# HG changeset patch
# User Richard M. Stallman <rms@gnu.org>
# Date 902614817 0
# Node ID dd92cb09f5d1c2ce22c751eb3190abf53da41a0f
# Parent  88334ee405a45dff5399d4138e330a96920e9ba1
Initial revision

diff -r 88334ee405a4 -r dd92cb09f5d1 lisp/hilit-chg.el
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/hilit-chg.el	Sat Aug 08 22:20:17 1998 +0000
@@ -0,0 +1,1202 @@
+;;; hilit-chg.el --- minor mode displaying buffer changes with special face
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Richard Sharman <rsharman@magma.ca>
+;; Keywords: faces
+
+;; 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, 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+
+;; A minor mode: "Highlight Changes mode".
+;;
+
+;; Highlight Changes mode has 2 submodes: active and passive.
+;; When active, changes to the buffer are displayed in a different face.
+;; When passive, any existing displayed changes are saved and new ones
+;; recorded but are not displayed differently.
+;; Why active and passive?  Having the changes visible can be handy when you
+;; want the information but very distracting otherwise.  So, you can keep
+;; Highlight Changes mode in passive state while you make your changes, toggle
+;; it on to active mode to see them, then toggle it back off to avoid
+;; distraction.
+;; 
+;; When active, changes are displayed in `highlight-changes-face'.  When
+;; text is deleted,  the following character is displayed in
+;; `highlight-changes-delete-face' face.
+;;
+;;
+;; You can "age" different sets of changes by using
+;; `highlight-changes-rotate-faces'.  This rotates different through a series
+;; of different faces, so you can distinguish "new" changes from "older"
+;; changes.  You can customize these "rotates" faces in two ways.  You can
+;; either explicitly define each face by customizing
+;; `highlight-changes-face-list'.  If, however, the faces differ from
+;; `highlight-changes-face' only in the foreground colour, you can simply set
+;; `highlight-changes-colours'.  If `highlight-changes-face-list' is nil when
+;; the faces are required they will be constructed from
+;; `highlight-changes-colours'.
+;;
+;;
+;; When a Highlight Changes mode is on (either active or passive) you can go
+;; to the next or previous change with `highlight-changes-next-change' and
+;; `highlight-changes-previous-change'.
+;;
+;;
+;; You can also use the command compare-with-file to show changes in this
+;; file compared with another file (typically the previous version of the
+;; file).
+;;
+;;
+;; There are currently three hooks run by `highlight-changes-mode':
+;; `highlight-changes-enable-hook'  - is run when Highlight Changes mode
+;;				    is initially enabled for a buffer.
+;; `highlight-changes-disable-hook' - is run when Highlight Changes mode
+;;				    is turned off.
+;; `highlight-changes-toggle-hook'  - is run each time `highlight-changes-mode'
+;;				    is called.  Typically this is when
+;;				    toggling between active and passive
+;;				    modes.  The variable
+;;				    `highlight-changes-mode' contains the new
+;;				    state (`active' or `passive'.)
+;;				    
+;;
+;; 
+;; Example usage:
+;; (defun my-highlight-changes-enable-hook ()
+;;   (add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)
+;; )
+;; 
+;; (defun my-highlight-changes-disable-hook ()
+;;   (remove-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)
+;; )
+;; 
+;; (add-hook 'highlight-changes-enable-hook 'my-highlight-changes-enable-hook)
+;; (add-hook 'highlight-changes-disable-hook
+;;		'my-highlight-changes-disable-hook)
+
+
+;;           Explciit vs. Implicit
+;;
+
+;; Normally, Highlight Changes mode is turned on explicitly in a buffer.
+;;
+;; If you prefer to have it automatically invoked you can do it as
+;; follows.
+;; 
+;; 1. Most modes have a major-hook, typically called MODE-hook.  You
+;; can use `add-hook' to call `highlight-changes-mode'.  
+;;
+;;   Example:
+;;	(add-hook 'c-mode-hook 'highlight-changes-mode)
+;;
+;;  If you want to make it start up in passive mode (regardless of the
+;;  setting of highlight-changes-initial-state):
+;;      (add-hook 'emacs-lisp-mode-hook 
+;; 	    (lambda ()
+;; 	      (highlight-changes-mode 'passive)))
+;;
+;; However, this cannot be done for Fundamental mode for there is no
+;; such hook.
+;;
+;; 2. You can use the function `global-highlight-changes' 
+;;
+;; This function, which is fashioned after the way `global-font-lock' works,
+;; toggles on or off global Highlight Changes mode.  When activated, it turns
+;; on Highlight Changes mode in all "suitable" existings buffers and will turn
+;; it on in new "suitable" buffers to be created.
+;; 
+;; A buffer's "suitability" is determined by variable
+;; `highlight-changes-global-modes',  as follows.  If the variable is
+;; * nil  -- then no buffers are suitable;
+;; * a function -- this function is called and the result is used.  As
+;;   an example,  if the value is 'buffer-file-name then all buffers
+;;   who are visiting files are suitable, but others (like dired
+;;   buffers) are not;
+;; * a list -- then if the buufer is suitable iff its mode is in the
+;;   list,  exccept if the first element is nil in which case the test
+;;   is reversed (i.e. it is a list of unsuitable modes).
+;; * Otherwise,  the buffer is suitable if its name does not begin with
+;;   ` ' or `*' and if `buffer-file-name' returns true.
+;;
+
+
+
+;;     Possible bindings:
+;; (global-set-key '[C-right] 'highlight-changes-next-change)
+;; (global-set-key '[C-left]  'highlight-changes-previous-change)
+;;
+;;     Other interactive functions (which could be bound if desired):
+;; highlight-changes-mode
+;; highlight-changes-remove-highlight
+;; highlight-changes-rotate-faces
+;; compare-with-file
+
+;; 
+;; You can automatically rotate faces when the buffer is saved;
+;; see function `highlight-changes-rotate-faces' for how to do this.
+;;
+
+
+;;; Bugs:
+
+;; - the next-change and previous-change functions are too literal;
+;;   they should find the next "real" change,  in other words treat
+;;   consecutive changes as one.
+
+
+;;; To do (maybe),  notes, ...
+
+;; - having different faces for deletion and non-deletion: is it
+;;   really worth the hassle?
+;; - should have better hooks:  when should they be run?
+;; - compare-with-file should allow RCS files - e.g. nice to be able
+;;   to say show changes compared with version 2.1.     
+;; - Maybe we should have compare-with-buffer as well.  (When I tried
+;;   a while back I ran into a problem with ediff-buffers-internal.)
+
+
+;;; History:
+
+;; R Sharman (rsharman@magma.ca) Feb 1998:
+;; - initial release as change-mode.
+;; Ray Nickson (nickson@mcs.vuw.ac.nz) 20 Feb 1998: 
+;; - deleting text causes surrounding characters to be highlighted.
+;; - make it only active for the current buffer.
+;; Jari Aalto <jari.aalto@ntc.nokia.com> Mar 1998
+;; - fixes for byte compile errors 
+;; - use eval-and-compile for autoload
+;; Marijn Ros <J.M.Ros@fys.ruu.nl> Mar 98
+;; - suggested turning it on by default
+;; Adrian Bridgett <adrian.bridgett@zetnet.co.uk> June 98:
+;; - make hide/unhide not affect the buffer modified status
+;; Eric Ludlam <zappo@gnu.org> Suggested using overlays.
+;; July 98
+;; - global mode and various stuff added
+;; - Changed to use overlays
+;; August 98
+;; - renmaed to Highlight Changes mode.
+
+
+;;; Code:
+
+;; ========== Remove when undo-in-progress is set by emacs ========
+(unless (boundp 'undo-in-progress)
+  (message "advising undo...")
+  (eval-when-compile (require 'advice))
+  (defvar undo-in-progress nil) ;; only undo should change this!
+  (defadvice undo (around record-this-is-an-undo activate)
+    (let ((undo-in-progress t))
+      ad-do-it)))
+;; ================================================================
+
+(require 'wid-edit)
+
+;; ====================== Customization =======================
+(defgroup highlight-changes nil
+  "Highlight Changes mode."
+  :group 'faces)
+
+
+;; Face information: How the changes appear.
+
+;; Defaults for face: red foreground, no change to background,
+;; and underlined if a change is because of a deletion.
+;; Note: underlining is helpful in that is shows up changes in white space.
+;; However, having it set for non-delete changes can be annoying because all
+;; indentation on inserts gets underlined (which can look pretty ugly!).
+
+(defface highlight-changes-face
+  '((((class color)) (:foreground "red" ))
+    (t (:inverse-video t)))
+  "Face used for highlighting changes."
+  :group 'highlight-changes
+  )
+
+;; This looks pretty ugly, actually.  Maybe the underline should be removed.
+(defface highlight-changes-delete-face
+  '((((class color)) (:foreground "red" :underline t))
+    (t (:inverse-video t)))
+  "Face used for highlighting deletions."
+  :group 'highlight-changes
+  )
+
+
+
+;; A (not very good) default list of colours to rotate through.
+;;
+(defcustom highlight-changes-colours 
+  (if (eq (frame-parameter nil 'background-mode) 'light)
+      ;; defaults for light background:
+      '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue")
+      ;; defaults for dark background:
+    '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid"))
+  "*Colours used by `highlight-changes-rotate-faces'.
+The newest rotated change will be displayed in the first element of this list, 
+the next older will be in the second element etc.
+
+This list is used if `highlight-changes-face-list' is nil,  otherwise that
+variable overrides this list.   If you only care about foreground
+colours then use this,  if you want fancier faces then set
+`highlight-changes-face-list'."
+   :type '(repeat color)
+  :group 'highlight-changes
+  )
+ 
+
+;; If you invoke highlight-changes-mode with no argument,  should it start in
+;; active or passive mode?
+;;
+(defcustom highlight-changes-initial-state 'active
+  "*What state (active or passive) `highlight-changes' should start in.
+This is used when `highlight-changes' is called with no argument.
+This variable must be set to one of the symbols `active' or `passive'."
+  :type '(choice (const :tag "Active" active)
+		 (const :tag "Passive" passive))
+  :group 'highlight-changes
+  )
+
+(defcustom highlight-changes-global-initial-state 'passive
+  "*What state `global-highlight-changes' should start in.
+This is used if `global-highlight-changes' is called with no argument.
+This variable must be set to either `active' or `passive'"
+  :type '(choice (const :tag "Active" active)
+		 (const :tag "Passive" passive))
+  :group 'highlight-changes
+  )
+
+;; The strings displayed in the mode-line for the minor mode:
+(defcustom highlight-changes-active-string nil
+  "*The string used when Highlight Changes mode is in the active state.
+This should be set to nil if no indication is desired,  or to
+a string with a leading space."
+  :type '(choice string
+		 (const :tag "None"  nil))
+  :group 'highlight-changes
+  )
+
+(defcustom highlight-changes-passive-string " Chg"
+  "*The string used when Highlight Changes mode is in the passive state.
+This should be set to nil if no indication is desired,  or to
+a string with a leading space."
+  :type '(choice string
+		 (const :tag "None"  nil))
+  :group 'highlight-changes
+  )
+
+(defcustom highlight-changes-global-modes t
+  "*Determine whether a buffer is suitable for global Highlight Changes mode.
+
+A function means that function is called:  if it returns non-nil the
+buffer is suitable.
+
+A list is a list of modes for which it is suitable,  or a list whose
+first element is 'not followed by modes which are not suitable.
+
+t means the buffer is suitable if its name does not begin with ` ' nor
+`*' and the buffer has a filename.
+
+nil means no buffers are suitable for `global-highlight-changes'
+(effectively disabling the mode).
+
+Examples:
+        (c-mode c++-mode)
+means that Highlight Changes mode is turned on for buffers in C and C++
+modes only."
+  :type '(choice 
+	  (const :tag "all non-special buffers visiting files" t)
+	  (set :menu-tag "specific modes" :tag "modes"
+	       :value (not)
+	       (const :tag "All except these" not)
+	       (repeat :tag "Modes" :inline t (symbol :tag "mode")))
+	  (function :menu-tag "determined by function"
+			   :value buffer-file-name)
+	  (const :tag "none" nil)
+	  )
+  :group 'highlight-changes
+  )
+
+
+(defvar global-highlight-changes nil)
+
+(defcustom highlight-changes-global-changes-existing-buffers nil
+  "*If non-nil toggling global Highlight Changes mode affects existing buffers.
+Normally, `global-highlight-changes' means affects only new buffers (to be
+created).  However, if highlight-changes-global-changes-existing-buffers
+is non-nil then turning on `global-highlight-changes' will turn on
+highlight-changes-mode in suitable buffers and turning the mode off will
+remove it from existing buffers."
+  :type 'boolean
+  :group 'highlight-changes)
+
+(defun hilit-chg-cust-fix-changes-face-list (w wc &optional event)
+  ;; When customization function `highlight-changes-face-list' inserts a new
+  ;; face it uses the default face.   We don't want the user to modify this
+  ;; face,  so we rename the faces in the list on an insert.  The rename is
+  ;; actually done by copying the faces so user-defined faces still remain
+  ;; in the same order.
+  ;; The notifying the parent is needed because without it changes to the
+  ;; faces are saved but not to the actual list itself.
+  (let ((old-list (widget-value w)))
+    (if (member 'default old-list)
+	(let
+	    ((p (reverse old-list))
+	     (n (length old-list))
+	     new-name old-name
+	     (new-list nil)
+	     )
+	  (while p
+	    (setq old-name (car p))
+	    (setq new-name (intern (format "highlight-changes-face-%d" n)))
+	    (if (eq old-name new-name)
+		nil
+	      ;; A new face has been inserted: we don't want to modify the
+	      ;; default face so copy it.   Better, though, (I think) is to
+	      ;; make a new face have the same attributes as
+	      ;; highlight-changes-face .
+	      (if (eq old-name 'default)
+		  (copy-face 'highlight-changes-face  new-name)
+		(copy-face old-name new-name)
+		))
+	    (setq new-list (append  (list new-name) new-list))
+	    (setq n (1- n))
+	    (setq p (cdr p)))
+	  (if (equal new-list (widget-value w))
+	      nil ;; (message "notify: no change!")
+	    (widget-value-set w new-list)
+	    (widget-setup)
+	    )
+	  )
+      ;; (message "notify: no default here!")
+      ))
+  (let ((parent (widget-get w :parent)))
+    (when parent
+      (widget-apply parent :notify w event)))
+    )
+
+
+(defcustom highlight-changes-face-list nil
+  "*A list of faces used when rotatating changes.
+Normally the variable is initialized to nil and the list is created from
+`highlight-changes-colours' when needed.  However, you can set this variable
+to any list of faces.  You will have to do this if you want faces which
+don't just differ from `highlight-changes-face' by the foreground colour.
+Otherwise, this list will be constructed when needed from
+`highlight-changes-colours'."
+  :type '(choice
+	  (repeat 
+	    :notify hilit-chg-cust-fix-changes-face-list
+	    face  )
+	  (const :tag "Derive from highlight-changes-colours"  nil)
+	  )
+  :group 'highlight-changes
+  )
+
+;; ========================================================================
+
+;; These shouldn't be changed!
+
+(defvar highlight-changes-mode nil)
+(defvar hilit-chg-list nil)
+(defvar hilit-chg-string " ??")
+(or (assq 'highlight-changes-mode minor-mode-alist)
+    (setq minor-mode-alist
+	  (cons '(highlight-changes-mode hilit-chg-string) minor-mode-alist)
+	  ))
+(make-variable-buffer-local 'highlight-changes-mode)
+(make-variable-buffer-local 'hilit-chg-string)
+
+
+
+(eval-and-compile
+  ;;  For compare-with-file
+  (defvar ediff-number-of-differences)
+  (autoload 'ediff-setup		"ediff")
+  (autoload 'ediff-with-current-buffer	"ediff")
+  (autoload 'ediff-really-quit		"ediff")
+  (autoload 'ediff-make-fine-diffs	"ediff")
+  (autoload 'ediff-get-fine-diff-vector "ediff")
+  (autoload 'ediff-get-difference	"ediff")
+  )
+
+
+
+;;; Functions...
+
+(defun hilit-chg-map-changes  (func &optional start-position end-position)
+  "Call function FUNC for each region used by Highlight Changes mode."
+  ;; if start-position is nil, (point-min) is used
+  ;; if end-position is nil, (point-max) is used
+  ;; FUNC is called with 3 params: property start stop
+  (let ((start (or start-position (point-min)))
+	(limit (or end-position (point-max)))
+	prop end)
+    (while (and start (< start limit))
+      (setq prop (get-text-property start 'hilit-chg))
+      (setq end (text-property-not-all start limit 'hilit-chg prop))
+      (if prop
+	  (funcall func prop start (or end limit)))
+      (setq start end)
+      )))
+
+
+(defun hilit-chg-display-changes (&optional beg end)
+  "Display face information for Highlight Changes mode.
+
+An overlay containing a change face is added,  from the information
+in the text property of type change.
+
+This is the opposite of hilit-chg-hide-changes."
+  (hilit-chg-map-changes 'hilit-chg-make-ov beg end))
+
+
+(defun hilit-chg-make-ov (prop start end)
+  ;; for the region make change overlays corresponding to
+  ;; the text property 'hilit-chg
+  (let ((ov (make-overlay start end))
+	face)
+    (or prop
+	(error "hilit-chg-make-ov: prop is nil"))
+    (if (eq prop 'hilit-chg-delete)
+	(setq face 'highlight-changes-delete-face)
+      (setq face (nth 1 (member prop hilit-chg-list))))
+    (if face
+	(progn
+	  ;; We must mark the face,  that is the purpose of the overlay
+	  (overlay-put ov 'face face)
+	  ;; I don't think we need to set evaporate since we should
+	  ;; be controlling them!
+	  (overlay-put ov 'evaporate t)
+	  ;; We set the change property so we can tell this is one
+	  ;; of our overlays (so we don't delete someone else's).
+	  (overlay-put ov 'hilit-chg t)
+	  )
+      (error "hilit-chg-make-ov: no face for prop: %s" prop)
+      )
+    ))
+
+(defun hilit-chg-hide-changes (&optional beg end)
+  "Remove face information for Highlight Changes mode.
+
+The overlay containing the face is removed,  but the text property
+containing the change information is retained.
+
+This is the opposite of hilit-chg-display-changes."
+  (let ((start (or beg (point-min)))
+	(limit (or end (point-max)))
+	p ov)
+    (setq p (overlays-in start limit))
+    (while p
+      ;; don't delete the overlay if it isn't ours!
+      (if (overlay-get (car p) 'hilit-chg)
+	  (delete-overlay (car p)))
+      (setq p (cdr p))
+      )))
+
+(defun hilit-chg-fixup (beg end)
+  "Fix change overlays in region beg .. end.
+
+Ensure the overlays agree with the changes as determined from
+the text properties of type `hilit-chg' ."
+  ;; Remove or alter overlays in region beg..end
+  (let (p ov ov-start ov-end
+	 props q)
+    (setq p (overlays-in beg end))
+    ;; temp for debugging:
+    ;; (or (eq highlight-changes-mode 'active)
+    ;;	 (error "hilit-chg-fixup called but Highlight Changes mode not active"))
+    (while p
+      (setq ov (car p))
+      (setq ov-start (overlay-start ov))
+      (setq ov-end (overlay-end ov))
+      (if (< ov-start beg)
+	  (progn
+	    (move-overlay ov ov-start beg)
+	    (if (> ov-end end)
+		(progn
+		  (setq props (overlay-properties ov))
+		  (setq ov (make-overlay end ov-end))
+		  (while props
+		    (overlay-put ov (car props)(car (cdr props)))
+		    (setq props (cdr (cdr props))))
+		  )
+	      )
+	    )
+	(if (> ov-end end)
+	    (move-overlay ov end ov-end)
+	  (delete-overlay ov)
+	  ))
+      (setq p (cdr p)))
+    (hilit-chg-display-changes beg end)
+    ))
+
+
+
+
+
+
+;;;###autoload
+(defun highlight-changes-remove-highlight (beg end) 
+  "Remove the change face from the region.  
+This allows you to manually remove highlighting from uninteresting changes."
+  (interactive "r")
+  (let ((after-change-functions nil))
+    (remove-text-properties beg end  '(hilit-chg nil))
+    (hilit-chg-fixup beg end)))
+
+(defun hilit-chg-set-face-on-change (beg end leng-before 
+	&optional no-proerty-change)
+  "Record changes and optionally display them in a distinctive face.
+`hilit-chg-set' adds this function to the `after-change-functions' hook."
+  ;;
+  ;; This function is called by the `after-change-functions' hook, which
+  ;; is how we are notified when text is changed.
+  ;; It is also called from `compare-with-file'.
+  ;;
+  ;; We do NOT want to simply do this if this is an undo command, because
+  ;; otherwise an undone change shows up as changed.  While the properties
+  ;; are automatically restored by undo,  we must fixup the overlay.
+  (save-match-data
+    (let ((beg-decr 1) (end-incr 1)
+	  (type 'hilit-chg)
+	  old)
+      (if undo-in-progress
+	  (if (eq highlight-changes-mode 'active)
+	      (hilit-chg-fixup beg end))
+	(if (and (= beg end) (> leng-before 0))
+	    ;; deletion
+	    (progn
+	      ;; The eolp and bolp tests are a kludge!  But they prevent
+	      ;; rather nasty looking displays when deleting text at the end 
+	      ;; of line,  such as normal corrections as one is typing and
+	      ;; immediately makes a corrections,  and when deleting first
+	      ;; character of a line.
+;;;	      (if (= leng-before 1)
+;;;		  (if (eolp)
+;;;		      (setq beg-decr 0 end-incr 0)
+;;;		    (if (bolp)
+;;;			(setq beg-decr 0))))
+;;;	      (setq beg (max (- beg beg-decr) (point-min)))
+	      (setq end (min (+ end end-incr) (point-max)))
+	      (setq type 'hilit-chg-delete))
+	  ;; Not a deletion.
+	  ;; Most of the time the following is not necessary,  but
+	  ;; if the current text was marked as a deletion then
+	  ;; the old overlay is still in effect, so if we add some
+	  ;; text then remove the deletion marking,  but set it to
+	  ;; changed otherwise its highlighting disappears.
+	  (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)
+	      (progn
+		(remove-text-properties end (+ end 1) '(hilit-chg nil))
+		(put-text-property end (+ end 1) 'hilit-chg 'hilit-chg)
+		(if (eq highlight-changes-mode 'active)
+		    (hilit-chg-fixup beg (+ end 1))))))
+	(unless no-proerty-change
+		(put-text-property beg end 'hilit-chg type))
+	(if (or (eq highlight-changes-mode 'active) no-proerty-change)
+	    (hilit-chg-make-ov type beg end))
+	))))
+
+
+
+
+
+(defun hilit-chg-set (value)
+  "Turn on Highlight Changes mode for this buffer."
+  (setq highlight-changes-mode value)
+  (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)
+  (hilit-chg-make-list)
+  (if (eq highlight-changes-mode 'active)
+      (progn
+	(setq hilit-chg-string highlight-changes-active-string)
+	(or buffer-read-only
+	    (hilit-chg-display-changes)))
+    ;; mode is passive
+    (setq hilit-chg-string highlight-changes-passive-string)
+    (or buffer-read-only
+	(hilit-chg-hide-changes))
+    )
+  (force-mode-line-update)
+  (make-local-hook 'after-change-functions)
+  (add-hook 'after-change-functions 'hilit-chg-set-face-on-change nil t)
+  )
+
+(defun hilit-chg-clear ()
+  "Remove Highlight Changes mode for this buffer.
+This removes all saved change information."
+  (if buffer-read-only
+      ;; We print the buffer name because this function could be called
+      ;; on many buffers from `global-highlight-changes'.
+      (message "Cannot remove highlighting from read-only mode buffer %s"
+	       (buffer-name))
+    (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)
+    (let ((after-change-functions nil))
+      (hilit-chg-hide-changes)
+      (hilit-chg-map-changes 
+       '(lambda (prop start stop)
+	  (remove-text-properties start stop '(hilit-chg nil))))
+      )
+    (setq highlight-changes-mode nil)
+    (force-mode-line-update)
+    ;; If we type:  C-u -1 M-x highlight-changes-mode
+    ;; we want to turn it off,  but hilit-chg-post-command-hook
+    ;; runs and that turns it back on!
+    (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)
+    ))
+
+;;;###autoload
+(defun highlight-changes-mode (&optional arg)
+  "Toggle (or initially set) Highlight Changes mode.
+
+Without an argument,  
+  if Highlight Changes mode is not enabled, then enable it (to either active
+  or passive as determined by variable highlight-changes-initial-state);
+  otherwise, toggle between active and passive states.
+
+With an argument,
+  if just C-u  or  a positive argument,  set state to active;
+  with a zero argument,  set state to passive;
+  with a negative argument,  disable Highlight Changes mode completely.
+
+Active state -  means changes are shown in a distinctive face.
+Passive state - means changes are kept and new ones recorded but are
+		not displayed in a different face.
+
+Functions:
+\\[highlight-changes-next-change] - move point to beginning of next change
+\\[highlight-changes-previous-change] - move to beginning of previous change 
+\\[compare-with-file] - mark text as changed by comparing this buffer with
+	the contents of a file
+\\[highlight-changes-remove-highlight] - remove the change face from the region
+\\[highlight-changes-rotate-faces] - rotate different \"ages\" of changes \
+through 
+	various faces.
+
+
+Hook variables:
+highlight-changes-enable-hook - when Highlight Changes mode enabled.
+highlight-changes-toggle-hook - when entering active or passive state
+highlight-changes-disable-hook - when turning off Highlight Changes mode.
+"
+  (interactive "P")
+  (if window-system
+      (let ((was-on highlight-changes-mode)
+	    (new-highlight-changes-mode
+	     (cond
+	      ((null arg)
+	       ;; no arg => toggle (or set to active initially)
+	       (if highlight-changes-mode
+		   (if (eq highlight-changes-mode 'active) 'passive 'active)
+		 highlight-changes-initial-state))
+	      ;; an argument is given
+	      ((eq arg 'active)
+	       'active)
+	      ((eq arg  'passive)
+	       'passive)
+	      ((> (prefix-numeric-value arg) 0)
+	       'active)
+	      ((< (prefix-numeric-value arg) 0)
+	       nil)
+	      (t
+	       'passive)
+	      )))
+	(if new-highlight-changes-mode
+	    ;; mode is turned on -- but may be passive
+	    (progn
+	      (hilit-chg-set new-highlight-changes-mode)
+	      (or was-on
+		  ;; run highlight-changes-enable-hook once
+		  (run-hooks 'highlight-changes-enable-hook))
+	      (run-hooks 'highlight-changes-toggle-hook))
+	  ;; mode is turned off
+	  (run-hooks 'highlight-changes-disable-hook)
+	  (hilit-chg-clear))
+	)
+    (message "Highlight Changes mode only works when using a window system"))
+  )
+
+
+
+;;;###autoload
+(defun highlight-changes-next-change ()
+  "Move to the beginning of the next change, if in Highlight Changes mode."
+  (interactive)
+  (if highlight-changes-mode
+      (let ((start (point))
+	    prop)
+	(setq prop (get-text-property (point) 'hilit-chg))
+	(if prop
+	    ;; we are in a change
+	    (setq start (next-single-property-change (point) 'hilit-chg)))
+	(if start
+	    (setq start (next-single-property-change start 'hilit-chg)))
+	(if start
+	    (goto-char start)
+	  (message "no next change")))
+    (message "This buffer is not in Highlight Changes mode.")))
+
+
+;;;###autoload
+(defun highlight-changes-previous-change ()
+  "Move to the beginning of the previous change, if in Highlight Changes mode."
+  (interactive)
+  (if highlight-changes-mode
+      (let ( (start (point)) (prop nil) )
+	(or (bobp)
+	    (setq prop (get-text-property (1- (point)) 'hilit-chg)))
+	(if prop
+	    ;; we are in a change
+	    (setq start (previous-single-property-change (point) 'hilit-chg)))
+	(if start
+	    (setq start (previous-single-property-change start 'hilit-chg)))
+	;; special handling for the case where (point-min) is a change
+	(if start
+	    (setq start (or (previous-single-property-change start 'hilit-chg)
+			    (if (get-text-property (point-min) 'hilit-chg)
+				(point-min)))))
+	(if start
+	    (goto-char start)
+	  (message "no previous change")))
+    (message "This buffer is not in Highlight Changes mode.")))
+
+
+;; ========================================================================
+
+
+(defun hilit-chg-make-list (&optional force)
+  "Construct hilit-chg-list and highlight-changes-face-list."
+  ;; Constructs highlight-changes-face-list if necessary,  
+  ;; and hilit-chg-list always:
+  ;; Maybe this should always be called when rotating a face
+  ;; so we pick up any changes?
+  (if (or (null highlight-changes-face-list)  ; Don't do it if it
+	  force) ; already exists unless FORCE non-nil.
+      (let ((p highlight-changes-colours) 
+	    (n 1) name)
+	(setq highlight-changes-face-list nil)
+	(while p
+	  (setq name (intern (format "highlight-changes-face-%d" n)))
+	  (copy-face 'highlight-changes-face name)
+	  (set-face-foreground name (car p))
+	  (setq highlight-changes-face-list 
+		(append highlight-changes-face-list (list name)))
+	  (setq p (cdr p))
+	  (setq n (1+ n)))))
+  (setq hilit-chg-list (list 'hilit-chg 'highlight-changes-face))
+  (let ((p highlight-changes-face-list)
+	(n 1) 
+	last-category last-face)
+    (while p
+      (setq last-category (intern (format "change-%d" n)))
+      ;; (setq last-face (intern (format "highlight-changes-face-%d" n)))
+      (setq last-face (car p))
+      (setq hilit-chg-list
+	    (append hilit-chg-list
+		    (list last-category last-face)))
+      (setq p (cdr p))
+      (setq n (1+ n)))
+    (setq hilit-chg-list
+	  (append hilit-chg-list
+		  (list last-category last-face)))
+    ))
+
+
+(defun hilit-chg-bump-change (prop start end)
+  "Increment (age) the Highlight Changes mode text property of type change."
+  (let ( new-prop )
+    (if (eq prop 'hilit-chg-delete)
+	(setq new-prop (nth 2 hilit-chg-list))
+      (setq new-prop (nth 2 (member prop hilit-chg-list)))
+      )
+    (if prop
+	(put-text-property start end 'hilit-chg new-prop)
+      (message "%d-%d unknown property %s not changed" start end prop)
+      )
+    ))
+
+;;;###autoload
+(defun highlight-changes-rotate-faces ()
+  "Rotate the faces used by Highlight Changes mode.
+
+Current changes will be display in the face described by the first element
+of highlight-changes-face-list, those (older) changes will be shown in the
+face described by the second element, and so on.  Very old changes remain
+shown in the last face in the list.
+
+You can automatically rotate colours when the buffer is saved
+by adding this to local-write-file-hooks,  by evaling (in the
+buffer to be saved):
+  (add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)
+"
+  (interactive)
+  ;; If not in active mode do nothing but don't complain because this
+  ;; may be bound to a hook.
+  (if (eq highlight-changes-mode 'active)
+      (let ((after-change-functions nil))
+	;; ensure hilit-chg-list is made and up to date
+	(hilit-chg-make-list)
+	;; remove our existing overlays
+	(hilit-chg-hide-changes)
+	;; for each change text property, increment it
+	(hilit-chg-map-changes 'hilit-chg-bump-change)
+	;; and display them all if active
+	(if (eq highlight-changes-mode 'active)
+	    (hilit-chg-display-changes))
+	))
+  ;; This always returns nil so it is safe to use in
+  ;; local-write-file-hook
+  nil)
+
+
+;; ========================================================================
+;; Comparing with an existing file.   
+;; This uses ediff to find the differences.
+
+;;;###autoload
+(defun compare-with-file (file-b)
+  "Compare this buffer with a file.
+
+The current buffer must be an unmodified buffer visiting a file,
+and not in read-only mode.
+
+If the backup filename exists, it is used as the default
+when called interactively.
+
+If a buffer is visiting the file being compared against,  it also will
+have its differences highlighted.   Otherwise, the file is read in
+temporarily but the buffer is deleted.
+
+If a buffer is read-only,  differences will be highlighted but no property
+changes made,  so \\[highlight-changes-next-change] and
+\\[highlight-changes-previous-change] will not work."
+  (interactive (list
+	      (read-file-name
+	       "File to compare with? " ;; prompt
+	       ""			;; directory
+	       nil			;; default
+	       'yes			;; must exist
+	       (let ((f (make-backup-file-name 
+			 (or (buffer-file-name (current-buffer))
+			     (error "no file for this buffer")))))
+		 (if (file-exists-p f) f ""))
+	       )))
+
+  (let* ((buf-a (current-buffer))
+	 (buf-a-read-only buffer-read-only)
+	 (orig-pos (point))
+	 (file-a (buffer-file-name))
+	 (existing-buf (get-file-buffer file-b))
+	 (buf-b (or existing-buf
+		    (find-file-noselect file-b)))
+	 (buf-b-read-only (with-current-buffer buf-b buffer-read-only))
+	 xy  xx yy p q
+	 a-start a-end len-a
+	 b-start b-end len-b
+	 )
+
+    ;; We use the fact that the buffer is not marked modified at the
+    ;; end where we clear its modified status
+    (if (buffer-modified-p buf-a)
+	(if (y-or-n-p (format "OK to save %s?  " file-a))
+		       (save-buffer buf-a)
+	  (error "Buffer must be saved before comparing with a file.")))
+    (if (and existing-buf (buffer-modified-p buf-b))
+	(if (y-or-n-p (format "OK to save %s?  " file-b))
+		       (save-buffer buf-b)
+	  (error "Cannot compare with a file in an unsaved buffer.")))
+    (highlight-changes-mode 'active)
+    (if existing-buf (with-current-buffer buf-b
+		       (highlight-changes-mode 'active)))
+    (save-window-excursion
+      (setq xy (hilit-chg-get-diff-info buf-a file-a buf-b file-b)))
+    (setq xx (car xy))
+    (setq p xx)
+    (setq yy (car (cdr xy)))
+    (setq q yy)
+    (hilit-chg-make-list)
+    (while p
+      (setq a-start (nth 0 (car p)))
+      (setq a-end (nth 1 (car p)))
+      (setq b-start (nth 0 (car q)))
+      (setq b-end (nth 1 (car q)))
+      (setq len-a (- a-end a-start))
+      (setq len-b (- b-end b-start))
+      (set-buffer buf-a)
+      (hilit-chg-set-face-on-change a-start a-end len-b buf-a-read-only)
+      (set-buffer-modified-p nil)
+      (goto-char orig-pos)
+      (if existing-buf
+	  (with-current-buffer buf-b
+	    (hilit-chg-set-face-on-change b-start b-end len-a
+					  buf-b-read-only )
+	    ))
+      (setq p (cdr p))
+      (setq q (cdr q))
+      )
+    (if existing-buf
+	(set-buffer-modified-p nil) 
+      (kill-buffer buf-b))
+    ))
+
+
+(defun hilit-chg-get-diff-info (buf-a file-a buf-b file-b)
+  (let ((e nil) x y)   ;; e is set by function hilit-chg-get-diff-list-hk
+    (ediff-setup buf-a file-a buf-b file-b
+	       nil nil   ; buf-c file-C
+	       'hilit-chg-get-diff-list-hk
+	       (list (cons 'ediff-job-name 'something))
+	       )
+    (ediff-with-current-buffer e (ediff-really-quit nil))
+    (list x y)))
+
+
+(defun hilit-chg-get-diff-list-hk ()
+  ;; x and y are dynamically bound by hilit-chg-get-diff-info 
+  ;; which calls this function as a hook
+  (defvar x)  ;; placate the byte-compiler
+  (defvar y)
+  (setq  e (current-buffer))
+  (let ((n 0) extent p va vb a b)
+    (setq  x nil  y nil)    ;; x and y are bound by hilit-chg-get-diff-info
+    (while (< n ediff-number-of-differences)
+      (ediff-make-fine-diffs n)
+      (setq va (ediff-get-fine-diff-vector n 'A))
+      ;; va is a vector if there are fine differences
+      (if va
+	  (setq a (append va nil))
+	;; if not,  get the unrefined difference
+	(setq va (ediff-get-difference n 'A))
+	(setq a (list (elt va 0)))
+	)
+      ;; a list a list
+      (setq p a)
+      (while p
+	(setq extent (list (overlay-start (car p))
+			   (overlay-end (car p))))
+	(setq p (cdr p))
+	(setq x (append x (list extent) ))
+	);; while p
+      ;;
+      (setq vb (ediff-get-fine-diff-vector n 'B))
+      ;; vb is a vector
+      (if vb
+	  (setq b (append vb nil))
+	;; if not,  get the unrefined difference
+	(setq vb (ediff-get-difference n 'B))
+	(setq b (list (elt vb 0)))
+	)
+      ;; b list a list
+      (setq p b)
+      (while p
+	(setq extent (list (overlay-start (car p))
+			   (overlay-end (car p))))
+	(setq p (cdr p))
+	(setq y (append y (list extent) ))
+	);; while p
+      ;;
+      (setq n (1+ n))
+      );; while
+    ;; ediff-quit doesn't work here.
+    ;; No point in returning a value, since this is a hook function.
+    ))
+
+;; ======================= automatic stuff ==============
+
+;; Global Highlight Changes mode is modelled after Global Font-lock mode.
+;; Three hooks are used to gain control.  When Global Changes Mode is
+;; enabled, `find-file-hooks' and `change-major-mode-hook' are set.
+;; `find-file-hooks' is called when visiting a file,  the new mode is
+;; known at this time.
+;; `change-major-mode-hook' is called when a buffer is changing mode.
+;; This could be because of finding a file in which case
+;; `find-file-hooks' has already been called and has done its work.
+;; However, it also catches the case where a new mode is being set by
+;; the user.  However, it is called from `kill-all-variables' and at
+;; this time the mode is the old mode,  which is not what we want.
+;; So,  our function temporarily sets `post-command-hook' which will
+;; be called after the buffer has been completely set up (with the new
+;; mode).  It then removes the `post-command-hook'.
+;; One other wrinkle - every M-x command runs the `change-major-mode-hook'
+;; so we ignore this by examining the buffer name.
+
+
+(defun hilit-chg-major-mode-hook ()
+  (add-hook 'post-command-hook 'hilit-chg-post-command-hook)
+  )
+
+(defun hilit-chg-post-command-hook ()
+  ;; This is called after changing a major mode, but also after each
+  ;; M-x command,  in which case the current buffer is a minibuffer.
+  ;; In that case, do not act on it here,  but don't turn it off
+  ;; either,  we will get called here again soon-after. 
+  ;; Also,  don't enable it for other special buffers.
+  (if (string-match "^[ *]"  (buffer-name))
+      nil ;; (message "ignoring this post-command-hook")
+    (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)
+    ;; The following check isn't necessary,  since 
+    ;; hilit-chg-turn-on-maybe makes this check too.
+    (or highlight-changes-mode	;; don't turn it on if it already is
+	(hilit-chg-turn-on-maybe highlight-changes-global-initial-state))
+    ))
+
+(defun hilit-chg-check-global ()
+  ;; This is called from the find file hook.
+  (hilit-chg-turn-on-maybe highlight-changes-global-initial-state))
+
+
+
+;;;###autoload
+(defun global-highlight-changes (&optional arg)
+  "Turn on or off global Highlight Changes mode.
+
+When called interactively:
+- if no prefix, toggle global Highlight Changes mode on or off
+- if called with a positive prefix (or just C-u) turn it on in active mode
+- if called with a zero prefix  turn it on in passive mode
+- if called with a negative prefix turn it off
+
+When called from a program:
+- if ARG is nil or omitted, turn it off
+- if ARG is 'active,  turn it on in active mode
+- if ARG is 'passive, turn it on in passive mode
+- otherwise just turn it on 
+
+When global Highlight Changes mode is enabled, Highlight Changes mode is turned
+on for future \"suitable\" buffers (and for \"suitable\" existing buffers if
+variable `highlight-changes-global-changes-existing-buffers' is non-nil).
+\"Suitablity\" is determined by variable `highlight-changes-global-modes'."
+
+  (interactive 
+   (list
+    (cond
+     ((null current-prefix-arg)
+      ;; no arg => toggle it on/off
+      (setq global-highlight-changes (not global-highlight-changes)))
+     ;; positive interactive arg - turn it on as active
+     ((> (prefix-numeric-value current-prefix-arg) 0)
+      (setq global-highlight-changes t)
+      'active)
+     ;; zero interactive arg - turn it on as passive
+     ((= (prefix-numeric-value current-prefix-arg) 0)
+      (setq global-highlight-changes t)
+      'passive)
+     ;; negative interactive arg - turn it off
+     (t
+      (setq global-highlight-changes nil)      
+      nil))))
+
+  (if arg
+      (progn
+	(if (eq arg 'active)
+	    (setq highlight-changes-global-initial-state 'active)
+	  (if (eq arg  'passive)
+	      (setq highlight-changes-global-initial-state 'passive)))
+	(setq global-highlight-changes t)
+	(message "turning ON Global Highlight Changes mode in %s state"
+		 highlight-changes-global-initial-state)
+	(add-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)
+	(add-hook 'find-file-hooks 'hilit-chg-check-global)
+	(if highlight-changes-global-changes-existing-buffers
+	    (hilit-chg-update-all-buffers 
+	     highlight-changes-global-initial-state))
+	)
+    (message "turning OFF global Highlight Changes mode")
+    (remove-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)
+    (remove-hook 'find-file-hooks 'hilit-chg-check-global)
+    (remove-hook 'post-command-hook
+		 'hilit-chg-post-command-hook)
+    (remove-hook 'find-file-hooks 'hilit-chg-check-global)
+    (if highlight-changes-global-changes-existing-buffers
+	(hilit-chg-update-all-buffers nil))
+    )
+  )
+
+
+
+
+
+(defun hilit-chg-turn-on-maybe (value)
+  "Turn on Highlight Changes mode if it is appropriate for this buffer.
+
+A buffer is appropriate for Highlight Changes mode if all these are true:
+- the buffer is not a special buffer (one whose name begins with 
+  `*' or ` ')
+- the buffer's mode is suitable as per variable highlight-changes-global-modes
+- Highlight Changes mode is not already on for this buffer.
+
+This function is called from hilit-chg-update-all-buffers 
+from `global-highlight-changes' when turning on global Highlight Changes mode.
+"
+  (or highlight-changes-mode			; do nothing if already on
+      (if
+	  (cond
+	   ((null highlight-changes-global-modes)
+	    nil)
+	   ((functionp highlight-changes-global-modes)
+	    (funcall highlight-changes-global-modes))
+	    ((listp highlight-changes-global-modes)
+	     (if (eq (car-safe highlight-changes-global-modes) 'not)
+		 (not (memq major-mode (cdr highlight-changes-global-modes)))
+	       (memq major-mode highlight-changes-global-modes)))
+	    (t
+	     (and 
+	      (not (string-match "^[ *]"  (buffer-name)))
+	      (buffer-file-name))
+	     ))
+	  (progn
+	    (hilit-chg-set value)
+	    (run-hooks 'highlight-changes-enable-hook)))
+      ))
+    
+
+(defun hilit-chg-turn-off-maybe ()
+  (if highlight-changes-mode
+      (progn
+	(run-hooks 'highlight-changes-disable-hook)
+	(hilit-chg-clear))))
+
+
+
+(defun hilit-chg-update-all-buffers (value)
+  (mapcar
+   (function (lambda (buffer)
+	       (with-current-buffer buffer
+		 (if value
+		     (hilit-chg-turn-on-maybe value)
+		   (hilit-chg-turn-off-maybe))
+		 )))
+   (buffer-list)))
+
+;; ===================== debug ==================
+;; For debug & test use:
+;;
+;; (defun hilit-chg-debug-show (&optional beg end)
+;;   (interactive)
+;;   (message "--- hilit-chg-debug-show ---")
+;;   (hilit-chg-map-changes '(lambda (prop start end)
+;; 			      (message "%d-%d: %s" start end prop)
+;; 			      )
+;; 			   beg end
+;; 			   ))
+;; 
+;; ================== end of debug ===============
+
+
+(provide 'hilit-chg)
+;;; hilit-chg.el ends here
+