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