(compare-windows): Make more efficient use of

result from compare-buffer-substrings.

1 files changed, 18 insertions, 40 deletions

diff --git a/lisp/compare-w.el b/lisp/compare-w.el
index ac569963268..7a01c302096 100644
--- a/lisp/compare-w.el
+++ b/lisp/compare-w.el
@@ -64,11 +64,13 @@ 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))
@@ -83,58 +85,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)
 		       (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))))