/[emacs]/emacs/lisp/hilit-chg.el
ViewVC logotype

Diff of /emacs/lisp/hilit-chg.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.16 by pj, Mon Jul 16 12:22:58 2001 UTC revision 1.16.4.1 by lektu, Fri Sep 6 09:35:39 2002 UTC
# Line 36  Line 36 
36  ;; Highlight Changes mode in passive state while you make your changes, toggle  ;; Highlight Changes mode in passive state while you make your changes, toggle
37  ;; it on to active mode to see them, then toggle it back off to avoid  ;; it on to active mode to see them, then toggle it back off to avoid
38  ;; distraction.  ;; distraction.
39  ;;  ;;
40  ;; When active, changes are displayed in `highlight-changes-face'.  When  ;; When active, changes are displayed in `highlight-changes-face'.  When
41  ;; text is deleted,  the following character is displayed in  ;; text is deleted, the following character is displayed in
42  ;; `highlight-changes-delete-face' face.  ;; `highlight-changes-delete-face' face.
43  ;;  ;;
44  ;;  ;;
# Line 75  Line 75 
75  ;;                                  modes.  The variable  ;;                                  modes.  The variable
76  ;;                                  `highlight-changes-mode' contains the new  ;;                                  `highlight-changes-mode' contains the new
77  ;;                                  state (`active' or `passive'.)  ;;                                  state (`active' or `passive'.)
 ;;                                    
78  ;;  ;;
79  ;;  ;;
80    ;;
81  ;; Example usage:  ;; Example usage:
82  ;; (defun my-highlight-changes-enable-hook ()  ;; (defun my-highlight-changes-enable-hook ()
83  ;;   (add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)  ;;   (add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)
84  ;; )  ;; )
85  ;;  ;;
86  ;; (defun my-highlight-changes-disable-hook ()  ;; (defun my-highlight-changes-disable-hook ()
87  ;;   (remove-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)  ;;   (remove-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)
88  ;; )  ;; )
89  ;;  ;;
90  ;; (add-hook 'highlight-changes-enable-hook 'my-highlight-changes-enable-hook)  ;; (add-hook 'highlight-changes-enable-hook 'my-highlight-changes-enable-hook)
91  ;; (add-hook 'highlight-changes-disable-hook  ;; (add-hook 'highlight-changes-disable-hook
92  ;;              'my-highlight-changes-disable-hook)  ;;              'my-highlight-changes-disable-hook)
# Line 99  Line 99 
99  ;;  ;;
100  ;; If you prefer to have it automatically invoked you can do it as  ;; If you prefer to have it automatically invoked you can do it as
101  ;; follows.  ;; follows.
102  ;;  ;;
103  ;; 1. Most modes have a major-hook, typically called MODE-hook.  You  ;; 1. Most modes have a major-hook, typically called MODE-hook.  You
104  ;; can use `add-hook' to call `highlight-changes-mode'.    ;; can use `add-hook' to call `highlight-changes-mode'.
105  ;;  ;;
106  ;;   Example:  ;;   Example:
107  ;;      (add-hook 'c-mode-hook 'highlight-changes-mode)  ;;      (add-hook 'c-mode-hook 'highlight-changes-mode)
108  ;;  ;;
109  ;;  If you want to make it start up in passive mode (regardless of the  ;;  If you want to make it start up in passive mode (regardless of the
110  ;;  setting of highlight-changes-initial-state):  ;;  setting of highlight-changes-initial-state):
111  ;;      (add-hook 'emacs-lisp-mode-hook  ;;      (add-hook 'emacs-lisp-mode-hook
112  ;;          (lambda ()  ;;          (lambda ()
113  ;;            (highlight-changes-mode 'passive)))  ;;            (highlight-changes-mode 'passive)))
114  ;;  ;;
115  ;; However, this cannot be done for Fundamental mode for there is no  ;; However, this cannot be done for Fundamental mode for there is no
116  ;; such hook.  ;; such hook.
117  ;;  ;;
118  ;; 2. You can use the function `global-highlight-changes'  ;; 2. You can use the function `global-highlight-changes'
119  ;;  ;;
120  ;; This function, which is fashioned after the way `global-font-lock' works,  ;; This function, which is fashioned after the way `global-font-lock' works,
121  ;; toggles on or off global Highlight Changes mode.  When activated, it turns  ;; toggles on or off global Highlight Changes mode.  When activated, it turns
122  ;; on Highlight Changes mode in all "suitable" existing buffers and will turn  ;; on Highlight Changes mode in all "suitable" existing buffers and will turn
123  ;; it on in new "suitable" buffers to be created.  ;; it on in new "suitable" buffers to be created.
124  ;;  ;;
125  ;; A buffer's "suitability" is determined by variable  ;; A buffer's "suitability" is determined by variable
126  ;; `highlight-changes-global-modes',  as follows.  If the variable is  ;; `highlight-changes-global-modes', as follows.  If the variable is
127  ;; * nil  -- then no buffers are suitable;  ;; * nil  -- then no buffers are suitable;
128  ;; * a function -- this function is called and the result is used.  As  ;; * a function -- this function is called and the result is used.  As
129  ;;   an example,  if the value is `buffer-file-name' then all buffers  ;;   an example, if the value is `buffer-file-name' then all buffers
130  ;;   who are visiting files are suitable, but others (like dired  ;;   who are visiting files are suitable, but others (like dired
131  ;;   buffers) are not;  ;;   buffers) are not;
132  ;; * a list -- then the buffer is suitable iff its mode is in the  ;; * a list -- then the buffer is suitable iff its mode is in the
133  ;;   list,  except if the first element is `not', in which case the test  ;;   list, except if the first element is `not', in which case the test
134  ;;   is reversed (i.e. it is a list of unsuitable modes).  ;;   is reversed (i.e. it is a list of unsuitable modes).
135  ;; * Otherwise,  the buffer is suitable if its name does not begin with  ;; * Otherwise, the buffer is suitable if its name does not begin with
136  ;;   ` ' or `*' and if `buffer-file-name' returns true.  ;;   ` ' or `*' and if `buffer-file-name' returns true.
137  ;;  ;;
138    
# Line 148  Line 148 
148  ;; highlight-changes-rotate-faces  ;; highlight-changes-rotate-faces
149  ;; highlight-compare-with-file  ;; highlight-compare-with-file
150    
151  ;;  ;;
152  ;; You can automatically rotate faces when the buffer is saved;  ;; You can automatically rotate faces when the buffer is saved;
153  ;; see function `highlight-changes-rotate-faces' for how to do this.  ;; see function `highlight-changes-rotate-faces' for how to do this.
154  ;;  ;;
# Line 157  Line 157 
157  ;;; Bugs:  ;;; Bugs:
158    
159  ;; - the next-change and previous-change functions are too literal;  ;; - the next-change and previous-change functions are too literal;
160  ;;   they should find the next "real" change,  in other words treat  ;;   they should find the next "real" change, in other words treat
161  ;;   consecutive changes as one.  ;;   consecutive changes as one.
162    
163    
164  ;;; To do (maybe),  notes, ...  ;;; To do (maybe), notes, ...
165    
166  ;; - having different faces for deletion and non-deletion: is it  ;; - having different faces for deletion and non-deletion: is it
167  ;;   really worth the hassle?  ;;   really worth the hassle?
# Line 177  Line 177 
177  ;; R Sharman (rsharman@magma.ca) Feb 1998:  ;; R Sharman (rsharman@magma.ca) Feb 1998:
178  ;; - initial release as change-mode.  ;; - initial release as change-mode.
179  ;; Jari Aalto <jari.aalto@ntc.nokia.com> Mar 1998  ;; Jari Aalto <jari.aalto@ntc.nokia.com> Mar 1998
180  ;; - fixes for byte compile errors  ;; - fixes for byte compile errors
181  ;; - use eval-and-compile for autoload  ;; - use eval-and-compile for autoload
182  ;; Marijn Ros <J.M.Ros@fys.ruu.nl> Mar 98  ;; Marijn Ros <J.M.Ros@fys.ruu.nl> Mar 98
183  ;; - suggested turning it on by default  ;; - suggested turning it on by default
# Line 225  Line 225 
225    
226  ;; A (not very good) default list of colours to rotate through.  ;; A (not very good) default list of colours to rotate through.
227  ;;  ;;
228  (defcustom highlight-changes-colours  (defcustom highlight-changes-colours
229    (if (eq (frame-parameter nil 'background-mode) 'light)    (if (eq (frame-parameter nil 'background-mode) 'light)
230        ;; defaults for light background:        ;; defaults for light background:
231        '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue")        '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue")
232        ;; defaults for dark background:        ;; defaults for dark background:
233      '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid"))      '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid"))
234    "*Colours used by `highlight-changes-rotate-faces'.    "*Colours used by `highlight-changes-rotate-faces'.
235  The newest rotated change will be displayed in the first element of this list,  The newest rotated change will be displayed in the first element of this list,
236  the next older will be in the second element etc.  the next older will be in the second element etc.
237    
238  This list is used if `highlight-changes-face-list' is nil,  otherwise that  This list is used if `highlight-changes-face-list' is nil, otherwise that
239  variable overrides this list.   If you only care about foreground  variable overrides this list.  If you only care about foreground
240  colours then use this,  if you want fancier faces then set  colours then use this, if you want fancier faces then set
241  `highlight-changes-face-list'."  `highlight-changes-face-list'."
242    :type '(repeat color)    :type '(repeat color)
243    :group 'highlight-changes)    :group 'highlight-changes)
   
244    
245  ;; If you invoke highlight-changes-mode with no argument,  should it start in  
246    ;; If you invoke highlight-changes-mode with no argument, should it start in
247  ;; active or passive mode?  ;; active or passive mode?
248  ;;  ;;
249  (defcustom highlight-changes-initial-state 'active  (defcustom highlight-changes-initial-state 'active
# Line 265  This variable must be set to either `act Line 265  This variable must be set to either `act
265  ;; The strings displayed in the mode-line for the minor mode:  ;; The strings displayed in the mode-line for the minor mode:
266  (defcustom highlight-changes-active-string nil  (defcustom highlight-changes-active-string nil
267    "*The string used when Highlight Changes mode is in the active state.    "*The string used when Highlight Changes mode is in the active state.
268  This should be set to nil if no indication is desired,  or to  This should be set to nil if no indication is desired, or to
269  a string with a leading space."  a string with a leading space."
270    :type '(choice string    :type '(choice string
271                   (const :tag "None"  nil))                   (const :tag "None"  nil))
# Line 273  a string with a leading space." Line 273  a string with a leading space."
273    
274  (defcustom highlight-changes-passive-string " Chg"  (defcustom highlight-changes-passive-string " Chg"
275    "*The string used when Highlight Changes mode is in the passive state.    "*The string used when Highlight Changes mode is in the passive state.
276  This should be set to nil if no indication is desired,  or to  This should be set to nil if no indication is desired, or to
277  a string with a leading space."  a string with a leading space."
278    :type '(choice string    :type '(choice string
279                   (const :tag "None"  nil))                   (const :tag "None"  nil))
# Line 285  a string with a leading space." Line 285  a string with a leading space."
285  A function means that function is called:  if it returns non-nil, the  A function means that function is called:  if it returns non-nil, the
286  buffer is suitable.  buffer is suitable.
287    
288  A list is a list of modes for which it is suitable,  or a list whose  A list is a list of modes for which it is suitable, or a list whose
289  first element is `not' followed by modes which are not suitable.  first element is `not' followed by modes which are not suitable.
290    
291  t means the buffer is suitable if its name does not begin with ` ' nor  t means the buffer is suitable if its name does not begin with ` ' nor
# Line 298  Examples: Line 298  Examples:
298          (c-mode c++-mode)          (c-mode c++-mode)
299  means that Highlight Changes mode is turned on for buffers in C and C++  means that Highlight Changes mode is turned on for buffers in C and C++
300  modes only."  modes only."
301    :type '(choice    :type '(choice
302            (const :tag "all non-special buffers visiting files" t)            (const :tag "all non-special buffers visiting files" t)
303            (set :menu-tag "specific modes" :tag "modes"            (set :menu-tag "specific modes" :tag "modes"
304                 :value (not)                 :value (not)
# Line 325  remove it from existing buffers." Line 325  remove it from existing buffers."
325  (defun hilit-chg-cust-fix-changes-face-list (w wc &optional event)  (defun hilit-chg-cust-fix-changes-face-list (w wc &optional event)
326    ;; When customization function `highlight-changes-face-list' inserts a new    ;; When customization function `highlight-changes-face-list' inserts a new
327    ;; face it uses the default face.   We don't want the user to modify this    ;; face it uses the default face.   We don't want the user to modify this
328    ;; face,  so we rename the faces in the list on an insert.  The rename is    ;; face, so we rename the faces in the list on an insert.  The rename is
329    ;; actually done by copying the faces so user-defined faces still remain    ;; actually done by copying the faces so user-defined faces still remain
330    ;; in the same order.    ;; in the same order.
331    ;; The notifying the parent is needed because without it changes to the    ;; The notifying the parent is needed because without it changes to the
# Line 376  don't just differ from `highlight-change Line 376  don't just differ from `highlight-change
376  Otherwise, this list will be constructed when needed from  Otherwise, this list will be constructed when needed from
377  `highlight-changes-colours'."  `highlight-changes-colours'."
378    :type '(choice    :type '(choice
379            (repeat            (repeat
380              :notify hilit-chg-cust-fix-changes-face-list              :notify hilit-chg-cust-fix-changes-face-list
381              face  )              face  )
382            (const :tag "Derive from highlight-changes-colours"  nil)            (const :tag "Derive from highlight-changes-colours"  nil)
# Line 453  This is the opposite of `hilit-chg-hide- Line 453  This is the opposite of `hilit-chg-hide-
453        (setq face (nth 1 (member prop hilit-chg-list))))        (setq face (nth 1 (member prop hilit-chg-list))))
454      (if face      (if face
455          (progn          (progn
456            ;; We must mark the face,  that is the purpose of the overlay            ;; We must mark the face, that is the purpose of the overlay
457            (overlay-put ov 'face face)            (overlay-put ov 'face face)
458            ;; I don't think we need to set evaporate since we should            ;; I don't think we need to set evaporate since we should
459            ;; be controlling them!            ;; be controlling them!
# Line 467  This is the opposite of `hilit-chg-hide- Line 467  This is the opposite of `hilit-chg-hide-
467  (defun hilit-chg-hide-changes (&optional beg end)  (defun hilit-chg-hide-changes (&optional beg end)
468    "Remove face information for Highlight Changes mode.    "Remove face information for Highlight Changes mode.
469    
470  The overlay containing the face is removed,  but the text property  The overlay containing the face is removed, but the text property
471  containing the change information is retained.  containing the change information is retained.
472    
473  This is the opposite of `hilit-chg-display-changes'."  This is the opposite of `hilit-chg-display-changes'."
# Line 514  the text properties of type `hilit-chg' Line 514  the text properties of type `hilit-chg'
514      (hilit-chg-display-changes beg end)))      (hilit-chg-display-changes beg end)))
515    
516  ;;;###autoload  ;;;###autoload
517  (defun highlight-changes-remove-highlight (beg end)  (defun highlight-changes-remove-highlight (beg end)
518    "Remove the change face from the region between BEG and END.      "Remove the change face from the region between BEG and END.
519  This allows you to manually remove highlighting from uninteresting changes."  This allows you to manually remove highlighting from uninteresting changes."
520    (interactive "r")    (interactive "r")
521    (let ((after-change-functions nil))    (let ((after-change-functions nil))
522      (remove-text-properties beg end  '(hilit-chg nil))      (remove-text-properties beg end  '(hilit-chg nil))
523      (hilit-chg-fixup beg end)))      (hilit-chg-fixup beg end)))
524    
525  (defun hilit-chg-set-face-on-change (beg end leng-before  (defun hilit-chg-set-face-on-change (beg end leng-before
526          &optional no-proerty-change)          &optional no-proerty-change)
527    "Record changes and optionally display them in a distinctive face.    "Record changes and optionally display them in a distinctive face.
528  `hilit-chg-set' adds this function to the `after-change-functions' hook."  `hilit-chg-set' adds this function to the `after-change-functions' hook."
# Line 533  This allows you to manually remove highl Line 533  This allows you to manually remove highl
533    ;;    ;;
534    ;; We do NOT want to simply do this if this is an undo command, because    ;; We do NOT want to simply do this if this is an undo command, because
535    ;; otherwise an undone change shows up as changed.  While the properties    ;; otherwise an undone change shows up as changed.  While the properties
536    ;; are automatically restored by undo,  we must fix up the overlay.    ;; are automatically restored by undo, we must fix up the overlay.
537    (save-match-data    (save-match-data
538      (let ((beg-decr 1) (end-incr 1)      (let ((beg-decr 1) (end-incr 1)
539            (type 'hilit-chg)            (type 'hilit-chg)
# Line 545  This allows you to manually remove highl Line 545  This allows you to manually remove highl
545              ;; deletion              ;; deletion
546              (progn              (progn
547                ;; The eolp and bolp tests are a kludge!  But they prevent                ;; The eolp and bolp tests are a kludge!  But they prevent
548                ;; rather nasty looking displays when deleting text at the end                ;; rather nasty looking displays when deleting text at the end
549                ;; of line,  such as normal corrections as one is typing and                ;; of line, such as normal corrections as one is typing and
550                ;; immediately makes a correction,  and when deleting first                ;; immediately makes a correction, and when deleting first
551                ;; character of a line.                ;; character of a line.
552  ;;;           (if (= leng-before 1)  ;;;           (if (= leng-before 1)
553  ;;;               (if (eolp)  ;;;               (if (eolp)
# Line 558  This allows you to manually remove highl Line 558  This allows you to manually remove highl
558                (setq end (min (+ end end-incr) (point-max)))                (setq end (min (+ end end-incr) (point-max)))
559                (setq type 'hilit-chg-delete))                (setq type 'hilit-chg-delete))
560            ;; Not a deletion.            ;; Not a deletion.
561            ;; Most of the time the following is not necessary,  but            ;; Most of the time the following is not necessary, but
562            ;; if the current text was marked as a deletion then            ;; if the current text was marked as a deletion then
563            ;; the old overlay is still in effect, so if we add some            ;; the old overlay is still in effect, so if we add some
564            ;; text then remove the deletion marking,  but set it to            ;; text then remove the deletion marking, but set it to
565            ;; changed otherwise its highlighting disappears.            ;; changed otherwise its highlighting disappears.
566            (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)            (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)
567                (progn                (progn
# Line 603  This removes all saved change informatio Line 603  This removes all saved change informatio
603      (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)      (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)
604      (let ((after-change-functions nil))      (let ((after-change-functions nil))
605        (hilit-chg-hide-changes)        (hilit-chg-hide-changes)
606        (hilit-chg-map-changes        (hilit-chg-map-changes
607         '(lambda (prop start stop)         '(lambda (prop start stop)
608            (remove-text-properties start stop '(hilit-chg nil))))            (remove-text-properties start stop '(hilit-chg nil))))
609        )        )
610      (setq highlight-changes-mode nil)      (setq highlight-changes-mode nil)
611      (force-mode-line-update)      (force-mode-line-update)
612      ;; If we type:  C-u -1 M-x highlight-changes-mode      ;; If we type:  C-u -1 M-x highlight-changes-mode
613      ;; we want to turn it off,  but hilit-chg-post-command-hook      ;; we want to turn it off, but hilit-chg-post-command-hook
614      ;; runs and that turns it back on!      ;; runs and that turns it back on!
615      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)))      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)))
616    
# Line 618  This removes all saved change informatio Line 618  This removes all saved change informatio
618  (defun highlight-changes-mode (&optional arg)  (defun highlight-changes-mode (&optional arg)
619    "Toggle (or initially set) Highlight Changes mode.    "Toggle (or initially set) Highlight Changes mode.
620    
621  Without an argument:  Without an argument:
622    If Highlight Changes mode is not enabled, then enable it (in either active    If Highlight Changes mode is not enabled, then enable it (in either active
623    or passive state as determined by the variable    or passive state as determined by the variable
624    `highlight-changes-initial-state'); otherwise, toggle between active    `highlight-changes-initial-state'); otherwise, toggle between active
# Line 635  Passive state - means changes are kept a Line 635  Passive state - means changes are kept a
635    
636  Functions:  Functions:
637  \\[highlight-changes-next-change] - move point to beginning of next change  \\[highlight-changes-next-change] - move point to beginning of next change
638  \\[highlight-changes-previous-change] - move to beginning of previous change  \\[highlight-changes-previous-change] - move to beginning of previous change
639  \\[highlight-compare-with-file] - mark text as changed by comparing this  \\[highlight-compare-with-file] - mark text as changed by comparing this
640          buffer with the contents of a file          buffer with the contents of a file
641  \\[highlight-changes-remove-highlight] - remove the change face from the region  \\[highlight-changes-remove-highlight] - remove the change face from the region
642  \\[highlight-changes-rotate-faces] - rotate different \"ages\" of changes \  \\[highlight-changes-rotate-faces] - rotate different \"ages\" of changes \
643  through  through
644          various faces.          various faces.
645    
646  Hook variables:  Hook variables:
# Line 728  Hook variables: Line 728  Hook variables:
728    
729  (defun hilit-chg-make-list (&optional force)  (defun hilit-chg-make-list (&optional force)
730    "Construct `hilit-chg-list' and `highlight-changes-face-list'."    "Construct `hilit-chg-list' and `highlight-changes-face-list'."
731    ;; Constructs highlight-changes-face-list if necessary,      ;; Constructs highlight-changes-face-list if necessary,
732    ;; and hilit-chg-list always:    ;; and hilit-chg-list always:
733    ;; Maybe this should always be called when rotating a face    ;; Maybe this should always be called when rotating a face
734    ;; so we pick up any changes?    ;; so we pick up any changes?
735    (if (or (null highlight-changes-face-list)  ; Don't do it if it    (if (or (null highlight-changes-face-list)  ; Don't do it if it
736            force) ; already exists unless FORCE non-nil.            force) ; already exists unless FORCE non-nil.
737        (let ((p highlight-changes-colours)        (let ((p highlight-changes-colours)
738              (n 1) name)              (n 1) name)
739          (setq highlight-changes-face-list nil)          (setq highlight-changes-face-list nil)
740          (while p          (while p
741            (setq name (intern (format "highlight-changes-face-%d" n)))            (setq name (intern (format "highlight-changes-face-%d" n)))
742            (copy-face 'highlight-changes-face name)            (copy-face 'highlight-changes-face name)
743            (set-face-foreground name (car p))            (set-face-foreground name (car p))
744            (setq highlight-changes-face-list            (setq highlight-changes-face-list
745                  (append highlight-changes-face-list (list name)))                  (append highlight-changes-face-list (list name)))
746            (setq p (cdr p))            (setq p (cdr p))
747            (setq n (1+ n)))))            (setq n (1+ n)))))
748    (setq hilit-chg-list (list 'hilit-chg 'highlight-changes-face))    (setq hilit-chg-list (list 'hilit-chg 'highlight-changes-face))
749    (let ((p highlight-changes-face-list)    (let ((p highlight-changes-face-list)
750          (n 1)          (n 1)
751          last-category last-face)          last-category last-face)
752      (while p      (while p
753        (setq last-category (intern (format "change-%d" n)))        (setq last-category (intern (format "change-%d" n)))
# Line 782  face described by the second element, an Line 782  face described by the second element, an
782  shown in the last face in the list.  shown in the last face in the list.
783    
784  You can automatically rotate colours when the buffer is saved  You can automatically rotate colours when the buffer is saved
785  by adding the following to `local-write-file-hooks',  by evaling it in the  by adding the following to `local-write-file-hooks', by evaling it in the
786  buffer to be saved):  buffer to be saved):
787    
788    \(add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)"    \(add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)"
# Line 805  buffer to be saved): Line 805  buffer to be saved):
805    nil)    nil)
806    
807  ;; ========================================================================  ;; ========================================================================
808  ;; Comparing with an existing file.    ;; Comparing with an existing file.
809  ;; This uses ediff to find the differences.  ;; This uses ediff to find the differences.
810    
811  ;;;###autoload  ;;;###autoload
# Line 831  changes are made, so \\[highlight-change Line 831  changes are made, so \\[highlight-change
831                 ""                       ;; directory                 ""                       ;; directory
832                 nil                      ;; default                 nil                      ;; default
833                 'yes                     ;; must exist                 'yes                     ;; must exist
834                 (let ((f (make-backup-file-name                 (let ((f (make-backup-file-name
835                           (or (buffer-file-name (current-buffer))                           (or (buffer-file-name (current-buffer))
836                               (error "no file for this buffer")))))                               (error "no file for this buffer")))))
837                   (if (file-exists-p f) f "")))))                   (if (file-exists-p f) f "")))))
# Line 887  changes are made, so \\[highlight-change Line 887  changes are made, so \\[highlight-change
887        (setq p (cdr p))        (setq p (cdr p))
888        (setq q (cdr q)))        (setq q (cdr q)))
889      (if existing-buf      (if existing-buf
890          (set-buffer-modified-p nil)          (set-buffer-modified-p nil)
891        (kill-buffer buf-b))))        (kill-buffer buf-b))))
892    
893    
# Line 903  changes are made, so \\[highlight-change Line 903  changes are made, so \\[highlight-change
903    
904    
905  (defun hilit-chg-get-diff-list-hk ()  (defun hilit-chg-get-diff-list-hk ()
906    ;; x and y are dynamically bound by hilit-chg-get-diff-info    ;; x and y are dynamically bound by hilit-chg-get-diff-info
907    ;; which calls this function as a hook    ;; which calls this function as a hook
908    (defvar x)  ;; placate the byte-compiler    (defvar x)  ;; placate the byte-compiler
909    (defvar y)    (defvar y)
# Line 916  changes are made, so \\[highlight-change Line 916  changes are made, so \\[highlight-change
916        ;; va is a vector if there are fine differences        ;; va is a vector if there are fine differences
917        (if va        (if va
918            (setq a (append va nil))            (setq a (append va nil))
919          ;; if not,  get the unrefined difference          ;; if not, get the unrefined difference
920          (setq va (ediff-get-difference n 'A))          (setq va (ediff-get-difference n 'A))
921          (setq a (list (elt va 0))))          (setq a (list (elt va 0))))
922        ;; a list a list        ;; a list a list
# Line 931  changes are made, so \\[highlight-change Line 931  changes are made, so \\[highlight-change
931        ;; vb is a vector        ;; vb is a vector
932        (if vb        (if vb
933            (setq b (append vb nil))            (setq b (append vb nil))
934          ;; if not,  get the unrefined difference          ;; if not, get the unrefined difference
935          (setq vb (ediff-get-difference n 'B))          (setq vb (ediff-get-difference n 'B))
936          (setq b (list (elt vb 0))))          (setq b (list (elt vb 0))))
937        ;; b list a list        ;; b list a list
# Line 951  changes are made, so \\[highlight-change Line 951  changes are made, so \\[highlight-change
951  ;; Global Highlight Changes mode is modeled after Global Font-lock mode.  ;; Global Highlight Changes mode is modeled after Global Font-lock mode.
952  ;; Three hooks are used to gain control.  When Global Changes Mode is  ;; Three hooks are used to gain control.  When Global Changes Mode is
953  ;; enabled, `find-file-hooks' and `change-major-mode-hook' are set.  ;; enabled, `find-file-hooks' and `change-major-mode-hook' are set.
954  ;; `find-file-hooks' is called when visiting a file,  the new mode is  ;; `find-file-hooks' is called when visiting a file, the new mode is
955  ;; known at this time.  ;; known at this time.
956  ;; `change-major-mode-hook' is called when a buffer is changing mode.  ;; `change-major-mode-hook' is called when a buffer is changing mode.
957  ;; This could be because of finding a file in which case  ;; This could be because of finding a file in which case
958  ;; `find-file-hooks' has already been called and has done its work.  ;; `find-file-hooks' has already been called and has done its work.
959  ;; However, it also catches the case where a new mode is being set by  ;; However, it also catches the case where a new mode is being set by
960  ;; the user.  However, it is called from `kill-all-variables' and at  ;; the user.  However, it is called from `kill-all-variables' and at
961  ;; this time the mode is the old mode,  which is not what we want.  ;; this time the mode is the old mode, which is not what we want.
962  ;; So,  our function temporarily sets `post-command-hook' which will  ;; So, our function temporarily sets `post-command-hook' which will
963  ;; be called after the buffer has been completely set up (with the new  ;; be called after the buffer has been completely set up (with the new
964  ;; mode).  It then removes the `post-command-hook'.  ;; mode).  It then removes the `post-command-hook'.
965  ;; One other wrinkle - every M-x command runs the `change-major-mode-hook'  ;; One other wrinkle - every M-x command runs the `change-major-mode-hook'
# Line 971  changes are made, so \\[highlight-change Line 971  changes are made, so \\[highlight-change
971    
972  (defun hilit-chg-post-command-hook ()  (defun hilit-chg-post-command-hook ()
973    ;; This is called after changing a major mode, but also after each    ;; This is called after changing a major mode, but also after each
974    ;; M-x command,  in which case the current buffer is a minibuffer.    ;; M-x command, in which case the current buffer is a minibuffer.
975    ;; In that case, do not act on it here,  but don't turn it off    ;; In that case, do not act on it here, but don't turn it off
976    ;; either,  we will get called here again soon-after.    ;; either, we will get called here again soon-after.
977    ;; Also,  don't enable it for other special buffers.    ;; Also, don't enable it for other special buffers.
978    (if (string-match "^[ *]"  (buffer-name))    (if (string-match "^[ *]"  (buffer-name))
979        nil ;; (message "ignoring this post-command-hook")        nil ;; (message "ignoring this post-command-hook")
980      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)
981      ;; The following check isn't necessary,  since      ;; The following check isn't necessary, since
982      ;; hilit-chg-turn-on-maybe makes this check too.      ;; hilit-chg-turn-on-maybe makes this check too.
983      (or highlight-changes-mode  ;; don't turn it on if it already is      (or highlight-changes-mode  ;; don't turn it on if it already is
984          (hilit-chg-turn-on-maybe highlight-changes-global-initial-state))))          (hilit-chg-turn-on-maybe highlight-changes-global-initial-state))))
# Line 1000  When called interactively: Line 1000  When called interactively:
1000    
1001  When called from a program:  When called from a program:
1002  - if ARG is nil or omitted, turn it off  - if ARG is nil or omitted, turn it off
1003  - if ARG is `active',  turn it on in active mode  - if ARG is `active', turn it on in active mode
1004  - if ARG is `passive', turn it on in passive mode  - if ARG is `passive', turn it on in passive mode
1005  - otherwise just turn it on  - otherwise just turn it on
1006    
1007  When global Highlight Changes mode is enabled, Highlight Changes mode is turned  When global Highlight Changes mode is enabled, Highlight Changes mode is turned
1008  on for future \"suitable\" buffers (and for \"suitable\" existing buffers if  on for future \"suitable\" buffers (and for \"suitable\" existing buffers if
1009  variable `highlight-changes-global-changes-existing-buffers' is non-nil).  variable `highlight-changes-global-changes-existing-buffers' is non-nil).
1010  \"Suitability\" is determined by variable `highlight-changes-global-modes'."  \"Suitability\" is determined by variable `highlight-changes-global-modes'."
1011    
1012    (interactive    (interactive
1013     (list     (list
1014      (cond      (cond
1015       ((null current-prefix-arg)       ((null current-prefix-arg)
# Line 1025  variable `highlight-changes-global-chang Line 1025  variable `highlight-changes-global-chang
1025        'passive)        'passive)
1026       ;; negative interactive arg - turn it off       ;; negative interactive arg - turn it off
1027       (t       (t
1028        (setq global-highlight-changes nil)              (setq global-highlight-changes nil)
1029        nil))))        nil))))
1030    
1031    (if arg    (if arg
# Line 1040  variable `highlight-changes-global-chang Line 1040  variable `highlight-changes-global-chang
1040          (add-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)          (add-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)
1041          (add-hook 'find-file-hooks 'hilit-chg-check-global)          (add-hook 'find-file-hooks 'hilit-chg-check-global)
1042          (if highlight-changes-global-changes-existing-buffers          (if highlight-changes-global-changes-existing-buffers
1043              (hilit-chg-update-all-buffers              (hilit-chg-update-all-buffers
1044               highlight-changes-global-initial-state)))               highlight-changes-global-initial-state)))
1045        
1046      (message "turning OFF global Highlight Changes mode")      (message "turning OFF global Highlight Changes mode")
1047      (remove-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)      (remove-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)
1048      (remove-hook 'find-file-hooks 'hilit-chg-check-global)      (remove-hook 'find-file-hooks 'hilit-chg-check-global)
# Line 1057  variable `highlight-changes-global-chang Line 1057  variable `highlight-changes-global-chang
1057    "Turn on Highlight Changes mode if it is appropriate for this buffer.    "Turn on Highlight Changes mode if it is appropriate for this buffer.
1058    
1059  A buffer is appropriate for Highlight Changes mode if all these are true:  A buffer is appropriate for Highlight Changes mode if all these are true:
1060  - the buffer is not a special buffer (one whose name begins with  - the buffer is not a special buffer (one whose name begins with
1061    `*' or ` ')    `*' or ` ')
1062  - the buffer's mode is suitable as per variable  - the buffer's mode is suitable as per variable
1063    `highlight-changes-global-modes'    `highlight-changes-global-modes'
1064  - Highlight Changes mode is not already on for this buffer.  - Highlight Changes mode is not already on for this buffer.
1065    
1066  This function is called from `hilit-chg-update-all-buffers' or  This function is called from `hilit-chg-update-all-buffers' or
1067  from `global-highlight-changes' when turning on global Highlight Changes mode."  from `global-highlight-changes' when turning on global Highlight Changes mode."
1068    (or highlight-changes-mode                    ; do nothing if already on    (or highlight-changes-mode                    ; do nothing if already on
1069        (if        (if
# Line 1077  from `global-highlight-changes' when tur Line 1077  from `global-highlight-changes' when tur
1077                   (not (memq major-mode (cdr highlight-changes-global-modes)))                   (not (memq major-mode (cdr highlight-changes-global-modes)))
1078                 (memq major-mode highlight-changes-global-modes)))                 (memq major-mode highlight-changes-global-modes)))
1079              (t              (t
1080               (and               (and
1081                (not (string-match "^[ *]"  (buffer-name)))                (not (string-match "^[ *]"  (buffer-name)))
1082                (buffer-file-name))))                (buffer-file-name))))
1083            (progn            (progn
1084              (hilit-chg-set value)              (hilit-chg-set value)
1085              (run-hooks 'highlight-changes-enable-hook)))))              (run-hooks 'highlight-changes-enable-hook)))))
1086        
1087    
1088  (defun hilit-chg-turn-off-maybe ()  (defun hilit-chg-turn-off-maybe ()
1089    (if highlight-changes-mode    (if highlight-changes-mode
# Line 1113  from `global-highlight-changes' when tur Line 1113  from `global-highlight-changes' when tur
1113  ;;                            )  ;;                            )
1114  ;;                         beg end  ;;                         beg end
1115  ;;                         ))  ;;                         ))
1116  ;;  ;;
1117  ;; ================== end of debug ===============  ;; ================== end of debug ===============
1118    
1119  (provide 'hilit-chg)  (provide 'hilit-chg)

Legend:
Removed from v.1.16  
changed lines
  Added in v.1.16.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26