comparison lisp/packages/diff.el @ 100:4be1180a9e89 r20-1b2

Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 131b0175ea99
children cf808b4c4290
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
1 ;;; diff.el --- Run `diff' in compilation-mode. 1 ;; -*-Emacs-Lisp-*-
2 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. 3 ;;
4 4 ;; File: diff.el
5 ;; Keywords: unix, tools 5 ;; Version: $Revision: 1.2 $
6 6 ;; Author: This file is based on diff.el by
7 ;; This file is part of XEmacs. 7 ;; sunpitt!wpmstr!fbresz@Sun.COM 1/27/89.
8 8 ;; It has been completely rewritten in July 1994 by
9 ;; XEmacs is free software; you can redistribute it and/or modify it 9 ;; Sandy Rutherford <sandy@ibm550.sissa.it>
10 ;; under the terms of the GNU General Public License as published by 10 ;; RCS:
11 ;; the Free Software Foundation; either version 2, or (at your option) 11 ;; Description: diff-mode for handling output from unix diff utility.
12 ;; any later version. 12 ;; Modified: Wed Jul 17 10:26:57 1996 (Andy Norman) ange@hplb.hpl.hp.com
13 13 ;;
14 ;; XEmacs is distributed in the hope that it will be useful, but 14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 15
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 ;;; Copyright (C) 1990 Free Software Foundation, Inc.
17 ;; General Public License for more details. 17 ;;; Copyright (C) 1994 Sandy Rutherford
18 18
19 ;; You should have received a copy of the GNU General Public License 19 ;;; This file is based on diff.el by sunpitt!wpmstr!fbresz@Sun.COM 1/27/89.
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free 20 ;;; It has been completely rewritten in July 1994 by
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 ;;; Sandy Rutherford <sandy@ibm550.sissa.it>
22 ;; 02111-1307, USA. 22
23 23 ;;; This program is free software; you can redistribute it and/or modify
24 ;;; Synched up with: FSF 19.34. 24 ;;; it under the terms of the GNU General Public License as published by
25 25 ;;; the Free Software Foundation; either version 1, or (at your option)
26 ;;; Commentary: 26 ;;; any later version.
27 27 ;;;
28 ;; This package helps you explore differences between files, using the 28 ;;; This program is distributed in the hope that it will be useful,
29 ;; UNIX command diff(1). The commands are `diff' and `diff-backup'. 29 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
30 ;; You can specify options with `diff-switches'. 30 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
31 31 ;;; GNU General Public License for more details.
32 ;;; Code: 32 ;;;
33 33 ;;; A copy of the GNU General Public License can be obtained from this
34 (require 'compile) 34 ;;; program's author (send electronic mail to sandy@ibm550.sissa.it) or
35 35 ;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
36 ;;; This is duplicated in vc.el. 36 ;;; MA 02139, USA.
37 ;;;###autoload 37
38 (defvar diff-switches (purecopy "-c") 38 (provide 'diff)
39 "*A string or list of strings specifying switches to be passed to diff.") 39
40 40 ;;; User Variables
41 (defvar diff-command "diff" 41
42 "*The command to use to run diff.") 42 ;; should be in to loaddefs.el now.
43 43 (defvar diff-switches nil
44 (defvar diff-regexp-alist 44 "*A list of switches (strings) to pass to the diff program.")
45 '( 45
46 ;; -u format: @@ -OLDSTART,OLDEND +NEWSTART,NEWEND @@ 46 (defvar diff-do-narrow nil
47 ("^@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@$" 1 2) 47 "*If non-nil diff buffers are initialized narrowed to each difference.")
48 48
49 ;; -c format: *** OLDSTART,OLDEND **** 49 (defvar diff-load-hooks nil
50 ("^\\*\\*\\* \\([0-9]+\\),[0-9]+ \\*\\*\\*\\*$" 1 nil) 50 "Hooks to run after loading diff.el")
51 ;; --- NEWSTART,NEWEND ---- 51
52 ("^--- \\([0-9]+\\),[0-9]+ ----$" nil 1) 52 ;;; Internal variables
53 53
54 ;; plain diff format: OLDSTART[,OLDEND]{a,d,c}NEWSTART[,NEWEND] 54 (defconst diff-emacs-19-p
55 ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)\\(,[0-9]+\\)?$" 1 3) 55 (let ((ver (string-to-int (substring emacs-version 0 2))))
56 56 (>= ver 19)))
57 ;; -e (ed) format: OLDSTART[,OLDEND]{a,d,c} 57
58 ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]$" 1) 58 (or diff-emacs-19-p (require 'emacs-19))
59 59
60 ;; -f format: {a,d,c}OLDSTART[ OLDEND] 60 (defvar diff-old-file nil)
61 ;; -n format: {a,d,c}OLDSTART LINES-CHANGED 61 ;; A list whose car is the name of the old file, and whose cdr indicates
62 ("^[adc]\\([0-9]+\\)\\( [0-9]+\\)?$" 1) 62 ;; whether we should delete the buffer on quit.
63 ) 63 (defvar diff-new-file nil)
64 "Alist (REGEXP OLD-IDX NEW-IDX) of regular expressions to match difference 64 ;; Same as diff-old-file, except for the new file.
65 sections in \\[diff] output. If REGEXP matches, the OLD-IDX'th 65 (defvar diff-total-differences "0")
66 subexpression gives the line number in the old file, and NEW-IDX'th 66 ;; Total number of difference hunks as a string.
67 subexpression gives the line number in the new file. If OLD-IDX or NEW-IDX 67 (defvar diff-current-difference "0")
68 is nil, REGEXP matches only half a section.") 68 ;; Current difference hunk as a string.
69 69 (defvar diff-current-hunk 0)
70 (defvar diff-old-file nil 70 ;; Current difference hunk as an integer.
71 "This is the old file name in the comparison in this buffer.") 71 (defvar diff-total-hunks 0)
72 (defvar diff-new-file nil 72 ;; Total number of difference hunks as an integer.
73 "This is the new file name in the comparison in this buffer.") 73 (defvar diff-hunk-vector (vector 0))
74 (defvar diff-old-temp-file nil 74 ;; Vector storing the starting positions of the difference hunks.
75 "This is the name of a temp file to be deleted after diff finishes.") 75 (defvar diff-old-file-pattern nil)
76 (defvar diff-new-temp-file nil 76 (defvar diff-new-file-pattern nil)
77 "This is the name of a temp file to be deleted after diff finishes.") 77 (defvar diff-hunk-pattern nil)
78 78 ;; Regexps to use when parsing file lines in difference hunks.
79 ;; See compilation-parse-errors-function (compile.el). 79
80 (defun diff-parse-differences (limit-search find-at-least) 80
81 (setq compilation-error-list nil) 81 (defvar diff-search-pattern-alist
82 (message "Parsing differences...") 82 (list
83 83 (list ?e "^[0-9]\\(,[0-9]+\\)?[acd]$" "^\\([0-9]+\\)" nil)
84 ;; Don't reparse diffs already seen at last parse. 84 (list ?c "^\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\n"
85 (if compilation-parsing-end (goto-char compilation-parsing-end)) 85 "^\\*+ \\([0-9]+\\)" "^-+ \\([0-9]+\\)")
86 86 (list ?u "^@@ " "^@@ -\\([0-9]+\\)" "^@@ -[0-9,]+ \\+\\([0-9]+\\)")
87 ;; Construct in REGEXP a regexp composed of all those in dired-regexp-alist. 87 (list nil "^[0-9]+" "^\\([0-9]+\\)" "^[0-9,]+[acd]\\([0-9]+\\)")))
88 (let ((regexp (mapconcat #'(lambda (elt) 88
89 (concat "\\(" (car elt) "\\)")) 89 (defvar diff-keymap-grokked nil)
90 diff-regexp-alist 90
91 "\\|")) 91 (defvar diff-temp-template "/tmp/diff")
92 ;; (GROUP-IDX OLD-IDX NEW-IDX) 92
93 (groups (let ((subexpr 1)) 93 ;; Initialize the keymap if it isn't already
94 (mapcar #'(lambda (elt) 94
95 (prog1 95 (defvar diff-mode-map nil
96 (cons subexpr 96 "Keymap used in diff mode.")
97 (mapcar #'(lambda (n) 97
98 (and n 98 (if diff-mode-map
99 (+ subexpr n))) 99 nil
100 (cdr elt))) 100 (setq diff-mode-map (make-keymap))
101 (setq subexpr (+ subexpr 1 101 (suppress-keymap diff-mode-map)
102 ;;#### undefined?? 102 (define-key diff-mode-map "?" 'describe-mode)
103 (count-regexp-groupings 103 (define-key diff-mode-map "." 'diff-display-file)
104 (car elt)))))) 104 (define-key diff-mode-map "N" 'diff-narrow)
105 diff-regexp-alist))) 105 (define-key diff-mode-map "W" 'widen)
106 106 (define-key diff-mode-map "f" 'diff-find-file)
107 (new-error 107 (define-key diff-mode-map "h" 'diff-show-header)
108 (function (lambda (file subexpr) 108 (define-key diff-mode-map "j" 'diff-show-difference)
109 (setq compilation-error-list 109 (define-key diff-mode-map "n" 'diff-next-difference)
110 (cons 110 (define-key diff-mode-map "o" 'diff-find-file-other-window)
111 (cons (save-excursion 111 (define-key diff-mode-map "p" 'diff-previous-difference)
112 ;; Report location of message 112 (define-key diff-mode-map "q" 'diff-quit)
113 ;; at beginning of line. 113 (define-key diff-mode-map "w" 'diff-find-file-other-frame)
114 (goto-char 114 (define-key diff-mode-map "\C-c\C-c" 'diff-find-file-other-window)
115 (match-beginning subexpr)) 115 (define-key diff-mode-map " " 'diff-advertised-scroll-up)
116 (beginning-of-line) 116 (define-key diff-mode-map "\177" 'diff-advertised-scroll-down)
117 (point-marker)) 117 (define-key diff-mode-map "\C-n" 'diff-next-line)
118 ;; Report location of corresponding text. 118 (define-key diff-mode-map "\C-p" 'diff-previous-line)
119 (let ((line (string-to-int 119 (define-key diff-mode-map "\M->" 'diff-end-of-buffer)
120 (buffer-substring 120 (define-key diff-mode-map "\M-<" 'diff-beginning-of-buffer))
121 (match-beginning subexpr) 121
122 (match-end subexpr))))) 122 ;;; Internal functions
123 (save-excursion 123
124 (save-match-data 124 (defun diff-grok-keys (to-command from-command)
125 (set-buffer (find-file-noselect file))) 125 ;; Assigns to TO-COMMAND the keys for the global binding of FROM-COMMAND.
126 (save-excursion 126 ;; Does not clobber anything in the local keymap.
127 (goto-line line) 127 (let ((keys (where-is-internal from-command)))
128 (point-marker))))) 128 (while keys
129 compilation-error-list))))) 129 (condition-case nil
130 130 (if (eq (global-key-binding (car keys)) (key-binding (car keys)))
131 (found-desired nil) 131 (local-set-key (car keys) to-command))
132 (num-loci-found 0) 132 (error nil))
133 g) 133 (setq keys (cdr keys)))))
134 134
135 (while (and (not found-desired) 135 (defun diff-grok-keymap ()
136 ;; We don't just pass LIMIT-SEARCH to re-search-forward 136 (if diff-keymap-grokked
137 ;; because we want to find matches containing LIMIT-SEARCH 137 ()
138 ;; but which extend past it. 138 (if (and term-setup-hook (boundp 'command-line-args-left))
139 (re-search-forward regexp nil t)) 139 (progn
140 140 (if diff-emacs-19-p
141 ;; Find which individual regexp matched. 141 (run-hooks term-setup-hook)
142 (setq g groups) 142 (funcall term-setup-hook))
143 (while (and g (null (match-beginning (car (car g))))) 143 (setq term-setup-hook nil)))
144 (setq g (cdr g))) 144 (setq diff-keymap-grokked t)
145 (setq g (car g)) 145 (diff-grok-keys 'diff-next-line 'next-line)
146 146 (diff-grok-keys 'diff-previous-line 'previous-line)
147 (if (nth 1 g) ;OLD-IDX 147 (diff-grok-keys 'diff-forward-char 'forward-char)
148 (funcall new-error diff-old-file (nth 1 g))) 148 (diff-grok-keys 'diff-backward-char 'backward-char)
149 (if (nth 2 g) ;NEW-IDX 149 (diff-grok-keys 'diff-scroll-up 'scroll-up)
150 (funcall new-error diff-new-file (nth 2 g))) 150 (diff-grok-keys 'diff-scroll-down 'scroll-down)
151 151 (diff-grok-keys 'diff-beginning-of-buffer 'beginning-of-buffer)
152 (setq num-loci-found (1+ num-loci-found)) 152 (diff-grok-keys 'diff-end-of-buffer 'end-of-buffer)))
153 (if (or (and find-at-least 153
154 (>= num-loci-found find-at-least)) 154 (defun diff-buffer-narrowed-p ()
155 (and limit-search (>= (point) limit-search))) 155 ;; Returns t if the current buffer is narrowed
156 ;; We have found as many new loci as the user wants, 156 (save-restriction
157 ;; or the user wanted a specific diff, and we're past it. 157 (let ((min (point-min))
158 (setq found-desired t))) 158 (max (point-max)))
159 (if found-desired 159 (widen)
160 (setq compilation-parsing-end (point)) 160 (not (and (= min (point-min)) (= max (point-max)))))))
161 ;; Set to point-max, not point, so we don't perpetually 161
162 ;; parse the last bit of text when it isn't a diff header. 162 (defun diff-current-hunk ()
163 (setq compilation-parsing-end (point-max))) 163 ;; Returns the current diff hunk.
164 (message "Parsing differences...done")) 164 (let ((pt (point))
165 (setq compilation-error-list (nreverse compilation-error-list))) 165 (start 0)
166 166 (end (1+ diff-total-hunks))
167 ;;;###autoload 167 m)
168 (defun diff (old new &optional switches) 168 (while (> (- end start) 1)
169 "Find and display the differences between OLD and NEW files. 169 (setq m (/ (+ start end) 2))
170 Interactively the current buffer's file name is the default for NEW 170 (if (>= pt (aref diff-hunk-vector m))
171 and a backup file for NEW is the default for OLD. 171 (setq start m)
172 With prefix arg, prompt for diff switches." 172 (setq end m)))
173 (interactive 173 (if (>= pt (aref diff-hunk-vector end))
174 (nconc 174 (setq m end)
175 (let (oldf newf) 175 (setq m start))
176 (nreverse 176 ;; Don't treat end of buffer as start of next hunk
177 (list 177 (if (eobp) (1- m) m)))
178 (setq newf (buffer-file-name) 178
179 (defun diff-hunk-min (n)
180 ;; Returns the start of the current diff hunk.
181 (aref diff-hunk-vector n))
182
183 (defun diff-hunk-max (n)
184 ;; Returns the end of the current diff hunk.
185 (aref diff-hunk-vector (1+ n)))
186
187 (defun diff-parse-hunks ()
188 ;; Parses a buffer of diff output.
189 (save-excursion
190 (save-restriction
191 (message "Parsing differences...")
192 (widen)
193 (goto-char (point-min))
194 (let ((hunks (list 1)))
195 (while (re-search-forward diff-hunk-pattern nil t)
196 (setq hunks (cons (match-beginning 0) hunks)))
197 (setq diff-total-hunks (1- (length hunks))
198 diff-hunk-vector (apply 'vector
199 (nreverse (cons (point-max) hunks)))))))
200 (message "Parsing differences...done"))
201
202 (defun diff-update-modeline ()
203 ;; Updates the mode line to show current diff hunk.
204 (if (or (< (point) (diff-hunk-min diff-current-hunk))
205 (>= (point) (diff-hunk-max diff-current-hunk)))
206 (progn
207 (setq diff-current-hunk (diff-current-hunk)
208 diff-current-difference (int-to-string diff-current-hunk))
209 (set-buffer-modified-p (buffer-modified-p)))))
210
211 (defun diff-read-args (oldprompt newprompt switchprompt
212 &optional file-for-backup)
213 ;; Grab the args for diff. OLDPROMPT and NEWPROMPT are the prompts
214 ;; for the old & new filenames, SWITCHPROMPT for the list of
215 ;; switches. If FILE_FOR_BACKUP is provided (it must be a string if
216 ;; so), then it will be used to try & work out a file & backup to
217 ;; diff, & in this case the prompting order is backwards. %s in a
218 ;; prompt has a guess substituted into it. This is nasty.
219 (let (oldf newf)
220 (if file-for-backup
221 (setq newf file-for-backup
179 newf (if (and newf (file-exists-p newf)) 222 newf (if (and newf (file-exists-p newf))
180 (read-file-name 223 (read-file-name
181 (concat "Diff new file: (" 224 (format newprompt (file-name-nondirectory newf))
182 (file-name-nondirectory newf) ") ")
183 nil newf t) 225 nil newf t)
184 (read-file-name "Diff new file: " nil nil t))) 226 (read-file-name (format newprompt "") nil nil t))
185 (setq oldf (file-newest-backup newf) 227 oldf (file-newest-backup newf)
186 oldf (if (and oldf (file-exists-p oldf)) 228 oldf (if (and oldf (file-exists-p oldf))
187 (read-file-name 229 (read-file-name
188 (concat "Diff original file: (" 230 (format oldprompt (file-name-nondirectory oldf))
189 (file-name-nondirectory oldf) ") ") 231 nil oldf t)
190 (file-name-directory oldf) oldf t) 232 (read-file-name (format oldprompt "")
191 (read-file-name "Diff original file: " 233 (file-name-directory newf) nil t)))
192 (file-name-directory newf) nil t)))))) 234 ;; Else we aren't trying to be bright...
193 (if current-prefix-arg 235 (setq oldf (read-file-name (format oldprompt "") nil nil t)
194 (list (read-string "Diff switches: " 236 newf (read-file-name
195 (if (stringp diff-switches) 237 (format newprompt (file-name-nondirectory oldf))
196 diff-switches 238 nil (file-name-directory oldf) t)))
197 (mapconcat 'identity diff-switches " ")))) 239 (list oldf newf (diff-read-switches switchprompt))))
198 nil))) 240
199 (setq new (expand-file-name new) 241 (defun diff-read-switches (switchprompt)
200 old (expand-file-name old)) 242 ;; Read and return a list of switches
201 ;; XEmacs addition -- allow (diff "../old/" "new-file.el") to work 243 (if current-prefix-arg
202 (cond ((file-directory-p old) 244 (let ((default (if (listp diff-switches)
203 (or (file-directory-p new) 245 (mapconcat 'identity diff-switches " ")
204 (setq old (expand-file-name (file-name-nondirectory new) 246 diff-switches)))
205 (file-name-as-directory old))))) 247 (diff-fix-switches
206 ((file-directory-p new) 248 (read-string (format switchprompt default) default)))))
207 (setq new (expand-file-name (file-name-nondirectory old) 249
208 (file-name-as-directory new))))) 250 (defun diff-fix-switches (switch-spec)
209 (let ((old-alt (file-local-copy old)) 251 ;; Parse a string into a list of switches or leave it be if it's
210 (new-alt (file-local-copy new)) 252 ;; not a string
211 buf) 253 (if (stringp switch-spec)
212 (unwind-protect 254 (let (result (start 0))
213 (let ((command 255 (while (string-match "\\(\\S-+\\)" switch-spec start)
214 (mapconcat 'identity 256 (setq result (cons (substring switch-spec (match-beginning 1)
215 (append (list diff-command) 257 (match-end 1))
216 ;; Use explicitly specified switches 258 result)
217 (if switches 259 start (match-end 0)))
218 (if (consp switches) 260 (nreverse result))
219 switches (list switches)) 261 switch-spec))
220 ;; If not specified, use default. 262
221 (if (consp diff-switches) 263 (defun diff-get-file-buffer (file)
222 diff-switches 264 ;; Returns \(BUFFER . DEL-P\), where DEL-P is t if diff is expected
223 (list diff-switches))) 265 ;; to delete the buffer, and nil otherwise.
224 (if (or old-alt new-alt) 266 (let* ((buff (get-file-buffer file))
225 (list "-L" old "-L" new)) 267 (del-p (null buff)))
226 (list 268 (if (and buff (buffer-modified-p buff))
227 (shell-quote-argument (or old-alt old))) 269 (progn
228 (list 270 (message
229 (shell-quote-argument (or new-alt new)))) 271 "Buffer %s is modified. Diffing against buffer contents."
230 " "))) 272 (buffer-name buff))
231 (setq buf 273 (sit-for 1)))
232 (compile-internal command 274 ;; Call find-file-noselect even if we already have the buffer,
233 "No more differences" "Diff" 275 ;; as it will run verify-buffer-file-modtime.
234 'diff-parse-differences)) 276 (cons (find-file-noselect file) del-p)))
235 (pop-to-buffer buf) 277
236 ;; Avoid frightening people with "abnormally terminated" 278 (defun diff-cleanup-buffers ()
237 ;; if diff finds differences. 279 ;; Cleans up diff buffers by deleting buffers that we don't expect
238 (set (make-local-variable 'compilation-exit-message-function) 280 ;; the user to care about.
239 (lambda (status code msg) 281 (let ((files (list diff-old-file diff-new-file)))
240 (cond ((not (eq status 'exit)) 282 (while files
241 (cons msg code)) 283 (let ((ent (car files))
242 ((zerop code) 284 buff)
243 '("finished (no differences)\n" . "no differences")) 285 (and (cdr ent)
244 ((= code 1) 286 (setq buff (get-file-buffer (car ent)))
245 '("finished\n" . "differences found")) 287 (not (buffer-modified-p buff))
246 (t 288 (kill-buffer buff)))
247 (cons msg code))))) 289 (setq files (cdr files)))
248 (set (make-local-variable 'diff-old-file) old) 290 (if (get-buffer "*Diff Header*")
249 (set (make-local-variable 'diff-new-file) new) 291 (kill-buffer "*Diff Header*"))))
250 (set (make-local-variable 'diff-old-temp-file) old-alt) 292
251 (set (make-local-variable 'diff-new-temp-file) new-alt) 293 (defun diff-latest-backup-file (file)
252 (set (make-local-variable 'compilation-finish-function)
253 (function (lambda (buff msg)
254 (if diff-old-temp-file
255 (delete-file diff-old-temp-file))
256 (if diff-new-temp-file
257 (delete-file diff-new-temp-file)))))
258 buf))))
259
260 ;;;###autoload
261 (defun diff-backup (file &optional switches)
262 "Diff this file with its backup file or vice versa.
263 Uses the latest backup, if there are several numerical backups.
264 If this file is a backup, diff it with its original.
265 The backup file is the first file given to `diff'."
266 (interactive (list (read-file-name "Diff (file with backup): ")
267 (if current-prefix-arg
268 (read-string "Diff switches: "
269 (if (stringp diff-switches)
270 diff-switches
271 (mapconcat 'identity
272 diff-switches " ")))
273 nil)))
274 (let (bak ori)
275 (if (backup-file-name-p file)
276 (setq bak file
277 ori (file-name-sans-versions file))
278 (setq bak (or (diff-latest-backup-file file)
279 (error "No backup found for %s" file))
280 ori file))
281 (diff bak ori switches)))
282
283 (defun diff-latest-backup-file (fn) ; actually belongs into files.el
284 "Return the latest existing backup of FILE, or nil." 294 "Return the latest existing backup of FILE, or nil."
285 (let ((handler (find-file-name-handler fn 'diff-latest-backup-file))) 295 ;; First try simple backup, then the highest numbered of the
296 ;; numbered backups.
297 ;; Ignore the value of version-control because we look for existing
298 ;; backups, which maybe were made earlier or by another user with
299 ;; a different value of version-control.
300 (let* ((file (expand-file-name file))
301 (handler (find-file-name-handler file 'diff-latest-backup-file)))
286 (if handler 302 (if handler
287 (funcall handler 'diff-latest-backup-file fn) 303 (funcall handler 'diff-latest-backup-file file)
288 ;; First try simple backup, then the highest numbered of the
289 ;; numbered backups.
290 ;; Ignore the value of version-control because we look for existing
291 ;; backups, which maybe were made earlier or by another user with
292 ;; a different value of version-control.
293 (setq fn (file-chase-links (expand-file-name fn)))
294 (or 304 (or
295 (let ((bak (make-backup-file-name fn))) 305 (let ((bak (make-backup-file-name file)))
296 (if (file-exists-p bak) bak)) 306 (if (file-exists-p bak) bak))
297 ;; We use BACKUPNAME to cope with backups stored in a different dir. 307 (let* ((dir (file-name-directory file))
298 (let* ((backupname (car (find-backup-file-name fn))) 308 (base-versions (concat (file-name-nondirectory file) ".~"))
299 (dir (file-name-directory backupname))
300 (base-versions (concat (file-name-sans-versions
301 (file-name-nondirectory backupname))
302 ".~"))
303 (bv-length (length base-versions))) 309 (bv-length (length base-versions)))
304 (concat dir 310 (concat dir
305 (car (sort 311 (car (sort
306 (file-name-all-completions base-versions dir) 312 (file-name-all-completions base-versions dir)
307 ;; bv-length is a fluid var for backup-extract-version: 313 ;; bv-length is a fluid var for backup-extract-version:
308 (function 314 (function
309 (lambda (fn1 fn2) 315 (lambda (fn1 fn2)
310 (> (backup-extract-version fn1) 316 (> (backup-extract-version fn1)
311 (backup-extract-version fn2)))))))))))) 317 (backup-extract-version fn2))))))))))))
312 318
313 (provide 'diff) 319 (defun diff-file-line (&optional old-file-p)
314 320 "Return line number of current hunk in `diff-new-file'.
315 ;;; diff.el ends here 321 With optional argument OLD-FILE-P, use `diff-old-file' instead."
322 (save-excursion
323 (let ((min (diff-hunk-min diff-current-hunk))
324 (max (diff-hunk-max diff-current-hunk))
325 (regexp (if old-file-p diff-old-file-pattern diff-new-file-pattern)))
326 (goto-char min)
327 (or (and regexp (re-search-forward regexp max t))
328 (error "Unable to locate a file line for %s file."
329 (if old-file-p "old" "new")))
330 (string-to-int (buffer-substring (match-beginning 1) (match-end 1))))))
331
332 (defun diff-run-diff (switches old old-temp new new-temp)
333 ;; Actually run the diff process with SWITCHES on OLD and NEW.
334 ;; OLD-TEMP and NEW-TEMP are names of temp files that can be used
335 ;; to dump the data out to.
336 (insert "diff " (mapconcat 'identity switches " ") " " old
337 " " new "\n")
338 (apply 'call-process "diff" nil t nil
339 (append switches (list old-temp new-temp))))
340
341
342 (defun diff-fix-file-names (old old-temp new new-temp pattern)
343 ;; Replaces any temp file names with the real names of files.
344 (save-excursion
345 (save-restriction
346 (let ((files (list old new))
347 (temps (list old-temp new-temp))
348 buffer-read-only case-fold-search)
349 (goto-char (point-min))
350 (if (re-search-forward pattern nil t)
351 (narrow-to-region (point-min) (match-beginning 0)))
352 (while files
353 (let ((regexp (concat "[ \t\n]\\("
354 (regexp-quote (car temps))
355 "\\)[ \t\n]")))
356 (goto-char (point-min))
357 (forward-line 1)
358 (while (re-search-forward regexp nil t)
359 (goto-char (match-beginning 1))
360 (delete-region (point) (match-end 1))
361 (insert (car files))))
362 (setq files (cdr files)
363 temps (cdr temps)))))))
364
365 ;;;; User commands
366
367 (defun diff-mode ()
368 "Diff Mode is used by \\[diff] for perusing the output from the diff program.
369 All normal editing commands are turned off. Instead, these are available:
370 \\<diff-mode-map>
371 \\[diff-advertised-scroll-up] Scroll to next screen of this difference.
372 \\[diff-advertised-scroll-down] Scroll to previous screen of this difference.
373 \\[diff-next-difference] Move to Next Difference.
374 \\[diff-previous-difference] Move to Previous Difference.
375 \\[diff-show-difference] Jump to difference specified by numeric position.
376 \\[diff-find-file] Find current diff in file
377 \\[diff-find-file-other-window] Find current diff in file in other window
378 \\[diff-display-file] Display file in other window
379 \\[diff-narrow] Narrow diff buffer to current difference
380 \\[widen] Widen diff buffer
381 \\[diff-show-header] Show diff header describing file name etc.
382 \\[diff-quit] Quit diff
383 "
384 (interactive)
385 (use-local-map diff-mode-map)
386 (diff-grok-keymap)
387 (setq buffer-read-only t
388 major-mode 'diff-mode
389 mode-name "Diff"
390 mode-line-modified "--- "
391 mode-line-process
392 '(" " diff-current-difference "/" diff-total-differences))
393 (diff-parse-hunks)
394 (setq diff-total-differences (int-to-string diff-total-hunks)))
395
396 ;;; Motion commands
397
398 (defun diff-next-difference (n)
399 "In diff-mode go the the beginning of the next difference hunk."
400 (interactive "p")
401 (if (zerop n)
402 (goto-char (diff-hunk-min diff-current-hunk))
403 (let ((narrow (diff-buffer-narrowed-p))
404 (max (point-max))
405 (min (point-min)))
406 (unwind-protect
407 (progn
408 (widen)
409 (setq diff-current-hunk (+ n diff-current-hunk))
410 (cond ((> diff-current-hunk diff-total-hunks)
411 (setq diff-current-hunk diff-total-hunks)
412 (message "No following difference hunks."))
413 ((< diff-current-hunk 0)
414 (setq diff-current-hunk 0)
415 (message "No preceding difference hunks.")))
416 (setq diff-current-difference (int-to-string diff-current-hunk)
417 min (goto-char (diff-hunk-min diff-current-hunk))
418 max (diff-hunk-max diff-current-hunk)))
419 (if narrow (narrow-to-region min max))))
420 (set-buffer-modified-p (buffer-modified-p))))
421
422 (defun diff-previous-difference (n)
423 "In diff-mode go the the beginning of the previous difference hunk."
424 (interactive "p")
425 (diff-next-difference (- n)))
426
427 (defun diff-next-line (n)
428 "In diff-mode go to the next line."
429 (interactive "p")
430 (condition-case nil
431 (next-line n)
432 (error (if (> n 0) (message "End of difference hunk"))))
433 (diff-update-modeline))
434
435 (defun diff-previous-line (n)
436 "In diff-mode go to the previous line."
437 (interactive "p")
438 (diff-next-line (- n)))
439
440 (defun diff-forward-char (n)
441 "In diff-mode move the point forward."
442 (interactive "p")
443 (forward-char n)
444 (diff-update-modeline))
445
446 (defun diff-backward-char (n)
447 "In diff-mode move the point backward."
448 (interactive "p")
449 (backward-char n)
450 (diff-update-modeline))
451
452 (defun diff-scroll-up (n)
453 "In diff-mode scroll the buffer up."
454 (interactive "P")
455 (scroll-up n)
456 (diff-update-modeline))
457
458 (fset 'diff-advertised-scroll-up 'diff-scroll-up)
459
460 (defun diff-scroll-down (n)
461 "In diff-mode scroll the buffer down."
462 (interactive "P")
463 (scroll-down n)
464 (diff-update-modeline))
465
466 (fset 'diff-advertised-scroll-down 'diff-scroll-down)
467
468 (defun diff-beginning-of-buffer (n)
469 "In diff-mode go to the beginning of the buffer."
470 (interactive "P")
471 (beginning-of-buffer n)
472 (diff-update-modeline))
473
474 (defun diff-end-of-buffer (n)
475 "In diff-mode go to the end of the buffer."
476 (interactive "P")
477 (end-of-buffer n)
478 (diff-update-modeline))
479
480 ;;; The main command.
481
482 (defun diff (old new &optional switches)
483 "Find and display the differences between OLD and NEW files.
484 Interactively you are prompted with the current buffer's file name for NEW
485 and what appears to be its backup for OLD."
486 ;; Support for diffing directories is rather limited. It needs work.
487 (interactive (diff-read-args "Diff original file (%s) "
488 "Diff new file (%s) "
489 "Switches for diff (%s) "
490 (buffer-file-name)))
491 (setq switches (diff-fix-switches (or switches diff-switches))
492 old (expand-file-name old)
493 new (expand-file-name new))
494 (let ((curr-buff (current-buffer))
495 doing-dirs old-temp new-temp old-buffer new-buffer flag)
496 (let ((fdp-old (file-directory-p old))
497 (fdp-new (file-directory-p new)))
498 (cond
499 ((null (or fdp-new fdp-old)))
500 ((null fdp-new)
501 (setq old (expand-file-name (file-name-nondirectory new) old)))
502 ((null fdp-old)
503 (setq new (expand-file-name (file-name-nondirectory old) new)))
504 (t (setq doing-dirs t))))
505 ;; (message "diff %s %s %s..."
506 ;; (mapconcat (function identity) switches " ") new old)
507 (message "diff %s %s %s..."
508 (mapconcat (function identity) switches " ") old new)
509 (if doing-dirs
510 (setq diff-old-file nil
511 diff-new-file nil)
512 (setq old-temp (make-temp-name (concat diff-temp-template "1"))
513 new-temp (make-temp-name (concat diff-temp-template "2"))
514 old-buffer (diff-get-file-buffer old)
515 new-buffer (diff-get-file-buffer new)
516 diff-old-file (cons old (cdr old-buffer))
517 diff-new-file (cons new (cdr new-buffer))))
518 (let (case-fold-search)
519 (mapcar (function
520 (lambda (x)
521 (if (string-match "[ecu]" x)
522 (setq flag (aref x (match-beginning 0))))))
523 switches))
524 (unwind-protect
525 (let ((patterns (assq flag diff-search-pattern-alist)))
526 (set-buffer (get-buffer-create "*Diff Output*"))
527 (setq default-directory (file-name-directory new)
528 diff-old-file-pattern (nth 2 patterns)
529 diff-new-file-pattern (nth 3 patterns)
530 diff-hunk-pattern (nth 1 patterns))
531 (let (buffer-read-only)
532 (if (fboundp 'buffer-disable-undo)
533 (buffer-disable-undo (current-buffer))
534 ;; old style (Emacs 18.55 and earlier)
535 (buffer-disable-undo (current-buffer)))
536 (widen)
537 (erase-buffer)
538 (if doing-dirs
539 (progn
540 (diff-run-diff switches old old new new)
541 (setq diff-hunk-pattern (concat diff-hunk-pattern
542 "\\|^Only in ")))
543 (save-excursion
544 (set-buffer (car old-buffer))
545 (write-region (point-min) (point-max) old-temp nil 'quiet)
546 (set-buffer (car new-buffer))
547 (write-region (point-min) (point-max) new-temp nil 'quiet))
548 (diff-run-diff switches old old-temp new new-temp))
549 ;; Need to replace file names
550 (if (and (not doing-dirs) (memq flag '(?c ?u)))
551 (diff-fix-file-names old old-temp new new-temp
552 diff-hunk-pattern))
553 (diff-mode)
554 (goto-char (point-min))
555 (setq diff-current-difference "0"
556 diff-current-hunk 0)
557 (if (zerop diff-total-hunks)
558 (progn
559 (diff-cleanup-buffers)
560 (message "No differences"))
561 (if diff-do-narrow (narrow-to-region (point) (diff-hunk-max 0)))
562 (display-buffer (current-buffer))
563 (message "%s difference hunk%s" diff-total-differences
564 (if (= diff-total-hunks 1) "" "s")))))
565 (condition-case nil
566 (delete-file old-temp)
567 (error nil))
568 (condition-case nil
569 (delete-file new-temp)
570 (error nil))
571 (set-buffer curr-buff))))
572
573 (defun diff-backup (file &optional switches)
574 "Diff this file with its backup file or vice versa.
575 Uses the latest backup, if there are several numerical backups.
576 If this file is a backup, diff it with its original.
577 The backup file is the first file given to `diff'."
578 (interactive (list (read-file-name "Diff (file with backup): ")
579 (and current-prefix-arg
580 (diff-read-switches "Diff switches: "))))
581 (let (bak ori)
582 (if (backup-file-name-p file)
583 (setq bak file
584 ori (file-name-sans-versions file))
585 (setq bak (or (diff-latest-backup-file file)
586 (error "No backup found for %s" file))
587 ori file))
588 (diff bak ori switches)))
589
590 (defun diff-show-difference (n)
591 "Show difference number N (prefix argument)."
592 (interactive "p")
593 (let ((narrowedp (diff-buffer-narrowed-p))
594 (min (diff-hunk-min diff-current-hunk))
595 (max (diff-hunk-max diff-current-hunk)))
596 (unwind-protect
597 (progn
598 (widen)
599 (cond
600 ((< n 0)
601 (message "No negative hunks.")
602 (setq n 0))
603 ((> n diff-total-hunks)
604 (message "No hunk %d." n)
605 (setq n diff-total-hunks)))
606 (setq diff-current-hunk n
607 diff-current-difference (int-to-string diff-current-hunk)
608 min (diff-hunk-min n)
609 max (diff-hunk-max n))
610 (goto-char min))
611 (if narrowedp (narrow-to-region min max))
612 (set-buffer-modified-p (buffer-modified-p)))))
613
614 (defun diff-show-header ()
615 "Show `diff-header'."
616 (interactive)
617 (with-output-to-temp-buffer "*Diff Header*"
618 (princ (save-restriction
619 (widen)
620 (buffer-substring (diff-hunk-min 0) (diff-hunk-max 0))))))
621
622
623 (defun diff-find-file (old-file-p)
624 "Visit diffed file, at the point corresponding to the current hunk.
625 Default is to visit the new file; prefix means visit old file instead."
626 (interactive "P")
627 (let ((line (diff-file-line old-file-p)))
628 (find-file
629 (if old-file-p
630 (car diff-old-file)
631 (car diff-new-file)))
632 (goto-line line)
633 (recenter 0)))
634
635 (defun diff-find-file-other-window (old-file-p)
636 "Visit the diffed file in other window, with the point at the current hunk.
637 Default is to visit the new file; prefix means visit the old file instead."
638 (interactive "P")
639 (let ((line (diff-file-line old-file-p)))
640 (find-file-other-window
641 (if old-file-p
642 (car diff-old-file)
643 (car diff-new-file)))
644 (goto-line line)
645 (recenter 0)))
646
647 (defun diff-find-file-other-frame (old-file-p)
648 "Visit the diffed file in other frame, with point at the current hunk.
649 Default is to visit the new file; prefix means visit the old file instead."
650 (interactive "P")
651 (let ((line (diff-file-line old-file-p)))
652 (find-file-other-frame
653 (if old-file-p
654 (car diff-old-file)
655 (car diff-new-file)))
656 (goto-line line)
657 (recenter 0)))
658
659 (defun diff-display-file (old-file-p)
660 "Display the diffed file in other window, with point at the current hunk.
661 Default is to visit the new file; prefix means visit the old file instead."
662 (interactive "P")
663 (let ((line (diff-file-line old-file-p))
664 (wind (display-buffer (find-file-noselect (if old-file-p
665 (car diff-old-file)
666 (car diff-new-file)))))
667 (curr-wind (selected-window)))
668 (unwind-protect
669 (progn
670 (select-window wind)
671 (goto-line line)
672 (recenter 0))
673 (select-window curr-wind))))
674
675 (defun diff-quit ()
676 "Quit diff by killing the diff buffer."
677 (interactive)
678 (kill-buffer "*Diff Output*")
679 (diff-cleanup-buffers))
680
681 (defun diff-narrow ()
682 "Narrow diff buffer to current difference hunk."
683 (interactive)
684 (narrow-to-region (diff-hunk-min diff-current-hunk)
685 (diff-hunk-max diff-current-hunk)))
686
687 ;;; Run any load hooks
688 (run-hooks 'diff-load-hook)
689
690 ;;; end of diff.el