* progmodes/compile.el (compilation-start): `start-process' must

still be redefined when calling `start-process-shell-command'.

* progmodes/gud.el (gud-file-name): When `default-directory' is a
remote file name, prepend its remote part to the filename.
(gud-common-init): When `default-directory' is a remote file name,
make the filename relative to it.
Based on a patch by Nick Roberts <nickrob@snap.net.nz>.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2bf592f7acd40acc917336375e3f2583118faedc..b4ca74d819821f68e4aba549f942f2a88b938990 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2007-07-11  Michael Albinus  <michael.albinus@gmx.de>
+
+       * progmodes/compile.el (compilation-start): `start-process' must
+       still be redefined when calling `start-process-shell-command'.
+
+       * progmodes/gud.el (gud-file-name): When `default-directory' is a
+       remote file name, prepend its remote part to the filename.
+       (gud-common-init): When `default-directory' is a remote file name,
+       make the filename relative to it.
+       Based on a patch by Nick Roberts <nickrob@snap.net.nz>.
+
 2007-07-11  Dan Nicolaescu  <dann@ics.uci.edu>
 
        * vc-hooks.el (vc-default-mode-line-string): Add a mouse face,

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 31fd7741a25f4a6bce992936c8c79a32a474e28b..94def936fb911380c7f45e4ed5e39ee9bb379c88 100644 (file)
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1098,7 +1098,8 @@ Returns the compilation buffer created."
              (unless (getenv "EMACS")
                (list "EMACS=t"))
              (list "INSIDE_EMACS=t")
-             (copy-sequence process-environment))))
+             (copy-sequence process-environment)))
+           (start-process (symbol-function 'start-process)))
        (set (make-local-variable 'compilation-arguments)
             (list command mode name-function highlight-regexp))
        (set (make-local-variable 'revert-buffer-function)
@@ -1114,13 +1115,27 @@ Returns the compilation buffer created."
            (funcall compilation-process-setup-function))
        (compilation-set-window-height outwin)
        ;; Start the compilation.
-       (let ((proc (if (eq mode t)
-                       (get-buffer-process
-                        (with-no-warnings
-                          (comint-exec outbuf (downcase mode-name)
-                                       shell-file-name nil `("-c" ,command))))
-                     (start-process-shell-command (downcase mode-name)
-                                                  outbuf command))))
+       (let ((proc
+              (if (eq mode t)
+                  ;; 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)))))
          ;; Make the buffer's mode line show process state.
          (setq mode-line-process '(":%s"))
          (set-process-sentinel proc 'compilation-sentinel)

diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 57eed959f8b915986aa905b23002c3acd03ddf93..97144fec83beb5c1b88d4242547c6f6dc8328002 100644 (file)
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -237,7 +237,7 @@ Used to grey out relevant toolbar icons.")
        ([menu-bar run] menu-item
        ,(propertize "run" 'face 'font-lock-doc-face) gud-run
        :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
-       ([menu-bar go] menu-item 
+       ([menu-bar go] menu-item
        ,(propertize " go " 'face 'font-lock-doc-face) gud-go
        :visible (and (not gud-running)
                      (eq gud-minor-mode 'gdba)))
@@ -292,6 +292,11 @@ Used to grey out relevant toolbar icons.")
 (defun gud-file-name (f)
   "Transform a relative file name to an absolute file name.
 Uses `gud-<MINOR-MODE>-directories' to find the source files."
+  ;; When `default-directory' is a remote file name, prepend its
+  ;; remote part to f, which is the local file name.  Fortunately,
+  ;; `file-remote-p' returns exactly this remote file name part (or
+  ;; nil otherwise).
+  (setq f (concat (or (file-remote-p default-directory) "") f))
   (if (file-exists-p f) (expand-file-name f)
     (let ((directories (gud-val 'directories))
          (result nil))
@@ -2510,7 +2515,10 @@ comint mode, which see."
       (while (and w (not (eq (car w) t)))
        (setq w (cdr w)))
       (if w
-         (setcar w file)))
+         (setcar w
+                 (if (file-remote-p default-directory)
+                     (setq file (file-name-nondirectory file))
+                   file))))
     (apply 'make-comint (concat "gud" filepart) program nil
           (if massage-args (funcall massage-args file args) args))
     ;; Since comint clobbered the mode, we don't set it until now.
@@ -3114,7 +3122,7 @@ class of the file (using s to separate nested class ids)."
                              'syntax-table (eval-when-compile
                                              (string-to-syntax "> b")))
           ;; Make sure that rehighlighting the previous line won't erase our
-          ;; syntax-table property.  
+          ;; syntax-table property.
           (put-text-property (1- (match-beginning 0)) (match-end 0)
                              'font-lock-multiline t)
           nil)))))