lisp/loadhist.el (unload-feature-special-hooks): Add comint-output-filter-functions.
[bpt/emacs.git] / lisp / compare-w.el
index e3e7bd3..65f7ce9 100644 (file)
@@ -1,17 +1,17 @@
 ;;; compare-w.el --- compare text between windows for Emacs
 
-;; Copyright (C) 1986, 1989, 1993, 1997, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1989, 1993, 1997, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: convenience files
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +19,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 ;;; Code:
 
-(defgroup compare-w nil
+(defgroup compare-windows nil
   "Compare text between windows."
   :prefix "compare-"
   :group 'tools)
 
 (defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+"
-  "*Regexp or function that defines whitespace sequences for `compare-windows'.
+  "Regexp or function that defines whitespace sequences for `compare-windows'.
 That command optionally ignores changes in whitespace.
 
 The value of `compare-windows-whitespace' is normally a regexp, but it
@@ -52,21 +50,21 @@ any text before that point.
 If the function returns the same value for both windows, then the
 whitespace is considered to match, and is skipped."
   :type '(choice regexp function)
-  :group 'compare-w)
+  :group 'compare-windows)
 
 (defcustom compare-ignore-whitespace nil
-  "*Non-nil means `compare-windows' ignores whitespace."
+  "Non-nil means `compare-windows' ignores whitespace."
   :type 'boolean
-  :group 'compare-w
+  :group 'compare-windows
   :version "22.1")
 
 (defcustom compare-ignore-case nil
-  "*Non-nil means `compare-windows' ignores case differences."
+  "Non-nil means `compare-windows' ignores case differences."
   :type 'boolean
-  :group 'compare-w)
+  :group 'compare-windows)
 
 (defcustom compare-windows-sync 'compare-windows-sync-default-function
-  "*Function or regexp that is used to synchronize points in two
+  "Function or regexp that is used to synchronize points in two
 windows if before calling `compare-windows' points are located
 on mismatched positions.
 
@@ -87,14 +85,15 @@ regexp containing some field separator or a newline, depending on
 the nature of the difference units separator.  The variable can
 be made buffer-local.
 
-If the value of this variable is `nil', then function `ding' is
-called to beep or flash the screen when points are mismatched."
-  :type '(choice regexp function)
-  :group 'compare-w
+If the value of this variable is `nil' (option \"No sync\"), then
+no synchronization is performed, and the function `ding' is called
+to beep or flash the screen when points are mismatched."
+  :type '(choice function regexp (const :tag "No sync" nil))
+  :group 'compare-windows
   :version "22.1")
 
 (defcustom compare-windows-sync-string-size 32
-  "*Size of string from one window that is searched in second window.
+  "Size of string from one window that is searched in second window.
 
 Small number makes difference regions more fine-grained, but it
 may fail by finding the wrong match.  The bigger number makes
@@ -102,34 +101,42 @@ difference regions more coarse-grained.
 
 The default value 32 is good for the most cases."
   :type 'integer
-  :group 'compare-w
+  :group 'compare-windows
   :version "22.1")
 
 (defcustom compare-windows-recenter nil
-  "*List of two values, each of which is used as argument of
+  "List of two values, each of which is used as argument of
 function `recenter' called in each of two windows to place
 matching points side-by-side.
 
 The value `(-1 0)' is useful if windows are split vertically,
 and the value `((4) (4))' for horizontally split windows."
   :type '(list sexp sexp)
-  :group 'compare-w
+  :group 'compare-windows
   :version "22.1")
 
 (defcustom compare-windows-highlight t
-  "*Non-nil means compare-windows highlights the differences."
-  :type 'boolean
-  :group 'compare-w
+  "Non-nil means compare-windows highlights the differences.
+The value t removes highlighting immediately after invoking a command
+other than `compare-windows'.
+The value `persistent' leaves all highlighted differences.  You can clear
+out all highlighting later with the command `compare-windows-dehighlight'."
+  :type '(choice (const :tag "No highlighting" nil)
+                (const :tag "Persistent highlighting" persistent)
+                (other :tag "Highlight until next command" t))
+  :group 'compare-windows
   :version "22.1")
 
 (defface compare-windows
   '((t :inherit lazy-highlight))
   "Face for highlighting of compare-windows difference regions."
-  :group 'compare-w
+  :group 'compare-windows
   :version "22.1")
 
 (defvar compare-windows-overlay1 nil)
 (defvar compare-windows-overlay2 nil)
+(defvar compare-windows-overlays1 nil)
+(defvar compare-windows-overlays2 nil)
 (defvar compare-windows-sync-point nil)
 
 ;;;###autoload
@@ -159,16 +166,14 @@ on first call it advances points to the next difference,
 on second call it synchronizes points by skipping the difference,
 on third call it again advances points to the next difference and so on."
   (interactive "P")
+  (if compare-ignore-whitespace
+      (setq ignore-whitespace (not ignore-whitespace)))
   (let* (p1 p2 maxp1 maxp2 b1 b2 w2
            (progress 1)
            (opoint1 (point))
            opoint2
-           (skip-func (if (if ignore-whitespace ; XOR
-                               (not compare-ignore-whitespace)
-                             compare-ignore-whitespace)
-                           (if (stringp compare-windows-whitespace)
-                               'compare-windows-skip-whitespace
-                             compare-windows-whitespace)))
+           skip-func-1
+           skip-func-2
            (sync-func (if (stringp compare-windows-sync)
                            'compare-windows-sync-regexp
                          compare-windows-sync)))
@@ -182,8 +187,21 @@ on third call it again advances points to the next difference and so on."
          b2 (window-buffer w2))
     (setq opoint2 p2)
     (setq maxp1 (point-max))
-    (save-excursion
-      (set-buffer b2)
+
+    (setq skip-func-1 (if ignore-whitespace
+                         (if (stringp compare-windows-whitespace)
+                             (lambda (pos)
+                               (compare-windows-skip-whitespace pos)
+                               t)
+                           compare-windows-whitespace)))
+
+    (with-current-buffer b2
+      (setq skip-func-2 (if ignore-whitespace
+                           (if (stringp compare-windows-whitespace)
+                             (lambda (pos)
+                               (compare-windows-skip-whitespace pos)
+                               t)
+                             compare-windows-whitespace)))
       (push-mark p2 t)
       (setq maxp2 (point-max)))
     (push-mark)
@@ -191,17 +209,16 @@ on third call it again advances points to the next difference and so on."
     (while (> progress 0)
       ;; If both windows have whitespace next to point,
       ;; optionally skip over it.
-      (and skip-func
+      (and skip-func-1
           (save-excursion
             (let (p1a p2a w1 w2 result1 result2)
-              (setq result1 (funcall skip-func opoint1))
+              (setq result1 (funcall skip-func-1 opoint1))
               (setq p1a (point))
               (set-buffer b2)
               (goto-char p2)
-              (setq result2 (funcall skip-func opoint2))
+              (setq result2 (funcall skip-func-2 opoint2))
               (setq p2a (point))
-              (if (or (stringp compare-windows-whitespace)
-                      (and result1 result2 (eq result1 result2)))
+              (if (and result1 result2 (eq result1 result2))
                   (setq p1 p1a
                         p2 p2a)))))
 
@@ -351,17 +368,26 @@ on third call it again advances points to the next difference and so on."
       (overlay-put compare-windows-overlay2 'face 'compare-windows)
       (overlay-put compare-windows-overlay2 'priority 1000))
     (overlay-put compare-windows-overlay2 'window w2)
-    ;; Remove highlighting before next command is executed
-    (add-hook 'pre-command-hook 'compare-windows-dehighlight)))
+    (if (not (eq compare-windows-highlight 'persistent))
+       ;; Remove highlighting before next command is executed
+       (add-hook 'pre-command-hook 'compare-windows-dehighlight)
+      (when compare-windows-overlay1
+       (push (copy-overlay compare-windows-overlay1) compare-windows-overlays1)
+       (delete-overlay compare-windows-overlay1))
+      (when compare-windows-overlay2
+       (push (copy-overlay compare-windows-overlay2) compare-windows-overlays2)
+       (delete-overlay compare-windows-overlay2)))))
 
 (defun compare-windows-dehighlight ()
   "Remove highlighting created by `compare-windows-highlight'."
   (interactive)
   (remove-hook 'pre-command-hook 'compare-windows-dehighlight)
+  (mapc 'delete-overlay compare-windows-overlays1)
+  (mapc 'delete-overlay compare-windows-overlays2)
   (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1))
   (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2)))
 
 (provide 'compare-w)
 
-;;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46
+;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46
 ;;; compare-w.el ends here