# HG changeset patch # User Karl Heuer # Date 855528917 0 # Node ID dc0cd1c70c879343d127410b63db61c368dd367e # Parent b0d8e7c0f90621320439a957ea6dfa0e0453d9c6 (compare-windows): Make more efficient use of result from compare-buffer-substrings. diff -r b0d8e7c0f906 -r dc0cd1c70c87 lisp/compare-w.el --- a/lisp/compare-w.el Sun Feb 09 16:03:50 1997 +0000 +++ b/lisp/compare-w.el Sun Feb 09 22:55:17 1997 +0000 @@ -64,11 +64,13 @@ 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 @@ (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))))) + (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)) - (goto-char p1) - (set-window-point w2 p2) (if (= (point) opoint1) (ding))))