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 |
;; |
;; |
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) |
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 |
|
|
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 |
;; |
;; |
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? |
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 |
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 |
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)) |
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)) |
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) |
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 |
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) |
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) |
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! |
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'." |
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." |
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) |
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) |
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 |
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 |
|
|
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 |
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: |
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))) |
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)" |
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 |
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 ""))))) |
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 |
|
|
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) |
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 |
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 |
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' |
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)))) |
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) |
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 |
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) |
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 |
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 |
1111 |
;; ) |
;; ) |
1112 |
;; beg end |
;; beg end |
1113 |
;; )) |
;; )) |
1114 |
;; |
;; |
1115 |
;; ================== end of debug =============== |
;; ================== end of debug =============== |
1116 |
|
|
1117 |
(provide 'hilit-chg) |
(provide 'hilit-chg) |