[Emacs-diffs] Changes to emacs/lisp/hilit-chg.el,v [EMACS_22_BASE]

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Branch:         EMACS_22_BASE
Changes by:     Stefan Monnier <monnier>        08/02/13 21:50:38

Index: hilit-chg.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/hilit-chg.el,v
retrieving revision 1.41.2.4
retrieving revision 1.41.2.5
diff -u -b -r1.41.2.4 -r1.41.2.5
--- hilit-chg.el        7 Jan 2008 02:44:43 -0000       1.41.2.4
+++ hilit-chg.el        13 Feb 2008 21:50:37 -0000      1.41.2.5
@@ -515,12 +515,28 @@
              (delete-overlay ov))))))
     (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")
-  (let ((after-change-functions nil))
+  (highlight-save-buffer-state
     (remove-text-properties beg end '(hilit-chg nil))
     (hilit-chg-fixup beg end)))
 
@@ -543,6 +559,7 @@
       (if undo-in-progress
          (if (eq highlight-changes-mode 'active)
              (hilit-chg-fixup beg end))
+        (highlight-save-buffer-state
        (if (and (= beg end) (> leng-before 0))
            ;; deletion
            (progn
@@ -551,12 +568,12 @@
              ;; 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)))
+                ;; (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.
@@ -574,7 +591,7 @@
        (unless no-property-change
                (put-text-property beg end 'hilit-chg type))
        (if (or (eq highlight-changes-mode 'active) no-property-change)
-           (hilit-chg-make-ov type beg end))))))
+              (hilit-chg-make-ov type beg end)))))))
 
 (defun hilit-chg-set (value)
   "Turn on Highlight Changes mode for this buffer."
@@ -602,12 +619,11 @@
       (message "Cannot remove highlighting from read-only mode buffer %s"
               (buffer-name))
     (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t)
-    (let ((after-change-functions nil))
+    (highlight-save-buffer-state
       (hilit-chg-hide-changes)
       (hilit-chg-map-changes
-       '(lambda (prop start stop)
-         (remove-text-properties start stop '(hilit-chg nil))))
-      )
+       (lambda (prop start stop)
+         (remove-text-properties start stop '(hilit-chg nil)))))
     (setq highlight-changes-mode nil)
     (force-mode-line-update)
     ;; If we type:  C-u -1 M-x highlight-changes-mode
@@ -798,11 +814,12 @@
       ;; 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.
-      (unless modified
-       ;; Install the "before" entry.
-       (setq buffer-undo-list
-             (cons '(apply restore-buffer-modified-p nil)
-                   buffer-undo-list)))
+      ;; 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))
       (unwind-protect
          (progn
            ;; ensure hilit-chg-list is made and up to date
@@ -815,10 +832,8 @@
            (if (eq highlight-changes-mode 'active)
                (hilit-chg-display-changes)))
        (unless modified
-         ;; Install the "after" entry.
-         (setq buffer-undo-list
-               (cons '(apply restore-buffer-modified-p nil)
-                     buffer-undo-list))
+         ;; Install the "after" entry.  FIXME: See above.
+         ;; (push '(apply restore-buffer-modified-p nil) buffer-undo-list)
 
          (restore-buffer-modified-p nil)))))
   ;; This always returns nil so it is safe to use in write-file-functions