(error nil))
(error "Cannot have two processes in `%s' at once"
(buffer-name)))))
- (buffer-disable-undo (current-buffer))
;; first transfer directory from where M-x compile was called
(setq default-directory thisdir)
;; Make compilation buffer read-only. The filter can still write it.
(erase-buffer)
;; Select the desired mode.
(if (not (eq mode t))
- (funcall mode)
+ (progn
+ (buffer-disable-undo)
+ (funcall mode))
(setq buffer-read-only nil)
(with-no-warnings (comint-mode))
(compilation-shell-minor-mode))
(funcall compilation-process-setup-function))
(compilation-set-window-height outwin)
;; Start the compilation.
- (let ((proc
- (if (eq mode t)
- ;; comint uses `start-file-process'.
- (get-buffer-process
- (with-no-warnings
- (comint-exec
- outbuf (downcase mode-name)
- (if (file-remote-p default-directory)
- "/bin/sh"
- shell-file-name)
- nil `("-c" ,command))))
- (start-file-process-shell-command (downcase mode-name)
- outbuf command))))
- ;; Make the buffer's mode line show process state.
+ (if (fboundp 'start-process)
+ (let ((proc
+ (if (eq mode t)
+ ;; comint uses `start-file-process'.
+ (get-buffer-process
+ (with-no-warnings
+ (comint-exec
+ outbuf (downcase mode-name)
+ (if (file-remote-p default-directory)
+ "/bin/sh"
+ shell-file-name)
+ nil `("-c" ,command))))
+ (start-file-process-shell-command (downcase mode-name)
+ outbuf command))))
+ ;; Make the buffer's mode line show process state.
+ (setq mode-line-process
+ (list (propertize ":%s" 'face 'compilation-warning)))
+ (set-process-sentinel proc 'compilation-sentinel)
+ (unless (eq mode t)
+ ;; Keep the comint filter, since it's needed for proper handling
+ ;; of the prompts.
+ (set-process-filter proc 'compilation-filter))
+ ;; Use (point-max) here so that output comes in
+ ;; after the initial text,
+ ;; regardless of where the user sees point.
+ (set-marker (process-mark proc) (point-max) outbuf)
+ (when compilation-disable-input
+ (condition-case nil
+ (process-send-eof proc)
+ ;; The process may have exited already.
+ (error nil)))
+ (setq compilation-in-progress
+ (cons proc compilation-in-progress)))
+ ;; No asynchronous processes available.
+ (message "Executing `%s'..." command)
+ ;; Fake modeline display as if `start-process' were run.
(setq mode-line-process
- (list (propertize ":%s" 'face 'compilation-warning)))
- (set-process-sentinel proc 'compilation-sentinel)
- (set-process-filter proc 'compilation-filter)
- ;; Use (point-max) here so that output comes in
- ;; after the initial text,
- ;; regardless of where the user sees point.
- (set-marker (process-mark proc) (point-max) outbuf)
- (when compilation-disable-input
- (condition-case nil
- (process-send-eof proc)
- ;; The process may have exited already.
- (error nil)))
- (setq compilation-in-progress
- (cons proc compilation-in-progress))))
+ (list (propertize ":run" 'face 'compilation-warning)))
+ (force-mode-line-update)
+ (sit-for 0) ; Force redisplay
+ (save-excursion
+ ;; Insert the output at the end, after the initial text,
+ ;; regardless of where the user sees point.
+ (goto-char (point-max))
+ (let* ((buffer-read-only nil) ; call-process needs to modify outbuf
+ (status (call-process shell-file-name nil outbuf nil "-c"
+ command)))
+ (cond ((numberp status)
+ (compilation-handle-exit
+ 'exit status
+ (if (zerop status)
+ "finished\n"
+ (format "exited abnormally with code %d\n" status))))
+ ((stringp status)
+ (compilation-handle-exit 'signal status
+ (concat status "\n")))
+ (t
+ (compilation-handle-exit 'bizarre status status)))))
+ ;; Without async subprocesses, the buffer is not yet
+ ;; fontified, so fontify it now.
+ (let ((font-lock-verbose nil)) ; shut up font-lock messages
+ (font-lock-fontify-buffer))
+ (set-buffer-modified-p nil)
+ (message "Executing `%s'...done" command)))
;; Now finally cd to where the shell started make/grep/...
- (setq default-directory thisdir))
- (if (buffer-local-value 'compilation-scroll-output outbuf)
- (save-selected-window
- (select-window outwin)
- (goto-char (point-max))))
+ (setq default-directory thisdir)
+ ;; The following form selected outwin ever since revision 1.183,
+ ;; so possibly messing up point in some other window (bug#1073).
+ ;; Moved into the scope of with-current-buffer, though still with
+ ;; complete disregard for the case when compilation-scroll-output
+ ;; equals 'first-error (martin 2008-10-04).
+ (when compilation-scroll-output
+ (goto-char (point-max))))
+
;; Make it so the next C-x ` will use this buffer.
(setq next-error-last-buffer outbuf)))
`compilation-minor-mode-map' is a parent of this.")
(defvar compilation-mode-tool-bar-map
- (if (display-graphic-p)
- (let ((map (butlast (copy-keymap tool-bar-map)))
- (help (last tool-bar-map))) ;; Keep Help last in tool bar
- (tool-bar-local-item
- "left-arrow" 'previous-error-no-select 'previous-error-no-select map
- :rtl "right-arrow"
- :help "Goto previous error")
- (tool-bar-local-item
- "right-arrow" 'next-error-no-select 'next-error-no-select map
- :rtl "left-arrow"
- :help "Goto next error")
- (tool-bar-local-item
- "cancel" 'kill-compilation 'kill-compilation map
- :enable '(let ((buffer (compilation-find-buffer)))
- (get-buffer-process buffer))
- :help "Stop compilation")
- (tool-bar-local-item
- "refresh" 'recompile 'recompile map
- :help "Restart compilation")
- (append map help))))
+ ;; When bootstrapping, tool-bar-map is not properly initialized yet,
+ ;; so don't do anything.
+ (when (keymapp (butlast tool-bar-map))
+ (let ((map (butlast (copy-keymap tool-bar-map)))
+ (help (last tool-bar-map))) ;; Keep Help last in tool bar
+ (tool-bar-local-item
+ "left-arrow" 'previous-error-no-select 'previous-error-no-select map
+ :rtl "right-arrow"
+ :help "Goto previous error")
+ (tool-bar-local-item
+ "right-arrow" 'next-error-no-select 'next-error-no-select map
+ :rtl "left-arrow"
+ :help "Goto next error")
+ (tool-bar-local-item
+ "cancel" 'kill-compilation 'kill-compilation map
+ :enable '(let ((buffer (compilation-find-buffer)))
+ (get-buffer-process buffer))
+ :help "Stop compilation")
+ (tool-bar-local-item
+ "refresh" 'recompile 'recompile map
+ :help "Restart compilation")
+ (append map help))))
(put 'compilation-mode 'mode-class 'special)
(interactive)
(kill-all-local-variables)
(use-local-map compilation-mode-map)
+ ;; Let windows scroll along with the output.
+ (set (make-local-variable 'window-point-insertion-type) t)
(set (make-local-variable 'tool-bar-map) compilation-mode-tool-bar-map)
(setq major-mode 'compilation-mode
mode-name (or name-of-mode "Compilation"))
(defun compilation-filter (proc string)
"Process filter for compilation buffers.
-Just inserts the text, but uses `insert-before-markers'."
- (if (buffer-name (process-buffer proc))
- (with-current-buffer (process-buffer proc)
- (let ((inhibit-read-only t))
- (save-excursion
- (goto-char (process-mark proc))
- (insert-before-markers string)
- (run-hooks 'compilation-filter-hook))))))
+Just inserts the text, and runs `compilation-filter-hook'."
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let ((inhibit-read-only t)
+ ;; `save-excursion' doesn't use the right insertion-type for us.
+ (pos (copy-marker (point) t)))
+ (unwind-protect
+ (progn
+ (goto-char (process-mark proc))
+ ;; We used to use `insert-before-markers', so that windows with
+ ;; point at `process-mark' scroll along with the output, but we
+ ;; now use window-point-insertion-type instead.
+ (insert string)
+ (set-marker (process-mark proc) (point))
+ (run-hooks 'compilation-filter-hook))
+ (goto-char pos))))))
;;; test if a buffer is a compilation buffer, assuming we're in the buffer
(defsubst compilation-buffer-internal-p ()