xemacs-beta: lisp/ediff/ediff-ptch.el comparison

comparison lisp/ediff/ediff-ptch.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14

author	cvs
date	Mon, 13 Aug 2007 08:45:50 +0200
parents
children	bcdc7deadc19

comparison

equal deleted inserted replaced

--1:000000000000
+:376386a54a3c
+;;; ediff-ptch.el --- Ediff's  patch support
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Author: Michael Kifer <kifer@cs.sunysb.edu>
+;; This file is part of GNU Emacs.
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 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.
+;;; Code:
+(defvar ediff-last-dir-patch nil
+"Last directory used by an Ediff command for file to patch.")
+(defvar ediff-backup-extension
+(if (memq system-type '(vax-vms axp-vms emx ms-dos windows-nt windows-95))
+"_orig" ".orig")
+"Default backup extension for the patch program.")
+(defvar ediff-patch-default-directory nil
+"*Default directory to look for patches.")
+(defvar ediff-context-diff-label-regexp
+(concat "\\(" 	; context diff 2-liner
+	  "^\\*\\*\\* \\([^ \t]+\\)[^*]+[\t ]*\n--- \\([^ \t]+\\)"
+	  "\\|" 	; GNU unified format diff 2-liner
+	  "^--- \\([^ \t]+\\)[^-]+[\t ]*\n\\+\\+\\+ \\([^ \t]+\\)"
+	  "\\)")
+"*Regexp matching filename 2-liners at the start of each context diff.")
+(defvar ediff-patch-program "patch"
+"*Name of the program that applies patches.")
+(defvar ediff-patch-options ""
+"*Options to pass to ediff-patch-program.")
+;; The buffer of the patch file. Local to control buffer.
+(ediff-defvar-local ediff-patchbufer nil "")
+;; The buffer where patch displays its diagnostics.
+(ediff-defvar-local ediff-patch-diagnostics nil "")
+;; Map of patch buffer. Has 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.
+(ediff-defvar-local ediff-patch-map nil "")
+;; strip prefix from filename
+;; 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)
+	(substring filename (match-end 0))
+(concat "/null/" filename))))
+;; no longer used
+;; return the number of matches of regexp in buf starting from the beginning
+(defun ediff-count-matches (regexp buf)
+(ediff-eval-in-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)))
+;; 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
+(defun ediff-map-patch-buffer (buf)
+(ediff-eval-in-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) ; ensure progress towards the end
+	    (setq mark2 (move-marker (make-marker) (match-beginning 0))
+		  mark2-end (match-end 0)
+		  beg1 (match-beginning 2)
+		  end1 (match-end 2)
+		  beg2 (match-beginning 3)
+		  end2 (match-end 3))
+	    ;; 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)
+	    (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")))
+	    ;; check for any `Index:' or `Prereq:' lines, but don't use them
+	    (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 (list 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))
+(setq ediff-patch-map (nreverse patch-map))
+count)))
+;; Fix up the file names in the list using the argument FILENAME
+;; Algorithm: find the first file's directory and cut it out from each file
+;; name in the patch. Prepend the directory of FILENAME to each file in the
+;; patch. In addition, the first file in the patch is replaced by FILENAME.
+;; Each file is actually a file-pair of files found in the context diff header
+;; In the end, for each pair, we select the shortest existing file.
+;; 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)))
+	;; 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)))))
+	)
+;; chop off base-dirs
+(mapcar (function (lambda (triple)
+			(or (string= (car (car triple)) "/dev/null")
+			    (setcar (car triple)
+				    (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)))
+			))
+	    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)))))
+;; prepend actual-dir
+(mapcar (function (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 "
+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 (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))))))
+			 ))
+	    ediff-patch-map)
+;; check for the shorter existing file in each pair and discard the other
+;; one
+(mapcar (function (lambda (triple)
+			(let* ((file1 (car (car triple)))
+			       (file2 (cdr (car triple)))
+			       (f1-exists (file-exists-p file1))
+			       (f2-exists (file-exists-p file2)))
+			  (cond
+			   ((and (< (length file2) (length file1))
+				 f2-exists)
+			    (setcar triple file2))
+			   ((and (< (length file1) (length file2))
+				 f1-exists)
+			    (setcar triple file1))
+			   ((and f1-exists f2-exists
+				 (string= file1 file2))
+			    (setcar triple file1))
+			   ((and f1-exists f2-exists)
+			    (with-output-to-temp-buffer ediff-msg-buffer
+			      (princ (format "
+Ediff has inferred that
+	%s
+	%s
+are 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 file2 file1)))
+			    (setcar triple
+				    (if (y-or-n-p (format "Use %s ? " file2))
+					file2 file1)))
+			   (f2-exists (setcar triple file2))
+			   (f1-exists (setcar triple file1))
+			   (t
+			    (with-output-to-temp-buffer ediff-msg-buffer
+			      (princ (format "
+Ediff inferred that
+	%s
+	%s
+are possible alternative targets for this patch.
+However, these files do not exist.
+Please enter an alternative patch target ...
+"
+					     file1 file2)))
+			    (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 triple 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-get-patch-buffer ()
+"Obtain patch buffer.  If patch is already in a buffer---use it.
+Else, read patch file into a new buffer."
+(let ((dir (cond (ediff-patch-default-directory) ; try patch default dir
+		   (ediff-use-last-dir ediff-last-dir-patch)
+		   (t default-directory)))
+	patch-buf)
+(if (y-or-n-p "Is the patch already in a buffer? ")
+	(setq patch-buf
+	      (get-buffer
+	       (read-buffer
+		"Which buffer contains the patch? "
+		(current-buffer) 'must-match)))
+(setq patch-buf
+	    (find-file-noselect
+	     (read-file-name "Which file contains the patch? " dir))))
+(ediff-eval-in-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))
+;; Dispatch the right patch file function: regular or meta-level,
+;; depending on how many patches are in the patch file.
+;; At present, there is no support for meta-level patches.
+;; Should return either the ctl buffer or the meta-buffer
+(defun ediff-dispatch-file-patching-job (patch-buf filename
+						   &optional startup-hooks)
+(ediff-eval-in-buffer patch-buf
+;; relativize names in the patch with respect to source-file
+(ediff-fixup-patch-map filename)
+(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))
+	   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))
+	 (file-name-ok (if buf-to-patch (buffer-file-name  buf-to-patch)))
+	 (buf-mod-status (buffer-modified-p buf-to-patch))
+	 (multifile-patch-p (> (length (ediff-eval-in-buffer patch-buf
+					 ediff-patch-map)) 1))
+	 default-dir file-name ctl-buf)
+(if file-name-ok
+	(setq file-name file-name-ok)
+(if multifile-patch-p
+	  (error
+	   "Can't apply multi-file patches to buffers that visit no files"))
+(ediff-eval-in-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)
+	(setq buffer-auto-save-file-name nil) ; don't create auto-save file
+	;;don't confuse the user with a new bufname
+	(rename-buffer buf-to-patch-name)
+	(set-buffer-modified-p nil)
+	(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))
+(if file-name-ok
+	()
+;; buffer wasn't visiting any file,
+;; so we will not run meta-level ediff here
+(ediff-eval-in-buffer ctl-buf
+	(delete-file (buffer-file-name ediff-buffer-A))
+	(delete-file (buffer-file-name ediff-buffer-B))
+	(ediff-eval-in-buffer ediff-buffer-A
+	  (if default-dir (setq default-directory default-dir))
+	  (set-visited-file-name nil)
+	  (rename-buffer buf-to-patch-name)
+	  (set-buffer-modified-p buf-mod-status))
+	(ediff-eval-in-buffer ediff-buffer-B
+	  (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
+			  (concat buf-to-patch-name "_patched") ""))
+	  (set-buffer-modified-p t))))
+))
+(defun ediff-patch-file-internal (patch-buf source-filename
+					    &optional startup-hooks)
+(setq source-filename (expand-file-name source-filename))
+(let* ((backup-extension
+	  ;; if the user specified a -b option, extract the backup
+	  ;; extension from there; else use ediff-backup-extension
+	  (substring ediff-patch-options
+		     (if (string-match "-b[ \t]+" ediff-patch-options)
+			 (match-end 0) 0)
+		     (if (string-match "-b[ \t]+[^ \t]+" ediff-patch-options)
+			 (match-end 0) 0)))
+	 (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
+	 ;; so, we save source-filename and true-source-filename as a var
+	 ;; that initially is source-filename but may be changed to a temp
+	 ;; file for the purpose of patching.
+	 (true-source-filename source-filename)
+	 (target-filename source-filename)
+	 target-buf buf-to-patch file-name-magic-p ctl-buf backup-style)
+;; if the user didn't specify a backup extension, use
+;; ediff-backup-extension
+(if (string= backup-extension "")
+	(setq backup-extension ediff-backup-extension))
+(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
+;; sync; arrange for the deletion of temp file.
+(ediff-find-file 'true-source-filename 'buf-to-patch
+		     'ediff-last-dir-patch 'startup-hooks)
+;; Check if source file name has triggered black magic, such as file name
+;; handlers or auto mode alist, and make a note of it.
+;; true-source-filename should be either the original name or a
+;; 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 could be
+;; checked back in.
+(if (ediff-file-checked-in-p (buffer-file-name buf-to-patch))
+	(ediff-toggle-read-only buf-to-patch))
+(ediff-eval-in-buffer patch-diagnostics
+(insert-buffer patch-buf)
+(message "Applying patch ... ")
+;; fix environment for gnu patch, so it won't make numbered extensions
+(setq backup-style (getenv "VERSION_CONTROL"))
+(setenv "VERSION_CONTROL" nil)
+;; always pass patch the -f option, so it won't ask any questions
+(shell-command-on-region
+(point-min) (point-max)
+(format "%s -f %s -b %s %s"
+	       ediff-patch-program ediff-patch-options
+	       backup-extension
+	       (expand-file-name true-source-filename))
+t)
+;; restore environment for gnu patch
+(setenv "VERSION_CONTROL" backup-style))
+(message "Applying patch ... done")
+(message "")
+(switch-to-buffer patch-diagnostics)
+(sit-for 0) ; synchronize - let the user see diagnostics
+(or (file-exists-p (concat true-source-filename backup-extension))
+	(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
+;; and temp-copy_patched for remote files. The orig file name isn't
+;; changed, and the temp copy of the original is later deleted.
+;; Without magic, the original file is renamed (usually into
+;; old-name_orig) and the result of patching will have the same name as
+;; the original.
+(if (not file-name-magic-p)
+	(ediff-eval-in-buffer buf-to-patch
+	  (set-visited-file-name (concat source-filename 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
+;; the orig file.
+(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)
+;; arrange that the temp copy of orig will be deleted
+(rename-file (concat true-source-filename 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
+	   startup-hooks 'epatch))
+(ediff-eval-in-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
+	  ;; 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)
+		     ))
+		startup-hooks))
+(setq meta-buf (ediff-prepare-meta-buffer
+		    'ediff-filegroup-action
+		    (ediff-eval-in-buffer patch-buf
+		      ;; nil replaces a regular expression
+		      (cons (list nil (format "%S" patch-buf))
+			    ediff-patch-map))
+		    "*Ediff Session Group Panel"
+		    'ediff-redraw-directory-group-buffer
+		    'ediff-multifile-patch
+		    startup-hooks))
+(ediff-show-meta-buffer meta-buf)
+))
+;;; Local Variables:
+;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
+;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
+;;; End:
+(provide 'ediff-ptch)
+;;; ediff-ptch.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/ediff/ediff-ptch.el @ 0:376386a54a3c r19-14