1 |
;;; compare-w.el --- compare text between windows for Emacs |
;;; compare-w.el --- compare text between windows for Emacs |
2 |
|
|
3 |
;; Copyright (C) 1986, 1989, 1993, 1997 Free Software Foundation, Inc. |
;; Copyright (C) 1986, 1989, 1993, 1997, 2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Maintainer: FSF |
;; Maintainer: FSF |
6 |
;; Keywords: convenience files |
;; Keywords: convenience files |
37 |
:group 'tools) |
:group 'tools) |
38 |
|
|
39 |
(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+" |
(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+" |
40 |
"*Regexp that defines whitespace sequences for \\[compare-windows]. |
"*Regexp or function that defines whitespace sequences for `compare-windows'. |
41 |
That command optionally ignores changes in whitespace. |
That command optionally ignores changes in whitespace. |
42 |
|
|
43 |
The value of `compare-windows-whitespace' is normally a regexp, but it |
The value of `compare-windows-whitespace' is normally a regexp, but it |
44 |
can also be a function. The function's job is to categorize any |
can also be a function. The function's job is to categorize any |
45 |
whitespace around (including before) point; it should also advance |
whitespace around (including before) point; it should also advance |
46 |
past any whitespace. The function is called in each buffer, with |
past any whitespace. The function is called in each window, with |
47 |
point at the current scanning point. It gets one argument, the point |
point at the current scanning point. It gets one argument, the point |
48 |
where `compare-windows' was originally called; it should not look at |
where \\[compare-windows] was originally called; it should not look at |
49 |
any text before that point. |
any text before that point. |
50 |
|
|
51 |
If the function returns the same value for both buffers, then the |
If the function returns the same value for both windows, then the |
52 |
whitespace is considered to match, and is skipped." |
whitespace is considered to match, and is skipped." |
53 |
:type '(choice regexp function) |
:type '(choice regexp function) |
54 |
:group 'compare-w) |
:group 'compare-w) |
55 |
|
|
56 |
|
(defcustom compare-ignore-whitespace nil |
57 |
|
"*Non-nil means `compare-windows' ignores whitespace." |
58 |
|
:type 'boolean |
59 |
|
:group 'compare-w) |
60 |
|
|
61 |
(defcustom compare-ignore-case nil |
(defcustom compare-ignore-case nil |
62 |
"*Non-nil means \\[compare-windows] ignores case differences." |
"*Non-nil means `compare-windows' ignores case differences." |
63 |
|
:type 'boolean |
64 |
|
:group 'compare-w) |
65 |
|
|
66 |
|
(defcustom compare-windows-sync 'compare-windows-sync-default-function |
67 |
|
"*Function or regexp that is used to synchronize points in two |
68 |
|
windows if before calling `compare-windows' points are located |
69 |
|
on mismatched positions. |
70 |
|
|
71 |
|
The value of `compare-windows-sync' can be a function. The |
72 |
|
function's job is to advance points in both windows to the next |
73 |
|
matching text. If the value of `compare-windows-sync' is a |
74 |
|
regexp, then points in both windows are advanced to the next |
75 |
|
occurrence of this regexp. |
76 |
|
|
77 |
|
The current default value is the general function |
78 |
|
`compare-windows-sync-default-function' that is able to |
79 |
|
synchronize points by using quadratic algorithm to find the first |
80 |
|
matching 32-character string in two windows. |
81 |
|
|
82 |
|
The other useful values of this variable could be such functions |
83 |
|
as `forward-word', `forward-sentence', `forward-paragraph', or a |
84 |
|
regexp containing some field separator or a newline, depending on |
85 |
|
the nature of the difference units separator. The variable can |
86 |
|
be made buffer-local. |
87 |
|
|
88 |
|
If the value of this variable is `nil', then function `ding' is |
89 |
|
called to beep or flash the screen when points are mismatched." |
90 |
|
:type '(choice regexp function) |
91 |
|
:group 'compare-w) |
92 |
|
|
93 |
|
(defcustom compare-windows-sync-string-size 32 |
94 |
|
"*Size of string from one window that is searched in second window. |
95 |
|
|
96 |
|
Small number makes difference regions more fine-grained, but it |
97 |
|
may fail by finding the wrong match. The bigger number makes |
98 |
|
difference regions more coarse-grained. |
99 |
|
|
100 |
|
The default value 32 is good for the most cases." |
101 |
|
:type 'integer |
102 |
|
:group 'compare-w) |
103 |
|
|
104 |
|
(defcustom compare-windows-recenter nil |
105 |
|
"*List of two values, each of which is used as argument of |
106 |
|
function `recenter' called in each of two windows to place |
107 |
|
matching points side-by-side. |
108 |
|
|
109 |
|
The value `(-1 0)' is useful if windows are split vertically, |
110 |
|
and the value `((4) (4))' for horizontally split windows." |
111 |
|
:type '(list sexp sexp) |
112 |
|
:group 'compare-w) |
113 |
|
|
114 |
|
(defcustom compare-windows-highlight t |
115 |
|
"*Non-nil means compare-windows highlights the differences." |
116 |
:type 'boolean |
:type 'boolean |
117 |
:group 'compare-w) |
:group 'compare-w) |
118 |
|
|
119 |
|
(defface compare-windows-face |
120 |
|
'((((type tty pc) (class color)) |
121 |
|
(:background "turquoise3")) |
122 |
|
(((class color) (background light)) |
123 |
|
(:background "paleturquoise")) |
124 |
|
(((class color) (background dark)) |
125 |
|
(:background "paleturquoise4")) |
126 |
|
(t (:underline t))) |
127 |
|
"Face for highlighting of compare-windows difference regions." |
128 |
|
:group 'compare-w) |
129 |
|
|
130 |
|
(defvar compare-windows-overlay1 nil) |
131 |
|
(defvar compare-windows-overlay2 nil) |
132 |
|
(defvar compare-windows-sync-point nil) |
133 |
|
|
134 |
;;;###autoload |
;;;###autoload |
135 |
(defun compare-windows (ignore-whitespace) |
(defun compare-windows (ignore-whitespace) |
136 |
"Compare text in current window with text in next window. |
"Compare text in current window with text in next window. |
143 |
the mark is pushed twice in that buffer: |
the mark is pushed twice in that buffer: |
144 |
first in the other window, then in the selected window. |
first in the other window, then in the selected window. |
145 |
|
|
146 |
A prefix arg means ignore changes in whitespace. |
A prefix arg means reverse the value of variable |
147 |
The variable `compare-windows-whitespace' controls how whitespace is skipped. |
`compare-ignore-whitespace'. If `compare-ignore-whitespace' is |
148 |
If `compare-ignore-case' is non-nil, changes in case are also ignored." |
nil, then a prefix arg means ignore changes in whitespace. If |
149 |
|
`compare-ignore-whitespace' is non-nil, then a prefix arg means |
150 |
|
don't ignore changes in whitespace. The variable |
151 |
|
`compare-windows-whitespace' controls how whitespace is skipped. |
152 |
|
If `compare-ignore-case' is non-nil, changes in case are also |
153 |
|
ignored. |
154 |
|
|
155 |
|
If `compare-windows-sync' is non-nil, then successive calls of |
156 |
|
this command work in interlaced mode: |
157 |
|
on first call it advances points to the next difference, |
158 |
|
on second call it synchronizes points by skipping the difference, |
159 |
|
on third call it again advances points to the next difference and so on." |
160 |
(interactive "P") |
(interactive "P") |
161 |
(let* (p1 p2 maxp1 maxp2 b1 b2 w2 |
(let* (p1 p2 maxp1 maxp2 b1 b2 w2 |
162 |
(progress 1) |
(progress 1) |
163 |
(opoint1 (point)) |
(opoint1 (point)) |
164 |
opoint2 |
opoint2 |
165 |
(skip-func (if ignore-whitespace |
(skip-func (if (if ignore-whitespace ; XOR |
166 |
(if (stringp compare-windows-whitespace) |
(not compare-ignore-whitespace) |
167 |
'compare-windows-skip-whitespace |
compare-ignore-whitespace) |
168 |
compare-windows-whitespace)))) |
(if (stringp compare-windows-whitespace) |
169 |
|
'compare-windows-skip-whitespace |
170 |
|
compare-windows-whitespace))) |
171 |
|
(sync-func (if (stringp compare-windows-sync) |
172 |
|
'compare-windows-sync-regexp |
173 |
|
compare-windows-sync))) |
174 |
(setq p1 (point) b1 (current-buffer)) |
(setq p1 (point) b1 (current-buffer)) |
175 |
(setq w2 (next-window (selected-window))) |
(setq w2 (next-window (selected-window))) |
176 |
(if (eq w2 (selected-window)) |
(if (eq w2 (selected-window)) |
188 |
(push-mark) |
(push-mark) |
189 |
|
|
190 |
(while (> progress 0) |
(while (> progress 0) |
191 |
;; If both buffers have whitespace next to point, |
;; If both windows have whitespace next to point, |
192 |
;; optionally skip over it. |
;; optionally skip over it. |
|
|
|
193 |
(and skip-func |
(and skip-func |
194 |
(save-excursion |
(save-excursion |
195 |
(let (p1a p2a w1 w2 result1 result2) |
(let (p1a p2a w1 w2 result1 result2) |
212 |
(setq p1 (+ p1 progress) p2 (+ p2 progress))) |
(setq p1 (+ p1 progress) p2 (+ p2 progress))) |
213 |
;; Advance point now rather than later, in case we're interrupted. |
;; Advance point now rather than later, in case we're interrupted. |
214 |
(goto-char p1) |
(goto-char p1) |
215 |
(set-window-point w2 p2)) |
(set-window-point w2 p2) |
216 |
|
(when compare-windows-recenter |
217 |
|
(recenter (car compare-windows-recenter)) |
218 |
|
(with-selected-window w2 (recenter (cadr compare-windows-recenter))))) |
219 |
|
|
220 |
(if (= (point) opoint1) |
(if (= (point) opoint1) |
221 |
(ding)))) |
(if (not sync-func) |
222 |
|
(ding) |
223 |
|
;; If points are not advanced (i.e. already on mismatch position), |
224 |
|
;; then synchronize points between both windows |
225 |
|
(save-excursion |
226 |
|
(setq compare-windows-sync-point nil) |
227 |
|
(funcall sync-func) |
228 |
|
(setq p1 (point)) |
229 |
|
(set-buffer b2) |
230 |
|
(goto-char p2) |
231 |
|
(funcall sync-func) |
232 |
|
(setq p2 (point))) |
233 |
|
(goto-char p1) |
234 |
|
(set-window-point w2 p2) |
235 |
|
(when compare-windows-recenter |
236 |
|
(recenter (car compare-windows-recenter)) |
237 |
|
(with-selected-window w2 (recenter (cadr compare-windows-recenter)))) |
238 |
|
;; If points are still not synchronized, then ding |
239 |
|
(when (and (= p1 opoint1) (= p2 opoint2)) |
240 |
|
;; Display error message when current points in two windows |
241 |
|
;; are unmatched and next matching points can't be found. |
242 |
|
(compare-windows-dehighlight) |
243 |
|
(ding) |
244 |
|
(message "No more matching points")))))) |
245 |
|
|
246 |
;; Move forward over whatever might be called whitespace. |
;; Move forward over whatever might be called whitespace. |
247 |
;; compare-windows-whitespace is a regexp that matches whitespace. |
;; compare-windows-whitespace is a regexp that matches whitespace. |
249 |
;; and find the latest point at which a match ends. |
;; and find the latest point at which a match ends. |
250 |
;; Don't try starting points before START, though. |
;; Don't try starting points before START, though. |
251 |
;; Value is non-nil if whitespace is found. |
;; Value is non-nil if whitespace is found. |
|
|
|
252 |
;; If there is whitespace before point, but none after, |
;; If there is whitespace before point, but none after, |
253 |
;; then return t, but don't advance point. |
;; then return t, but don't advance point. |
254 |
(defun compare-windows-skip-whitespace (start) |
(defun compare-windows-skip-whitespace (start) |
272 |
(or (/= beg opoint) |
(or (/= beg opoint) |
273 |
(/= end opoint)))) |
(/= end opoint)))) |
274 |
|
|
275 |
|
;; Move forward to the next synchronization regexp. |
276 |
|
(defun compare-windows-sync-regexp () |
277 |
|
(if (stringp compare-windows-sync) |
278 |
|
(re-search-forward compare-windows-sync nil t))) |
279 |
|
|
280 |
|
;; Function works in two passes: one call on each window. |
281 |
|
;; On the first call both matching points are computed, |
282 |
|
;; and one of them is stored in compare-windows-sync-point |
283 |
|
;; to be used when this function is called on second window. |
284 |
|
(defun compare-windows-sync-default-function () |
285 |
|
(if (not compare-windows-sync-point) |
286 |
|
(let* ((w2 (next-window (selected-window))) |
287 |
|
(b2 (window-buffer w2)) |
288 |
|
(point-max2 (with-current-buffer b2 (point-max))) |
289 |
|
(op2 (window-point w2)) |
290 |
|
(op1 (point)) |
291 |
|
(region-size compare-windows-sync-string-size) |
292 |
|
(string-size compare-windows-sync-string-size) |
293 |
|
in-bounds-p s1 p2 p12s p12) |
294 |
|
(while (and |
295 |
|
;; until matching points are found |
296 |
|
(not p12s) |
297 |
|
;; until size exceeds the maximum points of both buffers |
298 |
|
;; (bounds below take care to not overdo in each of them) |
299 |
|
(or (setq in-bounds-p (< region-size (max (- (point-max) op1) |
300 |
|
(- point-max2 op2)))) |
301 |
|
;; until string size becomes smaller than 4 |
302 |
|
(> string-size 4))) |
303 |
|
(if in-bounds-p |
304 |
|
;; make the next search in the double-sized region; |
305 |
|
;; on first iteration it is 2*compare-windows-sync-string-size, |
306 |
|
;; on last iterations it exceeds both buffers maximum points |
307 |
|
(setq region-size (* region-size 2)) |
308 |
|
;; if region size exceeds the maximum points of both buffers, |
309 |
|
;; then start to halve the string size until 4; |
310 |
|
;; this helps to find differences near the end of buffers |
311 |
|
(setq string-size (/ string-size 2))) |
312 |
|
(let ((p1 op1) |
313 |
|
(bound1 (- (min (+ op1 region-size) (point-max)) string-size)) |
314 |
|
(bound2 (min (+ op2 region-size) point-max2))) |
315 |
|
(while (< p1 bound1) |
316 |
|
(setq s1 (buffer-substring-no-properties p1 (+ p1 string-size))) |
317 |
|
(setq p2 (with-current-buffer b2 |
318 |
|
(goto-char op2) |
319 |
|
(let ((case-fold-search compare-ignore-case)) |
320 |
|
(search-forward s1 bound2 t)))) |
321 |
|
(when p2 |
322 |
|
(setq p2 (- p2 string-size)) |
323 |
|
(setq p12s (cons (list (+ p1 p2) p1 p2) p12s))) |
324 |
|
(setq p1 (1+ p1))))) |
325 |
|
(when p12s |
326 |
|
;; use closest matching points (i.e. points with minimal sum) |
327 |
|
(setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s))) |
328 |
|
(goto-char (car p12)) |
329 |
|
(compare-windows-highlight op1 (car p12) op2 (cadr p12) b2)) |
330 |
|
(setq compare-windows-sync-point (or (cadr p12) t))) |
331 |
|
;; else set point in the second window to the pre-calculated value |
332 |
|
(if (numberp compare-windows-sync-point) |
333 |
|
(goto-char compare-windows-sync-point)) |
334 |
|
(setq compare-windows-sync-point nil))) |
335 |
|
|
336 |
|
;; Highlight differences |
337 |
|
(defun compare-windows-highlight (beg1 end1 beg2 end2 buf2) |
338 |
|
(when compare-windows-highlight |
339 |
|
(if compare-windows-overlay1 |
340 |
|
(move-overlay compare-windows-overlay1 beg1 end1 (current-buffer)) |
341 |
|
(setq compare-windows-overlay1 (make-overlay beg1 end1 (current-buffer))) |
342 |
|
(overlay-put compare-windows-overlay1 'face 'compare-windows-face) |
343 |
|
(overlay-put compare-windows-overlay1 'priority 1)) |
344 |
|
(if compare-windows-overlay2 |
345 |
|
(move-overlay compare-windows-overlay2 beg2 end2 buf2) |
346 |
|
(setq compare-windows-overlay2 (make-overlay beg2 end2 buf2)) |
347 |
|
(overlay-put compare-windows-overlay2 'face 'compare-windows-face) |
348 |
|
(overlay-put compare-windows-overlay2 'priority 1)) |
349 |
|
;; Remove highlighting before next command is executed |
350 |
|
(add-hook 'pre-command-hook 'compare-windows-dehighlight))) |
351 |
|
|
352 |
|
(defun compare-windows-dehighlight () |
353 |
|
"Remove highlighting created by `compare-windows-highlight'." |
354 |
|
(interactive) |
355 |
|
(remove-hook 'pre-command-hook 'compare-windows-dehighlight) |
356 |
|
(and compare-windows-overlay1 (delete-overlay compare-windows-overlay1)) |
357 |
|
(and compare-windows-overlay2 (delete-overlay compare-windows-overlay2))) |
358 |
|
|
359 |
(provide 'compare-w) |
(provide 'compare-w) |
360 |
|
|
361 |
;;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46 |
;;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46 |