* 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.