1;;; compare-w.el --- compare text between windows for Emacs 2 3;; Copyright (C) 1986, 1989, 1993, 1997, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 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-windows 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'. 42That command optionally ignores changes in whitespace. 43 44The value of `compare-windows-whitespace' is normally a regexp, but it 45can also be a function. The function's job is to categorize any 46whitespace around (including before) point; it should also advance 47past any whitespace. The function is called in each window, with 48point at the current scanning point. It gets one argument, the point 49where \\[compare-windows] was originally called; it should not look at 50any text before that point. 51 52If the function returns the same value for both windows, then the 53whitespace is considered to match, and is skipped." 54 :type '(choice regexp function) 55 :group 'compare-windows) 56 57(defcustom compare-ignore-whitespace nil 58 "*Non-nil means `compare-windows' ignores whitespace." 59 :type 'boolean 60 :group 'compare-windows 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-windows) 67 68(defcustom compare-windows-sync 'compare-windows-sync-default-function 69 "*Function or regexp that is used to synchronize points in two 70windows if before calling `compare-windows' points are located 71on mismatched positions. 72 73The value of `compare-windows-sync' can be a function. The 74function's job is to advance points in both windows to the next 75matching text. If the value of `compare-windows-sync' is a 76regexp, then points in both windows are advanced to the next 77occurrence of this regexp. 78 79The current default value is the general function 80`compare-windows-sync-default-function' that is able to 81synchronize points by using quadratic algorithm to find the first 82matching 32-character string in two windows. 83 84The other useful values of this variable could be such functions 85as `forward-word', `forward-sentence', `forward-paragraph', or a 86regexp containing some field separator or a newline, depending on 87the nature of the difference units separator. The variable can 88be made buffer-local. 89 90If the value of this variable is `nil' (option \"No sync\"), then 91no synchronization is performed, and the function `ding' is called 92to beep or flash the screen when points are mismatched." 93 :type '(choice function regexp (const :tag "No sync" nil)) 94 :group 'compare-windows 95 :version "22.1") 96 97(defcustom compare-windows-sync-string-size 32 98 "*Size of string from one window that is searched in second window. 99 100Small number makes difference regions more fine-grained, but it 101may fail by finding the wrong match. The bigger number makes 102difference regions more coarse-grained. 103 104The default value 32 is good for the most cases." 105 :type 'integer 106 :group 'compare-windows 107 :version "22.1") 108 109(defcustom compare-windows-recenter nil 110 "*List of two values, each of which is used as argument of 111function `recenter' called in each of two windows to place 112matching points side-by-side. 113 114The value `(-1 0)' is useful if windows are split vertically, 115and the value `((4) (4))' for horizontally split windows." 116 :type '(list sexp sexp) 117 :group 'compare-windows 118 :version "22.1") 119 120(defcustom compare-windows-highlight t 121 "*Non-nil means compare-windows highlights the differences. 122The value t removes highlighting immediately after invoking a command 123other than `compare-windows'. 124The value `persistent' leaves all highlighted differences. You can clear 125out all highlighting later with the command `compare-windows-dehighlight'." 126 :type '(choice (const :tag "No highlighting" nil) 127 (const :tag "Persistent highlighting" persistent) 128 (other :tag "Highlight until next command" t)) 129 :group 'compare-windows 130 :version "22.1") 131 132(defface compare-windows 133 '((t :inherit lazy-highlight)) 134 "Face for highlighting of compare-windows difference regions." 135 :group 'compare-windows 136 :version "22.1") 137 138(defvar compare-windows-overlay1 nil) 139(defvar compare-windows-overlay2 nil) 140(defvar compare-windows-overlays1 nil) 141(defvar compare-windows-overlays2 nil) 142(defvar compare-windows-sync-point nil) 143 144;;;###autoload 145(defun compare-windows (ignore-whitespace) 146 "Compare text in current window with text in next window. 147Compares the text starting at point in each window, 148moving over text in each one as far as they match. 149 150This command pushes the mark in each window 151at the prior location of point in that window. 152If both windows display the same buffer, 153the mark is pushed twice in that buffer: 154first in the other window, then in the selected window. 155 156A prefix arg means reverse the value of variable 157`compare-ignore-whitespace'. If `compare-ignore-whitespace' is 158nil, then a prefix arg means ignore changes in whitespace. If 159`compare-ignore-whitespace' is non-nil, then a prefix arg means 160don't ignore changes in whitespace. The variable 161`compare-windows-whitespace' controls how whitespace is skipped. 162If `compare-ignore-case' is non-nil, changes in case are also 163ignored. 164 165If `compare-windows-sync' is non-nil, then successive calls of 166this command work in interlaced mode: 167on first call it advances points to the next difference, 168on second call it synchronizes points by skipping the difference, 169on third call it again advances points to the next difference and so on." 170 (interactive "P") 171 (if compare-ignore-whitespace 172 (setq ignore-whitespace (not ignore-whitespace))) 173 (let* (p1 p2 maxp1 maxp2 b1 b2 w2 174 (progress 1) 175 (opoint1 (point)) 176 opoint2 177 skip-func-1 178 skip-func-2 179 (sync-func (if (stringp compare-windows-sync) 180 'compare-windows-sync-regexp 181 compare-windows-sync))) 182 (setq p1 (point) b1 (current-buffer)) 183 (setq w2 (next-window (selected-window))) 184 (if (eq w2 (selected-window)) 185 (setq w2 (next-window (selected-window) nil 'visible))) 186 (if (eq w2 (selected-window)) 187 (error "No other window")) 188 (setq p2 (window-point w2) 189 b2 (window-buffer w2)) 190 (setq opoint2 p2) 191 (setq maxp1 (point-max)) 192 193 (setq skip-func-1 (if ignore-whitespace 194 (if (stringp compare-windows-whitespace) 195 (lambda (pos) 196 (compare-windows-skip-whitespace pos) 197 t) 198 compare-windows-whitespace))) 199 200 (with-current-buffer b2 201 (setq skip-func-2 (if ignore-whitespace 202 (if (stringp compare-windows-whitespace) 203 (lambda (pos) 204 (compare-windows-skip-whitespace pos) 205 t) 206 compare-windows-whitespace))) 207 (push-mark p2 t) 208 (setq maxp2 (point-max))) 209 (push-mark) 210 211 (while (> progress 0) 212 ;; If both windows have whitespace next to point, 213 ;; optionally skip over it. 214 (and skip-func-1 215 (save-excursion 216 (let (p1a p2a w1 w2 result1 result2) 217 (setq result1 (funcall skip-func-1 opoint1)) 218 (setq p1a (point)) 219 (set-buffer b2) 220 (goto-char p2) 221 (setq result2 (funcall skip-func-2 opoint2)) 222 (setq p2a (point)) 223 (if (and result1 result2 (eq result1 result2)) 224 (setq p1 p1a 225 p2 p2a))))) 226 227 (let ((size (min (- maxp1 p1) (- maxp2 p2))) 228 (case-fold-search compare-ignore-case)) 229 (setq progress (compare-buffer-substrings b2 p2 (+ size p2) 230 b1 p1 (+ size p1))) 231 (setq progress (if (zerop progress) size (1- (abs progress)))) 232 (setq p1 (+ p1 progress) p2 (+ p2 progress))) 233 ;; Advance point now rather than later, in case we're interrupted. 234 (goto-char p1) 235 (set-window-point w2 p2) 236 (when compare-windows-recenter 237 (recenter (car compare-windows-recenter)) 238 (with-selected-window w2 (recenter (cadr compare-windows-recenter))))) 239 240 (if (= (point) opoint1) 241 (if (not sync-func) 242 (ding) 243 ;; If points are not advanced (i.e. already on mismatch position), 244 ;; then synchronize points between both windows 245 (save-excursion 246 (setq compare-windows-sync-point nil) 247 (funcall sync-func) 248 (setq p1 (point)) 249 (set-buffer b2) 250 (goto-char p2) 251 (funcall sync-func) 252 (setq p2 (point))) 253 (goto-char p1) 254 (set-window-point w2 p2) 255 (when compare-windows-recenter 256 (recenter (car compare-windows-recenter)) 257 (with-selected-window w2 (recenter (cadr compare-windows-recenter)))) 258 ;; If points are still not synchronized, then ding 259 (when (and (= p1 opoint1) (= p2 opoint2)) 260 ;; Display error message when current points in two windows 261 ;; are unmatched and next matching points can't be found. 262 (compare-windows-dehighlight) 263 (ding) 264 (message "No more matching points")))))) 265 266;; Move forward over whatever might be called whitespace. 267;; compare-windows-whitespace is a regexp that matches whitespace. 268;; Match it at various starting points before the original point 269;; and find the latest point at which a match ends. 270;; Don't try starting points before START, though. 271;; Value is non-nil if whitespace is found. 272;; If there is whitespace before point, but none after, 273;; then return t, but don't advance point. 274(defun compare-windows-skip-whitespace (start) 275 (let ((end (point)) 276 (beg (point)) 277 (opoint (point))) 278 (while (or (and (looking-at compare-windows-whitespace) 279 (<= end (match-end 0)) 280 ;; This match goes past END, so advance END. 281 (progn (setq end (match-end 0)) 282 (> (point) start))) 283 (and (/= (point) start) 284 ;; Consider at least the char before point, 285 ;; unless it is also before START. 286 (= (point) opoint))) 287 ;; keep going back until whitespace 288 ;; doesn't extend to or past end 289 (forward-char -1)) 290 (setq beg (point)) 291 (goto-char end) 292 (or (/= beg opoint) 293 (/= end opoint)))) 294 295;; Move forward to the next synchronization regexp. 296(defun compare-windows-sync-regexp () 297 (if (stringp compare-windows-sync) 298 (re-search-forward compare-windows-sync nil t))) 299 300;; Function works in two passes: one call on each window. 301;; On the first call both matching points are computed, 302;; and one of them is stored in compare-windows-sync-point 303;; to be used when this function is called on second window. 304(defun compare-windows-sync-default-function () 305 (if (not compare-windows-sync-point) 306 (let* ((w1 (selected-window)) 307 (w2 (next-window w1)) 308 (b2 (window-buffer w2)) 309 (point-max2 (with-current-buffer b2 (point-max))) 310 (op2 (window-point w2)) 311 (op1 (point)) 312 (region-size compare-windows-sync-string-size) 313 (string-size compare-windows-sync-string-size) 314 in-bounds-p s1 p2 p12s p12) 315 (while (and 316 ;; until matching points are found 317 (not p12s) 318 ;; until size exceeds the maximum points of both buffers 319 ;; (bounds below take care to not overdo in each of them) 320 (or (setq in-bounds-p (< region-size (max (- (point-max) op1) 321 (- point-max2 op2)))) 322 ;; until string size becomes smaller than 4 323 (> string-size 4))) 324 (if in-bounds-p 325 ;; make the next search in the double-sized region; 326 ;; on first iteration it is 2*compare-windows-sync-string-size, 327 ;; on last iterations it exceeds both buffers maximum points 328 (setq region-size (* region-size 2)) 329 ;; if region size exceeds the maximum points of both buffers, 330 ;; then start to halve the string size until 4; 331 ;; this helps to find differences near the end of buffers 332 (setq string-size (/ string-size 2))) 333 (let ((p1 op1) 334 (bound1 (- (min (+ op1 region-size) (point-max)) string-size)) 335 (bound2 (min (+ op2 region-size) point-max2))) 336 (while (< p1 bound1) 337 (setq s1 (buffer-substring-no-properties p1 (+ p1 string-size))) 338 (setq p2 (with-current-buffer b2 339 (goto-char op2) 340 (let ((case-fold-search compare-ignore-case)) 341 (search-forward s1 bound2 t)))) 342 (when p2 343 (setq p2 (- p2 string-size)) 344 (setq p12s (cons (list (+ p1 p2) p1 p2) p12s))) 345 (setq p1 (1+ p1))))) 346 (when p12s 347 ;; use closest matching points (i.e. points with minimal sum) 348 (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s))) 349 (goto-char (car p12)) 350 (compare-windows-highlight op1 (car p12) (current-buffer) w1 351 op2 (cadr p12) b2 w2)) 352 (setq compare-windows-sync-point (or (cadr p12) t))) 353 ;; else set point in the second window to the pre-calculated value 354 (if (numberp compare-windows-sync-point) 355 (goto-char compare-windows-sync-point)) 356 (setq compare-windows-sync-point nil))) 357 358;; Highlight differences 359(defun compare-windows-highlight (beg1 end1 b1 w1 beg2 end2 b2 w2) 360 (when compare-windows-highlight 361 (if compare-windows-overlay1 362 (move-overlay compare-windows-overlay1 beg1 end1 b1) 363 (setq compare-windows-overlay1 (make-overlay beg1 end1 b1)) 364 (overlay-put compare-windows-overlay1 'face 'compare-windows) 365 (overlay-put compare-windows-overlay1 'priority 1000)) 366 (overlay-put compare-windows-overlay1 'window w1) 367 (if compare-windows-overlay2 368 (move-overlay compare-windows-overlay2 beg2 end2 b2) 369 (setq compare-windows-overlay2 (make-overlay beg2 end2 b2)) 370 (overlay-put compare-windows-overlay2 'face 'compare-windows) 371 (overlay-put compare-windows-overlay2 'priority 1000)) 372 (overlay-put compare-windows-overlay2 'window w2) 373 (if (not (eq compare-windows-highlight 'persistent)) 374 ;; Remove highlighting before next command is executed 375 (add-hook 'pre-command-hook 'compare-windows-dehighlight) 376 (when compare-windows-overlay1 377 (push (copy-overlay compare-windows-overlay1) compare-windows-overlays1) 378 (delete-overlay compare-windows-overlay1)) 379 (when compare-windows-overlay2 380 (push (copy-overlay compare-windows-overlay2) compare-windows-overlays2) 381 (delete-overlay compare-windows-overlay2))))) 382 383(defun compare-windows-dehighlight () 384 "Remove highlighting created by `compare-windows-highlight'." 385 (interactive) 386 (remove-hook 'pre-command-hook 'compare-windows-dehighlight) 387 (mapc 'delete-overlay compare-windows-overlays1) 388 (mapc 'delete-overlay compare-windows-overlays2) 389 (and compare-windows-overlay1 (delete-overlay compare-windows-overlay1)) 390 (and compare-windows-overlay2 (delete-overlay compare-windows-overlay2))) 391 392(provide 'compare-w) 393 394;;; arch-tag: 4177aab1-48e6-4a98-b7a1-000ee285de46 395;;; compare-w.el ends here 396