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 |
;; |
;; |
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 |
|
|
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? |
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 |
|
|
246 |
;; If you invoke highlight-changes-mode with no argument, should it start in |
;; 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)) |
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) |
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'." |
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) |
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 |
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 |
|
|
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? |
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 |
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 |
|
|