* subr.el (start-file-process-shell-command)

(process-file-shell-command): New defuns.

* progmodes/compile.el (compilation-start): Apply
`start-file-process-shell-command'.

3 files changed, 36 insertions, 18 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d0ab7c803ae..0ab088d420b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2007-07-24  Michael Albinus  <michael.albinus@gmx.de>
+
+        * subr.el (start-file-process-shell-command)
+        (process-file-shell-command): New defuns.
+
+        * progmodes/compile.el (compilation-start): Apply
+        `start-file-process-shell-command'.
+
 2007-07-24  Alexandre Julliard  <julliard@winehq.org>
 
         * vc-git.el (vc-git-checkout, vc-directory-exclusion-list): Fix
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 0c57e6f55b1..ec34dd61e96 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1101,8 +1101,7 @@ Returns the compilation buffer created."
               (unless (getenv "EMACS")
                 (list "EMACS=t"))
               (list "INSIDE_EMACS=t")
-              (copy-sequence process-environment)))
-            (start-process (symbol-function 'start-process)))
+              (copy-sequence process-environment))))
         (set (make-local-variable 'compilation-arguments)
              (list command mode name-function highlight-regexp))
         (set (make-local-variable 'revert-buffer-function)
@@ -1123,22 +1122,14 @@ Returns the compilation buffer created."
                    ;; comint uses `start-file-process'.
                    (get-buffer-process
                     (with-no-warnings
-                      (comint-exec outbuf (downcase mode-name)
-                                   shell-file-name nil `("-c" ,command))))
-                 ;; Redefine temporarily `start-process' in order to
-                 ;; handle remote compilation.
-                 (fset 'start-process
-                       (lambda (name buffer program &rest program-args)
-                         (apply
-                          (if (file-remote-p default-directory)
-                              'start-file-process
-                            start-process)
-                          name buffer program program-args)))
-                 (unwind-protect
-                     (start-process-shell-command (downcase mode-name)
-                                                  outbuf command)
-                   ;; Unwindform: Reset original definition of `start-process'.
-                   (fset 'start-process start-process)))))
+                      (comint-exec
+                       outbuf (downcase mode-name)
+                       (if (file-remote-p default-directory)
+                           "/bin/sh"
+                         shell-file-name)
+                       `("-c" ,command))))
+                 (start-file-process-shell-command (downcase mode-name)
+                                                   outbuf command))))
           ;; Make the buffer's mode line show process state.
           (setq mode-line-process '(":%s"))
           (set-process-sentinel proc 'compilation-sentinel)
diff --git a/lisp/subr.el b/lisp/subr.el
index c4816f5d134..ce36cf9637b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2310,6 +2310,15 @@ Wildcards and redirection are handled as usual in the shell.
     (start-process name buffer shell-file-name shell-command-switch
                    (mapconcat 'identity args " ")))))
 
+(defun start-file-process-shell-command (name buffer &rest args)
+  "Start a program in a subprocess.  Return the process object for it.
+Similar to `start-process-shell-command', but calls `start-file-process'."
+  (start-file-process
+   name buffer
+   (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
+   (if (file-remote-p default-directory) "-c" shell-command-switch)
+   (mapconcat 'identity args " ")))
+
 (defun call-process-shell-command (command &optional infile buffer display
                                            &rest args)
   "Execute the shell command COMMAND synchronously in separate process.
@@ -2341,6 +2350,16 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
                   infile buffer display
                   shell-command-switch
                   (mapconcat 'identity (cons command args) " ")))))
+
+(defun process-file-shell-command (command &optional infile buffer display
+                                           &rest args)
+  "Process files synchronously in a separate process.
+Similar to `call-process-shell-command', but calls `process-file'."
+  (process-file
+   (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
+   infile buffer display
+   (if (file-remote-p default-directory) "-c" shell-command-switch)
+   (mapconcat 'identity (cons command args) " ")))
 
 ;;;; Lisp macros to do various things temporarily.