[bpt/emacs.git] / lisp / compare-w.el

;;; compare-w.el --- compare text between windows for Emacs

;; Copyright (C) 1986, 1989, 1993, 1997, 2003 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: convenience files

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This package provides one entry point, compare-windows.  It compares
;; text starting from point in two adjacent windows, advancing point
;; until it finds a difference.  Option variables permit you to ignore
;; whitespace differences, or case differences, or both.

;;; Code:

(defgroup compare-w nil
  "Compare text between windows."
  :prefix "compare-"
  :group 'tools)

(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+"
  "*Regexp or function that defines whitespace sequences for `compare-windows'.
That command optionally ignores changes in whitespace.

The value of `compare-windows-whitespace' is normally a regexp, but it
can also be a function.  The function's job is to categorize any
whitespace around (including before) point; it should also advance
past any whitespace.  The function is called in each window, with
point at the current scanning point.  It gets one argument, the point
where \\[compare-windows] was originally called; it should not look at
any text before that point.

If the function returns the same value for both windows, then the
whitespace is considered to match, and is skipped."
  :type '(choice regexp function)
  :group 'compare-w)

(defcustom compare-ignore-whitespace nil
  "*Non-nil means `compare-windows' ignores whitespace."
  :type 'boolean
  :group 'compare-w)

(defcustom compare-ignore-case nil
  "*Non-nil means `compare-windows' ignores case differences."
  :type 'boolean
  :group 'compare-w)

(defcustom compare-windows-sync 'compare-windows-sync-default-function
  "*Function or regexp that is used to synchronize points in two
windows if before calling `compare-windows' points are located
on mismatched positions.

The value of `compare-windows-sync' can be a function.  The
function's job is to advance points in both windows to the next
matching text.  If the value of `compare-windows-sync' is a
regexp, then points in both windows are advanced to the next
occurrence of this regexp.

The current default value is the general function
`compare-windows-sync-default-function' that is able to
synchronize points by using quadratic algorithm to find the first
matching 32-character string in two windows.

The other useful values of this variable could be such functions
as `forward-word', `forward-sentence', `forward-paragraph', or a
regexp containing some field separator or a newline, depending on
the nature of the difference units separator.  The variable can
be made buffer-local.

If the value of this variable is `nil', then function `ding' is
called to beep or flash the screen when points are mismatched."
  :type '(choice regexp function)
  :group 'compare-w)

(defcustom compare-windows-sync-string-size 32
  "*Size of string from one window that is searched in second window.

Small number makes difference regions more fine-grained, but it
may fail by finding the wrong match.  The bigger number makes
difference regions more coarse-grained.

The default value 32 is good for the most cases."
  :type 'integer
  :group 'compare-w)

(defcustom compare-windows-recenter nil
  "*List of two values, each of which is used as argument of
function `recenter' called in each of two windows to place
matching points side-by-side.

The value `(-1 0)' is useful if windows are split vertically,
and the value `((4) (4))' for horizontally split windows."
  :type '(list sexp sexp)
  :group 'compare-w)

(defcustom compare-windows-highlight t
  "*Non-nil means compare-windows highlights the differences."
  :type 'boolean
  :group 'compare-w)

(defface compare-windows-face
  '((((type tty pc) (class color))
     (:background "turquoise3"))
    (((class color) (background light))
     (:background "paleturquoise"))
    (((class color) (background dark))
     (:background "paleturquoise4"))
    (t (:underline t)))
  "Face for highlighting of compare-windows difference regions."
  :group 'compare-w)

(defvar compare-windows-overlay1 nil)
(defvar compare-windows-overlay2 nil)
(defvar compare-windows-sync-point nil)

;;;###autoload
(defun compare-windows (ignore-whitespace)
  "Compare text in current window with text in next window.
Compares the text starting at point in each window,
moving over text in each one as far as they match.

This command pushes the mark in each window
at the prior location of point in that window.
If both windows display the same buffer,
the mark is pushed twice in that buffer:
first in the other window, then in the selected window.

A prefix arg means reverse the value of variable
`compare-ignore-whitespace'.  If `compare-ignore-whitespace' is
nil, then a prefix arg means ignore changes in whitespace.  If
`compare-ignore-whitespace' is non-nil, then a prefix arg means
don't ignore changes in whitespace.  The variable
`compare-windows-whitespace' controls how whitespace is skipped.
If `compare-ignore-case' is non-nil, changes in case are also
ignored.

If `compare-windows-sync' is non-nil, then successive calls of
this command work in interlaced mode:
on first call it advances points to the next difference,
on second call it synchronizes points by skipping the difference,
on third call it again advances points to the next difference and so on."
  (interactive "P")
  (let* (p1 p2 maxp1 maxp2 b1 b2 w2
	    (progress 1)
	    (opoint1 (point))
	    opoint2
	    (skip-func (if (if ignore-whitespace ; XOR
                               (not compare-ignore-whitespace)
                             compare-ignore-whitespace)
                           (if (stringp compare-windows-whitespace)
                               'compare-windows-skip-whitespace
                             compare-windows-whitespace)))
	    (sync-func (if (stringp compare-windows-sync)
                           'compare-windows-sync-regexp
                         compare-windows-sync)))
    (setq p1 (point) b1 (current-buffer))
    (setq w2 (next-window (selected-window)))
    (if (eq w2 (selected-window))
	(setq w2 (next-window (selected-window) nil 'visible)))
    (if (eq w2 (selected-window))
	(error "No other window"))
    (setq p2 (window-point w2)
	  b2 (window-buffer w2))
    (setq opoint2 p2)
    (setq maxp1 (point-max))
    (save-excursion
      (set-buffer b2)
      (push-mark p2 t)
      (setq maxp2 (point-max)))
    (push-mark)

    (while (> progress 0)
      ;; If both windows have whitespace next to point,
      ;; optionally skip over it.
      (and skip-func
	   (save-excursion
	     (let (p1a p2a w1 w2 result1 result2)
	       (setq result1 (funcall skip-func opoint1))
	       (setq p1a (point))
	       (set-buffer b2)
	       (goto-char p2)
	       (setq result2 (funcall skip-func opoint2))
	       (setq p2a (point))
	       (if (or (stringp compare-windows-whitespace)
		       (and result1 result2 (eq result1 result2)))
		   (setq p1 p1a
			 p2 p2a)))))

      (let ((size (min (- maxp1 p1) (- maxp2 p2)))
	    (case-fold-search compare-ignore-case))
	(setq progress (compare-buffer-substrings b2 p2 (+ size p2)
						  b1 p1 (+ size p1)))
	(setq progress (if (zerop progress) size (1- (abs progress))))
	(setq p1 (+ p1 progress) p2 (+ p2 progress)))
      ;; Advance point now rather than later, in case we're interrupted.
      (goto-char p1)
      (set-window-point w2 p2)
      (when compare-windows-recenter
        (recenter (car compare-windows-recenter))
        (with-selected-window w2 (recenter (cadr compare-windows-recenter)))))

    (if (= (point) opoint1)
	(if (not sync-func)
            (ding)
          ;; If points are not advanced (i.e. already on mismatch position),
          ;; then synchronize points between both windows
          (save-excursion
            (setq compare-windows-sync-point nil)
            (funcall sync-func)
            (setq p1 (point))
            (set-buffer b2)
            (goto-char p2)
            (funcall sync-func)
            (setq p2 (point)))
          (goto-char p1)
          (set-window-point w2 p2)
          (when compare-windows-recenter
            (recenter (car compare-windows-recenter))
            (with-selected-window w2 (recenter (cadr compare-windows-recenter))))
          ;; If points are still not synchronized, then ding
          (when (and (= p1 opoint1) (= p2 opoint2))
            ;; Display error message when current points in two windows
            ;; are unmatched and next matching points can't be found.
            (compare-windows-dehighlight)
            (ding)
            (message "No more matching points"))))))

;; Move forward over whatever might be called whitespace.
;; compare-windows-whitespace is a regexp that matches whitespace.
;; Match it at various starting points before the original point
;; and find the latest point at which a match ends.
;; Don't try starting points before START, though.
;; Value is non-nil if whitespace is found.
;; If there is whitespace before point, but none after,
;; then return t, but don't advance point.
(defun compare-windows-skip-whitespace (start)
  (let ((end (point))
	(beg (point))
	(opoint (point)))
    (while (or (and (looking-at compare-windows-whitespace)
		    (<= end (match-end 0))
		    ;; This match goes past END, so advance END.
		    (progn (setq end (match-end 0))
			   (> (point) start)))
	       (and (/= (point) start)
		    ;; Consider at least the char before point,
		    ;; unless it is also before START.
		    (= (point) opoint)))
      ;; keep going back until whitespace
      ;; doesn't extend to or past end
      (forward-char -1))
    (setq beg (point))
    (goto-char end)
    (or (/= beg opoint)
	(/= end opoint))))

;; Move forward to the next synchronization regexp.
(defun compare-windows-sync-regexp ()
  (if (stringp compare-windows-sync)
      (re-search-forward compare-windows-sync nil t)))

;; Function works in two passes: one call on each window.
;; On the first call both matching points are computed,
;; and one of them is stored in compare-windows-sync-point
;; to be used when this function is called on second window.
(defun compare-windows-sync-default-function ()
  (if (not compare-windows-sync-point)
      (let* ((w2 (next-window (selected-window)))
             (b2 (window-buffer w2))
             (point-max2 (with-current-buffer b2 (point-max)))
             (op2 (window-point w2))
             (op1 (point))
             (region-size compare-windows-sync-string-size)
             (string-size compare-windows-sync-string-size)
             in-bounds-p s1 p2 p12s p12)
        (while (and
                ;; until matching points are found
                (not p12s)
                ;; until size exceeds the maximum points of both buffers
                ;; (bounds below take care to not overdo in each of them)
                (or (setq in-bounds-p (< region-size (max (- (point-max) op1)
                                                          (- point-max2 op2))))
                    ;; until string size becomes smaller than 4
                    (> string-size 4)))
          (if in-bounds-p
              ;; make the next search in the double-sized region;
              ;; on first iteration it is 2*compare-windows-sync-string-size,
              ;; on last iterations it exceeds both buffers maximum points
              (setq region-size (* region-size 2))
            ;; if region size exceeds the maximum points of both buffers,
            ;; then start to halve the string size until 4;
            ;; this helps to find differences near the end of buffers
            (setq string-size (/ string-size 2)))
          (let ((p1 op1)
                (bound1 (- (min (+ op1 region-size) (point-max)) string-size))
                (bound2 (min (+ op2 region-size) point-max2)))
            (while (< p1 bound1)
              (setq s1 (buffer-substring-no-properties p1 (+ p1 string-size)))
              (setq p2 (with-current-buffer b2
                         (goto-char op2)
                         (let ((case-fold-search compare-ignore-case))
                           (search-forward s1 bound2 t))))
              (when p2
                (setq p2 (- p2 string-size))
                (setq p12s (cons (list (+ p1 p2) p1 p2) p12s)))
              (setq p1 (1+ p1)))))
        (when p12s
          ;; use closest matching points (i.e. points with minimal sum)
          (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s)))
          (goto-char (car p12))
          (compare-windows-highlight op1 (car p12) op2 (cadr p12) b2))
        (setq compare-windows-sync-point (or (cadr p12) t)))
    ;; else set point in the second window to the pre-calculated value
    (if (numberp compare-windows-sync-point)
        (goto-char compare-windows-sync-point))
    (setq compare-windows-sync-point nil)))

;; Highlight differences
(defun compare-windows-highlight (beg1 end1 beg2 end2 buf2)
  (when compare-windows-highlight
    (if compare-windows-overlay1
        (move-overlay compare-windows-overlay1 beg1 end1 (current-buffer))
      (setq compare-windows-overlay1 (make-overlay beg1 end1 (current-buffer)))
      (overlay-put compare-windows-overlay1 'face 'compare-windows-face)
      (overlay-put compare-windows-overlay1 'priority 1))
    (if compare-windows-overlay2
        (move-overlay compare-windows-overlay2 beg2 end2 buf2)
      (setq compare-windows-overlay2 (make-overlay beg2 end2 buf2))
      (overlay-put compare-windows-overlay2 'face 'compare-windows-face)
      (overlay-put compare-windows-overlay2 'priority 1))
    ;; Remove highlighting before next command is executed
    (add-hook 'pre-command-hook 'compare-windows-dehighlight)))

(defun compare-windows-dehighlight ()
  "Remove highlighting created by `compare-windows-highlight'."
  (interactive)
  (remove-hook 'pre-command-hook 'compare-windows-dehighlight)
  (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1))
  (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2)))

(provide 'compare-w)

;;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46
;;; compare-w.el ends here
Commit	Line	Data
55535639	1	;;; compare-w.el --- compare text between windows for Emacs
c0274f38	2
6b61353c	3	;; Copyright (C) 1986, 1989, 1993, 1997, 2003 Free Software Foundation, Inc.
745bc783	4
9750e079	5	;; Maintainer: FSF
30764597	6	;; Keywords: convenience files
9750e079	7
745bc783 JB	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
e5167999	12	;; the Free Software Foundation; either version 2, or (at your option)
745bc783 JB	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
b578f267 EN	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
745bc783	24
e41b2db1 ER	25	;;; Commentary:
	26
	27	;; This package provides one entry point, compare-windows. It compares
	28	;; text starting from point in two adjacent windows, advancing point
	29	;; until it finds a difference. Option variables permit you to ignore
	30	;; whitespace differences, or case differences, or both.
	31
e5167999 ER	32	;;; Code:
e5167999 ER	33
4bef9110 SE	34	(defgroup compare-w nil
	35	"Compare text between windows."
	36	:prefix "compare-"
	37	:group 'tools)
	38
76960e50	39	(defcustom compare-windows-whitespace "\\(\\s-\\\|\n\\)+"
6b61353c	40	"*Regexp or function that defines whitespace sequences for `compare-windows'.
76960e50	41	That command optionally ignores changes in whitespace.
745bc783	42
76960e50 RS	43	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
	45	whitespace around (including before) point; it should also advance
6b61353c	46	past any whitespace. The function is called in each window, with
76960e50	47	point at the current scanning point. It gets one argument, the point
6b61353c	48	where \\[compare-windows] was originally called; it should not look at
76960e50	49	any text before that point.
745bc783	50
6b61353c	51	If the function returns the same value for both windows, then the
4bef9110 SE	52	whitespace is considered to match, and is skipped."
	53	:type '(choice regexp function)
	54	:group 'compare-w)
745bc783	55
6b61353c KH	56	(defcustom compare-ignore-whitespace nil
	57	"*Non-nil means `compare-windows' ignores whitespace."
	58	:type 'boolean
	59	:group 'compare-w)
	60
4bef9110	61	(defcustom compare-ignore-case nil
6b61353c KH	62	"*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."
4bef9110 SE	116	:type 'boolean
4bef9110 SE	117	:group 'compare-w)
745bc783	118
6b61353c KH	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
745bc783 JB	134	;;;###autoload
	135	(defun compare-windows (ignore-whitespace)
	136	"Compare text in current window with text in next window.
	137	Compares the text starting at point in each window,
	138	moving over text in each one as far as they match.
	139
82734236 RS	140	This command pushes the mark in each window
	141	at the prior location of point in that window.
	142	If both windows display the same buffer,
	143	the mark is pushed twice in that buffer:
	144	first in the other window, then in the selected window.
	145
6b61353c KH	146	A prefix arg means reverse the value of variable
	147	`compare-ignore-whitespace'. If `compare-ignore-whitespace' is
	148	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."
745bc783 JB	160	(interactive "P")
745bc783 JB	161	(let* (p1 p2 maxp1 maxp2 b1 b2 w2
8c9dbabe	162	(progress 1)
745bc783 JB	163	(opoint1 (point))
745bc783 JB	164	opoint2
6b61353c KH	165	(skip-func (if (if ignore-whitespace ; XOR
	166	(not compare-ignore-whitespace)
	167	compare-ignore-whitespace)
	168	(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)))
745bc783	174	(setq p1 (point) b1 (current-buffer))
0846761d AS	175	(setq w2 (next-window (selected-window)))
	176	(if (eq w2 (selected-window))
	177	(setq w2 (next-window (selected-window) nil 'visible)))
745bc783 JB	178	(if (eq w2 (selected-window))
	179	(error "No other window"))
	180	(setq p2 (window-point w2)
	181	b2 (window-buffer w2))
	182	(setq opoint2 p2)
	183	(setq maxp1 (point-max))
	184	(save-excursion
	185	(set-buffer b2)
82734236	186	(push-mark p2 t)
745bc783	187	(setq maxp2 (point-max)))
82734236	188	(push-mark)
745bc783	189
8c9dbabe	190	(while (> progress 0)
6b61353c	191	;; If both windows have whitespace next to point,
745bc783	192	;; optionally skip over it.
8c9dbabe	193	(and skip-func
745bc783 JB	194	(save-excursion
745bc783 JB	195	(let (p1a p2a w1 w2 result1 result2)
8c9dbabe	196	(setq result1 (funcall skip-func opoint1))
048ab7d3	197	(setq p1a (point))
745bc783 JB	198	(set-buffer b2)
745bc783 JB	199	(goto-char p2)
8c9dbabe	200	(setq result2 (funcall skip-func opoint2))
048ab7d3	201	(setq p2a (point))
5ff083af	202	(if (or (stringp compare-windows-whitespace)
5a534851 RS	203	(and result1 result2 (eq result1 result2)))
	204	(setq p1 p1a
	205	p2 p2a)))))
745bc783	206
8c9dbabe	207	(let ((size (min (- maxp1 p1) (- maxp2 p2)))
d76bfaa2	208	(case-fold-search compare-ignore-case))
8c9dbabe KH	209	(setq progress (compare-buffer-substrings b2 p2 (+ size p2)
	210	b1 p1 (+ size p1)))
	211	(setq progress (if (zerop progress) size (1- (abs progress))))
	212	(setq p1 (+ p1 progress) p2 (+ p2 progress)))
	213	;; Advance point now rather than later, in case we're interrupted.
	214	(goto-char p1)
6b61353c KH	215	(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)))))
8c9dbabe	219
745bc783	220	(if (= (point) opoint1)
6b61353c KH	221	(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"))))))
49116ac0	245
048ab7d3 RS	246	;; Move forward over whatever might be called whitespace.
	247	;; compare-windows-whitespace is a regexp that matches whitespace.
	248	;; Match it at various starting points before the original point
	249	;; and find the latest point at which a match ends.
	250	;; Don't try starting points before START, though.
	251	;; Value is non-nil if whitespace is found.
7f5d3541 RS	252	;; If there is whitespace before point, but none after,
7f5d3541 RS	253	;; then return t, but don't advance point.
048ab7d3 RS	254	(defun compare-windows-skip-whitespace (start)
048ab7d3 RS	255	(let ((end (point))
7f5d3541	256	(beg (point))
048ab7d3	257	(opoint (point)))
5dd1ad8e	258	(while (or (and (looking-at compare-windows-whitespace)
7f5d3541 RS	259	(<= end (match-end 0))
	260	;; This match goes past END, so advance END.
	261	(progn (setq end (match-end 0))
5dd1ad8e RS	262	(> (point) start)))
	263	(and (/= (point) start)
	264	;; Consider at least the char before point,
	265	;; unless it is also before START.
	266	(= (point) opoint)))
048ab7d3 RS	267	;; keep going back until whitespace
	268	;; doesn't extend to or past end
	269	(forward-char -1))
7f5d3541	270	(setq beg (point))
048ab7d3	271	(goto-char end)
7f5d3541 RS	272	(or (/= beg opoint)
7f5d3541 RS	273	(/= end opoint))))
048ab7d3	274
6b61353c KH	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
49116ac0 JB	359	(provide 'compare-w)
49116ac0 JB	360
6b61353c	361	;;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46
c0274f38	362	;;; compare-w.el ends here