(gnu
"^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
-\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\): ?\
+\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\
\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3))
(oracle
- "^Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):$"
+ "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
+\\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\
+\\(?:,\\| in\\| of\\)? file \\(.*?\\):?$"
3 1 2)
(perl
(list 'const (car elt)))
compilation-error-regexp-alist-alist))
:link `(file-link :tag "example file"
- ,(concat doc-directory "compilation.txt"))
+ ,(expand-file-name "compilation.txt" data-directory))
:group 'compilation)
(defvar compilation-directory nil
(defvar compile-history nil)
(defface compilation-warning-face
- '((((type tty) (class color)) (:foreground "cyan" :weight bold))
- (((class color)) (:foreground "Orange" :weight bold))
+ '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold))
+ (((class color)) (:foreground "cyan" :weight bold))
(t (:weight bold)))
"Face used to highlight compiler warnings."
:group 'font-lock-highlighting-faces
:version "21.4")
(defface compilation-info-face
- '((((type tty) (class color)) (:foreground "green" :weight bold))
- (((class color) (background light)) (:foreground "Green3" :weight bold))
- (((class color) (background dark)) (:foreground "Green" :weight bold))
+ '((((class color) (min-colors 16) (background light))
+ (:foreground "Green3" :weight bold))
+ (((class color) (min-colors 16) (background dark))
+ (:foreground "Green" :weight bold))
+ (((class color)) (:foreground "green" :weight bold))
(t (:weight bold)))
"Face used to highlight compiler warnings."
:group 'font-lock-highlighting-faces
(and end-line
(setq end-line (match-string-no-properties end-line))
(setq end-line (string-to-number end-line)))
- (and col
- (setq col (match-string-no-properties col))
- (setq col (- (string-to-number col) compilation-first-column)))
- (if (and end-col (setq end-col (match-string-no-properties end-col)))
- (setq end-col (- (string-to-number end-col) compilation-first-column))
- (if end-line (setq end-col -1)))
+ (if col
+ (if (functionp col)
+ (setq col (funcall col))
+ (and
+ (setq col (match-string-no-properties col))
+ (setq col (- (string-to-number col) compilation-first-column)))))
+ (if (and end-col (functionp end-col))
+ (setq end-col (funcall end-col))
+ (if (and end-col (setq end-col (match-string-no-properties end-col)))
+ (setq end-col (- (string-to-number end-col) compilation-first-column -1))
+ (if end-line (setq end-col -1))))
(if (consp type) ; not a static type, check what it is.
(setq type (or (and (car type) (match-end (car type)) 1)
(and (cdr type) (match-end (cdr type)) 0)
,@(when end-line
`((,end-line compilation-line-face nil t)))
- ,@(when col
+ ,@(when (integerp col)
`((,col compilation-column-face nil t)))
- ,@(when end-col
+ ,@(when (integerp end-col)
`((,end-col compilation-column-face nil t)))
,@(nthcdr 6 item)
original use. Otherwise, recompile using `compile-command'."
(interactive)
(save-some-buffers (not compilation-ask-about-save) nil)
- (let ((default-directory (or compilation-directory default-directory)))
+ (let ((default-directory
+ (or (and (not (eq major-mode (nth 1 compilation-arguments)))
+ compilation-directory)
+ default-directory)))
(apply 'compilation-start (or compilation-arguments
`(,(eval compile-command))))))
(funcall name-function mode-name))
(compilation-buffer-name-function
(funcall compilation-buffer-name-function mode-name))
- ((and (eq major-mode 'compilation-mode)
- (equal mode-name (nth 2 compilation-arguments)))
+ ((eq major-mode (nth 1 compilation-arguments))
(buffer-name))
(t
(concat "*" (downcase mode-name) "*"))))
(defun compilation-start (command &optional mode name-function highlight-regexp)
"Run compilation command COMMAND (low level interface).
+If COMMAND starts with a cd command, that becomes the `default-directory'.
The rest of the arguments are optional; for them, nil means use the default.
MODE is the major mode to set in the compilation buffer. Mode
Returns the compilation buffer created."
(or mode (setq mode 'compilation-mode))
- (let ((name-of-mode
- (if (eq mode t)
- (prog1 "compilation" (require 'comint))
- (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"))
- process-environment))
- (thisdir default-directory)
- outwin outbuf)
+ (let* ((name-of-mode
+ (if (eq mode t)
+ (prog1 "compilation" (require 'comint))
+ (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
+ (thisdir default-directory)
+ outwin outbuf)
(with-current-buffer
(setq outbuf
(get-buffer-create
(error nil))
(error "Cannot have two processes in `%s' at once"
(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 `cd' command to indicate this.
- (setq buffer-read-only nil)
(buffer-disable-undo (current-buffer))
- (erase-buffer)
- (buffer-enable-undo (current-buffer))
+ ;; first transfer directory from where M-x compile was called
(setq default-directory thisdir)
- ;; output a mode setter, for saving and later reloading this buffer
- (insert "cd " thisdir " # -*-" name-of-mode
- "-*-\nEntering directory `" thisdir "'\n" command "\n")
+ ;; Make compilation buffer read-only. The filter can still write it.
+ ;; Clear out the compilation buffer.
+ (let ((inhibit-read-only t)
+ (default-directory thisdir))
+ ;; Then evaluate a cd command if any, but don't perform it yet, else start-command
+ ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make"
+ (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
+ (if (match-end 1)
+ (match-string 1 command)
+ "~")
+ default-directory))
+ (erase-buffer)
+ ;; output a mode setter, for saving and later reloading this buffer
+ (insert "-*- mode: " name-of-mode
+ "; default-directory: " (prin1-to-string default-directory)
+ " -*-\n" command "\n")
+ (setq thisdir default-directory))
(set-buffer-modified-p nil))
;; If we're already in the compilation buffer, go to the end
;; of the buffer, so point will track the compilation output.
;; Pop up the compilation buffer.
(setq outwin (display-buffer outbuf nil t))
(with-current-buffer outbuf
- (if (not (eq mode t))
- (funcall mode)
- (with-no-warnings (comint-mode))
- (compilation-shell-minor-mode))
- ;; In what way is it non-ergonomic ? -stef
- ;; (toggle-read-only 1) ;;; Non-ergonomic.
- (if highlight-regexp
- (set (make-local-variable 'compilation-highlight-regexp)
- highlight-regexp))
- (set (make-local-variable 'compilation-arguments)
- (list command mode name-function highlight-regexp))
- (set (make-local-variable 'revert-buffer-function)
- 'compilation-revert-buffer)
- (set-window-start outwin (point-min))
- (or (eq outwin (selected-window))
- (set-window-point outwin (if compilation-scroll-output
- (point)
- (point-min))))
- ;; The setup function is called before compilation-set-window-height
- ;; so it can set the compilation-window-height buffer locally.
- (if compilation-process-setup-function
- (funcall compilation-process-setup-function))
- (compilation-set-window-height outwin)
- ;; Start the compilation.
- (if (fboundp 'start-process)
- (let ((proc (if (eq mode t)
- (get-buffer-process
- (with-no-warnings
- (comint-exec outbuf (downcase mode-name)
- shell-file-name nil `("-c" ,command))))
- (start-process-shell-command (downcase mode-name)
- outbuf command))))
- ;; Make the buffer's mode line show process state.
- (setq mode-line-process '(":%s"))
- (set-process-sentinel proc 'compilation-sentinel)
- (set-process-filter proc 'compilation-filter)
- (set-marker (process-mark proc) (point) outbuf)
- (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 ":run")
- (force-mode-line-update)
- (sit-for 0) ; Force redisplay
- (let ((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 "\
+ (let ((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))))
+ (if (not (eq mode t))
+ (funcall mode)
+ (setq buffer-read-only nil)
+ (with-no-warnings (comint-mode))
+ (compilation-shell-minor-mode))
+ (if highlight-regexp
+ (set (make-local-variable 'compilation-highlight-regexp)
+ highlight-regexp))
+ (set (make-local-variable 'compilation-arguments)
+ (list command mode name-function highlight-regexp))
+ (set (make-local-variable 'revert-buffer-function)
+ 'compilation-revert-buffer)
+ (set-window-start outwin (point-min))
+ (or (eq outwin (selected-window))
+ (set-window-point outwin (if compilation-scroll-output
+ (point)
+ (point-min))))
+ ;; The setup function is called before compilation-set-window-height
+ ;; so it can set the compilation-window-height buffer locally.
+ (if compilation-process-setup-function
+ (funcall compilation-process-setup-function))
+ (compilation-set-window-height outwin)
+ ;; Start the compilation.
+ (if (fboundp 'start-process)
+ (let ((proc (if (eq mode t)
+ (get-buffer-process
+ (with-no-warnings
+ (comint-exec outbuf (downcase mode-name)
+ shell-file-name nil `("-c" ,command))))
+ (start-process-shell-command (downcase mode-name)
+ outbuf command))))
+ ;; Make the buffer's mode line show process state.
+ (setq mode-line-process '(":%s"))
+ (set-process-sentinel proc 'compilation-sentinel)
+ (set-process-filter proc 'compilation-filter)
+ (set-marker (process-mark proc) (point) outbuf)
+ (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 ":run")
+ (force-mode-line-update)
+ (sit-for 0) ; Force redisplay
+ (let ((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))
- (message "Executing `%s'...done" command)))
+ 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))
+ (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)
;; If window is alone in its frame, aside from a minibuffer,
;; don't change its height.
(not (eq window (frame-root-window (window-frame window))))
- ;; This save-current-buffer prevents us from changing the current
- ;; buffer, which might not be the same as the selected window's buffer.
- (save-current-buffer
+ ;; Stef said that doing the saves in this order is safer:
+ (save-excursion
(save-selected-window
(select-window window)
(enlarge-window (- height (window-height))))))))
(set-keymap-parent map compilation-minor-mode-map)
(define-key map " " 'scroll-up)
(define-key map "\^?" 'scroll-down)
+ (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
;; Set up the menu-bar
(define-key map [menu-bar compilation]
:version "21.4")
;;;###autoload
-(defun compilation-mode ()
+(defun compilation-mode (&optional name-of-mode)
"Major mode for compilation log buffers.
\\<compilation-mode-map>To visit the source for a line-numbered error,
move point to the error message line and type \\[compile-goto-error].
To kill the compilation, type \\[kill-compilation].
-Runs `compilation-mode-hook' with `run-hooks' (which see)."
+Runs `compilation-mode-hook' with `run-hooks' (which see).
+
+\\{compilation-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map compilation-mode-map)
(setq major-mode 'compilation-mode
- mode-name "Compilation")
+ mode-name (or name-of-mode "Compilation"))
(set (make-local-variable 'page-delimiter)
compilation-page-delimiter)
(compilation-setup)
"Prepare the buffer for the compilation parsing commands to work.
Optional argument MINOR indicates this is called from
`compilation-minor-mode'."
+ (unless minor
+ (setq buffer-read-only t))
(make-local-variable 'compilation-current-error)
(make-local-variable 'compilation-messages-start)
(make-local-variable 'compilation-error-screen-columns)
(defun compilation-handle-exit (process-status exit-status msg)
"Write MSG in the current buffer and hack its mode-line-process."
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
(status (if compilation-exit-message-function
(funcall compilation-exit-message-function
process-status exit-status msg)
(defun compilation-goto-locus (msg mk end-mk)
"Jump to an error corresponding to MSG at MK.
-All arguments are markers. If END-MK is non nil, mark is set there."
+All arguments are markers. If END-MK is non-nil, mark is set there
+and overlay is highlighted between MK and END-MK."
(if (eq (window-buffer (selected-window))
(marker-buffer msg))
;; If the compilation buffer window is selected,
(widen)
(goto-char mk))
(if end-mk
- (push-mark end-mk nil t)
+ (push-mark end-mk t)
(if mark-active (setq mark-active)))
;; If hideshow got in the way of
;; seeing the right place, open permanently.
compilation-highlight-regexp)))
(compilation-set-window-height w)
- (when (and highlight-regexp
- (not (and end-mk transient-mark-mode)))
+ (when highlight-regexp
(unless compilation-highlight-overlay
(setq compilation-highlight-overlay
(make-overlay (point-min) (point-min)))
- (overlay-put compilation-highlight-overlay 'face 'region))
+ (overlay-put compilation-highlight-overlay 'face 'next-error))
(with-current-buffer (marker-buffer mk)
(save-excursion
- (end-of-line)
+ (if end-mk (goto-char end-mk) (end-of-line))
(let ((end (point)))
- (beginning-of-line)
+ (if mk (goto-char mk) (beginning-of-line))
(if (and (stringp highlight-regexp)
(re-search-forward highlight-regexp end t))
(progn
(goto-char (match-beginning 0))
- (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0)))
- (move-overlay compilation-highlight-overlay (point) end))
- (sit-for 0.5)
- (delete-overlay compilation-highlight-overlay)))))))
-
+ (move-overlay compilation-highlight-overlay
+ (match-beginning 0) (match-end 0)
+ (current-buffer)))
+ (move-overlay compilation-highlight-overlay
+ (point) end (current-buffer)))
+ (if (numberp next-error-highlight)
+ (sit-for next-error-highlight))
+ (if (not (eq next-error-highlight t))
+ (delete-overlay compilation-highlight-overlay))))))
+ (when (and (eq next-error-highlight 'fringe-arrow))
+ (set (make-local-variable 'overlay-arrow-position)
+ (copy-marker (line-beginning-position))))))
\f
(defun compilation-find-file (marker filename dir &rest formats)
"Find a buffer for file FILENAME.