Mercurial > emacs
comparison lisp/compare-w.el @ 16986:dc0cd1c70c87
(compare-windows): Make more efficient use of
result from compare-buffer-substrings.
| author | Karl Heuer <kwzh@gnu.org> |
|---|---|
| date | Sun, 09 Feb 1997 22:55:17 +0000 |
| parents | 83f275dcd93a |
| children | 433d9754cdd5 |
comparison
equal
deleted
inserted
replaced
| 16985:b0d8e7c0f906 | 16986:dc0cd1c70c87 |
|---|---|
| 62 A prefix arg means ignore changes in whitespace. | 62 A prefix arg means ignore changes in whitespace. |
| 63 The variable `compare-windows-whitespace' controls how whitespace is skipped. | 63 The variable `compare-windows-whitespace' controls how whitespace is skipped. |
| 64 If `compare-ignore-case' is non-nil, changes in case are also ignored." | 64 If `compare-ignore-case' is non-nil, changes in case are also ignored." |
| 65 (interactive "P") | 65 (interactive "P") |
| 66 (let* (p1 p2 maxp1 maxp2 b1 b2 w2 | 66 (let* (p1 p2 maxp1 maxp2 b1 b2 w2 |
| 67 success size | 67 (progress 1) |
| 68 (opoint1 (point)) | 68 (opoint1 (point)) |
| 69 opoint2 | 69 opoint2 |
| 70 (skip-whitespace (if ignore-whitespace | 70 (skip-func (if ignore-whitespace |
| 71 compare-windows-whitespace))) | 71 (if (stringp compare-windows-whitespace) |
| 72 'compare-windows-skip-whitespace | |
| 73 compare-windows-whitespace)))) | |
| 72 (setq p1 (point) b1 (current-buffer)) | 74 (setq p1 (point) b1 (current-buffer)) |
| 73 (setq w2 (next-window (selected-window))) | 75 (setq w2 (next-window (selected-window))) |
| 74 (if (eq w2 (selected-window)) | 76 (if (eq w2 (selected-window)) |
| 75 (error "No other window")) | 77 (error "No other window")) |
| 76 (setq p2 (window-point w2) | 78 (setq p2 (window-point w2) |
| 81 (set-buffer b2) | 83 (set-buffer b2) |
| 82 (push-mark p2 t) | 84 (push-mark p2 t) |
| 83 (setq maxp2 (point-max))) | 85 (setq maxp2 (point-max))) |
| 84 (push-mark) | 86 (push-mark) |
| 85 | 87 |
| 86 (setq success t) | 88 (while (> progress 0) |
| 87 (while success | |
| 88 (setq success nil) | |
| 89 ;; if interrupted, show how far we've gotten | |
| 90 (goto-char p1) | |
| 91 (set-window-point w2 p2) | |
| 92 | |
| 93 ;; If both buffers have whitespace next to point, | 89 ;; If both buffers have whitespace next to point, |
| 94 ;; optionally skip over it. | 90 ;; optionally skip over it. |
| 95 | 91 |
| 96 (and skip-whitespace | 92 (and skip-func |
| 97 (save-excursion | 93 (save-excursion |
| 98 (let (p1a p2a w1 w2 result1 result2) | 94 (let (p1a p2a w1 w2 result1 result2) |
| 99 (setq result1 | 95 (setq result1 (funcall skip-func opoint1)) |
| 100 (if (stringp skip-whitespace) | |
| 101 (compare-windows-skip-whitespace opoint1) | |
| 102 (funcall skip-whitespace opoint1))) | |
| 103 (setq p1a (point)) | 96 (setq p1a (point)) |
| 104 (set-buffer b2) | 97 (set-buffer b2) |
| 105 (goto-char p2) | 98 (goto-char p2) |
| 106 (setq result2 | 99 (setq result2 (funcall skip-func opoint2)) |
| 107 (if (stringp skip-whitespace) | |
| 108 (compare-windows-skip-whitespace opoint2) | |
| 109 (funcall skip-whitespace opoint2))) | |
| 110 (setq p2a (point)) | 100 (setq p2a (point)) |
| 111 (if (or (stringp skip-whitespace) | 101 (if (or (stringp skip-whitespace) |
| 112 (and result1 result2 (eq result1 result2))) | 102 (and result1 result2 (eq result1 result2))) |
| 113 (setq p1 p1a | 103 (setq p1 p1a |
| 114 p2 p2a))))) | 104 p2 p2a))))) |
| 115 | 105 |
| 116 ;; Try advancing comparing 1000 chars at a time. | 106 (let ((size (min (- maxp1 p1) (- maxp2 p2))) |
| 117 ;; When that fails, go 500 chars at a time, and so on. | |
| 118 (let ((size 1000) | |
| 119 success-1 | |
| 120 (case-fold-search compare-ignore-case)) | 107 (case-fold-search compare-ignore-case)) |
| 121 (while (> size 0) | 108 (setq progress (compare-buffer-substrings b2 p2 (+ size p2) |
| 122 (setq success-1 t) | 109 b1 p1 (+ size p1))) |
| 123 ;; Try comparing SIZE chars at a time, repeatedly, till that fails. | 110 (setq progress (if (zerop progress) size (1- (abs progress)))) |
| 124 (while success-1 | 111 (setq p1 (+ p1 progress) p2 (+ p2 progress))) |
| 125 (setq size (min size (- maxp1 p1) (- maxp2 p2))) | 112 ;; Advance point now rather than later, in case we're interrupted. |
| 126 (setq success-1 | 113 (goto-char p1) |
| 127 (and (> size 0) | 114 (set-window-point w2 p2)) |
| 128 (= 0 (compare-buffer-substrings b2 p2 (+ size p2) | |
| 129 b1 p1 (+ size p1))))) | |
| 130 (if success-1 | |
| 131 (setq p1 (+ p1 size) p2 (+ p2 size) | |
| 132 success t))) | |
| 133 ;; If SIZE chars don't match, try fewer. | |
| 134 (setq size (/ size 2))))) | |
| 135 | 115 |
| 136 (goto-char p1) | |
| 137 (set-window-point w2 p2) | |
| 138 (if (= (point) opoint1) | 116 (if (= (point) opoint1) |
| 139 (ding)))) | 117 (ding)))) |
| 140 | 118 |
| 141 ;; Move forward over whatever might be called whitespace. | 119 ;; Move forward over whatever might be called whitespace. |
| 142 ;; compare-windows-whitespace is a regexp that matches whitespace. | 120 ;; compare-windows-whitespace is a regexp that matches whitespace. |