X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/3af0304a614da0c7f9b049623c1d814926930f95..d9df5bffac090389cdd163ba04feeb11f0e2d8b8:/lisp/ediff-ptch.el diff --git a/lisp/ediff-ptch.el b/lisp/ediff-ptch.el index 2bac3192b3..df781e92b5 100644 --- a/lisp/ediff-ptch.el +++ b/lisp/ediff-ptch.el @@ -1,8 +1,9 @@ ;;; ediff-ptch.el --- Ediff's patch support -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, +;; 2003, 2004, 2005 Free Software Foundation, Inc. -;; Author: Michael Kifer +;; Author: Michael Kifer ;; This file is part of GNU Emacs. @@ -18,16 +19,17 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;; Commentary: ;;; Code: - + (provide 'ediff-ptch) (defgroup ediff-ptch nil - "Ediff patch support" + "Ediff patch support." :tag "Patch" :prefix "ediff-" :group 'ediff) @@ -43,6 +45,8 @@ (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)) )) @@ -73,7 +77,7 @@ case the default value for this variable should be changed." (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. @@ -82,14 +86,16 @@ See also `ediff-backup-specs'." :group 'ediff-ptch) (defun ediff-test-patch-utility () - (cond ((zerop (call-process ediff-patch-program nil nil nil "-z." "-b")) - ;; GNU `patch' v. >= 2.2 - 'gnu) - ((zerop (call-process ediff-patch-program nil nil nil "-b")) - 'posix) - (t 'traditional))) - -(defcustom ediff-backup-specs + (condition-case nil + (cond ((eq 0 (call-process ediff-patch-program nil nil nil "-z." "-b")) + ;; GNU `patch' v. >= 2.2 + '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) ;; GNU `patch' v. >= 2.2 @@ -158,7 +164,7 @@ program." ;; returns /dev/null, if can't strip prefix (defsubst ediff-file-name-sans-prefix (filename prefix) (save-match-data - (if (string-match (concat "^" prefix) filename) + (if (string-match (concat "^" (regexp-quote prefix)) filename) (substring filename (match-end 0)) (concat "/null/" filename)))) @@ -179,12 +185,22 @@ program." (setq count (1+ count))))) count))) -;; Scan BUF (which is supposed to contain a patch) and make a list of the form -;; ((filename1 marker1 marker2) (filename2 marker1 marker2) ...) -;; where filenames are files to which patch would have applied the patch; -;; marker1 delimits the beginning of the corresponding patch and marker2 does -;; it for the end. This list is then assigned to ediff-patch-map. -;; Returns the number of elements in the list ediff-patch-map +;; Scan BUF (which is supposed to contain a patch) and make a list of the form +;; ((nil nil filename-spec1 marker1 marker2) +;; (nil nil filename-spec2 marker1 marker2) ...) +;; where filename-spec[12] are files to which the `patch' program would +;; have applied the patch. +;; nin, nil are placeholders. See ediff-make-new-meta-list-element in +;; ediff-meta.el for the explanations. +;; In the beginning we don't know exactly which files need to be patched. +;; We usually come up with two candidates and ediff-file-name-sans-prefix +;; resolves this later. +;; +;; The marker `marker1' delimits the beginning of the corresponding patch and +;; `marker2' does it for the end. +;; The result of ediff-map-patch-buffer is a list, which is then assigned +;; to ediff-patch-map. +;; The function returns the number of elements in the list ediff-patch-map (defun ediff-map-patch-buffer (buf) (ediff-with-current-buffer buf (let ((count 0) @@ -209,7 +225,8 @@ program." end2 (or (match-end 3) (match-end 5))) ;; possible-file-names is holding the new file names until we ;; insert the old file name in the patch map - ;; It is a pair (filename from 1st header line . fn from 2nd line) + ;; It is a pair + ;; (filename-from-1st-header-line . fn from 2nd line) (setq possible-file-names (cons (if (and beg1 end1) (buffer-substring beg1 end1) @@ -224,16 +241,21 @@ program." (move-marker mark2 (match-beginning 0))) (goto-char mark2-end) - + (if filenames - (setq patch-map (cons (list filenames mark1 mark2) patch-map))) + (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 (list possible-file-names mark1 mark2) patch-map)) + patch-map (cons (ediff-make-new-meta-list-element + possible-file-names mark1 mark2) + patch-map)) (setq ediff-patch-map (nreverse patch-map)) count))) @@ -253,42 +275,53 @@ program." ;; directory part of filename (file-name-as-directory filename) (file-name-directory filename))) + ;; Filename-spec is objA; at this point it is represented as + ;; (file1 . file2). We get it using ediff-get-session-objA ;; directory part of the first file in the patch - (base-dir1 (file-name-directory (car (car (car ediff-patch-map))))) - (base-dir2 (file-name-directory (cdr (car (car ediff-patch-map))))) + (base-dir1 (file-name-directory + (car (ediff-get-session-objA-name (car ediff-patch-map))))) + ;; directory part of the 2nd file in the patch + (base-dir2 (file-name-directory + (cdr (ediff-get-session-objA-name (car ediff-patch-map))))) ) ;; chop off base-dirs - (mapcar (lambda (triple) - (or (string= (car (car triple)) "/dev/null") - (setcar (car triple) + (mapcar (lambda (session-info) + (let ((proposed-file-names + (ediff-get-session-objA-name session-info))) + (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 - (car (car triple)) base-dir1))) - (or (string= (cdr (car triple)) "/dev/null") - (setcdr (car triple) - (ediff-file-name-sans-prefix - (cdr (car triple)) base-dir2))) - ) + (cdr proposed-file-names) base-dir2))) + )) ediff-patch-map) ;; take the given file name into account (or (file-directory-p filename) (string= "/dev/null" filename) - (progn - (setcar (car ediff-patch-map) - (cons (file-name-nondirectory filename) - (file-name-nondirectory filename))))) + (setcar (ediff-get-session-objA (car ediff-patch-map)) + (cons (file-name-nondirectory filename) + (file-name-nondirectory filename)))) ;; prepend actual-dir - (mapcar (lambda (triple) - (if (and (string-match "^/null/" (car (car triple))) - (string-match "^/null/" (cdr (car triple)))) - ;; couldn't strip base-dir1 and base-dir2 - ;; hence, something wrong - (progn - (with-output-to-temp-buffer ediff-msg-buffer - (princ - (format " + (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))) + ;; couldn't strip base-dir1 and base-dir2 + ;; hence, something is wrong + (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 @@ -299,49 +332,56 @@ please enter it now. If you don't know and still would like to apply patches to other files, enter /dev/null " - (substring (car (car triple)) 6) - (substring (cdr (car triple)) 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 triple (cons user-file user-file)))) - (setcar (car triple) - (expand-file-name - (concat actual-dir (car (car triple))))) - (setcdr (car triple) - (expand-file-name - (concat actual-dir (cdr (car triple)))))) - ) + (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 shorter existing file in each pair and discard the other ;; one - (mapcar (lambda (triple) - (let* ((file1 (car (car triple))) - (file2 (cdr (car triple))) + (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 (< (length file2) (length file1)) f2-exists) - (setcar triple file2)) + ;; replace file-pair with the winning file2 + (setcar session-file-object file2)) ((and (< (length file1) (length file2)) f1-exists) - (setcar triple file1)) + ;; replace file-pair with the winning file1 + (setcar session-file-object file1)) ((and f1-exists f2-exists (string= file1 file2)) - (setcar triple file1)) + (setcar session-file-object file1)) ((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 @@ -354,13 +394,15 @@ Please advice: Type `n' to use %s as the target. " file1 file2 file2 file1))) - (setcar triple + (setcar session-file-object (if (y-or-n-p (format "Use %s ? " file2)) file2 file1))) - (f2-exists (setcar triple file2)) - (f1-exists (setcar triple file1)) + (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 " @@ -377,7 +419,7 @@ are two possible targets for this patch. However, these files do not exist." (let ((directory t) target) (while directory - (setq target (read-file-name + (setq target (read-file-name "Please enter a patch target: " actual-dir actual-dir t)) (if (not (file-directory-p target)) @@ -385,7 +427,7 @@ are two possible targets for this patch. However, these files do not exist." (beep) (message "%s is a directory" target) (sit-for 2))) - (setcar triple target)))))) + (setcar session-file-object target)))))) ediff-patch-map) )) @@ -401,7 +443,8 @@ are two possible targets for this patch. However, these files do not exist." (defun ediff-prompt-for-patch-file () (let ((dir (cond (ediff-patch-default-directory) ; try patch default dir (ediff-use-last-dir ediff-last-dir-patch) - (t default-directory)))) + (t default-directory))) + (coding-system-for-read ediff-coding-system-for-read)) (find-file-noselect (read-file-name (format "Patch is in file:%s " @@ -421,7 +464,7 @@ are two possible targets for this patch. However, these files do not exist." (defun ediff-prompt-for-patch-buffer () (get-buffer (read-buffer - "Patch is in buffer: " + "Buffer that holds the patch: " (cond ((save-excursion (goto-char (point-min)) (re-search-forward ediff-context-diff-label-regexp nil t)) @@ -438,7 +481,7 @@ are two possible targets for this patch. However, these files do not exist." (goto-char (point-min)) (and (re-search-forward ediff-context-diff-label-regexp nil t) (current-buffer))))) - (t nil)) + (t (ediff-other-buffer (current-buffer)))) 'must-match))) @@ -460,7 +503,7 @@ optional argument, then use it." (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) @@ -482,9 +525,15 @@ optional argument, then use it." (if (< (length ediff-patch-map) 2) (ediff-patch-file-internal patch-buf - (if (and (not (string-match "^/dev/null" (car (car ediff-patch-map)))) - (> (length (car (car ediff-patch-map))) 1)) - (car (car ediff-patch-map)) + (if (and ediff-patch-map + (not (string-match + "^/dev/null" + ;; this is the file to patch + (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)) @@ -523,11 +572,11 @@ optional argument, then use it." (set-visited-file-modtime) ; sync buffer and temp file (setq default-directory default-dir) ) - + ;; dispatch a patch function (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)) @@ -540,7 +589,7 @@ optional argument, then use it." (setq buffer-auto-save-file-name nil) ; don't create auto-save file (if default-dir (setq default-directory default-dir)) (set-visited-file-name nil) - (rename-buffer (ediff-unique-buffer-name + (rename-buffer (ediff-unique-buffer-name (concat buf-to-patch-name "_patched") "")) (set-buffer-modified-p t))) )) @@ -559,7 +608,7 @@ optional argument, then use it." (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*")) ;; ediff-find-file may use a temp file to do the patch @@ -568,13 +617,17 @@ optional argument, then use it." ;; file for the purpose of patching. (true-source-filename source-filename) (target-filename source-filename) - target-buf buf-to-patch file-name-magic-p + ;; this ensures that the patch process gets patch buffer in the + ;; encoding that Emacs thinks is right for that type of text + (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")) - + ;; Make a temp file, if source-filename has a magic file handler (or if ;; it is handled via auto-mode-alist and similar magic). ;; Check if there is a buffer visiting source-filename and if they are in @@ -588,8 +641,8 @@ optional argument, then use it." ;; temporary file where we put the after-product of the file handler. (setq file-name-magic-p (not (equal (file-truename true-source-filename) (file-truename source-filename)))) - - ;; Checkout orig file, if necessary, so that the patched file + + ;; Checkout orig file, if necessary, so that the patched file ;; could be checked back in. (ediff-maybe-checkout buf-to-patch) @@ -622,13 +675,15 @@ optional argument, then use it." (switch-to-buffer patch-diagnostics) (sit-for 0) ; synchronize - let the user see diagnostics - + (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 - (princ (format + (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. @@ -641,17 +696,17 @@ The second problem might be due to an incompatibility among these settings: 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 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 - ))) + 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 @@ -659,7 +714,7 @@ you can still examine the changes via M-x ediff-files" (goto-char (point-max)))) (switch-to-buffer-other-window patch-diagnostics) (error "Patch appears to have failed"))) - + ;; If black magic is involved, apply patch to a temp copy of the ;; file. Otherwise, apply patch to the orig copy. If patch is applied ;; to temp copy, we name the result old-name_patched for local files @@ -673,7 +728,7 @@ you can still examine the changes via M-x ediff-files" (set-visited-file-name (concat source-filename ediff-backup-extension)) (set-buffer-modified-p nil)) - + ;; Black magic in effect. ;; If orig file was remote, put the patched file in the temp directory. ;; If orig file is local, put the patched file in the directory of @@ -684,20 +739,20 @@ you can still examine the changes via M-x ediff-files" true-source-filename source-filename) "_patched")) - + (rename-file true-source-filename target-filename t) - + ;; arrange that the temp copy of orig will be deleted (rename-file (concat true-source-filename ediff-backup-extension) true-source-filename t)) - + ;; make orig buffer read-only (setq startup-hooks (cons 'ediff-set-read-only-in-buf-A startup-hooks)) - + ;; set up a buf for the patched file (setq target-buf (find-file-noselect target-filename)) - + (setq ctl-buf (ediff-buffers-internal buf-to-patch target-buf nil @@ -705,7 +760,7 @@ you can still examine the changes via M-x ediff-files" (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)) @@ -715,18 +770,22 @@ you can still examine the changes via M-x ediff-files" (setq startup-hooks ;; this sets various vars in the meta buffer inside ;; ediff-prepare-meta-buffer - (cons (` (lambda () - ;; tell what to do if the user clicks on a session record - (setq ediff-session-action-function - 'ediff-patch-file-form-meta - ediff-meta-patchbufer patch-buf) - )) + (cons `(lambda () + ;; tell what to do if the user clicks on a session record + (setq ediff-session-action-function + 'ediff-patch-file-form-meta + ediff-meta-patchbufer patch-buf) ) startup-hooks)) - (setq meta-buf (ediff-prepare-meta-buffer + (setq meta-buf (ediff-prepare-meta-buffer 'ediff-filegroup-action (ediff-with-current-buffer patch-buf - ;; nil replaces a regular expression - (cons (list nil (format "%S" patch-buf)) + (cons (ediff-make-new-meta-list-header + nil ; regexp + (format "%S" patch-buf) ; obj A + nil nil ; objects B,C + nil ; merge-auto-store-dir + nil ; comparison-func + ) ediff-patch-map)) "*Ediff Session Group Panel" 'ediff-redraw-directory-group-buffer @@ -735,8 +794,8 @@ you can still examine the changes via M-x ediff-files" (ediff-show-meta-buffer meta-buf) )) - - + + ;;; Local Variables: ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) @@ -744,4 +803,5 @@ you can still examine the changes via M-x ediff-files" ;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) ;;; End: +;;; arch-tag: 2fe2161e-e116-469b-90fa-5cbb44c1bd1b ;;; ediff-ptch.el ends here