;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; times of the form "HH:MM:SS" where MM is taken as a line number, so
;; the last line tries to rule out message where the info after the
;; line number starts with "SS". --Stef
+
+ ;; The core of the regexp is the one with *?. It says that a file name
+ ;; can be composed of any non-newline char, but it also rules out some
+ ;; valid but unlikely cases, such as a trailing space or a space
+ ;; followed by a -.
"^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
-\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-\n]\\)*?\\): ?\
+\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\
\\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
\\(?:-\\([0-9]+\\)?\\(?:\\3\\([0-9]+\\)\\)?\\)?:\
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
(sun-ada
"^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
+ (watcom
+ "\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)): ?\
+\\(?:\\(Error! E[0-9]+\\)\\|\\(Warning! W[0-9]+\\)\\):"
+ 1 2 nil (4))
+
(4bsd
"\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))
(defun compilation-auto-jump (buffer pos)
(with-current-buffer buffer
(goto-char pos)
+ (let ((win (get-buffer-window buffer 0)))
+ (if win (set-window-point win pos)))
(if compilation-auto-jump-to-first-error
(compile-goto-error))))
(list
(let ((command (eval compile-command)))
(if (or compilation-read-command current-prefix-arg)
- (read-from-minibuffer "Compile command: "
- command nil nil
- (if (equal (car compile-history) command)
- '(compile-history . 1)
- 'compile-history))
+ (read-shell-command "Compile command: " command
+ (if (equal (car compile-history) command)
+ '(compile-history . 1)
+ 'compile-history))
command))
(consp current-prefix-arg)))
(unless (equal command (eval compile-command))
(compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?"
"\\1" error-message)))
(compilation-start command nil name-function highlight-regexp)))
-(make-obsolete 'compile-internal 'compilation-start)
+(make-obsolete 'compile-internal 'compilation-start "22.1")
;;;###autoload
(defun compilation-start (command &optional mode name-function highlight-regexp)
(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)
- ;; Remember the original dir, so we can use it when we recompile.
- ;; default-directory' can't be used reliably for that because it may be
- ;; affected by the special handling of "cd ...;".
- (set (make-local-variable 'compilation-directory) thisdir)
;; Make compilation buffer read-only. The filter can still write it.
;; Clear out the compilation buffer.
(let ((inhibit-read-only t)
(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))
+ ;; Remember the original dir, so we can use it when we recompile.
+ ;; default-directory' can't be used reliably for that because it may be
+ ;; affected by the special handling of "cd ...;".
+ ;; NB: must be fone after (funcall mode) as that resets local variables
+ (set (make-local-variable 'compilation-directory) thisdir)
(if highlight-regexp
(set (make-local-variable 'compilation-highlight-regexp)
highlight-regexp))
(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.
- (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))))
+ (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 ":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)))
(define-key map "\M-p" 'compilation-previous-error)
(define-key map "\M-{" 'compilation-previous-file)
(define-key map "\M-}" 'compilation-next-file)
+ (define-key map "g" 'recompile) ; revert
+ (define-key map "q" 'quit-window)
;; Set up the menu-bar
(define-key map [menu-bar compilation]
(cons "Errors" compilation-menu-map))
(define-key map "\M-}" 'compilation-next-file)
(define-key map "\t" 'compilation-next-error)
(define-key map [backtab] 'compilation-previous-error)
+ (define-key map "g" 'recompile) ; revert
+ (define-key map "q" 'quit-window)
(define-key map " " 'scroll-up)
(define-key map "\^?" 'scroll-down)
`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
- :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 ()