emacs/lisp/compare-w.el

0 ;;; compare-w.el --- compare text between windows for Emacs
28 ;; This package provides one entry point, compare-windows.  It compares
29 ;; text starting from point in two adjacent windows, advancing point
31 ;; whitespace differences, or case differences, or both.
35 (defgroup compare-windows nil
36   "Compare text between windows."
37   :prefix "compare-"
40 (defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+"
41   "*Regexp or function that defines whitespace sequences for `compare-windows'.
42 That command optionally ignores changes in whitespace.
44 The value of `compare-windows-whitespace' is normally a regexp, but it
46 whitespace around (including before) point; it should also advance
47 past any whitespace.  The function is called in each window, with
49 where \\[compare-windows] was originally called; it should not look at
52 If the function returns the same value for both windows, then the
53 whitespace is considered to match, and is skipped."
55   :group 'compare-windows)
57 (defcustom compare-ignore-whitespace nil
58   "*Non-nil means `compare-windows' ignores whitespace."
60   :group 'compare-windows
63 (defcustom compare-ignore-case nil
64   "*Non-nil means `compare-windows' ignores case differences."
66   :group 'compare-windows)
68 (defcustom compare-windows-sync 'compare-windows-sync-default-function
70 windows if before calling `compare-windows' points are located
73 The value of `compare-windows-sync' can be a function.  The
74 function's job is to advance points in both windows to the next
75 matching text.  If the value of `compare-windows-sync' is a
76 regexp, then points in both windows are advanced to the next
80 `compare-windows-sync-default-function' that is able to
82 matching 32-character string in two windows.
94   :group 'compare-windows
97 (defcustom compare-windows-sync-string-size 32
106   :group 'compare-windows
109 (defcustom compare-windows-recenter nil
111 function `recenter' called in each of two windows to place
114 The value `(-1 0)' is useful if windows are split vertically,
115 and the value `((4) (4))' for horizontally split windows."
117   :group 'compare-windows
120 (defcustom compare-windows-highlight t
121   "*Non-nil means compare-windows highlights the differences.
123 other than `compare-windows'.
125 out all highlighting later with the command `compare-windows-dehighlight'."
129   :group 'compare-windows
132 (defface compare-windows
134   "Face for highlighting of compare-windows difference regions."
135   :group 'compare-windows
138 (defvar compare-windows-overlay1 nil)
139 (defvar compare-windows-overlay2 nil)
140 (defvar compare-windows-overlays1 nil)
141 (defvar compare-windows-overlays2 nil)
142 (defvar compare-windows-sync-point nil)
145 (defun compare-windows (ignore-whitespace)
152 If both windows display the same buffer,
157 `compare-ignore-whitespace'.  If `compare-ignore-whitespace' is
158 nil, then a prefix arg means ignore changes in whitespace.  If
159 `compare-ignore-whitespace' is non-nil, then a prefix arg means
160 don't ignore changes in whitespace.  The variable
161 `compare-windows-whitespace' controls how whitespace is skipped.
162 If `compare-ignore-case' is non-nil, changes in case are also
165 If `compare-windows-sync' is non-nil, then successive calls of
171   (if compare-ignore-whitespace
172       (setq ignore-whitespace (not ignore-whitespace)))
177 	    skip-func-1
178 	    skip-func-2
179 	    (sync-func (if (stringp compare-windows-sync)
180                            'compare-windows-sync-regexp
181                          compare-windows-sync)))
193     (setq skip-func-1 (if ignore-whitespace
194 			  (if (stringp compare-windows-whitespace)
196 				(compare-windows-skip-whitespace pos)
198 			    compare-windows-whitespace)))
201       (setq skip-func-2 (if ignore-whitespace
202 			    (if (stringp compare-windows-whitespace)
204 				(compare-windows-skip-whitespace pos)
206 			      compare-windows-whitespace)))
212       ;; If both windows have whitespace next to point,
213       ;; optionally skip over it.
214       (and skip-func-1
217 	       (setq result1 (funcall skip-func-1 opoint1))
221 	       (setq result2 (funcall skip-func-2 opoint2))
228 	    (case-fold-search compare-ignore-case))
229 	(setq progress (compare-buffer-substrings b2 p2 (+ size p2)
236       (when compare-windows-recenter
237         (recenter (car compare-windows-recenter))
238         (with-selected-window w2 (recenter (cadr compare-windows-recenter)))))
244           ;; then synchronize points between both windows
246             (setq compare-windows-sync-point nil)
255           (when compare-windows-recenter
256             (recenter (car compare-windows-recenter))
257             (with-selected-window w2 (recenter (cadr compare-windows-recenter))))
260             ;; Display error message when current points in two windows
262             (compare-windows-dehighlight)
266 ;; Move forward over whatever might be called whitespace.
267 ;; compare-windows-whitespace is a regexp that matches whitespace.
271 ;; Value is non-nil if whitespace is found.
272 ;; If there is whitespace before point, but none after,
274 (defun compare-windows-skip-whitespace (start)
278     (while (or (and (looking-at compare-windows-whitespace)
287       ;; keep going back until whitespace
296 (defun compare-windows-sync-regexp ()
297   (if (stringp compare-windows-sync)
298       (re-search-forward compare-windows-sync nil t)))
302 ;; and one of them is stored in compare-windows-sync-point
304 (defun compare-windows-sync-default-function ()
305   (if (not compare-windows-sync-point)
312              (region-size compare-windows-sync-string-size)
313              (string-size compare-windows-sync-string-size)
326               ;; on first iteration it is 2*compare-windows-sync-string-size,
340                          (let ((case-fold-search compare-ignore-case))
350           (compare-windows-highlight op1 (car p12) (current-buffer) w1
352         (setq compare-windows-sync-point (or (cadr p12) t)))
354     (if (numberp compare-windows-sync-point)
355         (goto-char compare-windows-sync-point))
356     (setq compare-windows-sync-point nil)))
359 (defun compare-windows-highlight (beg1 end1 b1 w1 beg2 end2 b2 w2)
360   (when compare-windows-highlight
361     (if compare-windows-overlay1
362         (move-overlay compare-windows-overlay1 beg1 end1 b1)
363       (setq compare-windows-overlay1 (make-overlay beg1 end1 b1))
364       (overlay-put compare-windows-overlay1 'face 'compare-windows)
365       (overlay-put compare-windows-overlay1 'priority 1000))
366     (overlay-put compare-windows-overlay1 'window w1)
367     (if compare-windows-overlay2
368         (move-overlay compare-windows-overlay2 beg2 end2 b2)
369       (setq compare-windows-overlay2 (make-overlay beg2 end2 b2))
370       (overlay-put compare-windows-overlay2 'face 'compare-windows)
371       (overlay-put compare-windows-overlay2 'priority 1000))
372     (overlay-put compare-windows-overlay2 'window w2)
373     (if (not (eq compare-windows-highlight 'persistent))
375 	(add-hook 'pre-command-hook 'compare-windows-dehighlight)
376       (when compare-windows-overlay1
377 	(push (copy-overlay compare-windows-overlay1) compare-windows-overlays1)
378 	(delete-overlay compare-windows-overlay1))
379       (when compare-windows-overlay2
380 	(push (copy-overlay compare-windows-overlay2) compare-windows-overlays2)
381 	(delete-overlay compare-windows-overlay2)))))
383 (defun compare-windows-dehighlight ()
384   "Remove highlighting created by `compare-windows-highlight'."
386   (remove-hook 'pre-command-hook 'compare-windows-dehighlight)
387   (mapc 'delete-overlay compare-windows-overlays1)
388   (mapc 'delete-overlay compare-windows-overlays2)
389   (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1))
390   (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2)))
392 (provide 'compare-w)
395 ;;; compare-w.el ends here