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

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

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

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d0ab7c803aec1b9c575a2ed1dd0ecc81da7e9c9b..0ab088d420b46172c4c671d690dc9331f2557936 100644 (file)
--- 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 0c57e6f55b1e91d8fb0e90d558ce34c9354f71c9..ec34dd61e96534c6cb955a34a3403de32e09949c 100644 (file)
--- 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 c4816f5d13412c5b9d6b961f942e9a57fdfbfb6c..ce36cf9637b13116db0651b6e94854112411e293 100644 (file)
--- 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) " ")))
 \f
 ;;;; Lisp macros to do various things temporarily.