;;;; editing-behaviour-log.el -- record how you edit things
;;; Time-stamp: <2005-02-15 11:46:28 john>

;;  This program is free software; you can redistribute it and/or modify it
;;  under the terms of the GNU General Public License as published by the
;;  Free Software Foundation; either version 2 of the License, or (at your
;;  option) any later version.

;;  This program is distributed in the hope that it will be useful, but
;;  WITHOUT ANY WARRANTY; without even the implied warranty of
;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;  General Public License for more details.

;;  You should have received a copy of the GNU General Public License along
;;  with this program; if not, write to the Free Software Foundation, Inc.,
;;  59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

(provide 'editing-behaviour-log)

(defvar editing-behaviour-log nil
  "The log of commands typed, as a list, most recent first.
This variable has a separate value in each buffer.
* If it is nil, no logging is done in that buffer.
* If it is not nil, logging is turned on, and it is a list of log entries.
* self-insert-commands are bunched together into strings of one or more characters.
* Repeats of other commands are represented by (command count).
* Other commands are represented by symbols.
* Integers are buffer positions at which the user switched from moving to changing
* Vectors of two numbers are [ line column ]
* Vectors of three numbers are [ line column point ]
* Other vectors are other things such as annotations.
To start the recording, make this variable non-nil; a list containing a vector
of [remark \"Logging started\"] is a suitable non-nil value.")

(make-variable-buffer-local 'editing-behaviour-log)

(defvar editing-behaviour-logged-files nil
  "The files whose buffers are having their editing behaviour logged.
Useful if we want to save stuff between sessions.")

(defvar editing-behaviour-previous-was-move nil
  "Whether the previous action noticed was a move rather than a change.
This is used so that each contiguous sequence of commands that change
things only gets one position recorded.")

(make-variable-buffer-local 'editing-behaviour-previous-was-move)

(defvar editing-behaviour-command-caused-change nil 
  "Whether the present command caused a change.
Used in the setting of editing-behaviour-previous-was-move.")

(make-variable-buffer-local 'editing-behaviour-command-caused-change)

(defun editing-behaviour-log-latest-command ()
  "Log the latest command."
  (if editing-behaviour-log
      (condition-case error-var
	  (progn
	    (setq editing-behaviour-previous-was-move
		  (not editing-behaviour-command-caused-change))
	    (if (not (member buffer-file-truename editing-behaviour-logged-files))
		(setq editing-behaviour-logged-files
		      (cons buffer-file-truename
			    editing-behaviour-logged-files)))
	    ;; (message "Logging %S" this-command)  
	    (let ((last-entry (if (consp editing-behaviour-log)
				  (car editing-behaviour-log)
				nil)))
	      (cond
	       ((eq this-command 'self-insert-command)
		(let ((char-string (char-to-string last-command-char)))
		  (if (stringp last-entry)
		      (rplaca editing-behaviour-log (concat last-entry char-string))
		    (setq editing-behaviour-log
			  (cons char-string
				editing-behaviour-log)))))
	       ((and (consp last-entry)
		     (eq this-command (car last-entry)))
		(rplaca (cdr last-entry) (1+ (cadr last-entry))))
	       ((and (symbolp last-entry)
		     (eq this-command last-entry))
		(rplaca editing-behaviour-log (list last-entry 2)))
	       (t
		(setq editing-behaviour-log
		      (cons this-command
			    editing-behaviour-log))))))
	(error (message "error in editing-behaviour-log-latest-command")))))

(add-hook 'post-command-hook 'editing-behaviour-log-latest-command)

(defun editing-behaviour-start-command ()
  "Note some information at the start of the command."
  (setq editing-behaviour-command-caused-change nil))

(add-hook 'pre-command-hook 'editing-behaviour-start-command)

(defvar editing-behaviour-log-position-types 'line-col-point
  "*How to record the current position.")

(make-variable-buffer-local 'editing-behaviour-log-position-types)

(defun editing-behaviour-log-latest-position ()
  "Log the latest position."
  (if (and editing-behaviour-log
	   editing-behaviour-previous-was-move
	   editing-behaviour-log-position-types)
      (condition-case error-var
	  (progn
	    (case editing-behaviour-log-position-types
	      (point (setq editing-behaviour-log
			   (cons (point)
				 editing-behaviour-log)))
	      (line-col (setq editing-behaviour-log
			      (cons (vector (count-lines (point-min) (point))
					    (current-column))
				    editing-behaviour-log)))
	      (line-col-point (setq editing-behaviour-log
				    (cons (vector (count-lines (point-min) (point))
						  (current-column)
						  (point))
					  editing-behaviour-log)))))
	(error (message "error in editing-behaviour-log-latest-position")))))

(defun editing-behaviour-log-before-change-function (&optional tweedledum tweedledee)
  "Record a change to the buffer"
  (editing-behaviour-log-latest-position)
  (setq editing-behaviour-command-caused-change t))

(add-hook 'before-change-functions 'editing-behaviour-log-before-change-function)

(defvar editing-behaviour-log-old-value nil
  "The value that editing-behaviour-log had at the time we turned logging off.")

(make-variable-buffer-local 'editing-behaviour-log-old-value)

;;;###autoload
(defun editing-behaviour-log-mode (&optional arg)
  (interactive "p")
  (if (> arg 0)
      (setq editing-behaviour-log (if editing-behaviour-log-old-value
				      editing-behaviour-log-old-value
				    (list (vector 'remark "Logging started"))))
    (setq editing-behaviour-log-old-value editing-behaviour-log
	  editing-behaviour-log nil)
    (message "Editing behaviour logging suspended")))

(defun editing-behaviour-logs-restore (log-list)
  "Restore the editing behaviour logs from LOG-LIST"
  (mapcar (lambda (log)
	    (if (and log (file-exists-p (car log)))
		(save-excursion
		  (find-file (car log))
		  (setq editing-behaviour-log (cdr log)))))
	  log-list))

;;;###autoload
(defun editing-behaviour-log-remark (remark)
  "Enter REMARK into the behaviour log for the current buffer."
  (interactive "sRemark: ")
  (setq editing-behaviour-log
	(cons (vector 'remark remark)
	      editing-behaviour-log)))

;; give it a binding similar to M-; being comment within code
;; this doesn't work, it doesn't like \C-; although describe-key will read that keychord!
;; (if (not (global-key-binding "\C-;")) (global-set-key "\C-;" 'editing-behaviour-log-remark))

;;;###autoload
(defun editing-behaviour-log-gather-remark ()
  "Read a remark from the user, and put it into the editing log for this buffer."
  (interactive)
  (save-window-excursion
    (let ((remark-buffer (get-buffer-create "*Remark*")))
      (switch-to-buffer-other-window remark-buffer)
      (erase-buffer)
      (message "Enter remark; \\[exit-recursive-edit] to return")
      (recursive-edit)
      (set-buffer remark-buffer)
      (editing-behaviour-log-remark (buffer-substring-no-properties
				     (point-min)
				     (point-max))))))

;; todo: command for showing the most recent remark -- could this lead to a "literate editing" style?
;; todo: start a "conscious editing" package?
;; todo: hook for modifying this-command (or maybe do this in "versor"?)
;; todo: mark commands entered by voice, pedals, and by menu if I can find where to do this

;;; end of editing-behavior-log.el