-;;; 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, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Maintainer: FSF
+;; Keywords: convenience files
;; This file is part of GNU Emacs.
;; 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., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
-(defvar compare-windows-whitespace "[ \t\n]+"
- "*Regexp that defines whitespace sequences for \\[compare-windows].
-Changes in whitespace are optionally ignored.
+(defgroup compare-w nil
+ "Compare text between windows."
+ :prefix "compare-"
+ :group 'tools)
-The value of `compare-windows-whitespace' may instead be a function; this
-function is called in each buffer, with point at the current scanning point.
-The function's job is to categorize any whitespace around (including before)
-point; it should also advance past any whitespace.
+(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+"
+ "*Regexp or function that defines whitespace sequences for `compare-windows'.
+That command optionally ignores changes in 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.")
+The value of `compare-windows-whitespace' is normally a regexp, but it
+can also be a function. The function's job is to categorize any
+whitespace around (including before) point; it should also advance
+past any whitespace. The function is called in each window, with
+point at the current scanning point. It gets one argument, the point
+where \\[compare-windows] was originally called; it should not look at
+any text before that point.
-(defvar compare-ignore-case nil
- "*Non-nil means \\[compare-windows] ignores case differences.")
+If the function returns the same value for both windows, then the
+whitespace is considered to match, and is skipped."
+ :type '(choice regexp function)
+ :group 'compare-w)
+
+(defcustom compare-ignore-whitespace nil
+ "*Non-nil means `compare-windows' ignores whitespace."
+ :type 'boolean
+ :group 'compare-w
+ :version "22.1")
+
+(defcustom compare-ignore-case nil
+ "*Non-nil means `compare-windows' ignores case differences."
+ :type 'boolean
+ :group 'compare-w)
+
+(defcustom compare-windows-sync 'compare-windows-sync-default-function
+ "*Function or regexp that is used to synchronize points in two
+windows if before calling `compare-windows' points are located
+on mismatched positions.
+
+The value of `compare-windows-sync' can be a function. The
+function's job is to advance points in both windows to the next
+matching text. If the value of `compare-windows-sync' is a
+regexp, then points in both windows are advanced to the next
+occurrence of this regexp.
+
+The current default value is the general function
+`compare-windows-sync-default-function' that is able to
+synchronize points by using quadratic algorithm to find the first
+matching 32-character string in two windows.
+
+The other useful values of this variable could be such functions
+as `forward-word', `forward-sentence', `forward-paragraph', or a
+regexp containing some field separator or a newline, depending on
+the nature of the difference units separator. The variable can
+be made buffer-local.
+
+If the value of this variable is `nil', then function `ding' is
+called to beep or flash the screen when points are mismatched."
+ :type '(choice regexp function)
+ :group 'compare-w
+ :version "22.1")
+
+(defcustom compare-windows-sync-string-size 32
+ "*Size of string from one window that is searched in second window.
+
+Small number makes difference regions more fine-grained, but it
+may fail by finding the wrong match. The bigger number makes
+difference regions more coarse-grained.
+
+The default value 32 is good for the most cases."
+ :type 'integer
+ :group 'compare-w
+ :version "22.1")
+
+(defcustom compare-windows-recenter nil
+ "*List of two values, each of which is used as argument of
+function `recenter' called in each of two windows to place
+matching points side-by-side.
+
+The value `(-1 0)' is useful if windows are split vertically,
+and the value `((4) (4))' for horizontally split windows."
+ :type '(list sexp sexp)
+ :group 'compare-w
+ :version "22.1")
+
+(defcustom compare-windows-highlight t
+ "*Non-nil means compare-windows highlights the differences.
+The value t removes highlighting immediately after invoking a command
+other than `compare-windows'.
+The value `persistent' leaves all highlighted differences. You can clear
+out all highlighting later with the command `compare-windows-dehighlight'."
+ :type '(choice (const :tag "No highlighting" nil)
+ (const :tag "Persistent highlighting" persistent)
+ (other :tag "Highlight until next command" t))
+ :group 'compare-w
+ :version "22.1")
+
+(defface compare-windows
+ '((t :inherit lazy-highlight))
+ "Face for highlighting of compare-windows difference regions."
+ :group 'compare-w
+ :version "22.1")
+
+(defvar compare-windows-overlay1 nil)
+(defvar compare-windows-overlay2 nil)
+(defvar compare-windows-overlays1 nil)
+(defvar compare-windows-overlays2 nil)
+(defvar compare-windows-sync-point nil)
;;;###autoload
(defun compare-windows (ignore-whitespace)
Compares the text starting at point in each window,
moving over text in each one as far as they match.
-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."
+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 reverse the value of variable
+`compare-ignore-whitespace'. If `compare-ignore-whitespace' is
+nil, then a prefix arg means ignore changes in whitespace. If
+`compare-ignore-whitespace' is non-nil, then a prefix arg means
+don't 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.
+
+If `compare-windows-sync' is non-nil, then successive calls of
+this command work in interlaced mode:
+on first call it advances points to the next difference,
+on second call it synchronizes points by skipping the difference,
+on third call it again advances points to the next difference and so on."
(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 (if ignore-whitespace ; XOR
+ (not compare-ignore-whitespace)
+ compare-ignore-whitespace)
+ (if (stringp compare-windows-whitespace)
+ 'compare-windows-skip-whitespace
+ compare-windows-whitespace)))
+ (sync-func (if (stringp compare-windows-sync)
+ 'compare-windows-sync-regexp
+ compare-windows-sync)))
(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)
(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)
-
- ;; If both buffers have whitespace next to point,
+ (while (> progress 0)
+ ;; If both windows 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)
+ (when compare-windows-recenter
+ (recenter (car compare-windows-recenter))
+ (with-selected-window w2 (recenter (cadr compare-windows-recenter)))))
+
(if (= (point) opoint1)
- (ding))))
+ (if (not sync-func)
+ (ding)
+ ;; If points are not advanced (i.e. already on mismatch position),
+ ;; then synchronize points between both windows
+ (save-excursion
+ (setq compare-windows-sync-point nil)
+ (funcall sync-func)
+ (setq p1 (point))
+ (set-buffer b2)
+ (goto-char p2)
+ (funcall sync-func)
+ (setq p2 (point)))
+ (goto-char p1)
+ (set-window-point w2 p2)
+ (when compare-windows-recenter
+ (recenter (car compare-windows-recenter))
+ (with-selected-window w2 (recenter (cadr compare-windows-recenter))))
+ ;; If points are still not synchronized, then ding
+ (when (and (= p1 opoint1) (= p2 opoint2))
+ ;; Display error message when current points in two windows
+ ;; are unmatched and next matching points can't be found.
+ (compare-windows-dehighlight)
+ (ding)
+ (message "No more matching points"))))))
;; Move forward over whatever might be called whitespace.
;; compare-windows-whitespace is a regexp that matches whitespace.
;; 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))))
+
+;; Move forward to the next synchronization regexp.
+(defun compare-windows-sync-regexp ()
+ (if (stringp compare-windows-sync)
+ (re-search-forward compare-windows-sync nil t)))
+
+;; Function works in two passes: one call on each window.
+;; On the first call both matching points are computed,
+;; and one of them is stored in compare-windows-sync-point
+;; to be used when this function is called on second window.
+(defun compare-windows-sync-default-function ()
+ (if (not compare-windows-sync-point)
+ (let* ((w1 (selected-window))
+ (w2 (next-window w1))
+ (b2 (window-buffer w2))
+ (point-max2 (with-current-buffer b2 (point-max)))
+ (op2 (window-point w2))
+ (op1 (point))
+ (region-size compare-windows-sync-string-size)
+ (string-size compare-windows-sync-string-size)
+ in-bounds-p s1 p2 p12s p12)
+ (while (and
+ ;; until matching points are found
+ (not p12s)
+ ;; until size exceeds the maximum points of both buffers
+ ;; (bounds below take care to not overdo in each of them)
+ (or (setq in-bounds-p (< region-size (max (- (point-max) op1)
+ (- point-max2 op2))))
+ ;; until string size becomes smaller than 4
+ (> string-size 4)))
+ (if in-bounds-p
+ ;; make the next search in the double-sized region;
+ ;; on first iteration it is 2*compare-windows-sync-string-size,
+ ;; on last iterations it exceeds both buffers maximum points
+ (setq region-size (* region-size 2))
+ ;; if region size exceeds the maximum points of both buffers,
+ ;; then start to halve the string size until 4;
+ ;; this helps to find differences near the end of buffers
+ (setq string-size (/ string-size 2)))
+ (let ((p1 op1)
+ (bound1 (- (min (+ op1 region-size) (point-max)) string-size))
+ (bound2 (min (+ op2 region-size) point-max2)))
+ (while (< p1 bound1)
+ (setq s1 (buffer-substring-no-properties p1 (+ p1 string-size)))
+ (setq p2 (with-current-buffer b2
+ (goto-char op2)
+ (let ((case-fold-search compare-ignore-case))
+ (search-forward s1 bound2 t))))
+ (when p2
+ (setq p2 (- p2 string-size))
+ (setq p12s (cons (list (+ p1 p2) p1 p2) p12s)))
+ (setq p1 (1+ p1)))))
+ (when p12s
+ ;; use closest matching points (i.e. points with minimal sum)
+ (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s)))
+ (goto-char (car p12))
+ (compare-windows-highlight op1 (car p12) (current-buffer) w1
+ op2 (cadr p12) b2 w2))
+ (setq compare-windows-sync-point (or (cadr p12) t)))
+ ;; else set point in the second window to the pre-calculated value
+ (if (numberp compare-windows-sync-point)
+ (goto-char compare-windows-sync-point))
+ (setq compare-windows-sync-point nil)))
+
+;; Highlight differences
+(defun compare-windows-highlight (beg1 end1 b1 w1 beg2 end2 b2 w2)
+ (when compare-windows-highlight
+ (if compare-windows-overlay1
+ (move-overlay compare-windows-overlay1 beg1 end1 b1)
+ (setq compare-windows-overlay1 (make-overlay beg1 end1 b1))
+ (overlay-put compare-windows-overlay1 'face 'compare-windows)
+ (overlay-put compare-windows-overlay1 'priority 1000))
+ (overlay-put compare-windows-overlay1 'window w1)
+ (if compare-windows-overlay2
+ (move-overlay compare-windows-overlay2 beg2 end2 b2)
+ (setq compare-windows-overlay2 (make-overlay beg2 end2 b2))
+ (overlay-put compare-windows-overlay2 'face 'compare-windows)
+ (overlay-put compare-windows-overlay2 'priority 1000))
+ (overlay-put compare-windows-overlay2 'window w2)
+ (if (not (eq compare-windows-highlight 'persistent))
+ ;; Remove highlighting before next command is executed
+ (add-hook 'pre-command-hook 'compare-windows-dehighlight)
+ (when compare-windows-overlay1
+ (push (copy-overlay compare-windows-overlay1) compare-windows-overlays1)
+ (delete-overlay compare-windows-overlay1))
+ (when compare-windows-overlay2
+ (push (copy-overlay compare-windows-overlay2) compare-windows-overlays2)
+ (delete-overlay compare-windows-overlay2)))))
+
+(defun compare-windows-dehighlight ()
+ "Remove highlighting created by `compare-windows-highlight'."
+ (interactive)
+ (remove-hook 'pre-command-hook 'compare-windows-dehighlight)
+ (mapc 'delete-overlay compare-windows-overlays1)
+ (mapc 'delete-overlay compare-windows-overlays2)
+ (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1))
+ (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2)))
(provide 'compare-w)
+;;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46
;;; compare-w.el ends here