
(d-quote
  (progn
    ;; APPLIES ONLY TO DIRS!
    (setq d-cap--dir "d:/midi-files/")
    (setq d-cap--list (directory-files-subdirs d-cap--dir nil))
    (d-capitalize--rename)
    )
  (progn
    :: APPLIES TO ALL DEEP!
    (setq d-cap--dir "d:/midi-files/")
    (setq d-cap--list (directory-files-deep d-cap--dir nil "\\.[Mm][Ii][Dd]$"))
    (d-capitalize--rename)
    )
  (progn
    (setq d-cap--dir "~/aaa/")
    (setq d-cap--list (directory-files-deep d-cap--dir nil "\\.[Mm][Ii][Dd]$"))
    (d-capitalize--rename))
  (progn
    ;; APPLIES ONLY TO BEATLES FILES!
    (setq d-cap--dir "d:/midi-files/Beatles--the/")
    (setq d-cap--list (directory-files-deep d-cap--dir nil "\\.[Mm][Ii][Dd]$"))
    (d-capitalize--rename)
    )
  (progn
    ;; APPLIES ONLY TO MOZART FILES!
    (setq d-cap--dir "d:/midi-files/Classical/Mozart--Wolfgang-Amadeus/classical-archives.com/Keyboard-Works/Other-Keyboard-Works/")
    (setq d-cap--list (directory-files-deep d-cap--dir nil "\\.[Mm][Ii][Dd]$"))
    (d-capitalize--rename)
    )
  )

