* 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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5b0b2e71fc34d31dc0ae76c8aa702115b42e23b2..32e7b3fb077324381a0197b6ce550b9ede779adb 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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.

diff --git a/lisp/net/tramp-vc.el b/lisp/net/tramp-vc.el
index e720deb8f07f1592b3130066ea55974fbd83ee0a..3cc54eda650ae5fa1d49363ddb346fd95951b6b8 100644 (file)
--- a/lisp/net/tramp-vc.el
+++ b/lisp/net/tramp-vc.el
@@ -217,6 +217,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
 ;; 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 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
           (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)))))
 ;;-)
 
 

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 582ae8ee207294256c5f693470072c3cec1ec226..5a71a50c5db6b8af99052a7237105602ede0c35f 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1770,6 +1770,7 @@ on the FILENAME argument, even if VISIT was a string.")
     (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 @@ This will break if COMMAND prints a newline, followed by the value of
     (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 @@ ARGS are the arguments OPERATION has been called with."
    ; 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)

diff --git a/lisp/simple.el b/lisp/simple.el
index 47e275001d9d641d8956a9a3f0f8f30e8df11309..9b0c8c085fc9715ce3da17d9ab462187fa0c23d8 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1879,6 +1879,39 @@ specifies the value of ERROR-BUFFER."
     (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)))))
+
+
 \f
 (defvar universal-argument-map
   (let ((map (make-sparse-keymap)))

diff --git a/lisp/vc.el b/lisp/vc.el
index a0d3d1cd4bef4ef9ee03c59f6c8573aae9b617bc..15d0258e85de979ea36438bcfe415d39f73649f0 100644 (file)
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -953,7 +953,7 @@ that is inserted into the command line before the filename."
              (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))