(defgroup compare-windows nil
"Compare text between windows."
:prefix "compare-"
:group 'tools)
(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+"
"*Regexp or function that defines whitespace sequences for `compare-windows'.
That command optionally ignores changes in whitespace.
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.
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-windows)
(defcustom compare-ignore-whitespace nil
"*Non-nil means `compare-windows' ignores whitespace."
:type 'boolean
:group 'compare-windows
:version "22.1")
(defcustom compare-ignore-case nil
"*Non-nil means `compare-windows' ignores case differences."
:type 'boolean
:group 'compare-windows)
(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' (option \"No sync\"), then
no synchronization is performed, and the function `ding' is called
to beep or flash the screen when points are mismatched."
:type '(choice function regexp (const :tag "No sync" nil))
:group 'compare-windows
: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-windows
: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-windows
: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-windows
:version "22.1")
(defface compare-windows
'((t :inherit lazy-highlight))
"Face for highlighting of compare-windows difference regions."
:group 'compare-windows
: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)
(defun compare-windows (ignore-whitespace)
"Compare text in current window with text in next window.
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 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")
(if compare-ignore-whitespace
(setq ignore-whitespace (not ignore-whitespace)))
(let* (p1 p2 maxp1 maxp2 b1 b2 w2
(progress 1)
(opoint1 (point))
opoint2
skip-func-1
skip-func-2
(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)
b2 (window-buffer w2))
(setq opoint2 p2)
(setq maxp1 (point-max))
(setq skip-func-1 (if ignore-whitespace
(if (stringp compare-windows-whitespace)
(lambda (pos)
(compare-windows-skip-whitespace pos)
t)
compare-windows-whitespace)))
(with-current-buffer b2
(setq skip-func-2 (if ignore-whitespace
(if (stringp compare-windows-whitespace)
(lambda (pos)
(compare-windows-skip-whitespace pos)
t)
compare-windows-whitespace)))
(push-mark p2 t)
(setq maxp2 (point-max)))
(push-mark)
(while (> progress 0)
(and skip-func-1
(save-excursion
(let (p1a p2a w1 w2 result1 result2)
(setq result1 (funcall skip-func-1 opoint1))
(setq p1a (point))
(set-buffer b2)
(goto-char p2)
(setq result2 (funcall skip-func-2 opoint2))
(setq p2a (point))
(if (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)))
(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)
(if (not sync-func)
(ding)
(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))))
(when (and (= p1 opoint1) (= p2 opoint2))
(compare-windows-dehighlight)
(ding)
(message "No more matching points"))))))
(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))
(progn (setq end (match-end 0))
(> (point) start)))
(and (/= (point) start)
(= (point) opoint)))
(forward-char -1))
(setq beg (point))
(goto-char end)
(or (/= beg opoint)
(/= end opoint))))
(defun compare-windows-sync-regexp ()
(if (stringp compare-windows-sync)
(re-search-forward compare-windows-sync nil t)))
(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
(not p12s)
(or (setq in-bounds-p (< region-size (max (- (point-max) op1)
(- point-max2 op2))))
(> string-size 4)))
(if in-bounds-p
(setq region-size (* region-size 2))
(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
(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)))
(if (numberp compare-windows-sync-point)
(goto-char compare-windows-sync-point))
(setq compare-windows-sync-point nil)))
(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))
(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)