|
|
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 distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: ! 22: (defun compare-windows () ! 23: "Compare text in current window with text in next window. ! 24: Compares the text starting at point in each window, ! 25: moving over text in each one as far as they match." ! 26: (interactive) ! 27: (let (p1 p2 maxp1 maxp2 b1 b2 w2 ! 28: success size ! 29: (opoint (point))) ! 30: (setq p1 (point) b1 (current-buffer)) ! 31: (setq w2 (next-window (selected-window))) ! 32: (if (eq w2 (selected-window)) ! 33: (error "No other window.")) ! 34: (setq p2 (window-point w2) ! 35: b2 (window-buffer w2)) ! 36: (setq maxp1 (point-max)) ! 37: (save-excursion ! 38: (set-buffer b2) ! 39: (setq maxp2 (point-max))) ! 40: ! 41: ;; Try advancing comparing 1000 chars at a time. ! 42: ;; When that fails, go 500 chars at a time, and so on. ! 43: (setq size 1000) ! 44: (while (> size 0) ! 45: (setq success t) ! 46: (while success ! 47: (setq size (min size (- maxp1 p1) (- maxp2 p2))) ! 48: (save-excursion ! 49: (set-buffer b2) ! 50: (setq s2 (buffer-substring p2 (+ size p2)))) ! 51: (setq s1 (buffer-substring p1 (+ size p1))) ! 52: (setq success (and (> size 0) (equal s1 s2))) ! 53: (if success ! 54: (setq p1 (+ p1 size) p2 (+ p2 size)))) ! 55: (setq size (/ size 2))) ! 56: ! 57: (goto-char p1) ! 58: (set-window-point w2 p2) ! 59: (if (= (point) opoint) ! 60: (ding))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.