(defgroup ediff-ptch nil
"Ediff patch support."
:tag "Patch"
:prefix "ediff-"
:group 'ediff)
(defvar ediff-window-A)
(defvar ediff-window-B)
(defvar ediff-window-C)
(defvar ediff-use-last-dir)
(defvar ediff-shell)
(eval-when-compile
(let ((load-path (cons (expand-file-name ".") load-path)))
(or (featurep 'ediff-init)
(load "ediff-init.el" nil nil 'nosuffix))
(or (featurep 'ediff-mult)
(load "ediff-mult.el" nil nil 'nosuffix))
(or (featurep 'ediff)
(load "ediff.el" nil nil 'nosuffix))
))
(require 'ediff-init)
(defcustom ediff-patch-program "patch"
"*Name of the program that applies patches.
It is recommended to use GNU-compatible versions."
:type 'string
:group 'ediff-ptch)
(defcustom ediff-patch-options "-f"
"*Options to pass to ediff-patch-program.
Note: the `-b' option should be specified in `ediff-backup-specs'.
It is recommended to pass the `-f' option to the patch program, so it won't ask
questions. However, some implementations don't accept this option, in which
case the default value for this variable should be changed."
:type 'string
:group 'ediff-ptch)
(defvar ediff-last-dir-patch nil
"Last directory used by an Ediff command for file to patch.")
(defconst ediff-default-backup-extension
(if (memq system-type '(vax-vms axp-vms emx ms-dos))
"_orig" ".orig"))
(defcustom ediff-backup-extension ediff-default-backup-extension
"Backup extension used by the patch program.
See also `ediff-backup-specs'."
:type 'string
:group 'ediff-ptch)
(defun ediff-test-patch-utility ()
(condition-case nil
(cond ((eq 0 (call-process ediff-patch-program nil nil nil "-z." "-b"))
'gnu)
((eq 0 (call-process ediff-patch-program nil nil nil "-b"))
'posix)
(t 'traditional))
(file-error nil)))
(defcustom ediff-backup-specs
(let ((type (ediff-test-patch-utility)))
(cond ((eq type 'gnu)
(format "-z%s -b" ediff-backup-extension))
((eq type 'posix)
(setq ediff-backup-extension ediff-default-backup-extension)
"-b")
(t
(format "-b %s" ediff-backup-extension))))
"*Backup directives to pass to the patch program.
Ediff requires that the old version of the file \(before applying the patch\)
be saved in a file named `the-patch-file.extension'. Usually `extension' is
`.orig', but this can be changed by the user and may depend on the system.
Therefore, Ediff needs to know the backup extension used by the patch program.
Some versions of the patch program let you specify `-b backup-extension'.
Other versions only permit `-b', which assumes the extension `.orig'
\(in which case ediff-backup-extension MUST be also `.orig'\). The latest
versions of GNU patch require `-b -z backup-extension'.
Note that both `ediff-backup-extension' and `ediff-backup-specs'
must be set properly. If your patch program takes the option `-b',
but not `-b extension', the variable `ediff-backup-extension' must
still be set so Ediff will know which extension to use.
Ediff tries to guess the appropriate value for this variables. It is believed
to be working for `traditional' patch, all versions of GNU patch, and for POSIX
patch. So, don't change these variables, unless the default doesn't work."
:type 'string
:group 'ediff-ptch)
(defcustom ediff-patch-default-directory nil
"*Default directory to look for patches."
:type '(choice (const nil) string)
:group 'ediff-ptch)
(defcustom ediff-context-diff-label-regexp
(concat "\\(" "^\\*\\*\\* \\([^ \t]+\\)[^*]+[\t ]*\n--- \\([^ \t]+\\)"
"\\|" "^--- \\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ \\([^ \t]+\\)"
"\\)")
"*Regexp matching filename 2-liners at the start of each context diff.
You probably don't want to change that, unless you are using an obscure patch
program."
:type 'regexp
:group 'ediff-ptch)
(ediff-defvar-local ediff-patchbufer nil "")
(ediff-defvar-local ediff-patch-diagnostics nil "")
(ediff-defvar-local ediff-patch-map nil "")
(defsubst ediff-file-name-sans-prefix (filename prefix)
(if prefix
(save-match-data
(if (string-match (concat "^" (if (stringp prefix)
(regexp-quote prefix)
""))
filename)
(substring filename (match-end 0))
(concat "/null/" filename)))
filename)
)
(defun ediff-count-matches (regexp buf)
(ediff-with-current-buffer buf
(let ((count 0) opoint)
(save-excursion
(goto-char (point-min))
(while (and (not (eobp))
(progn (setq opoint (point))
(re-search-forward regexp nil t)))
(if (= opoint (point))
(forward-char 1)
(setq count (1+ count)))))
count)))
(defun ediff-map-patch-buffer (buf)
(ediff-with-current-buffer buf
(let ((count 0)
(mark1 (move-marker (make-marker) (point-min)))
(mark1-end (point-min))
(possible-file-names '("/dev/null" . "/dev/null"))
mark2-end mark2 filenames
beg1 beg2 end1 end2
patch-map opoint)
(save-excursion
(goto-char (point-min))
(setq opoint (point))
(while (and (not (eobp))
(re-search-forward ediff-context-diff-label-regexp nil t))
(if (= opoint (point))
(forward-char 1) (setq mark2 (move-marker (make-marker) (match-beginning 0))
mark2-end (match-end 0)
beg1 (or (match-beginning 2) (match-beginning 4))
end1 (or (match-end 2) (match-end 4))
beg2 (or (match-beginning 3) (match-beginning 5))
end2 (or (match-end 3) (match-end 5)))
(setq possible-file-names
(cons (if (and beg1 end1)
(buffer-substring beg1 end1)
"/dev/null")
(if (and beg2 end2)
(buffer-substring beg2 end2)
"/dev/null")))
(if (re-search-backward "^Index:" mark1-end 'noerror)
(move-marker mark2 (match-beginning 0)))
(if (re-search-backward "^Prereq:" mark1-end 'noerror)
(move-marker mark2 (match-beginning 0)))
(goto-char mark2-end)
(if filenames
(setq patch-map
(cons (ediff-make-new-meta-list-element
filenames mark1 mark2)
patch-map)))
(setq mark1 mark2
mark1-end mark2-end
filenames possible-file-names))
(setq opoint (point)
count (1+ count))))
(setq mark2 (point-max-marker)
patch-map (cons (ediff-make-new-meta-list-element
possible-file-names mark1 mark2)
patch-map))
(setq ediff-patch-map (nreverse patch-map))
count)))
(defun ediff-fixup-patch-map (filename)
(setq filename (expand-file-name filename))
(let ((actual-dir (if (file-directory-p filename)
(file-name-as-directory filename)
(file-name-directory filename)))
chosen-alternative
)
(mapcar (lambda (session-info)
(let* ((proposed-file-names
(ediff-get-session-objA-name session-info))
(base-dir1
(or (file-name-directory (car proposed-file-names))
""))
(base-dir2
(or (file-name-directory (cdr proposed-file-names))
""))
)
(unless (or (file-name-absolute-p base-dir1)
(file-name-absolute-p base-dir2)
(not (file-exists-p base-dir1))
(not (file-exists-p base-dir2)))
(setq base-dir1 ""
base-dir2 ""))
(or (string= (car proposed-file-names) "/dev/null")
(setcar proposed-file-names
(ediff-file-name-sans-prefix
(car proposed-file-names) base-dir1)))
(or (string=
(cdr proposed-file-names) "/dev/null")
(setcdr proposed-file-names
(ediff-file-name-sans-prefix
(cdr proposed-file-names) base-dir2)))
))
ediff-patch-map)
(or (file-directory-p filename)
(string= "/dev/null" filename)
(setcar (ediff-get-session-objA (car ediff-patch-map))
(cons (file-name-nondirectory filename)
(file-name-nondirectory filename))))
(mapcar (lambda (session-info)
(let ((proposed-file-names
(ediff-get-session-objA-name session-info)))
(if (and (string-match "^/null/" (car proposed-file-names))
(string-match "^/null/" (cdr proposed-file-names)))
(progn
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ
(format "
The patch file contains a context diff for
%s
%s
However, Ediff cannot infer the name of the actual file
to be patched on your system. If you know the correct file name,
please enter it now.
If you don't know and still would like to apply patches to
other files, enter /dev/null
"
(substring (car proposed-file-names) 6)
(substring (cdr proposed-file-names) 6))))
(let ((directory t)
user-file)
(while directory
(setq user-file
(read-file-name
"Please enter file name: "
actual-dir actual-dir t))
(if (not (file-directory-p user-file))
(setq directory nil)
(setq directory t)
(beep)
(message "%s is a directory" user-file)
(sit-for 2)))
(setcar (ediff-get-session-objA session-info)
(cons user-file user-file))))
(setcar proposed-file-names
(expand-file-name
(concat actual-dir (car proposed-file-names))))
(setcdr proposed-file-names
(expand-file-name
(concat actual-dir (cdr proposed-file-names)))))
))
ediff-patch-map)
(mapcar (lambda (session-info)
(let* ((file1 (car (ediff-get-session-objA-name session-info)))
(file2 (cdr (ediff-get-session-objA-name session-info)))
(session-file-object
(ediff-get-session-objA session-info))
(f1-exists (file-exists-p file1))
(f2-exists (file-exists-p file2)))
(cond
((and
(not f1-exists)
f2-exists)
(setcar session-file-object file2))
((and
(not f2-exists)
f1-exists)
(setcar session-file-object file1))
((and f1-exists f2-exists
(string= file1 file2))
(setcar session-file-object file1))
((and f1-exists f2-exists (eq chosen-alternative 1))
(setcar session-file-object file1))
((and f1-exists f2-exists (eq chosen-alternative 2))
(setcar session-file-object file2))
((and f1-exists f2-exists)
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ (format "
Ediff has inferred that
%s
%s
are two possible targets for applying the patch.
Both files seem to be plausible alternatives.
Please advice:
Type `y' to use %s as the target;
Type `n' to use %s as the target.
"
file1 file2 file1 file2)))
(setcar session-file-object
(if (y-or-n-p (format "Use %s ? " file1))
(progn
(setq chosen-alternative 1)
file1)
(setq chosen-alternative 2)
file2))
)
(f2-exists (setcar session-file-object file2))
(f1-exists (setcar session-file-object file1))
(t
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ "\nEdiff has inferred that")
(if (string= file1 file2)
(princ (format "
%s
is assumed to be the target for this patch. However, this file does not exist."
file1))
(princ (format "
%s
%s
are two possible targets for this patch. However, these files do not exist."
file1 file2)))
(princ "
\nPlease enter an alternative patch target ...\n"))
(let ((directory t)
target)
(while directory
(setq target (read-file-name
"Please enter a patch target: "
actual-dir actual-dir t))
(if (not (file-directory-p target))
(setq directory nil)
(beep)
(message "%s is a directory" target)
(sit-for 2)))
(setcar session-file-object target))))))
ediff-patch-map)
))
(defun ediff-show-patch-diagnostics ()
(interactive)
(cond ((window-live-p ediff-window-A)
(set-window-buffer ediff-window-A ediff-patch-diagnostics))
((window-live-p ediff-window-B)
(set-window-buffer ediff-window-B ediff-patch-diagnostics))
(t (display-buffer ediff-patch-diagnostics 'not-this-window))))
(defun ediff-prompt-for-patch-file ()
(let ((dir (cond (ediff-use-last-dir ediff-last-dir-patch)
(ediff-patch-default-directory) (t default-directory)))
(coding-system-for-read ediff-coding-system-for-read)
patch-file-name)
(setq patch-file-name
(read-file-name
(format "Patch is in file%s: "
(cond ((and buffer-file-name
(equal (expand-file-name dir)
(file-name-directory buffer-file-name)))
(concat
" (default "
(file-name-nondirectory buffer-file-name)
")"))
(t "")))
dir buffer-file-name 'must-match))
(if (file-directory-p patch-file-name)
(error "Patch file cannot be a directory: %s" patch-file-name)
(find-file-noselect patch-file-name))
))
(defun ediff-prompt-for-patch-buffer ()
(get-buffer
(read-buffer
"Buffer that holds the patch: "
(cond ((save-excursion
(goto-char (point-min))
(re-search-forward ediff-context-diff-label-regexp nil t))
(current-buffer))
((save-window-excursion
(other-window 1)
(save-excursion
(goto-char (point-min))
(and (re-search-forward ediff-context-diff-label-regexp nil t)
(current-buffer)))))
((save-window-excursion
(other-window -1)
(save-excursion
(goto-char (point-min))
(and (re-search-forward ediff-context-diff-label-regexp nil t)
(current-buffer)))))
(t (ediff-other-buffer (current-buffer))))
'must-match)))
(defun ediff-get-patch-buffer (&optional arg patch-buf)
"Obtain patch buffer. If patch is already in a buffer---use it.
Else, read patch file into a new buffer. If patch buffer is passed as an
optional argument, then use it."
(let ((last-nonmenu-event t) last-command-event)
(cond ((ediff-buffer-live-p patch-buf))
((and (integerp arg) (eq 0 (mod arg 2)))
(setq patch-buf (ediff-prompt-for-patch-buffer)))
((and (integerp arg) (eq 1 (mod arg 2)))
(setq patch-buf (ediff-prompt-for-patch-file)))
(t (setq patch-buf
(if (y-or-n-p "Is the patch already in a buffer? ")
(ediff-prompt-for-patch-buffer)
(ediff-prompt-for-patch-file)))))
(ediff-with-current-buffer patch-buf
(goto-char (point-min))
(or (ediff-get-visible-buffer-window patch-buf)
(progn
(pop-to-buffer patch-buf 'other-window)
(select-window (previous-window)))))
(ediff-map-patch-buffer patch-buf)
patch-buf))
(defun ediff-dispatch-file-patching-job (patch-buf filename
&optional startup-hooks)
(ediff-with-current-buffer patch-buf
(ediff-fixup-patch-map filename)
(if (< (length ediff-patch-map) 2)
(ediff-patch-file-internal
patch-buf
(if (and ediff-patch-map
(not (string-match
"^/dev/null"
(ediff-get-session-objA-name (car ediff-patch-map))))
(> (length
(ediff-get-session-objA-name (car ediff-patch-map)))
1))
(ediff-get-session-objA-name (car ediff-patch-map))
filename)
startup-hooks)
(ediff-multi-patch-internal patch-buf startup-hooks))
))
(defun ediff-patch-buffer-internal (patch-buf
buf-to-patch-name
&optional startup-hooks)
(let* ((buf-to-patch (get-buffer buf-to-patch-name))
(visited-file (if buf-to-patch (buffer-file-name buf-to-patch)))
(buf-mod-status (buffer-modified-p buf-to-patch))
(multifile-patch-p (> (length (ediff-with-current-buffer patch-buf
ediff-patch-map)) 1))
default-dir file-name ctl-buf)
(if multifile-patch-p
(error
"To apply multi-file patches, please use `ediff-patch-file'"))
(ediff-with-current-buffer buf-to-patch
(setq default-dir default-directory)
(setq file-name (ediff-make-temp-file buf-to-patch))
(set-visited-file-name file-name)
(or visited-file
(setq buffer-auto-save-file-name nil))
(rename-buffer buf-to-patch-name)
(set-buffer-modified-p nil)
(set-visited-file-modtime) (setq default-directory default-dir)
)
(setq ctl-buf (ediff-dispatch-file-patching-job
patch-buf file-name startup-hooks))
(ediff-with-current-buffer ctl-buf
(delete-file (buffer-file-name ediff-buffer-A))
(delete-file (buffer-file-name ediff-buffer-B))
(ediff-with-current-buffer ediff-buffer-A
(if default-dir (setq default-directory default-dir))
(set-visited-file-name visited-file) (rename-buffer buf-to-patch-name)
(set-buffer-modified-p buf-mod-status))
(ediff-with-current-buffer ediff-buffer-B
(setq buffer-auto-save-file-name nil) (if default-dir (setq default-directory default-dir))
(set-visited-file-name nil)
(rename-buffer (ediff-unique-buffer-name
(concat buf-to-patch-name "_patched") ""))
(set-buffer-modified-p t)))
))
(defun ediff-patch-return-code-ok (code)
(eq code 0))
(defun ediff-patch-file-internal (patch-buf source-filename
&optional startup-hooks)
(setq source-filename (expand-file-name source-filename))
(let* ((shell-file-name ediff-shell)
(patch-diagnostics (get-buffer-create "*ediff patch diagnostics*"))
(true-source-filename source-filename)
(target-filename source-filename)
(coding-system-for-write
(if (boundp 'buffer-file-coding-system) buffer-file-coding-system))
target-buf buf-to-patch file-name-magic-p
patch-return-code ctl-buf backup-style aux-wind)
(if (string-match "V" ediff-patch-options)
(error
"Ediff doesn't take the -V option in `ediff-patch-options'--sorry"))
(ediff-find-file 'true-source-filename 'buf-to-patch
'ediff-last-dir-patch 'startup-hooks)
(setq file-name-magic-p (not (equal (file-truename true-source-filename)
(file-truename source-filename))))
(ediff-maybe-checkout buf-to-patch)
(ediff-with-current-buffer patch-diagnostics
(insert-buffer-substring patch-buf)
(message "Applying patch ... ")
(setq backup-style (getenv "VERSION_CONTROL"))
(setenv "VERSION_CONTROL" nil)
(setq patch-return-code
(call-process-region
(point-min) (point-max)
shell-file-name
t t nil shell-command-switch (format "%s %s %s %s"
ediff-patch-program
ediff-patch-options
ediff-backup-specs
(expand-file-name true-source-filename))
))
(setenv "VERSION_CONTROL" backup-style))
(message "Applying patch ... done")
(message "")
(switch-to-buffer patch-diagnostics)
(sit-for 0)
(or (and (ediff-patch-return-code-ok patch-return-code)
(file-exists-p
(concat true-source-filename ediff-backup-extension)))
(progn
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ (format
"Patch program has failed due to a bad patch file,
it couldn't apply all hunks, OR
it couldn't create the backup for the file being patched.
The former could be caused by a corrupt patch file or because the %S
program doesn't understand the format of the patch file in use.
The second problem might be due to an incompatibility among these settings:
ediff-patch-program = %S ediff-patch-options = %S
ediff-backup-extension = %S ediff-backup-specs = %S
See Ediff on-line manual for more details on these variables.
In particular, check the documentation for `ediff-backup-specs'.
In any of the above cases, Ediff doesn't compare files automatically.
However, if the patch was applied partially and the backup file was created,
you can still examine the changes via M-x ediff-files"
ediff-patch-program
ediff-patch-program
ediff-patch-options
ediff-backup-extension
ediff-backup-specs
)))
(beep 1)
(if (setq aux-wind (get-buffer-window ediff-msg-buffer))
(progn
(select-window aux-wind)
(goto-char (point-max))))
(switch-to-buffer-other-window patch-diagnostics)
(error "Patch appears to have failed")))
(if (not file-name-magic-p)
(ediff-with-current-buffer buf-to-patch
(set-visited-file-name
(concat source-filename ediff-backup-extension))
(set-buffer-modified-p nil))
(setq target-filename
(concat
(if (ediff-file-remote-p (file-truename source-filename))
true-source-filename
source-filename)
"_patched"))
(rename-file true-source-filename target-filename t)
(rename-file (concat true-source-filename ediff-backup-extension)
true-source-filename t))
(setq startup-hooks
(cons 'ediff-set-read-only-in-buf-A startup-hooks))
(setq target-buf (find-file-noselect target-filename))
(setq ctl-buf
(ediff-buffers-internal
buf-to-patch target-buf nil
startup-hooks 'epatch))
(ediff-with-current-buffer ctl-buf
(setq ediff-patchbufer patch-buf
ediff-patch-diagnostics patch-diagnostics))
(bury-buffer patch-diagnostics)
(message "Type `P', if you need to see patch diagnostics")
ctl-buf))
(defun ediff-multi-patch-internal (patch-buf &optional startup-hooks)
(let (meta-buf)
(setq startup-hooks
(cons `(lambda ()
(setq ediff-session-action-function
'ediff-patch-file-form-meta
ediff-meta-patchbufer patch-buf) )
startup-hooks))
(setq meta-buf (ediff-prepare-meta-buffer
'ediff-filegroup-action
(ediff-with-current-buffer patch-buf
(cons (ediff-make-new-meta-list-header
nil (format "%S" patch-buf) nil nil nil nil )
ediff-patch-map))
"*Ediff Session Group Panel"
'ediff-redraw-directory-group-buffer
'ediff-multifile-patch
startup-hooks))
(ediff-show-meta-buffer meta-buf)
))
(provide 'ediff-ptch)