
(defun bak ()
  (interactive)

  (assert os-type--mswindows-p)

  (save-window-excursion
    (save-some-buffers 'NO-QUESTIONS)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; dlisp-YYYYMMDD-HHMMSS.tar.gz
;;;
    (save-window-excursion
      (shell-command "cd ~/dlisp && make tar")
      (datify-bak-dir))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; rest.tar
;;;
    (message "*** building rest.tar")

    (progn
      (assert (string-match "^[a-zA-Z]:/" (getenv "HOME")))
      (setq home-dir-root (substring (getenv "HOME") (match-beginning 0) (match-end 0))))

    (save-window-excursion
      (shell-command "cd c:/wamp/www && make tar"))

    (save-window-excursion
      (shell-command "cd ~/java-projects && make clean"))

    (bak--bak-files home-dir-root
                    (concat windows-bak-dir "rest.tar")
                    `(
                      ;; Config files...
                      ,@(directory-files "~/" t "^_[a-zA-Z0-9_-]+$")
                      ,@(directory-files "~/" t "^\\.[a-zA-Z0-9_-]+$")

                      ;;,@(delete
                      ;;   nil
                      ;;   (mapcar
                      ;;    (lambda (x) (if (string-match "/.$" x) nil x))
                      ;;    (directory-files "~/" t "^\\.[a-zA-Z_-]*$")))

                      ;;"~/_bashrc"
                      ;;"~/_inputrc"
                      ;;"~/_emacs"
                      ;;"~/_diary"

                      ;; NOTE: Splice in these files...
                      ,@(directory-files "~/"          t "\\.lnk$")
                      ,@(directory-files "~/"          t "\\.txt$")
                      ,@(directory-files "~/"          t "\\.cc$")
                      ,@(directory-files "~/"          t "\\.hh$")
                      ,@(directory-files "~/"          t "\\.java$")
                      ,@(directory-files "~/"          t "\\.html$")
                      ;;,@(directory-files "~/"          t "\\.el$")
                      ,@(directory-files "~/"          t "\\.mk$")
                      ,@(directory-files "~/"          t "\\.inc$")

                      ;; NOTE: batmacs, x,
                      ,@(directory-files "~/bin"       t "\\.bat$")

                      ;; NOTE: entire directories...
                      "~/text"
                      "~/java-projects/"

                      ;; NOTE: Simbad Makefiles
                      "~/workspace/Makefile"
                      "~/tmp-project/Makefile"

                      ;; NOTE: COOL!
                      ;;,@logger--buf-list-all
                      ,@(directory-files-deep "c:/home/" t "^log-?[0-9]*\\.txt$")

                      ;; NOTE: none here.........
                      ;;,@(directory-files "~/zallegro/" t "\\.txt$")
                      ;;,@(directory-files "~/zallegro/" t "\\.cc$")
                      ;;,@(directory-files "~/zallegro/" t "\\.wiki$")

                      ;; NOTE: Already included...
                      ;;"~/text/mal.txt"
                      ;;"~/text/stereo-equipment.txt"
                      ;;"~/text/lardwords.txt"
                      ;;"~/text/asciitab.txt"
                      ;;"~/text/environment-variables.txt"

                      ;; Davin's File Chooser: ~/hairy-lemon/output/index.html
                      ;; and                   ~/hairy-lemon/output/htmlref.html
                      ;;,@(directory-files "~/hairy-lemon/output/" t "\\.html?$")

                      ;; NOTE: includes links pages
                      ,@(directory-files
                         (concat webdata "/output")
                         t
                         "\\.html?$")


                      ;; NOTE: includes links pages
                      ,@(directory-files
                         (concat webdata "/src")
                         t
                         "\\.html?$")

                      "~/hairy-lemon/src/50webs.com/research/index.hts"

                      ;; NOTE: includes default icon
                      ,@(directory-files
                         (concat webdata "/output")
                         t
                         "\\.\\(css\\|ico\\|gif\\|png\\)$")

                      ;; NOTE: the pattern established in this file
                      ;; NOTE: for accessing non-native info files...
                      ;; NOTE: info.tar.gz files are stored in
                      ;;       c:/Install Files/editors/info/
                      ;; NOTE: the "dir" files are backed up in bak--info
                      ;; ---------------------------------------------------------
                      ;;"c:/Program Files/emacs-20.7/info/dir"
                      ;;"~/../Program Files/emacs-20.7/info/dir"
                      ;;"c:/emacs-20.7/info/others"
                      ))

    (progn
      (when (file-exists-p "f:/")
        (make-directory "f:/home/bak" 'PARENTS)
        (copy-file "c:/home/bak/rest.tar.gz" "f:/home/bak/rest.tar.gz" 'ok-if-already-exists 'keep-time))
      (when (file-exists-p "g:/")
        (make-directory "g:/home/bak" 'PARENTS)
        (copy-file "c:/home/bak/rest.tar.gz" "g:/home/bak/rest.tar.gz" 'ok-if-already-exists 'keep-time))
      ;;(datify--dir "c:/bak")
      (datify--dir "c:/home/bak")
      (datify--dir "f:/home/bak")
      (if (file-exists-p "g:/")
          (datify--dir "g:/home/bak")))

    (progn
      (progn
        ;;(bak--cull-stuff "c:/bak/")
        (bak--cull-stuff "c:/home/bak/")
        (bak--cull-stuff "f:/home/bak/")
        (if (file-exists-p "g:/")
            (bak--cull-stuff "g:/home/bak/")))
      (progn
        ;;(bak--cull-stuff "c:/bak/baz")
        (bak--cull-stuff "c:/home/bak/baz")
        (if (file-exists-p "f:/home/bak/baz")
            (bak--cull-stuff "f:/home/bak/baz"))
        (if (file-exists-p "g:/home/bak/baz")
            (bak--cull-stuff "g:/home/bak/baz"))
        )
      )

    (demises-get-demises)
    ;;(d-beeps "Demises finished")
    ;;(acz)
    )
  )

(defun bak--cull-stuff (dirname)
  (setq dirname (expand-file-name dirname))
  (if (not (string-match "/$" dirname))
      (setq dirname (concat dirname "/")))
  (cull-same-dates dirname)
  (cull-size-quota dirname))

;; (setq s (expand-file-name "~/bak"))
;; (bak--get-drive s)
(defun bak--get-drive (s)
  (assert (string-match "^\\([a-zA-Z]\\):" s))
  (substring s (match-beginning 1) (match-end 1)))

;; (setq s (expand-file-name "~/bak"))
;; (bak--get-rest s)
(defun bak--get-rest (s)
  (assert (string-match "^[a-zA-Z]:/\\(.*$\\)" s))
  (substring s (match-beginning 1) (match-end 1)))

(defun bak--get-windows-bak-dir ()
  (let ((s (expand-file-name "~/bak/")))
    (concat "/cygdrive/"
            (bak--get-drive s)
            "/"
            (bak--get-rest s))))

;; (bak--get-command-list (setq list (directory-files-no-subdirs "~/workspace/")))
(defun bak--get-command-list (list)
  (let ((ptr list)
        (result ""))
    (while ptr
      (setq result (concat result " " (car ptr)))
      (setq ptr (cdr ptr)))
    result)
  )

(setq windows-bak-dir (bak--get-windows-bak-dir))

;;;
;;; NOTE: cygwin tar doesn't accept "c:/bak/"
;;;

;;(defun bak--get-temp-file ()
;;  (concat "c:/eraseme-" (format "%04x" (random 65536)) ".tmp")
;;  )
;; (setq filename "c:/djgpp/bin/x.bat")
;; (setq filename "~/text/*.txt")
;; (setq filename "~/text/mal.txt")
;; (setq filename "//lasher/foo")
;; (file-name-directory filename)
;; (file-name-nondirectory filename)
;;
;; (bak--strip-prefix-and-exist "c:/home/log.txt")
;; (bak--strip-prefix-and-exist "c:/log.txt")
(defun bak--strip-prefix-and-exist (filename)

  ;; NOTE: Blank if file doesn't exist
  (if (file-exists-p filename)
      (progn
        ;; NOTE: Expand...
        (setq filename (expand-file-name filename))

        ;; NOTE: Strip crud...
        (if (string-match "^[a-zA-Z]:/" filename)
            (setq filename (substring filename 2)))
        (if (string-match "^/[^/]" filename)
            (setq filename (substring filename 1)))
        filename)
    nil))

;;;
;;; (setq bak-list '("~/.emacs" "~/.recent"))
;;;
(defun bak--bak-files (base-dir bak-name bak-list)

  (message "base-dir=%s bak-name=%s bak-list=%s"
           (prin1-to-string base-dir)
           (prin1-to-string bak-name)
           (prin1-to-string bak-list))
  ;;(debug "carrot")

  (setq bak--bak-files--old-default-directory default-directory)
  (setq default-directory base-dir)

  (save-window-excursion

    (setq bak-list (mapcar 'bak--strip-prefix-and-exist bak-list))
    (setq bak-list (delete nil bak-list)) ;;; Delete non-existent files (see above)

    (let* ((files (substring (prin1-to-string bak-list) 1 -1))
           (tar-command (concat "cd " base-dir "; tar "
                                "--verbose --totals --checkpoint "
                                "-cf " bak-name " " files)))

      (message "-> %s" tar-command)
      (if (get-buffer "*Shell Command Output*")
          (kill-buffer "*Shell Command Output*"))
      (shell-command tar-command)

      (progn
        (set-buffer "*Shell Command Output*")
        (goto-char (point-min))
        ;;(rename-buffer "*tar output*")
        (insert "\n\nTAR COMMAND:\n>>> " tar-command "\n\n")
        ;;(set-buffer "*tar output*")
        (goto-char (point-min))
        (let ((case-fold-search t))
          (if (re-search-forward "error" nil t)
              (error "Error in bak!")))
        ))

    (shell-command (concat "gzip " bak-name))
    ;;(shell-command (concat "rm -f " temp-file))
    )

  ;;(datify-bak-dir)
  (setq default-directory bak--bak-files--old-default-directory)

  ;; END DEFUN:
  )

;;; (setq list (directory-files-no-dotdotdot (bak-dir)))
;;; (setq ptr  list)
;;;
(defun bak--copy-to-other-drives ()
  (progn
    (datify-bak-dir)

    (bak--copy-to-other-drive--internal "~/bak" "c:/bak")

    (when (file-exists-p "f:/home/bak/")
      (bak--copy-to-other-drive--internal "~/bak" "f:/home/bak/")
      )

    (when (file-exists-p "g:/bak/")
      (bak--copy-to-other-drive--internal "~/bak" "g:/bak/")
      )
    )
  (if (file-exists-p "f:/")
      (save-window-excursion
        (let ((baz-dir  "~/bak/baz")
              (baz-dir2 "c:/bak/baz")
              (baz-dir3 "f:/home/bak/baz"))
          (when (file-exists-p baz-dir2)
            (bak--copy-to-other-drive--internal baz-dir baz-dir2)
            (cull-same-dates baz-dir2)
            (cull-size-quota baz-dir2))
          (when (file-exists-p baz-dir3)
            (bak--copy-to-other-drive--internal baz-dir baz-dir3)
            (cull-same-dates baz-dir3)
            (cull-size-quota baz-dir3)
            ))))

  (if (file-exists-p "g:/")
      (save-window-excursion
        (let ((baz-dir  "~/bak/baz")
              (baz-dir2 "c:/bak/baz")
              (baz-dir3 "g:/home/bak/baz"))
          (when (file-exists-p baz-dir2)
            (bak--copy-to-other-drive--internal baz-dir baz-dir2)
            (cull-same-dates baz-dir2)
            (cull-size-quota baz-dir2))
          (when (file-exists-p baz-dir3)
            (bak--copy-to-other-drive--internal baz-dir baz-dir3)
            (cull-same-dates baz-dir3)
            (cull-size-quota baz-dir3)
            ))))

 )

;;;
;;; (bak--copy-to-other-drive--internal--internal "~/bak" "c:/bak" "\\.tar$")
;;; (bak--copy-to-other-drive--internal--internal "~/bak" "c:/bak" "\\.tar\\.gz$")
;;; (bak--copy-to-other-drive--internal--internal "~/bak" "f:/bak" "\\.exe$")
;;;
(defun bak--copy-to-other-drive--internal--internal (from-dir to-dir extension)

  (let* ((list (directory-files-no-subdirs from-dir nil extension))
         (ptr  list))

    ;;(bak--test-yyyymmdd from-dir extension)

    ;;(debug)

    ;; PRUNE DATE FROM ARCHIVE FILES:
    (while ptr
      (if (string-match (concat "\\(.*\\)" bak--yyyymmdd bak--hhmmss extension) (car ptr))
          (setcar ptr (substring (car ptr) (match-beginning 1) (match-end 1)))
          ;;(if (string-match (concat "^\\([-a-zA-Z]+[0-9]*[-a-zA-Z]+\\)-[-0-9]*" extension) (car ptr))
        (setcar ptr nil))
      (setq ptr (cdr ptr)))

    ;; DELETE DUPLICATES AND NIL:
    (setq list (delete-duplicates list :test 'string=))
    (setq list (delete nil list))

    ;;(debug)
    ;; (setq ptr '("home-kidwords"))

    ;; COPY ARCHIVE FILES:
    (setq ptr list)
    (while ptr
      (let* ((file (car (last (directory-files-no-subdirs
                               from-dir
                               nil
                               (concat "^" (car ptr) bak--yyyymmdd bak--hhmmss extension)))))
             (from-file (concat from-dir "/" file))
             (to-file   (concat to-dir "/" file))
             (cmd       nil))

        ;;(if (string= (car ptr) "home-kidwords")
        ;;  (debug))

        ;;(debug)
        ;;(copy-file from-file to-file :ok-if-already-exists :keep-time)
        (setq cmd (concat "cp -upv " from-file " " to-dir))
        (message ">>> %s" cmd)
        (shell-command cmd)
        ;;(message (concat "cp -upv " from-file " " to-dir))
        )
      (setq ptr (cdr ptr)))

    ;; END LET:
    ))

(defun bak--copy-to-other-drive--internal (from-dir to-dir)
  (assert (and os-type--mswindows-p emacs-dialect--gnuemacs-p))
  (datify--dir from-dir)
  (if (not (file-exists-p to-dir))
      (make-directory to-dir t))
  (bak--copy-to-other-drive--internal--internal from-dir to-dir "\\.tar$")
  (bak--copy-to-other-drive--internal--internal from-dir to-dir "\\.tar\\.gz$")
  (bak--copy-to-other-drive--internal--internal from-dir to-dir "\\.zip$")
  (bak--copy-to-other-drive--internal--internal from-dir to-dir "\\.exe$")
  )

;;(defun bak--ddriving ()
;;  (interactive)
;;
;;  (save-window-excursion
;;
;;    (save-some-buffers 'NO-QUESTIONS)
;;
;;    (let ((default-directory "c:/home"))
;;      (shell-command (concat "tar"
;;                             " cvf "
;;                             windows-bak-dir
;;                             "bakw-c-ddriving.tar ddriving"))
;;      (datify-bak-dir)
;;      (cull-size-quota (bak-dir)))
;;    )
;;  ;; END DEFUN:
;;  )

(defun bak--photos ()
  (interactive)

  (save-window-excursion
    (let ((default-directory "c:/"))
      (shell-command (concat "tar cvf "
                             windows-bak-dir
                             "bakw-photos.tar photos"))
      (datify-bak-dir)
      (cull-size-quota (bak-dir))
      ;;(bak)

      )
    )

  ;; END DEFUN:
  )

(defun bak--sound-samples ()
  (interactive)

  (save-window-excursion
    (let ((default-directory "c:/"))
      (shell-command (concat "tar cvf "
                             windows-bak-dir
                             "bakw-sound-samples.tar sound-samples"))
      (datify-bak-dir)
      (cull-size-quota (bak-dir)))
      )

  ;; END DEFUN:
  )

(defun bak--info ()
  (interactive)

  ;;
  ;;  WTF: why doesn't this work???
  ;;
  (save-window-excursion
    ;;(shell-command "cd \"c:/Program Files/emacs-20.7/info\"; ls")

    ;; INTERESTING: need trailing slash to work.........
    ;;(let ((default-directory "c:/Program Files/emacs-20.7/info/"))
    ;;  (shell-command "ls"))

    (setq d-program-files (expand-file-name "~/../Program Files/"))

    (let ((default-directory (concat d-program-files "emacs-21.3/")))
      (shell-command (concat "tar cvf "
                             windows-bak-dir
                             "bakw-info.tar info"))
      (shell-command (concat "gzip " windows-bak-dir "bakw-info.tar"))
      (datify-bak-dir)
      (cull-size-quota (bak-dir)))

    ;; END SWE:
      )

  ;; END DEFUN:
  )

(defun bak--art ()
  (interactive)

  (save-window-excursion
    (let ((default-directory (getenv "HOME")))
      (shell-command (concat "tar cvf "
                             windows-bak-dir
                             "art.tar art"))
      (shell-command (concat "gzip " windows-bak-dir "art.tar"))
      (datify-bak-dir)
      (cull-size-quota (bak-dir)))
      )

  ;; END DEFUN:
  )





;;;
;;; COOL! (bak--allegro-inner (setq dir (car (last (directory-files-subdirs (getenv "HOME") nil "^[0-9]+")))))
;;; COOL! (bak--allegro-inner (setq dir (car (directory-files-subdirs (getenv "HOME") nil "^1-.*$"))))
;;; COOL! (bak--allegro-inner (setq dir (car (directory-files-subdirs (getenv "HOME") nil "^3-.*$"))))
;;; COOL! (bak--allegro-inner (setq dir (car (directory-files-subdirs (getenv "HOME") nil "^4-.*$"))))

;;(defun bak--allegro-inner (dir)
;;  (save-window-excursion
;;    (shell-command (concat "cd " (getenv "HOME") "/" dir "; make clean"))
;;    (shell-command (concat "cd " (getenv "HOME") "; "
;;                           "tar"
;;                           " cf "
;;                           windows-bak-dir
;;                           "allegro-" dir ".tar "
;;                           "Makefile.mk "
;;                           dir))
;;    (shell-command (concat "cd " windows-bak-dir "; gzip allegro-*.tar"))
;;    (datify-bak-dir)
;;    (cull-size-quota (bak-dir))
;;    (d-beeps "Finished bak")
;;    )
;;  )

;;(defun bak--allegro (&optional no-extra)
;;  (interactive)
;;  (save-window-excursion
;;    (save-some-buffers 'NO-QUESTIONS)
;;
;;    (safe-require 'd-copy)
;;    (d-copy-copy-files)   ;;; calls make clean internally
;;
;;    (save-window-excursion
;;      (let* ((list (directory-files-subdirs (getenv "HOME") nil "^[0-9]+"))
;;             (ptr  list))
;;
;;        (while ptr
;;          (bak--allegro-inner (car ptr))
;;          (setq ptr (cdr ptr)))
;;        ))
;;
;;    ;;(if (directory-files "~/bak/" nil "^allegro.*\\.tar$")
;;
;;    (if (not no-extra)
;;        (bak))
;;
;;    (d-beeps "Done bak--allegro")
;;
;;    ;; END: save-window-excursion
;;    )
;;  ;; END DEFUN:
;;  )
;;

(provide 'bak-windows)
;;; bak-windows.el ends here
