Function: ediff-fixup-patch-map
ediff-fixup-patch-map is a byte-compiled function defined in
ediff-ptch.el.gz.
Signature
(ediff-fixup-patch-map FILENAME)
Source Code
;; Defined in /usr/src/emacs/lisp/vc/ediff-ptch.el.gz
;; Fix up the file names in the list using the argument FILENAME
;; Algorithm: find the files' directories in the patch and, if a directory is
;; absolute, cut it out from the corresponding file name in the patch.
;; Relative directories are not cut out.
;; Prepend the directory of FILENAME to each resulting file (which came
;; originally from the patch).
;; In addition, the first file in the patch document is replaced by FILENAME.
;; Each file is actually a pair of files found in the context diff header
;; In the end, for each pair, we ask the user which file to patch.
;; Note: Ediff doesn't recognize multi-file patches that are separated
;; with the `Index:' line. It treats them as a single-file patch.
;;
;; Executes inside the patch buffer
(defun ediff-fixup-patch-map (filename)
(setq filename (expand-file-name filename))
(let ((actual-dir (if (file-directory-p filename)
;; directory part of filename
(file-name-as-directory filename)
(file-name-directory filename)))
(multi-patch-p (cdr ediff-patch-map))
;; In case 2 files are possible patch targets, the user will be offered
;; to choose file1 or file2. In a multifile patch, if the user chooses
;; 1 or 2, this choice is preserved to decide future alternatives.
chosen-alternative
)
;; chop off base-dirs
(mapc (lambda (session-info)
(let* ((proposed-file-names
;; Filename-spec is objA; it is represented as
;; (file1 . file2). Get it using ediff-get-session-objA.
(ediff-get-session-objA-name session-info))
;; base-dir1 is the dir part of the 1st file in the patch
(base-dir1
(or (file-name-directory (car proposed-file-names))
""))
;; directory part of the 2nd file in the patch
(base-dir2
(or (file-name-directory (cdr proposed-file-names))
""))
)
;; If both base-dir1 and base-dir2 are relative and exist,
;; assume that
;; these dirs lead to the actual files starting at the present
;; directory. So, we don't strip these relative dirs from the
;; file names. This is a heuristic intended to improve guessing
(let ((default-directory (file-name-directory filename)))
(unless (or (file-name-absolute-p base-dir1)
(file-name-absolute-p base-dir2))
(if (and (file-exists-p base-dir1)
(file-exists-p base-dir2))
(setq base-dir1 ""
base-dir2 "")
;; Strip possible source/destination prefixes
;; such as a/ and b/ from dir names.
(save-match-data
(let ((m1 (when (string-match "^[^/]+/" base-dir1)
(cons (substring base-dir1 0 (match-end 0))
(substring base-dir1 (match-end 0)))))
(m2 (when (string-match "^[^/]+/" base-dir2)
(cons (substring base-dir2 0 (match-end 0))
(substring base-dir2 (match-end 0))))))
(when (and (file-exists-p (cdr m1))
(file-exists-p (cdr m2)))
(setq base-dir1 (car m1)
base-dir2 (car m2))))))))
(or (string= (car proposed-file-names) null-device)
(setcar proposed-file-names
(ediff-file-name-sans-prefix
(car proposed-file-names) base-dir1)))
(or (string=
(cdr proposed-file-names) null-device)
(setcdr proposed-file-names
(ediff-file-name-sans-prefix
(cdr proposed-file-names) base-dir2)))
))
ediff-patch-map)
;; take the given file name into account
(or (file-directory-p filename)
(string= null-device filename)
(setcar (ediff-get-session-objA (car ediff-patch-map))
(cons (file-name-nondirectory filename)
(file-name-nondirectory filename))))
;; prepend actual-dir
(mapc (lambda (session-info)
(let ((proposed-file-names
(ediff-get-session-objA-name session-info)))
(if (and (string-match-p "^/null/" (car proposed-file-names))
(string-match-p "^/null/" (cdr proposed-file-names)))
;; couldn't intuit the file name to patch, so
;; something is amiss
(progn
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ
(format-message "
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)
;; Check for the existing files in each pair and discard the nonexistent
;; ones. If both exist, ask the user.
(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
;; The patch program prefers the shortest file as the patch
;; target. However, this is a questionable heuristic. In an
;; interactive program, like ediff, we can offer the user a
;; choice.
;; (< (length file2) (length file1))
(not f1-exists)
f2-exists)
;; replace file-pair with the winning file2
(setcar session-file-object file2))
((and
;; (< (length file1) (length file2))
(not f2-exists)
f1-exists)
;; replace file-pair with the winning file1
(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))
(with-current-buffer standard-output
(insert (format-message
(substitute-command-keys "
Ediff has inferred that
%s
%s
are two possible targets for applying the patch.
Both files seem to be plausible alternatives.
Please advise:
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
;; TODO: Often for multi-patches the file doesn't exist
;; because the directory part is wrong; for instance, if the
;; patch needs to be applied into
;; (expand-file-name "lisp/vc/ediff-ptch.el" source-directory)
;; and default-directory is
;; (expand-file-name "lisp" source-directory)
;; then Ediff assumes the wrong file:
;; (expand-file-name "lisp/ediff-ptch.el" source-directory).
;; We might identify these common failures and suggest
;; in the prompt the possible corrected file. --Tino
(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 %s target for this %spatch. However, this file does not exist."
file1
(if multi-patch-p "one" "the")
(if multi-patch-p "multi-" "")))
(princ (format "
%s
%s
are two possible targets for this %spatch. However, these files do not exist."
file1 file2 (if multi-patch-p "multi-" ""))))
(princ "
\nPlease enter an alternative patch target ...\n"))
(when (and (string= file1 file2)
(y-or-n-p (format "Create %s?" file1)))
(write-region (point-min) (point-min) file1))
(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)
))