hilit-chg.el 37 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2
;;; hilit-chg.el --- minor mode displaying buffer changes with special face

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1998, 2000-2019 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4

Karl Heuer's avatar
Karl Heuer committed
5
;; Author: Richard Sharman <rsharman@pobox.com>
Richard M. Stallman's avatar
Richard M. Stallman committed
6 7
;; Keywords: faces

Karl Heuer's avatar
Karl Heuer committed
8 9
;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
14

Gerd Moellmann's avatar
Gerd Moellmann committed
15
;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
16 17 18 19 20
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
22 23 24 25 26

;;; Commentary:

;; A minor mode: "Highlight Changes mode".

27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
;; When Highlight Changes mode is enabled changes to the buffer are
;; recorded with a text property.  Normally these ranges of text are
;; displayed in a distinctive face.  However, sometimes it is
;; desirable to temporarily not see these changes.  Instead of
;; disabling Highlight Changes mode (which would remove the text property)
;; use the command highlight-changes-visible-mode.

;; Two faces are supported: one for changed or inserted text and
;; another for the first character after text has been deleted.

;; When Highlight Changes mode is on (even if changes are not visible)
;; you can go to the next or previous change with
;; `highlight-changes-next-change' or `highlight-changes-previous-change'.

;; Command highlight-compare-with-file shows changes in this file
;; compared with another file (by default the previous version of the
;; file).
Richard M. Stallman's avatar
Richard M. Stallman committed
44
;;
45 46 47
;; The command highlight-compare-buffers compares two buffers by
;; highlighting their differences.

Richard M. Stallman's avatar
Richard M. Stallman committed
48
;; You can "age" different sets of changes by using
49
;; `highlight-changes-rotate-faces'.  This rotates through a series
Richard M. Stallman's avatar
Richard M. Stallman committed
50
;; of different faces, so you can distinguish "new" changes from "older"
Richard M. Stallman's avatar
Richard M. Stallman committed
51
;; changes.  You can customize these "rotated" faces in two ways.  You can
Richard M. Stallman's avatar
Richard M. Stallman committed
52 53
;; either explicitly define each face by customizing
;; `highlight-changes-face-list'.  If, however, the faces differ from
54
;; `highlight-changes-face' only in the foreground color, you can simply set
55
;; `highlight-changes-colors'.  If `highlight-changes-face-list' is nil when
Richard M. Stallman's avatar
Richard M. Stallman committed
56
;; the faces are required they will be constructed from
57
;; `highlight-changes-colors'.
58 59 60 61

;; You can automatically rotate faces when the buffer is saved;
;; see function `highlight-changes-rotate-faces' for how to do this.

62 63 64 65
;; The hook `highlight-changes-mode-hook' is called when
;; Highlight Changes mode is turned on or off.
;; When it called, variable `highlight-changes-mode' has been updated
;; to the new value.
66
;;
67 68 69 70 71 72
;; Example usage:
;; (defun my-highlight-changes-mode-hook ()
;;   (if highlight-changes-mode
;;       (add-hook 'write-file-functions 'highlight-changes-rotate-faces nil t)
;;     (remove-hook 'write-file-functions 'highlight-changes-rotate-faces t)
;;     ))
Richard M. Stallman's avatar
Richard M. Stallman committed
73 74


75
;;           Automatically enabling Highlight Changes mode
Richard M. Stallman's avatar
Richard M. Stallman committed
76 77 78 79 80 81
;;

;; Normally, Highlight Changes mode is turned on explicitly in a buffer.
;;
;; If you prefer to have it automatically invoked you can do it as
;; follows.
82

Richard M. Stallman's avatar
Richard M. Stallman committed
83
;; 1. Most modes have a major-hook, typically called MODE-hook.  You
84
;; can use `add-hook' to call `highlight-changes-mode'.
85

Richard M. Stallman's avatar
Richard M. Stallman committed
86 87
;;   Example:
;;	(add-hook 'c-mode-hook 'highlight-changes-mode)
88

Richard M. Stallman's avatar
Richard M. Stallman committed
89 90
;; However, this cannot be done for Fundamental mode for there is no
;; such hook.
91 92

;; 2. You can use the function `global-highlight-changes-mode'
Richard M. Stallman's avatar
Richard M. Stallman committed
93 94 95
;;
;; This function, which is fashioned after the way `global-font-lock' works,
;; toggles on or off global Highlight Changes mode.  When activated, it turns
96
;; on Highlight Changes mode in all "suitable" existing buffers and will turn
Richard M. Stallman's avatar
Richard M. Stallman committed
97
;; it on in new "suitable" buffers to be created.
98

