866 |
(if (eq mode t) |
(if (eq mode t) |
867 |
(prog1 "compilation" (require 'comint)) |
(prog1 "compilation" (require 'comint)) |
868 |
(replace-regexp-in-string "-mode$" "" (symbol-name mode)))) |
(replace-regexp-in-string "-mode$" "" (symbol-name mode)))) |
869 |
cd-path ; in case process-environment contains CDPATH |
(thisdir default-directory) |
|
(thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command) |
|
|
(substitute-in-file-name (match-string 1 command)) |
|
|
default-directory)) |
|
870 |
outwin outbuf) |
outwin outbuf) |
871 |
(with-current-buffer |
(with-current-buffer |
872 |
(setq outbuf |
(setq outbuf |
887 |
(error "Cannot have two processes in `%s' at once" |
(error "Cannot have two processes in `%s' at once" |
888 |
(buffer-name))))) |
(buffer-name))))) |
889 |
(buffer-disable-undo (current-buffer)) |
(buffer-disable-undo (current-buffer)) |
890 |
|
;; first transfer directory from where M-x compile was called |
891 |
|
(setq default-directory thisdir) |
892 |
;; Make compilation buffer read-only. The filter can still write it. |
;; Make compilation buffer read-only. The filter can still write it. |
893 |
;; Clear out the compilation buffer. |
;; Clear out the compilation buffer. |
894 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t) |
895 |
|
(default-directory thisdir)) |
896 |
|
;; Then evaluate a cd command if any, but don't perform it yet, else start-command |
897 |
|
;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make" |
898 |
|
(cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command) |
899 |
|
(if (match-end 1) |
900 |
|
(match-string 1 command) |
901 |
|
"~") |
902 |
|
default-directory)) |
903 |
(erase-buffer) |
(erase-buffer) |
|
;; Change its default-directory to the directory where the compilation |
|
|
;; will happen, and insert a `cd' command to indicate this. |
|
|
(setq default-directory thisdir) |
|
904 |
;; output a mode setter, for saving and later reloading this buffer |
;; output a mode setter, for saving and later reloading this buffer |
905 |
(insert "-*- mode: " name-of-mode |
(insert "-*- mode: " name-of-mode |
906 |
"; default-directory: " (prin1-to-string default-directory) |
"; default-directory: " (prin1-to-string default-directory) |
907 |
" -*-\n" command "\n")) |
" -*-\n" command "\n") |
908 |
|
(setq thisdir default-directory)) |
909 |
(set-buffer-modified-p nil)) |
(set-buffer-modified-p nil)) |
910 |
;; If we're already in the compilation buffer, go to the end |
;; If we're already in the compilation buffer, go to the end |
911 |
;; of the buffer, so point will track the compilation output. |
;; of the buffer, so point will track the compilation output. |
990 |
;; fontified, so fontify it now. |
;; fontified, so fontify it now. |
991 |
(let ((font-lock-verbose nil)) ; shut up font-lock messages |
(let ((font-lock-verbose nil)) ; shut up font-lock messages |
992 |
(font-lock-fontify-buffer)) |
(font-lock-fontify-buffer)) |
993 |
(message "Executing `%s'...done" command)))) |
(message "Executing `%s'...done" command))) |
994 |
|
;; Now finally cd to where the shell started make/grep/... |
995 |
|
(setq default-directory thisdir)) |
996 |
(if (buffer-local-value 'compilation-scroll-output outbuf) |
(if (buffer-local-value 'compilation-scroll-output outbuf) |
997 |
(save-selected-window |
(save-selected-window |
998 |
(select-window outwin) |
(select-window outwin) |