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