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