/[emacs]/emacs/lisp/compare-w.el
ViewVC logotype

Diff of /emacs/lisp/compare-w.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.23 by miles, Mon Sep 1 15:45:09 2003 UTC revision 1.24 by rms, Mon Oct 20 23:31:51 2003 UTC
# Line 1  Line 1 
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
# Line 37  Line 37 
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.
# Line 70  If both windows display the same buffer, Line 143  If both windows display the same buffer,
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))
# Line 99  If `compare-ignore-case' is non-nil, cha Line 188  If `compare-ignore-case' is non-nil, cha
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)
# Line 124  If `compare-ignore-case' is non-nil, cha Line 212  If `compare-ignore-case' is non-nil, cha
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.
# Line 135  If `compare-ignore-case' is non-nil, cha Line 249  If `compare-ignore-case' is non-nil, cha
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)
# Line 159  If `compare-ignore-case' is non-nil, cha Line 272  If `compare-ignore-case' is non-nil, cha
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

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26