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 |
(process-environment |
(thisdir default-directory) |
|
(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))) |
|
|
cd-path ; in case process-environment contains CDPATH |
|
|
(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 |
886 |
(error nil)) |
(error nil)) |
887 |
(error "Cannot have two processes in `%s' at once" |
(error "Cannot have two processes in `%s' at once" |
888 |
(buffer-name))))) |
(buffer-name))))) |
|
;; Clear out the compilation buffer and make it writable. |
|
|
;; Change its default-directory to the directory where the compilation |
|
|
;; will happen, and insert a `default-directory' to indicate this. |
|
|
(setq buffer-read-only nil) |
|
889 |
(buffer-disable-undo (current-buffer)) |
(buffer-disable-undo (current-buffer)) |
890 |
(erase-buffer) |
;; first transfer directory from where M-x compile was called |
891 |
(buffer-enable-undo (current-buffer)) |
(setq default-directory thisdir) |
892 |
(cd thisdir) |
;; Make compilation buffer read-only. The filter can still write it. |
893 |
;; output a mode setter, for saving and later reloading this buffer |
;; Clear out the compilation buffer. |
894 |
(insert "-*- mode: " name-of-mode |
(let ((inhibit-read-only t) |
895 |
"; default-directory: " (prin1-to-string default-directory) |
(default-directory thisdir)) |
896 |
" -*-\n" command "\n") |
;; 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) |
904 |
|
;; output a mode setter, for saving and later reloading this buffer |
905 |
|
(insert "-*- mode: " name-of-mode |
906 |
|
"; default-directory: " (prin1-to-string default-directory) |
907 |
|
" -*-\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. |
914 |
;; Pop up the compilation buffer. |
;; Pop up the compilation buffer. |
915 |
(setq outwin (display-buffer outbuf nil t)) |
(setq outwin (display-buffer outbuf nil t)) |
916 |
(with-current-buffer outbuf |
(with-current-buffer outbuf |
917 |
(if (not (eq mode t)) |
(let ((process-environment |
918 |
(funcall mode) |
(append |
919 |
(with-no-warnings (comint-mode)) |
compilation-environment |
920 |
(compilation-shell-minor-mode)) |
(if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning |
921 |
;; In what way is it non-ergonomic ? -stef |
system-uses-terminfo) |
922 |
;; (toggle-read-only 1) ;;; Non-ergonomic. |
(list "TERM=dumb" "TERMCAP=" |
923 |
(if highlight-regexp |
(format "COLUMNS=%d" (window-width))) |
924 |
(set (make-local-variable 'compilation-highlight-regexp) |
(list "TERM=emacs" |
925 |
highlight-regexp)) |
(format "TERMCAP=emacs:co#%d:tc=unknown:" |
926 |
(set (make-local-variable 'compilation-arguments) |
(window-width)))) |
927 |
(list command mode name-function highlight-regexp)) |
;; Set the EMACS variable, but |
928 |
(set (make-local-variable 'revert-buffer-function) |
;; don't override users' setting of $EMACS. |
929 |
'compilation-revert-buffer) |
(unless (getenv "EMACS") '("EMACS=t")) |
930 |
(set-window-start outwin (point-min)) |
(copy-sequence process-environment)))) |
931 |
(or (eq outwin (selected-window)) |
(if (not (eq mode t)) |
932 |
(set-window-point outwin (if compilation-scroll-output |
(funcall mode) |
933 |
(point) |
(setq buffer-read-only nil) |
934 |
(point-min)))) |
(with-no-warnings (comint-mode)) |
935 |
;; The setup function is called before compilation-set-window-height |
(compilation-shell-minor-mode)) |
936 |
;; so it can set the compilation-window-height buffer locally. |
(if highlight-regexp |
937 |
(if compilation-process-setup-function |
(set (make-local-variable 'compilation-highlight-regexp) |
938 |
(funcall compilation-process-setup-function)) |
highlight-regexp)) |
939 |
(compilation-set-window-height outwin) |
(set (make-local-variable 'compilation-arguments) |
940 |
;; Start the compilation. |
(list command mode name-function highlight-regexp)) |
941 |
(if (fboundp 'start-process) |
(set (make-local-variable 'revert-buffer-function) |
942 |
(let ((proc (if (eq mode t) |
'compilation-revert-buffer) |
943 |
(get-buffer-process |
(set-window-start outwin (point-min)) |
944 |
(with-no-warnings |
(or (eq outwin (selected-window)) |
945 |
(comint-exec outbuf (downcase mode-name) |
(set-window-point outwin (if compilation-scroll-output |
946 |
shell-file-name nil `("-c" ,command)))) |
(point) |
947 |
(start-process-shell-command (downcase mode-name) |
(point-min)))) |
948 |
outbuf command)))) |
;; The setup function is called before compilation-set-window-height |
949 |
;; Make the buffer's mode line show process state. |
;; so it can set the compilation-window-height buffer locally. |
950 |
(setq mode-line-process '(":%s")) |
(if compilation-process-setup-function |
951 |
(set-process-sentinel proc 'compilation-sentinel) |
(funcall compilation-process-setup-function)) |
952 |
(set-process-filter proc 'compilation-filter) |
(compilation-set-window-height outwin) |
953 |
(set-marker (process-mark proc) (point) outbuf) |
;; Start the compilation. |
954 |
(setq compilation-in-progress |
(if (fboundp 'start-process) |
955 |
(cons proc compilation-in-progress))) |
(let ((proc (if (eq mode t) |
956 |
;; No asynchronous processes available. |
(get-buffer-process |
957 |
(message "Executing `%s'..." command) |
(with-no-warnings |
958 |
;; Fake modeline display as if `start-process' were run. |
(comint-exec outbuf (downcase mode-name) |
959 |
(setq mode-line-process ":run") |
shell-file-name nil `("-c" ,command)))) |
960 |
(force-mode-line-update) |
(start-process-shell-command (downcase mode-name) |
961 |
(sit-for 0) ; Force redisplay |
outbuf command)))) |
962 |
(let ((status (call-process shell-file-name nil outbuf nil "-c" |
;; Make the buffer's mode line show process state. |
963 |
command))) |
(setq mode-line-process '(":%s")) |
964 |
(cond ((numberp status) |
(set-process-sentinel proc 'compilation-sentinel) |
965 |
(compilation-handle-exit 'exit status |
(set-process-filter proc 'compilation-filter) |
966 |
(if (zerop status) |
(set-marker (process-mark proc) (point) outbuf) |
967 |
"finished\n" |
(setq compilation-in-progress |
968 |
(format "\ |
(cons proc compilation-in-progress))) |
969 |
|
;; No asynchronous processes available. |
970 |
|
(message "Executing `%s'..." command) |
971 |
|
;; Fake modeline display as if `start-process' were run. |
972 |
|
(setq mode-line-process ":run") |
973 |
|
(force-mode-line-update) |
974 |
|
(sit-for 0) ; Force redisplay |
975 |
|
(let ((status (call-process shell-file-name nil outbuf nil "-c" |
976 |
|
command))) |
977 |
|
(cond ((numberp status) |
978 |
|
(compilation-handle-exit 'exit status |
979 |
|
(if (zerop status) |
980 |
|
"finished\n" |
981 |
|
(format "\ |
982 |
exited abnormally with code %d\n" |
exited abnormally with code %d\n" |
983 |
status)))) |
status)))) |
984 |
((stringp status) |
((stringp status) |
985 |
(compilation-handle-exit 'signal status |
(compilation-handle-exit 'signal status |
986 |
(concat status "\n"))) |
(concat status "\n"))) |
987 |
(t |
(t |
988 |
(compilation-handle-exit 'bizarre status status)))) |
(compilation-handle-exit 'bizarre status status)))) |
989 |
;; Without async subprocesses, the buffer is not yet |
;; Without async subprocesses, the buffer is not yet |
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) |
1114 |
:version "21.4") |
:version "21.4") |
1115 |
|
|
1116 |
;;;###autoload |
;;;###autoload |
1117 |
(defun compilation-mode () |
(defun compilation-mode (&optional name-of-mode) |
1118 |
"Major mode for compilation log buffers. |
"Major mode for compilation log buffers. |
1119 |
\\<compilation-mode-map>To visit the source for a line-numbered error, |
\\<compilation-mode-map>To visit the source for a line-numbered error, |
1120 |
move point to the error message line and type \\[compile-goto-error]. |
move point to the error message line and type \\[compile-goto-error]. |
1127 |
(kill-all-local-variables) |
(kill-all-local-variables) |
1128 |
(use-local-map compilation-mode-map) |
(use-local-map compilation-mode-map) |
1129 |
(setq major-mode 'compilation-mode |
(setq major-mode 'compilation-mode |
1130 |
mode-name "Compilation") |
mode-name (or name-of-mode "Compilation")) |
1131 |
(set (make-local-variable 'page-delimiter) |
(set (make-local-variable 'page-delimiter) |
1132 |
compilation-page-delimiter) |
compilation-page-delimiter) |
1133 |
(compilation-setup) |
(compilation-setup) |
1193 |
"Prepare the buffer for the compilation parsing commands to work. |
"Prepare the buffer for the compilation parsing commands to work. |
1194 |
Optional argument MINOR indicates this is called from |
Optional argument MINOR indicates this is called from |
1195 |
`compilation-minor-mode'." |
`compilation-minor-mode'." |
1196 |
|
(unless minor |
1197 |
|
(setq buffer-read-only t)) |
1198 |
(make-local-variable 'compilation-current-error) |
(make-local-variable 'compilation-current-error) |
1199 |
(make-local-variable 'compilation-messages-start) |
(make-local-variable 'compilation-messages-start) |
1200 |
(make-local-variable 'compilation-error-screen-columns) |
(make-local-variable 'compilation-error-screen-columns) |
1256 |
|
|
1257 |
(defun compilation-handle-exit (process-status exit-status msg) |
(defun compilation-handle-exit (process-status exit-status msg) |
1258 |
"Write MSG in the current buffer and hack its mode-line-process." |
"Write MSG in the current buffer and hack its mode-line-process." |
1259 |
(let ((buffer-read-only nil) |
(let ((inhibit-read-only t) |
1260 |
(status (if compilation-exit-message-function |
(status (if compilation-exit-message-function |
1261 |
(funcall compilation-exit-message-function |
(funcall compilation-exit-message-function |
1262 |
process-status exit-status msg) |
process-status exit-status msg) |