
(defun copy-to-folder ()
  (interactive)
  (setq long-dir "d:/home/Davin's Stuff/")

  ;;(setq list (directory-files-no-subdirs long-dir t "\\.lpp$")))
  ;;(mapcar 'delete-file list)
  (setq date-stamp (concat (d-time--get-stamp) "/"))
  (make-directory (concat long-dir date-stamp) 'PARENTS)

  (copy-file "~/.emacs"                      "~/dlisp/dotemacs.el" 'OK-IF-ALREADY-EXISTS)
  (copy-file "~/.emacs"                      (concat long-dir "dlisp/dotemacs.el")   'OK-IF-ALREADY-EXISTS)
  (copy-file "~/.emacs"                      (concat long-dir date-stamp "dotemacs.el") 'OK-IF-ALREADY-EXISTS)
  (copy-file "~/log-2010.txt"                (concat long-dir "home-log-2010.txt")      'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  (copy-file "~/log-2012.txt"                (concat long-dir "home-log-2012.txt")      'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  (copy-file "~/log.txt"                     (concat long-dir "home-log.txt")           'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  (copy-file "~/dlisp/log-2010.txt"          (concat long-dir "dlisp-log-2010.txt")     'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  (copy-file "~/dlisp/log-2011.txt"          (concat long-dir "dlisp-log-2011.txt")     'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  (copy-file "~/dlisp/log.txt"               (concat long-dir "dlisp-log.txt")          'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  ;;(copy-file "~/c++-projects/log-2010.txt"       (concat long-dir "c++-projects-log-2010.txt")  'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  ;;(copy-file "~/c++-projects/log-2011.txt"       (concat long-dir "c++-projects-log-2011.txt")  'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  (copy-file "~/c++-projects/log.txt"              (concat long-dir date-stamp "c++-projects-log.txt") 'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  ;;(copy-file "~/c++-projects/Crystal.jpg"          (concat long-dir "Crystal.jpg")            'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  ;;(copy-file "~/c++-projects/dylan-sound-bites.hts"(concat long-dir "dylan-sound-bites.hts") 'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  (copy-file "~/c++-projects/to-kill-a-mockingbird.hts" (concat long-dir "to-kill-a-mockingbird.hts") 'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
  ;;(copy-file "~/c++-projects/stylesheet10.css"   (concat long-dir date-stamp "stylesheet10.css") 'OK-IF-ALREADY-EXISTS 'KEEP-TIME)


  (progn
    (setq ptr (directory-files-deep "~/c++-projects/2012/Othello" nil nil))
    ;;(setq ptr '("gfx/font-17x17.bmp"))
    (while ptr
      (make-directory (file-name-directory (concat long-dir "/Othello/" (car ptr))) 'PARENTS)
      (if (not (file-directory-p (concat "~/c++-projects/2012/Othello/" (car ptr))))
          ;;(condition-case nil
          (copy-file (concat "~/c++-projects/2012/Othello/" (car ptr))
                     (concat long-dir "/Othello/" (car ptr))
                     'OK-IF-ALREADY-EXISTS
                     'KEEP-TIME))
      ;; (error nil)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-deep "~/c++-projects/2012/Arithmetickles" nil nil))
    ;;(setq ptr '("gfx/font-17x17.bmp"))
    (while ptr
      (make-directory (file-name-directory (concat long-dir "/Arithmetickles/" (car ptr))) 'PARENTS)
      (if (not (file-directory-p (concat "~/c++-projects/2012/Arithmetickles/" (car ptr))))
          ;;(condition-case nil
          (copy-file (concat "~/c++-projects/2012/Arithmetickles/" (car ptr))
                     (concat long-dir "/Arithmetickles/" (car ptr))
                     'OK-IF-ALREADY-EXISTS
                     'KEEP-TIME))
      ;; (error nil)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-deep "~/c++-projects/2012/Arithmetickles-old/" nil nil))
    ;;(setq ptr '("gfx/font-17x17.bmp"))
    (while ptr
      (make-directory (file-name-directory (concat long-dir "/Arithmetickles-old/" (car ptr))) 'PARENTS)
      (if (not (file-directory-p (concat "~/c++-projects/2012/Arithmetickles-old/" (car ptr))))
          ;;(condition-case nil
          (copy-file (concat "~/c++-projects/2012/Arithmetickles-old/" (car ptr))
                     (concat long-dir "/Arithmetickles-old/" (car ptr))
                     'OK-IF-ALREADY-EXISTS
                     'KEEP-TIME))
      ;; (error nil)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/2012/Arithmetickles/sfx/numbers/" nil))
    (make-directory (concat long-dir "Arithmetickles/sfx/numbers") 'PARENTS)
    (while ptr
      (condition-case nil
          (progn
            (copy-file (concat "d:/home/c++-projects/2012/Arithmetickles/sfx/numbers/" (car ptr))
                       (concat long-dir "Arithmetickles/sfx/numbers/" (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/2012/Arithmetickles/sfx/" nil))
    (make-directory (concat long-dir "Arithmetickles/sfx/") 'PARENTS)
    (while ptr
      (condition-case nil
          (progn
            (copy-file (concat "d:/home/c++-projects/2012/Arithmetickles/sfx/" (car ptr))
                       (concat long-dir "Arithmetickles/sfx/" (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/2012/Arithmetickles/" nil))
    (make-directory (concat long-dir "Arithmetickles/") 'PARENTS)
    (while ptr
      (condition-case nil
          (progn
            (copy-file (concat "d:/home/c++-projects/2012/Arithmetickles/" (car ptr))
                       (concat long-dir "Arithmetickles/" (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/2011/lisp++" nil))
    (make-directory (concat long-dir "lisp++") 'PARENTS)
    (while ptr
      (condition-case nil
          (progn
            (copy-file (concat "d:/home/c++-projects/2011/lisp++/" (car ptr))
                       (concat long-dir "lisp++/" (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/2011/c++" nil))
    (make-directory (concat long-dir "c++") 'PARENTS)
    (while ptr
      (condition-case nil
          (progn
            (copy-file (concat "d:/home/c++-projects/2011/c++/" (car ptr))
                       (concat long-dir "c++/" (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/dlisp/" nil "\\.el$"))
    (make-directory (concat long-dir "dlisp") 'PARENTS)
    (while ptr
      (condition-case nil
          (progn
            (copy-file (concat "d:/home/dlisp/" (car ptr))
                       (concat long-dir "dlisp/" (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/" nil "\\.el$"))
    (while ptr
      (condition-case nil
          (progn
            (copy-file (concat "d:/home/c++-projects/" (car ptr))
                       (concat long-dir date-stamp (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/" nil "Makefile.*$"))
    (while ptr
      (condition-case nil
          (progn
            (copy-file (concat "d:/home/c++-projects/" (car ptr))
                       (concat long-dir date-stamp (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/trash/" nil ""))
    (make-directory (concat long-dir "trash") 'PARENTS)
    (while ptr
      (condition-case nil
          (progn
            (copy-file (concat "~/c++-projects/trash/" (car ptr))
                       (concat long-dir "trash/" (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/" nil "\\.txt$"))
    (while ptr
      (condition-case nil
          (progn
            ;;(assert (string-match "^.$" (car ptr)))
            (copy-file (concat "d:/home/c++-projects/" (car ptr))
                       (concat long-dir (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)
            ))
      (setq ptr (cdr ptr))))

  (progn
    (setq ptr (directory-files-no-subdirs "~/c++-projects/2007/r4" nil "\\.\\(cc\\|ch\\|hh\\)$"))
    (setq r4-dir (concat "R4-" date-stamp))
    (make-directory (concat long-dir r4-dir) 'PARENTS)
    (while ptr
      (condition-case nil
          (progn
            ;;(assert (string-match "^.$" (car ptr)))
            (copy-file (concat "d:/home/c++-projects/2007/r4/" (car ptr))
                       (concat long-dir r4-dir (car ptr))
                       'OK-IF-ALREADY-EXISTS
                       'KEEP-TIME)
            ))
      (setq ptr (cdr ptr))))

  (dired "~/c++-projects/")
  )

;;(message "**2")

(defun page-count ()
  (interactive)
  (let (ptr list)
    (progn
      ;;(manaaki-build-book)
      (find-file "~/hairy-lemon/src/50webs-com/prog/book.tex")
      (goto-char (point-max))
      (setq doc-count (d-what-line))
      (kill-buffer nil))
    (save-excursion
      (find-file "eraseme")
      (erase-buffer)
      (setq list (directory-files-no-subdirs "~/c++-projects/" nil "c[+][+]2lisp[+][+][^/]*[.]el"))
      (setq list (cons "back-to-from-editor.el" list))
      (setq list (cons "inside-stuff.el" list))
      (setq ptr list)
      (while ptr
        (insert-file (concat "~/c++-projects/" (car ptr)))
        (setq ptr (cdr ptr)))
      (goto-char (point-max))
      (setq c2l-count (d-what-line))
      (set-buffer-modified-p nil)
      (kill-buffer nil))
    (save-excursion
      (find-file "eraseme")
      (erase-buffer)
      (setq list (directory-files-no-subdirs "~/c++-projects/" nil "lisp[+][+]2c[+][+][^/]*.el"))
      (setq list (cons "back-to-from-editor.el" list))
      (setq list (cons "inside-stuff.el" list))
      (setq ptr list)
      (while ptr
        (insert-file (concat "~/c++-projects/" (car ptr)))
        (setq ptr (cdr ptr)))
      (goto-char (point-max))
      (setq l2c-count (d-what-line))
      (set-buffer-modified-p nil)
      (kill-buffer nil))
    (save-excursion
      (find-file "~/hairy-lemon/src/50webs-com/prog/jtw-tutorials/jtw2java.el")
      (goto-char (point-max))
      (setq jtw2java-count (d-what-line))
      (kill-buffer nil))
    (save-excursion
      (find-file "~/dlisp/jtw-mode.el")
      (goto-char (point-max))
      (setq jtw-mode-count (d-what-line))
      (kill-buffer nil))
    (message "doc=%s c2l-loc=%s l2c-loc=%s jtw2java=%s jtw-mode=%s"
             (/ doc-count 50)
             c2l-count
             l2c-count
             (/ jtw2java-count 50)
             (/ jtw-mode-count 50)
             ))
  )

;;(message "**3")

(defun cull-same-dates--on-directories ()
  (interactive)
  (let (dir list ptr s list2 ptr2)
    (setq dir  "d:/home/Davin's Stuff/")
    (setq list (directory-files-subdirs dir))
    (setq ptr list)
    (while ptr
      (setq s (car ptr)) ;;;   Y    Y    Y    Y    M    M    D    D
      (when (string-match "^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]-" s)
        (setcar ptr (substring s 0 (match-end 0))))
      (setq ptr (cdr ptr)))
    (setq list (delete-duplicates list :test 'string=))
    (setq ptr list)
    (while ptr
      (setq list2 (directory-files-subdirs dir nil (concat (car ptr)
                                                ;;;            H    H    M    M    S    S
                                                           "[0-9][0-9][0-9][0-9][0-9][0-9]$")))
      (setq ptr2 list2)
      (while (cdr ptr2)
        (dired-delete-file (concat dir (car ptr2)) 'always)
        (setq ptr2 (cdr ptr2)))
      (setq ptr (cdr ptr))))
  )

(defun manaaki-abc ()
  (interactive)
  (shell-command "cd ~/hairy-lemon/src/50webs-com/prog/; m4 -P abc.tes >abc.tex"))

(defun manaaki-build-book ()
  (interactive)
  (save-some-buffers 'NO-QUESTIONS)
  ;;(find-file "~/c++-projects/book/book.tes")
  (shell-command "cd ~/hairy-lemon/src/50webs-com/prog; m4 -P book.tes >book.tex")
  (d-quote let* ((list (directory-files "~/hairy-lemon/src/50webs-com/prog/" nil "\\.tes$"))
         (ptr  list)
         (new-file))
    ;;(setq ptr '("book.tes"))
    (while ptr
      (assert (string-match "\\.tes$" (car ptr)))
      (setq new-file (concat (substring
                              (car ptr)
                              0
                              (match-beginning 0))
                             ".tex"))
      ;;(debug "Rocket Man")
      (shell-command (concat "cd ~/hairy-lemon/src/50webs-com/prog/; m4 -P "
                             (car ptr)
                             " >"
                             new-file))
      (message "*** done %s" new-file)
      ;;(setq ptr nil)
      (setq ptr (cdr ptr))))
  ;;(shell-command "cd ~/c++-projects/book; m4 -P book.tes >book.tex")
  ;;  (write-file "~/c++-projects/book/book.tex")
  ;;  (goto-char (point-min))
  ;;  (let ((case-fold-search nil))
  ;;    (while (re-search-forward "^include(\\([^()\r\n]+\\))" nil t)
  ;;      (setq filename (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
  ;;      (delete-region (point-at-bol) (point-at-eol))
  ;;      (save-excursion
  ;;        (assert (file-exists-p filename))
  ;;        (find-file filename)
  ;;        (setq str (buffer-substring-no-properties (point-min) (point-max)))
  ;;        (kill-buffer nil))
  ;;      (save-excursion
  ;;        (insert str)
  ;;        ))
  ;;    (goto-char (point-min))
  ;;    (while (re-search-forward "\\<ignore(" nil t)
  ;;      (forward-char (- (length "ignore(")))
  ;;      (kill-sexp 2))
  ;;    (goto-char (point-min))
  ;;    (while (re-search-forward "^[ \t]*m4_dnl" nil t)
  ;;      (delete-region (point-at-bol) (point-at-eol)))
  ;;    (save-some-buffers 'NO-QUESTIONS)
  ;;    ;;(write-file "~/c++-projects/book.latex")
  ;;    (kill-buffer nil))
  )

(defun davins-compose-book-and-backup-folder ()
  (interactive)
  ;;(manaaki-build-book)
  (progn
    (copy-to-folder)
    (cull-same-dates--on-directories))
  (d-beeps "Finished davins-compose-book")
  (message "")
  )

(provide 'manaaki)
;;; manaaki.el ends here
