Re: compare-windows - synchronize points

[Juri Linkov]

Richard Stallman <address@hidden> writes:
> How does it fail?  By taking forever, or something else?  It might be
> faster if you tried using a small bound, then again with the bound
> doubled, etc.

It failed by not finding the next matching points in a fixed region.
Now, I added the code to start with a small bound and to double it.
This eliminates the need to choose some fixed bound and also makes
the search fast, so speed is not a problem anymore.

The only parameter that should be customizable, I think, is the
size of a string from one window that is searched in a second window.

The small number makes the difference regions more fine-grained,
but often it fails by finding the wrong match (the same string which
is closer to the starting point).  The bigger number finds the correct
matches, but it makes regions more coarse-grained.

I found that default value 32 is good for most cases,
but sometimes on many small differences the value 4 is better.
Just one illustrative example: when the quotes in the string
`compare-windows' are changed to \\[compare-windows], then
value 4 finds two differences: one is ` to \\[, and second
is ' to ], while value 32 finds one difference as a whole region.

Here is the new implementation (I also added functions for highlighting
difference regions):

(defcustom compare-windows-sync-string-size 32
  "*Size of string from one window that is searched in second window.
The small number makes the difference regions more fine-grained,
but it may fail by finding the wrong match.  The bigger number
makes regions more coarse-grained."
  :type 'integer
  :group 'compare-w)

;; 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* ((case-fold-search compare-ignore-case)
             (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)
                         (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 precalculated value
    (if (numberp compare-windows-sync-point)
        (goto-char compare-windows-sync-point))
    (setq compare-windows-sync-point nil)))

(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)

(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))))

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

-- 
http://www.jurta.org/emacs/