From 0457dd55384ea10734a4a888c28bf842bdf6938d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kai=20Gro=C3=9Fjohann?= Date: Sat, 23 Oct 2004 19:52:18 +0000 Subject: [PATCH] * 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. --- lisp/ChangeLog | 12 ++++++++++++ lisp/net/tramp-vc.el | 3 ++- lisp/net/tramp.el | 15 +++++++++++++++ lisp/simple.el | 33 +++++++++++++++++++++++++++++++++ lisp/vc.el | 2 +- 5 files changed, 63 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5b0b2e71fc3..32e7b3fb077 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2004-10-23 Kai Grossjohann + + * 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 * calendar/icalendar.el (icalendar--weekday-array): New constant. diff --git a/lisp/net/tramp-vc.el b/lisp/net/tramp-vc.el index e720deb8f07..3cc54eda650 100644 --- 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 ;;-(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 582ae8ee207..5a71a50c5db 100644 --- 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 47e275001d9..9b0c8c085fc 100644 --- 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))))) + + (defvar universal-argument-map (let ((map (make-sparse-keymap))) diff --git a/lisp/vc.el b/lisp/vc.el index a0d3d1cd4be..15d0258e85d 100644 --- 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))