Mercurial > emacs
comparison lisp/compare-w.el @ 4072:d38c94145afe
(compare-windows-skip-whitespace): New function.
(compare-windows): Use that.
(compare-windows-whitespace): Value is now regexp.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Tue, 13 Jul 1993 07:31:09 +0000 |
| parents | 10e417efb12a |
| children | 76fb8b35df3f |
comparison
equal
deleted
inserted
replaced
| 4071:4f387cc0a49f | 4072:d38c94145afe |
|---|---|
| 1 ;;; compare-w.el --- compare text between windows for Emacs. | 1 ;;; compare-w.el --- compare text between windows for Emacs. |
| 2 | 2 |
| 3 ;; Copyright (C) 1986, 1989 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1986, 1989, 1993 Free Software Foundation, Inc. |
| 4 | 4 |
| 5 ;; Maintainer: FSF | 5 ;; Maintainer: FSF |
| 6 | 6 |
| 7 ;; This file is part of GNU Emacs. | 7 ;; This file is part of GNU Emacs. |
| 8 | 8 |
| 27 ;; until it finds a difference. Option variables permit you to ignore | 27 ;; until it finds a difference. Option variables permit you to ignore |
| 28 ;; whitespace differences, or case differences, or both. | 28 ;; whitespace differences, or case differences, or both. |
| 29 | 29 |
| 30 ;;; Code: | 30 ;;; Code: |
| 31 | 31 |
| 32 (defvar compare-windows-whitespace " \t\n" | 32 (defvar compare-windows-whitespace "[ \t\n]+" |
| 33 "*String of characters considered whitespace for \\[compare-windows]. | 33 "*Regexp that defines whitespace sequences for \\[compare-windows]. |
| 34 Changes in whitespace are optionally ignored. | 34 Changes in whitespace are optionally ignored. |
| 35 | 35 |
| 36 The value of `compare-windows-whitespace' may instead be a function; this | 36 The value of `compare-windows-whitespace' may instead be a function; this |
| 37 function is called in each buffer, with point at the current scanning point. | 37 function is called in each buffer, with point at the current scanning point. |
| 38 The function's job is to categorize any whitespace around (including before) | 38 The function's job is to categorize any whitespace around (including before) |
| 59 (let* (p1 p2 maxp1 maxp2 b1 b2 w2 | 59 (let* (p1 p2 maxp1 maxp2 b1 b2 w2 |
| 60 success size | 60 success size |
| 61 (opoint1 (point)) | 61 (opoint1 (point)) |
| 62 opoint2 | 62 opoint2 |
| 63 (skip-whitespace (if ignore-whitespace | 63 (skip-whitespace (if ignore-whitespace |
| 64 compare-windows-whitespace)) | 64 compare-windows-whitespace))) |
| 65 (skip-whitespace-regexp (concat "[" skip-whitespace "]+"))) | |
| 66 (setq p1 (point) b1 (current-buffer)) | 65 (setq p1 (point) b1 (current-buffer)) |
| 67 (setq w2 (next-window (selected-window))) | 66 (setq w2 (next-window (selected-window))) |
| 68 (if (eq w2 (selected-window)) | 67 (if (eq w2 (selected-window)) |
| 69 (error "No other window")) | 68 (error "No other window")) |
| 70 (setq p2 (window-point w2) | 69 (setq p2 (window-point w2) |
| 86 ;; optionally skip over it. | 85 ;; optionally skip over it. |
| 87 | 86 |
| 88 (and skip-whitespace | 87 (and skip-whitespace |
| 89 (save-excursion | 88 (save-excursion |
| 90 (let (p1a p2a w1 w2 result1 result2) | 89 (let (p1a p2a w1 w2 result1 result2) |
| 91 (if (stringp skip-whitespace) | 90 (setq result1 |
| 92 (progn | 91 (if (stringp skip-whitespace) |
| 93 (if (not (eobp)) | 92 (compare-windows-skip-whitespace opoint1) |
| 94 (skip-chars-backward skip-whitespace opoint1)) | 93 (funcall skip-whitespace opoint1))) |
| 95 (and (looking-at skip-whitespace-regexp) | 94 (setq p1a (point)) |
| 96 (setq p1a (match-end 0) result1 t))) | |
| 97 (setq result1 (funcall skip-whitespace opoint1)) | |
| 98 (setq p1a (point))) | |
| 99 (set-buffer b2) | 95 (set-buffer b2) |
| 100 (goto-char p2) | 96 (goto-char p2) |
| 101 (if (stringp skip-whitespace) | 97 (setq result2 |
| 102 (progn | 98 (if (stringp skip-whitespace) |
| 103 (if (not (eobp)) | 99 (compare-windows-skip-whitespace opoint2) |
| 104 (skip-chars-backward skip-whitespace opoint2)) | 100 (funcall skip-whitespace opoint2))) |
| 105 (and (looking-at skip-whitespace-regexp) | 101 (setq p2a (point)) |
| 106 (setq p2a (match-end 0) result2 t))) | |
| 107 (setq result2 (funcall skip-whitespace opoint2)) | |
| 108 (setq p2a (point))) | |
| 109 (and result1 result2 (eq result1 result2) | 102 (and result1 result2 (eq result1 result2) |
| 110 (setq p1 p1a | 103 (setq p1 p1a |
| 111 p2 p2a))))) | 104 p2 p2a))))) |
| 112 | 105 |
| 113 ;; Try advancing comparing 1000 chars at a time. | 106 ;; Try advancing comparing 1000 chars at a time. |
| 133 (goto-char p1) | 126 (goto-char p1) |
| 134 (set-window-point w2 p2) | 127 (set-window-point w2 p2) |
| 135 (if (= (point) opoint1) | 128 (if (= (point) opoint1) |
| 136 (ding)))) | 129 (ding)))) |
| 137 | 130 |
| 131 ;; Move forward over whatever might be called whitespace. | |
| 132 ;; compare-windows-whitespace is a regexp that matches whitespace. | |
| 133 ;; Match it at various starting points before the original point | |
| 134 ;; and find the latest point at which a match ends. | |
| 135 ;; Don't try starting points before START, though. | |
| 136 ;; Value is non-nil if whitespace is found. | |
| 137 (defun compare-windows-skip-whitespace (start) | |
| 138 (let ((end (point)) | |
| 139 (opoint (point))) | |
| 140 (while (and (looking-at compare-windows-whitespace) | |
| 141 (<= end (match-end 0)) | |
| 142 ;; This match goes past END, so advance END. | |
| 143 (progn (setq end (match-end 0)) | |
| 144 (> (point) start))) | |
| 145 ;; keep going back until whitespace | |
| 146 ;; doesn't extend to or past end | |
| 147 (forward-char -1)) | |
| 148 (goto-char end) | |
| 149 (/= end opoint))) | |
| 150 | |
| 138 (provide 'compare-w) | 151 (provide 'compare-w) |
| 139 | 152 |
| 140 ;;; compare-w.el ends here | 153 ;;; compare-w.el ends here |