+ (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* ((w1 (selected-window))
+ (w2 (next-window w1))
+ (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) (current-buffer) w1
+ op2 (cadr p12) b2 w2))
+ (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 b1 w1 beg2 end2 b2 w2)
+ (when compare-windows-highlight
+ (if compare-windows-overlay1
+ (move-overlay compare-windows-overlay1 beg1 end1 b1)
+ (setq compare-windows-overlay1 (make-overlay beg1 end1 b1))
+ (overlay-put compare-windows-overlay1 'face 'compare-windows)
+ (overlay-put compare-windows-overlay1 'priority 1000))
+ (overlay-put compare-windows-overlay1 'window w1)
+ (if compare-windows-overlay2
+ (move-overlay compare-windows-overlay2 beg2 end2 b2)
+ (setq compare-windows-overlay2 (make-overlay beg2 end2 b2))
+ (overlay-put compare-windows-overlay2 'face 'compare-windows)
+ (overlay-put compare-windows-overlay2 'priority 1000))
+ (overlay-put compare-windows-overlay2 'window w2)
+ (if (not (eq compare-windows-highlight 'persistent))
+ ;; Remove highlighting before next command is executed
+ (add-hook 'pre-command-hook 'compare-windows-dehighlight)
+ (when compare-windows-overlay1
+ (push (copy-overlay compare-windows-overlay1) compare-windows-overlays1)
+ (delete-overlay compare-windows-overlay1))
+ (when compare-windows-overlay2
+ (push (copy-overlay compare-windows-overlay2) compare-windows-overlays2)
+ (delete-overlay compare-windows-overlay2)))))
+
+(defun compare-windows-dehighlight ()
+ "Remove highlighting created by `compare-windows-highlight'."
+ (interactive)
+ (remove-hook 'pre-command-hook 'compare-windows-dehighlight)
+ (mapc 'delete-overlay compare-windows-overlays1)
+ (mapc 'delete-overlay compare-windows-overlays2)
+ (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1))
+ (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2)))