Commit | Line | Data |
---|---|---|
55535639 | 1 | ;;; compare-w.el --- compare text between windows for Emacs |
c0274f38 | 2 | |
e91081eb | 3 | ;; Copyright (C) 1986, 1989, 1993, 1997, 2001, 2002, 2003, 2004, |
114f9c96 | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
745bc783 | 5 | |
9750e079 | 6 | ;; Maintainer: FSF |
30764597 | 7 | ;; Keywords: convenience files |
9750e079 | 8 | |
745bc783 JB |
9 | ;; This file is part of GNU Emacs. |
10 | ||
eb3fa2cf | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
745bc783 | 12 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
745bc783 JB |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
745bc783 | 23 | |
e41b2db1 ER |
24 | ;;; Commentary: |
25 | ||
26 | ;; This package provides one entry point, compare-windows. It compares | |
27 | ;; text starting from point in two adjacent windows, advancing point | |
28 | ;; until it finds a difference. Option variables permit you to ignore | |
29 | ;; whitespace differences, or case differences, or both. | |
30 | ||
e5167999 ER |
31 | ;;; Code: |
32 | ||
84d6b04b | 33 | (defgroup compare-windows nil |
4bef9110 SE |
34 | "Compare text between windows." |
35 | :prefix "compare-" | |
36 | :group 'tools) | |
37 | ||
76960e50 | 38 | (defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+" |
9201cc28 | 39 | "Regexp or function that defines whitespace sequences for `compare-windows'. |
76960e50 | 40 | That command optionally ignores changes in whitespace. |
745bc783 | 41 | |
76960e50 RS |
42 | The value of `compare-windows-whitespace' is normally a regexp, but it |
43 | can also be a function. The function's job is to categorize any | |
44 | whitespace around (including before) point; it should also advance | |
6166a68e | 45 | past any whitespace. The function is called in each window, with |
76960e50 | 46 | point at the current scanning point. It gets one argument, the point |
6166a68e | 47 | where \\[compare-windows] was originally called; it should not look at |
76960e50 | 48 | any text before that point. |
745bc783 | 49 | |
6166a68e | 50 | If the function returns the same value for both windows, then the |
4bef9110 SE |
51 | whitespace is considered to match, and is skipped." |
52 | :type '(choice regexp function) | |
84d6b04b | 53 | :group 'compare-windows) |
745bc783 | 54 | |
6166a68e | 55 | (defcustom compare-ignore-whitespace nil |
9201cc28 | 56 | "Non-nil means `compare-windows' ignores whitespace." |
6166a68e | 57 | :type 'boolean |
84d6b04b | 58 | :group 'compare-windows |
1dbe7fe7 | 59 | :version "22.1") |
6166a68e | 60 | |
4bef9110 | 61 | (defcustom compare-ignore-case nil |
9201cc28 | 62 | "Non-nil means `compare-windows' ignores case differences." |
6166a68e | 63 | :type 'boolean |
84d6b04b | 64 | :group 'compare-windows) |
6166a68e RS |
65 | |
66 | (defcustom compare-windows-sync 'compare-windows-sync-default-function | |
9201cc28 | 67 | "Function or regexp that is used to synchronize points in two |
6166a68e RS |
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 | ||
84d6b04b JL |
88 | If the value of this variable is `nil' (option \"No sync\"), then |
89 | no synchronization is performed, and the function `ding' is called | |
90 | to beep or flash the screen when points are mismatched." | |
91 | :type '(choice function regexp (const :tag "No sync" nil)) | |
92 | :group 'compare-windows | |
1dbe7fe7 | 93 | :version "22.1") |
6166a68e RS |
94 | |
95 | (defcustom compare-windows-sync-string-size 32 | |
9201cc28 | 96 | "Size of string from one window that is searched in second window. |
6166a68e RS |
97 | |
98 | Small number makes difference regions more fine-grained, but it | |
99 | may fail by finding the wrong match. The bigger number makes | |
100 | difference regions more coarse-grained. | |
101 | ||
102 | The default value 32 is good for the most cases." | |
103 | :type 'integer | |
84d6b04b | 104 | :group 'compare-windows |
1dbe7fe7 | 105 | :version "22.1") |
6166a68e RS |
106 | |
107 | (defcustom compare-windows-recenter nil | |
9201cc28 | 108 | "List of two values, each of which is used as argument of |
6166a68e RS |
109 | function `recenter' called in each of two windows to place |
110 | matching points side-by-side. | |
111 | ||
112 | The value `(-1 0)' is useful if windows are split vertically, | |
113 | and the value `((4) (4))' for horizontally split windows." | |
114 | :type '(list sexp sexp) | |
84d6b04b | 115 | :group 'compare-windows |
1dbe7fe7 | 116 | :version "22.1") |
6166a68e RS |
117 | |
118 | (defcustom compare-windows-highlight t | |
9201cc28 | 119 | "Non-nil means compare-windows highlights the differences. |
9b0f7f31 JL |
120 | The value t removes highlighting immediately after invoking a command |
121 | other than `compare-windows'. | |
122 | The value `persistent' leaves all highlighted differences. You can clear | |
123 | out all highlighting later with the command `compare-windows-dehighlight'." | |
124 | :type '(choice (const :tag "No highlighting" nil) | |
125 | (const :tag "Persistent highlighting" persistent) | |
126 | (other :tag "Highlight until next command" t)) | |
84d6b04b | 127 | :group 'compare-windows |
1dbe7fe7 | 128 | :version "22.1") |
745bc783 | 129 | |
37af2dd3 | 130 | (defface compare-windows |
1dbe7fe7 | 131 | '((t :inherit lazy-highlight)) |
6166a68e | 132 | "Face for highlighting of compare-windows difference regions." |
84d6b04b | 133 | :group 'compare-windows |
1dbe7fe7 | 134 | :version "22.1") |
6166a68e RS |
135 | |
136 | (defvar compare-windows-overlay1 nil) | |
137 | (defvar compare-windows-overlay2 nil) | |
9b0f7f31 JL |
138 | (defvar compare-windows-overlays1 nil) |
139 | (defvar compare-windows-overlays2 nil) | |
6166a68e RS |
140 | (defvar compare-windows-sync-point nil) |
141 | ||
745bc783 JB |
142 | ;;;###autoload |
143 | (defun compare-windows (ignore-whitespace) | |
144 | "Compare text in current window with text in next window. | |
145 | Compares the text starting at point in each window, | |
146 | moving over text in each one as far as they match. | |
147 | ||
82734236 RS |
148 | This command pushes the mark in each window |
149 | at the prior location of point in that window. | |
150 | If both windows display the same buffer, | |
151 | the mark is pushed twice in that buffer: | |
152 | first in the other window, then in the selected window. | |
153 | ||
6166a68e RS |
154 | A prefix arg means reverse the value of variable |
155 | `compare-ignore-whitespace'. If `compare-ignore-whitespace' is | |
156 | nil, then a prefix arg means ignore changes in whitespace. If | |
157 | `compare-ignore-whitespace' is non-nil, then a prefix arg means | |
158 | don't ignore changes in whitespace. The variable | |
159 | `compare-windows-whitespace' controls how whitespace is skipped. | |
160 | If `compare-ignore-case' is non-nil, changes in case are also | |
161 | ignored. | |
162 | ||
163 | If `compare-windows-sync' is non-nil, then successive calls of | |
164 | this command work in interlaced mode: | |
165 | on first call it advances points to the next difference, | |
166 | on second call it synchronizes points by skipping the difference, | |
167 | on third call it again advances points to the next difference and so on." | |
745bc783 | 168 | (interactive "P") |
27f9dfbf RS |
169 | (if compare-ignore-whitespace |
170 | (setq ignore-whitespace (not ignore-whitespace))) | |
745bc783 | 171 | (let* (p1 p2 maxp1 maxp2 b1 b2 w2 |
8c9dbabe | 172 | (progress 1) |
745bc783 JB |
173 | (opoint1 (point)) |
174 | opoint2 | |
27f9dfbf RS |
175 | skip-func-1 |
176 | skip-func-2 | |
6166a68e RS |
177 | (sync-func (if (stringp compare-windows-sync) |
178 | 'compare-windows-sync-regexp | |
179 | compare-windows-sync))) | |
745bc783 | 180 | (setq p1 (point) b1 (current-buffer)) |
0846761d AS |
181 | (setq w2 (next-window (selected-window))) |
182 | (if (eq w2 (selected-window)) | |
183 | (setq w2 (next-window (selected-window) nil 'visible))) | |
745bc783 JB |
184 | (if (eq w2 (selected-window)) |
185 | (error "No other window")) | |
186 | (setq p2 (window-point w2) | |
187 | b2 (window-buffer w2)) | |
188 | (setq opoint2 p2) | |
189 | (setq maxp1 (point-max)) | |
27f9dfbf RS |
190 | |
191 | (setq skip-func-1 (if ignore-whitespace | |
192 | (if (stringp compare-windows-whitespace) | |
fb5422b2 RS |
193 | (lambda (pos) |
194 | (compare-windows-skip-whitespace pos) | |
27f9dfbf RS |
195 | t) |
196 | compare-windows-whitespace))) | |
197 | ||
198 | (with-current-buffer b2 | |
199 | (setq skip-func-2 (if ignore-whitespace | |
200 | (if (stringp compare-windows-whitespace) | |
fb5422b2 RS |
201 | (lambda (pos) |
202 | (compare-windows-skip-whitespace pos) | |
27f9dfbf RS |
203 | t) |
204 | compare-windows-whitespace))) | |
82734236 | 205 | (push-mark p2 t) |
745bc783 | 206 | (setq maxp2 (point-max))) |
82734236 | 207 | (push-mark) |
745bc783 | 208 | |
8c9dbabe | 209 | (while (> progress 0) |
6166a68e | 210 | ;; If both windows have whitespace next to point, |
745bc783 | 211 | ;; optionally skip over it. |
27f9dfbf | 212 | (and skip-func-1 |
745bc783 JB |
213 | (save-excursion |
214 | (let (p1a p2a w1 w2 result1 result2) | |
27f9dfbf | 215 | (setq result1 (funcall skip-func-1 opoint1)) |
048ab7d3 | 216 | (setq p1a (point)) |
745bc783 JB |
217 | (set-buffer b2) |
218 | (goto-char p2) | |
27f9dfbf | 219 | (setq result2 (funcall skip-func-2 opoint2)) |
048ab7d3 | 220 | (setq p2a (point)) |
27f9dfbf | 221 | (if (and result1 result2 (eq result1 result2)) |
5a534851 RS |
222 | (setq p1 p1a |
223 | p2 p2a))))) | |
745bc783 | 224 | |
8c9dbabe | 225 | (let ((size (min (- maxp1 p1) (- maxp2 p2))) |
d76bfaa2 | 226 | (case-fold-search compare-ignore-case)) |
8c9dbabe KH |
227 | (setq progress (compare-buffer-substrings b2 p2 (+ size p2) |
228 | b1 p1 (+ size p1))) | |
229 | (setq progress (if (zerop progress) size (1- (abs progress)))) | |
230 | (setq p1 (+ p1 progress) p2 (+ p2 progress))) | |
231 | ;; Advance point now rather than later, in case we're interrupted. | |
232 | (goto-char p1) | |
6166a68e RS |
233 | (set-window-point w2 p2) |
234 | (when compare-windows-recenter | |
235 | (recenter (car compare-windows-recenter)) | |
236 | (with-selected-window w2 (recenter (cadr compare-windows-recenter))))) | |
8c9dbabe | 237 | |
745bc783 | 238 | (if (= (point) opoint1) |
6166a68e RS |
239 | (if (not sync-func) |
240 | (ding) | |
241 | ;; If points are not advanced (i.e. already on mismatch position), | |
242 | ;; then synchronize points between both windows | |
243 | (save-excursion | |
244 | (setq compare-windows-sync-point nil) | |
245 | (funcall sync-func) | |
246 | (setq p1 (point)) | |
247 | (set-buffer b2) | |
248 | (goto-char p2) | |
249 | (funcall sync-func) | |
250 | (setq p2 (point))) | |
251 | (goto-char p1) | |
252 | (set-window-point w2 p2) | |
253 | (when compare-windows-recenter | |
254 | (recenter (car compare-windows-recenter)) | |
255 | (with-selected-window w2 (recenter (cadr compare-windows-recenter)))) | |
256 | ;; If points are still not synchronized, then ding | |
257 | (when (and (= p1 opoint1) (= p2 opoint2)) | |
258 | ;; Display error message when current points in two windows | |
259 | ;; are unmatched and next matching points can't be found. | |
260 | (compare-windows-dehighlight) | |
261 | (ding) | |
262 | (message "No more matching points")))))) | |
49116ac0 | 263 | |
048ab7d3 RS |
264 | ;; Move forward over whatever might be called whitespace. |
265 | ;; compare-windows-whitespace is a regexp that matches whitespace. | |
266 | ;; Match it at various starting points before the original point | |
267 | ;; and find the latest point at which a match ends. | |
268 | ;; Don't try starting points before START, though. | |
269 | ;; Value is non-nil if whitespace is found. | |
7f5d3541 RS |
270 | ;; If there is whitespace before point, but none after, |
271 | ;; then return t, but don't advance point. | |
048ab7d3 RS |
272 | (defun compare-windows-skip-whitespace (start) |
273 | (let ((end (point)) | |
7f5d3541 | 274 | (beg (point)) |
048ab7d3 | 275 | (opoint (point))) |
5dd1ad8e | 276 | (while (or (and (looking-at compare-windows-whitespace) |
7f5d3541 RS |
277 | (<= end (match-end 0)) |
278 | ;; This match goes past END, so advance END. | |
279 | (progn (setq end (match-end 0)) | |
5dd1ad8e RS |
280 | (> (point) start))) |
281 | (and (/= (point) start) | |
282 | ;; Consider at least the char before point, | |
283 | ;; unless it is also before START. | |
284 | (= (point) opoint))) | |
048ab7d3 RS |
285 | ;; keep going back until whitespace |
286 | ;; doesn't extend to or past end | |
287 | (forward-char -1)) | |
7f5d3541 | 288 | (setq beg (point)) |
048ab7d3 | 289 | (goto-char end) |
7f5d3541 RS |
290 | (or (/= beg opoint) |
291 | (/= end opoint)))) | |
048ab7d3 | 292 | |
6166a68e RS |
293 | ;; Move forward to the next synchronization regexp. |
294 | (defun compare-windows-sync-regexp () | |
295 | (if (stringp compare-windows-sync) | |
296 | (re-search-forward compare-windows-sync nil t))) | |
297 | ||
298 | ;; Function works in two passes: one call on each window. | |
299 | ;; On the first call both matching points are computed, | |
300 | ;; and one of them is stored in compare-windows-sync-point | |
301 | ;; to be used when this function is called on second window. | |
302 | (defun compare-windows-sync-default-function () | |
303 | (if (not compare-windows-sync-point) | |
efbbac29 JL |
304 | (let* ((w1 (selected-window)) |
305 | (w2 (next-window w1)) | |
6166a68e RS |
306 | (b2 (window-buffer w2)) |
307 | (point-max2 (with-current-buffer b2 (point-max))) | |
308 | (op2 (window-point w2)) | |
309 | (op1 (point)) | |
310 | (region-size compare-windows-sync-string-size) | |
311 | (string-size compare-windows-sync-string-size) | |
312 | in-bounds-p s1 p2 p12s p12) | |
313 | (while (and | |
314 | ;; until matching points are found | |
315 | (not p12s) | |
316 | ;; until size exceeds the maximum points of both buffers | |
317 | ;; (bounds below take care to not overdo in each of them) | |
318 | (or (setq in-bounds-p (< region-size (max (- (point-max) op1) | |
319 | (- point-max2 op2)))) | |
320 | ;; until string size becomes smaller than 4 | |
321 | (> string-size 4))) | |
322 | (if in-bounds-p | |
323 | ;; make the next search in the double-sized region; | |
324 | ;; on first iteration it is 2*compare-windows-sync-string-size, | |
325 | ;; on last iterations it exceeds both buffers maximum points | |
326 | (setq region-size (* region-size 2)) | |
327 | ;; if region size exceeds the maximum points of both buffers, | |
328 | ;; then start to halve the string size until 4; | |
329 | ;; this helps to find differences near the end of buffers | |
330 | (setq string-size (/ string-size 2))) | |
331 | (let ((p1 op1) | |
332 | (bound1 (- (min (+ op1 region-size) (point-max)) string-size)) | |
333 | (bound2 (min (+ op2 region-size) point-max2))) | |
334 | (while (< p1 bound1) | |
335 | (setq s1 (buffer-substring-no-properties p1 (+ p1 string-size))) | |
336 | (setq p2 (with-current-buffer b2 | |
337 | (goto-char op2) | |
338 | (let ((case-fold-search compare-ignore-case)) | |
339 | (search-forward s1 bound2 t)))) | |
340 | (when p2 | |
341 | (setq p2 (- p2 string-size)) | |
342 | (setq p12s (cons (list (+ p1 p2) p1 p2) p12s))) | |
343 | (setq p1 (1+ p1))))) | |
344 | (when p12s | |
345 | ;; use closest matching points (i.e. points with minimal sum) | |
346 | (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s))) | |
347 | (goto-char (car p12)) | |
efbbac29 JL |
348 | (compare-windows-highlight op1 (car p12) (current-buffer) w1 |
349 | op2 (cadr p12) b2 w2)) | |
6166a68e RS |
350 | (setq compare-windows-sync-point (or (cadr p12) t))) |
351 | ;; else set point in the second window to the pre-calculated value | |
352 | (if (numberp compare-windows-sync-point) | |
353 | (goto-char compare-windows-sync-point)) | |
354 | (setq compare-windows-sync-point nil))) | |
355 | ||
356 | ;; Highlight differences | |
efbbac29 | 357 | (defun compare-windows-highlight (beg1 end1 b1 w1 beg2 end2 b2 w2) |
6166a68e RS |
358 | (when compare-windows-highlight |
359 | (if compare-windows-overlay1 | |
efbbac29 JL |
360 | (move-overlay compare-windows-overlay1 beg1 end1 b1) |
361 | (setq compare-windows-overlay1 (make-overlay beg1 end1 b1)) | |
37af2dd3 | 362 | (overlay-put compare-windows-overlay1 'face 'compare-windows) |
67019e7f | 363 | (overlay-put compare-windows-overlay1 'priority 1000)) |
efbbac29 | 364 | (overlay-put compare-windows-overlay1 'window w1) |
6166a68e | 365 | (if compare-windows-overlay2 |
efbbac29 JL |
366 | (move-overlay compare-windows-overlay2 beg2 end2 b2) |
367 | (setq compare-windows-overlay2 (make-overlay beg2 end2 b2)) | |
37af2dd3 | 368 | (overlay-put compare-windows-overlay2 'face 'compare-windows) |
67019e7f | 369 | (overlay-put compare-windows-overlay2 'priority 1000)) |
efbbac29 | 370 | (overlay-put compare-windows-overlay2 'window w2) |
9b0f7f31 JL |
371 | (if (not (eq compare-windows-highlight 'persistent)) |
372 | ;; Remove highlighting before next command is executed | |
373 | (add-hook 'pre-command-hook 'compare-windows-dehighlight) | |
374 | (when compare-windows-overlay1 | |
375 | (push (copy-overlay compare-windows-overlay1) compare-windows-overlays1) | |
376 | (delete-overlay compare-windows-overlay1)) | |
377 | (when compare-windows-overlay2 | |
378 | (push (copy-overlay compare-windows-overlay2) compare-windows-overlays2) | |
379 | (delete-overlay compare-windows-overlay2))))) | |
6166a68e RS |
380 | |
381 | (defun compare-windows-dehighlight () | |
382 | "Remove highlighting created by `compare-windows-highlight'." | |
383 | (interactive) | |
384 | (remove-hook 'pre-command-hook 'compare-windows-dehighlight) | |
9b0f7f31 JL |
385 | (mapc 'delete-overlay compare-windows-overlays1) |
386 | (mapc 'delete-overlay compare-windows-overlays2) | |
6166a68e RS |
387 | (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1)) |
388 | (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2))) | |
389 | ||
49116ac0 JB |
390 | (provide 'compare-w) |
391 | ||
cbee283d | 392 | ;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46 |
c0274f38 | 393 | ;;; compare-w.el ends here |