Richard M. Stallman's avatar
Richard M. Stallman committed
99
;; A buffer's "suitability" is determined by variable
100
;; `highlight-changes-global-modes', as follows.  If it is
Richard M. Stallman's avatar
Richard M. Stallman committed
101 102
;; * nil  -- then no buffers are suitable;
;; * a function -- this function is called and the result is used.  As
103
;;   an example, if the value is `buffer-file-name' then all buffers
Richard M. Stallman's avatar
Richard M. Stallman committed
104 105
;;   who are visiting files are suitable, but others (like dired
;;   buffers) are not;
106
;; * a list -- then the buffer is suitable if and only if its mode is in the
107
;;   list, except if the first element is `not', in which case the test
Richard M. Stallman's avatar
Richard M. Stallman committed
108
;;   is reversed (i.e. it is a list of unsuitable modes).
109
;; * Otherwise, the buffer is suitable if its name does not begin with
Richard M. Stallman's avatar
Richard M. Stallman committed
110 111
;;   ` ' or `*' and if `buffer-file-name' returns true.

112 113
;; To enable it for future sessions put this in your ~/.emacs file:
;;		(global-highlight-changes-mode t)
Richard M. Stallman's avatar
Richard M. Stallman committed
114 115 116 117 118 119


;;     Possible bindings:
;; (global-set-key '[C-right] 'highlight-changes-next-change)
;; (global-set-key '[C-left]  'highlight-changes-previous-change)
;;
120
;;     Other interactive functions (that could be bound if desired):
Richard M. Stallman's avatar
Richard M. Stallman committed
121
;; highlight-changes-mode
122
;; highlight-changes-toggle-visibility
Richard M. Stallman's avatar
Richard M. Stallman committed
123
;; highlight-changes-remove-highlight
Karl Heuer's avatar
Karl Heuer committed
124
;; highlight-compare-with-file
125
;; highlight-compare-buffers
126
;; highlight-changes-rotate-faces
Richard M. Stallman's avatar
Richard M. Stallman committed
127 128 129 130 131


;;; Bugs:

;; - the next-change and previous-change functions are too literal;
132
;;   they should find the next "real" change, in other words treat
Richard M. Stallman's avatar
Richard M. Stallman committed
133 134 135
;;   consecutive changes as one.


136
;;; To do (maybe), notes, ...
Richard M. Stallman's avatar
Richard M. Stallman committed
137 138 139

;; - having different faces for deletion and non-deletion: is it
;;   really worth the hassle?
Karl Heuer's avatar
Karl Heuer committed
140 141
;; - highlight-compare-with-file should allow RCS files - e.g. nice to be
;;   able to say show changes compared with version 2.1.
Richard M. Stallman's avatar
Richard M. Stallman committed
142 143 144 145


;;; History:

146
;; R Sharman (rsharman@pobox.com) Feb 1998:
Richard M. Stallman's avatar
Richard M. Stallman committed
147 148
;; - initial release as change-mode.
;; Jari Aalto <jari.aalto@ntc.nokia.com> Mar 1998
149
;; - fixes for byte compile errors
Richard M. Stallman's avatar
Richard M. Stallman committed
150 151 152 153 154 155 156 157
;; - use eval-and-compile for autoload
;; Marijn Ros <J.M.Ros@fys.ruu.nl> Mar 98
;; - suggested turning it on by default
;; Eric Ludlam <zappo@gnu.org> Suggested using overlays.
;; July 98
;; - global mode and various stuff added
;; - Changed to use overlays
;; August 98
158
;; - renamed to Highlight Changes mode.
159 160 161
;; Dec 2003
;; - Use require for ediff stuff
;; - Added highlight-compare-buffers
162 163 164 165 166 167
;; Mar 2008
;; - Made highlight-changes-mode like other modes (toggle on/off)
;; - Added new command highlight-changes-visible-mode to replace the
;;   previous active/passive aspect of highlight-changes-mode.
;; - Removed highlight-changes-toggle-hook
;; - Put back eval-and-compile inadvertently dropped
168 169 170
;; May 2008
;; - Removed highlight-changes-disable-hook and highlight-changes-enable-hook
;;   because highlight-changes-mode-hook can do both.
Richard M. Stallman's avatar
Richard M. Stallman committed
171 172 173 174 175 176 177 178

;;; Code:

(require 'wid-edit)

;; ====================== Customization =======================
(defgroup highlight-changes nil
  "Highlight Changes mode."
179
  :version "20.4"
Richard M. Stallman's avatar
Richard M. Stallman committed
180 181 182 183 184 185 186
  :group 'faces)


;; Face information: How the changes appear.

;; Defaults for face: red foreground, no change to background,
;; and underlined if a change is because of a deletion.
187
;; Note: underlining is helpful in that it shows up changes in white space.
Richard M. Stallman's avatar
Richard M. Stallman committed
188 189 190
;; However, having it set for non-delete changes can be annoying because all
;; indentation on inserts gets underlined (which can look pretty ugly!).

191
(defface highlight-changes
192
  '((((min-colors 88) (class color)) (:foreground "red1"))
193
    (((class color)) (:foreground "red" ))
Richard M. Stallman's avatar
Richard M. Stallman committed
194 195
    (t (:inverse-video t)))
  "Face used for highlighting changes."
196
  :group 'highlight-changes)
Richard M. Stallman's avatar
Richard M. Stallman committed
197 198

;; This looks pretty ugly, actually.  Maybe the underline should be removed.
199
(defface highlight-changes-delete
200 201
  '((((min-colors 88) (class color)) (:foreground "red1" :underline t))
    (((class color)) (:foreground "red" :underline t))
Richard M. Stallman's avatar
Richard M. Stallman committed
202 203
    (t (:inverse-video t)))
  "Face used for highlighting deletions."
204
  :group 'highlight-changes)
Richard M. Stallman's avatar
Richard M. Stallman committed
205

206 207
;; A (not very good) default list of colors to rotate through.
(defcustom highlight-changes-colors
Richard M. Stallman's avatar
Richard M. Stallman committed
208 209 210 211 212
  (if (eq (frame-parameter nil 'background-mode) 'light)
      ;; defaults for light background:
      '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue")
      ;; defaults for dark background:
    '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid"))
213
  "Colors used by `highlight-changes-rotate-faces'.
214
The newest rotated change will be displayed in the first element of this list,
Richard M. Stallman's avatar
Richard M. Stallman committed
215 216
the next older will be in the second element etc.

217 218
This list is used if `highlight-changes-face-list' is nil, otherwise that
variable overrides this list.  If you only care about foreground
219
colors then use this, if you want fancier faces then set
Richard M. Stallman's avatar
Richard M. Stallman committed
220
`highlight-changes-face-list'."
221 222
  :type '(repeat color)
  :group 'highlight-changes)
223

224 225 226 227
;; When you invoke highlight-changes-mode, should highlight-changes-visible-mode
;; be on or off?

