;;; demises.el

;; Copyright (C) 2006-2014 Davin Pearson

;; Author/Maintainer: m4_davin_pearson
;; Keywords: Cull Size Quota
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;; This file warns against archive files that have decreased in size
;; as this may indicate loss of data.

;;; m4_limitation_of_warranty

;;; m4_install_instructions(demises)

;;; Known Bugs:

;; None!

;;; Code:

(defvar demises--bufname "*demises*")

;;;
;;; (demises--get-demises-inner (setq dirname "~/bak") (setq extension ".tar.gz"))
;;; (demises--get-demises-inner (setq dirname "~/bak") (setq extension ".zip"))
;;;
;;; (setq ptr (bak--get-bases dirname extension))
;;;
(defun demises--get-demises-inner (dirname extension)

  (assert (string-match "\\.\\(tar\\|tar\\.gz\\|zip\\)$" extension))
  ;;
  ;; (setq list '("bakw-h-dlisp"))
  ;;
  (let* ((list   (bak--get-bases dirname extension))
         (ptr    list)
         (list-2 nil))

    (while ptr
      (setq list-2 (nreverse (directory-files dirname nil (concat "^"
                                                                  (car ptr)
                                                                  bak--yyyymmdd
                                                                  bak--hhmmss
                                                                  (regexp-quote extension)
                                                                  "$$"))))
      (if (>= (length list-2) 2)
          (save-excursion
            (let* ((newer (nth 0 list-2))
                   (older (nth 1 list-2))
                   (newer-size (nth 7 (file-attributes (concat dirname "/" newer))))
                   (older-size (nth 7 (file-attributes (concat dirname "/" older)))))
              (if (< newer-size (- older-size 2000))
                  (save-excursion
                    ;;(d-foo)
                    (set-buffer demises--bufname)
                    (goto-char (point-max))
                    (insert (format "*** demise of %d in new file %s\n" (- older-size newer-size) newer)
                    ;;(insert "*** file " newer " is smaller than " older "\n")
                    ))))))
      (setq ptr (cdr ptr))))

  )

;; (demises-get-demises)
(defun demises-get-demises ()
  (interactive)

  (setq demises-start-time (current-time))

  (if (get-buffer demises--bufname)
      (kill-buffer demises--bufname))

  (save-excursion
    (set-buffer (generate-new-buffer demises--bufname))
    (compilation-mode)
    (read-only-mode -1))

  (demises--get-demises-inner "~/bak"     ".tar.gz")
  (demises--get-demises-inner "~/bak"     ".tar")
  (demises--get-demises-inner "~/bak"     ".zip")
  (demises--get-demises-inner "~/bak/baz" ".tar")

  (save-excursion
    (set-buffer demises--bufname)
    (goto-char (point-min))
    ;;(flush-lines "bakw-h-workspace")
    (flush-lines "project")
    ;;(flush-lines "Function-Plotter-Setup")

    (let ((count 0))
      (goto-char (point-min))
      (while (re-search-forward "\\*\\*\\* demise of" nil t)
        (incf count))
      (progn
        (d-random-play-emacs-midi "/media/www/C1TB/sound-samples/emacs/completed-demises.wav")
        (d-say-number-improved count)
        (d-random-play-emacs-midi "/media/www/C1TB/sound-samples/emacs/numbers/demises-found.wav")
        )
      (goto-char (point-max))
      (insert (format "**** %d demise(s) found\n"  count))
      (insert (format "**** time took: %s\n"
                      (seconds-to-readable-string (seconds-of-time-difference demises-start-time (current-time))))
              )
      )

    ;;(message "No demises found")
    ;;(message "Finished with demises")

    (progn
      (switch-to-buffer demises--bufname)
      (save-excursion
        (setq s (buffer-string))
        (find-file (concat "~/bak/demises-" (d-time--get-stamp) ".comp"))
        (insert s)
        (save-buffer)
        (kill-buffer nil)))

    (let ((ptr (nreverse (directory-files "~/bak" nil "^demises")))
          (i 0))
      (while (< i 10)
        (incf i)
        (setq ptr (cdr ptr)))
      (while ptr
        (delete-file (concat "~/bak/" (car ptr)))
        (setq ptr (cdr ptr))))
    )
  )

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