Re: Patch: new function process-file (call-process with file handlers)

[Kai Grossjohann <kai@emptydomain.de>]

[-- Attachment #1: Type: text/plain, Size: 66 bytes --]

Oops, thanks for the friendly hints about the attachment...

Kai


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: x --]
[-- Type: text/x-patch, Size: 5164 bytes --]

cvs diff: Diffing lisp
Index: lisp/simple.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/simple.el,v
retrieving revision 1.661
diff -u -r1.661 simple.el
--- lisp/simple.el	19 Sep 2004 00:02:44 -0000	1.661
+++ lisp/simple.el	17 Oct 2004 15:38:08 -0000
@@ -1879,6 +1879,25 @@
     (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.
+
+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)))
+    (if fh (apply fh 'process-file program infile buffer display args)
+      (apply 'call-process program infile buffer display args))))
+
+
 \f
 (defvar universal-argument-map
   (let ((map (make-sparse-keymap)))
Index: lisp/vc.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc.el,v
retrieving revision 1.381
diff -u -r1.381 vc.el
--- lisp/vc.el	13 Oct 2004 17:04:45 -0000	1.381
+++ lisp/vc.el	17 Oct 2004 15:38:10 -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))
cvs diff: Diffing lisp/calc
cvs diff: Diffing lisp/calendar
cvs diff: Diffing lisp/emacs-lisp
cvs diff: Diffing lisp/emulation
cvs diff: Diffing lisp/eshell
cvs diff: Diffing lisp/gnus
cvs diff: Diffing lisp/international
cvs diff: Diffing lisp/language
cvs diff: Diffing lisp/mail
cvs diff: Diffing lisp/mh-e
cvs diff: Diffing lisp/net
Index: lisp/net/tramp-vc.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/net/tramp-vc.el,v
retrieving revision 1.9
diff -u -r1.9 tramp-vc.el
--- lisp/net/tramp-vc.el	17 Jul 2004 17:28:06 -0000	1.9
+++ lisp/net/tramp-vc.el	17 Oct 2004 15:38:11 -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)))))
 ;;-)
 
 
Index: lisp/net/tramp.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/net/tramp.el,v
retrieving revision 1.52
diff -u -r1.52 tramp.el
--- lisp/net/tramp.el	17 Oct 2004 14:05:51 -0000	1.52
+++ lisp/net/tramp.el	17 Oct 2004 15:38:16 -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)
cvs diff: Diffing lisp/obsolete
cvs diff: Diffing lisp/play
cvs diff: Diffing lisp/progmodes
cvs diff: Diffing lisp/term
cvs diff: Diffing lisp/textmodes
cvs diff: Diffing lisp/toolbar
cvs diff: Diffing lisp/url

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel