aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/hilit-chg.el283
1 files changed, 106 insertions, 177 deletions
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 3ce381738e8..f2467f55ff4 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -1,6 +1,6 @@
1;;; hilit-chg.el --- minor mode displaying buffer changes with special face 1;;; hilit-chg.el --- minor mode displaying buffer changes with special face
2 2
3;; Copyright (C) 1998 Free Software Foundation, Inc. 3;; Copyright (C) 1998, 2000 Free Software Foundation, Inc.
4 4
5;; Author: Richard Sharman <rsharman@pobox.com> 5;; Author: Richard Sharman <rsharman@pobox.com>
6;; Keywords: faces 6;; Keywords: faces
@@ -44,12 +44,12 @@
44;; 44;;
45;; 45;;
46;; You can "age" different sets of changes by using 46;; You can "age" different sets of changes by using
47;; `highlight-changes-rotate-faces'. This rotates different through a series 47;; `highlight-changes-rotate-faces'. This rotates through a series
48;; of different faces, so you can distinguish "new" changes from "older" 48;; of different faces, so you can distinguish "new" changes from "older"
49;; changes. You can customize these "rotated" faces in two ways. You can 49;; changes. You can customize these "rotated" faces in two ways. You can
50;; either explicitly define each face by customizing 50;; either explicitly define each face by customizing
51;; `highlight-changes-face-list'. If, however, the faces differ from 51;; `highlight-changes-face-list'. If, however, the faces differ from
52;; `highlight-changes-face' only in the foreground colour, you can simply set 52;; `highlight-changes-face' only in the foreground color, you can simply set
53;; `highlight-changes-colours'. If `highlight-changes-face-list' is nil when 53;; `highlight-changes-colours'. If `highlight-changes-face-list' is nil when
54;; the faces are required they will be constructed from 54;; the faces are required they will be constructed from
55;; `highlight-changes-colours'. 55;; `highlight-changes-colours'.
@@ -93,7 +93,7 @@
93;; 'my-highlight-changes-disable-hook) 93;; 'my-highlight-changes-disable-hook)
94 94
95 95
96;; Explcit vs. Implicit 96;; Explicit vs. Implicit
97;; 97;;
98 98
99;; Normally, Highlight Changes mode is turned on explicitly in a buffer. 99;; Normally, Highlight Changes mode is turned on explicitly in a buffer.
@@ -120,14 +120,14 @@
120;; 120;;
121;; This function, which is fashioned after the way `global-font-lock' works, 121;; This function, which is fashioned after the way `global-font-lock' works,
122;; toggles on or off global Highlight Changes mode. When activated, it turns 122;; toggles on or off global Highlight Changes mode. When activated, it turns
123;; on Highlight Changes mode in all "suitable" existings buffers and will turn 123;; on Highlight Changes mode in all "suitable" existing buffers and will turn
124;; it on in new "suitable" buffers to be created. 124;; it on in new "suitable" buffers to be created.
125;; 125;;
126;; A buffer's "suitability" is determined by variable 126;; A buffer's "suitability" is determined by variable
127;; `highlight-changes-global-modes', as follows. If the variable is 127;; `highlight-changes-global-modes', as follows. If the variable is
128;; * nil -- then no buffers are suitable; 128;; * nil -- then no buffers are suitable;
129;; * a function -- this function is called and the result is used. As 129;; * a function -- this function is called and the result is used. As
130;; an example, if the value is 'buffer-file-name then all buffers 130;; an example, if the value is `buffer-file-name' then all buffers
131;; who are visiting files are suitable, but others (like dired 131;; who are visiting files are suitable, but others (like dired
132;; buffers) are not; 132;; buffers) are not;
133;; * a list -- then the buffer is suitable iff its mode is in the 133;; * a list -- then the buffer is suitable iff its mode is in the
@@ -187,7 +187,7 @@
187;; - global mode and various stuff added 187;; - global mode and various stuff added
188;; - Changed to use overlays 188;; - Changed to use overlays
189;; August 98 189;; August 98
190;; - renmaed to Highlight Changes mode. 190;; - renamed to Highlight Changes mode.
191 191
192 192
193;;; Code: 193;;; Code:
@@ -205,7 +205,7 @@
205 205
206;; Defaults for face: red foreground, no change to background, 206;; Defaults for face: red foreground, no change to background,
207;; and underlined if a change is because of a deletion. 207;; and underlined if a change is because of a deletion.
208;; Note: underlining is helpful in that is shows up changes in white space. 208;; Note: underlining is helpful in that it shows up changes in white space.
209;; However, having it set for non-delete changes can be annoying because all 209;; However, having it set for non-delete changes can be annoying because all
210;; indentation on inserts gets underlined (which can look pretty ugly!). 210;; indentation on inserts gets underlined (which can look pretty ugly!).
211 211
@@ -213,16 +213,14 @@
213 '((((class color)) (:foreground "red" )) 213 '((((class color)) (:foreground "red" ))
214 (t (:inverse-video t))) 214 (t (:inverse-video t)))
215 "Face used for highlighting changes." 215 "Face used for highlighting changes."
216 :group 'highlight-changes 216 :group 'highlight-changes)
217 )
218 217
219;; This looks pretty ugly, actually. Maybe the underline should be removed. 218;; This looks pretty ugly, actually. Maybe the underline should be removed.
220(defface highlight-changes-delete-face 219(defface highlight-changes-delete-face
221 '((((class color)) (:foreground "red" :underline t)) 220 '((((class color)) (:foreground "red" :underline t))
222 (t (:inverse-video t))) 221 (t (:inverse-video t)))
223 "Face used for highlighting deletions." 222 "Face used for highlighting deletions."
224 :group 'highlight-changes 223 :group 'highlight-changes)
225 )
226 224
227 225
228 226
@@ -242,9 +240,8 @@ This list is used if `highlight-changes-face-list' is nil, otherwise that
242variable overrides this list. If you only care about foreground 240variable overrides this list. If you only care about foreground
243colours then use this, if you want fancier faces then set 241colours then use this, if you want fancier faces then set
244`highlight-changes-face-list'." 242`highlight-changes-face-list'."
245 :type '(repeat color) 243 :type '(repeat color)
246 :group 'highlight-changes 244 :group 'highlight-changes)
247 )
248 245
249 246
250;; If you invoke highlight-changes-mode with no argument, should it start in 247;; If you invoke highlight-changes-mode with no argument, should it start in
@@ -256,8 +253,7 @@ This is used when `highlight-changes' is called with no argument.
256This variable must be set to one of the symbols `active' or `passive'." 253This variable must be set to one of the symbols `active' or `passive'."
257 :type '(choice (const :tag "Active" active) 254 :type '(choice (const :tag "Active" active)
258 (const :tag "Passive" passive)) 255 (const :tag "Passive" passive))
259 :group 'highlight-changes 256 :group 'highlight-changes)
260 )
261 257
262(defcustom highlight-changes-global-initial-state 'passive 258(defcustom highlight-changes-global-initial-state 'passive
263 "*What state `global-highlight-changes' should start in. 259 "*What state `global-highlight-changes' should start in.
@@ -265,8 +261,7 @@ This is used if `global-highlight-changes' is called with no argument.
265This variable must be set to either `active' or `passive'" 261This variable must be set to either `active' or `passive'"
266 :type '(choice (const :tag "Active" active) 262 :type '(choice (const :tag "Active" active)
267 (const :tag "Passive" passive)) 263 (const :tag "Passive" passive))
268 :group 'highlight-changes 264 :group 'highlight-changes)
269 )
270 265
271;; The strings displayed in the mode-line for the minor mode: 266;; The strings displayed in the mode-line for the minor mode:
272(defcustom highlight-changes-active-string nil 267(defcustom highlight-changes-active-string nil
@@ -275,8 +270,7 @@ This should be set to nil if no indication is desired, or to
275a string with a leading space." 270a string with a leading space."
276 :type '(choice string 271 :type '(choice string
277 (const :tag "None" nil)) 272 (const :tag "None" nil))
278 :group 'highlight-changes 273 :group 'highlight-changes)
279 )
280 274
281(defcustom highlight-changes-passive-string " Chg" 275(defcustom highlight-changes-passive-string " Chg"
282 "*The string used when Highlight Changes mode is in the passive state. 276 "*The string used when Highlight Changes mode is in the passive state.
@@ -284,22 +278,21 @@ This should be set to nil if no indication is desired, or to
284a string with a leading space." 278a string with a leading space."
285 :type '(choice string 279 :type '(choice string
286 (const :tag "None" nil)) 280 (const :tag "None" nil))
287 :group 'highlight-changes 281 :group 'highlight-changes)
288 )
289 282
290(defcustom highlight-changes-global-modes t 283(defcustom highlight-changes-global-modes t
291 "*Determine whether a buffer is suitable for global Highlight Changes mode. 284 "*Determine whether a buffer is suitable for global Highlight Changes mode.
292 285
293A function means that function is called: if it returns non-nil the 286A function means that function is called: if it returns non-nil, the
294buffer is suitable. 287buffer is suitable.
295 288
296A list is a list of modes for which it is suitable, or a list whose 289A list is a list of modes for which it is suitable, or a list whose
297first element is 'not followed by modes which are not suitable. 290first element is `not' followed by modes which are not suitable.
298 291
299t means the buffer is suitable if its name does not begin with ` ' nor 292t means the buffer is suitable if its name does not begin with ` ' nor
300`*' and the buffer has a filename. 293`*' and the buffer has a filename.
301 294
302nil means no buffers are suitable for `global-highlight-changes' 295A value of nil means no buffers are suitable for `global-highlight-changes'
303(effectively disabling the mode). 296(effectively disabling the mode).
304 297
305Examples: 298Examples:
@@ -316,18 +309,16 @@ modes only."
316 :value buffer-file-name) 309 :value buffer-file-name)
317 (const :tag "none" nil) 310 (const :tag "none" nil)
318 ) 311 )
319 :group 'highlight-changes 312 :group 'highlight-changes)
320 )
321
322 313
323(defvar global-highlight-changes nil) 314(defvar global-highlight-changes nil)
324 315
325(defcustom highlight-changes-global-changes-existing-buffers nil 316(defcustom highlight-changes-global-changes-existing-buffers nil
326 "*If non-nil toggling global Highlight Changes mode affects existing buffers. 317 "*If non-nil, toggling global Highlight Changes mode affects existing buffers.
327Normally, `global-highlight-changes' means affects only new buffers (to be 318Normally, `global-highlight-changes' affects only new buffers (to be
328created). However, if highlight-changes-global-changes-existing-buffers 319created). However, if `highlight-changes-global-changes-existing-buffers'
329is non-nil then turning on `global-highlight-changes' will turn on 320is non-nil, then turning on `global-highlight-changes' will turn on
330highlight-changes-mode in suitable buffers and turning the mode off will 321Highlight Changes mode in suitable buffers, and turning the mode off will
331remove it from existing buffers." 322remove it from existing buffers."
332 :type 'boolean 323 :type 'boolean
333 :group 'highlight-changes) 324 :group 'highlight-changes)
@@ -374,12 +365,11 @@ remove it from existing buffers."
374 )) 365 ))
375 (let ((parent (widget-get w :parent))) 366 (let ((parent (widget-get w :parent)))
376 (when parent 367 (when parent
377 (widget-apply parent :notify w event))) 368 (widget-apply parent :notify w event))))
378 )
379 369
380 370
381(defcustom highlight-changes-face-list nil 371(defcustom highlight-changes-face-list nil
382 "*A list of faces used when rotatating changes. 372 "*A list of faces used when rotating changes.
383Normally the variable is initialized to nil and the list is created from 373Normally the variable is initialized to nil and the list is created from
384`highlight-changes-colours' when needed. However, you can set this variable 374`highlight-changes-colours' when needed. However, you can set this variable
385to any list of faces. You will have to do this if you want faces which 375to any list of faces. You will have to do this if you want faces which
@@ -392,8 +382,7 @@ Otherwise, this list will be constructed when needed from
392 face ) 382 face )
393 (const :tag "Derive from highlight-changes-colours" nil) 383 (const :tag "Derive from highlight-changes-colours" nil)
394 ) 384 )
395 :group 'highlight-changes 385 :group 'highlight-changes)
396 )
397 386
398;; ======================================================================== 387;; ========================================================================
399 388
@@ -421,8 +410,7 @@ Otherwise, this list will be constructed when needed from
421 (autoload 'ediff-really-quit "ediff") 410 (autoload 'ediff-really-quit "ediff")
422 (autoload 'ediff-make-fine-diffs "ediff") 411 (autoload 'ediff-make-fine-diffs "ediff")
423 (autoload 'ediff-get-fine-diff-vector "ediff") 412 (autoload 'ediff-get-fine-diff-vector "ediff")
424 (autoload 'ediff-get-difference "ediff") 413 (autoload 'ediff-get-difference "ediff"))
425 )
426 414
427 415
428 416
@@ -441,17 +429,16 @@ Otherwise, this list will be constructed when needed from
441 (setq end (text-property-not-all start limit 'hilit-chg prop)) 429 (setq end (text-property-not-all start limit 'hilit-chg prop))
442 (if prop 430 (if prop
443 (funcall func prop start (or end limit))) 431 (funcall func prop start (or end limit)))
444 (setq start end) 432 (setq start end))))
445 )))
446 433
447 434
448(defun hilit-chg-display-changes (&optional beg end) 435(defun hilit-chg-display-changes (&optional beg end)
449 "Display face information for Highlight Changes mode. 436 "Display face information for Highlight Changes mode.
450 437
451An overlay containing a change face is added, from the information 438An overlay containing a change face is added from the information
452in the text property of type change. 439in the text property of type `hilit-chg'.
453 440
454This is the opposite of hilit-chg-hide-changes." 441This is the opposite of `hilit-chg-hide-changes'."
455 (hilit-chg-map-changes 'hilit-chg-make-ov beg end)) 442 (hilit-chg-map-changes 'hilit-chg-make-ov beg end))
456 443
457 444
@@ -476,9 +463,7 @@ This is the opposite of hilit-chg-hide-changes."
476 ;; of our overlays (so we don't delete someone else's). 463 ;; of our overlays (so we don't delete someone else's).
477 (overlay-put ov 'hilit-chg t) 464 (overlay-put ov 'hilit-chg t)
478 ) 465 )
479 (error "hilit-chg-make-ov: no face for prop: %s" prop) 466 (error "hilit-chg-make-ov: no face for prop: %s" prop))))
480 )
481 ))
482 467
483(defun hilit-chg-hide-changes (&optional beg end) 468(defun hilit-chg-hide-changes (&optional beg end)
484 "Remove face information for Highlight Changes mode. 469 "Remove face information for Highlight Changes mode.
@@ -486,7 +471,7 @@ This is the opposite of hilit-chg-hide-changes."
486The overlay containing the face is removed, but the text property 471The overlay containing the face is removed, but the text property
487containing the change information is retained. 472containing the change information is retained.
488 473
489This is the opposite of hilit-chg-display-changes." 474This is the opposite of `hilit-chg-display-changes'."
490 (let ((start (or beg (point-min))) 475 (let ((start (or beg (point-min)))
491 (limit (or end (point-max))) 476 (limit (or end (point-max)))
492 p ov) 477 p ov)
@@ -495,11 +480,10 @@ This is the opposite of hilit-chg-display-changes."
495 ;; don't delete the overlay if it isn't ours! 480 ;; don't delete the overlay if it isn't ours!
496 (if (overlay-get (car p) 'hilit-chg) 481 (if (overlay-get (car p) 'hilit-chg)
497 (delete-overlay (car p))) 482 (delete-overlay (car p)))
498 (setq p (cdr p)) 483 (setq p (cdr p)))))
499 )))
500 484
501(defun hilit-chg-fixup (beg end) 485(defun hilit-chg-fixup (beg end)
502 "Fix change overlays in region beg .. end. 486 "Fix change overlays in region between BEG and END.
503 487
504Ensure the overlays agree with the changes as determined from 488Ensure the overlays agree with the changes as determined from
505the text properties of type `hilit-chg' ." 489the text properties of type `hilit-chg' ."
@@ -523,26 +507,16 @@ the text properties of type `hilit-chg' ."
523 (setq ov (make-overlay end ov-end)) 507 (setq ov (make-overlay end ov-end))
524 (while props 508 (while props
525 (overlay-put ov (car props)(car (cdr props))) 509 (overlay-put ov (car props)(car (cdr props)))
526 (setq props (cdr (cdr props)))) 510 (setq props (cdr (cdr props)))))))
527 )
528 )
529 )
530 (if (> ov-end end) 511 (if (> ov-end end)
531 (move-overlay ov end ov-end) 512 (move-overlay ov end ov-end)
532 (delete-overlay ov) 513 (delete-overlay ov)))
533 ))
534 (setq p (cdr p))) 514 (setq p (cdr p)))
535 (hilit-chg-display-changes beg end) 515 (hilit-chg-display-changes beg end)))
536 ))
537
538
539
540
541
542 516
543;;;###autoload 517;;;###autoload
544(defun highlight-changes-remove-highlight (beg end) 518(defun highlight-changes-remove-highlight (beg end)
545 "Remove the change face from the region. 519 "Remove the change face from the region between BEG and END.
546This allows you to manually remove highlighting from uninteresting changes." 520This allows you to manually remove highlighting from uninteresting changes."
547 (interactive "r") 521 (interactive "r")
548 (let ((after-change-functions nil)) 522 (let ((after-change-functions nil))
@@ -560,7 +534,7 @@ This allows you to manually remove highlighting from uninteresting changes."
560 ;; 534 ;;
561 ;; We do NOT want to simply do this if this is an undo command, because 535 ;; We do NOT want to simply do this if this is an undo command, because
562 ;; otherwise an undone change shows up as changed. While the properties 536 ;; otherwise an undone change shows up as changed. While the properties
563 ;; are automatically restored by undo, we must fixup the overlay. 537 ;; are automatically restored by undo, we must fix up the overlay.
564 (save-match-data 538 (save-match-data
565 (let ((beg-decr 1) (end-incr 1) 539 (let ((beg-decr 1) (end-incr 1)
566 (type 'hilit-chg) 540 (type 'hilit-chg)
@@ -574,7 +548,7 @@ This allows you to manually remove highlighting from uninteresting changes."
574 ;; The eolp and bolp tests are a kludge! But they prevent 548 ;; The eolp and bolp tests are a kludge! But they prevent
575 ;; rather nasty looking displays when deleting text at the end 549 ;; rather nasty looking displays when deleting text at the end
576 ;; of line, such as normal corrections as one is typing and 550 ;; of line, such as normal corrections as one is typing and
577 ;; immediately makes a corrections, and when deleting first 551 ;; immediately makes a correction, and when deleting first
578 ;; character of a line. 552 ;; character of a line.
579;;; (if (= leng-before 1) 553;;; (if (= leng-before 1)
580;;; (if (eolp) 554;;; (if (eolp)
@@ -599,12 +573,7 @@ This allows you to manually remove highlighting from uninteresting changes."
599 (unless no-proerty-change 573 (unless no-proerty-change
600 (put-text-property beg end 'hilit-chg type)) 574 (put-text-property beg end 'hilit-chg type))
601 (if (or (eq highlight-changes-mode 'active) no-proerty-change) 575 (if (or (eq highlight-changes-mode 'active) no-proerty-change)
602 (hilit-chg-make-ov type beg end)) 576 (hilit-chg-make-ov type beg end))))))
603 ))))
604
605
606
607
608 577
609(defun hilit-chg-set (value) 578(defun hilit-chg-set (value)
610 "Turn on Highlight Changes mode for this buffer." 579 "Turn on Highlight Changes mode for this buffer."
@@ -619,12 +588,10 @@ This allows you to manually remove highlighting from uninteresting changes."
619 ;; mode is passive 588 ;; mode is passive
620 (setq hilit-chg-string highlight-changes-passive-string) 589 (setq hilit-chg-string highlight-changes-passive-string)
621 (or buffer-read-only 590 (or buffer-read-only
622 (hilit-chg-hide-changes)) 591 (hilit-chg-hide-changes)))
623 )
624 (force-mode-line-update) 592 (force-mode-line-update)
625 (make-local-hook 'after-change-functions) 593 (make-local-hook 'after-change-functions)
626 (add-hook 'after-change-functions 'hilit-chg-set-face-on-change nil t) 594 (add-hook 'after-change-functions 'hilit-chg-set-face-on-change nil t))
627 )
628 595
629(defun hilit-chg-clear () 596(defun hilit-chg-clear ()
630 "Remove Highlight Changes mode for this buffer. 597 "Remove Highlight Changes mode for this buffer.
@@ -646,24 +613,24 @@ This removes all saved change information."
646 ;; If we type: C-u -1 M-x highlight-changes-mode 613 ;; If we type: C-u -1 M-x highlight-changes-mode
647 ;; we want to turn it off, but hilit-chg-post-command-hook 614 ;; we want to turn it off, but hilit-chg-post-command-hook
648 ;; runs and that turns it back on! 615 ;; runs and that turns it back on!
649 (remove-hook 'post-command-hook 'hilit-chg-post-command-hook) 616 (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)))
650 ))
651 617
652;;;###autoload 618;;;###autoload
653(defun highlight-changes-mode (&optional arg) 619(defun highlight-changes-mode (&optional arg)
654 "Toggle (or initially set) Highlight Changes mode. 620 "Toggle (or initially set) Highlight Changes mode.
655 621
656Without an argument, 622Without an argument:
657 if Highlight Changes mode is not enabled, then enable it (to either active 623 If Highlight Changes mode is not enabled, then enable it (in either active
658 or passive as determined by variable highlight-changes-initial-state); 624 or passive state as determined by the variable
659 otherwise, toggle between active and passive states. 625 `highlight-changes-initial-state'); otherwise, toggle between active
626 and passive state.
660 627
661With an argument, 628With an argument ARG:
662 if just C-u or a positive argument, set state to active; 629 If ARG is positive, set state to active;
663 with a zero argument, set state to passive; 630 If ARG is zero, set state to passive;
664 with a negative argument, disable Highlight Changes mode completely. 631 If ARG is negative, disable Highlight Changes mode completely.
665 632
666Active state - means changes are shown in a distinctive face. 633Active state - means changes are shown in a distinctive face.
667Passive state - means changes are kept and new ones recorded but are 634Passive state - means changes are kept and new ones recorded but are
668 not displayed in a different face. 635 not displayed in a different face.
669 636
@@ -677,12 +644,10 @@ Functions:
677through 644through
678 various faces. 645 various faces.
679 646
680
681Hook variables: 647Hook variables:
682highlight-changes-enable-hook - when Highlight Changes mode enabled. 648`highlight-changes-enable-hook' - when enabling Highlight Changes mode.
683highlight-changes-toggle-hook - when entering active or passive state 649`highlight-changes-toggle-hook' - when entering active or passive state
684highlight-changes-disable-hook - when turning off Highlight Changes mode. 650`highlight-changes-disable-hook' - when turning off Highlight Changes mode."
685"
686 (interactive "P") 651 (interactive "P")
687 (if (or (display-color-p) 652 (if (or (display-color-p)
688 (and (fboundp 'x-display-grayscale-p) (x-display-grayscale-p))) 653 (and (fboundp 'x-display-grayscale-p) (x-display-grayscale-p)))
@@ -704,8 +669,7 @@ highlight-changes-disable-hook - when turning off Highlight Changes mode.
704 ((< (prefix-numeric-value arg) 0) 669 ((< (prefix-numeric-value arg) 0)
705 nil) 670 nil)
706 (t 671 (t
707 'passive) 672 'passive))))
708 )))
709 (if new-highlight-changes-mode 673 (if new-highlight-changes-mode
710 ;; mode is turned on -- but may be passive 674 ;; mode is turned on -- but may be passive
711 (progn 675 (progn
@@ -716,12 +680,8 @@ highlight-changes-disable-hook - when turning off Highlight Changes mode.
716 (run-hooks 'highlight-changes-toggle-hook)) 680 (run-hooks 'highlight-changes-toggle-hook))
717 ;; mode is turned off 681 ;; mode is turned off
718 (run-hooks 'highlight-changes-disable-hook) 682 (run-hooks 'highlight-changes-disable-hook)
719 (hilit-chg-clear)) 683 (hilit-chg-clear)))
720 ) 684 (message "Highlight Changes mode requires color or grayscale display")))
721 (message "Highlight Changes mode requires color or grayscale display"))
722 )
723
724
725 685
726;;;###autoload 686;;;###autoload
727(defun highlight-changes-next-change () 687(defun highlight-changes-next-change ()
@@ -765,12 +725,10 @@ highlight-changes-disable-hook - when turning off Highlight Changes mode.
765 (message "no previous change"))) 725 (message "no previous change")))
766 (message "This buffer is not in Highlight Changes mode."))) 726 (message "This buffer is not in Highlight Changes mode.")))
767 727
768
769;; ======================================================================== 728;; ========================================================================
770 729
771
772(defun hilit-chg-make-list (&optional force) 730(defun hilit-chg-make-list (&optional force)
773 "Construct hilit-chg-list and highlight-changes-face-list." 731 "Construct `hilit-chg-list' and `highlight-changes-face-list'."
774 ;; Constructs highlight-changes-face-list if necessary, 732 ;; Constructs highlight-changes-face-list if necessary,
775 ;; and hilit-chg-list always: 733 ;; and hilit-chg-list always:
776 ;; Maybe this should always be called when rotating a face 734 ;; Maybe this should always be called when rotating a face
@@ -803,37 +761,32 @@ highlight-changes-disable-hook - when turning off Highlight Changes mode.
803 (setq n (1+ n))) 761 (setq n (1+ n)))
804 (setq hilit-chg-list 762 (setq hilit-chg-list
805 (append hilit-chg-list 763 (append hilit-chg-list
806 (list last-category last-face))) 764 (list last-category last-face)))))
807 ))
808
809 765
810(defun hilit-chg-bump-change (prop start end) 766(defun hilit-chg-bump-change (prop start end)
811 "Increment (age) the Highlight Changes mode text property of type change." 767 "Increment (age) the Highlight Changes mode text property."
812 (let ( new-prop ) 768 (let ( new-prop )
813 (if (eq prop 'hilit-chg-delete) 769 (if (eq prop 'hilit-chg-delete)
814 (setq new-prop (nth 2 hilit-chg-list)) 770 (setq new-prop (nth 2 hilit-chg-list))
815 (setq new-prop (nth 2 (member prop hilit-chg-list))) 771 (setq new-prop (nth 2 (member prop hilit-chg-list))))
816 )
817 (if prop 772 (if prop
818 (put-text-property start end 'hilit-chg new-prop) 773 (put-text-property start end 'hilit-chg new-prop)
819 (message "%d-%d unknown property %s not changed" start end prop) 774 (message "%d-%d unknown property %s not changed" start end prop))))
820 )
821 ))
822 775
823;;;###autoload 776;;;###autoload
824(defun highlight-changes-rotate-faces () 777(defun highlight-changes-rotate-faces ()
825 "Rotate the faces used by Highlight Changes mode. 778 "Rotate the faces used by Highlight Changes mode.
826 779
827Current changes will be display in the face described by the first element 780Current changes are displayed in the face described by the first element
828of highlight-changes-face-list, those (older) changes will be shown in the 781of `highlight-changes-face-list', one level older changes are shown in
829face described by the second element, and so on. Very old changes remain 782face described by the second element, and so on. Very old changes remain
830shown in the last face in the list. 783shown in the last face in the list.
831 784
832You can automatically rotate colours when the buffer is saved 785You can automatically rotate colours when the buffer is saved
833by adding this to local-write-file-hooks, by evaling (in the 786by adding the following to `local-write-file-hooks', by evaling it in the
834buffer to be saved): 787buffer to be saved):
835 (add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces) 788
836" 789 \(add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)"
837 (interactive) 790 (interactive)
838 ;; If not in active mode do nothing but don't complain because this 791 ;; If not in active mode do nothing but don't complain because this
839 ;; may be bound to a hook. 792 ;; may be bound to a hook.
@@ -847,13 +800,11 @@ buffer to be saved):
847 (hilit-chg-map-changes 'hilit-chg-bump-change) 800 (hilit-chg-map-changes 'hilit-chg-bump-change)
848 ;; and display them all if active 801 ;; and display them all if active
849 (if (eq highlight-changes-mode 'active) 802 (if (eq highlight-changes-mode 'active)
850 (hilit-chg-display-changes)) 803 (hilit-chg-display-changes))))
851 ))
852 ;; This always returns nil so it is safe to use in 804 ;; This always returns nil so it is safe to use in
853 ;; local-write-file-hook 805 ;; local-write-file-hook
854 nil) 806 nil)
855 807
856
857;; ======================================================================== 808;; ========================================================================
858;; Comparing with an existing file. 809;; Comparing with an existing file.
859;; This uses ediff to find the differences. 810;; This uses ediff to find the differences.
@@ -863,17 +814,17 @@ buffer to be saved):
863 "Compare this buffer with a file, and highlight differences. 814 "Compare this buffer with a file, and highlight differences.
864 815
865The current buffer must be an unmodified buffer visiting a file, 816The current buffer must be an unmodified buffer visiting a file,
866and not in read-only mode. 817and must not be read-only.
867 818
868If the backup filename exists, it is used as the default 819If the buffer has a backup filename, it is used as the default when
869when called interactively. 820this function is called interactively.
870 821
871If a buffer is visiting the file being compared against, it also will 822If the current buffer is visiting the file being compared against, it
872have its differences highlighted. Otherwise, the file is read in 823also will have its differences highlighted. Otherwise, the file is
873temporarily but the buffer is deleted. 824read in temporarily but the buffer is deleted.
874 825
875If a buffer is read-only, differences will be highlighted but no property 826If the buffer is read-only, differences will be highlighted but no property
876changes made, so \\[highlight-changes-next-change] and 827changes are made, so \\[highlight-changes-next-change] and
877\\[highlight-changes-previous-change] will not work." 828\\[highlight-changes-previous-change] will not work."
878 (interactive (list 829 (interactive (list
879 (read-file-name 830 (read-file-name
@@ -884,8 +835,7 @@ changes made, so \\[highlight-changes-next-change] and
884 (let ((f (make-backup-file-name 835 (let ((f (make-backup-file-name
885 (or (buffer-file-name (current-buffer)) 836 (or (buffer-file-name (current-buffer))
886 (error "no file for this buffer"))))) 837 (error "no file for this buffer")))))
887 (if (file-exists-p f) f "")) 838 (if (file-exists-p f) f "")))))
888 )))
889 839
890 (let* ((buf-a (current-buffer)) 840 (let* ((buf-a (current-buffer))
891 (buf-a-read-only buffer-read-only) 841 (buf-a-read-only buffer-read-only)
@@ -897,8 +847,7 @@ changes made, so \\[highlight-changes-next-change] and
897 (buf-b-read-only (with-current-buffer buf-b buffer-read-only)) 847 (buf-b-read-only (with-current-buffer buf-b buffer-read-only))
898 xy xx yy p q 848 xy xx yy p q
899 a-start a-end len-a 849 a-start a-end len-a
900 b-start b-end len-b 850 b-start b-end len-b)
901 )
902 851
903 ;; We use the fact that the buffer is not marked modified at the 852 ;; We use the fact that the buffer is not marked modified at the
904 ;; end where we clear its modified status 853 ;; end where we clear its modified status
@@ -937,12 +886,10 @@ changes made, so \\[highlight-changes-next-change] and
937 buf-b-read-only ) 886 buf-b-read-only )
938 )) 887 ))
939 (setq p (cdr p)) 888 (setq p (cdr p))
940 (setq q (cdr q)) 889 (setq q (cdr q)))
941 )
942 (if existing-buf 890 (if existing-buf
943 (set-buffer-modified-p nil) 891 (set-buffer-modified-p nil)
944 (kill-buffer buf-b)) 892 (kill-buffer buf-b))))
945 ))
946 893
947 894
948(defun hilit-chg-get-diff-info (buf-a file-a buf-b file-b) 895(defun hilit-chg-get-diff-info (buf-a file-a buf-b file-b)
@@ -972,16 +919,14 @@ changes made, so \\[highlight-changes-next-change] and
972 (setq a (append va nil)) 919 (setq a (append va nil))
973 ;; if not, get the unrefined difference 920 ;; if not, get the unrefined difference
974 (setq va (ediff-get-difference n 'A)) 921 (setq va (ediff-get-difference n 'A))
975 (setq a (list (elt va 0))) 922 (setq a (list (elt va 0))))
976 )
977 ;; a list a list 923 ;; a list a list
978 (setq p a) 924 (setq p a)
979 (while p 925 (while p
980 (setq extent (list (overlay-start (car p)) 926 (setq extent (list (overlay-start (car p))
981 (overlay-end (car p)))) 927 (overlay-end (car p))))
982 (setq p (cdr p)) 928 (setq p (cdr p))
983 (setq x (append x (list extent) )) 929 (setq x (append x (list extent) )));; while p
984 );; while p
985 ;; 930 ;;
986 (setq vb (ediff-get-fine-diff-vector n 'B)) 931 (setq vb (ediff-get-fine-diff-vector n 'B))
987 ;; vb is a vector 932 ;; vb is a vector
@@ -989,26 +934,22 @@ changes made, so \\[highlight-changes-next-change] and
989 (setq b (append vb nil)) 934 (setq b (append vb nil))
990 ;; if not, get the unrefined difference 935 ;; if not, get the unrefined difference
991 (setq vb (ediff-get-difference n 'B)) 936 (setq vb (ediff-get-difference n 'B))
992 (setq b (list (elt vb 0))) 937 (setq b (list (elt vb 0))))
993 )
994 ;; b list a list 938 ;; b list a list
995 (setq p b) 939 (setq p b)
996 (while p 940 (while p
997 (setq extent (list (overlay-start (car p)) 941 (setq extent (list (overlay-start (car p))
998 (overlay-end (car p)))) 942 (overlay-end (car p))))
999 (setq p (cdr p)) 943 (setq p (cdr p))
1000 (setq y (append y (list extent) )) 944 (setq y (append y (list extent) )))
1001 );; while p 945 (setq n (1+ n)));; while
1002 ;;
1003 (setq n (1+ n))
1004 );; while
1005 ;; ediff-quit doesn't work here. 946 ;; ediff-quit doesn't work here.
1006 ;; No point in returning a value, since this is a hook function. 947 ;; No point in returning a value, since this is a hook function.
1007 )) 948 ))
1008 949
1009;; ======================= automatic stuff ============== 950;; ======================= automatic stuff ==============
1010 951
1011;; Global Highlight Changes mode is modelled after Global Font-lock mode. 952;; Global Highlight Changes mode is modeled after Global Font-lock mode.
1012;; Three hooks are used to gain control. When Global Changes Mode is 953;; Three hooks are used to gain control. When Global Changes Mode is
1013;; enabled, `find-file-hooks' and `change-major-mode-hook' are set. 954;; enabled, `find-file-hooks' and `change-major-mode-hook' are set.
1014;; `find-file-hooks' is called when visiting a file, the new mode is 955;; `find-file-hooks' is called when visiting a file, the new mode is
@@ -1027,8 +968,7 @@ changes made, so \\[highlight-changes-next-change] and
1027 968
1028 969
1029(defun hilit-chg-major-mode-hook () 970(defun hilit-chg-major-mode-hook ()
1030 (add-hook 'post-command-hook 'hilit-chg-post-command-hook) 971 (add-hook 'post-command-hook 'hilit-chg-post-command-hook))
1031 )
1032 972
1033(defun hilit-chg-post-command-hook () 973(defun hilit-chg-post-command-hook ()
1034 ;; This is called after changing a major mode, but also after each 974 ;; This is called after changing a major mode, but also after each
@@ -1042,15 +982,13 @@ changes made, so \\[highlight-changes-next-change] and
1042 ;; The following check isn't necessary, since 982 ;; The following check isn't necessary, since
1043 ;; hilit-chg-turn-on-maybe makes this check too. 983 ;; hilit-chg-turn-on-maybe makes this check too.
1044 (or highlight-changes-mode ;; don't turn it on if it already is 984 (or highlight-changes-mode ;; don't turn it on if it already is
1045 (hilit-chg-turn-on-maybe highlight-changes-global-initial-state)) 985 (hilit-chg-turn-on-maybe highlight-changes-global-initial-state))))
1046 ))
1047 986
1048(defun hilit-chg-check-global () 987(defun hilit-chg-check-global ()
1049 ;; This is called from the find file hook. 988 ;; This is called from the find file hook.
1050 (hilit-chg-turn-on-maybe highlight-changes-global-initial-state)) 989 (hilit-chg-turn-on-maybe highlight-changes-global-initial-state))
1051 990
1052 991
1053
1054;;;###autoload 992;;;###autoload
1055(defun global-highlight-changes (&optional arg) 993(defun global-highlight-changes (&optional arg)
1056 "Turn on or off global Highlight Changes mode. 994 "Turn on or off global Highlight Changes mode.
@@ -1063,14 +1001,14 @@ When called interactively:
1063 1001
1064When called from a program: 1002When called from a program:
1065- if ARG is nil or omitted, turn it off 1003- if ARG is nil or omitted, turn it off
1066- if ARG is 'active, turn it on in active mode 1004- if ARG is `active', turn it on in active mode
1067- if ARG is 'passive, turn it on in passive mode 1005- if ARG is `passive', turn it on in passive mode
1068- otherwise just turn it on 1006- otherwise just turn it on
1069 1007
1070When global Highlight Changes mode is enabled, Highlight Changes mode is turned 1008When global Highlight Changes mode is enabled, Highlight Changes mode is turned
1071on for future \"suitable\" buffers (and for \"suitable\" existing buffers if 1009on for future \"suitable\" buffers (and for \"suitable\" existing buffers if
1072variable `highlight-changes-global-changes-existing-buffers' is non-nil). 1010variable `highlight-changes-global-changes-existing-buffers' is non-nil).
1073\"Suitablity\" is determined by variable `highlight-changes-global-modes'." 1011\"Suitability\" is determined by variable `highlight-changes-global-modes'."
1074 1012
1075 (interactive 1013 (interactive
1076 (list 1014 (list
@@ -1104,8 +1042,8 @@ variable `highlight-changes-global-changes-existing-buffers' is non-nil).
1104 (add-hook 'find-file-hooks 'hilit-chg-check-global) 1042 (add-hook 'find-file-hooks 'hilit-chg-check-global)
1105 (if highlight-changes-global-changes-existing-buffers 1043 (if highlight-changes-global-changes-existing-buffers
1106 (hilit-chg-update-all-buffers 1044 (hilit-chg-update-all-buffers
1107 highlight-changes-global-initial-state)) 1045 highlight-changes-global-initial-state)))
1108 ) 1046
1109 (message "turning OFF global Highlight Changes mode") 1047 (message "turning OFF global Highlight Changes mode")
1110 (remove-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook) 1048 (remove-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook)
1111 (remove-hook 'find-file-hooks 'hilit-chg-check-global) 1049 (remove-hook 'find-file-hooks 'hilit-chg-check-global)
@@ -1113,12 +1051,7 @@ variable `highlight-changes-global-changes-existing-buffers' is non-nil).
1113 'hilit-chg-post-command-hook) 1051 'hilit-chg-post-command-hook)
1114 (remove-hook 'find-file-hooks 'hilit-chg-check-global) 1052 (remove-hook 'find-file-hooks 'hilit-chg-check-global)
1115 (if highlight-changes-global-changes-existing-buffers 1053 (if highlight-changes-global-changes-existing-buffers
1116 (hilit-chg-update-all-buffers nil)) 1054 (hilit-chg-update-all-buffers nil))))
1117 )
1118 )
1119
1120
1121
1122 1055
1123 1056
1124(defun hilit-chg-turn-on-maybe (value) 1057(defun hilit-chg-turn-on-maybe (value)
@@ -1127,12 +1060,12 @@ variable `highlight-changes-global-changes-existing-buffers' is non-nil).
1127A buffer is appropriate for Highlight Changes mode if all these are true: 1060A buffer is appropriate for Highlight Changes mode if all these are true:
1128- the buffer is not a special buffer (one whose name begins with 1061- the buffer is not a special buffer (one whose name begins with
1129 `*' or ` ') 1062 `*' or ` ')
1130- the buffer's mode is suitable as per variable highlight-changes-global-modes 1063- the buffer's mode is suitable as per variable
1064 `highlight-changes-global-modes'
1131- Highlight Changes mode is not already on for this buffer. 1065- Highlight Changes mode is not already on for this buffer.
1132 1066
1133This function is called from hilit-chg-update-all-buffers 1067This function is called from `hilit-chg-update-all-buffers' or
1134from `global-highlight-changes' when turning on global Highlight Changes mode. 1068from `global-highlight-changes' when turning on global Highlight Changes mode."
1135"
1136 (or highlight-changes-mode ; do nothing if already on 1069 (or highlight-changes-mode ; do nothing if already on
1137 (if 1070 (if
1138 (cond 1071 (cond
@@ -1147,12 +1080,10 @@ from `global-highlight-changes' when turning on global Highlight Changes mode.
1147 (t 1080 (t
1148 (and 1081 (and
1149 (not (string-match "^[ *]" (buffer-name))) 1082 (not (string-match "^[ *]" (buffer-name)))
1150 (buffer-file-name)) 1083 (buffer-file-name))))
1151 ))
1152 (progn 1084 (progn
1153 (hilit-chg-set value) 1085 (hilit-chg-set value)
1154 (run-hooks 'highlight-changes-enable-hook))) 1086 (run-hooks 'highlight-changes-enable-hook)))))
1155 ))
1156 1087
1157 1088
1158(defun hilit-chg-turn-off-maybe () 1089(defun hilit-chg-turn-off-maybe ()
@@ -1162,7 +1093,6 @@ from `global-highlight-changes' when turning on global Highlight Changes mode.
1162 (hilit-chg-clear)))) 1093 (hilit-chg-clear))))
1163 1094
1164 1095
1165
1166(defun hilit-chg-update-all-buffers (value) 1096(defun hilit-chg-update-all-buffers (value)
1167 (mapcar 1097 (mapcar
1168 (function (lambda (buffer) 1098 (function (lambda (buffer)
@@ -1187,7 +1117,6 @@ from `global-highlight-changes' when turning on global Highlight Changes mode.
1187;; 1117;;
1188;; ================== end of debug =============== 1118;; ================== end of debug ===============
1189 1119
1190
1191(provide 'hilit-chg) 1120(provide 'hilit-chg)
1192 1121
1193;;; hilit-chg.el ends here 1122;;; hilit-chg.el ends here