my bak for xyzzy

bak

;;; 
;;; bak
;;;
(defvar bak-max 999)

(defun bak-difference-file-p (path1 path2)
  ;(dbg-msgbox path1 path2)
  (cond ((not (file-exist-p path1)) t)
	((not (file-exist-p path2)) t)
	((/= (file-length path1) (file-length path2)) t)
	(t nil)
	; todo: read both files and check differences each other
	))

(defun bak-suffixed-number (num)
  (let ((f "~~~D,'0D"))
    (format nil (format nil f (digit bak-max)) num)))

(defun bak-get-oldest-suffix-number (curr suffix)
  "return oldest suffix number."
  (let ((new (concat curr suffix)))
    (cond ((not (file-exist-p curr)) (error (format nil "not exist ~S" curr)))
	  ((not (file-exist-p new)) 0)
	  (t
      (let ((n 1)
	    candidate found)
	(while (and (not found) (< n (1+ bak-max)))
	  (setq candidate (concat new (bak-suffixed-number n)))
	  (unless (file-exist-p candidate)
	    (setq found (1- n)))
	  (incf n))
	found)))))

(defun bak-shift-file (curr suffix num)
  "e.g: x.bak -> x.bak001"
  (let ((not-yet t)
	(n num))
    (while (> n 0)
      (when (>= n bak-max)
        (delete-file (concat curr suffix (bak-suffixed-number bak-max)))) ; rotate
      (let ((curr (concat curr suffix (bak-suffixed-number n)))
	    (next (concat curr suffix (bak-suffixed-number (1+ n)))))
	(when (file-exist-p next) (error (format nil "already exists ~S" next)))
	(unless (file-exist-p curr) (error (format nil "not exists ~S" curr)))
	(rename-file curr next))
      (decf n)))
  (when (file-exist-p (concat curr suffix))
    (rename-file (concat curr suffix) (concat curr suffix "001"))))

(defun bak-1 (curr suffix)
  (interactive)
  ;(dbg-msgbox (bak-get-oldest-suffix-number curr suffix))
  (let ((new (concat curr suffix)))
    (if (bak-difference-file-p curr new)
        (progn
          (bak-shift-file curr suffix
                          (bak-get-oldest-suffix-number curr suffix))
          (copy-file curr new)    ; original --> ".bak"
          (message "BAKed --> ~S" new))
      (message "file has no changed. so that, no need to backup."))))
    
(defun bak ()
  (interactive)
  (let ((curr (get-buffer-file-name))
	(suffix ".bak"))
    (call-interactively #'(lambda (input)
	(interactive "sBAK as: " :default0 (concat (get-buffer-file-name) ".bak"))
        (unless (string-match (get-buffer-file-name) input) (error "file name will be changed, that is not backup. use `write-file'."))
        (setq suffix (substitute-string input (get-buffer-file-name) ""))
        (bak-1 curr suffix)))))