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)))) |
|
(process-environment |
|
|
(append |
|
|
compilation-environment |
|
|
(if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning |
|
|
system-uses-terminfo) |
|
|
(list "TERM=dumb" "TERMCAP=" |
|
|
(format "COLUMNS=%d" (window-width))) |
|
|
(list "TERM=emacs" |
|
|
(format "TERMCAP=emacs:co#%d:tc=unknown:" |
|
|
(window-width)))) |
|
|
;; Set the EMACS variable, but |
|
|
;; don't override users' setting of $EMACS. |
|
|
(unless (getenv "EMACS") '("EMACS=t")) |
|
|
(copy-sequence process-environment))) |
|
869 |
cd-path ; in case process-environment contains CDPATH |
cd-path ; in case process-environment contains CDPATH |
870 |
(thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command) |
(thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command) |
871 |
(substitute-in-file-name (match-string 1 command)) |
(substitute-in-file-name (match-string 1 command)) |
909 |
;; Pop up the compilation buffer. |
;; Pop up the compilation buffer. |
910 |
(setq outwin (display-buffer outbuf nil t)) |
(setq outwin (display-buffer outbuf nil t)) |
911 |
(with-current-buffer outbuf |
(with-current-buffer outbuf |
912 |
(if (not (eq mode t)) |
(let ((process-environment |
913 |
(funcall mode) |
(append |
914 |
(setq buffer-read-only nil) |
compilation-environment |
915 |
(with-no-warnings (comint-mode)) |
(if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning |
916 |
(compilation-shell-minor-mode)) |
system-uses-terminfo) |
917 |
(if highlight-regexp |
(list "TERM=dumb" "TERMCAP=" |
918 |
(set (make-local-variable 'compilation-highlight-regexp) |
(format "COLUMNS=%d" (window-width))) |
919 |
highlight-regexp)) |
(list "TERM=emacs" |
920 |
(set (make-local-variable 'compilation-arguments) |
(format "TERMCAP=emacs:co#%d:tc=unknown:" |
921 |
(list command mode name-function highlight-regexp)) |
(window-width)))) |
922 |
(set (make-local-variable 'revert-buffer-function) |
;; Set the EMACS variable, but |
923 |
'compilation-revert-buffer) |
;; don't override users' setting of $EMACS. |
924 |
(set-window-start outwin (point-min)) |
(unless (getenv "EMACS") '("EMACS=t")) |
925 |
(or (eq outwin (selected-window)) |
(copy-sequence process-environment)))) |
926 |
(set-window-point outwin (if compilation-scroll-output |
(if (not (eq mode t)) |
927 |
(point) |
(funcall mode) |
928 |
(point-min)))) |
(setq buffer-read-only nil) |
929 |
;; The setup function is called before compilation-set-window-height |
(with-no-warnings (comint-mode)) |
930 |
;; so it can set the compilation-window-height buffer locally. |
(compilation-shell-minor-mode)) |
931 |
(if compilation-process-setup-function |
(if highlight-regexp |
932 |
(funcall compilation-process-setup-function)) |
(set (make-local-variable 'compilation-highlight-regexp) |
933 |
(compilation-set-window-height outwin) |
highlight-regexp)) |
934 |
;; Start the compilation. |
(set (make-local-variable 'compilation-arguments) |
935 |
(if (fboundp 'start-process) |
(list command mode name-function highlight-regexp)) |
936 |
(let ((proc (if (eq mode t) |
(set (make-local-variable 'revert-buffer-function) |
937 |
(get-buffer-process |
'compilation-revert-buffer) |
938 |
(with-no-warnings |
(set-window-start outwin (point-min)) |
939 |
(comint-exec outbuf (downcase mode-name) |
(or (eq outwin (selected-window)) |
940 |
shell-file-name nil `("-c" ,command)))) |
(set-window-point outwin (if compilation-scroll-output |
941 |
(start-process-shell-command (downcase mode-name) |
(point) |
942 |
outbuf command)))) |
(point-min)))) |
943 |
;; Make the buffer's mode line show process state. |
;; The setup function is called before compilation-set-window-height |
944 |
(setq mode-line-process '(":%s")) |
;; so it can set the compilation-window-height buffer locally. |
945 |
(set-process-sentinel proc 'compilation-sentinel) |
(if compilation-process-setup-function |
946 |
(set-process-filter proc 'compilation-filter) |
(funcall compilation-process-setup-function)) |
947 |
(set-marker (process-mark proc) (point) outbuf) |
(compilation-set-window-height outwin) |
948 |
(setq compilation-in-progress |
;; Start the compilation. |
949 |
(cons proc compilation-in-progress))) |
(if (fboundp 'start-process) |
950 |
;; No asynchronous processes available. |
(let ((proc (if (eq mode t) |
951 |
(message "Executing `%s'..." command) |
(get-buffer-process |
952 |
;; Fake modeline display as if `start-process' were run. |
(with-no-warnings |
953 |
(setq mode-line-process ":run") |
(comint-exec outbuf (downcase mode-name) |
954 |
(force-mode-line-update) |
shell-file-name nil `("-c" ,command)))) |
955 |
(sit-for 0) ; Force redisplay |
(start-process-shell-command (downcase mode-name) |
956 |
(let ((status (call-process shell-file-name nil outbuf nil "-c" |
outbuf command)))) |
957 |
command))) |
;; Make the buffer's mode line show process state. |
958 |
(cond ((numberp status) |
(setq mode-line-process '(":%s")) |
959 |
(compilation-handle-exit 'exit status |
(set-process-sentinel proc 'compilation-sentinel) |
960 |
(if (zerop status) |
(set-process-filter proc 'compilation-filter) |
961 |
"finished\n" |
(set-marker (process-mark proc) (point) outbuf) |
962 |
(format "\ |
(setq compilation-in-progress |
963 |
|
(cons proc compilation-in-progress))) |
964 |
|
;; No asynchronous processes available. |
965 |
|
(message "Executing `%s'..." command) |
966 |
|
;; Fake modeline display as if `start-process' were run. |
967 |
|
(setq mode-line-process ":run") |
968 |
|
(force-mode-line-update) |
969 |
|
(sit-for 0) ; Force redisplay |
970 |
|
(let ((status (call-process shell-file-name nil outbuf nil "-c" |
971 |
|
command))) |
972 |
|
(cond ((numberp status) |
973 |
|
(compilation-handle-exit 'exit status |
974 |
|
(if (zerop status) |
975 |
|
"finished\n" |
976 |
|
(format "\ |
977 |
exited abnormally with code %d\n" |
exited abnormally with code %d\n" |
978 |
status)))) |
status)))) |
979 |
((stringp status) |
((stringp status) |
980 |
(compilation-handle-exit 'signal status |
(compilation-handle-exit 'signal status |
981 |
(concat status "\n"))) |
(concat status "\n"))) |
982 |
(t |
(t |
983 |
(compilation-handle-exit 'bizarre status status)))) |
(compilation-handle-exit 'bizarre status status)))) |
984 |
;; Without async subprocesses, the buffer is not yet |
;; Without async subprocesses, the buffer is not yet |
985 |
;; fontified, so fontify it now. |
;; fontified, so fontify it now. |
986 |
(let ((font-lock-verbose nil)) ; shut up font-lock messages |
(let ((font-lock-verbose nil)) ; shut up font-lock messages |
987 |
(font-lock-fontify-buffer)) |
(font-lock-fontify-buffer)) |
988 |
(message "Executing `%s'...done" command))) |
(message "Executing `%s'...done" command)))) |
989 |
(if (buffer-local-value 'compilation-scroll-output outbuf) |
(if (buffer-local-value 'compilation-scroll-output outbuf) |
990 |
(save-selected-window |
(save-selected-window |
991 |
(select-window outwin) |
(select-window outwin) |