]> code.delx.au - gnu-emacs/blob - lisp/vc/ediff-ptch.el
* emulation/cua-base.el (cua--init-keymaps):
[gnu-emacs] / lisp / vc / ediff-ptch.el
1 ;;; ediff-ptch.el --- Ediff's patch support
2
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010
5 ;; Free Software Foundation, Inc.
6
7 ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
8 ;; Package: ediff
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29
30 (provide 'ediff-ptch)
31
32 (defgroup ediff-ptch nil
33 "Ediff patch support."
34 :tag "Patch"
35 :prefix "ediff-"
36 :group 'ediff)
37
38 ;; compiler pacifier
39 (eval-when-compile
40 (require 'ediff))
41 ;; end pacifier
42
43 (require 'ediff-init)
44
45 (defcustom ediff-patch-program "patch"
46 "Name of the program that applies patches.
47 It is recommended to use GNU-compatible versions."
48 :type 'string
49 :group 'ediff-ptch)
50 (defcustom ediff-patch-options "-f"
51 "Options to pass to ediff-patch-program.
52
53 Note: the `-b' option should be specified in `ediff-backup-specs'.
54
55 It is recommended to pass the `-f' option to the patch program, so it won't ask
56 questions. However, some implementations don't accept this option, in which
57 case the default value for this variable should be changed."
58 :type 'string
59 :group 'ediff-ptch)
60
61 (defvar ediff-last-dir-patch nil
62 "Last directory used by an Ediff command for file to patch.")
63
64 ;; the default backup extension
65 (defconst ediff-default-backup-extension
66 (if (eq system-type 'ms-dos)
67 "_orig" ".orig"))
68
69
70 (defcustom ediff-backup-extension ediff-default-backup-extension
71 "Backup extension used by the patch program.
72 See also `ediff-backup-specs'."
73 :type 'string
74 :group 'ediff-ptch)
75
76 (defun ediff-test-patch-utility ()
77 (condition-case nil
78 (cond ((eq 0 (call-process ediff-patch-program nil nil nil "-z." "-b"))
79 ;; GNU `patch' v. >= 2.2
80 'gnu)
81 ((eq 0 (call-process ediff-patch-program nil nil nil "-b"))
82 'posix)
83 (t 'traditional))
84 (file-error nil)))
85
86 (defcustom ediff-backup-specs
87 (let ((type (ediff-test-patch-utility)))
88 (cond ((eq type 'gnu)
89 ;; GNU `patch' v. >= 2.2
90 (format "-z%s -b" ediff-backup-extension))
91 ((eq type 'posix)
92 ;; POSIX `patch' -- ediff-backup-extension must be ".orig"
93 (setq ediff-backup-extension ediff-default-backup-extension)
94 "-b")
95 (t
96 ;; traditional `patch'
97 (format "-b %s" ediff-backup-extension))))
98 "Backup directives to pass to the patch program.
99 Ediff requires that the old version of the file \(before applying the patch\)
100 be saved in a file named `the-patch-file.extension'. Usually `extension' is
101 `.orig', but this can be changed by the user and may depend on the system.
102 Therefore, Ediff needs to know the backup extension used by the patch program.
103
104 Some versions of the patch program let you specify `-b backup-extension'.
105 Other versions only permit `-b', which assumes the extension `.orig'
106 \(in which case ediff-backup-extension MUST be also `.orig'\). The latest
107 versions of GNU patch require `-b -z backup-extension'.
108
109 Note that both `ediff-backup-extension' and `ediff-backup-specs'
110 must be set properly. If your patch program takes the option `-b',
111 but not `-b extension', the variable `ediff-backup-extension' must
112 still be set so Ediff will know which extension to use.
113
114 Ediff tries to guess the appropriate value for this variables. It is believed
115 to be working for `traditional' patch, all versions of GNU patch, and for POSIX
116 patch. So, don't change these variables, unless the default doesn't work."
117 :type 'string
118 :group 'ediff-ptch)
119
120
121 (defcustom ediff-patch-default-directory nil
122 "Default directory to look for patches."
123 :type '(choice (const nil) string)
124 :group 'ediff-ptch)
125
126 ;; This context diff does not recognize spaces inside files, but removing ' '
127 ;; from [^ \t] breaks normal patches for some reason
128 (defcustom ediff-context-diff-label-regexp
129 (concat "\\(" ; context diff 2-liner
130 "^\\*\\*\\* +\\([^ \t]+\\)[^*]+[\t ]*\n--- +\\([^ \t]+\\)"
131 "\\|" ; unified format diff 2-liner
132 "^--- +\\([^ \t]+\\).*\n\\+\\+\\+ +\\([^ \t]+\\)"
133 "\\)")
134 "Regexp matching filename 2-liners at the start of each context diff.
135 You probably don't want to change that, unless you are using an obscure patch
136 program."
137 :type 'regexp
138 :group 'ediff-ptch)
139
140 ;; The buffer of the patch file. Local to control buffer.
141 (ediff-defvar-local ediff-patchbufer nil "")
142
143 ;; The buffer where patch displays its diagnostics.
144 (ediff-defvar-local ediff-patch-diagnostics nil "")
145
146 ;; Map of patch buffer. Has the form:
147 ;; ((filename1 marker1 marker2) (filename2 marker1 marker2) ...)
148 ;; where filenames are files to which patch would have applied the patch;
149 ;; marker1 delimits the beginning of the corresponding patch and marker2 does
150 ;; it for the end.
151 (ediff-defvar-local ediff-patch-map nil "")
152
153 ;; strip prefix from filename
154 ;; returns /dev/null, if can't strip prefix
155 (defsubst ediff-file-name-sans-prefix (filename prefix)
156 (if prefix
157 (save-match-data
158 (if (string-match (concat "^" (if (stringp prefix)
159 (regexp-quote prefix)
160 ""))
161 filename)
162 (substring filename (match-end 0))
163 (concat "/null/" filename)))
164 filename)
165 )
166
167
168
169 ;; no longer used
170 ;; return the number of matches of regexp in buf starting from the beginning
171 (defun ediff-count-matches (regexp buf)
172 (ediff-with-current-buffer buf
173 (let ((count 0) opoint)
174 (save-excursion
175 (goto-char (point-min))
176 (while (and (not (eobp))
177 (progn (setq opoint (point))
178 (re-search-forward regexp nil t)))
179 (if (= opoint (point))
180 (forward-char 1)
181 (setq count (1+ count)))))
182 count)))
183
184 ;; Scan BUF (which is supposed to contain a patch) and make a list of the form
185 ;; ((nil nil filename-spec1 marker1 marker2)
186 ;; (nil nil filename-spec2 marker1 marker2) ...)
187 ;; where filename-spec[12] are files to which the `patch' program would
188 ;; have applied the patch.
189 ;; nin, nil are placeholders. See ediff-make-new-meta-list-element in
190 ;; ediff-meta.el for the explanations.
191 ;; In the beginning we don't know exactly which files need to be patched.
192 ;; We usually come up with two candidates and ediff-file-name-sans-prefix
193 ;; resolves this later.
194 ;;
195 ;; The marker `marker1' delimits the beginning of the corresponding patch and
196 ;; `marker2' does it for the end.
197 ;; The result of ediff-map-patch-buffer is a list, which is then assigned
198 ;; to ediff-patch-map.
199 ;; The function returns the number of elements in the list ediff-patch-map
200 (defun ediff-map-patch-buffer (buf)
201 (ediff-with-current-buffer buf
202 (let ((count 0)
203 (mark1 (move-marker (make-marker) (point-min)))
204 (mark1-end (point-min))
205 (possible-file-names '("/dev/null" . "/dev/null"))
206 mark2-end mark2 filenames
207 beg1 beg2 end1 end2
208 patch-map opoint)
209 (save-excursion
210 (goto-char (point-min))
211 (setq opoint (point))
212 (while (and (not (eobp))
213 (re-search-forward ediff-context-diff-label-regexp nil t))
214 (if (= opoint (point))
215 (forward-char 1) ; ensure progress towards the end
216 (setq mark2 (move-marker (make-marker) (match-beginning 0))
217 mark2-end (match-end 0)
218 beg1 (or (match-beginning 2) (match-beginning 4))
219 end1 (or (match-end 2) (match-end 4))
220 beg2 (or (match-beginning 3) (match-beginning 5))
221 end2 (or (match-end 3) (match-end 5)))
222 ;; possible-file-names is holding the new file names until we
223 ;; insert the old file name in the patch map
224 ;; It is a pair
225 ;; (filename-from-1st-header-line . filename-from-2nd-line)
226 (setq possible-file-names
227 (cons (if (and beg1 end1)
228 (buffer-substring beg1 end1)
229 "/dev/null")
230 (if (and beg2 end2)
231 (buffer-substring beg2 end2)
232 "/dev/null")))
233 ;; check for any `Index:' or `Prereq:' lines, but don't use them
234 (if (re-search-backward "^Index:" mark1-end 'noerror)
235 (move-marker mark2 (match-beginning 0)))
236 (if (re-search-backward "^Prereq:" mark1-end 'noerror)
237 (move-marker mark2 (match-beginning 0)))
238
239 (goto-char mark2-end)
240
241 (if filenames
242 (setq patch-map
243 (cons (ediff-make-new-meta-list-element
244 filenames mark1 mark2)
245 patch-map)))
246 (setq mark1 mark2
247 mark1-end mark2-end
248 filenames possible-file-names))
249 (setq opoint (point)
250 count (1+ count))))
251 (setq mark2 (point-max-marker)
252 patch-map (cons (ediff-make-new-meta-list-element
253 possible-file-names mark1 mark2)
254 patch-map))
255 (setq ediff-patch-map (nreverse patch-map))
256 count)))
257
258 ;; Fix up the file names in the list using the argument FILENAME
259 ;; Algorithm: find the files' directories in the patch and, if a directory is
260 ;; absolute, cut it out from the corresponding file name in the patch.
261 ;; Relative directories are not cut out.
262 ;; Prepend the directory of FILENAME to each resulting file (which came
263 ;; originally from the patch).
264 ;; In addition, the first file in the patch document is replaced by FILENAME.
265 ;; Each file is actually a pair of files found in the context diff header
266 ;; In the end, for each pair, we ask the user which file to patch.
267 ;; Note: Ediff doesn't recognize multi-file patches that are separated
268 ;; with the `Index:' line. It treats them as a single-file patch.
269 ;;
270 ;; Executes inside the patch buffer
271 (defun ediff-fixup-patch-map (filename)
272 (setq filename (expand-file-name filename))
273 (let ((actual-dir (if (file-directory-p filename)
274 ;; directory part of filename
275 (file-name-as-directory filename)
276 (file-name-directory filename)))
277 ;; In case 2 files are possible patch targets, the user will be offered
278 ;; to choose file1 or file2. In a multifile patch, if the user chooses
279 ;; 1 or 2, this choice is preserved to decide future alternatives.
280 chosen-alternative
281 )
282
283 ;; chop off base-dirs
284 (mapc (lambda (session-info)
285 (let* ((proposed-file-names
286 ;; Filename-spec is objA; it is represented as
287 ;; (file1 . file2). Get it using ediff-get-session-objA.
288 (ediff-get-session-objA-name session-info))
289 ;; base-dir1 is the dir part of the 1st file in the patch
290 (base-dir1
291 (or (file-name-directory (car proposed-file-names))
292 ""))
293 ;; directory part of the 2nd file in the patch
294 (base-dir2
295 (or (file-name-directory (cdr proposed-file-names))
296 ""))
297 )
298 ;; If both base-dir1 and base-dir2 are relative and exist,
299 ;; assume that
300 ;; these dirs lead to the actual files starting at the present
301 ;; directory. So, we don't strip these relative dirs from the
302 ;; file names. This is a heuristic intended to improve guessing
303 (let ((default-directory (file-name-directory filename)))
304 (unless (or (file-name-absolute-p base-dir1)
305 (file-name-absolute-p base-dir2)
306 (not (file-exists-p base-dir1))
307 (not (file-exists-p base-dir2)))
308 (setq base-dir1 ""
309 base-dir2 "")))
310 (or (string= (car proposed-file-names) "/dev/null")
311 (setcar proposed-file-names
312 (ediff-file-name-sans-prefix
313 (car proposed-file-names) base-dir1)))
314 (or (string=
315 (cdr proposed-file-names) "/dev/null")
316 (setcdr proposed-file-names
317 (ediff-file-name-sans-prefix
318 (cdr proposed-file-names) base-dir2)))
319 ))
320 ediff-patch-map)
321
322 ;; take the given file name into account
323 (or (file-directory-p filename)
324 (string= "/dev/null" filename)
325 (setcar (ediff-get-session-objA (car ediff-patch-map))
326 (cons (file-name-nondirectory filename)
327 (file-name-nondirectory filename))))
328
329 ;; prepend actual-dir
330 (mapc (lambda (session-info)
331 (let ((proposed-file-names
332 (ediff-get-session-objA-name session-info)))
333 (if (and (string-match "^/null/" (car proposed-file-names))
334 (string-match "^/null/" (cdr proposed-file-names)))
335 ;; couldn't intuit the file name to patch, so
336 ;; something is amiss
337 (progn
338 (with-output-to-temp-buffer ediff-msg-buffer
339 (ediff-with-current-buffer standard-output
340 (fundamental-mode))
341 (princ
342 (format "
343 The patch file contains a context diff for
344 %s
345 %s
346 However, Ediff cannot infer the name of the actual file
347 to be patched on your system. If you know the correct file name,
348 please enter it now.
349
350 If you don't know and still would like to apply patches to
351 other files, enter /dev/null
352 "
353 (substring (car proposed-file-names) 6)
354 (substring (cdr proposed-file-names) 6))))
355 (let ((directory t)
356 user-file)
357 (while directory
358 (setq user-file
359 (read-file-name
360 "Please enter file name: "
361 actual-dir actual-dir t))
362 (if (not (file-directory-p user-file))
363 (setq directory nil)
364 (setq directory t)
365 (beep)
366 (message "%s is a directory" user-file)
367 (sit-for 2)))
368 (setcar (ediff-get-session-objA session-info)
369 (cons user-file user-file))))
370 (setcar proposed-file-names
371 (expand-file-name
372 (concat actual-dir (car proposed-file-names))))
373 (setcdr proposed-file-names
374 (expand-file-name
375 (concat actual-dir (cdr proposed-file-names)))))
376 ))
377 ediff-patch-map)
378 ;; Check for the existing files in each pair and discard the nonexisting
379 ;; ones. If both exist, ask the user.
380 (mapcar (lambda (session-info)
381 (let* ((file1 (car (ediff-get-session-objA-name session-info)))
382 (file2 (cdr (ediff-get-session-objA-name session-info)))
383 (session-file-object
384 (ediff-get-session-objA session-info))
385 (f1-exists (file-exists-p file1))
386 (f2-exists (file-exists-p file2)))
387 (cond
388 ((and
389 ;; The patch program prefers the shortest file as the patch
390 ;; target. However, this is a questionable heuristic. In an
391 ;; interactive program, like ediff, we can offer the user a
392 ;; choice.
393 ;; (< (length file2) (length file1))
394 (not f1-exists)
395 f2-exists)
396 ;; replace file-pair with the winning file2
397 (setcar session-file-object file2))
398 ((and
399 ;; (< (length file1) (length file2))
400 (not f2-exists)
401 f1-exists)
402 ;; replace file-pair with the winning file1
403 (setcar session-file-object file1))
404 ((and f1-exists f2-exists
405 (string= file1 file2))
406 (setcar session-file-object file1))
407 ((and f1-exists f2-exists (eq chosen-alternative 1))
408 (setcar session-file-object file1))
409 ((and f1-exists f2-exists (eq chosen-alternative 2))
410 (setcar session-file-object file2))
411 ((and f1-exists f2-exists)
412 (with-output-to-temp-buffer ediff-msg-buffer
413 (ediff-with-current-buffer standard-output
414 (fundamental-mode))
415 (princ (format "
416 Ediff has inferred that
417 %s
418 %s
419 are two possible targets for applying the patch.
420 Both files seem to be plausible alternatives.
421
422 Please advice:
423 Type `y' to use %s as the target;
424 Type `n' to use %s as the target.
425 "
426 file1 file2 file1 file2)))
427 (setcar session-file-object
428 (if (y-or-n-p (format "Use %s ? " file1))
429 (progn
430 (setq chosen-alternative 1)
431 file1)
432 (setq chosen-alternative 2)
433 file2))
434 )
435 (f2-exists (setcar session-file-object file2))
436 (f1-exists (setcar session-file-object file1))
437 (t
438 (with-output-to-temp-buffer ediff-msg-buffer
439 (ediff-with-current-buffer standard-output
440 (fundamental-mode))
441 (princ "\nEdiff has inferred that")
442 (if (string= file1 file2)
443 (princ (format "
444 %s
445 is assumed to be the target for this patch. However, this file does not exist."
446 file1))
447 (princ (format "
448 %s
449 %s
450 are two possible targets for this patch. However, these files do not exist."
451 file1 file2)))
452 (princ "
453 \nPlease enter an alternative patch target ...\n"))
454 (let ((directory t)
455 target)
456 (while directory
457 (setq target (read-file-name
458 "Please enter a patch target: "
459 actual-dir actual-dir t))
460 (if (not (file-directory-p target))
461 (setq directory nil)
462 (beep)
463 (message "%s is a directory" target)
464 (sit-for 2)))
465 (setcar session-file-object target))))))
466 ediff-patch-map)
467 ))
468
469 (defun ediff-show-patch-diagnostics ()
470 (interactive)
471 (cond ((window-live-p ediff-window-A)
472 (set-window-buffer ediff-window-A ediff-patch-diagnostics))
473 ((window-live-p ediff-window-B)
474 (set-window-buffer ediff-window-B ediff-patch-diagnostics))
475 (t (display-buffer ediff-patch-diagnostics 'not-this-window))))
476
477 ;; prompt for file, get the buffer
478 (defun ediff-prompt-for-patch-file ()
479 (let ((dir (cond (ediff-use-last-dir ediff-last-dir-patch)
480 (ediff-patch-default-directory) ; try patch default dir
481 (t default-directory)))
482 (coding-system-for-read ediff-coding-system-for-read)
483 patch-file-name)
484 (setq patch-file-name
485 (read-file-name
486 (format "Patch is in file%s: "
487 (cond ((and buffer-file-name
488 (equal (expand-file-name dir)
489 (file-name-directory buffer-file-name)))
490 (concat
491 " (default "
492 (file-name-nondirectory buffer-file-name)
493 ")"))
494 (t "")))
495 dir buffer-file-name 'must-match))
496 (if (file-directory-p patch-file-name)
497 (error "Patch file cannot be a directory: %s" patch-file-name)
498 (find-file-noselect patch-file-name))
499 ))
500
501
502 ;; Try current buffer, then the other window's buffer. Else, give up.
503 (defun ediff-prompt-for-patch-buffer ()
504 (get-buffer
505 (read-buffer
506 "Buffer that holds the patch: "
507 (cond ((save-excursion
508 (goto-char (point-min))
509 (re-search-forward ediff-context-diff-label-regexp nil t))
510 (current-buffer))
511 ((save-window-excursion
512 (other-window 1)
513 (save-excursion
514 (goto-char (point-min))
515 (and (re-search-forward ediff-context-diff-label-regexp nil t)
516 (current-buffer)))))
517 ((save-window-excursion
518 (other-window -1)
519 (save-excursion
520 (goto-char (point-min))
521 (and (re-search-forward ediff-context-diff-label-regexp nil t)
522 (current-buffer)))))
523 (t (ediff-other-buffer (current-buffer))))
524 'must-match)))
525
526
527 (defun ediff-get-patch-buffer (&optional arg patch-buf)
528 "Obtain patch buffer. If patch is already in a buffer---use it.
529 Else, read patch file into a new buffer. If patch buffer is passed as an
530 optional argument, then use it."
531 (let ((last-nonmenu-event t) ; Emacs: don't use dialog box
532 last-command-event) ; XEmacs: don't use dialog box
533
534 (cond ((ediff-buffer-live-p patch-buf))
535 ;; even prefix arg: patch in buffer
536 ((and (integerp arg) (eq 0 (mod arg 2)))
537 (setq patch-buf (ediff-prompt-for-patch-buffer)))
538 ;; odd prefix arg: get patch from a file
539 ((and (integerp arg) (eq 1 (mod arg 2)))
540 (setq patch-buf (ediff-prompt-for-patch-file)))
541 (t (setq patch-buf
542 (if (y-or-n-p "Is the patch already in a buffer? ")
543 (ediff-prompt-for-patch-buffer)
544 (ediff-prompt-for-patch-file)))))
545
546 (ediff-with-current-buffer patch-buf
547 (goto-char (point-min))
548 (or (ediff-get-visible-buffer-window patch-buf)
549 (progn
550 (pop-to-buffer patch-buf 'other-window)
551 (select-window (previous-window)))))
552 (ediff-map-patch-buffer patch-buf)
553 patch-buf))
554
555 ;; Dispatch the right patch file function: regular or meta-level,
556 ;; depending on how many patches are in the patch file.
557 ;; At present, there is no support for meta-level patches.
558 ;; Should return either the ctl buffer or the meta-buffer
559 (defun ediff-dispatch-file-patching-job (patch-buf filename
560 &optional startup-hooks)
561 (ediff-with-current-buffer patch-buf
562 ;; relativize names in the patch with respect to source-file
563 (ediff-fixup-patch-map filename)
564 (if (< (length ediff-patch-map) 2)
565 (ediff-patch-file-internal
566 patch-buf
567 (if (and ediff-patch-map
568 (not (string-match
569 "^/dev/null"
570 ;; this is the file to patch
571 (ediff-get-session-objA-name (car ediff-patch-map))))
572 (> (length
573 (ediff-get-session-objA-name (car ediff-patch-map)))
574 1))
575 (ediff-get-session-objA-name (car ediff-patch-map))
576 filename)
577 startup-hooks)
578 (ediff-multi-patch-internal patch-buf startup-hooks))
579 ))
580
581
582 ;; When patching a buffer, never change the orig file. Instead, create a new
583 ;; buffer, ***_patched, even if the buff visits a file.
584 ;; Users who want to actually patch the buffer should use
585 ;; ediff-patch-file, not ediff-patch-buffer.
586 (defun ediff-patch-buffer-internal (patch-buf
587 buf-to-patch-name
588 &optional startup-hooks)
589 (let* ((buf-to-patch (get-buffer buf-to-patch-name))
590 (visited-file (if buf-to-patch (buffer-file-name buf-to-patch)))
591 (buf-mod-status (buffer-modified-p buf-to-patch))
592 (multifile-patch-p (> (length (ediff-with-current-buffer patch-buf
593 ediff-patch-map)) 1))
594 default-dir file-name ctl-buf)
595 (if multifile-patch-p
596 (error
597 "To apply multi-file patches, please use `ediff-patch-file'"))
598
599 ;; create a temp file to patch
600 (ediff-with-current-buffer buf-to-patch
601 (setq default-dir default-directory)
602 (setq file-name (ediff-make-temp-file buf-to-patch))
603 ;; temporarily switch visited file name, if any
604 (set-visited-file-name file-name)
605 ;; don't create auto-save file, if buff was visiting a file
606 (or visited-file
607 (setq buffer-auto-save-file-name nil))
608 ;; don't confuse the user with a new bufname
609 (rename-buffer buf-to-patch-name)
610 (set-buffer-modified-p nil)
611 (set-visited-file-modtime) ; sync buffer and temp file
612 (setq default-directory default-dir)
613 )
614
615 ;; dispatch a patch function
616 (setq ctl-buf (ediff-dispatch-file-patching-job
617 patch-buf file-name startup-hooks))
618
619 (ediff-with-current-buffer ctl-buf
620 (delete-file (buffer-file-name ediff-buffer-A))
621 (delete-file (buffer-file-name ediff-buffer-B))
622 (ediff-with-current-buffer ediff-buffer-A
623 (if default-dir (setq default-directory default-dir))
624 (set-visited-file-name visited-file) ; visited-file might be nil
625 (rename-buffer buf-to-patch-name)
626 (set-buffer-modified-p buf-mod-status))
627 (ediff-with-current-buffer ediff-buffer-B
628 (setq buffer-auto-save-file-name nil) ; don't create auto-save file
629 (if default-dir (setq default-directory default-dir))
630 (set-visited-file-name nil)
631 (rename-buffer (ediff-unique-buffer-name
632 (concat buf-to-patch-name "_patched") ""))
633 (set-buffer-modified-p t)))
634 ))
635
636
637 ;; Traditional patch has weird return codes.
638 ;; GNU and Posix return 1 if some hanks failed and 2 in case of trouble.
639 ;; 0 is a good code in all cases.
640 ;; We'll do the concervative thing.
641 (defun ediff-patch-return-code-ok (code)
642 (eq code 0))
643 ;;; (if (eq (ediff-test-patch-utility) 'traditional)
644 ;;; (eq code 0)
645 ;;; (not (eq code 2))))
646
647 (defun ediff-patch-file-internal (patch-buf source-filename
648 &optional startup-hooks)
649 (setq source-filename (expand-file-name source-filename))
650
651 (let* ((shell-file-name ediff-shell)
652 (patch-diagnostics (get-buffer-create "*ediff patch diagnostics*"))
653 ;; ediff-find-file may use a temp file to do the patch
654 ;; so, we save source-filename and true-source-filename as a var
655 ;; that initially is source-filename but may be changed to a temp
656 ;; file for the purpose of patching.
657 (true-source-filename source-filename)
658 (target-filename source-filename)
659 ;; this ensures that the patch process gets patch buffer in the
660 ;; encoding that Emacs thinks is right for that type of text
661 (coding-system-for-write
662 (if (boundp 'buffer-file-coding-system) buffer-file-coding-system))
663 target-buf buf-to-patch file-name-magic-p
664 patch-return-code ctl-buf backup-style aux-wind)
665
666 (if (string-match "V" ediff-patch-options)
667 (error
668 "Ediff doesn't take the -V option in `ediff-patch-options'--sorry"))
669
670 ;; Make a temp file, if source-filename has a magic file handler (or if
671 ;; it is handled via auto-mode-alist and similar magic).
672 ;; Check if there is a buffer visiting source-filename and if they are in
673 ;; sync; arrange for the deletion of temp file.
674 (ediff-find-file 'true-source-filename 'buf-to-patch
675 'ediff-last-dir-patch 'startup-hooks)
676
677 ;; Check if source file name has triggered black magic, such as file name
678 ;; handlers or auto mode alist, and make a note of it.
679 ;; true-source-filename should be either the original name or a
680 ;; temporary file where we put the after-product of the file handler.
681 (setq file-name-magic-p (not (equal (file-truename true-source-filename)
682 (file-truename source-filename))))
683
684 ;; Checkout orig file, if necessary, so that the patched file
685 ;; could be checked back in.
686 (ediff-maybe-checkout buf-to-patch)
687
688 (ediff-with-current-buffer patch-diagnostics
689 (insert-buffer-substring patch-buf)
690 (message "Applying patch ... ")
691 ;; fix environment for gnu patch, so it won't make numbered extensions
692 (setq backup-style (getenv "VERSION_CONTROL"))
693 (setenv "VERSION_CONTROL" nil)
694 (setq patch-return-code
695 (call-process-region
696 (point-min) (point-max)
697 shell-file-name
698 t ; delete region (which contains the patch
699 t ; insert output (patch diagnostics) in current buffer
700 nil ; don't redisplay
701 shell-command-switch ; usually -c
702 (format "%s %s %s %s"
703 ediff-patch-program
704 ediff-patch-options
705 ediff-backup-specs
706 (expand-file-name true-source-filename))
707 ))
708
709 ;; restore environment for gnu patch
710 (setenv "VERSION_CONTROL" backup-style))
711
712 (message "Applying patch ... done")
713 (message "")
714
715 (switch-to-buffer patch-diagnostics)
716 (sit-for 0) ; synchronize - let the user see diagnostics
717
718 (or (and (ediff-patch-return-code-ok patch-return-code)
719 (file-exists-p
720 (concat true-source-filename ediff-backup-extension)))
721 (progn
722 (with-output-to-temp-buffer ediff-msg-buffer
723 (ediff-with-current-buffer standard-output
724 (fundamental-mode))
725 (princ (format
726 "Patch program has failed due to a bad patch file,
727 it couldn't apply all hunks, OR
728 it couldn't create the backup for the file being patched.
729
730 The former could be caused by a corrupt patch file or because the %S
731 program doesn't understand the format of the patch file in use.
732
733 The second problem might be due to an incompatibility among these settings:
734 ediff-patch-program = %S ediff-patch-options = %S
735 ediff-backup-extension = %S ediff-backup-specs = %S
736
737 See Ediff on-line manual for more details on these variables.
738 In particular, check the documentation for `ediff-backup-specs'.
739
740 In any of the above cases, Ediff doesn't compare files automatically.
741 However, if the patch was applied partially and the backup file was created,
742 you can still examine the changes via M-x ediff-files"
743 ediff-patch-program
744 ediff-patch-program
745 ediff-patch-options
746 ediff-backup-extension
747 ediff-backup-specs
748 )))
749 (beep 1)
750 (if (setq aux-wind (get-buffer-window ediff-msg-buffer))
751 (progn
752 (select-window aux-wind)
753 (goto-char (point-max))))
754 (switch-to-buffer-other-window patch-diagnostics)
755 (error "Patch appears to have failed")))
756
757 ;; If black magic is involved, apply patch to a temp copy of the
758 ;; file. Otherwise, apply patch to the orig copy. If patch is applied
759 ;; to temp copy, we name the result old-name_patched for local files
760 ;; and temp-copy_patched for remote files. The orig file name isn't
761 ;; changed, and the temp copy of the original is later deleted.
762 ;; Without magic, the original file is renamed (usually into
763 ;; old-name_orig) and the result of patching will have the same name as
764 ;; the original.
765 (if (not file-name-magic-p)
766 (ediff-with-current-buffer buf-to-patch
767 (set-visited-file-name
768 (concat source-filename ediff-backup-extension))
769 (set-buffer-modified-p nil))
770
771 ;; Black magic in effect.
772 ;; If orig file was remote, put the patched file in the temp directory.
773 ;; If orig file is local, put the patched file in the directory of
774 ;; the orig file.
775 (setq target-filename
776 (concat
777 (if (ediff-file-remote-p (file-truename source-filename))
778 true-source-filename
779 source-filename)
780 "_patched"))
781
782 (rename-file true-source-filename target-filename t)
783
784 ;; arrange that the temp copy of orig will be deleted
785 (rename-file (concat true-source-filename ediff-backup-extension)
786 true-source-filename t))
787
788 ;; make orig buffer read-only
789 (setq startup-hooks
790 (cons 'ediff-set-read-only-in-buf-A startup-hooks))
791
792 ;; set up a buf for the patched file
793 (setq target-buf (find-file-noselect target-filename))
794
795 (setq ctl-buf
796 (ediff-buffers-internal
797 buf-to-patch target-buf nil
798 startup-hooks 'epatch))
799 (ediff-with-current-buffer ctl-buf
800 (setq ediff-patchbufer patch-buf
801 ediff-patch-diagnostics patch-diagnostics))
802
803 (bury-buffer patch-diagnostics)
804 (message "Type `P', if you need to see patch diagnostics")
805 ctl-buf))
806
807 (defun ediff-multi-patch-internal (patch-buf &optional startup-hooks)
808 (let (meta-buf)
809 (setq startup-hooks
810 ;; this sets various vars in the meta buffer inside
811 ;; ediff-prepare-meta-buffer
812 (cons `(lambda ()
813 ;; tell what to do if the user clicks on a session record
814 (setq ediff-session-action-function
815 'ediff-patch-file-form-meta
816 ediff-meta-patchbufer patch-buf) )
817 startup-hooks))
818 (setq meta-buf (ediff-prepare-meta-buffer
819 'ediff-filegroup-action
820 (ediff-with-current-buffer patch-buf
821 (cons (ediff-make-new-meta-list-header
822 nil ; regexp
823 (format "%S" patch-buf) ; obj A
824 nil nil ; objects B,C
825 nil ; merge-auto-store-dir
826 nil ; comparison-func
827 )
828 ediff-patch-map))
829 "*Ediff Session Group Panel"
830 'ediff-redraw-directory-group-buffer
831 'ediff-multifile-patch
832 startup-hooks))
833 (ediff-show-meta-buffer meta-buf)
834 ))
835
836
837
838
839 ;; Local Variables:
840 ;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
841 ;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
842 ;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
843 ;; End:
844
845 ;;; ediff-ptch.el ends here