(defun d-capitalize ()
  (interactive)
  (assert (eq major-mode 'dired-mode))
  (setq d-cap--dir default-directory)
  (setq d-cap--list (directory-files-no-dotdotdot d-cap--dir))
  (d-capitalize--rename)
  (sit-for 1)
  (revert-buffer))

;;(setq filename "foo/bar.mid")
;;(setq s "foo")
;;(d-capitalize--upcase-first-downcase-rest s)
(defun d-capitalize--rename ()

  (assert (boundp 'd-cap--list))
  (assert (boundp 'd-cap--dir))

  (let ((ptr  d-cap--list)
        (temp-file)
        (count 0))

    (while ptr

      (let* ((filename  (car ptr))
             (file-part (file-name-nondirectory filename))
             (dir-part  (file-name-directory    filename))
             (from-file nil)
             (to-file   nil)
             (fullname  nil))

        (setq file-part (d-capitalize--process file-part))
        (setq fullname (concat dir-part file-part))

        (setq from-file (concat d-cap--dir (car ptr)))
        (setq to-file   (concat d-cap--dir fullname))

        ;;(assert (not (file-exists-p temp-file)))
        (assert (file-exists-p from-file))

        (when (not (string= from-file to-file))
          ;;(rename-file from-file temp-file)
          ;;(rename-file temp-file to-file)
          (rename-file from-file to-file 'OK-IF-ALREADY-EXISTS)
          (message "Renaming from \"%s\" to \"%s\""  from-file to-file)
          (incf count)
          ))

      ;;(message "working with file=\"%s\"" (car ptr))
      (setq ptr (cdr ptr))
      ;; END WHILE:
      )

    ;;(assert (not (file-exists-p temp-file)))
    (message "Files processed = %d" count)

    ))

;; (setq file "Papa's-got-a-brand-new-bag.mid")
;; (setq file "KC-and-the-sunshine-band")
;; (setq file "foo--bar--mid")
;; (setq file "better_butter-is_all_around.mid")
;; (setq file "concerto-in-Bb.mid")
;; -----------------------------------------
;; (d-capitalize--process "aa---    ____b.c Ph.D   d")
;; (d-capitalize--decompose "aa---    ____b.c Ph.D   d")
(defun d-capitalize--process (file)
  (let ((list (d-capitalize--decompose file)))
    (d-capitalize--inner-process list)
    (if (string-match "^[Mm][Ii][Dd]$" (car (last list)))
        (setcar (last list) "mid"))
    (if (string-match "^[Mm][Pp]3$" (car (last list)))
        (setcar (last list) "mp3"))
    (if (string-match "^[Ww][Mm][Aa]$" (car (last list)))
        (setcar (last list) "wma"))
    (if (string-match "^[Jj][Pp][Gg]$" (car (last list)))
        (setcar (last list) "jpg"))
    (if (string-match "^[Gg][Ii][Ff]$" (car (last list)))
        (setcar (last list) "gif"))
    (setq file (d-capitalize--recompose list))
    (setq file (d-capitalize--upcase-first-leave-rest file))))

;; (setq string "000-misc")
;; (setq string "foo/bar.mid")
;; (setq answer (d-capitalize--decompose string))
;; (setq string "A- ---b.mid")
;; (setq i 1)
(defun d-capitalize--decompose (string)
  (let ((i 0)
        (current "")
        (answer nil))

    (while (< i (length string))
      (setq current (if (d-capitalize--inside-word string i)
                        (d-capitalize--get-word string i)
                      (d-capitalize--get-non-word string i)))
      ;;(message "current=%s" current)
      (setq answer (cons current answer))

      (setq i (+ i (length current))))

    (reverse answer))
  )

;; (d-capitalize--process "aa---    ____b.c Ph.D   d")
;; (insert (prin1-to-string (d-capitalize--decompose "aa---    ____b.c Ph.D   d")))
;;
;; (setq answer-list '("aa" "---    ____" "b" "." "c" " " "Ph" "." "D" "   " "d"))
;;
(defun d-capitalize--inner-process (answer-list)
  (let ((ptr answer-list))
    (while ptr

      (when (d-capitalize--is-word (car ptr))
        (setcar ptr (cond
                     ;; ALL UPCASE KEEP!
                     ((string= (upcase (car ptr)) (car ptr))
                      (car ptr))

                     ;; FIRST UPCASE KEEP!
                     ((string= (d-capitalize--upcase-first-downcase-rest (car ptr)) (car ptr))
                      (car ptr))

                     ;; NOT DONE!
                     ;;
                     ;;((string-match "^i$" (downcase (car ptr)))
                     ;; "I")
                     ;;((string-match "^i'll$" (downcase (car ptr)))
                     ;; "I'll")
                     ;;((string-match "^i'm$" (downcase (car ptr)))
                     ;; "I'm")
                     ;;((string-match "^i've$" (downcase (car ptr)))
                     ;; "I've")
                     ;;

                     ;; BORING WORDS! are now capitalised like other words...........
                     ;;
                     ;;((d-capitalize--is-boring-word (car ptr))
                     ;; (downcase (car ptr)))

                     ;;((string= (d-capitalize--upcase-first-downcase-rest (car ptr)))
                     (t
                      (d-capitalize--upcase-first-downcase-rest (car ptr))))))

      (when (not (d-capitalize--is-word (car ptr)))
        (setcar ptr (d-capitalize--underscores-and-spaces-to-dashes (car ptr))))

        ;;(message "word=%s" (car ptr))
      (setq ptr (cdr ptr)))
    answer-list)
  )

;; (d-capitalize--recompose answer)
(defun d-capitalize--recompose (list)
  (apply 'concat list))

;; (setq string "foo.mid")
;; (d-capitalize--upcase-first "FOO.MID")
;; (d-capitalize--upcase-first "foo.mid")
;; (d-capitalize--upcase-first "foo.mid")
;; (d-capitalize--upcase-first "a-ha")
;;
;; (setq i 0)
;; (setq string "abc")
(defun d-capitalize--upcase-first-downcase-rest (string)
  "
Makes uppercase the first letter of the string
Makes lowercase the other letters of the string
"
  (progn
    ;; CLONE:
    (setq string (format "%s" string))

    (let ((i 1)
          (len (length string)))
      (while (< i len)
        (aset string i (d-capitalize--char-downcase (aref string i)))
        (incf i)))

    (aset string 0 (d-capitalize--char-upcase (aref string 0)))
    string
    ;; END PROGN:
    )
  ;; END DEFUN:
  )

(defun d-capitalize--upcase-first-leave-rest (string)
  "
Makes uppercase the first letter of the string
Leaves the other letters of the string unchanged
"
  (progn
    ;; CLONE:
    (setq string (format "%s" string))
    (aset string 0 (d-capitalize--char-upcase (aref string 0)))
    string
    ;; END PROGN:
    )
  ;; END DEFUN:
  )



(defun d-capitalize--is-word (string)
  (d-capitalize--inside-word string 0))

;; (d-capitalize--get-word string 4)
(defun d-capitalize--get-word (string i)
  (let ((answer ""))
    (while (and (< i (length string))
                (d-capitalize--inside-word string i))
      (setq answer (concat answer (format "%c" (aref string i))))
      (incf i))
    answer))

;; (d-capitalize--get-non-word string 3)
(defun d-capitalize--get-non-word (string i)
  (let ((answer ""))
    (while (and (< i (length string))
                (not (d-capitalize--inside-word string i)))
      (setq answer (concat answer (format "%c" (aref string i))))
      (incf i))
    answer))

;; (setq string "000-misc")
;; (setq string "(")
;; (setq i 0)
(defun d-capitalize--inside-word (string i)
  (not (or (eq (aref string i) ?\()
           (eq (aref string i) ?\))
           (eq (aref string i) ?-)
           (eq (aref string i) ?_)
           (eq (aref string i) ?/)
           (eq (aref string i) ?.)
           (eq (aref string i) ?,)
           (eq (aref string i) ? )
           )))



;; (setq the "WORD")
;; (setq word2 (downcase word))
(defun d-capitalize--is-boring-word (word)
  (setq word (downcase word))
  (or (string= word "a")
      (string= word "ain't")
      (string= word "all")
      (string= word "am")
      (string= word "an")
      (string= word "and")
      (string= word "are")
      (string= word "as")
      (string= word "at")
      (string= word "be")
      (string= word "but")
      (string= word "buy")
      (string= word "by")
      (string= word "call")
      (string= word "can")
      (string= word "can't")
      (string= word "care")
      (string= word "day")
      (string= word "days")
      (string= word "do")
      (string= word "don't")
      (string= word "for")
      (string= word "get")
      (string= word "go")
      (string= word "goes")
      (string= word "got")
      (string= word "has")
      (string= word "have")
      (string= word "he")
      (string= word "her")
      (string= word "he's")
      (string= word "his")
      (string= word "in")
      (string= word "into")
      (string= word "is")
      (string= word "it")
      (string= word "it's")
      (string= word "know")
      (string= word "let")
      (string= word "like")
      (string= word "look")
      (string= word "love")
      (string= word "man")
      (string= word "me")
      (string= word "d-")
      (string= word "no")
      (string= word "not")
      (string= word "of")
      (string= word "on")
      (string= word "only")
      (string= word "or")
      (string= word "our")
      (string= word "out")
      (string= word "over")
      (string= word "see")
      (string= word "seen")
      (string= word "send")
      (string= word "set")
      (string= word "she")
      (string= word "so")
      (string= word "than")
      (string= word "that")
      (string= word "the")
      (string= word "they")
      (string= word "this")
      (string= word "to")
      (string= word "too")
      (string= word "up")
      (string= word "us")
      (string= word "want")
      (string= word "was")
      (string= word "what")
      (string= word "will")
      (string= word "with")
      (string= word "you")
      (string= word "your")
      (string= word "you're")
      )
  )

;; (setq string "___a---b   c___")
;; (d-capitalize--underscores-and-spaces-to-dashes string)
(defun d-capitalize--underscores-and-spaces-to-dashes (string)
  (progn
    ;; CLONE:
    (setq string (format "%s" string))
    (let ((i 0)
          (ch))
      (while (< i (length string))
        (setq ch (aref string i))
        (if (eq ch ?_) (setq ch ?-))
        (if (eq ch ? ) (setq ch ?-))
        (aset string i ch)
        (incf i)))
      string)
  )



(defun d-capitalize--char-upcase (ch)
  (if (and (>= ch ?a) (<= ch ?z))
      (setq ch (- ch 32)))
  ch)

(defun d-capitalize--char-downcase (ch)
  (if (and (>= ch ?A) (<= ch ?Z))
      (setq ch (+ ch 32)))
  ch)



(provide 'd-capitalize)
