|
|
1.1 root 1: ;; Compare text between windows for Emacs.
2: ;; Copyright (C) 1986 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20:
21: (defun compare-windows ()
22: "Compare text in current window with text in next window.
23: Compares the text starting at point in each window,
24: moving over text in each one as far as they match."
25: (interactive)
26: (let (p1 p2 maxp1 maxp2 b1 b2 w2
27: success size
28: (opoint (point)))
29: (setq p1 (point) b1 (current-buffer))
30: (setq w2 (next-window (selected-window)))
31: (if (eq w2 (selected-window))
32: (error "No other window."))
33: (setq p2 (window-point w2)
34: b2 (window-buffer w2))
35: (setq maxp1 (point-max))
36: (save-excursion
37: (set-buffer b2)
38: (setq maxp2 (point-max)))
39:
40: ;; Try advancing comparing 1000 chars at a time.
41: ;; When that fails, go 500 chars at a time, and so on.
42: (setq size 1000)
43: (while (> size 0)
44: (setq success t)
45: (while success
46: (setq size (min size (- maxp1 p1) (- maxp2 p2)))
47: (save-excursion
48: (set-buffer b2)
49: (setq s2 (buffer-substring p2 (+ size p2))))
50: (setq s1 (buffer-substring p1 (+ size p1)))
51: (setq success (and (> size 0) (equal s1 s2)))
52: (if success
53: (setq p1 (+ p1 size) p2 (+ p2 size))))
54: (setq size (/ size 2)))
55:
56: (goto-char p1)
57: (set-window-point w2 p2)
58: (if (= (point) opoint)
59: (ding))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.