From db8af973954fda8e7204929b6efbd82f41ca05f8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 11 Jul 2007 19:38:21 +0000 Subject: [PATCH] * 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 . --- lisp/ChangeLog | 11 +++++++++++ lisp/progmodes/compile.el | 31 +++++++++++++++++++++++-------- lisp/progmodes/gud.el | 14 +++++++++++--- 3 files changed, 45 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2bf592f7acd..b4ca74d8198 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2007-07-11 Michael Albinus + + * 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 . + 2007-07-11 Dan Nicolaescu * 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 31fd7741a25..94def936fb9 100644 --- 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 57eed959f8b..97144fec83b 100644 --- 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--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))))) -- 2.39.2