diff lisp/simple.el @ 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 942b8e28d21a
children d9dc84198059
line wrap: on
line diff
--- 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)))