;;; compile.el --- run compiler as inferior of Emacs, parse error messages
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2011
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2012
;; Free Software Foundation, Inc.
;; Authors: Roland McGrath <roland@gnu.org>,
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'tool-bar)
(require 'comint)
after `call-process' inserts the grep output into the buffer.")
(defvar compilation-filter-start nil
- "Start of the text inserted by `compilation-filter'.
-This is bound to a buffer position before running `compilation-filter-hook'.")
+ "Position of the start of the text inserted by `compilation-filter'.
+This is bound before running `compilation-filter-hook'.")
(defvar compilation-first-column 1
- "*This is how compilers number the first column, usually 1 or 0.")
+ "This is how compilers number the first column, usually 1 or 0.
+If this is buffer-local in the destination buffer, Emacs obeys
+that value, otherwise it uses the value in the *compilation*
+buffer. This enables a major-mode to specify its own value.")
(defvar compilation-parse-errors-filename-function nil
"Function to call to post-process filenames while parsing error messages.
;;;###autoload
(defvar compilation-process-setup-function nil
- "*Function to call to customize the compilation process.
+ "Function to call to customize the compilation process.
This function is called immediately before the compilation process is
started. It can be used to set any variables or functions that are used
while processing the output of the compilation process.")
;; due to matching filenames via \\(.*?\\). This might be faster.
(maven
;; Maven is a popular free software build tool for Java.
- "\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 1 2 3)
+ "\\([^ \n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 1 2 3)
(jikes-line
"^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
each character occupying one column.
The default is to use screen columns, which requires that the compilation
program and Emacs agree about the display width of the characters,
-especially the TAB character."
+especially the TAB character.
+If this is buffer-local in the destination buffer, Emacs obeys
+that value, otherwise it uses the value in the *compilation*
+buffer. This enables a major-mode to specify its own value."
:type 'boolean
:group 'compilation
:version "20.4")
(defvar compilation-locs ())
(defvar compilation-debug nil
- "*Set this to t before creating a *compilation* buffer.
+ "Set this to t before creating a *compilation* buffer.
Then every error line will have a debug text property with the matcher that
fit this line and the match data. Use `describe-text-properties'.")
:group 'compilation
:version "22.1")
+;; The next three faces must be able to stand out against the
+;; `mode-line' and `mode-line-inactive' faces.
+
+(defface compilation-mode-line-fail
+ '((default :inherit compilation-error)
+ (((class color) (min-colors 16)) (:foreground "Red1" :weight bold))
+ (((class color) (min-colors 8)) (:foreground "red"))
+ (t (:inverse-video t :weight bold)))
+ "Face for Compilation mode's \"error\" mode line indicator."
+ :group 'compilation
+ :version "24.2")
+
+(defface compilation-mode-line-run
+ '((t :inherit compilation-warning))
+ "Face for Compilation mode's \"running\" mode line indicator."
+ :group 'compilation
+ :version "24.2")
+
+(defface compilation-mode-line-exit
+ '((default :inherit compilation-info)
+ (((class color) (min-colors 16))
+ (:foreground "ForestGreen" :weight bold))
+ (((class color)) (:foreground "green" :weight bold))
+ (t (:weight bold)))
+ "Face for Compilation mode's \"exit\" mode line indicator."
+ :group 'compilation
+ :version "24.2")
+
(defface compilation-line-number
'((t :inherit font-lock-keyword-face))
"Face for displaying line numbers in compiler messages."
;; (make-variable-buffer-local 'compilation-buffer-modtime)
(defvar compilation-skip-to-next-location t
- "*If non-nil, skip multiple error messages for the same source location.")
+ "If non-nil, skip multiple error messages for the same source location.")
(defcustom compilation-skip-threshold 1
"Compilation motion commands skip less important messages.
3)))
(setq compilation-skip-threshold level)
(message "Skipping %s"
- (case compilation-skip-threshold
+ (pcase compilation-skip-threshold
(0 "Nothing")
(1 "Info messages")
(2 "Warnings and info"))))
;; modified using the same *compilation* buffer. this necessitates
;; re-parsing markers.
-;; (defstruct (compilation--loc
+;; (cl-defstruct (compilation--loc
;; (:constructor nil)
;; (:copier nil)
;; (:constructor compilation--make-loc
;; These are the value of the `compilation-message' text-properties in the
;; compilation buffer.
-(defstruct (compilation--message
+(cl-defstruct (compilation--message
(:constructor nil)
(:copier nil)
;; (:type list) ;Old representation.
(marker
(if marker-line (compilation--loc->marker (cadr marker-line))))
(screen-columns compilation-error-screen-columns)
+ (first-column compilation-first-column)
end-marker loc end-loc)
(if (not (and marker (marker-buffer marker)))
(setq marker nil) ; no valid marker for this file
- (setq loc (or line 1)) ; normalize no linenumber to line 1
+ (unless line (setq line 1)) ; normalize no linenumber to line 1
(catch 'marker ; find nearest loc, at least one exists
(dolist (x (cddr (compilation--file-struct->loc-tree
file-struct))) ; Loop over remaining lines.
- (if (> (car x) loc) ; Still bigger.
+ (if (> (car x) line) ; Still bigger.
(setq marker-line x)
- (if (> (- (or (car marker-line) 1) loc)
- (- loc (car x))) ; Current line is nearer.
+ (if (> (- (or (car marker-line) 1) line)
+ (- line (car x))) ; Current line is nearer.
(setq marker-line x))
(throw 'marker t))))
(setq marker (compilation--loc->marker (cadr marker-line))
;; Obey the compilation-error-screen-columns of the target
;; buffer if its major mode set it buffer-locally.
(if (local-variable-p 'compilation-error-screen-columns)
- compilation-error-screen-columns screen-columns)))
+ compilation-error-screen-columns screen-columns))
+ (compilation-first-column
+ (if (local-variable-p 'compilation-first-column)
+ compilation-first-column first-column)))
(save-excursion
(save-restriction
(widen)
(goto-char (marker-position marker))
- (when (or end-col end-line)
+ ;; Set end-marker if appropriate and go to line.
+ (if (not (or end-col end-line))
+ (beginning-of-line (- line marker-line -1))
(beginning-of-line (- (or end-line line) marker-line -1))
(if (or (null end-col) (< end-col 0))
(end-of-line)
(compilation-move-to-column end-col screen-columns))
- (setq end-marker (point-marker)))
- (beginning-of-line (if end-line
- (- line end-line -1)
- (- loc marker-line -1)))
+ (setq end-marker (point-marker))
+ (when end-line (beginning-of-line (- line end-line -1))))
(if col
(compilation-move-to-column col screen-columns)
(forward-to-indentation 0))
(goto-char end)
(unless (bolp)
;; We generally don't like to parse partial lines.
- (assert (eobp))
+ (cl-assert (eobp))
(when (let ((proc (get-buffer-process (current-buffer))))
(and proc (memq (process-status proc) '(run open))))
(setq end (line-beginning-position))))
outbuf command))))
;; Make the buffer's mode line show process state.
(setq mode-line-process
- (list (propertize ":%s" 'face 'compilation-warning)))
+ '(:propertize ":%s" face compilation-mode-line-run))
(set-process-sentinel proc 'compilation-sentinel)
(unless (eq mode t)
;; Keep the comint filter, since it's needed for proper handling
(cons proc compilation-in-progress)))
;; No asynchronous processes available.
(message "Executing `%s'..." command)
- ;; Fake modeline display as if `start-process' were run.
+ ;; Fake mode line display as if `start-process' were run.
(setq mode-line-process
- (list (propertize ":run" 'face 'compilation-warning)))
+ '(:propertize ":run" face compilation-mode-line-run))
(force-mode-line-update)
(sit-for 0) ; Force redisplay
(save-excursion
(setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
+;;;###autoload
+(put 'define-compilation-mode 'doc-string-elt 3)
+
(defmacro define-compilation-mode (mode name doc &rest body)
"This is like `define-derived-mode' without the PARENT argument.
The parent is always `compilation-mode' and the customizable `compilation-...'
(car status)))))
(message "%s" msg)
(propertize out-string
- 'help-echo msg 'face (if (> exit-status 0)
- 'compilation-error
- 'compilation-info))))
+ 'help-echo msg
+ 'face (if (> exit-status 0)
+ 'compilation-mode-line-fail
+ 'compilation-mode-line-exit))))
;; Force mode line redisplay soon.
(force-mode-line-update)
(if (and opoint (< opoint omax))
(if (or (eq (get-text-property ,limit 'compilation-message)
(get-text-property opt 'compilation-message))
(eq pt opt))
- (error ,error compilation-error)
+ (user-error ,error compilation-error)
(setq pt ,limit)))
;; prop 'compilation-message usually has 2 changes, on and off, so
;; re-search if off
(or (setq msg (get-text-property pt 'compilation-message))
(if (setq pt (,property-change pt 'compilation-message nil ,limit))
(setq msg (get-text-property pt 'compilation-message)))
- (error ,error compilation-error))
+ (user-error ,error compilation-error))
(or (< (compilation--message->type msg) compilation-skip-threshold)
(if different-file
(eq (prog1 last
(when reset
(setq compilation-current-error nil))
(let* ((screen-columns compilation-error-screen-columns)
+ (first-column compilation-first-column)
(last 1)
(msg (compilation-next-error (or n 1) nil
(or compilation-current-error
;; Obey the compilation-error-screen-columns of the target
;; buffer if its major mode set it buffer-locally.
(if (local-variable-p 'compilation-error-screen-columns)
- compilation-error-screen-columns screen-columns)))
+ compilation-error-screen-columns screen-columns))
+ (compilation-first-column
+ (if (local-variable-p 'compilation-first-column)
+ compilation-first-column first-column)))
(save-restriction
(widen)
(goto-char (point-min))
(push fs compilation-gcpro)
(let ((loc (compilation-assq (or line 1) (cdr fs))))
(setq loc (compilation-assq col loc))
- (assert (null (cdr loc)))
+ (cl-assert (null (cdr loc)))
(setcdr loc (compilation--make-cdrloc line fs marker))
loc)))
(defun compilation--flush-file-structure (file)
(or (consp file) (setq file (list file)))
(let ((fs (compilation-get-file-structure file)))
- (assert (eq fs (gethash file compilation-locs)))
- (assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
+ (cl-assert (eq fs (gethash file compilation-locs)))
+ (cl-assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
compilation-locs)))
(maphash (lambda (k v)
(if (eq v fs) (remhash k compilation-locs)))
compilation-locs)))
-(add-to-list 'debug-ignored-errors "\\`No more [-a-z ]+s yet\\'")
-(add-to-list 'debug-ignored-errors "\\`Moved past last .*")
-
;;; Compatibility with the old compile.el.
(defvaralias 'compilation-last-buffer 'next-error-last-buffer)