(define-obsolete-variable-alias 'highlight-changes-initial-state
228
  'highlight-changes-visibility-initial-state "23.1")
Richard M. Stallman's avatar
Richard M. Stallman committed
229

230
(defcustom highlight-changes-visibility-initial-state t
231
  "Controls whether changes are initially visible in Highlight Changes mode.
232

233
This controls the initial value of `highlight-changes-visible-mode'.
234
When a buffer is in Highlight Changes mode the function
235
`highlight-changes-visible-mode' is used to toggle the mode on or off."
236
  :type 'boolean
237
  :group 'highlight-changes)
Richard M. Stallman's avatar
Richard M. Stallman committed
238

239 240 241 242 243
;; highlight-changes-global-initial-state has been removed



;; These are the strings displayed in the mode-line for the minor mode:
244 245
(define-obsolete-variable-alias 'highlight-changes-active-string
  'highlight-changes-visible-string "23.1")
246 247 248

(defcustom highlight-changes-visible-string " +Chg"
  "The string used when in Highlight Changes mode and changes are visible.
249
This should be set to nil if no indication is desired, or to
Richard M. Stallman's avatar
Richard M. Stallman committed
250 251 252
a string with a leading space."
  :type '(choice string
		 (const :tag "None"  nil))
253
  :group 'highlight-changes)
Richard M. Stallman's avatar
Richard M. Stallman committed
254

255 256
(define-obsolete-variable-alias 'highlight-changes-passive-string
  'highlight-changes-invisible-string "23.1")
257 258 259

(defcustom highlight-changes-invisible-string " -Chg"
  "The string used when in Highlight Changes mode and changes are hidden.
260
This should be set to nil if no indication is desired, or to
Richard M. Stallman's avatar
Richard M. Stallman committed
261 262 263
a string with a leading space."
  :type '(choice string
		 (const :tag "None"  nil))
264
  :group 'highlight-changes)
Richard M. Stallman's avatar
Richard M. Stallman committed
265 266

(defcustom highlight-changes-global-modes t
267
  "Determine whether a buffer is suitable for global Highlight Changes mode.
Richard M. Stallman's avatar
Richard M. Stallman committed
268

269 270
A function means call that function to decide: if it returns non-nil,
the buffer is suitable.
Richard M. Stallman's avatar
Richard M. Stallman committed
271

272 273 274
A list means the elements are major modes suitable for Highlight
Changes mode, or a list whose first element is `not' followed by major
modes which are not suitable.
Richard M. Stallman's avatar
Richard M. Stallman committed
275

276 277
A value of t means the buffer is suitable if it is visiting a file and
its name does not begin with ` ' or `*'.
Richard M. Stallman's avatar
Richard M. Stallman committed
278

279
A value of nil means no buffers are suitable for `global-highlight-changes-mode'
Stefan Monnier's avatar
Stefan Monnier committed
280
\(effectively disabling the mode).
Richard M. Stallman's avatar
Richard M. Stallman committed
281

282
Example:
283
	(c-mode c++-mode)
Richard M. Stallman's avatar
Richard M. Stallman committed
284 285
means that Highlight Changes mode is turned on for buffers in C and C++
modes only."
286
  :type '(choice
Richard M. Stallman's avatar
Richard M. Stallman committed
287 288 289 290 291 292 293 294 295
	  (const :tag "all non-special buffers visiting files" t)
	  (set :menu-tag "specific modes" :tag "modes"
	       :value (not)
	       (const :tag "All except these" not)
	       (repeat :tag "Modes" :inline t (symbol :tag "mode")))
	  (function :menu-tag "determined by function"
			   :value buffer-file-name)
	  (const :tag "none" nil)
	  )
296
  :group 'highlight-changes)
Richard M. Stallman's avatar
Richard M. Stallman committed
297 298

(defcustom highlight-changes-global-changes-existing-buffers nil
299
  "If non-nil, toggling global Highlight Changes mode affects existing buffers.
Glenn Morris's avatar
Glenn Morris committed
300
Normally, `global-highlight-changes-mode' affects only new buffers (to be
301
created).  However, if `highlight-changes-global-changes-existing-buffers'
Glenn Morris's avatar
Glenn Morris committed
302
is non-nil, then turning on `global-highlight-changes-mode' will turn on
303
Highlight Changes mode in suitable buffers, and turning the mode off will
Richard M. Stallman's avatar
Richard M. Stallman committed
304 305 306 307
remove it from existing buffers."
  :type 'boolean
  :group 'highlight-changes)

308 309 310 311 312 313 314 315 316 317 318 319 320
;; These are for internal use.

(defvar hilit-chg-list nil)
(defvar hilit-chg-string " ??")

(make-variable-buffer-local 'hilit-chg-string)



;;; Functions...

;;;###autoload
(define-minor-mode highlight-changes-mode
321
  "Toggle highlighting changes in this buffer (Highlight Changes mode).
322

323 324
When Highlight Changes is enabled, changes are marked with a text
property.  Normally they are displayed in a distinctive face, but
325
command \\[highlight-changes-visible-mode] can be used to toggle
326
this on and off.
327 328 329 330 331 332 333 334 335

Other functions for buffers in this mode include:
\\[highlight-changes-next-change] - move point to beginning of next change
\\[highlight-changes-previous-change] - move to beginning of previous change
\\[highlight-changes-remove-highlight] - remove the change face from the region
\\[highlight-changes-rotate-faces] - rotate different \"ages\" of changes
through	various faces.
\\[highlight-compare-with-file] - mark text as changed by comparing this
buffer with the contents of a file
336
\\[highlight-compare-buffers] highlights differences between two buffers."
337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358
  nil			;; init-value
  hilit-chg-string	;; lighter
  nil			;; keymap
  (if (or (display-color-p)
	  (and (fboundp 'x-display-grayscale-p) (x-display-grayscale-p)))
      (progn
	(if (and (eq this-command 'global-highlight-changes-mode)
		 (not highlight-changes-global-changes-existing-buffers))
	    ;; The global mode has toggled the value of the mode variable,
	    ;; but not other changes have been mode, so we are safe
	    ;; to retoggle it.
	    (setq highlight-changes-mode (not highlight-changes-mode)))
	(if highlight-changes-mode
	    ;; it is being turned on
	    (hilit-chg-set)
	  ;; mode is turned off
	  (hilit-chg-clear)))
    (message "Highlight Changes mode requires color or grayscale display")))


;;;###autoload
(define-minor-mode highlight-changes-visible-mode
Paul Eggert's avatar
Paul Eggert committed
359
  "Toggle visibility of highlighting due to Highlight Changes mode.
360

361 362
Highlight Changes Visible mode only has an effect when Highlight
Changes mode is on.  When enabled, the changed text is displayed
363 364 365
in a distinctive face.

The default value can be customized with variable
366
`highlight-changes-visibility-initial-state'.
367

368
This command does not itself set Highlight Changes mode."
369 370 371 372 373 374 375 376 377

  t		;; init-value
  nil		;; lighter
  nil		;; keymap

  (hilit-chg-update)
  )


378
(defun hilit-chg-cust-fix-changes-face-list (w _wc &optional event)
Richard M. Stallman's avatar
Richard M. Stallman committed
379
  ;; When customization function `highlight-changes-face-list' inserts a new
380 381
  ;; face it uses the default face.  We don't want the user to modify this
  ;; face, so we rename the faces in the list on an insert.  The rename is
Richard M. Stallman's avatar
Richard M. Stallman committed
382 383 384 385 386 387 388 389 390 391 392 393 394 395
  ;; actually done by copying the faces so user-defined faces still remain
  ;; in the same order.
  ;; The notifying the parent is needed because without it changes to the
  ;; faces are saved but not to the actual list itself.
  (let ((old-list (widget-value w)))
    (if (member 'default old-list)
	(let
	    ((p (reverse old-list))
	     (n (length old-list))
	     new-name old-name
	     (new-list nil)
	     )
	  (while p
	    (setq old-name (car p))
396
	    (setq new-name (intern (format "highlight-changes-%d" n)))
Richard M. Stallman's avatar
Richard M. Stallman committed
397 398 399
	    (if (eq old-name new-name)
		nil
	      ;; A new face has been inserted: we don't want to modify the
400
	      ;; default face so copy it.  Better, though, (I think) is to
Richard M. Stallman's avatar
Richard M. Stallman committed
401
	      ;; make a new face have the same attributes as
402
	      ;; the `highlight-changes' face.
Richard M. Stallman's avatar
Richard M. Stallman committed
403
	      (if (eq old-name 'default)
404
		  (copy-face 'highlight-changes new-name)
Richard M. Stallman's avatar
Richard M. Stallman committed
405 406
		(copy-face old-name new-name)
		))
407
	    (setq new-list (append (list new-name) new-list))
Richard M. Stallman's avatar
Richard M. Stallman committed
408 409 410 411 412 413 414 415 416 417 418 419
	    (setq n (1- n))
	    (setq p (cdr p)))
	  (if (equal new-list (widget-value w))
	      nil ;; (message "notify: no change!")
	    (widget-value-set w new-list)
	    (widget-setup)
	    )
	  )
      ;; (message "notify: no default here!")
      ))
  (let ((parent (widget-get w :parent)))
    (when parent
420
      (widget-apply parent :notify w event))))
Richard M. Stallman's avatar
Richard M. Stallman committed
421 422 423


(defcustom highlight-changes-face-list nil
424
  "A list of faces used when rotating changes.
Richard M. Stallman's avatar
Richard M. Stallman committed
425
Normally the variable is initialized to nil and the list is created from
426
`highlight-changes-colors' when needed.  However, you can set this variable
Richard M. Stallman's avatar
Richard M. Stallman committed
427
to any list of faces.  You will have to do this if you want faces which
428
don't just differ from the `highlight-changes' face by the foreground color.
Richard M. Stallman's avatar
Richard M. Stallman committed
429
Otherwise, this list will be constructed when needed from
430
`highlight-changes-colors'."
Richard M. Stallman's avatar
Richard M. Stallman committed
431
  :type '(choice
432
	  (repeat
Richard M. Stallman's avatar
Richard M. Stallman committed
433 434
	    :notify hilit-chg-cust-fix-changes-face-list
	    face  )
435
	  (const :tag "Derive from highlight-changes-colors"  nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
436
	  )
437
  :group 'highlight-changes)
Richard M. Stallman's avatar
Richard M. Stallman committed
438 439


440
(defun hilit-chg-map-changes (func &optional start-position end-position)
441 442 443
  "Call function FUNC for each region used by Highlight Changes mode.
If START-POSITION is nil, (point-min) is used.
If END-POSITION is nil, (point-max) is used.
444
FUNC is called with three params: PROPERTY START STOP."
Richard M. Stallman's avatar
Richard M. Stallman committed
445 446 447 448 449 450 451 452
  (let ((start (or start-position (point-min)))
	(limit (or end-position (point-max)))
	prop end)
    (while (and start (< start limit))
      (setq prop (get-text-property start 'hilit-chg))
      (setq end (text-property-not-all start limit 'hilit-chg prop))
      (if prop
	  (funcall func prop start (or end limit)))
453
      (setq start end))))
Richard M. Stallman's avatar
Richard M. Stallman committed
454 455 456 457 458


(defun hilit-chg-display-changes (&optional beg end)
  "Display face information for Highlight Changes mode.

459 460
An overlay from BEG to END containing a change face is added
from the information in the text property of type `hilit-chg'.
Richard M. Stallman's avatar
Richard M. Stallman committed
461

462
This is the opposite of `hilit-chg-hide-changes'."
Richard M. Stallman's avatar
Richard M. Stallman committed
463 464 465 466
  (hilit-chg-map-changes 'hilit-chg-make-ov beg end))


(defun hilit-chg-make-ov (prop start end)
467 468
  (or prop
      (error "hilit-chg-make-ov: prop is nil"))
Paul Eggert's avatar
Paul Eggert committed
469
  ;; For the region create overlays with a distinctive face
470
  ;; and the text property 'hilit-chg.
Richard M. Stallman's avatar
Richard M. Stallman committed
471
  (let ((ov (make-overlay start end))
472 473 474
	(face (if (eq prop 'hilit-chg-delete)
                  'highlight-changes-delete
                (nth 1 (member prop hilit-chg-list)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
475 476
    (if face
	(progn
477
	  ;; We must mark the face, that is the purpose of the overlay.
Richard M. Stallman's avatar
Richard M. Stallman committed
478 479 480 481 482 483 484 485
	  (overlay-put ov 'face face)
	  ;; I don't think we need to set evaporate since we should
	  ;; be controlling them!
	  (overlay-put ov 'evaporate t)
	  ;; We set the change property so we can tell this is one
	  ;; of our overlays (so we don't delete someone else's).
	  (overlay-put ov 'hilit-chg t)
	  )
486
      (error "hilit-chg-make-ov: no face for prop: %s" prop))))
Richard M. Stallman's avatar
Richard M. Stallman committed
487 488 489 490

(defun hilit-chg-hide-changes (&optional beg end)
  "Remove face information for Highlight Changes mode.

491
The overlay containing the face is removed, but the text property
Richard M. Stallman's avatar
Richard M. Stallman committed
492 493
containing the change information is retained.

494
This is the opposite of `hilit-chg-display-changes'."
Richard M. Stallman's avatar
Richard M. Stallman committed
495
  (let ((start (or beg (point-min)))
496 497
	(limit (or end (point-max))))
    (dolist (p (overlays-in start limit))
Richard M. Stallman's avatar
Richard M. Stallman committed
498
      ;; don't delete the overlay if it isn't ours!
499 500 501
      (if (overlay-get p 'hilit-chg)
	  (delete-overlay p)))))

Richard M. Stallman's avatar
Richard M. Stallman committed
502 503

(defun hilit-chg-fixup (beg end)
504
  "Fix change overlays in region between BEG and END.
Richard M. Stallman's avatar
Richard M. Stallman committed
505 506

Ensure the overlays agree with the changes as determined from
507
the text properties of type `hilit-chg'."
Richard M. Stallman's avatar
Richard M. Stallman committed
508
  ;; Remove or alter overlays in region beg..end
509 510
  (remove-overlays beg end 'hilit-chg t)
  (hilit-chg-display-changes beg end))
Richard M. Stallman's avatar
Richard M. Stallman committed
511 512

;;;###autoload
513 514
(defun highlight-changes-remove-highlight (beg end)
  "Remove the change face from the region between BEG and END.
Richard M. Stallman's avatar
Richard M. Stallman committed
515 516
This allows you to manually remove highlighting from uninteresting changes."
  (interactive "r")
517
  (with-silent-modifications
518
    (remove-text-properties beg end '(hilit-chg nil))
Richard M. Stallman's avatar
Richard M. Stallman committed
519 520
    (hilit-chg-fixup beg end)))

521
(defun hilit-chg-set-face-on-change (beg end leng-before
522
					 &optional no-property-change)
Richard M. Stallman's avatar
Richard M. Stallman committed
523 524 525 526 527
  "Record changes and optionally display them in a distinctive face.
`hilit-chg-set' adds this function to the `after-change-functions' hook."
  ;;
  ;; This function is called by the `after-change-functions' hook, which
  ;; is how we are notified when text is changed.
Karl Heuer's avatar
Karl Heuer committed
528
  ;; It is also called from `highlight-compare-with-file'.
Richard M. Stallman's avatar
Richard M. Stallman committed
529 530 531
  ;;
  ;; We do NOT want to simply do this if this is an undo command, because
  ;; otherwise an undone change shows up as changed.  While the properties
532
  ;; are automatically restored by undo, we must fix up the overlay.
Richard M. Stallman's avatar
Richard M. Stallman committed
533
  (save-match-data
534 535 536
    (let (;;(beg-decr 1)
          (end-incr 1)
	  (type 'hilit-chg))
Richard M. Stallman's avatar
Richard M. Stallman committed
537
      (if undo-in-progress
538 539
	  (if (and highlight-changes-mode
		   highlight-changes-visible-mode)
Richard M. Stallman's avatar
Richard M. Stallman committed
540
	      (hilit-chg-fixup beg end))
541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574
        (with-silent-modifications
          (if (and (= beg end) (> leng-before 0))
              ;; deletion
              (progn
                ;; The eolp and bolp tests are a kludge!  But they prevent
                ;; rather nasty looking displays when deleting text at the end
                ;; of line, such as normal corrections as one is typing and
                ;; immediately makes a correction, and when deleting first
                ;; character of a line.
                ;; (if (= leng-before 1)
                ;;     (if (eolp)
                ;;         (setq beg-decr 0 end-incr 0)
                ;;       (if (bolp)
                ;;   	(setq beg-decr 0))))
                ;; (setq beg (max (- beg beg-decr) (point-min)))
                (setq end (min (+ end end-incr) (point-max)))
                (setq type 'hilit-chg-delete))
            ;; Not a deletion.
            ;; Most of the time the following is not necessary, but
            ;; if the current text was marked as a deletion then
            ;; the old overlay is still in effect.  So if the user adds some
            ;; text where she earlier deleted text, we have to remove the
            ;; deletion marking, and replace it explicitly with a `changed'
            ;; marking, otherwise its highlighting would disappear.
            (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)
                (save-restriction
                  (widen)
                  (put-text-property end (+ end 1) 'hilit-chg 'hilit-chg)
                  (if highlight-changes-visible-mode
                      (hilit-chg-fixup end (+ end 1))))))
          (unless no-property-change
            (put-text-property beg end 'hilit-chg type))
          (if (or highlight-changes-visible-mode no-property-change)
              (hilit-chg-make-ov type beg end)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
575

576
(defun hilit-chg-update ()
577
  "Update a buffer's highlight changes when visibility changed."
578 579
  (if highlight-changes-visible-mode
      ;; changes are visible
Richard M. Stallman's avatar
Richard M. Stallman committed
580
      (progn
581
	(setq hilit-chg-string highlight-changes-visible-string)
Richard M. Stallman's avatar
Richard M. Stallman committed
582 583
	(or buffer-read-only
	    (hilit-chg-display-changes)))
584 585
    ;; changes are invisible
    (setq hilit-chg-string highlight-changes-invisible-string)
Richard M. Stallman's avatar
Richard M. Stallman committed
586
    (or buffer-read-only
587 588 589 590 591 592 593 594 595
	(hilit-chg-hide-changes))))

(defun hilit-chg-set ()
  "Turn on Highlight Changes mode for this buffer."
  (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)
  (hilit-chg-make-list)
  (setq highlight-changes-mode t)
  (setq highlight-changes-visible-mode highlight-changes-visibility-initial-state)
  (hilit-chg-update)
Richard M. Stallman's avatar
Richard M. Stallman committed
596
  (force-mode-line-update)
597
  (add-hook 'after-change-functions 'hilit-chg-set-face-on-change nil t))
Richard M. Stallman's avatar
Richard M. Stallman committed
598 599 600 601 602 603

(defun hilit-chg-clear ()
  "Remove Highlight Changes mode for this buffer.
This removes all saved change information."
  (if buffer-read-only
      ;; We print the buffer name because this function could be called
604
      ;; on many buffers from `global-highlight-changes-mode'.
Richard M. Stallman's avatar
Richard M. Stallman committed
605 606 607
      (message "Cannot remove highlighting from read-only mode buffer %s"
	       (buffer-name))
    (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)
608
    (with-silent-modifications
Richard M. Stallman's avatar
Richard M. Stallman committed
609
      (hilit-chg-hide-changes)
610
      (hilit-chg-map-changes
611
       (lambda (_prop start stop)
612
         (remove-text-properties start stop '(hilit-chg nil)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
613
    (setq highlight-changes-mode nil)
614
    (force-mode-line-update)))
Richard M. Stallman's avatar
Richard M. Stallman committed
615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661


;;;###autoload
(defun highlight-changes-next-change ()
  "Move to the beginning of the next change, if in Highlight Changes mode."
  (interactive)
  (if highlight-changes-mode
      (let ((start (point))
	    prop)
	(setq prop (get-text-property (point) 'hilit-chg))
	(if prop
	    ;; we are in a change
	    (setq start (next-single-property-change (point) 'hilit-chg)))
	(if start
	    (setq start (next-single-property-change start 'hilit-chg)))
	(if start
	    (goto-char start)
	  (message "no next change")))
    (message "This buffer is not in Highlight Changes mode.")))


;;;###autoload
(defun highlight-changes-previous-change ()
  "Move to the beginning of the previous change, if in Highlight Changes mode."
  (interactive)
  (if highlight-changes-mode
      (let ( (start (point)) (prop nil) )
	(or (bobp)
	    (setq prop (get-text-property (1- (point)) 'hilit-chg)))
	(if prop
	    ;; we are in a change
	    (setq start (previous-single-property-change (point) 'hilit-chg)))
	(if start
	    (setq start (previous-single-property-change start 'hilit-chg)))
	;; special handling for the case where (point-min) is a change
	(if start
	    (setq start (or (previous-single-property-change start 'hilit-chg)
			    (if (get-text-property (point-min) 'hilit-chg)
				(point-min)))))
	(if start
	    (goto-char start)
	  (message "no previous change")))
    (message "This buffer is not in Highlight Changes mode.")))

;; ========================================================================

(defun hilit-chg-make-list (&optional force)
662
  "Construct `hilit-chg-list' and `highlight-changes-face-list'."
663
  ;; Constructs highlight-changes-face-list if necessary,
Richard M. Stallman's avatar
Richard M. Stallman committed
664 665 666 667 668
  ;; and hilit-chg-list always:
  ;; Maybe this should always be called when rotating a face
  ;; so we pick up any changes?
  (if (or (null highlight-changes-face-list)  ; Don't do it if it
	  force) ; already exists unless FORCE non-nil.
669
      (let ((p highlight-changes-colors)
Richard M. Stallman's avatar
Richard M. Stallman committed
670 671 672
	    (n 1) name)
	(setq highlight-changes-face-list nil)
	(while p
673 674
	  (setq name (intern (format "highlight-changes-%d" n)))
	  (copy-face 'highlight-changes name)
Richard M. Stallman's avatar
Richard M. Stallman committed
675
	  (set-face-foreground name (car p))
676
	  (setq highlight-changes-face-list
Richard M. Stallman's avatar
Richard M. Stallman committed
677 678 679
		(append highlight-changes-face-list (list name)))
	  (setq p (cdr p))
	  (setq n (1+ n)))))
680
  (setq hilit-chg-list (list 'hilit-chg 'highlight-changes))
Richard M. Stallman's avatar
Richard M. Stallman committed
681
  (let ((p highlight-changes-face-list)
682
	(n 1)
Richard M. Stallman's avatar
Richard M. Stallman committed
683 684 685
	last-category last-face)
    (while p
      (setq last-category (intern (format "change-%d" n)))
686
      ;; (setq last-face (intern (format "highlight-changes-%d" n)))
Richard M. Stallman's avatar
Richard M. Stallman committed
687 688 689 690 691 692 693 694
      (setq last-face (car p))
      (setq hilit-chg-list
	    (append hilit-chg-list
		    (list last-category last-face)))
      (setq p (cdr p))
      (setq n (1+ n)))
    (setq hilit-chg-list
	  (append hilit-chg-list
695
		  (list last-category last-face)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
696 697

(defun hilit-chg-bump-change (prop start end)
698
  "Increment (age) the Highlight Changes mode text property."
Richard M. Stallman's avatar
Richard M. Stallman committed
699 700 701
  (let ( new-prop )
    (if (eq prop 'hilit-chg-delete)
	(setq new-prop (nth 2 hilit-chg-list))
702
      (setq new-prop (nth 2 (member prop hilit-chg-list))))
Richard M. Stallman's avatar
Richard M. Stallman committed
703 704
    (if prop
	(put-text-property start end 'hilit-chg new-prop)
705
      (message "%d-%d unknown property %s not changed" start end prop))))
Richard M. Stallman's avatar
Richard M. Stallman committed
706 707 708

;;;###autoload
(defun highlight-changes-rotate-faces ()
709
  "Rotate the faces if in Highlight Changes mode and the changes are visible.
Richard M. Stallman's avatar
Richard M. Stallman committed
710

711 712
Current changes are displayed in the face described by the first element
of `highlight-changes-face-list', one level older changes are shown in
Richard M. Stallman's avatar
Richard M. Stallman committed
713 714 715
face described by the second element, and so on.  Very old changes remain
shown in the last face in the list.

716 717 718
You can automatically rotate colors when the buffer is saved by adding
this function to `write-file-functions' as a buffer-local value.  To do
this, eval the following in the buffer to be saved:
719

720
  (add-hook \\='write-file-functions \\='highlight-changes-rotate-faces nil t)"
Richard M. Stallman's avatar
Richard M. Stallman committed
721
  (interactive)
722
  (when (and highlight-changes-mode highlight-changes-visible-mode)
723 724 725 726 727 728 729
    (let ((modified (buffer-modified-p))
	  (inhibit-modification-hooks t))
      ;; The `modified' related code tries to combine two goals: (1) Record the
      ;; rotation in `buffer-undo-list' and (2) avoid setting the modified flag
      ;; of the current buffer due to the rotation.  We do this by inserting (in
      ;; `buffer-undo-list') entries restoring buffer-modified-p to nil before
      ;; and after the entry for the rotation.
730 731 732 733 734 735
      ;; FIXME: this is no good: we need to test the `modified' state at the
      ;; time of the undo, not at the time of the "do", otherwise the undo
      ;; may erroneously clear the modified flag.  --Stef
      ;; (unless modified
      ;;   ;; Install the "before" entry.
      ;;   (push '(apply restore-buffer-modified-p nil) buffer-undo-list))
736 737 738 739 740 741 742 743
      (unwind-protect
	  (progn
	    ;; ensure hilit-chg-list is made and up to date
	    (hilit-chg-make-list)
	    ;; remove our existing overlays
	    (hilit-chg-hide-changes)
	    ;; for each change text property, increment it
	    (hilit-chg-map-changes 'hilit-chg-bump-change)
744 745
	    ;; and display them
	    (hilit-chg-display-changes))
746
	(unless modified
747 748
	  ;; Install the "after" entry.  FIXME: See above.
	  ;; (push '(apply restore-buffer-modified-p nil) buffer-undo-list)
749 750

	  (restore-buffer-modified-p nil)))))
751
  ;; This always returns nil so it is safe to use in write-file-functions
Richard M. Stallman's avatar
Richard M. Stallman committed
752 753 754
  nil)

;; ========================================================================
755 756 757 758 759 760 761 762
;; Comparing buffers/files
;; These use ediff to find the differences.

(defun highlight-markup-buffers
  (buf-a file-a buf-b file-b &optional markup-a-only)
  "Get differences between two buffers and set highlight changes.
Both buffers are done unless optional parameter MARKUP-A-ONLY
is non-nil."
763 764
  (eval-and-compile
    (require 'ediff-util))
765 766 767 768 769 770
  (save-window-excursion
    (let* (change-info
	   change-a change-b
	   a-start a-end len-a
	   b-start b-end len-b
	   (bufa-modified (buffer-modified-p buf-a))
771
	   (bufb-modified (and (not (eq buf-a buf-b)) (buffer-modified-p buf-b)))
772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792
	   (buf-a-read-only (with-current-buffer buf-a buffer-read-only))
	   (buf-b-read-only (with-current-buffer buf-b buffer-read-only))
	   temp-a temp-b)
      (if (and file-a bufa-modified)
	  (if (y-or-n-p (format "Save buffer %s?  " buf-a))
	      (with-current-buffer buf-a
		(save-buffer)
		(setq bufa-modified (buffer-modified-p buf-a)))
	    (setq file-a nil)))
      (or file-a
	  (setq temp-a (setq file-a (ediff-make-temp-file buf-a nil))))

      (if (and file-b bufb-modified)
	  (if (y-or-n-p (format "Save buffer %s?  " buf-b))
	      (with-current-buffer buf-b
		(save-buffer)
		(setq bufb-modified (buffer-modified-p buf-b)))
	    (setq file-b nil)))
      (or file-b
	  (setq temp-b (setq file-b (ediff-make-temp-file buf-b nil))))
      (set-buffer buf-a)
793
      (highlight-changes-mode 1)
794
      (or markup-a-only (with-current-buffer buf-b
795
			  (highlight-changes-mode 1)))
796 797 798 799 800
      (setq change-info (hilit-chg-get-diff-info buf-a file-a buf-b file-b))


      (setq change-a (car change-info))
      (setq change-b (car (cdr change-info)))
801

802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837
      (hilit-chg-make-list)
      (while change-a
	(setq a-start (nth 0 (car change-a)))
	(setq a-end (nth 1 (car change-a)))
	(setq b-start (nth 0 (car change-b)))
	(setq b-end (nth 1 (car change-b)))
	(setq len-a (- a-end a-start))
	(setq len-b (- b-end b-start))
	(set-buffer buf-a)
	(hilit-chg-set-face-on-change a-start a-end len-b buf-a-read-only)
	(or markup-a-only
	    (with-current-buffer buf-b
	      (hilit-chg-set-face-on-change b-start b-end len-a
					    buf-b-read-only)
	      ))
	(setq change-a (cdr change-a))
	(setq change-b (cdr change-b)))
      (or bufa-modified
	  (with-current-buffer buf-a (set-buffer-modified-p nil)))
      (or bufb-modified
	  (with-current-buffer buf-b (set-buffer-modified-p nil)))
      (if temp-a
	  (delete-file temp-a))
      (if temp-b
	  (delete-file temp-b)))
    ))

;;;###autoload
(defun highlight-compare-buffers (buf-a buf-b)
"Compare two buffers and highlight the differences.

The default is the current buffer and the one in the next window.

If either buffer is modified and is visiting a file, you are prompted
to save the file.

838
Unless the buffer is unmodified and visiting a file, the buffer is
839 840 841 842 843 844
written to a temporary file for comparison.

If a buffer is read-only, differences will be highlighted but no property
changes are made, so \\[highlight-changes-next-change] and
\\[highlight-changes-previous-change] will not work."
  (interactive
845
   (list
846 847 848
    (get-buffer (read-buffer "buffer-a " (current-buffer) t))
    (get-buffer
     (read-buffer "buffer-b "
849
		  (window-buffer (next-window)) t))))
850 851 852 853
  (let ((file-a (buffer-file-name buf-a))
	(file-b (buffer-file-name buf-b)))
    (highlight-markup-buffers buf-a file-a buf-b file-b)
    ))
Richard M. Stallman's avatar
Richard M. Stallman committed
854 855

;;;###autoload
856 857
(defun highlight-compare-with-file (file-b)
  "Compare this buffer with a file, and highlight differences.
Richard M. Stallman's avatar
Richard M. Stallman committed
858

859 860
If the buffer has a backup filename, it is used as the default when
this function is called interactively.
Richard M. Stallman's avatar
Richard M. Stallman committed
861

862 863 864
If the current buffer is visiting the file being compared against, it
also will have its differences highlighted.  Otherwise, the file is
read in temporarily but the buffer is deleted.
Richard M. Stallman's avatar
Richard M. Stallman committed
865

866 867
If the buffer is read-only, differences will be highlighted but no property
changes are made, so \\[highlight-changes-next-change] and
Richard M. Stallman's avatar
Richard M. Stallman committed
868
\\[highlight-changes-previous-change] will not work."
869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885
  (interactive
   (let ((file buffer-file-name)
	 (file-name nil)
	 (file-dir nil))
     (and file
	  (setq file-name (file-name-nondirectory file)
		file-dir (file-name-directory file)))
     (setq file-name (make-backup-file-name file-name))
     (unless (file-exists-p file-name)
	     (setq file-name nil))
     (list (read-file-name
	    "Find to compare with: "	;; prompt
	    file-dir			;; directory
	    nil				;; default
	    nil				;; existing
	    file-name)			;; initial
	   )))
Richard M. Stallman's avatar
Richard M. Stallman committed
886 887 888 889
  (let* ((buf-a (current-buffer))
	 (file-a (buffer-file-name))
	 (existing-buf (get-file-buffer file-b))
	 (buf-b (or existing-buf
890
		    (find-file-noselect file-b))))
891 892 893 894
    (highlight-markup-buffers buf-a file-a buf-b file-b (not existing-buf))
    (unless existing-buf
      (kill-buffer buf-b))
    ))
Richard M. Stallman's avatar
Richard M. Stallman committed
895 896 897


(defun hilit-chg-get-diff-info (buf-a file-a buf-b file-b)
Glenn Morris's avatar
Glenn Morris committed
898 899
   ;; hilit-e,x,y are set by function hilit-chg-get-diff-list-hk.
  (let (hilit-e hilit-x hilit-y)
Richard M. Stallman's avatar
Richard M. Stallman committed
900 901
    (ediff-setup buf-a file-a buf-b file-b
	       nil nil   ; buf-c file-C
Tino Calancha's avatar
Tino Calancha committed
902
	       '(hilit-chg-get-diff-list-hk)
Richard M. Stallman's avatar
Richard M. Stallman committed
903 904
	       (list (cons 'ediff-job-name 'something))
	       )
Glenn Morris's avatar
Glenn Morris committed
905 906
    (ediff-with-current-buffer hilit-e (ediff-really-quit nil))
    (list hilit-x hilit-y)))
Richard M. Stallman's avatar
Richard M. Stallman committed
907 908 909


(defun hilit-chg-get-diff-list-hk ()
Glenn Morris's avatar
Glenn Morris committed
910 911 912 913 914 915
  ;; hilit-e/x/y are dynamically bound by hilit-chg-get-diff-info
  ;; which calls this function as a hook.
  (defvar hilit-x)                      ; placate the byte-compiler
  (defvar hilit-y)
  (defvar hilit-e)
  (setq hilit-e (current-buffer))
Richard M. Stallman's avatar
Richard M. Stallman committed
916
  (let ((n 0) extent p va vb a b)
Glenn Morris's avatar
Glenn Morris committed
917
    (setq hilit-x nil hilit-y nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
918 919 920 921 922 923
    (while (< n ediff-number-of-differences)
      (ediff-make-fine-diffs n)
      (setq va (ediff-get-fine-diff-vector n 'A))
      ;; va is a vector if there are fine differences
      (if va
	  (setq a (append va nil))
924
	;; if not, get the unrefined difference
Richard M. Stallman's avatar
Richard M. Stallman committed
925
	(setq va (ediff-get-difference n 'A))
926
	(setq a (list (elt va 0))))
Richard M. Stallman's avatar
Richard M. Stallman committed
927 928 929 930 931 932
      ;; a list a list
      (setq p a)
      (while p
	(setq extent (list (overlay-start (car p))
			   (overlay-end (car p))))
	(setq p (cdr p))
Glenn Morris's avatar
Glenn Morris committed
933
	(setq hilit-x (append hilit-x (list extent) )));; while p
Richard M. Stallman's avatar
Richard M. Stallman committed
934 935 936 937 938
      ;;
      (setq vb (ediff-get-fine-diff-vector n 'B))
      ;; vb is a vector
      (if vb
	  (setq b (append vb nil))
939
	;; if not, get the unrefined difference
Richard M. Stallman's avatar
Richard M. Stallman committed
940
	(setq vb (ediff-get-difference n 'B))
941
	(setq b (list (elt vb 0))))
Richard M. Stallman's avatar
Richard M. Stallman committed
942 943 944 945 946 947
      ;; b list a list
      (setq p b)
      (while p
	(setq extent (list (overlay-start (car p))
			   (overlay-end (car p))))
	(setq p (cdr p))
Glenn Morris's avatar
Glenn Morris committed
948
	(setq hilit-y (append hilit-y (list extent) )))
949
      (setq n (1+ n)));; while
Richard M. Stallman's avatar
Richard M. Stallman committed
950 951 952 953
    ;; ediff-quit doesn't work here.
    ;; No point in returning a value, since this is a hook function.
    ))

954
;; ======================= global-highlight-changes-mode ==============
Richard M. Stallman's avatar
Richard M. Stallman committed
955 956

;;;###autoload
957
(define-globalized-minor-mode global-highlight-changes-mode
958
  highlight-changes-mode highlight-changes-mode-turn-on)
Richard M. Stallman's avatar
Richard M. Stallman committed
959

960 961
(define-obsolete-function-alias
 'global-highlight-changes
962
  'global-highlight-changes-mode "23.1")
963 964

(defun highlight-changes-mode-turn-on ()
965 966
  "See if Highlight Changes mode should be turned on for this buffer.
This is called when `global-highlight-changes-mode' is turned on."
Richard M. Stallman's avatar
Richard M. Stallman committed
967 968 969 970 971 972 973 974 975 976 977 978
  (or highlight-changes-mode			; do nothing if already on
      (if
	  (cond
	   ((null highlight-changes-global-modes)
	    nil)
	   ((functionp highlight-changes-global-modes)
	    (funcall highlight-changes-global-modes))
	    ((listp highlight-changes-global-modes)
	     (if (eq (car-safe highlight-changes-global-modes) 'not)
		 (not (memq major-mode (cdr highlight-changes-global-modes)))
	       (memq major-mode highlight-changes-global-modes)))
	    (t
979
	     (and
980
	      (not (string-match "^[ *]" (buffer-name)))
981
	      (buffer-file-name))))
982 983
	  (highlight-changes-mode 1))
	))
984

Richard M. Stallman's avatar
Richard M. Stallman committed
985

986 987 988 989 990 991 992 993 994 995
;;;; Desktop support.

;; Called by `desktop-create-buffer' to restore `highlight-changes-mode'.
(defun hilit-chg-desktop-restore (desktop-buffer-locals)
  (highlight-changes-mode
   (or (cdr (assq 'highlight-changes-mode desktop-buffer-locals)) 1)))

(add-to-list 'desktop-minor-mode-handlers
             '(highlight-changes-mode . hilit-chg-desktop-restore))

996 997
(add-to-list 'desktop-locals-to-save 'highlight-changes-mode)

Richard M. Stallman's avatar
Richard M. Stallman committed
998 999 1000 1001 1002 1003
;; ===================== debug ==================
;; For debug & test use:
;;
;; (defun hilit-chg-debug-show (&optional beg end)
;;   (interactive)
;;   (message "--- hilit-chg-debug-show ---")
1004 1005
;;   (hilit-chg-map-changes (lambda (prop start end)
;; 			     (message "%d-%d: %s" start end prop))
Richard M. Stallman's avatar
Richard M. Stallman committed
1006 1007
;; 			   beg end
;; 			   ))
1008
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
1009 1010
;; ================== end of debug ===============

1011 1012 1013 1014 1015 1016
(defun hilit-chg-unload-function ()
  "Unload the Highlight Changes library."
  (global-hi-lock-mode -1)
  ;; continue standard unloading
  nil)

Richard M. Stallman's avatar
Richard M. Stallman committed
1017 1018
(provide 'hilit-chg)

1019
;;; hilit-chg.el ends here