comparison lisp/diff.el @ 894:41507a5a8fd7

*** empty log message ***
author Roland McGrath <roland@gnu.org>
date Wed, 29 Jul 1992 05:06:36 +0000
parents 945558e05127
children 48ca3bf4b5f8
comparison
equal deleted inserted replaced
893:751a51860b29 894:41507a5a8fd7
1 ;;; diff.el --- "DIFF" mode for handling output from unix diff utility. 1 ;;; diff.el --- Run `diff' in compilation-mode.
2 2
3 ;; Copyright (C) 1990 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
4 4
5 ;; Author: Frank P. Bresz <fpb@ittc.wec.com>
6 ;; Maintainer: FSF
7 ;; Created: 27 Jan 1989
8 ;; Keyword: unix, tools 5 ;; Keyword: unix, tools
9 6
10 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
11 8
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 9 ;; GNU Emacs is free software; you can redistribute it and/or modify
21 18
22 ;; You should have received a copy of the GNU General Public License 19 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to 20 ;; along with GNU Emacs; see the file COPYING. If not, write to
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25 22
26 ;;; Commentary:
27
28 ;; todo: diff-switches flexibility:
29 ;; (defconst diff-switches-function
30 ;; '(lambda (file)
31 ;; (if (string-match "\\.el$" file)
32 ;; "-c -F\"^(\""
33 ;; "-p"))
34 ;; "Function to return switches to pass to the `diff' utility, in \\[diff].
35 ;; This function is called with one arg, a file name, and returns a string
36 ;; containing 0 or more arguments which are passed on to `diff'.
37 ;; NOTE: This is not an ordinary hook; it may not be a list of functions.")
38
39 ;; - fpb@ittc.wec.com - Sep 25, 1990
40 ;; Added code to support sccs diffing.
41 ;; also fixed one minor glitch in the
42 ;; search for the pattern. If you only 1 addition you won't find the end
43 ;; of the pattern (minor)
44
45 ;;; Code: 23 ;;; Code:
46 24
25 (require 'compile)
26
47 (defvar diff-switches nil 27 (defvar diff-switches nil
48 "*A list of switches to pass to the diff program.") 28 "*A string or list of strings specifying switches to be be passed to diff.")
49 29
50 (defvar diff-search-pattern "^\\([0-9]\\|\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\)" 30 (defvar diff-regexp-alist
51 "Regular expression that delineates difference regions in diffs.") 31 '(
52 32 ;; -u format: @@ -OLDSTART,OLDEND +NEWSTART,NEWEND @@
53 (defvar diff-rcs-extension ",v" 33 ("^@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@$" 1 2)
54 "*Extension to find RCS file, some systems do not use ,v") 34
55 35 ;; -c format: *** OLDSTART,OLDEND ****
56 ;; Initialize the keymap if it isn't already 36 ("^\\*\\*\\* \\([0-9]+\\),[0-9]+ \\*\\*\\*\\*$" 1 nil)
57 (if (boundp 'diff-mode-map) 37 ;; --- NEWSTART,NEWEND ----
58 nil 38 ("^--- \\([0-9]+\\),[0-9]+ ----$" nil 1)
59 (setq diff-mode-map (make-keymap)) 39
60 (suppress-keymap diff-mode-map) 40 ;; plain diff format: OLDSTART[,OLDEND]{a,d,c}NEWSTART[,NEWEND]
61 (define-key diff-mode-map "?" 'describe-mode) 41 ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)\\(,[0-9]+\\)?$" 1 3)
62 (define-key diff-mode-map "." 'diff-beginning-of-diff) 42
63 (define-key diff-mode-map " " 'scroll-up) 43 ;; -e (ed) format: OLDSTART[,OLDEND]{a,d,c}
64 (define-key diff-mode-map "\177" 'scroll-down) 44 ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]$" 1)
65 (define-key diff-mode-map "n" 'diff-next-difference) 45
66 (define-key diff-mode-map "p" 'diff-previous-difference) 46 ;; -f format: {a,d,c}OLDSTART[ OLDEND]
67 (define-key diff-mode-map "j" 'diff-show-difference)) 47 ;; -n format: {a,d,c}OLDSTART LINES-CHANGED
48 ("^[adc]\\([0-9]+\\)\\( [0-9]+\\)?$" 1)
49 )
50 "Alist (REGEXP OLD-IDX NEW-IDX) of regular expressions to match difference
51 sections in \\[diff] output. If REGEXP matches, the OLD-IDX'th
52 subexpression gives the line number in the old file, and NEW-IDX'th
53 subexpression gives the line number in the new file. If OLD-IDX or NEW-IDX
54 is nil, REGEXP matches only half a section.")
55
56 ;; See compilation-parse-errors-function (compile.el).
57 (defun diff-parse-differences (limit-search)
58 (setq compilation-error-list nil)
59 (message "Parsing differences...")
60
61 ;; Don't reparse diffs already seen at last parse.
62 (goto-char compilation-parsing-end)
63
64 ;; Construct in REGEXP a regexp composed of all those in dired-regexp-alist.
65 (let ((regexp (mapconcat (lambda (elt)
66 (concat "\\(" (car elt) "\\)"))
67 diff-regexp-alist
68 "\\|"))
69 ;; (GROUP-IDX OLD-IDX NEW-IDX)
70 (groups (let ((subexpr 1))
71 (mapcar (lambda (elt)
72 (prog1
73 (cons subexpr
74 (mapcar (lambda (n)
75 (and n
76 (+ subexpr n)))
77 (cdr elt)))
78 (setq subexpr (+ subexpr 1
79 (count-regexp-groupings
80 (car elt))))))
81 diff-regexp-alist)))
82
83 (new-error
84 (function (lambda (file subexpr)
85 (setq compilation-error-list
86 (cons
87 (cons (set-marker (make-marker)
88 (match-beginning subexpr)
89 (current-buffer))
90 (let ((line (string-to-int
91 (buffer-substring
92 (match-beginning subexpr)
93 (match-end subexpr)))))
94 (save-excursion
95 (set-buffer (find-file-noselect file))
96 (save-excursion
97 (goto-line line)
98 (point-marker)))))
99 compilation-error-list)))))
100
101 (found-desired nil)
102 g)
103
104 (while (and (not found-desired)
105 ;; We don't just pass LIMIT-SEARCH to re-search-forward
106 ;; because we want to find matches containing LIMIT-SEARCH
107 ;; but which extend past it.
108 (re-search-forward regexp nil t))
109
110 ;; Find which individual regexp matched.
111 (setq g groups)
112 (while (and g (null (match-beginning (car (car g)))))
113 (setq g (cdr g)))
114 (setq g (car g))
115
116 (if (nth 1 g) ;OLD-IDX
117 (funcall new-error diff-old-file (nth 1 g)))
118 (if (nth 2 g) ;NEW-IDX
119 (funcall new-error diff-new-file (nth 2 g)))
120
121 (and limit-search (>= (point) limit-search)
122 ;; The user wanted a specific diff, and we're past it.
123 (setq found-desired t)))
124 (if found-desired
125 (setq compilation-parsing-end (point))
126 ;; Set to point-max, not point, so we don't perpetually
127 ;; parse the last bit of text when it isn't a diff header.
128 (setq compilation-parsing-end (point-max))
129 (message "Parsing differences...done")))
130 (setq compilation-error-list (nreverse compilation-error-list)))
68 131
69 ;;;###autoload 132 ;;;###autoload
70 (defun diff (old new) 133 (defun diff (old new &optional switches)
71 "Find and display the differences between OLD and NEW files. 134 "Find and display the differences between OLD and NEW files.
72 Interactively the current buffer's file name is the default for for NEW 135 Interactively the current buffer's file name is the default for for NEW
73 and a backup file for NEW is the default for OLD." 136 and a backup file for NEW is the default for OLD.
137 With prefix arg, prompt for diff switches."
74 (interactive 138 (interactive
75 (let (oldf newf) 139 (nconc
76 (reverse 140 (let (oldf newf)
77 (list 141 (nreverse
78 (setq newf (buffer-file-name) 142 (list
79 newf (if (and newf (file-exists-p newf)) 143 (setq newf (buffer-file-name)
80 (read-file-name 144 newf (if (and newf (file-exists-p newf))
81 (concat "Diff new file: (" 145 (read-file-name
82 (file-name-nondirectory newf) ") ") 146 (concat "Diff new file: ("
83 nil newf t) 147 (file-name-nondirectory newf) ") ")
84 (read-file-name "Diff new file: " nil nil t))) 148 nil newf t)
85 (setq oldf (file-newest-backup newf) 149 (read-file-name "Diff new file: " nil nil t)))
86 oldf (if (and oldf (file-exists-p oldf)) 150 (setq oldf (file-newest-backup newf)
87 (read-file-name 151 oldf (if (and oldf (file-exists-p oldf))
88 (concat "Diff original file: (" 152 (read-file-name
89 (file-name-nondirectory oldf) ") ") 153 (concat "Diff original file: ("
90 (file-name-directory oldf) oldf t) 154 (file-name-nondirectory oldf) ") ")
91 (read-file-name "Diff original file: " 155 (file-name-directory oldf) oldf t)
92 (file-name-directory newf) nil t))))))) 156 (read-file-name "Diff original file: "
157 (file-name-directory newf) nil t))))))
158 (if current-prefix-arg
159 (list (read-string "Diff switches: "
160 (if (stringp diff-switches)
161 diff-switches
162 (mapconcat 'identity diff-switches " "))))
163 nil)))
93 (message "Comparing files %s %s..." new old) 164 (message "Comparing files %s %s..." new old)
94 (setq new (expand-file-name new) 165 (setq new (expand-file-name new)
95 old (expand-file-name old)) 166 old (expand-file-name old))
96 (diff-internal-diff "diff" (append diff-switches (list new old)) nil)) 167 (let ((buf (compile-internal (mapconcat 'identity
97 168 (append '("diff")
98 (defun diff-backup (file) 169 (if (consp diff-switches)
170 diff-switches
171 (list diff-switches))
172 (list old)
173 (list new))
174 " ")
175 "No more differences" "Diff"
176 'diff-parse-differences)))
177 (save-excursion
178 (set-buffer buf)
179 (set (make-local-variable 'diff-old-file) old)
180 (set (make-local-variable 'diff-new-file) new))
181 buf))
182
183 ;;;###autoload
184 (defun diff-backup (file &optional switches)
99 "Diff this file with its backup file or vice versa. 185 "Diff this file with its backup file or vice versa.
100 Uses the latest backup, if there are several numerical backups. 186 Uses the latest backup, if there are several numerical backups.
101 If this file is a backup, diff it with its original. 187 If this file is a backup, diff it with its original.
102 The backup file is the first file given to `diff'." 188 The backup file is the first file given to `diff'."
103 (interactive "fDiff (file with backup): ") 189 (interactive (list (read-file-name "Diff (file with backup): ")
190 (if current-prefix-arg
191 (read-string "Diff switches: "
192 (if (stringp diff-switches)
193 diff-switches
194 (mapconcat 'identity
195 diff-switches " ")))
196 nil)))
104 (let (bak ori) 197 (let (bak ori)
105 (if (backup-file-name-p file) 198 (if (backup-file-name-p file)
106 (setq bak file 199 (setq bak file
107 ori (file-name-sans-versions file)) 200 ori (file-name-sans-versions file))
108 (setq bak (or (diff-latest-backup-file file) 201 (setq bak (or (diff-latest-backup-file file)
109 (error "No backup found for %s" file)) 202 (error "No backup found for %s" file))
110 ori file)) 203 ori file))
111 (diff bak ori))) 204 (diff bak ori switches)))
112 205
113 (defun diff-latest-backup-file (fn) ; actually belongs into files.el 206 (defun diff-latest-backup-file (fn) ; actually belongs into files.el
114 "Return the latest existing backup of FILE, or nil." 207 "Return the latest existing backup of FILE, or nil."
115 ;; First try simple backup, then the highest numbered of the 208 ;; First try simple backup, then the highest numbered of the
116 ;; numbered backups. 209 ;; numbered backups.
131 (function 224 (function
132 (lambda (fn1 fn2) 225 (lambda (fn1 fn2)
133 (> (backup-extract-version fn1) 226 (> (backup-extract-version fn1)
134 (backup-extract-version fn2)))))))))) 227 (backup-extract-version fn2))))))))))
135 228
136 (defun diff-internal-diff (diff-command sw strip)
137 (let ((buffer-read-only nil))
138 (with-output-to-temp-buffer "*Diff Output*"
139 (buffer-disable-undo standard-output)
140 (save-excursion
141 (set-buffer standard-output)
142 (erase-buffer)
143 (apply 'call-process diff-command nil t nil sw)))
144 (set-buffer "*Diff Output*")
145 (goto-char (point-min))
146 (while sw
147 (if (string= (car sw) "-c")
148 ;; strip leading filenames from context diffs
149 (progn (forward-line 2) (delete-region (point-min) (point))))
150 (if (and (string= (car sw) "-C") (string= "sccs" diff-command))
151 ;; strip stuff from SCCS context diffs
152 (progn (forward-line 2) (delete-region (point-min) (point))))
153 (setq sw (cdr sw)))
154 (if strip
155 ;; strip stuff from SCCS context diffs
156 (progn (forward-line strip) (delete-region (point-min) (point)))))
157 (diff-mode)
158 (if (string= "0" diff-total-differences)
159 (let ((buffer-read-only nil))
160 (insert (message "There are no differences.")))
161 (narrow-to-region (point) (progn
162 (forward-line 1)
163 (if (re-search-forward diff-search-pattern
164 nil t)
165 (goto-char (match-beginning 0))
166 (goto-char (point-max)))))
167 (setq diff-current-difference "1")))
168
169 ;; Take a buffer full of Unix diff output and go into a mode to easily
170 ;; see the next and previous difference
171 (defun diff-mode ()
172 "Diff Mode is used by \\[diff] for perusing the output from the diff program.
173 All normal editing commands are turned off. Instead, these are available:
174 \\<diff-mode-map>
175 \\[diff-beginning-of-diff] Move point to start of this difference.
176 \\[scroll-up] Scroll to next screen of this difference.
177 \\[scroll-down] Scroll to previous screen of this difference.
178 \\[diff-next-difference] Move to Next Difference.
179 \\[diff-previous-difference] Move to Previous Difference.
180 \\[diff-show-difference] Jump to difference specified by numeric position.
181 "
182 (interactive)
183 (use-local-map diff-mode-map)
184 (setq buffer-read-only t
185 major-mode 'diff-mode
186 mode-name "Diff"
187 mode-line-modified "--- "
188 mode-line-process
189 '(" " diff-current-difference "/" diff-total-differences))
190 (make-local-variable 'diff-current-difference)
191 (set (make-local-variable 'diff-total-differences)
192 (int-to-string (diff-count-differences))))
193
194 (defun diff-next-difference (n)
195 "Go to the beginning of the next difference.
196 Differences are delimited by `diff-search-pattern'."
197 (interactive "p")
198 (if (< n 0) (diff-previous-difference (- n))
199 (if (zerop n) ()
200 (goto-char (point-min))
201 (forward-line 1) ; to get past the match for the start of this diff
202 (widen)
203 (if (re-search-forward diff-search-pattern nil 'move n)
204 (let ((start (goto-char (match-beginning 0))))
205 (forward-line 1)
206 (if (re-search-forward diff-search-pattern nil 'move)
207 (goto-char (match-beginning 0)))
208 (narrow-to-region start (point))
209 (setq diff-current-difference
210 (int-to-string (+ n (string-to-int
211 diff-current-difference)))))
212 (re-search-backward diff-search-pattern nil)
213 (narrow-to-region (point) (point-max))
214 (message "No following differences.")
215 (setq diff-current-difference diff-total-differences))
216 (goto-char (point-min)))))
217
218 (defun diff-previous-difference (n)
219 "Go the the beginning of the previous difference.
220 Differences are delimited by `diff-search-pattern'."
221 (interactive "p")
222 (if (< n 0) (diff-next-difference (- n))
223 (if (zerop n) ()
224 (goto-char (point-min))
225 (widen)
226 (if (re-search-backward diff-search-pattern nil 'move n)
227 (setq diff-current-difference
228 (int-to-string (- (string-to-int diff-current-difference) n)))
229 (message "No previous differences.")
230 (setq diff-current-difference "1"))
231 (narrow-to-region (point) (progn
232 (forward-line 1)
233 (re-search-forward diff-search-pattern nil)
234 (goto-char (match-beginning 0))))
235 (goto-char (point-min)))))
236
237 (defun diff-show-difference (n)
238 "Show difference number N (prefix argument)."
239 (interactive "p")
240 (let ((cur (string-to-int diff-current-difference)))
241 (cond ((or (= n cur)
242 (zerop n)
243 (not (natnump n))) ; should signal an error perhaps.
244 ;; just redisplay.
245 (goto-char (point-min)))
246 ((< n cur)
247 (diff-previous-difference (- cur n)))
248 ((> n cur)
249 (diff-next-difference (- n cur))))))
250
251 (defun diff-beginning-of-diff ()
252 "Go to beginning of current difference."
253 (interactive)
254 (goto-char (point-min)))
255
256 ;; This function counts up the number of differences in the buffer.
257 (defun diff-count-differences ()
258 "Count number of differences in the current buffer."
259 (message "Counting differences...")
260 (save-excursion
261 (save-restriction
262 (widen)
263 (goto-char (point-min))
264 (let ((cnt 0))
265 (while (re-search-forward diff-search-pattern nil t)
266 (setq cnt (1+ cnt)))
267 (message "Counting differences...done (%d)" cnt)
268 cnt))))
269
270 ;;; diff.el ends here 229 ;;; diff.el ends here