| 1 | ;;; compare-w.el --- compare text between windows for Emacs |
| 2 | |
| 3 | ;; Copyright (C) 1986, 1989, 1993, 1997, 2002, 2003, 2004, |
| 4 | ;; 2005, 2006 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Maintainer: FSF |
| 7 | ;; Keywords: convenience files |
| 8 | |
| 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 |
| 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 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 |
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 24 | ;; Boston, MA 02110-1301, USA. |
| 25 | |
| 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 | |
| 33 | ;;; Code: |
| 34 | |
| 35 | (defgroup compare-w nil |
| 36 | "Compare text between windows." |
| 37 | :prefix "compare-" |
| 38 | :group 'tools) |
| 39 | |
| 40 | (defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+" |
| 41 | "*Regexp or function that defines whitespace sequences for `compare-windows'. |
| 42 | That command optionally ignores changes in whitespace. |
| 43 | |
| 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 |
| 47 | past any whitespace. The function is called in each window, with |
| 48 | point at the current scanning point. It gets one argument, the point |
| 49 | where \\[compare-windows] was originally called; it should not look at |
| 50 | any text before that point. |
| 51 | |
| 52 | If the function returns the same value for both windows, then the |
| 53 | whitespace is considered to match, and is skipped." |
| 54 | :type '(choice regexp function) |
| 55 | :group 'compare-w) |
| 56 | |
| 57 | (defcustom compare-ignore-whitespace nil |
| 58 | "*Non-nil means `compare-windows' ignores whitespace." |
| 59 | :type 'boolean |
| 60 | :group 'compare-w |
| 61 | :version "22.1") |
| 62 | |
| 63 | (defcustom compare-ignore-case nil |
| 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) |
| 93 | :group 'compare-w |
| 94 | :version "22.1") |
| 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 |
| 105 | :group 'compare-w |
| 106 | :version "22.1") |
| 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) |
| 116 | :group 'compare-w |
| 117 | :version "22.1") |
| 118 | |
| 119 | (defcustom compare-windows-highlight t |
| 120 | "*Non-nil means compare-windows highlights the differences. |
| 121 | The value t removes highlighting immediately after invoking a command |
| 122 | other than `compare-windows'. |
| 123 | The value `persistent' leaves all highlighted differences. You can clear |
| 124 | out all highlighting later with the command `compare-windows-dehighlight'." |
| 125 | :type '(choice (const :tag "No highlighting" nil) |
| 126 | (const :tag "Persistent highlighting" persistent) |
| 127 | (other :tag "Highlight until next command" t)) |
| 128 | :group 'compare-w |
| 129 | :version "22.1") |
| 130 | |
| 131 | (defface compare-windows |
| 132 | '((t :inherit lazy-highlight)) |
| 133 | "Face for highlighting of compare-windows difference regions." |
| 134 | :group 'compare-w |
| 135 | :version "22.1") |
| 136 | |
| 137 | (defvar compare-windows-overlay1 nil) |
| 138 | (defvar compare-windows-overlay2 nil) |
| 139 | (defvar compare-windows-overlays1 nil) |
| 140 | (defvar compare-windows-overlays2 nil) |
| 141 | (defvar compare-windows-sync-point nil) |
| 142 | |
| 143 | ;;;###autoload |
| 144 | (defun compare-windows (ignore-whitespace) |
| 145 | "Compare text in current window with text in next window. |
| 146 | Compares the text starting at point in each window, |
| 147 | moving over text in each one as far as they match. |
| 148 | |
| 149 | This command pushes the mark in each window |
| 150 | at the prior location of point in that window. |
| 151 | If both windows display the same buffer, |
| 152 | the mark is pushed twice in that buffer: |
| 153 | first in the other window, then in the selected window. |
| 154 | |
| 155 | A prefix arg means reverse the value of variable |
| 156 | `compare-ignore-whitespace'. If `compare-ignore-whitespace' is |
| 157 | nil, then a prefix arg means ignore changes in whitespace. If |
| 158 | `compare-ignore-whitespace' is non-nil, then a prefix arg means |
| 159 | don't ignore changes in whitespace. The variable |
| 160 | `compare-windows-whitespace' controls how whitespace is skipped. |
| 161 | If `compare-ignore-case' is non-nil, changes in case are also |
| 162 | ignored. |
| 163 | |
| 164 | If `compare-windows-sync' is non-nil, then successive calls of |
| 165 | this command work in interlaced mode: |
| 166 | on first call it advances points to the next difference, |
| 167 | on second call it synchronizes points by skipping the difference, |
| 168 | on third call it again advances points to the next difference and so on." |
| 169 | (interactive "P") |
| 170 | (if compare-ignore-whitespace |
| 171 | (setq ignore-whitespace (not ignore-whitespace))) |
| 172 | (let* (p1 p2 maxp1 maxp2 b1 b2 w2 |
| 173 | (progress 1) |
| 174 | (opoint1 (point)) |
| 175 | opoint2 |
| 176 | skip-func-1 |
| 177 | skip-func-2 |
| 178 | (sync-func (if (stringp compare-windows-sync) |
| 179 | 'compare-windows-sync-regexp |
| 180 | compare-windows-sync))) |
| 181 | (setq p1 (point) b1 (current-buffer)) |
| 182 | (setq w2 (next-window (selected-window))) |
| 183 | (if (eq w2 (selected-window)) |
| 184 | (setq w2 (next-window (selected-window) nil 'visible))) |
| 185 | (if (eq w2 (selected-window)) |
| 186 | (error "No other window")) |
| 187 | (setq p2 (window-point w2) |
| 188 | b2 (window-buffer w2)) |
| 189 | (setq opoint2 p2) |
| 190 | (setq maxp1 (point-max)) |
| 191 | |
| 192 | (setq skip-func-1 (if ignore-whitespace |
| 193 | (if (stringp compare-windows-whitespace) |
| 194 | (lambda (pos) |
| 195 | (compare-windows-skip-whitespace pos) |
| 196 | t) |
| 197 | compare-windows-whitespace))) |
| 198 | |
| 199 | (with-current-buffer b2 |
| 200 | (setq skip-func-2 (if ignore-whitespace |
| 201 | (if (stringp compare-windows-whitespace) |
| 202 | (lambda (pos) |
| 203 | (compare-windows-skip-whitespace pos) |
| 204 | t) |
| 205 | compare-windows-whitespace))) |
| 206 | (push-mark p2 t) |
| 207 | (setq maxp2 (point-max))) |
| 208 | (push-mark) |
| 209 | |
| 210 | (while (> progress 0) |
| 211 | ;; If both windows have whitespace next to point, |
| 212 | ;; optionally skip over it. |
| 213 | (and skip-func-1 |
| 214 | (save-excursion |
| 215 | (let (p1a p2a w1 w2 result1 result2) |
| 216 | (setq result1 (funcall skip-func-1 opoint1)) |
| 217 | (setq p1a (point)) |
| 218 | (set-buffer b2) |
| 219 | (goto-char p2) |
| 220 | (setq result2 (funcall skip-func-2 opoint2)) |
| 221 | (setq p2a (point)) |
| 222 | (if (and result1 result2 (eq result1 result2)) |
| 223 | (setq p1 p1a |
| 224 | p2 p2a))))) |
| 225 | |
| 226 | (let ((size (min (- maxp1 p1) (- maxp2 p2))) |
| 227 | (case-fold-search compare-ignore-case)) |
| 228 | (setq progress (compare-buffer-substrings b2 p2 (+ size p2) |
| 229 | b1 p1 (+ size p1))) |
| 230 | (setq progress (if (zerop progress) size (1- (abs progress)))) |
| 231 | (setq p1 (+ p1 progress) p2 (+ p2 progress))) |
| 232 | ;; Advance point now rather than later, in case we're interrupted. |
| 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 | |
| 239 | (if (= (point) opoint1) |
| 240 | (if (not sync-func) |
| 241 | (ding) |
| 242 | ;; If points are not advanced (i.e. already on mismatch position), |
| 243 | ;; then synchronize points between both windows |
| 244 | (save-excursion |
| 245 | (setq compare-windows-sync-point nil) |
| 246 | (funcall sync-func) |
| 247 | (setq p1 (point)) |
| 248 | (set-buffer b2) |
| 249 | (goto-char p2) |
| 250 | (funcall sync-func) |
| 251 | (setq p2 (point))) |
| 252 | (goto-char p1) |
| 253 | (set-window-point w2 p2) |
| 254 | (when compare-windows-recenter |
| 255 | (recenter (car compare-windows-recenter)) |
| 256 | (with-selected-window w2 (recenter (cadr compare-windows-recenter)))) |
| 257 | ;; If points are still not synchronized, then ding |
| 258 | (when (and (= p1 opoint1) (= p2 opoint2)) |
| 259 | ;; Display error message when current points in two windows |
| 260 | ;; are unmatched and next matching points can't be found. |
| 261 | (compare-windows-dehighlight) |
| 262 | (ding) |
| 263 | (message "No more matching points")))))) |
| 264 | |
| 265 | ;; Move forward over whatever might be called whitespace. |
| 266 | ;; compare-windows-whitespace is a regexp that matches whitespace. |
| 267 | ;; Match it at various starting points before the original point |
| 268 | ;; and find the latest point at which a match ends. |
| 269 | ;; Don't try starting points before START, though. |
| 270 | ;; Value is non-nil if whitespace is found. |
| 271 | ;; If there is whitespace before point, but none after, |
| 272 | ;; then return t, but don't advance point. |
| 273 | (defun compare-windows-skip-whitespace (start) |
| 274 | (let ((end (point)) |
| 275 | (beg (point)) |
| 276 | (opoint (point))) |
| 277 | (while (or (and (looking-at compare-windows-whitespace) |
| 278 | (<= end (match-end 0)) |
| 279 | ;; This match goes past END, so advance END. |
| 280 | (progn (setq end (match-end 0)) |
| 281 | (> (point) start))) |
| 282 | (and (/= (point) start) |
| 283 | ;; Consider at least the char before point, |
| 284 | ;; unless it is also before START. |
| 285 | (= (point) opoint))) |
| 286 | ;; keep going back until whitespace |
| 287 | ;; doesn't extend to or past end |
| 288 | (forward-char -1)) |
| 289 | (setq beg (point)) |
| 290 | (goto-char end) |
| 291 | (or (/= beg opoint) |
| 292 | (/= end opoint)))) |
| 293 | |
| 294 | ;; Move forward to the next synchronization regexp. |
| 295 | (defun compare-windows-sync-regexp () |
| 296 | (if (stringp compare-windows-sync) |
| 297 | (re-search-forward compare-windows-sync nil t))) |
| 298 | |
| 299 | ;; Function works in two passes: one call on each window. |
| 300 | ;; On the first call both matching points are computed, |
| 301 | ;; and one of them is stored in compare-windows-sync-point |
| 302 | ;; to be used when this function is called on second window. |
| 303 | (defun compare-windows-sync-default-function () |
| 304 | (if (not compare-windows-sync-point) |
| 305 | (let* ((w1 (selected-window)) |
| 306 | (w2 (next-window w1)) |
| 307 | (b2 (window-buffer w2)) |
| 308 | (point-max2 (with-current-buffer b2 (point-max))) |
| 309 | (op2 (window-point w2)) |
| 310 | (op1 (point)) |
| 311 | (region-size compare-windows-sync-string-size) |
| 312 | (string-size compare-windows-sync-string-size) |
| 313 | in-bounds-p s1 p2 p12s p12) |
| 314 | (while (and |
| 315 | ;; until matching points are found |
| 316 | (not p12s) |
| 317 | ;; until size exceeds the maximum points of both buffers |
| 318 | ;; (bounds below take care to not overdo in each of them) |
| 319 | (or (setq in-bounds-p (< region-size (max (- (point-max) op1) |
| 320 | (- point-max2 op2)))) |
| 321 | ;; until string size becomes smaller than 4 |
| 322 | (> string-size 4))) |
| 323 | (if in-bounds-p |
| 324 | ;; make the next search in the double-sized region; |
| 325 | ;; on first iteration it is 2*compare-windows-sync-string-size, |
| 326 | ;; on last iterations it exceeds both buffers maximum points |
| 327 | (setq region-size (* region-size 2)) |
| 328 | ;; if region size exceeds the maximum points of both buffers, |
| 329 | ;; then start to halve the string size until 4; |
| 330 | ;; this helps to find differences near the end of buffers |
| 331 | (setq string-size (/ string-size 2))) |
| 332 | (let ((p1 op1) |
| 333 | (bound1 (- (min (+ op1 region-size) (point-max)) string-size)) |
| 334 | (bound2 (min (+ op2 region-size) point-max2))) |
| 335 | (while (< p1 bound1) |
| 336 | (setq s1 (buffer-substring-no-properties p1 (+ p1 string-size))) |
| 337 | (setq p2 (with-current-buffer b2 |
| 338 | (goto-char op2) |
| 339 | (let ((case-fold-search compare-ignore-case)) |
| 340 | (search-forward s1 bound2 t)))) |
| 341 | (when p2 |
| 342 | (setq p2 (- p2 string-size)) |
| 343 | (setq p12s (cons (list (+ p1 p2) p1 p2) p12s))) |
| 344 | (setq p1 (1+ p1))))) |
| 345 | (when p12s |
| 346 | ;; use closest matching points (i.e. points with minimal sum) |
| 347 | (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s))) |
| 348 | (goto-char (car p12)) |
| 349 | (compare-windows-highlight op1 (car p12) (current-buffer) w1 |
| 350 | op2 (cadr p12) b2 w2)) |
| 351 | (setq compare-windows-sync-point (or (cadr p12) t))) |
| 352 | ;; else set point in the second window to the pre-calculated value |
| 353 | (if (numberp compare-windows-sync-point) |
| 354 | (goto-char compare-windows-sync-point)) |
| 355 | (setq compare-windows-sync-point nil))) |
| 356 | |
| 357 | ;; Highlight differences |
| 358 | (defun compare-windows-highlight (beg1 end1 b1 w1 beg2 end2 b2 w2) |
| 359 | (when compare-windows-highlight |
| 360 | (if compare-windows-overlay1 |
| 361 | (move-overlay compare-windows-overlay1 beg1 end1 b1) |
| 362 | (setq compare-windows-overlay1 (make-overlay beg1 end1 b1)) |
| 363 | (overlay-put compare-windows-overlay1 'face 'compare-windows) |
| 364 | (overlay-put compare-windows-overlay1 'priority 1000)) |
| 365 | (overlay-put compare-windows-overlay1 'window w1) |
| 366 | (if compare-windows-overlay2 |
| 367 | (move-overlay compare-windows-overlay2 beg2 end2 b2) |
| 368 | (setq compare-windows-overlay2 (make-overlay beg2 end2 b2)) |
| 369 | (overlay-put compare-windows-overlay2 'face 'compare-windows) |
| 370 | (overlay-put compare-windows-overlay2 'priority 1000)) |
| 371 | (overlay-put compare-windows-overlay2 'window w2) |
| 372 | (if (not (eq compare-windows-highlight 'persistent)) |
| 373 | ;; Remove highlighting before next command is executed |
| 374 | (add-hook 'pre-command-hook 'compare-windows-dehighlight) |
| 375 | (when compare-windows-overlay1 |
| 376 | (push (copy-overlay compare-windows-overlay1) compare-windows-overlays1) |
| 377 | (delete-overlay compare-windows-overlay1)) |
| 378 | (when compare-windows-overlay2 |
| 379 | (push (copy-overlay compare-windows-overlay2) compare-windows-overlays2) |
| 380 | (delete-overlay compare-windows-overlay2))))) |
| 381 | |
| 382 | (defun compare-windows-dehighlight () |
| 383 | "Remove highlighting created by `compare-windows-highlight'." |
| 384 | (interactive) |
| 385 | (remove-hook 'pre-command-hook 'compare-windows-dehighlight) |
| 386 | (mapc 'delete-overlay compare-windows-overlays1) |
| 387 | (mapc 'delete-overlay compare-windows-overlays2) |
| 388 | (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1)) |
| 389 | (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2))) |
| 390 | |
| 391 | (provide 'compare-w) |
| 392 | |
| 393 | ;;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46 |
| 394 | ;;; compare-w.el ends here |