X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/048ab7d386ee81982e94c90236d4655a77da94dd..96439b6aabaca49a1fb43bf5d526e82f12b0924b:/lisp/compare-w.el diff --git a/lisp/compare-w.el b/lisp/compare-w.el index a52e8e0754..bdfcd006c9 100644 --- a/lisp/compare-w.el +++ b/lisp/compare-w.el @@ -1,6 +1,6 @@ ;;; 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 @@ -17,8 +17,9 @@ ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: @@ -52,18 +53,26 @@ whitespace is considered to match, and is skipped.") Compares the text starting at point in each window, moving over text in each one as far as they match. +This command pushes the mark in each window +at the prior location of point in that window. +If both windows display the same buffer, +the mark is pushed twice in that buffer: +first in the other window, then in the selected window. + A prefix arg means ignore changes in whitespace. 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))) + (setq w2 (next-window (selected-window) nil 'visible)) (if (eq w2 (selected-window)) (error "No other window")) (setq p2 (window-point w2) @@ -72,59 +81,38 @@ If `compare-ignore-case' is non-nil, changes in case are also ignored." (setq maxp1 (point-max)) (save-excursion (set-buffer b2) + (push-mark p2 t) (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)) - (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 + (if (or (stringp compare-windows-whitespace) + (and result1 result2 (eq result1 result2))) + (setq p1 p1a + p2 p2a))))) + + (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)))) @@ -134,19 +122,29 @@ If `compare-ignore-case' is non-nil, changes in case are also ignored." ;; and find the latest point at which a match ends. ;; Don't try starting points before START, though. ;; Value is non-nil if whitespace is found. + +;; If there is whitespace before point, but none after, +;; then return t, but don't advance point. (defun compare-windows-skip-whitespace (start) (let ((end (point)) + (beg (point)) (opoint (point))) - (while (and (looking-at compare-windows-whitespace) - (<= end (match-end 0)) - ;; This match goes past END, so advance END. - (progn (setq end (match-end 0)) - (> (point) start))) + (while (or (and (looking-at compare-windows-whitespace) + (<= end (match-end 0)) + ;; This match goes past END, so advance END. + (progn (setq end (match-end 0)) + (> (point) start))) + (and (/= (point) start) + ;; Consider at least the char before point, + ;; unless it is also before START. + (= (point) opoint))) ;; keep going back until whitespace ;; doesn't extend to or past end (forward-char -1)) + (setq beg (point)) (goto-char end) - (/= end opoint))) + (or (/= beg opoint) + (/= end opoint)))) (provide 'compare-w)