X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/745bc783eb8bd84b07a7d512660947ec214e71eb..ddff3d800e7820d6d2d71f270afa90e5cc29ac71:/lisp/compare-w.el diff --git a/lisp/compare-w.el b/lisp/compare-w.el index 0ae9f37673..495ff12d11 100644 --- a/lisp/compare-w.el +++ b/lisp/compare-w.el @@ -1,11 +1,14 @@ -;; Compare text between windows for Emacs. -;; Copyright (C) 1986, 1989 Free Software Foundation, Inc. +;;; compare-w.el --- compare text between windows for Emacs. + +;; Copyright (C) 1986, 1989, 1993, 1997 Free Software Foundation, Inc. + +;; Maintainer: FSF ;; This file is part of GNU Emacs. ;; 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 1, or (at your option) +;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -14,13 +17,26 @@ ;; 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. -(provide 'compare-w) +;;; Commentary: + +;; This package provides one entry point, compare-windows. It compares +;; text starting from point in two adjacent windows, advancing point +;; until it finds a difference. Option variables permit you to ignore +;; whitespace differences, or case differences, or both. -(defvar compare-windows-whitespace " \t\n" - "*String of characters considered whitespace for \\[compare-windows]. +;;; Code: + +(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. The value of `compare-windows-whitespace' may instead be a function; this @@ -31,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) @@ -42,19 +62,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-whitespace-regexp (concat "[" skip-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) @@ -63,67 +90,71 @@ 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) - (if (stringp skip-whitespace) - (progn - (if (not (eobp)) - (skip-chars-backward skip-whitespace opoint1)) - (and (looking-at skip-whitespace-regexp) - (setq p1a (match-end 0) result1 t))) - (setq result1 (funcall skip-whitespace opoint1)) - (setq p1a (point))) + (setq result1 (funcall skip-func opoint1)) + (setq p1a (point)) (set-buffer b2) (goto-char p2) - (if (stringp skip-whitespace) - (progn - (if (not (eobp)) - (skip-chars-backward skip-whitespace opoint2)) - (and (looking-at skip-whitespace-regexp) - (setq p2a (match-end 0) result2 t))) - (setq result2 (funcall skip-whitespace 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) - (while (> size 0) - (setq success-1 t) - (while success-1 - (setq size (min size (- maxp1 p1) (- maxp2 p2))) - (save-excursion - (set-buffer b2) - (setq s2 (buffer-substring p2 (+ size p2)))) - (setq success-1 - (and (> size 0) - (if compare-ignore-case - (let ((case-fold-search t)) - (save-excursion - (search-forward s2 (+ p1 size) t))) - (equal (buffer-substring p1 (+ size p1)) s2)))) - (if success-1 - (setq p1 (+ p1 size) p2 (+ p2 size) - success t))) - (setq size (/ size 2))))) - - (goto-char p1) - (set-window-point w2 p2) + (setq result2 (funcall skip-func opoint2)) + (setq p2a (point)) + (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)) + (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)))) + +;; Move forward over whatever might be called whitespace. +;; compare-windows-whitespace is a regexp that matches whitespace. +;; Match it at various starting points before the original point +;; 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 (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) + (or (/= beg opoint) + (/= end opoint)))) + +(provide 'compare-w) + +;;; compare-w.el ends here