Mercurial > emacs
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)))