/[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.21 by pj, Mon Apr 22 15:27:08 2002 UTC revision 1.21.2.1 by miles, Fri Apr 4 06:20:06 2003 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 " +Chg"  (defcustom highlight-changes-active-string " +Chg"
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 299  Examples: Line 299  Examples:
299          (c-mode c++-mode)          (c-mode c++-mode)
300  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++
301  modes only."  modes only."
302    :type '(choice    :type '(choice
303            (const :tag "all non-special buffers visiting files" t)            (const :tag "all non-special buffers visiting files" t)
304            (set :menu-tag "specific modes" :tag "modes"            (set :menu-tag "specific modes" :tag "modes"
305                 :value (not)                 :value (not)
# Line 325  remove it from existing buffers." Line 325  remove it from existing buffers."
325    
326  (defun hilit-chg-cust-fix-changes-face-list (w wc &optional event)  (defun hilit-chg-cust-fix-changes-face-list (w wc &optional event)
327    ;; When customization function `highlight-changes-face-list' inserts a new    ;; When customization function `highlight-changes-face-list' inserts a new
328    ;; 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
329    ;; 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
330    ;; actually done by copying the faces so user-defined faces still remain    ;; actually done by copying the faces so user-defined faces still remain
331    ;; in the same order.    ;; in the same order.
332    ;; 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 345  remove it from existing buffers." Line 345  remove it from existing buffers."
345              (if (eq old-name new-name)              (if (eq old-name new-name)
346                  nil                  nil
347                ;; A new face has been inserted: we don't want to modify the                ;; A new face has been inserted: we don't want to modify the
348                ;; default face so copy it.   Better, though, (I think) is to                ;; default face so copy it.  Better, though, (I think) is to
349                ;; make a new face have the same attributes as                ;; make a new face have the same attributes as
350                ;; highlight-changes-face .                ;; highlight-changes-face .
351                (if (eq old-name 'default)                (if (eq old-name 'default)
# Line 377  don't just differ from `highlight-change Line 377  don't just differ from `highlight-change
377  Otherwise, this list will be constructed when needed from  Otherwise, this list will be constructed when needed from
378  `highlight-changes-colours'."  `highlight-changes-colours'."
379    :type '(choice    :type '(choice
380            (repeat            (repeat
381              :notify hilit-chg-cust-fix-changes-face-list              :notify hilit-chg-cust-fix-changes-face-list
382              face  )              face  )
383            (const :tag "Derive from highlight-changes-colours"  nil)            (const :tag "Derive from highlight-changes-colours"  nil)
# Line 454  This is the opposite of `hilit-chg-hide- Line 454  This is the opposite of `hilit-chg-hide-
454        (setq face (nth 1 (member prop hilit-chg-list))))        (setq face (nth 1 (member prop hilit-chg-list))))
455      (if face      (if face
456          (progn          (progn
457            ;; We must mark the face,  that is the purpose of the overlay            ;; We must mark the face, that is the purpose of the overlay
458            (overlay-put ov 'face face)            (overlay-put ov 'face face)
459            ;; I don't think we need to set evaporate since we should            ;; I don't think we need to set evaporate since we should
460            ;; be controlling them!            ;; be controlling them!
# Line 468  This is the opposite of `hilit-chg-hide- Line 468  This is the opposite of `hilit-chg-hide-
468  (defun hilit-chg-hide-changes (&optional beg end)  (defun hilit-chg-hide-changes (&optional beg end)
469    "Remove face information for Highlight Changes mode.    "Remove face information for Highlight Changes mode.
470    
471  The overlay containing the face is removed,  but the text property  The overlay containing the face is removed, but the text property
472  containing the change information is retained.  containing the change information is retained.
473    
474  This is the opposite of `hilit-chg-display-changes'."  This is the opposite of `hilit-chg-display-changes'."
# Line 513  the text properties of type `hilit-chg' Line 513  the text properties of type `hilit-chg'
513      (hilit-chg-display-changes beg end)))      (hilit-chg-display-changes beg end)))
514    
515  ;;;###autoload  ;;;###autoload
516  (defun highlight-changes-remove-highlight (beg end)  (defun highlight-changes-remove-highlight (beg end)
517    "Remove the change face from the region between BEG and END.      "Remove the change face from the region between BEG and END.
518  This allows you to manually remove highlighting from uninteresting changes."  This allows you to manually remove highlighting from uninteresting changes."
519    (interactive "r")    (interactive "r")
520    (let ((after-change-functions nil))    (let ((after-change-functions nil))
521      (remove-text-properties beg end  '(hilit-chg nil))      (remove-text-properties beg end  '(hilit-chg nil))
522      (hilit-chg-fixup beg end)))      (hilit-chg-fixup beg end)))
523    
524  (defun hilit-chg-set-face-on-change (beg end leng-before  (defun hilit-chg-set-face-on-change (beg end leng-before
525                                           &optional no-property-change)                                           &optional no-property-change)
526    "Record changes and optionally display them in a distinctive face.    "Record changes and optionally display them in a distinctive face.
527  `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 532  This allows you to manually remove highl Line 532  This allows you to manually remove highl
532    ;;    ;;
533    ;; 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
534    ;; otherwise an undone change shows up as changed.  While the properties    ;; otherwise an undone change shows up as changed.  While the properties
535    ;; are automatically restored by undo,  we must fix up the overlay.    ;; are automatically restored by undo, we must fix up the overlay.
536    (save-match-data    (save-match-data
537      (let ((beg-decr 1) (end-incr 1)      (let ((beg-decr 1) (end-incr 1)
538            (type 'hilit-chg)            (type 'hilit-chg)
# Line 544  This allows you to manually remove highl Line 544  This allows you to manually remove highl
544              ;; deletion              ;; deletion
545              (progn              (progn
546                ;; The eolp and bolp tests are a kludge!  But they prevent                ;; The eolp and bolp tests are a kludge!  But they prevent
547                ;; rather nasty looking displays when deleting text at the end                ;; rather nasty looking displays when deleting text at the end
548                ;; of line,  such as normal corrections as one is typing and                ;; of line, such as normal corrections as one is typing and
549                ;; immediately makes a correction,  and when deleting first                ;; immediately makes a correction, and when deleting first
550                ;; character of a line.                ;; character of a line.
551  ;;;           (if (= leng-before 1)  ;;;           (if (= leng-before 1)
552  ;;;               (if (eolp)  ;;;               (if (eolp)
# Line 557  This allows you to manually remove highl Line 557  This allows you to manually remove highl
557                (setq end (min (+ end end-incr) (point-max)))                (setq end (min (+ end end-incr) (point-max)))
558                (setq type 'hilit-chg-delete))                (setq type 'hilit-chg-delete))
559            ;; Not a deletion.            ;; Not a deletion.
560            ;; Most of the time the following is not necessary,  but            ;; Most of the time the following is not necessary, but
561            ;; if the current text was marked as a deletion then            ;; if the current text was marked as a deletion then
562            ;; the old overlay is still in effect, so if we add some            ;; the old overlay is still in effect, so if we add some
563            ;; text then remove the deletion marking,  but set it to            ;; text then remove the deletion marking, but set it to
564            ;; changed otherwise its highlighting disappears.            ;; changed otherwise its highlighting disappears.
565            (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)            (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)
566                (progn                (progn
# Line 601  This removes all saved change informatio Line 601  This removes all saved change informatio
601      (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)      (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)
602      (let ((after-change-functions nil))      (let ((after-change-functions nil))
603        (hilit-chg-hide-changes)        (hilit-chg-hide-changes)
604        (hilit-chg-map-changes        (hilit-chg-map-changes
605         '(lambda (prop start stop)         '(lambda (prop start stop)
606            (remove-text-properties start stop '(hilit-chg nil))))            (remove-text-properties start stop '(hilit-chg nil))))
607        )        )
608      (setq highlight-changes-mode nil)      (setq highlight-changes-mode nil)
609      (force-mode-line-update)      (force-mode-line-update)
610      ;; If we type:  C-u -1 M-x highlight-changes-mode      ;; If we type:  C-u -1 M-x highlight-changes-mode
611      ;; we want to turn it off,  but hilit-chg-post-command-hook      ;; we want to turn it off, but hilit-chg-post-command-hook
612      ;; runs and that turns it back on!      ;; runs and that turns it back on!
613      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)))      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)))
614    
# Line 616  This removes all saved change informatio Line 616  This removes all saved change informatio
616  (defun highlight-changes-mode (&optional arg)  (defun highlight-changes-mode (&optional arg)
617    "Toggle (or initially set) Highlight Changes mode.    "Toggle (or initially set) Highlight Changes mode.
618    
619  Without an argument:  Without an argument:
620    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
621    or passive state as determined by the variable    or passive state as determined by the variable
622    `highlight-changes-initial-state'); otherwise, toggle between active    `highlight-changes-initial-state'); otherwise, toggle between active
# Line 633  Passive state - means changes are kept a Line 633  Passive state - means changes are kept a
633    
634  Functions:  Functions:
635  \\[highlight-changes-next-change] - move point to beginning of next change  \\[highlight-changes-next-change] - move point to beginning of next change
636  \\[highlight-changes-previous-change] - move to beginning of previous change  \\[highlight-changes-previous-change] - move to beginning of previous change
637  \\[highlight-compare-with-file] - mark text as changed by comparing this  \\[highlight-compare-with-file] - mark text as changed by comparing this
638          buffer with the contents of a file          buffer with the contents of a file
639  \\[highlight-changes-remove-highlight] - remove the change face from the region  \\[highlight-changes-remove-highlight] - remove the change face from the region
640  \\[highlight-changes-rotate-faces] - rotate different \"ages\" of changes \  \\[highlight-changes-rotate-faces] - rotate different \"ages\" of changes \
641  through  through
642          various faces.          various faces.
643    
644  Hook variables:  Hook variables:
# Line 726  Hook variables: Line 726  Hook variables:
726    
727  (defun hilit-chg-make-list (&optional force)  (defun hilit-chg-make-list (&optional force)
728    "Construct `hilit-chg-list' and `highlight-changes-face-list'."    "Construct `hilit-chg-list' and `highlight-changes-face-list'."
729    ;; Constructs highlight-changes-face-list if necessary,      ;; Constructs highlight-changes-face-list if necessary,
730    ;; and hilit-chg-list always:    ;; and hilit-chg-list always:
731    ;; Maybe this should always be called when rotating a face    ;; Maybe this should always be called when rotating a face
732    ;; so we pick up any changes?    ;; so we pick up any changes?
733    (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
734            force) ; already exists unless FORCE non-nil.            force) ; already exists unless FORCE non-nil.
735        (let ((p highlight-changes-colours)        (let ((p highlight-changes-colours)
736              (n 1) name)              (n 1) name)
737          (setq highlight-changes-face-list nil)          (setq highlight-changes-face-list nil)
738          (while p          (while p
739            (setq name (intern (format "highlight-changes-face-%d" n)))            (setq name (intern (format "highlight-changes-face-%d" n)))
740            (copy-face 'highlight-changes-face name)            (copy-face 'highlight-changes-face name)
741            (set-face-foreground name (car p))            (set-face-foreground name (car p))
742            (setq highlight-changes-face-list            (setq highlight-changes-face-list
743                  (append highlight-changes-face-list (list name)))                  (append highlight-changes-face-list (list name)))
744            (setq p (cdr p))            (setq p (cdr p))
745            (setq n (1+ n)))))            (setq n (1+ n)))))
746    (setq hilit-chg-list (list 'hilit-chg 'highlight-changes-face))    (setq hilit-chg-list (list 'hilit-chg 'highlight-changes-face))
747    (let ((p highlight-changes-face-list)    (let ((p highlight-changes-face-list)
748          (n 1)          (n 1)
749          last-category last-face)          last-category last-face)
750      (while p      (while p
751        (setq last-category (intern (format "change-%d" n)))        (setq last-category (intern (format "change-%d" n)))
# Line 780  face described by the second element, an Line 780  face described by the second element, an
780  shown in the last face in the list.  shown in the last face in the list.
781    
782  You can automatically rotate colours when the buffer is saved  You can automatically rotate colours when the buffer is saved
783  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
784  buffer to be saved):  buffer to be saved):
785    
786    \(add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)"    \(add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)"
# Line 803  buffer to be saved): Line 803  buffer to be saved):
803    nil)    nil)
804    
805  ;; ========================================================================  ;; ========================================================================
806  ;; Comparing with an existing file.    ;; Comparing with an existing file.
807  ;; This uses ediff to find the differences.  ;; This uses ediff to find the differences.
808    
809  ;;;###autoload  ;;;###autoload
# Line 829  changes are made, so \\[highlight-change Line 829  changes are made, so \\[highlight-change
829                 ""                       ;; directory                 ""                       ;; directory
830                 nil                      ;; default                 nil                      ;; default
831                 'yes                     ;; must exist                 'yes                     ;; must exist
832                 (let ((f (make-backup-file-name                 (let ((f (make-backup-file-name
833                           (or (buffer-file-name (current-buffer))                           (or (buffer-file-name (current-buffer))
834                               (error "no file for this buffer")))))                               (error "no file for this buffer")))))
835                   (if (file-exists-p f) f "")))))                   (if (file-exists-p f) f "")))))
# Line 885  changes are made, so \\[highlight-change Line 885  changes are made, so \\[highlight-change
885        (setq p (cdr p))        (setq p (cdr p))
886        (setq q (cdr q)))        (setq q (cdr q)))
887      (if existing-buf      (if existing-buf
888          (set-buffer-modified-p nil)          (set-buffer-modified-p nil)
889        (kill-buffer buf-b))))        (kill-buffer buf-b))))
890    
891    
# Line 901  changes are made, so \\[highlight-change Line 901  changes are made, so \\[highlight-change
901    
902    
903  (defun hilit-chg-get-diff-list-hk ()  (defun hilit-chg-get-diff-list-hk ()
904    ;; x and y are dynamically bound by hilit-chg-get-diff-info    ;; x and y are dynamically bound by hilit-chg-get-diff-info
905    ;; which calls this function as a hook    ;; which calls this function as a hook
906    (defvar x)  ;; placate the byte-compiler    (defvar x)  ;; placate the byte-compiler
907    (defvar y)    (defvar y)
# Line 914  changes are made, so \\[highlight-change Line 914  changes are made, so \\[highlight-change
914        ;; va is a vector if there are fine differences        ;; va is a vector if there are fine differences
915        (if va        (if va
916            (setq a (append va nil))            (setq a (append va nil))
917          ;; if not,  get the unrefined difference          ;; if not, get the unrefined difference
918          (setq va (ediff-get-difference n 'A))          (setq va (ediff-get-difference n 'A))
919          (setq a (list (elt va 0))))          (setq a (list (elt va 0))))
920        ;; a list a list        ;; a list a list
# Line 929  changes are made, so \\[highlight-change Line 929  changes are made, so \\[highlight-change
929        ;; vb is a vector        ;; vb is a vector
930        (if vb        (if vb
931            (setq b (append vb nil))            (setq b (append vb nil))
932          ;; if not,  get the unrefined difference          ;; if not, get the unrefined difference
933          (setq vb (ediff-get-difference n 'B))          (setq vb (ediff-get-difference n 'B))
934          (setq b (list (elt vb 0))))          (setq b (list (elt vb 0))))
935        ;; b list a list        ;; b list a list
# Line 949  changes are made, so \\[highlight-change Line 949  changes are made, so \\[highlight-change
949  ;; Global Highlight Changes mode is modeled after Global Font-lock mode.  ;; Global Highlight Changes mode is modeled after Global Font-lock mode.
950  ;; Three hooks are used to gain control.  When Global Changes Mode is  ;; Three hooks are used to gain control.  When Global Changes Mode is
951  ;; enabled, `find-file-hooks' and `change-major-mode-hook' are set.  ;; enabled, `find-file-hooks' and `change-major-mode-hook' are set.
952  ;; `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
953  ;; known at this time.  ;; known at this time.
954  ;; `change-major-mode-hook' is called when a buffer is changing mode.  ;; `change-major-mode-hook' is called when a buffer is changing mode.
955  ;; This could be because of finding a file in which case  ;; This could be because of finding a file in which case
956  ;; `find-file-hooks' has already been called and has done its work.  ;; `find-file-hooks' has already been called and has done its work.
957  ;; 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
958  ;; the user.  However, it is called from `kill-all-variables' and at  ;; the user.  However, it is called from `kill-all-variables' and at
959  ;; 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.
960  ;; So,  our function temporarily sets `post-command-hook' which will  ;; So, our function temporarily sets `post-command-hook' which will
961  ;; 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
962  ;; mode).  It then removes the `post-command-hook'.  ;; mode).  It then removes the `post-command-hook'.
963  ;; 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 969  changes are made, so \\[highlight-change Line 969  changes are made, so \\[highlight-change
969    
970  (defun hilit-chg-post-command-hook ()  (defun hilit-chg-post-command-hook ()
971    ;; This is called after changing a major mode, but also after each    ;; This is called after changing a major mode, but also after each
972    ;; M-x command,  in which case the current buffer is a minibuffer.    ;; M-x command, in which case the current buffer is a minibuffer.
973    ;; 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
974    ;; either,  we will get called here again soon-after.    ;; either, we will get called here again soon-after.
975    ;; Also,  don't enable it for other special buffers.    ;; Also, don't enable it for other special buffers.
976    (if (string-match "^[ *]"  (buffer-name))    (if (string-match "^[ *]"  (buffer-name))
977        nil ;; (message "ignoring this post-command-hook")        nil ;; (message "ignoring this post-command-hook")
978      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)
979      ;; The following check isn't necessary,  since      ;; The following check isn't necessary, since
980      ;; hilit-chg-turn-on-maybe makes this check too.      ;; hilit-chg-turn-on-maybe makes this check too.
981      (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
982          (hilit-chg-turn-on-maybe highlight-changes-global-initial-state))))          (hilit-chg-turn-on-maybe highlight-changes-global-initial-state))))
# Line 998  When called interactively: Line 998  When called interactively:
998    
999  When called from a program:  When called from a program:
1000  - if ARG is nil or omitted, turn it off  - if ARG is nil or omitted, turn it off
1001  - if ARG is `active',  turn it on in active mode  - if ARG is `active', turn it on in active mode
1002  - if ARG is `passive', turn it on in passive mode  - if ARG is `passive', turn it on in passive mode
1003  - otherwise just turn it on  - otherwise just turn it on
1004    
1005  When global Highlight Changes mode is enabled, Highlight Changes mode is turned  When global Highlight Changes mode is enabled, Highlight Changes mode is turned
1006  on for future \"suitable\" buffers (and for \"suitable\" existing buffers if  on for future \"suitable\" buffers (and for \"suitable\" existing buffers if
1007  variable `highlight-changes-global-changes-existing-buffers' is non-nil).  variable `highlight-changes-global-changes-existing-buffers' is non-nil).
1008  \"Suitability\" is determined by variable `highlight-changes-global-modes'."  \"Suitability\" is determined by variable `highlight-changes-global-modes'."
1009    
1010    (interactive    (interactive
1011     (list     (list
1012      (cond      (cond
1013       ((null current-prefix-arg)       ((null current-prefix-arg)
# Line 1023  variable `highlight-changes-global-chang Line 1023  variable `highlight-changes-global-chang
1023        'passive)        'passive)
1024       ;; negative interactive arg - turn it off       ;; negative interactive arg - turn it off
1025       (t       (t
1026        (setq global-highlight-changes nil)              (setq global-highlight-changes nil)
1027        nil))))        nil))))
1028    
1029    (if arg    (if arg
# Line 1038  variable `highlight-changes-global-chang Line 1038  variable `highlight-changes-global-chang
1038          (add-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)          (add-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)
1039          (add-hook 'find-file-hooks 'hilit-chg-check-global)          (add-hook 'find-file-hooks 'hilit-chg-check-global)
1040          (if highlight-changes-global-changes-existing-buffers          (if highlight-changes-global-changes-existing-buffers
1041              (hilit-chg-update-all-buffers              (hilit-chg-update-all-buffers
1042               highlight-changes-global-initial-state)))               highlight-changes-global-initial-state)))
1043        
1044      (message "Turning OFF global Highlight Changes mode")      (message "Turning OFF global Highlight Changes mode")
1045      (remove-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)      (remove-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)
1046      (remove-hook 'find-file-hooks 'hilit-chg-check-global)      (remove-hook 'find-file-hooks 'hilit-chg-check-global)
# Line 1055  variable `highlight-changes-global-chang Line 1055  variable `highlight-changes-global-chang
1055    "Turn on Highlight Changes mode if it is appropriate for this buffer.    "Turn on Highlight Changes mode if it is appropriate for this buffer.
1056    
1057  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:
1058  - the buffer is not a special buffer (one whose name begins with  - the buffer is not a special buffer (one whose name begins with
1059    `*' or ` ')    `*' or ` ')
1060  - the buffer's mode is suitable as per variable  - the buffer's mode is suitable as per variable
1061    `highlight-changes-global-modes'    `highlight-changes-global-modes'
1062  - Highlight Changes mode is not already on for this buffer.  - Highlight Changes mode is not already on for this buffer.
1063    
1064  This function is called from `hilit-chg-update-all-buffers' or  This function is called from `hilit-chg-update-all-buffers' or
1065  from `global-highlight-changes' when turning on global Highlight Changes mode."  from `global-highlight-changes' when turning on global Highlight Changes mode."
1066    (or highlight-changes-mode                    ; do nothing if already on    (or highlight-changes-mode                    ; do nothing if already on
1067        (if        (if
# Line 1075  from `global-highlight-changes' when tur Line 1075  from `global-highlight-changes' when tur
1075                   (not (memq major-mode (cdr highlight-changes-global-modes)))                   (not (memq major-mode (cdr highlight-changes-global-modes)))
1076                 (memq major-mode highlight-changes-global-modes)))                 (memq major-mode highlight-changes-global-modes)))
1077              (t              (t
1078               (and               (and
1079                (not (string-match "^[ *]"  (buffer-name)))                (not (string-match "^[ *]"  (buffer-name)))
1080                (buffer-file-name))))                (buffer-file-name))))
1081            (progn            (progn
1082              (hilit-chg-set value)              (hilit-chg-set value)
1083              (run-hooks 'highlight-changes-enable-hook)))))              (run-hooks 'highlight-changes-enable-hook)))))
1084        
1085    
1086  (defun hilit-chg-turn-off-maybe ()  (defun hilit-chg-turn-off-maybe ()
1087    (if highlight-changes-mode    (if highlight-changes-mode
# Line 1111  from `global-highlight-changes' when tur Line 1111  from `global-highlight-changes' when tur
1111  ;;                            )  ;;                            )
1112  ;;                         beg end  ;;                         beg end
1113  ;;                         ))  ;;                         ))
1114  ;;  ;;
1115  ;; ================== end of debug ===============  ;; ================== end of debug ===============
1116    
1117  (provide 'hilit-chg)  (provide 'hilit-chg)

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.21.2.1

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