;;; compile.el --- run compiler as inferior of Emacs, parse error messages
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 03, 2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+;; 2001, 2003, 2004 Free Software Foundation, Inc.
;; Authors: Roland McGrath <roland@gnu.org>,
;; Daniel Pfeiffer <occitan@esperanto.org>
(epc
"^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
+ (ftnchek
+ "\\(^Warning .*\\)? line[ \n]\\([0-9]+\\)[ \n]\\(?:col \\([0-9]+\\)[ \n]\\)?file \\([^ :;\n]+\\)"
+ 4 2 3 (1))
+
(iar
"^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
1 2 nil (3))
;; fixme: should be `mips'
(irix
- "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
- \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
+ "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\
+\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
(java
"^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
(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 -1))
- (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)
2)))
(compilation-internal-error-properties file line end-line col end-col type fmt)))
+(defun compilation-move-to-column (col screen)
+ "Go to column COL on the current line.
+If SCREEN is non-nil, columns are screen columns, otherwise, they are
+just char-counts."
+ (if screen
+ (move-to-column col)
+ (goto-char (min (+ (line-beginning-position) col) (line-end-position)))))
+
(defun compilation-internal-error-properties (file line end-line col end-col type fmt)
"Get the meta-info that will be added as text-properties.
LINE, END-LINE, COL, END-COL are integers or nil.
(goto-char (marker-position marker))
(when (or end-col end-line)
(beginning-of-line (- (or end-line line) marker-line -1))
- (if (< end-col 0)
+ (if (or (null end-col) (< end-col 0))
(end-of-line)
- (if compilation-error-screen-columns
- (move-to-column end-col)
- (forward-char end-col)))
+ (compilation-move-to-column
+ end-col compilation-error-screen-columns))
(setq end-marker (list (point-marker))))
(beginning-of-line (if end-line
- (- end-line line -1)
+ (- line end-line -1)
(- loc marker-line -1)))
(if col
- (if compilation-error-screen-columns
- (move-to-column col)
- (forward-char col))
+ (compilation-move-to-column
+ col compilation-error-screen-columns)
(forward-to-indentation 0))
(setq marker (list (point-marker))))))
,@(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)
to a function that generates a unique name."
(interactive
(list
- (if (or compilation-read-command current-prefix-arg)
- (read-from-minibuffer "Compile command: "
- (eval compile-command) nil nil
- '(compile-history . 1))
- (eval compile-command))
+ (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))
+ command))
(consp current-prefix-arg)))
(unless (equal command (eval compile-command))
(setq compile-command command))
(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)
+ (substitute-env-vars (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* ((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))
- (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))
+ (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)
(defvar compilation-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'compile-goto-error)
+ (define-key map [follow-link] 'mouse-face)
(define-key map "\C-c\C-c" 'compile-goto-error)
(define-key map "\C-m" 'compile-goto-error)
(define-key map "\C-c\C-k" 'kill-compilation)
(defvar compilation-button-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'compile-goto-error)
+ (define-key map [follow-link] 'mouse-face)
(define-key map "\C-m" 'compile-goto-error)
map)
"Keymap for compilation-message buttons.")
(defvar compilation-mode-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map compilation-minor-mode-map)
+ ;; Don't inherit from compilation-minor-mode-map,
+ ;; because that introduces a menu bar item we don't want.
+ ;; That confuses C-down-mouse-3.
+ (define-key map [mouse-2] 'compile-goto-error)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map "\C-c\C-c" 'compile-goto-error)
+ (define-key map "\C-m" 'compile-goto-error)
+ (define-key map "\C-c\C-k" 'kill-compilation)
+ (define-key map "\M-n" 'compilation-next-error)
+ (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 " " '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]
- (cons "Compile" (make-sparse-keymap "Compile")))
+ (let ((submap (make-sparse-keymap "Compile")))
+ (define-key map [menu-bar compilation]
+ (cons "Compile" submap))
+ (set-keymap-parent submap compilation-menu-map))
(define-key map [menu-bar compilation compilation-separator2]
'("----" . nil))
(define-key map [menu-bar compilation compilation-grep]
: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].
(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)
+ (setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
(defmacro define-compilation-mode (mode name doc &rest body)
(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)
;; If the current buffer is a compilation buffer, return it.
;; Otherwise, look for a compilation buffer and signal an error
;; if there are none.
-(defun compilation-find-buffer (&optional other-buffer)
- (next-error-find-buffer other-buffer 'compilation-buffer-internal-p))
+(defun compilation-find-buffer (&optional avoid-current)
+ (next-error-find-buffer avoid-current 'compilation-buffer-internal-p))
;;;###autoload
(defun compilation-next-error-function (n &optional reset)
(if (car col)
(if (eq (car col) -1) ; special case for range end
(end-of-line)
- (if columns
- (move-to-column (car col))
- (beginning-of-line)
- (forward-char (car col))))
+ (compilation-move-to-column (car col) columns))
(beginning-of-line)
(skip-chars-forward " \t"))
(if (nth 3 col)
(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 '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