1 ;;; ediff-ptch.el --- Ediff's patch support
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
5 ;; Author: Michael Kifer <kifer@cs.sunysb.edu>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
29 (defgroup ediff-ptch nil
36 (defvar ediff-window-A
)
37 (defvar ediff-window-B
)
38 (defvar ediff-window-C
)
39 (defvar ediff-use-last-dir
)
43 (let ((load-path (cons (expand-file-name ".") load-path
)))
44 (or (featurep 'ediff-init
)
45 (load "ediff-init.el" nil nil
'nosuffix
))
47 (load "ediff.el" nil nil
'nosuffix
))
53 (defvar ediff-last-dir-patch nil
54 "Last directory used by an Ediff command for file to patch.")
56 (defvar ediff-backup-extension
57 (if (memq system-type
'(vax-vms axp-vms emx ms-dos windows-nt windows-95
))
59 "Backup extension used by the patch program.
60 See also `ediff-backup-specs'.")
62 (defcustom ediff-backup-specs
(format "-b %s" ediff-backup-extension
)
63 "*Backup directives to pass to the patch program.
64 Ediff requires that the old version of the file \(before applying the patch\)
65 is saved in a file named `the-patch-file.extension'. Usually `extension' is
66 `.orig', but this can be changed by the user and may depend on the system.
67 Therefore, Ediff needs to know the backup extension used by the patch program.
69 Some versions of the patch program let you specify `-b backup-extension'.
70 Other versions only permit `-b', which assumes some canned extension
73 Note that both `ediff-backup-extension' and `ediff-backup-specs'
74 must be properly set. If your patch program takes the option `-b',
75 but not `-b extension', the variable `ediff-backup-extension' must
76 still be set so Ediff will know which extension to use."
81 (defcustom ediff-patch-default-directory nil
82 "*Default directory to look for patches."
83 :type
'(choice (const nil
) string
)
86 (defcustom ediff-context-diff-label-regexp
87 (concat "\\(" ; context diff 2-liner
88 "^\\*\\*\\* \\([^ \t]+\\)[^*]+[\t ]*\n--- \\([^ \t]+\\)"
89 "\\|" ; GNU unified format diff 2-liner
90 "^--- \\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ \\([^ \t]+\\)"
92 "*Regexp matching filename 2-liners at the start of each context diff."
96 (defcustom ediff-patch-program
"patch"
97 "*Name of the program that applies patches.
98 It is recommended to use GNU-compatible versions."
101 (defcustom ediff-patch-options
"-f"
102 "*Options to pass to ediff-patch-program.
104 Note: the `-b' option should be specified in `ediff-backup-specs'.
106 It is recommended to pass the `-f' option to the patch program, so it won't ask
107 questions. However, some implementations don't accept this option, in which
108 case the default value for this variable should be changed."
112 ;; The buffer of the patch file. Local to control buffer.
113 (ediff-defvar-local ediff-patchbufer nil
"")
115 ;; The buffer where patch displays its diagnostics.
116 (ediff-defvar-local ediff-patch-diagnostics nil
"")
118 ;; Map of patch buffer. Has the form:
119 ;; ((filename1 marker1 marker2) (filename2 marker1 marker2) ...)
120 ;; where filenames are files to which patch would have applied the patch;
121 ;; marker1 delimits the beginning of the corresponding patch and marker2 does
123 (ediff-defvar-local ediff-patch-map nil
"")
125 ;; strip prefix from filename
126 ;; returns /dev/null, if can't strip prefix
127 (defsubst ediff-file-name-sans-prefix
(filename prefix
)
129 (if (string-match (concat "^" prefix
) filename
)
130 (substring filename
(match-end 0))
131 (concat "/null/" filename
))))
136 ;; return the number of matches of regexp in buf starting from the beginning
137 (defun ediff-count-matches (regexp buf
)
138 (ediff-eval-in-buffer buf
139 (let ((count 0) opoint
)
141 (goto-char (point-min))
142 (while (and (not (eobp))
143 (progn (setq opoint
(point))
144 (re-search-forward regexp nil t
)))
145 (if (= opoint
(point))
147 (setq count
(1+ count
)))))
150 ;; Scan BUF (which is supposed to contain a patch) and make a list of the form
151 ;; ((filename1 marker1 marker2) (filename2 marker1 marker2) ...)
152 ;; where filenames are files to which patch would have applied the patch;
153 ;; marker1 delimits the beginning of the corresponding patch and marker2 does
154 ;; it for the end. This list is then assigned to ediff-patch-map.
155 ;; Returns the number of elements in the list ediff-patch-map
156 (defun ediff-map-patch-buffer (buf)
157 (ediff-eval-in-buffer buf
159 (mark1 (move-marker (make-marker) (point-min)))
160 (mark1-end (point-min))
161 (possible-file-names '("/dev/null" .
"/dev/null"))
162 mark2-end mark2 filenames
166 (goto-char (point-min))
167 (setq opoint
(point))
168 (while (and (not (eobp))
169 (re-search-forward ediff-context-diff-label-regexp nil t
))
170 (if (= opoint
(point))
171 (forward-char 1) ; ensure progress towards the end
172 (setq mark2
(move-marker (make-marker) (match-beginning 0))
173 mark2-end
(match-end 0)
174 beg1
(or (match-beginning 2) (match-beginning 4))
175 end1
(or (match-end 2) (match-end 4))
176 beg2
(or (match-beginning 3) (match-beginning 5))
177 end2
(or (match-end 3) (match-end 5)))
178 ;; possible-file-names is holding the new file names until we
179 ;; insert the old file name in the patch map
180 ;; It is a pair (filename from 1st header line . fn from 2nd line)
181 (setq possible-file-names
182 (cons (if (and beg1 end1
)
183 (buffer-substring beg1 end1
)
186 (buffer-substring beg2 end2
)
188 ;; check for any `Index:' or `Prereq:' lines, but don't use them
189 (if (re-search-backward "^Index:" mark1-end
'noerror
)
190 (move-marker mark2
(match-beginning 0)))
191 (if (re-search-backward "^Prereq:" mark1-end
'noerror
)
192 (move-marker mark2
(match-beginning 0)))
194 (goto-char mark2-end
)
197 (setq patch-map
(cons (list filenames mark1 mark2
) patch-map
)))
200 filenames possible-file-names
))
203 (setq mark2
(point-max-marker)
204 patch-map
(cons (list possible-file-names mark1 mark2
) patch-map
))
205 (setq ediff-patch-map
(nreverse patch-map
))
208 ;; Fix up the file names in the list using the argument FILENAME
209 ;; Algorithm: find the first file's directory and cut it out from each file
210 ;; name in the patch. Prepend the directory of FILENAME to each file in the
211 ;; patch. In addition, the first file in the patch is replaced by FILENAME.
212 ;; Each file is actually a file-pair of files found in the context diff header
213 ;; In the end, for each pair, we select the shortest existing file.
214 ;; Note: Ediff doesn't recognize multi-file patches that are separated
215 ;; with the `Index:' line. It treats them as a single-file patch.
217 ;; Executes inside the patch buffer
218 (defun ediff-fixup-patch-map (filename)
219 (setq filename
(expand-file-name filename
))
220 (let ((actual-dir (if (file-directory-p filename
)
221 ;; directory part of filename
222 (file-name-as-directory filename
)
223 (file-name-directory filename
)))
224 ;; directory part of the first file in the patch
225 (base-dir1 (file-name-directory (car (car (car ediff-patch-map
)))))
226 (base-dir2 (file-name-directory (cdr (car (car ediff-patch-map
)))))
229 ;; chop off base-dirs
230 (mapcar (function (lambda (triple)
231 (or (string= (car (car triple
)) "/dev/null")
233 (ediff-file-name-sans-prefix
234 (car (car triple
)) base-dir1
)))
235 (or (string= (cdr (car triple
)) "/dev/null")
237 (ediff-file-name-sans-prefix
238 (cdr (car triple
)) base-dir2
)))
242 ;; take the given file name into account
243 (or (file-directory-p filename
)
244 (string= "/dev/null" filename
)
246 (setcar (car ediff-patch-map
)
247 (cons (file-name-nondirectory filename
)
248 (file-name-nondirectory filename
)))))
250 ;; prepend actual-dir
251 (mapcar (function (lambda (triple)
252 (if (and (string-match "^/null/" (car (car triple
)))
253 (string-match "^/null/" (cdr (car triple
))))
254 ;; couldn't strip base-dir1 and base-dir2
255 ;; hence, something wrong
257 (with-output-to-temp-buffer ediff-msg-buffer
260 The patch file contains a context diff for
265 However, Ediff cannot infer the name of the actual file
266 to be patched on your system. If you know the correct file name,
269 If you don't know and still would like to apply patches to
270 other files, enter /dev/null
272 (substring (car (car triple
)) 6)
273 (substring (cdr (car triple
)) 6))))
279 "Please enter file name: "
280 actual-dir actual-dir t
))
281 (if (not (file-directory-p user-file
))
285 (message "%s is a directory" user-file
)
287 (setcar triple
(cons user-file user-file
))))
290 (concat actual-dir
(car (car triple
)))))
293 (concat actual-dir
(cdr (car triple
))))))
296 ;; check for the shorter existing file in each pair and discard the other
298 (mapcar (function (lambda (triple)
299 (let* ((file1 (car (car triple
)))
300 (file2 (cdr (car triple
)))
301 (f1-exists (file-exists-p file1
))
302 (f2-exists (file-exists-p file2
)))
304 ((and (< (length file2
) (length file1
))
306 (setcar triple file2
))
307 ((and (< (length file1
) (length file2
))
309 (setcar triple file1
))
310 ((and f1-exists f2-exists
311 (string= file1 file2
))
312 (setcar triple file1
))
313 ((and f1-exists f2-exists
)
314 (with-output-to-temp-buffer ediff-msg-buffer
316 Ediff has inferred that
319 are possible targets for applying the patch.
320 Both files seem to be plausible alternatives.
323 Type `y' to use %s as the target;
324 Type `n' to use %s as the target.
326 file1 file2 file2 file1
)))
328 (if (y-or-n-p (format "Use %s ? " file2
))
330 (f2-exists (setcar triple file2
))
331 (f1-exists (setcar triple file1
))
333 (with-output-to-temp-buffer ediff-msg-buffer
338 are possible alternative targets for this patch.
340 However, these files do not exist.
342 Please enter an alternative patch target ...
348 (setq target
(read-file-name
349 "Please enter a patch target: "
350 actual-dir actual-dir t
))
351 (if (not (file-directory-p target
))
354 (message "%s is a directory" target
)
356 (setcar triple target
)))))))
360 (defun ediff-show-patch-diagnostics ()
362 (cond ((window-live-p ediff-window-A
)
363 (set-window-buffer ediff-window-A ediff-patch-diagnostics
))
364 ((window-live-p ediff-window-B
)
365 (set-window-buffer ediff-window-B ediff-patch-diagnostics
))
366 (t (display-buffer ediff-patch-diagnostics
'not-this-window
))))
368 (defun ediff-get-patch-buffer ()
369 "Obtain patch buffer. If patch is already in a buffer---use it.
370 Else, read patch file into a new buffer."
371 (let ((dir (cond (ediff-patch-default-directory) ; try patch default dir
372 (ediff-use-last-dir ediff-last-dir-patch
)
373 (t default-directory
)))
375 (if (y-or-n-p "Is the patch already in a buffer? ")
379 "Which buffer contains the patch? "
380 (current-buffer) 'must-match
)))
383 (read-file-name "Which file contains the patch? "
384 dir nil
'must-match
))))
386 (ediff-eval-in-buffer patch-buf
387 (goto-char (point-min))
388 (or (ediff-get-visible-buffer-window patch-buf
)
390 (pop-to-buffer patch-buf
'other-window
)
391 (select-window (previous-window)))))
392 (ediff-map-patch-buffer patch-buf
)
395 ;; Dispatch the right patch file function: regular or meta-level,
396 ;; depending on how many patches are in the patch file.
397 ;; At present, there is no support for meta-level patches.
398 ;; Should return either the ctl buffer or the meta-buffer
399 (defun ediff-dispatch-file-patching-job (patch-buf filename
400 &optional startup-hooks
)
401 (ediff-eval-in-buffer patch-buf
402 ;; relativize names in the patch with respect to source-file
403 (ediff-fixup-patch-map filename
)
404 (if (< (length ediff-patch-map
) 2)
405 (ediff-patch-file-internal
407 (if (and (not (string-match "^/dev/null" (car (car ediff-patch-map
))))
408 (> (length (car (car ediff-patch-map
))) 1))
409 (car (car ediff-patch-map
))
412 (ediff-multi-patch-internal patch-buf startup-hooks
))
416 (defun ediff-patch-buffer-internal (patch-buf buf-to-patch-name
417 &optional startup-hooks
)
418 (let* ((buf-to-patch (get-buffer buf-to-patch-name
))
419 (file-name-ok (if buf-to-patch
(buffer-file-name buf-to-patch
)))
420 (buf-mod-status (buffer-modified-p buf-to-patch
))
421 (multifile-patch-p (> (length (ediff-eval-in-buffer patch-buf
422 ediff-patch-map
)) 1))
423 default-dir file-name ctl-buf
)
425 (setq file-name file-name-ok
)
426 (if multifile-patch-p
428 "Can't apply multi-file patches to buffers that visit no files"))
429 (ediff-eval-in-buffer buf-to-patch
430 (setq default-dir default-directory
)
431 (setq file-name
(ediff-make-temp-file buf-to-patch
))
432 (set-visited-file-name file-name
)
433 (setq buffer-auto-save-file-name nil
) ; don't create auto-save file
434 ;;don't confuse the user with a new bufname
435 (rename-buffer buf-to-patch-name
)
436 (set-buffer-modified-p nil
)
437 (set-visited-file-modtime) ; sync buffer and temp file
438 (setq default-directory default-dir
)
441 ;; dispatch a patch function
442 (setq ctl-buf
(ediff-dispatch-file-patching-job
443 patch-buf file-name startup-hooks
))
447 ;; buffer wasn't visiting any file,
448 ;; so we will not run meta-level ediff here
449 (ediff-eval-in-buffer ctl-buf
450 (delete-file (buffer-file-name ediff-buffer-A
))
451 (delete-file (buffer-file-name ediff-buffer-B
))
452 (ediff-eval-in-buffer ediff-buffer-A
453 (if default-dir
(setq default-directory default-dir
))
454 (set-visited-file-name nil
)
455 (rename-buffer buf-to-patch-name
)
456 (set-buffer-modified-p buf-mod-status
))
457 (ediff-eval-in-buffer ediff-buffer-B
458 (setq buffer-auto-save-file-name nil
) ; don't create auto-save file
459 (if default-dir
(setq default-directory default-dir
))
460 (set-visited-file-name nil
)
461 (rename-buffer (ediff-unique-buffer-name
462 (concat buf-to-patch-name
"_patched") ""))
463 (set-buffer-modified-p t
))))
466 (defun ediff-patch-file-internal (patch-buf source-filename
467 &optional startup-hooks
)
468 (setq source-filename
(expand-file-name source-filename
))
470 (let* ((shell-file-name ediff-shell
)
471 (patch-diagnostics (get-buffer-create "*ediff patch diagnostics*"))
472 ;; ediff-find-file may use a temp file to do the patch
473 ;; so, we save source-filename and true-source-filename as a var
474 ;; that initially is source-filename but may be changed to a temp
475 ;; file for the purpose of patching.
476 (true-source-filename source-filename
)
477 (target-filename source-filename
)
478 target-buf buf-to-patch file-name-magic-p
479 patch-return-code ctl-buf backup-style aux-wind
)
481 (if (string-match "-V" ediff-patch-options
)
483 "Ediff doesn't take the -V option in `ediff-patch-options'--sorry"))
485 ;; Make a temp file, if source-filename has a magic file handler (or if
486 ;; it is handled via auto-mode-alist and similar magic).
487 ;; Check if there is a buffer visiting source-filename and if they are in
488 ;; sync; arrange for the deletion of temp file.
489 (ediff-find-file 'true-source-filename
'buf-to-patch
490 'ediff-last-dir-patch
'startup-hooks
)
492 ;; Check if source file name has triggered black magic, such as file name
493 ;; handlers or auto mode alist, and make a note of it.
494 ;; true-source-filename should be either the original name or a
495 ;; temporary file where we put the after-product of the file handler.
496 (setq file-name-magic-p
(not (equal (file-truename true-source-filename
)
497 (file-truename source-filename
))))
499 ;; Checkout orig file, if necessary, so that the patched file
500 ;; could be checked back in.
501 (ediff-maybe-checkout buf-to-patch
)
503 (ediff-eval-in-buffer patch-diagnostics
504 (insert-buffer patch-buf
)
505 (message "Applying patch ... ")
506 ;; fix environment for gnu patch, so it won't make numbered extensions
507 (setq backup-style
(getenv "VERSION_CONTROL"))
508 (setenv "VERSION_CONTROL" nil
)
509 (setq patch-return-code
511 (point-min) (point-max)
513 t
; delete region (which contains the patch
514 t
; insert output (patch diagnostics) in current buffer
515 nil
; don't redisplay
516 shell-command-switch
; usually -c
517 (format "%s %s %s %s"
521 (expand-file-name true-source-filename
))
524 ;; restore environment for gnu patch
525 (setenv "VERSION_CONTROL" backup-style
))
527 (message "Applying patch ... done")
530 (switch-to-buffer patch-diagnostics
)
531 (sit-for 0) ; synchronize - let the user see diagnostics
533 (or (and (eq patch-return-code
0) ; patch reported success
535 (concat true-source-filename ediff-backup-extension
)))
537 (with-output-to-temp-buffer ediff-msg-buffer
539 Patch has failed OR the backup version of the patched file was not created by
542 One reason may be that the values of the variables
544 ediff-patch-options = %S
545 ediff-backup-extension = %S
546 ediff-backup-specs = %S
548 are not appropriate for the program specified in the variable
550 ediff-patch-program = %S
552 Another reason could be that the %S program doesn't understand
553 the format of the patch file you used.
555 See Ediff on-line manual for more details on these variables.
556 \(Or use a GNU-compatible patch program and stay out of trouble.\)
558 Type any key to continue...
561 ediff-backup-extension
564 ediff-patch-program
)))
566 (if (setq aux-wind
(get-buffer-window ediff-msg-buffer
))
568 (select-window aux-wind
)
569 (goto-char (point-max))))
570 (read-char-exclusive)
571 (if aux-wind
(bury-buffer)) ; ediff-msg-buffer
572 (if (setq aux-wind
(get-buffer-window patch-diagnostics
))
574 (select-window aux-wind
)
576 (error "Patch appears to have failed")))
578 ;; If black magic is involved, apply patch to a temp copy of the
579 ;; file. Otherwise, apply patch to the orig copy. If patch is applied
580 ;; to temp copy, we name the result old-name_patched for local files
581 ;; and temp-copy_patched for remote files. The orig file name isn't
582 ;; changed, and the temp copy of the original is later deleted.
583 ;; Without magic, the original file is renamed (usually into
584 ;; old-name_orig) and the result of patching will have the same name as
586 (if (not file-name-magic-p
)
587 (ediff-eval-in-buffer buf-to-patch
588 (set-visited-file-name
589 (concat source-filename ediff-backup-extension
))
590 (set-buffer-modified-p nil
))
592 ;; Black magic in effect.
593 ;; If orig file was remote, put the patched file in the temp directory.
594 ;; If orig file is local, put the patched file in the directory of
596 (setq target-filename
598 (if (ediff-file-remote-p (file-truename source-filename
))
603 (rename-file true-source-filename target-filename t
)
605 ;; arrange that the temp copy of orig will be deleted
606 (rename-file (concat true-source-filename ediff-backup-extension
)
607 true-source-filename t
))
609 ;; make orig buffer read-only
611 (cons 'ediff-set-read-only-in-buf-A startup-hooks
))
613 ;; set up a buf for the patched file
614 (setq target-buf
(find-file-noselect target-filename
))
617 (ediff-buffers-internal
618 buf-to-patch target-buf nil
619 startup-hooks
'epatch
))
620 (ediff-eval-in-buffer ctl-buf
621 (setq ediff-patchbufer patch-buf
622 ediff-patch-diagnostics patch-diagnostics
))
624 (bury-buffer patch-diagnostics
)
625 (message "Type `P', if you need to see patch diagnostics")
628 (defun ediff-multi-patch-internal (patch-buf &optional startup-hooks
)
631 ;; this sets various vars in the meta buffer inside
632 ;; ediff-prepare-meta-buffer
634 ;; tell what to do if the user clicks on a session record
635 (setq ediff-session-action-function
636 'ediff-patch-file-form-meta
637 ediff-meta-patchbufer patch-buf
)
640 (setq meta-buf
(ediff-prepare-meta-buffer
641 'ediff-filegroup-action
642 (ediff-eval-in-buffer patch-buf
643 ;; nil replaces a regular expression
644 (cons (list nil
(format "%S" patch-buf
))
646 "*Ediff Session Group Panel"
647 'ediff-redraw-directory-group-buffer
648 'ediff-multifile-patch
650 (ediff-show-meta-buffer meta-buf
)
657 ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
658 ;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
659 ;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
662 ;;; ediff-ptch.el ends here