X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5df4f04cd32af723742c81095b38ae83b3c2b462..1650d7102ae8ea943e4197b7d91198640f0e0ff6:/lisp/hilit-chg.el

diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 0a18d89db4..1e4deb9353 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -1,7 +1,6 @@
 ;;; hilit-chg.el --- minor mode displaying buffer changes with special face
 
-;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;;   2008, 2009, 2010, 2011  Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2016 Free Software Foundation, Inc.
 
 ;; Author: Richard Sharman <rsharman@pobox.com>
 ;; Keywords: faces
@@ -195,8 +194,6 @@
     (t (:inverse-video t)))
   "Face used for highlighting changes."
   :group 'highlight-changes)
-(define-obsolete-face-alias 'highlight-changes-face
-  'highlight-changes "22.1")
 
 ;; This looks pretty ugly, actually.  Maybe the underline should be removed.
 (defface highlight-changes-delete
@@ -205,9 +202,6 @@
     (t (:inverse-video t)))
   "Face used for highlighting deletions."
   :group 'highlight-changes)
-(define-obsolete-face-alias 'highlight-changes-delete-face
-  'highlight-changes-delete "22.1")
-
 
 ;; A (not very good) default list of colors to rotate through.
 (define-obsolete-variable-alias 'highlight-changes-colours
@@ -327,14 +321,15 @@ remove it from existing buffers."
 
 ;;;###autoload
 (define-minor-mode highlight-changes-mode
-  "Toggle Highlight Changes mode.
-
-With ARG, turn Highlight Changes mode on if and only if arg is positive.
+  "Toggle highlighting changes in this buffer (Highlight Changes mode).
+With a prefix argument ARG, enable Highlight Changes mode if ARG
+is positive, and disable it otherwise.  If called from Lisp,
+enable the mode if ARG is omitted or nil.
 
-In Highlight Changes mode changes are recorded with a text property.
-Normally they are displayed in a distinctive face, but command
-\\[highlight-changes-visible-mode] can be used to toggles this
-on and off.
+When Highlight Changes is enabled, changes are marked with a text
+property.  Normally they are displayed in a distinctive face, but
+command \\[highlight-changes-visible-mode] can be used to toggle
+this on and off.
 
 Other functions for buffers in this mode include:
 \\[highlight-changes-next-change] - move point to beginning of next change
@@ -367,16 +362,19 @@ buffer with the contents of a file
 
 ;;;###autoload
 (define-minor-mode highlight-changes-visible-mode
-  "Toggle visiblility of changes when buffer is in Highlight Changes mode.
+  "Toggle visibility of highlighting due to Highlight Changes mode.
+With a prefix argument ARG, enable Highlight Changes Visible mode
+if ARG is positive, and disable it otherwise.  If called from
+Lisp, enable the mode if ARG is omitted or nil.
 
-This mode only has an effect when Highlight Changes mode is on.
-It allows toggling between whether or not the changed text is displayed
+Highlight Changes Visible mode only has an effect when Highlight
+Changes mode is on.  When enabled, the changed text is displayed
 in a distinctive face.
 
 The default value can be customized with variable
-`highlight-changes-visibility-initial-state'
+`highlight-changes-visibility-initial-state'.
 
-This command does not itself set highlight-changes mode."
+This command does not itself set Highlight Changes mode."
 
   t		;; init-value
   nil		;; lighter
@@ -386,7 +384,7 @@ This command does not itself set highlight-changes mode."
   )
 
 
-(defun hilit-chg-cust-fix-changes-face-list (w wc &optional event)
+(defun hilit-chg-cust-fix-changes-face-list (w _wc &optional event)
   ;; When customization function `highlight-changes-face-list' inserts a new
   ;; 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
@@ -452,7 +450,7 @@ Otherwise, this list will be constructed when needed from
   "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.
-FUNC is called with 3 params: PROPERTY START STOP."
+FUNC is called with three params: PROPERTY START STOP."
   (let ((start (or start-position (point-min)))
 	(limit (or end-position (point-max)))
 	prop end)
@@ -467,8 +465,8 @@ FUNC is called with 3 params: PROPERTY START STOP."
 (defun hilit-chg-display-changes (&optional beg end)
   "Display face information for Highlight Changes mode.
 
-An overlay from BEG to END containing a change face is added from the
-information in the text property of type `hilit-chg'.
+An overlay from BEG to END containing a change face is added
+from the information in the text property of type `hilit-chg'.
 
 This is the opposite of `hilit-chg-hide-changes'."
   (hilit-chg-map-changes 'hilit-chg-make-ov beg end))
@@ -477,7 +475,7 @@ This is the opposite of `hilit-chg-hide-changes'."
 (defun hilit-chg-make-ov (prop start end)
   (or prop
       (error "hilit-chg-make-ov: prop is nil"))
-  ;; For the region create overlays with a distincive face
+  ;; For the region create overlays with a distinctive face
   ;; and the text property 'hilit-chg.
   (let ((ov (make-overlay start end))
 	(face (if (eq prop 'hilit-chg-delete)
@@ -520,28 +518,12 @@ the text properties of type `hilit-chg'."
   (remove-overlays beg end 'hilit-chg t)
   (hilit-chg-display-changes beg end))
 
-;; Inspired by font-lock.  Something like this should be moved to subr.el.
-(defmacro highlight-save-buffer-state (&rest body)
-  "Bind variables according to VARLIST and eval BODY restoring buffer state."
-  (declare (indent 0) (debug t))
-  (let ((modified (make-symbol "modified")))
-    `(let* ((,modified (buffer-modified-p))
-            (inhibit-modification-hooks t)
-            deactivate-mark
-            ;; So we don't check the file's mtime.
-            buffer-file-name
-            buffer-file-truename)
-       (progn
-         ,@body)
-       (unless ,modified
-         (restore-buffer-modified-p nil)))))
-
 ;;;###autoload
 (defun highlight-changes-remove-highlight (beg end)
   "Remove the change face from the region between BEG and END.
 This allows you to manually remove highlighting from uninteresting changes."
   (interactive "r")
-  (highlight-save-buffer-state
+  (with-silent-modifications
     (remove-text-properties beg end '(hilit-chg nil))
     (hilit-chg-fixup beg end)))
 
@@ -558,14 +540,14 @@ This allows you to manually remove highlighting from uninteresting changes."
   ;; otherwise an undone change shows up as changed.  While the properties
   ;; are automatically restored by undo, we must fix up the overlay.
   (save-match-data
-    (let ((beg-decr 1) (end-incr 1)
-	  (type 'hilit-chg)
-	  old)
+    (let (;;(beg-decr 1)
+          (end-incr 1)
+	  (type 'hilit-chg))
       (if undo-in-progress
 	  (if (and highlight-changes-mode
 		   highlight-changes-visible-mode)
 	      (hilit-chg-fixup beg end))
-        (highlight-save-buffer-state
+        (with-silent-modifications
           (if (and (= beg end) (> leng-before 0))
               ;; deletion
               (progn
@@ -585,14 +567,16 @@ This allows you to manually remove highlighting from uninteresting changes."
             ;; 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 we add some
-            ;; text then remove the deletion marking, but set it to
-	  ;; changed otherwise its highlighting disappears.
-	  (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)
-	      (progn
-		(put-text-property end (+ end 1) 'hilit-chg 'hilit-chg)
-		(if highlight-changes-visible-mode
-		    (hilit-chg-fixup beg (+ end 1))))))
+            ;; 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)
@@ -630,10 +614,10 @@ This removes all saved change information."
       (message "Cannot remove highlighting from read-only mode buffer %s"
 	       (buffer-name))
     (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)
-    (highlight-save-buffer-state
+    (with-silent-modifications
       (hilit-chg-hide-changes)
       (hilit-chg-map-changes
-       (lambda (prop start stop)
+       (lambda (_prop start stop)
          (remove-text-properties start stop '(hilit-chg nil)))))
     (setq highlight-changes-mode nil)
     (force-mode-line-update)))
@@ -742,7 +726,7 @@ 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:
 
-  \(add-hook 'write-file-functions 'highlight-changes-rotate-faces nil t)"
+  (add-hook \\='write-file-functions \\='highlight-changes-rotate-faces nil t)"
   (interactive)
   (when (and highlight-changes-mode highlight-changes-visible-mode)
     (let ((modified (buffer-modified-p))
@@ -793,7 +777,7 @@ is non-nil."
 	   a-start a-end len-a
 	   b-start b-end len-b
 	   (bufa-modified (buffer-modified-p buf-a))
-	   (bufb-modified (buffer-modified-p buf-b))
+	   (bufb-modified (and (not (eq buf-a buf-b)) (buffer-modified-p buf-b)))
 	   (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)
@@ -871,7 +855,7 @@ changes are made, so \\[highlight-changes-next-change] and
     (get-buffer (read-buffer "buffer-a " (current-buffer) t))
     (get-buffer
      (read-buffer "buffer-b "
-		  (window-buffer (next-window (selected-window))) t))))
+		  (window-buffer (next-window)) t))))
   (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)
@@ -912,8 +896,7 @@ changes are made, so \\[highlight-changes-next-change] and
 	 (file-a (buffer-file-name))
 	 (existing-buf (get-file-buffer file-b))
 	 (buf-b (or existing-buf
-		    (find-file-noselect file-b)))
-	 (buf-b-read-only (with-current-buffer buf-b buffer-read-only)))
+		    (find-file-noselect file-b))))
     (highlight-markup-buffers buf-a file-a buf-b file-b (not existing-buf))
     (unless existing-buf
       (kill-buffer buf-b))
@@ -921,24 +904,26 @@ changes are made, so \\[highlight-changes-next-change] and
 
 
 (defun hilit-chg-get-diff-info (buf-a file-a buf-b file-b)
-  (let ((e nil) x y)   ;; e is set by function hilit-chg-get-diff-list-hk
+   ;; hilit-e,x,y are set by function hilit-chg-get-diff-list-hk.
+  (let (hilit-e hilit-x hilit-y)
     (ediff-setup buf-a file-a buf-b file-b
 	       nil nil   ; buf-c file-C
-	       'hilit-chg-get-diff-list-hk
+	       '(hilit-chg-get-diff-list-hk)
 	       (list (cons 'ediff-job-name 'something))
 	       )
-    (ediff-with-current-buffer e (ediff-really-quit nil))
-    (list x y)))
+    (ediff-with-current-buffer hilit-e (ediff-really-quit nil))
+    (list hilit-x hilit-y)))
 
 
 (defun hilit-chg-get-diff-list-hk ()
-  ;; x and y are dynamically bound by hilit-chg-get-diff-info
-  ;; which calls this function as a hook
-  (defvar x)  ;; placate the byte-compiler
-  (defvar y)
-  (setq e (current-buffer))
+  ;; 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))
   (let ((n 0) extent p va vb a b)
-    (setq x nil y nil)    ;; x and y are bound by hilit-chg-get-diff-info
+    (setq hilit-x nil hilit-y nil)
     (while (< n ediff-number-of-differences)
       (ediff-make-fine-diffs n)
       (setq va (ediff-get-fine-diff-vector n 'A))
@@ -954,7 +939,7 @@ changes are made, so \\[highlight-changes-next-change] and
 	(setq extent (list (overlay-start (car p))
 			   (overlay-end (car p))))
 	(setq p (cdr p))
-	(setq x (append x (list extent) )));; while p
+	(setq hilit-x (append hilit-x (list extent) )));; while p
       ;;
       (setq vb (ediff-get-fine-diff-vector n 'B))
       ;; vb is a vector
@@ -969,7 +954,7 @@ changes are made, so \\[highlight-changes-next-change] and
 	(setq extent (list (overlay-start (car p))
 			   (overlay-end (car p))))
 	(setq p (cdr p))
-	(setq y (append y (list extent) )))
+	(setq hilit-y (append hilit-y (list extent) )))
       (setq n (1+ n)));; while
     ;; ediff-quit doesn't work here.
     ;; No point in returning a value, since this is a hook function.
@@ -1025,15 +1010,19 @@ This is called when `global-highlight-changes-mode' is turned on."
 ;; (defun hilit-chg-debug-show (&optional beg end)
 ;;   (interactive)
 ;;   (message "--- hilit-chg-debug-show ---")
-;;   (hilit-chg-map-changes '(lambda (prop start end)
-;; 			      (message "%d-%d: %s" start end prop)
-;; 			      )
+;;   (hilit-chg-map-changes (lambda (prop start end)
+;; 			     (message "%d-%d: %s" start end prop))
 ;; 			   beg end
 ;; 			   ))
 ;;
 ;; ================== end of debug ===============
 
+(defun hilit-chg-unload-function ()
+  "Unload the Highlight Changes library."
+  (global-hi-lock-mode -1)
+  ;; continue standard unloading
+  nil)
+
 (provide 'hilit-chg)
 
-;; arch-tag: de00301d-5bad-44da-aa82-e0e010b0c463
 ;;; hilit-chg.el ends here