Mercurial > hg > xemacs-beta

comparison lisp/packages/diff.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; diff.el --- Run `diff' in compilation-mode.
2
3 ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
4
5 ;; Keywords: unix, tools
6
7 ;; This file is part of XEmacs.
8
9 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; XEmacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
23 ;;; Synched up with: FSF 19.30.
24
25 ;;; Commentary:
26
27 ;; This package helps you explore differences between files, using the
28 ;; UNIX command diff(1). The commands are `diff' and `diff-backup'.
29 ;; You can specify options with `diff-switches'.
30
31 ;;; Code:
32
33 (require 'compile)
34
35 ;;; This is duplicated in vc.el.
36 ;;;###autoload
37 (defvar diff-switches (purecopy "-c")
38 "*A string or list of strings specifying switches to be be passed to diff.")
39
40 (defvar diff-command "diff"
41 "*The command to use to run diff.")
42
43 (defvar diff-regexp-alist
44 '(
45 ;; -u format: @@ -OLDSTART,OLDEND +NEWSTART,NEWEND @@
46 ("^@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@$" 1 2)
47
48 ;; -c format: *** OLDSTART,OLDEND ****
49 ("^\\*\\*\\* \\([0-9]+\\),[0-9]+ \\*\\*\\*\\*$" 1 nil)
50 ;; --- NEWSTART,NEWEND ----
51 ("^--- \\([0-9]+\\),[0-9]+ ----$" nil 1)
52
53 ;; plain diff format: OLDSTART[,OLDEND]{a,d,c}NEWSTART[,NEWEND]
54 ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)\\(,[0-9]+\\)?$" 1 3)
55
56 ;; -e (ed) format: OLDSTART[,OLDEND]{a,d,c}
57 ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]$" 1)
58
59 ;; -f format: {a,d,c}OLDSTART[ OLDEND]
60 ;; -n format: {a,d,c}OLDSTART LINES-CHANGED
61 ("^[adc]\\([0-9]+\\)\\( [0-9]+\\)?$" 1)
62 )
63 "Alist (REGEXP OLD-IDX NEW-IDX) of regular expressions to match difference
64 sections in \\[diff] output. If REGEXP matches, the OLD-IDX'th
65 subexpression gives the line number in the old file, and NEW-IDX'th
66 subexpression gives the line number in the new file. If OLD-IDX or NEW-IDX
67 is nil, REGEXP matches only half a section.")
68
69 (defvar diff-old-file nil
70 "This is the old file name in the comparison in this buffer.")
71 (defvar diff-new-file nil
72 "This is the new file name in the comparison in this buffer.")
73 (defvar diff-old-temp-file nil
74 "This is the name of a temp file to be deleted after diff finishes.")
75 (defvar diff-new-temp-file nil
76 "This is the name of a temp file to be deleted after diff finishes.")
77
78 ;; See compilation-parse-errors-function (compile.el).
79 (defun diff-parse-differences (limit-search find-at-least)
80 (setq compilation-error-list nil)
81 (message "Parsing differences...")
82
83 ;; Don't reparse diffs already seen at last parse.
84 (if compilation-parsing-end (goto-char compilation-parsing-end))
85
86 ;; Construct in REGEXP a regexp composed of all those in dired-regexp-alist.
87 (let ((regexp (mapconcat #'(lambda (elt)
88 (concat "\\(" (car elt) "\\)"))
89 diff-regexp-alist
90 "\\|"))
91 ;; (GROUP-IDX OLD-IDX NEW-IDX)
92 (groups (let ((subexpr 1))
93 (mapcar #'(lambda (elt)
94 (prog1
95 (cons subexpr
96 (mapcar #'(lambda (n)
97 (and n
98 (+ subexpr n)))
99 (cdr elt)))
100 (setq subexpr (+ subexpr 1
101 ;;#### undefined??
102 (count-regexp-groupings
103 (car elt))))))
104 diff-regexp-alist)))
105
106 (new-error
107 (function (lambda (file subexpr)
108 (setq compilation-error-list
109 (cons
110 (cons (save-excursion
111 ;; Report location of message
112 ;; at beginning of line.
113 (goto-char
114 (match-beginning subexpr))
115 (beginning-of-line)
116 (point-marker))
117 ;; Report location of corresponding text.
118 (let ((line (string-to-int
119 (buffer-substring
120 (match-beginning subexpr)
121 (match-end subexpr)))))
122 (save-excursion
123 (save-match-data
124 (set-buffer (find-file-noselect file)))
125 (save-excursion
126 (goto-line line)
127 (point-marker)))))
128 compilation-error-list)))))
129
130 (found-desired nil)
131 (num-loci-found 0)
132 g)
133
134 (while (and (not found-desired)
135 ;; We don't just pass LIMIT-SEARCH to re-search-forward
136 ;; because we want to find matches containing LIMIT-SEARCH
137 ;; but which extend past it.
138 (re-search-forward regexp nil t))
139
140 ;; Find which individual regexp matched.
141 (setq g groups)
142 (while (and g (null (match-beginning (car (car g)))))
143 (setq g (cdr g)))
144 (setq g (car g))
145
146 (if (nth 1 g) ;OLD-IDX
147 (funcall new-error diff-old-file (nth 1 g)))
148 (if (nth 2 g) ;NEW-IDX
149 (funcall new-error diff-new-file (nth 2 g)))
150
151 (setq num-loci-found (1+ num-loci-found))
152 (if (or (and find-at-least
153 (>= num-loci-found find-at-least))
154 (and limit-search (>= (point) limit-search)))
155 ;; We have found as many new loci as the user wants,
156 ;; or the user wanted a specific diff, and we're past it.
157 (setq found-desired t)))
158 (if found-desired
159 (setq compilation-parsing-end (point))
160 ;; Set to point-max, not point, so we don't perpetually
161 ;; parse the last bit of text when it isn't a diff header.
162 (setq compilation-parsing-end (point-max)))
163 (message "Parsing differences...done"))
164 (setq compilation-error-list (nreverse compilation-error-list)))
165
166 ;;;###autoload
167 (defun diff (old new &optional switches)
168 "Find and display the differences between OLD and NEW files.
169 Interactively the current buffer's file name is the default for NEW
170 and a backup file for NEW is the default for OLD.
171 With prefix arg, prompt for diff switches."
172 (interactive
173 (nconc
174 (let (oldf newf)
175 (nreverse
176 (list
177 (setq newf (buffer-file-name)
178 newf (if (and newf (file-exists-p newf))
179 (read-file-name
180 (concat "Diff new file: ("
181 (file-name-nondirectory newf) ") ")
182 nil newf t)
183 (read-file-name "Diff new file: " nil nil t)))
184 (setq oldf (file-newest-backup newf)
185 oldf (if (and oldf (file-exists-p oldf))
186 (read-file-name
187 (concat "Diff original file: ("
188 (file-name-nondirectory oldf) ") ")
189 (file-name-directory oldf) oldf t)
190 (read-file-name "Diff original file: "
191 (file-name-directory newf) nil t))))))
192 (if current-prefix-arg
193 (list (read-string "Diff switches: "
194 (if (stringp diff-switches)
195 diff-switches
196 (mapconcat 'identity diff-switches " "))))
197 nil)))
198 (setq new (expand-file-name new)
199 old (expand-file-name old))
200 ;; XEmacs addition -- allow (diff "../old/" "new-file.el") to work
201 (cond ((file-directory-p old)
202 (or (file-directory-p new)
203 (setq old (expand-file-name (file-name-nondirectory new)
204 (file-name-as-directory old)))))
205 ((file-directory-p new)
206 (setq new (expand-file-name (file-name-nondirectory old)
207 (file-name-as-directory new)))))
208 (let ((old-alt (file-local-copy old))
209 (new-alt (file-local-copy new))
210 buf)
211 (unwind-protect
212 (let ((command
213 (mapconcat 'identity
214 (append (list diff-command)
215 ;; Use explicitly specified switches
216 (if switches
217 (if (consp switches)
218 switches (list switches))
219 ;; If not specified, use default.
220 (if (consp diff-switches)
221 diff-switches
222 (list diff-switches)))
223 (if (or old-alt new-alt)
224 (list "-L" old "-L" new))
225 (list
226 (shell-quote-argument (or old-alt old)))
227 (list
228 (shell-quote-argument (or new-alt new))))
229 " ")))
230 (setq buf
231 (compile-internal command
232 "No more differences" "Diff"
233 'diff-parse-differences))
234 (pop-to-buffer buf)
235 (set (make-local-variable 'diff-old-file) old)
236 (set (make-local-variable 'diff-new-file) new)
237 (set (make-local-variable 'diff-old-temp-file) old-alt)
238 (set (make-local-variable 'diff-new-temp-file) new-alt)
239 (set (make-local-variable 'compilation-finish-function)
240 (function (lambda (buff msg)
241 (if diff-old-temp-file
242 (delete-file diff-old-temp-file))
243 (if diff-new-temp-file
244 (delete-file diff-new-temp-file)))))
245 buf))))
246
247 ;;;###autoload
248 (defun diff-backup (file &optional switches)
249 "Diff this file with its backup file or vice versa.
250 Uses the latest backup, if there are several numerical backups.
251 If this file is a backup, diff it with its original.
252 The backup file is the first file given to `diff'."
253 (interactive (list (read-file-name "Diff (file with backup): ")
254 (if current-prefix-arg
255 (read-string "Diff switches: "
256 (if (stringp diff-switches)
257 diff-switches
258 (mapconcat 'identity
259 diff-switches " ")))
260 nil)))
261 (let (bak ori)
262 (if (backup-file-name-p file)
263 (setq bak file
264 ori (file-name-sans-versions file))
265 (setq bak (or (diff-latest-backup-file file)
266 (error "No backup found for %s" file))
267 ori file))
268 (diff bak ori switches)))
269
270 (defun diff-latest-backup-file (fn) ; actually belongs into files.el
271 "Return the latest existing backup of FILE, or nil."
272 (let ((handler (find-file-name-handler fn 'diff-latest-backup-file)))
273 (if handler
274 (funcall handler 'diff-latest-backup-file fn)
275 ;; First try simple backup, then the highest numbered of the
276 ;; numbered backups.
277 ;; Ignore the value of version-control because we look for existing
278 ;; backups, which maybe were made earlier or by another user with
279 ;; a different value of version-control.
280 (setq fn (file-chase-links (expand-file-name fn)))
281 (or
282 (let ((bak (make-backup-file-name fn)))
283 (if (file-exists-p bak) bak))
284 ;; We use BACKUPNAME to cope with backups stored in a different dir.
285 (let* ((backupname (car (find-backup-file-name fn)))
286 (dir (file-name-directory backupname))
287 (base-versions (concat (file-name-sans-versions
288 (file-name-nondirectory backupname))
289 ".~"))
290 (bv-length (length base-versions)))
291 (concat dir
292 (car (sort
293 (file-name-all-completions base-versions dir)
294 ;; bv-length is a fluid var for backup-extract-version:
295 (function
296 (lambda (fn1 fn2)
297 (> (backup-extract-version fn1)
298 (backup-extract-version fn2))))))))))))
299
300 (provide 'diff)
301
302 ;;; diff.el ends here