changeset 57653:b324ca4df07c

* simple.el (process-file): New function, similar to call-process but supports file handlers. * vc.el (vc-do-command): Use it, instead of call-process. * net/tramp-vc.el (vc-do-command): Do not advise it if process-file is fboundp. * net/tramp.el (tramp-file-name-handler-alist): Add entry for process-file. (tramp-handle-process-file): New function. (tramp-file-name-for-operation): Support process-file.
author Kai Großjohann <kgrossjo@eu.uu.net>
date Sat, 23 Oct 2004 19:52:18 +0000
parents 1d0ad14ff912
children 000df8ff0cc6
files lisp/ChangeLog lisp/net/tramp-vc.el lisp/net/tramp.el lisp/simple.el lisp/vc.el
diffstat 5 files changed, 63 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Oct 23 16:13:06 2004 +0000
+++ b/lisp/ChangeLog	Sat Oct 23 19:52:18 2004 +0000
@@ -1,3 +1,15 @@
+2004-10-23  Kai Grossjohann  <kai.grossjohann@gmx.net>
+
+	* simple.el (process-file): New function, similar to call-process
+	but supports file handlers.
+	* vc.el (vc-do-command): Use it, instead of call-process.
+	* net/tramp-vc.el (vc-do-command): Do not advise it if
+	process-file is fboundp.
+	* net/tramp.el (tramp-file-name-handler-alist): Add entry for
+	process-file.
+	(tramp-handle-process-file): New function.
+	(tramp-file-name-for-operation): Support process-file.
+
 2004-10-23  Ulf Jasper  <ulf.jasper@web.de>
 
 	* calendar/icalendar.el (icalendar--weekday-array): New constant.
--- a/lisp/net/tramp-vc.el	Sat Oct 23 16:13:06 2004 +0000
+++ b/lisp/net/tramp-vc.el	Sat Oct 23 19:52:18 2004 +0000
@@ -217,6 +217,7 @@
 ;; Daniel Pittman <daniel@danann.net>
 ;;-(if (fboundp 'vc-call-backend)
 ;;-    () ;; This is the new VC for which we don't have an appropriate advice yet
+(unless (fboundp 'process-file)
 (if (fboundp 'vc-call-backend)
     (defadvice vc-do-command
       (around tramp-advice-vc-do-command
@@ -242,7 +243,7 @@
           (setq ad-return-value
                 (apply 'tramp-vc-do-command buffer okstatus command 
                        (or file (buffer-file-name)) last flags))
-        ad-do-it))))
+        ad-do-it)))))
 ;;-)
 
 
--- a/lisp/net/tramp.el	Sat Oct 23 16:13:06 2004 +0000
+++ b/lisp/net/tramp.el	Sat Oct 23 19:52:18 2004 +0000
@@ -1770,6 +1770,7 @@
     (delete-file . tramp-handle-delete-file)
     (directory-file-name . tramp-handle-directory-file-name)
     (shell-command . tramp-handle-shell-command)
+    (process-file . tramp-handle-process-file)
     (insert-directory . tramp-handle-insert-directory)
     (expand-file-name . tramp-handle-expand-file-name)
     (file-local-copy . tramp-handle-file-local-copy)
@@ -3469,6 +3470,18 @@
     (tramp-run-real-handler 'shell-command
 			    (list command output-buffer error-buffer))))
 
+(defun tramp-handle-process-file (program &optional infile buffer display &rest args)
+  "Like `process-file' for Tramp files."
+  (when infile (error "Implementation does not handle input from file"))
+  (when (and (numberp buffer) (zerop buffer))
+    (error "Implementation does not handle immediate return"))
+  (when (consp buffer) (error "Implementation does not handle error files"))
+  (shell-command 
+   (mapconcat 'tramp-shell-quote-argument
+              (cons program args)
+              " ")
+   buffer))
+
 ;; File Editing.
 
 (defsubst tramp-make-temp-file ()
@@ -3960,6 +3973,8 @@
    ; COMMAND
    ((member operation
 	    (list 'dired-call-process 'shell-command
+                  ; Post Emacs 21.3 only
+                  'process-file
 	          ; XEmacs only
 		  'dired-print-file 'dired-shell-call-process))
     default-directory)
--- a/lisp/simple.el	Sat Oct 23 16:13:06 2004 +0000
+++ b/lisp/simple.el	Sat Oct 23 19:52:18 2004 +0000
@@ -1879,6 +1879,39 @@
     (with-current-buffer
       standard-output
       (call-process shell-file-name nil t nil shell-command-switch command))))
+
+(defun process-file (program &optional infile buffer display &rest args)
+  "Process files synchronously in a separate process.
+Similar to `call-process', but may invoke a file handler based on
+`default-directory'.  The current working directory of the
+subprocess is `default-directory'.
+
+File names in INFILE and BUFFER are handled normally, but file
+names in ARGS should be relative to `default-directory', as they
+are passed to the process verbatim.  \(This is a difference to
+`call-process' which does not support file handlers for INFILE
+and BUFFER.\)
+
+Some file handlers might not support all variants, for example
+they might behave as if DISPLAY was nil, regardless of the actual
+value passed."
+  (let ((fh (find-file-name-handler default-directory 'process-file))
+        lc stderr-file)
+    (unwind-protect
+        (if fh (apply fh 'process-file program infile buffer display args)
+          (setq lc (file-local-copy infile))
+          (setq stderr-file (when (and (consp buffer) (stringp (cadr buffer)))
+                              (make-temp-file "emacs"))))
+      (prog1
+          (apply 'call-process program
+                 (or lc infile)
+                 (if stderr-file (list (car buffer) stderr-file) buffer)
+                 display args)
+        (when stderr-file (copy-file stderr-file (cadr buffer))))
+      (when stderr-file (delete-file stderr-file))
+      (when lc (delete-file lc)))))
+
+
 
 (defvar universal-argument-map
   (let ((map (make-sparse-keymap)))
--- a/lisp/vc.el	Sat Oct 23 16:13:06 2004 +0000
+++ b/lisp/vc.el	Sat Oct 23 19:52:18 2004 +0000
@@ -953,7 +953,7 @@
 	      (vc-exec-after
 	       `(unless (active-minibuffer-window)
                   (message "Running %s in the background... done" ',command))))
-	  (setq status (apply 'call-process command nil t nil squeezed))
+	  (setq status (apply 'process-file command nil t nil squeezed))
 	  (when (or (not (integerp status)) (and okstatus (< okstatus status)))
 	    (pop-to-buffer (current-buffer))
 	    (goto-char (point-min))