;;; Version 1.0 by bert, on Sun Aug 27 14:07:50 1995 on IS-DCNSÕs-Macintosh
;;; a trivial revision control system for Emacs

;;; to enable, add this to your .emacs file, with the appropriate path:
;;;
;;;     (autoload 'magic-mode "/path.to.this.file/magic" nil 't)

;;; to use with a single file, add the following lines to the end of the file:
;;;
;;; ### Local variables:
;;; ### mode:magic
;;; ### End:
;;;
;;; Setting magic-comment and other "magic" variables can cause lossage.
;;;
;;; to use with all text files, add the following lines to your .emacs:
;;;
;;;     (setq text-mode-hook '(lambda () (magic-mode)))
;;;
;;; [you can use other mode hooks for non-text modes]

(defvar magic-comment "###"
  "*This is the buffer-local variable storing the starting file comment.
It should consist of three identical characters possibly prefixed by
another, for example \"###\" or \"/***\".")

(defvar magic-update-on-write nil
  "*Should the version be updated on writes, as well as on reads?")

(defvar magic-time-string "\[write-time\]"  ; escapes prevent from losing it
  "*This string is replaced with the time when the document was saved
upon saving.")

(defvar magic-buffers nil
  "A list of all buffers that have been magic'd.
This is used to get around (kill-all-local-variables) cruft...")

(defvar magic-user nil
  "This is the buffer-local variable storing the author's name.")

(defvar magic-user-alist '(("IS DCNS" . nil))
  "This alist maps return values of (user-login-name) to real names,
or nil for bogon return values (like \"IS DCNS\").")

(defvar magic-machine nil
  "This is the (non-buffer-local!) variable storing the machine's name.")

(defvar magic-machine-alist nil
  "This alist maps return values of (system-name) to real names.")

(defvar magic-version nil
  "This is the buffer-local variable storing the file version, as a cons.")

(defvar magic-minor-version-min "0"
  "Where to start minor versions (either \"0\" or \"1\").")

(defvar magic-branch-version-min "1"
  "Where to start branched minor versions (most likely \"1\").")

(defvar magic-hooks-modified nil
  "Have we mucked with hooks yet?")



(defun magic-already-tagged ()
  "Check if the current buffer has already been tagged with a version.
NB: Sets match data and changes point to the start of buffer."
  (goto-char (point-min))
  (looking-at
   "\\(.?\\(.\\)\\2\\2\\) Version \\(\\([0-9]+\\)\\.\\)?\\([0-9]+\\)") )

(defun magic-parse-header ()
  "Parse the version header (if any) and set magic-version and magic-comment.
(magic-comment is set only if there is a header.)"
  (make-variable-buffer-local 'magic-version)
  (make-variable-buffer-local 'magic-comment)
  (save-excursion
    (if (magic-already-tagged)
	(progn
	  (setq magic-comment
		(buffer-substring (match-beginning 1) (match-end 1)))
	  (setq magic-version
	    (if (match-beginning 5)
		(if (match-beginning 3) ;; 4 may be set even if 3 is not!
		    (cons (buffer-substring (match-beginning 5) (match-end 5))
			  (buffer-substring (match-beginning 4) (match-end 4)))
		  (cons (buffer-substring (match-beginning 5) (match-end 5))
			nil) )
	      '("err"))) )
     (setq magic-version '("0"))) ))

(defun magic-default-user ()
  "The default value for the user name.
This is determined from (user-login-name), using magic-user-alist."
  (let* ((login (user-login-name))
	 (ass-val (assoc login magic-user-alist)))
    (cond
     (magic-user magic-user)
     (ass-val  (cdr ass-val))
     ('t       login) )))

(defun magic-user (&optional user)
  "The value for the username.  If the function is called interactively,
or if the optional argument is missing, the user is queried.
If the optional argument is \"\", the default is used.
Otherwise, the username is set to the argument.
This function also sets the variable magic-user."
  (interactive (list (read-string "Username: " (magic-default-user))))
  (let ((user-str (if user user
		    (read-string "Username: " (magic-default-user)))))
    (make-variable-buffer-local 'magic-user)
    (setq magic-user
	  (if (string-equal user-str "") (magic-default-user)
	      user-str)) ))

(defun magic-default-machine ()
  "The default value for the machine name.
This is determined from (system-name), using magic-machine-alist."
  (let* ((mach (system-name))
	 (ass-val (assoc mach magic-machine-alist)))
    (cond
     (magic-machine magic-machine)
     (ass-val  (cdr ass-val))
     ('t       mach) )))

(defun magic-machine (&optional machine)
  "The value for the machine name.  If the function is called interactively,
or if the optional argument is missing, the user is queried.
If the optional argument is \"\", the default is used.
Otherwise, the machine name is set to the argument.
This function also sets the variable magic-machine."
  (interactive (list (read-string "Machine name: " (magic-default-machine))))
  (let ((machine-str (if machine machine
		      (read-string "Machine name: " (magic-default-machine)))))
    (setq magic-machine
	  (if (string-equal machine-str "") (magic-default-machine)
	    machine-str)) ))

(defun magic-inc-version (version)
  "Return the next minor version.  (If only one version number exists, that
one is incremented... surprise =)"
  (let ((num-v (string-to-int (car version))))
    (if (not (string-equal (car version) (int-to-string num-v)))
	(error "Bogus minor version number: \"%s\"" (car version))
      (cons (int-to-string (1+ num-v)) (cdr version))) ))

(defun magic-inc-major-version (version)
  "Return the next major version.  The minor version is set to
magic-minor-version-min (or magic-branch-version-min if there was
only one version number)."
  (let ((ver   (cdr version)))
    (if ver
	(let ((num-v (string-to-int ver)))
	  (if (not (string-equal ver (int-to-string num-v)))
	      (error "Bogus major version number: \"%s\"" ver)
	    (cons magic-minor-version-min (int-to-string (1+ num-v))) ))
      (let ((num-v (string-to-int (car version))))
	(if (not (string-equal (car version) (int-to-string num-v)))
	    (error "Bogus meanor version number: \"%s\"" (car version))
	  (cons magic-branch-version-min (int-to-string num-v)) )) ) ))

(defun magic-format-version (version)
  "Convert the version to a string."
  (if (cdr version)
      (concat (cdr version) "." (car version))
    (car version)))

(defun magic-new-version (&optional major)
  "Add a new version header.  The existing headers are not parsed unless
necessary to determine the version.  With prefix arg, increments the
major version instead of minor."
  (interactive "*P")
  (if (not magic-version) (magic-parse-header))
  (save-excursion
    (make-variable-buffer-local 'magic-version)
    (goto-char (point-min))
    (let ((save-version magic-version)
	  (new-version (if major
			   (magic-inc-major-version magic-version)
			 (magic-inc-version magic-version)))
	  update)
      (unwind-protect
	  (progn
	    (insert (format "%s Version %s by %s, on %s on %s\n%s \n"
			    magic-comment
			    (magic-format-version new-version)
			    (magic-user magic-user)
			    magic-time-string
			    (magic-machine magic-machine)
			    magic-comment))
	    (setq update t) )
	(if update (setq magic-version new-version)) )) ))

;(defun magic-already-magic ()
;  magic-mode)

;(defun magic-set-magic ()
;  (setq magic-mode t))

(defun magic-already-magic ()
  "Has this buffer been magicked yet?"
  (memq (current-buffer) magic-buffers))

(defun magic-set-magic ()
  "Mark this buffer as having been magicked..."
  (setq magic-buffers (magic-purge-buffer-list magic-buffers))
  (if (magic-already-magic) nil
      (setq magic-buffers (cons (current-buffer) magic-buffers)) )
  (setq magic-mode t))

(defun magic-purge-buffer-list (list)
  "Remove dead and dreaming buffers from a list of buffers."
  (if (and (listp list) list)
      (if (and (bufferp (car list)) (buffer-name (car list))) ; valid buffer
	  (cons (car list) (magic-purge-buffer-list (cdr list)))
	(magic-purge-buffer-list (cdr list)))
    nil))

(defun magic-update-time ()
  (save-excursion
    (let ((case-replace nil))
      (goto-char (point-min))
      (replace-string magic-time-string (current-time-string)) )))

(defun magic (&optional arg)
  "Work magic on a buffer (that is, insert a new version header).
With prefix arg, increments major version instead of minor."
  (interactive "P")
  (if buffer-read-only
      (error "Can't work magic with read-only buffers.")
    (magic-parse-header)
    (let ((save-bmp (buffer-modified-p)))
      (unwind-protect
	  (magic-new-version arg)
	(set-buffer-modified-p save-bmp))) ))

(defun magic-mode ()
  "Minor mode for simple version control.
A more detailed description should go here..."
  (interactive)
  (make-variable-buffer-local 'magic-mode)
  (if (not (assoc 'magic-mode minor-mode-alist))
      (setq minor-mode-alist
	    (cons '(magic-mode " Magic") minor-mode-alist)))
  (if (magic-already-magic)
      (progn (setq magic-mode t) (message "Already in \"magic\" minor mode."))
    (magic-set-magic)
    (magic) ))

(if (not magic-hooks-modified)
    (setq write-file-hooks
	  (cons '(lambda () (if magic-mode
				(progn (magic-update-time)
				       (if magic-update-on-write (magic)) )
			      nil))
		write-file-hooks)
	  magic-hooks-modified t) )

;;; Local variables:
;;; mode:magic
;;; End: