(custom-set-variables): Set options with :require

[gnu-emacs] / lisp / compare-w.el

diff --git a/lisp/compare-w.el b/lisp/compare-w.el
index ac569963268bc7392cbf0a05eeed03ff848d9ff7..389da2c0aad542f1fa4841c86167a27481914a5a 100644 (file)
--- a/lisp/compare-w.el
+++ b/lisp/compare-w.el
@@ -1,6 +1,6 @@
-;;; compare-w.el --- compare text between windows for Emacs.
+;;; compare-w.el --- compare text between windows for Emacs
 
-;; Copyright (C) 1986, 1989, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1989, 1993, 1997 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 
@@ -30,7 +30,12 @@
 
 ;;; Code:
 
-(defvar compare-windows-whitespace "[ \t\n]+"
+(defgroup compare-w nil
+  "Compare text between windows."
+  :prefix "compare-"
+  :group 'tools)
+
+(defcustom compare-windows-whitespace "[ \t\n]+"
   "*Regexp that defines whitespace sequences for \\[compare-windows].
 Changes in whitespace are optionally ignored.
 
@@ -42,10 +47,14 @@ point; it should also advance past any whitespace.
 The function is passed one argument, the point where `compare-windows'
 was originally called; it should not consider any text before that point.
 If the function returns the same value for both buffers, then the
-whitespace is considered to match, and is skipped.")
+whitespace is considered to match, and is skipped."
+  :type '(choice regexp function)
+  :group 'compare-w)
 
-(defvar compare-ignore-case nil
-  "*Non-nil means \\[compare-windows] ignores case differences.")
+(defcustom compare-ignore-case nil
+  "*Non-nil means \\[compare-windows] ignores case differences."
+  :type 'boolean
+  :group 'compare-w)
 
 ;;;###autoload
 (defun compare-windows (ignore-whitespace)
@@ -64,13 +73,17 @@ The variable `compare-windows-whitespace' controls how whitespace is skipped.
 If `compare-ignore-case' is non-nil, changes in case are also ignored."
   (interactive "P")
   (let* (p1 p2 maxp1 maxp2 b1 b2 w2
-           success size
+           (progress 1)
            (opoint1 (point))
            opoint2
-           (skip-whitespace (if ignore-whitespace
-                                compare-windows-whitespace)))
+           (skip-func (if ignore-whitespace
+                        (if (stringp compare-windows-whitespace)
+                            'compare-windows-skip-whitespace
+                          compare-windows-whitespace))))
     (setq p1 (point) b1 (current-buffer))
     (setq w2 (next-window (selected-window)))
+    (if (eq w2 (selected-window))
+       (setq w2 (next-window (selected-window) nil 'visible)))
     (if (eq w2 (selected-window))
        (error "No other window"))
     (setq p2 (window-point w2)
@@ -83,58 +96,34 @@ If `compare-ignore-case' is non-nil, changes in case are also ignored."
       (setq maxp2 (point-max)))
     (push-mark)
 
-    (setq success t)
-    (while success
-      (setq success nil)
-      ;; if interrupted, show how far we've gotten
-      (goto-char p1)
-      (set-window-point w2 p2)
-
+    (while (> progress 0)
       ;; If both buffers have whitespace next to point,
       ;; optionally skip over it.
 
-      (and skip-whitespace
+      (and skip-func
           (save-excursion
             (let (p1a p2a w1 w2 result1 result2)
-              (setq result1
-                    (if (stringp skip-whitespace)
-                        (compare-windows-skip-whitespace opoint1)
-                      (funcall skip-whitespace opoint1)))
+              (setq result1 (funcall skip-func opoint1))
               (setq p1a (point))
               (set-buffer b2)
               (goto-char p2)
-              (setq result2
-                    (if (stringp skip-whitespace)
-                        (compare-windows-skip-whitespace opoint2)
-                      (funcall skip-whitespace opoint2)))
+              (setq result2 (funcall skip-func opoint2))
               (setq p2a (point))
-              (if (or (stringp skip-whitespace)
+              (if (or (stringp compare-windows-whitespace)
                       (and result1 result2 (eq result1 result2)))
                   (setq p1 p1a
                         p2 p2a)))))
 
-      ;; Try advancing comparing 1000 chars at a time.
-      ;; When that fails, go 500 chars at a time, and so on.
-      (let ((size 1000)
-           success-1
+      (let ((size (min (- maxp1 p1) (- maxp2 p2)))
            (case-fold-search compare-ignore-case))
-       (while (> size 0)
-         (setq success-1 t)
-         ;; Try comparing SIZE chars at a time, repeatedly, till that fails.
-         (while success-1
-           (setq size (min size (- maxp1 p1) (- maxp2 p2)))
-           (setq success-1
-                 (and (> size 0)
-                      (= 0 (compare-buffer-substrings b2 p2 (+ size p2)
-                                                      b1 p1 (+ size p1)))))
-           (if success-1
-               (setq p1 (+ p1 size) p2 (+ p2 size)
-                     success t)))
-         ;; If SIZE chars don't match, try fewer.
-         (setq size (/ size 2)))))
-
-    (goto-char p1)
-    (set-window-point w2 p2)
+       (setq progress (compare-buffer-substrings b2 p2 (+ size p2)
+                                                 b1 p1 (+ size p1)))
+       (setq progress (if (zerop progress) size (1- (abs progress))))
+       (setq p1 (+ p1 progress) p2 (+ p2 progress)))
+      ;; Advance point now rather than later, in case we're interrupted.
+      (goto-char p1)
+      (set-window-point w2 p2))
+
     (if (= (point) opoint1)
        (ding))))