Initial revision

1 files changed, 1202 insertions, 0 deletions

diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
new file mode 100644
index 00000000000..132d8f81b10
--- /dev/null
+++ b/lisp/hilit-chg.el
@@ -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
+