Commit | Line | Data |
---|---|---|
55535639 | 1 | ;;; compare-w.el --- compare text between windows for Emacs |
c0274f38 | 2 | |
0d30b337 | 3 | ;; Copyright (C) 1986, 1989, 1993, 1997, 2002, 2003, 2004, |
aaef169d | 4 | ;; 2005, 2006 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 | |
e5167999 | 13 | ;; the Free Software Foundation; either version 2, 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 | ||
4bef9110 SE |
35 | (defgroup compare-w nil |
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) | |
55 | :group 'compare-w) | |
745bc783 | 56 | |
6166a68e RS |
57 | (defcustom compare-ignore-whitespace nil |
58 | "*Non-nil means `compare-windows' ignores whitespace." | |
59 | :type 'boolean | |
1dbe7fe7 JL |
60 | :group 'compare-w |
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 | |
66 | :group 'compare-w) | |
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 | ||
90 | If the value of this variable is `nil', then function `ding' is | |
91 | called to beep or flash the screen when points are mismatched." | |
92 | :type '(choice regexp function) | |
1dbe7fe7 JL |
93 | :group 'compare-w |
94 | :version "22.1") | |
6166a68e RS |
95 | |
96 | (defcustom compare-windows-sync-string-size 32 | |
97 | "*Size of string from one window that is searched in second window. | |
98 | ||
99 | Small number makes difference regions more fine-grained, but it | |
100 | may fail by finding the wrong match. The bigger number makes | |
101 | difference regions more coarse-grained. | |
102 | ||
103 | The default value 32 is good for the most cases." | |
104 | :type 'integer | |
1dbe7fe7 JL |
105 | :group 'compare-w |
106 | :version "22.1") | |
6166a68e RS |
107 | |
108 | (defcustom compare-windows-recenter nil | |
109 | "*List of two values, each of which is used as argument of | |
110 | function `recenter' called in each of two windows to place | |
111 | matching points side-by-side. | |
112 | ||
113 | The value `(-1 0)' is useful if windows are split vertically, | |
114 | and the value `((4) (4))' for horizontally split windows." | |
115 | :type '(list sexp sexp) | |
1dbe7fe7 JL |
116 | :group 'compare-w |
117 | :version "22.1") | |
6166a68e RS |
118 | |
119 | (defcustom compare-windows-highlight t | |
120 | "*Non-nil means compare-windows highlights the differences." | |
4bef9110 | 121 | :type 'boolean |
1dbe7fe7 JL |
122 | :group 'compare-w |
123 | :version "22.1") | |
745bc783 | 124 | |
37af2dd3 | 125 | (defface compare-windows |
1dbe7fe7 | 126 | '((t :inherit lazy-highlight)) |
6166a68e | 127 | "Face for highlighting of compare-windows difference regions." |
1dbe7fe7 JL |
128 | :group 'compare-w |
129 | :version "22.1") | |
6166a68e RS |
130 | |
131 | (defvar compare-windows-overlay1 nil) | |
132 | (defvar compare-windows-overlay2 nil) | |
133 | (defvar compare-windows-sync-point nil) | |
134 | ||
745bc783 JB |
135 | ;;;###autoload |
136 | (defun compare-windows (ignore-whitespace) | |
137 | "Compare text in current window with text in next window. | |
138 | Compares the text starting at point in each window, | |
139 | moving over text in each one as far as they match. | |
140 | ||
82734236 RS |
141 | This command pushes the mark in each window |
142 | at the prior location of point in that window. | |
143 | If both windows display the same buffer, | |
144 | the mark is pushed twice in that buffer: | |
145 | first in the other window, then in the selected window. | |
146 | ||
6166a68e RS |
147 | A prefix arg means reverse the value of variable |
148 | `compare-ignore-whitespace'. If `compare-ignore-whitespace' is | |
149 | nil, then a prefix arg means ignore changes in whitespace. If | |
150 | `compare-ignore-whitespace' is non-nil, then a prefix arg means | |
151 | don't ignore changes in whitespace. The variable | |
152 | `compare-windows-whitespace' controls how whitespace is skipped. | |
153 | If `compare-ignore-case' is non-nil, changes in case are also | |
154 | ignored. | |
155 | ||
156 | If `compare-windows-sync' is non-nil, then successive calls of | |
157 | this command work in interlaced mode: | |
158 | on first call it advances points to the next difference, | |
159 | on second call it synchronizes points by skipping the difference, | |
160 | on third call it again advances points to the next difference and so on." | |
745bc783 JB |
161 | (interactive "P") |
162 | (let* (p1 p2 maxp1 maxp2 b1 b2 w2 | |
8c9dbabe | 163 | (progress 1) |
745bc783 JB |
164 | (opoint1 (point)) |
165 | opoint2 | |
6166a68e RS |
166 | (skip-func (if (if ignore-whitespace ; XOR |
167 | (not compare-ignore-whitespace) | |
168 | compare-ignore-whitespace) | |
169 | (if (stringp compare-windows-whitespace) | |
170 | 'compare-windows-skip-whitespace | |
171 | compare-windows-whitespace))) | |
172 | (sync-func (if (stringp compare-windows-sync) | |
173 | 'compare-windows-sync-regexp | |
174 | compare-windows-sync))) | |
745bc783 | 175 | (setq p1 (point) b1 (current-buffer)) |
0846761d AS |
176 | (setq w2 (next-window (selected-window))) |
177 | (if (eq w2 (selected-window)) | |
178 | (setq w2 (next-window (selected-window) nil 'visible))) | |
745bc783 JB |
179 | (if (eq w2 (selected-window)) |
180 | (error "No other window")) | |
181 | (setq p2 (window-point w2) | |
182 | b2 (window-buffer w2)) | |
183 | (setq opoint2 p2) | |
184 | (setq maxp1 (point-max)) | |
185 | (save-excursion | |
186 | (set-buffer b2) | |
82734236 | 187 | (push-mark p2 t) |
745bc783 | 188 | (setq maxp2 (point-max))) |
82734236 | 189 | (push-mark) |
745bc783 | 190 | |
8c9dbabe | 191 | (while (> progress 0) |
6166a68e | 192 | ;; If both windows have whitespace next to point, |
745bc783 | 193 | ;; optionally skip over it. |
8c9dbabe | 194 | (and skip-func |
745bc783 JB |
195 | (save-excursion |
196 | (let (p1a p2a w1 w2 result1 result2) | |
8c9dbabe | 197 | (setq result1 (funcall skip-func opoint1)) |
048ab7d3 | 198 | (setq p1a (point)) |
745bc783 JB |
199 | (set-buffer b2) |
200 | (goto-char p2) | |
8c9dbabe | 201 | (setq result2 (funcall skip-func opoint2)) |
048ab7d3 | 202 | (setq p2a (point)) |
5ff083af | 203 | (if (or (stringp compare-windows-whitespace) |
5a534851 RS |
204 | (and result1 result2 (eq result1 result2))) |
205 | (setq p1 p1a | |
206 | p2 p2a))))) | |
745bc783 | 207 | |
8c9dbabe | 208 | (let ((size (min (- maxp1 p1) (- maxp2 p2))) |
d76bfaa2 | 209 | (case-fold-search compare-ignore-case)) |
8c9dbabe KH |
210 | (setq progress (compare-buffer-substrings b2 p2 (+ size p2) |
211 | b1 p1 (+ size p1))) | |
212 | (setq progress (if (zerop progress) size (1- (abs progress)))) | |
213 | (setq p1 (+ p1 progress) p2 (+ p2 progress))) | |
214 | ;; Advance point now rather than later, in case we're interrupted. | |
215 | (goto-char p1) | |
6166a68e RS |
216 | (set-window-point w2 p2) |
217 | (when compare-windows-recenter | |
218 | (recenter (car compare-windows-recenter)) | |
219 | (with-selected-window w2 (recenter (cadr compare-windows-recenter))))) | |
8c9dbabe | 220 | |
745bc783 | 221 | (if (= (point) opoint1) |
6166a68e RS |
222 | (if (not sync-func) |
223 | (ding) | |
224 | ;; If points are not advanced (i.e. already on mismatch position), | |
225 | ;; then synchronize points between both windows | |
226 | (save-excursion | |
227 | (setq compare-windows-sync-point nil) | |
228 | (funcall sync-func) | |
229 | (setq p1 (point)) | |
230 | (set-buffer b2) | |
231 | (goto-char p2) | |
232 | (funcall sync-func) | |
233 | (setq p2 (point))) | |
234 | (goto-char p1) | |
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)))) | |
239 | ;; If points are still not synchronized, then ding | |
240 | (when (and (= p1 opoint1) (= p2 opoint2)) | |
241 | ;; Display error message when current points in two windows | |
242 | ;; are unmatched and next matching points can't be found. | |
243 | (compare-windows-dehighlight) | |
244 | (ding) | |
245 | (message "No more matching points")))))) | |
49116ac0 | 246 | |
048ab7d3 RS |
247 | ;; Move forward over whatever might be called whitespace. |
248 | ;; compare-windows-whitespace is a regexp that matches whitespace. | |
249 | ;; Match it at various starting points before the original point | |
250 | ;; and find the latest point at which a match ends. | |
251 | ;; Don't try starting points before START, though. | |
252 | ;; Value is non-nil if whitespace is found. | |
7f5d3541 RS |
253 | ;; If there is whitespace before point, but none after, |
254 | ;; then return t, but don't advance point. | |
048ab7d3 RS |
255 | (defun compare-windows-skip-whitespace (start) |
256 | (let ((end (point)) | |
7f5d3541 | 257 | (beg (point)) |
048ab7d3 | 258 | (opoint (point))) |
5dd1ad8e | 259 | (while (or (and (looking-at compare-windows-whitespace) |
7f5d3541 RS |
260 | (<= end (match-end 0)) |
261 | ;; This match goes past END, so advance END. | |
262 | (progn (setq end (match-end 0)) | |
5dd1ad8e RS |
263 | (> (point) start))) |
264 | (and (/= (point) start) | |
265 | ;; Consider at least the char before point, | |
266 | ;; unless it is also before START. | |
267 | (= (point) opoint))) | |
048ab7d3 RS |
268 | ;; keep going back until whitespace |
269 | ;; doesn't extend to or past end | |
270 | (forward-char -1)) | |
7f5d3541 | 271 | (setq beg (point)) |
048ab7d3 | 272 | (goto-char end) |
7f5d3541 RS |
273 | (or (/= beg opoint) |
274 | (/= end opoint)))) | |
048ab7d3 | 275 | |
6166a68e RS |
276 | ;; Move forward to the next synchronization regexp. |
277 | (defun compare-windows-sync-regexp () | |
278 | (if (stringp compare-windows-sync) | |
279 | (re-search-forward compare-windows-sync nil t))) | |
280 | ||
281 | ;; Function works in two passes: one call on each window. | |
282 | ;; On the first call both matching points are computed, | |
283 | ;; and one of them is stored in compare-windows-sync-point | |
284 | ;; to be used when this function is called on second window. | |
285 | (defun compare-windows-sync-default-function () | |
286 | (if (not compare-windows-sync-point) | |
efbbac29 JL |
287 | (let* ((w1 (selected-window)) |
288 | (w2 (next-window w1)) | |
6166a68e RS |
289 | (b2 (window-buffer w2)) |
290 | (point-max2 (with-current-buffer b2 (point-max))) | |
291 | (op2 (window-point w2)) | |
292 | (op1 (point)) | |
293 | (region-size compare-windows-sync-string-size) | |
294 | (string-size compare-windows-sync-string-size) | |
295 | in-bounds-p s1 p2 p12s p12) | |
296 | (while (and | |
297 | ;; until matching points are found | |
298 | (not p12s) | |
299 | ;; until size exceeds the maximum points of both buffers | |
300 | ;; (bounds below take care to not overdo in each of them) | |
301 | (or (setq in-bounds-p (< region-size (max (- (point-max) op1) | |
302 | (- point-max2 op2)))) | |
303 | ;; until string size becomes smaller than 4 | |
304 | (> string-size 4))) | |
305 | (if in-bounds-p | |
306 | ;; make the next search in the double-sized region; | |
307 | ;; on first iteration it is 2*compare-windows-sync-string-size, | |
308 | ;; on last iterations it exceeds both buffers maximum points | |
309 | (setq region-size (* region-size 2)) | |
310 | ;; if region size exceeds the maximum points of both buffers, | |
311 | ;; then start to halve the string size until 4; | |
312 | ;; this helps to find differences near the end of buffers | |
313 | (setq string-size (/ string-size 2))) | |
314 | (let ((p1 op1) | |
315 | (bound1 (- (min (+ op1 region-size) (point-max)) string-size)) | |
316 | (bound2 (min (+ op2 region-size) point-max2))) | |
317 | (while (< p1 bound1) | |
318 | (setq s1 (buffer-substring-no-properties p1 (+ p1 string-size))) | |
319 | (setq p2 (with-current-buffer b2 | |
320 | (goto-char op2) | |
321 | (let ((case-fold-search compare-ignore-case)) | |
322 | (search-forward s1 bound2 t)))) | |
323 | (when p2 | |
324 | (setq p2 (- p2 string-size)) | |
325 | (setq p12s (cons (list (+ p1 p2) p1 p2) p12s))) | |
326 | (setq p1 (1+ p1))))) | |
327 | (when p12s | |
328 | ;; use closest matching points (i.e. points with minimal sum) | |
329 | (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s))) | |
330 | (goto-char (car p12)) | |
efbbac29 JL |
331 | (compare-windows-highlight op1 (car p12) (current-buffer) w1 |
332 | op2 (cadr p12) b2 w2)) | |
6166a68e RS |
333 | (setq compare-windows-sync-point (or (cadr p12) t))) |
334 | ;; else set point in the second window to the pre-calculated value | |
335 | (if (numberp compare-windows-sync-point) | |
336 | (goto-char compare-windows-sync-point)) | |
337 | (setq compare-windows-sync-point nil))) | |
338 | ||
339 | ;; Highlight differences | |
efbbac29 | 340 | (defun compare-windows-highlight (beg1 end1 b1 w1 beg2 end2 b2 w2) |
6166a68e RS |
341 | (when compare-windows-highlight |
342 | (if compare-windows-overlay1 | |
efbbac29 JL |
343 | (move-overlay compare-windows-overlay1 beg1 end1 b1) |
344 | (setq compare-windows-overlay1 (make-overlay beg1 end1 b1)) | |
37af2dd3 | 345 | (overlay-put compare-windows-overlay1 'face 'compare-windows) |
67019e7f | 346 | (overlay-put compare-windows-overlay1 'priority 1000)) |
efbbac29 | 347 | (overlay-put compare-windows-overlay1 'window w1) |
6166a68e | 348 | (if compare-windows-overlay2 |
efbbac29 JL |
349 | (move-overlay compare-windows-overlay2 beg2 end2 b2) |
350 | (setq compare-windows-overlay2 (make-overlay beg2 end2 b2)) | |
37af2dd3 | 351 | (overlay-put compare-windows-overlay2 'face 'compare-windows) |
67019e7f | 352 | (overlay-put compare-windows-overlay2 'priority 1000)) |
efbbac29 | 353 | (overlay-put compare-windows-overlay2 'window w2) |
6166a68e RS |
354 | ;; Remove highlighting before next command is executed |
355 | (add-hook 'pre-command-hook 'compare-windows-dehighlight))) | |
356 | ||
357 | (defun compare-windows-dehighlight () | |
358 | "Remove highlighting created by `compare-windows-highlight'." | |
359 | (interactive) | |
360 | (remove-hook 'pre-command-hook 'compare-windows-dehighlight) | |
361 | (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1)) | |
362 | (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2))) | |
363 | ||
49116ac0 JB |
364 | (provide 'compare-w) |
365 | ||
ab5796a9 | 366 | ;;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46 |
c0274f38 | 367 | ;;; compare-w.el ends here |