|
|
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.