(defvar compile-auto-highlight nil
"*Specify how many compiler errors to highlight (and parse) initially.
-\(Highlighting applies to ean error message when the mouse is over it.)
+\(Highlighting applies to an error message when the mouse is over it.)
If this is a number N, all compiler error messages in the first N lines
are highlighted and parsed as soon as they arrive in Emacs.
If t, highlight and parse the whole compilation output as soon as it arrives.
;; We'll insist that the number be followed by a colon or closing
;; paren, because otherwise this matches just about anything
;; containing a number with spaces around it.
- ("\
-\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
+ ("\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5)
;; Microsoft C/C++:
;; Absoft FORTRAN 77 Compiler 3.1.3
;; error on line 19 of fplot.f: spelling error?
;; warning on line 17 of fplot.f: data type is undefined for variable d
- ("\\(\\|.* on \\)[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
+ ("\\(.* on \\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
;; Apollo cc, 4.3BSD fc:
;; IBM AIX lint is too painful to do right this way. File name
;; prefixes entire sections rather than being on each line.
+ ;; SPARCcompiler Pascal:
+ ;; 20 linjer : array[1..4] of linje;
+ ;; e 18480-----------^--- Inserted ';'
+ ;; and
+ ;; E 18520 line 61 - 0 is undefined
+ ;; These messages don't contain a file name. Instead the compiler gives
+ ;; a message whenever the file being compiled is changed.
+ (" +\\([0-9]+\\) +.*\n[ew] [0-9]+-+" nil 1)
+ ("[Ew] +[0-9]+ line \\([0-9]+\\) - " nil 1)
+
;; Lucid Compiler, lcc 3.x
;; E, file.cc(35,52) Illegal operation on pointers
("[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3)
\\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
;; Cray C compiler error messages
- ("\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5)
+ ("\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \
+\\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5)
;; IBM C/C++ Tools 2.01:
;; foo.c(2:0) : informational EDC0804: Function foo is not referenced.
;; Perl -w:
;; syntax error at automake line 922, near "':'"
- ("\n.* at \\([^ ]+\\) line \\([0-9]+\\)," 1 2)
+ (".* at \\([^ ]+\\) line \\([0-9]+\\)," 1 2)
)
"Alist that specifies how to match errors in compiler output.
Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...])
try; %s in the string is replaced by the text matching the FILE-IDX'th
subexpression.")
+(defvar compilation-enter-directory-regexp-alist
+ '(
+ ;; Matches lines printed by the `-w' option of GNU Make.
+ (".*: Entering directory `\\(.*\\)'$" 1)
+ )
+ "Alist specifying how to match lines that indicate a new current directory.
+Note that the match is done at the beginning of lines.
+Each elt has the form (REGEXP IDX).
+If REGEXP matches, the IDX'th subexpression gives the directory name.
+
+The default value matches lines printed by the `-w' option of GNU Make.")
+
+(defvar compilation-leave-directory-regexp-alist
+ '(
+ ;; Matches lines printed by the `-w' option of GNU Make.
+ (".*: Leaving directory `\\(.*\\)'$" 1)
+ )
+"Alist specifying how to match lines that indicate restoring current directory.
+Note that the match is done at the beginning of lines.
+Each elt has the form (REGEXP IDX).
+If REGEXP matches, the IDX'th subexpression gives the name of the directory
+being moved from. If IDX is nil, the last directory entered \(by a line
+matching `compilation-enter-directory-regexp-alist'\) is assumed.
+
+The default value matches lines printed by the `-w' option of GNU Make.")
+
+(defvar compilation-file-regexp-alist
+ '(
+ ;; This matches entries with date time year file-name: like
+ ;; Thu May 14 10:46:12 1992 mom3.p:
+ ("\\w\\w\\w \\w\\w\\w +[0-9]+ [0-9][0-9]:[0-9][0-9]:[0-9][0-9] [0-9][0-9][0-9][0-9] \\(.*\\):$" 1)
+ )
+ "Alist specifying how to match lines that indicate a new current file.
+Note that the match is done at the beginning of lines.
+Each elt has the form (REGEXP IDX).
+If REGEXP matches, the IDX'th subexpression gives the file name. This is
+used with compilers that don't indicate file name in every error message.")
+
+;; There is no generally useful regexp that will match non messages, but
+;; in special cases there might be one. The lines that are not matched by
+;; a regexp take much longer time than the ones that are recognized so if
+;; you have same regexeps here, parsing is faster.
+(defvar compilation-nomessage-regexp-alist
+ '(
+ )
+ "Alist specifying how to match lines that have no message.
+Note that the match is done at the beginning of lines.
+Each elt has the form (REGEXP). This alist is by default empty, but if
+you have some good regexps here, the parsing of messages will be faster.")
+
(defvar compilation-read-command t
"If not nil, M-x compile reads the compilation command to use.
Otherwise, M-x compile just uses the value of `compile-command'.")
Otherwise, it saves all modified buffers without asking.")
(defvar grep-regexp-alist
- '(("^\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
+ '(("\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
"Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
;; The system null device. (Should reference NULL_DEVICE from C.)
(concat \"make -k \"
buffer-file-name))))))")
-(defvar compilation-enter-directory-regexp
- ".*: Entering directory `\\(.*\\)'$"
- "Regular expression matching lines that indicate a new current directory.
-This must contain one \\(, \\) pair around the directory name.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
-(defvar compilation-leave-directory-regexp
- ".*: Leaving directory `\\(.*\\)'$"
- "Regular expression matching lines that indicate restoring current directory.
-This may contain one \\(, \\) pair around the name of the directory
-being moved from. If it does not, the last directory entered \(by a
-line matching `compilation-enter-directory-regexp'\) is assumed.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
(defvar compilation-directory-stack nil
"Stack of previous directories for `compilation-leave-directory-regexp'.
The head element is the directory the compilation was started in.")
compilation-error-regexp-alist)
(list
;;
- ;; Compiler output lines. Recognise `make[n]:' lines too.
+ ;; Compiler output lines. Recognize `make[n]:' lines too.
'("^\\([A-Za-z_0-9/\.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
(1 font-lock-function-name-face) (3 font-lock-comment-face nil t)))
))
(grep command-args)))
(defun compile-internal (command error-message
- &optional name-of-mode parser regexp-alist
- name-function)
+ &optional name-of-mode parser
+ error-regexp-alist name-function
+ enter-regexp-alist leave-regexp-alist
+ file-regexp-alist nomessage-regexp-alist)
"Run compilation command COMMAND (low level interface).
ERROR-MESSAGE is a string to print if the user asks to see another error
-and there are no more errors. Third argument NAME-OF-MODE is the name
-to display as the major mode in the compilation buffer.
-
-Fourth arg PARSER is the error parser function (nil means the default). Fifth
-arg REGEXP-ALIST is the error message regexp alist to use (nil means the
-default). Sixth arg NAME-FUNCTION is a function called to name the buffer (nil
-means the default). The defaults for these variables are the global values of
-\`compilation-parse-errors-function', `compilation-error-regexp-alist', and
-\`compilation-buffer-name-function', respectively.
+and there are no more errors. The rest of the arguments, 3-10 are optional.
+For them nil means use the default.
+NAME-OF-MODE is the name to display as the major mode in the compilation
+buffer. PARSER is the error parser function. ERROR-REGEXP-ALIST is the error
+message regexp alist to use. NAME-FUNCTION is a function called to name the
+buffer. ENTER-REGEXP-ALIST is the enter directory message regexp alist to use.
+LEAVE-REGEXP-ALIST is the leave directory message regexp alist to use.
+FILE-REGEXP-ALIST is the change current file message regexp alist to use.
+NOMESSAGE-REGEXP-ALIST is the nomessage regexp alist to use.
+ The defaults for these variables are the global values of
+\`compilation-parse-errors-function', `compilation-error-regexp-alist',
+\`compilation-buffer-name-function', `compilation-enter-directory-regexp-alist',
+\`compilation-leave-directory-regexp-alist', `compilation-file-regexp-alist',
+\ and `compilation-nomessage-regexp-alist', respectively.
+For arg 7-10 a value `t' means an empty alist.
Returns the compilation buffer created."
(let (outbuf)
;; In case the compilation buffer is current, make sure we get the global
;; values of compilation-error-regexp-alist, etc.
(kill-all-local-variables))
- (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist))
- (parser (or parser compilation-parse-errors-function))
- (thisdir default-directory)
+ (or error-regexp-alist
+ (setq error-regexp-alist compilation-error-regexp-alist))
+ (or enter-regexp-alist
+ (setq enter-regexp-alist compilation-enter-directory-regexp-alist))
+ (or leave-regexp-alist
+ (setq leave-regexp-alist compilation-leave-directory-regexp-alist))
+ (or file-regexp-alist
+ (setq file-regexp-alist compilation-file-regexp-alist))
+ (or nomessage-regexp-alist
+ (setq nomessage-regexp-alist compilation-nomessage-regexp-alist))
+ (or parser (setq parser compilation-parse-errors-function))
+ (let ((thisdir default-directory)
outwin)
(save-excursion
;; Clear out the compilation buffer and make it writable.
;; (setq buffer-read-only t) ;;; Non-ergonomic.
(set (make-local-variable 'compilation-parse-errors-function) parser)
(set (make-local-variable 'compilation-error-message) error-message)
- (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist)
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ error-regexp-alist)
+ (set (make-local-variable 'compilation-enter-directory-regexp-alist)
+ enter-regexp-alist)
+ (set (make-local-variable 'compilation-leave-directory-regexp-alist)
+ leave-regexp-alist)
+ (set (make-local-variable 'compilation-file-regexp-alist)
+ file-regexp-alist)
+ (set (make-local-variable 'compilation-nomessage-regexp-alist)
+ nomessage-regexp-alist)
(setq default-directory thisdir
compilation-directory-stack (list default-directory))
(set-window-start outwin (point-min))
map)
"Keymap for `compilation-minor-mode'.")
+(defvar compilation-shell-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'compile-mouse-goto-error)
+ (define-key map "\M-\C-m" 'compile-goto-error)
+ (define-key map "\M-\C-n" 'compilation-next-error)
+ (define-key map "\M-\C-p" 'compilation-previous-error)
+ (define-key map "\M-{" 'compilation-previous-file)
+ (define-key map "\M-}" 'compilation-next-file)
+ ;; Set up the menu-bar
+ (define-key map [menu-bar errors-menu]
+ (cons "Errors" (make-sparse-keymap "Errors")))
+ (define-key map [menu-bar errors-menu stop-subjob]
+ '("Stop" . comint-interrupt-subjob))
+ (define-key map [menu-bar errors-menu compilation-mode-separator2]
+ '("----" . nil))
+ (define-key map [menu-bar errors-menu compilation-mode-first-error]
+ '("First Error" . first-error))
+ (define-key map [menu-bar errors-menu compilation-mode-previous-error]
+ '("Previous Error" . previous-error))
+ (define-key map [menu-bar errors-menu compilation-mode-next-error]
+ '("Next Error" . next-error))
+ map)
+ "Keymap for `compilation-shell-minor-mode'.")
+
(defvar compilation-mode-map
(let ((map (cons 'keymap compilation-minor-mode-map)))
(define-key map " " 'scroll-up)
(set (make-local-variable 'compilation-directory-stack) nil)
(setq compilation-last-buffer (current-buffer)))
+(defvar compilation-shell-minor-mode nil
+ "Non-nil when in compilation-shell-minor-mode.
+In this minor mode, all the error-parsing commands of the
+Compilation major mode are available but bound to keys that don't
+collide with Shell mode.")
+(make-variable-buffer-local 'compilation-shell-minor-mode)
+
+(or (assq 'compilation-shell-minor-mode minor-mode-alist)
+ (setq minor-mode-alist
+ (cons '(compilation-shell-minor-mode " Shell-Compile")
+ minor-mode-alist)))
+(or (assq 'compilation-shell-minor-mode minor-mode-map-alist)
+ (setq minor-mode-map-alist (cons (cons 'compilation-shell-minor-mode
+ compilation-shell-minor-mode-map)
+ minor-mode-map-alist)))
+
(defvar compilation-minor-mode nil
"Non-nil when in compilation-minor-mode.
In this minor mode, all the error-parsing commands of the
(defsubst compilation-buffer-p (buffer)
(save-excursion
(set-buffer buffer)
- (or compilation-minor-mode (eq major-mode 'compilation-mode))))
+ (or compilation-shell-minor-mode compilation-minor-mode
+ (eq major-mode 'compilation-mode))))
(defun compilation-next-error (n)
"Move point to the next error in the compilation buffer.
(setq compilation-last-buffer (current-buffer))
;; `compile-reinitialize-errors' needs to see the complete filename
;; on the line where they clicked the mouse. Since it only looks
- ;; upto point, moving point to eol makes sure the filename is
+ ;; up to point, moving point to eol makes sure the filename is
;; visible to `compile-reinitialize-errors'.
(end-of-line)
(compile-reinitialize-errors nil (point))
;; Skip over multiple error messages for the same source location,
;; so the next C-x ` won't go to an error in the same place.
(while (and compilation-error-list
- (equal (cdr (car compilation-error-list)) (cdr next-error)))
+ (equal (cdr (car compilation-error-list))
+ (cdr next-error)))
(setq compilation-error-list (cdr compilation-error-list))))
;; We now have a marker for the position of the error source code.
)
+;; This function is not needed any more by compilation mode.
+;; Does anyone else need it or can it be deleted?
(defun count-regexp-groupings (regexp)
"Return the number of \\( ... \\) groupings in REGEXP (a string)."
(let ((groupings 0)
(setq groupings (1+ groupings))))))))
groupings))
+(defvar compilation-current-file nil
+ "Used by compilation-parse-errors to store filename for file being compiled")
+
+;; This variable is not used as a global variable. It's defined here just to
+;; shut up the byte compiler. It's bound and used by compilation-parse-errors
+;; and set by compile-collect-regexps.
+(defvar compilation-regexps nil)
+
(defun compilation-parse-errors (limit-search find-at-least)
- "Parse the current buffer as grep, cc or lint error messages.
+ "Parse the current buffer as grep, cc, lint or other error messages.
See variable `compilation-parse-errors-function' for the interface it uses."
(setq compilation-error-list nil)
(message "Parsing error messages...")
- (let (text-buffer orig orig-expanded parent-expanded
- regexp enter-group leave-group error-group
- alist subexpr error-regexp-groups
- (found-desired nil)
- (compilation-num-errors-found 0))
+ (if (null compilation-error-regexp-alist)
+ (error "compilation-error-regexp-alist is empty!"))
+ (let* ((compilation-regexps nil) ; Variable set by compile-collect-regexps.
+ (found-desired nil)
+ (compilation-num-errors-found 0)
+ ;; Set up now the expanded, abbreviated directory variables
+ ;; that compile-abbreviate-directory will need, so we can
+ ;; compute them just once here.
+ (orig (abbreviate-file-name default-directory))
+ (orig-expanded (abbreviate-file-name
+ (file-truename default-directory)))
+ (parent-expanded (abbreviate-file-name
+ (expand-file-name "../" orig-expanded))))
+
+ ;; Make a list of all the regexps. Each element has the form
+ ;; (REGEXP TYPE IDX1 IDX2 ...)
+ ;; where TYPE is one of leave, enter, file, error or nomessage.
+ (compile-collect-regexps 'leave compilation-leave-directory-regexp-alist)
+ (compile-collect-regexps 'enter compilation-enter-directory-regexp-alist)
+ (compile-collect-regexps 'file compilation-file-regexp-alist)
+ (compile-collect-regexps 'nomessage compilation-nomessage-regexp-alist)
+ (compile-collect-regexps 'error compilation-error-regexp-alist)
;; Don't reparse messages already seen at last parse.
(goto-char compilation-parsing-end)
- ;; Don't parse the first two lines as error messages.
- ;; This matters for grep.
(if (bobp)
(progn
- (forward-line 2)
- ;; Move back so point is before the newline.
- ;; This matters because some error regexps use \n instead of ^
- ;; to be faster.
- (forward-char -1)))
-
- ;; Compile all the regexps we want to search for into one.
- (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|"
- "\\(" compilation-leave-directory-regexp "\\)\\|"
- "\\(" (mapconcat (function
- (lambda (elt)
- (concat "\\(" (car elt) "\\)")))
- compilation-error-regexp-alist
- "\\|") "\\)"))
-
- ;; Find out how many \(...\) groupings are in each of the regexps, and set
- ;; *-GROUP to the grouping containing each constituent regexp (whose
- ;; subgroups will come immediately thereafter) of the big regexp we have
- ;; just constructed.
- (setq enter-group 1
- leave-group (+ enter-group
- (count-regexp-groupings
- compilation-enter-directory-regexp)
- 1)
- error-group (+ leave-group
- (count-regexp-groupings
- compilation-leave-directory-regexp)
- 1))
-
- ;; Compile an alist (IDX FILE LINE [COL]), where IDX is the number of
- ;; the subexpression for an entire error-regexp, and FILE and LINE (and
- ;; possibly COL) are the numbers for the subexpressions giving the file
- ;; name and line number (and possibly column number).
- (setq alist (or compilation-error-regexp-alist
- (error "compilation-error-regexp-alist is empty!"))
- subexpr (1+ error-group))
- (while alist
- (setq error-regexp-groups
- (cons (list subexpr
- (+ subexpr (nth 1 (car alist)))
- (+ subexpr (nth 2 (car alist)))
- (and (nth 3 (car alist))
- (+ subexpr (nth 3 (car alist)))))
- error-regexp-groups))
- (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
- (setq alist (cdr alist)))
-
- ;; Set up now the expanded, abbreviated directory variables
- ;; that compile-abbreviate-directory will need, so we can
- ;; compute them just once here.
- (setq orig (abbreviate-file-name default-directory)
- orig-expanded (abbreviate-file-name
- (file-truename default-directory))
- parent-expanded (abbreviate-file-name
- (expand-file-name "../" orig-expanded)))
-
- (while (and (not found-desired)
- ;; Instead of using re-search-forward,
- ;; we use this loop which tries only at each line.
- (progn
- (while (and (not (eobp))
- (not (looking-at regexp)))
- (forward-line 1))
- (not (eobp))))
-
- ;; Move to the end of the match we just found.
- (goto-char (match-end 0))
-
- ;; Figure out which constituent regexp matched.
- (cond ((match-beginning enter-group)
- ;; The match was the enter-directory regexp.
- (let ((dir
- (file-name-as-directory
- (expand-file-name
- (buffer-substring (match-beginning (+ enter-group 1))
- (match-end (+ enter-group 1)))))))
- ;; The directory name in the "entering" message
- ;; is a truename. Try to convert it to a form
- ;; like what the user typed in.
- (setq dir
- (compile-abbreviate-directory dir orig orig-expanded
- parent-expanded))
- (setq compilation-directory-stack
- (cons dir compilation-directory-stack))
- (and (file-directory-p dir)
- (setq default-directory dir)))
-
- (and limit-search (>= (point) limit-search)
- ;; The user wanted a specific error, and we're past it.
- ;; We do this check here (and in the leave-group case)
- ;; rather than at the end of the loop because if the last
- ;; thing seen is an error message, we must carefully
- ;; discard the last error when it is the first in a new
- ;; file (see below in the error-group case).
- (setq found-desired t)))
-
- ((match-beginning leave-group)
- ;; The match was the leave-directory regexp.
- (let ((beg (match-beginning (+ leave-group 1)))
- (stack compilation-directory-stack))
- (if beg
- (let ((dir
- (file-name-as-directory
- (expand-file-name
- (buffer-substring beg
- (match-end (+ leave-group
- 1)))))))
- ;; The directory name in the "leaving" message
- ;; is a truename. Try to convert it to a form
- ;; like what the user typed in.
- (setq dir
- (compile-abbreviate-directory dir orig orig-expanded
- parent-expanded))
- (while (and stack
- (not (string-equal (car stack) dir)))
- (setq stack (cdr stack)))))
- (setq compilation-directory-stack (cdr stack))
- (setq stack (car compilation-directory-stack))
- (if stack
- (setq default-directory stack))
- )
-
- (and limit-search (>= (point) limit-search)
- ;; The user wanted a specific error, and we're past it.
- ;; We do this check here (and in the enter-group case)
- ;; rather than at the end of the loop because if the last
- ;; thing seen is an error message, we must carefully
- ;; discard the last error when it is the first in a new
- ;; file (see below in the error-group case).
- (setq found-desired t)))
-
- ((match-beginning error-group)
- ;; The match was the composite error regexp.
- ;; Find out which individual regexp matched.
- (setq alist error-regexp-groups)
- (while (and alist
- (null (match-beginning (car (car alist)))))
- (setq alist (cdr alist)))
- (if alist
- (setq alist (car alist))
- (error "compilation-parse-errors: impossible regexp match!"))
-
- ;; Extract the file name and line number from the error message.
- (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes
- (filename (buffer-substring (match-beginning (nth 1 alist))
- (match-end (nth 1 alist))))
- (linenum (string-to-int
- (buffer-substring
- (match-beginning (nth 2 alist))
- (match-end (nth 2 alist)))))
- (column (and (nth 3 alist)
- (match-beginning (nth 3 alist))
- (string-to-int
- (buffer-substring
- (match-beginning (nth 3 alist))
- (match-end (nth 3 alist)))))))
-
- ;; Check for a comint-file-name-prefix and prepend it if
- ;; appropriate. (This is very useful for
- ;; compilation-minor-mode in an rlogin-mode buffer.)
- (and (boundp 'comint-file-name-prefix)
- ;; If the file name is relative, default-directory will
- ;; already contain the comint-file-name-prefix (done by
- ;; compile-abbreviate-directory).
- (file-name-absolute-p filename)
- (setq filename (concat comint-file-name-prefix filename)))
-
- ;; Some compilers (e.g. Sun's java compiler, reportedly)
- ;; produce bogus file names like "./bar//foo.c" for the file
- ;; "bar/foo.c"; expand-file-name will collapse these into
- ;; "/foo.c" and fail to find the appropriate file. So we look
- ;; for doubled slashes in the file name and fix them up in the
- ;; buffer.
- (setq filename (command-line-normalize-file-name filename))
- (setq filename (cons filename (cons default-directory
- (nthcdr 4 alist))))
-
-
- ;; Locate the erring file and line.
- ;; Cons a new elt onto compilation-error-list,
- ;; giving a marker for the current compilation buffer
- ;; location, and the file and line number of the error.
- (save-excursion
- ;; Save as the start of the error the beginning of the
- ;; line containing the match unless the match starts at a
- ;; newline, in which case the beginning of the next line.
- (goto-char beginning-of-match)
- (forward-line (if (eolp) 1 0))
- (let ((this (cons (point-marker)
- (list filename linenum column))))
- ;; Don't add the same source line more than once.
- (if (and compilation-skip-to-next-location
- (equal (cdr this)
- (cdr (car compilation-error-list))))
- nil
- (setq compilation-error-list
- (cons this
- compilation-error-list))
- (setq compilation-num-errors-found
- (1+ compilation-num-errors-found)))))
- (and (or (and find-at-least (> compilation-num-errors-found
+ (setq compilation-current-file nil) ; No current file at start.
+ ;; Don't parse the first two lines as error messages.
+ ;; This matters for grep.
+ (forward-line 2)))
+
+ ;; Parse messages.
+ (while (not (or found-desired (eobp)))
+ (let ((this compilation-regexps) (prev nil) (alist nil) type)
+ ;; Go through the regular expressions. If a match is found,
+ ;; variable alist is set to the corresponding alist and the
+ ;; matching regexp is moved to the front of compilation-regexps
+ ;; to make it match faster next time.
+ (while (and this (null alist))
+ (if (not (looking-at (car (car this))))
+ (progn (setq prev this) ; No match, go to next.
+ (setq this (cdr this)))
+ (setq alist (cdr (car this))) ; Got a match.
+;;; (if prev ; If not the first regexp,
+;;; (progn ; move it to the front.
+;;; (setcdr prev (cdr this))
+;;; (setcdr this compilation-regexps)
+;;; (setq compilation-regexps this)))
+ ))
+ (if (and alist ; Seen a match and not to
+ (not (eq (setq type (car alist)) 'nomessage))) ; be ignored.
+ (let* ((end-of-match (match-end 0))
+ (filename
+ (compile-buffer-substring (car (setq alist (cdr alist)))))
+ stack)
+ (if (eq type 'error) ; error message
+ (let* ((linenum (if (numberp (car (setq alist (cdr alist))))
+ (string-to-int
+ (compile-buffer-substring (car alist)))
+ ;; (car alist) is not a number, must be a
+ ;; function that is called below to return
+ ;; an error position descriptor.
+ (car alist)))
+ ;; Convert to integer later if linenum not a function.
+ (column (compile-buffer-substring
+ (car (setq alist (cdr alist)))))
+ this-error)
+
+ ;; Check that we have a file name.
+ (or filename
+ ;; No file name in message, we must have seen it before
+ (setq filename compilation-current-file)
+ (error "\
+An error message with no file name and no file name has been seen earlier."))
+
+ ;; Check for a comint-file-name-prefix and prepend it if
+ ;; appropriate. (This is very useful for
+ ;; compilation-minor-mode in an rlogin-mode buffer.)
+ (and (boundp 'comint-file-name-prefix)
+ ;; If file name is relative, default-directory will
+ ;; already contain the comint-file-name-prefix (done
+ ;; by compile-abbreviate-directory).
+ (file-name-absolute-p filename)
+ (setq filename
+ (concat comint-file-name-prefix filename)))
+
+ ;; Some compilers (e.g. Sun's java compiler, reportedly)
+ ;; produce bogus file names like "./bar//foo.c" for file
+ ;; "bar/foo.c"; expand-file-name will collapse these into
+ ;; "/foo.c" and fail to find the appropriate file. So we
+ ;; look for doubled slashes in the file name and fix them
+ ;; up in the buffer.
+ (setq filename (command-line-normalize-file-name filename))
+
+ (setq filename
+ (cons filename (cons default-directory (cdr alist))))
+
+ ;; Locate the erring file and line.
+ ;; Make this-error a new elt for compilation-error-list,
+ ;; giving a marker for the current compilation buffer
+ ;; location, and the file and line number of the error.
+ ;; Save, as the start of the error, the beginning of the
+ ;; line containing the match.
+ (if (setq this-error
+ (if (numberp linenum)
+ (list (point-marker) filename linenum
+ (and column (string-to-int column)))
+ ;; If linenum is not a number then it must be
+ ;; a function returning an error position
+ ;; descriptor or nil (meaning no position).
+ (save-excursion
+ (funcall linenum filename column))))
+
+ ;; We have an error position descriptor.
+ ;; If we have found as many new errors as the user
+ ;; wants, or if we are past the buffer position he
+ ;; indicated, then we continue to parse until we have
+ ;; seen all consecutive errors in the same file. This
+ ;; means that all the errors of a source file will be
+ ;; seen in one parsing run, so that the error positions
+ ;; will be recorded as markers in the source file
+ ;; buffer that will move when the buffer is changed.
+ (if (and (or (and find-at-least
+ (>= compilation-num-errors-found
find-at-least))
- (and limit-search (>= (point) limit-search)))
- ;; We have found as many new errors as the user wants,
- ;; or past the buffer position he indicated. We
- ;; continue to parse until we have seen all the
- ;; consecutive errors in the same file, so the error
- ;; positions will be recorded as markers in this buffer
- ;; that might change.
- (cdr compilation-error-list) ; Must check at least two.
- (not (equal (car (cdr (nth 0 compilation-error-list)))
- (car (cdr (nth 1 compilation-error-list)))))
- (progn
- ;; Discard the error just parsed, so that the next
- ;; parsing run can get it and the following errors in
- ;; the same file all at once. If we didn't do this, we
- ;; would have the same problem we are trying to avoid
- ;; with the test above, just delayed until the next run!
- (setq compilation-error-list
- (cdr compilation-error-list))
- (goto-char beginning-of-match)
- (setq found-desired t)))
- )
- )
- (t
- (error "compilation-parse-errors: known groups didn't match!")))
-
- (message "Parsing error messages...%d (%.0f%% of buffer)"
+ (and limit-search
+ (>= end-of-match limit-search)))
+ compilation-error-list ;At least one previous.
+ (not (equal ; Same filename?
+ (car (cdr (car compilation-error-list)))
+ (car (cdr this-error)))))
+ ;; We are past the limits and the last error
+ ;; parsed, didn't belong to the same source file
+ ;; as the earlier ones i.e. we have seen all the
+ ;; errors belonging to the earlier file. We don't
+ ;; add the error just parsed so that the next
+ ;; parsing run can get it and the following errors
+ ;; in the same file all at once.
+ (setq found-desired t)
+
+ (goto-char end-of-match) ; Prepare for next message.
+ ;; Don't add the same source line more than once.
+ (and (not (and
+ compilation-error-list
+ (equal (cdr (car compilation-error-list))
+ (cdr this-error))))
+ (setq compilation-error-list
+ (cons this-error compilation-error-list)
+ compilation-num-errors-found
+ (1+ compilation-num-errors-found))))))
+
+ ;; Not an error message.
+ (if (eq type `file) ; Change current file.
+ (and filename (setq compilation-current-file filename))
+ ;; Enter or leave directory.
+ (setq stack compilation-directory-stack)
+ (and filename
+ (file-directory-p
+ (setq filename
+ ;; The directory name in the message
+ ;; is a truename. Try to convert it to a form
+ ;; like what the user typed in.
+ (compile-abbreviate-directory
+ (file-name-as-directory
+ (expand-file-name filename))
+ orig orig-expanded parent-expanded)))
+ (if (eq type 'leave)
+ (while (and stack
+ (not (string-equal (car stack)
+ filename)))
+ (setq stack (cdr stack)))
+ (setq compilation-directory-stack
+ (cons filename compilation-directory-stack)
+ default-directory filename)))
+ (and (eq type 'leave
+ stack
+ (setq compilation-directory-stack (cdr stack))
+ (setq stack (car compilation-directory-stack))
+ (setq default-directory stack)))
+ (goto-char end-of-match) ; Prepare to look at next message.
+ (and limit-search (>= end-of-match limit-search)
+ ;; The user wanted a specific error, and we're past it.
+ ;; We do this check here rather than at the end of the
+ ;; loop because if the last thing seen is an error
+ ;; message, we must carefully discard the last error
+ ;; when it is the first in a new file (see above in
+ ;; the error-message case)
+ (setq found-desired t))))
+
+ ;; Go to before the last character in the message so that we will
+ ;; see the next line also when the message ended at end of line.
+ ;; When we ignore the last error message above, this will
+ ;; cancel the effect of forward-line below so that point
+ ;; doesn't move.
+ (forward-char -1)
+
+ ;; Is this message necessary any more? Parsing is now so fast
+ ;; that you might not need to know how it proceeds.
+ (message
+ "Parsing error messages...%d found. %.0f%% of buffer seen."
compilation-num-errors-found
;; Use floating-point because (* 100 (point)) frequently
;; exceeds the range of Emacs Lisp integers.
(/ (* 100.0 (point)) (point-max)))
-
- (and limit-search (>= (point) limit-search)
- ;; The user wanted a specific error, and we're past it.
- (setq found-desired t)))
- (setq compilation-parsing-end (if found-desired
- (point)
- ;; We have searched the whole buffer.
- (point-max))))
- (setq compilation-error-list (nreverse compilation-error-list))
- (message "Parsing error messages...done"))
+ ))
+
+ (forward-line 1))) ; End of while loop. Look at next line.
+
+ (setq compilation-parsing-end (point))
+ (setq compilation-error-list (nreverse compilation-error-list))
+;;; (message "Parsing error messages...done. %d found. %.0f%% of buffer seen."
+;;; compilation-num-errors-found
+;;; (/ (* 100.0 (point)) (point-max)))
+ (message "Parsing error messages...done.")))
+
+(defun compile-collect-regexps (type this)
+ ;; Add elements to variable compilation-regexps that is bound in
+ ;; compilation-parse-errors.
+ (and (not (eq this t))
+ (while this
+ (setq compilation-regexps
+ (cons (cons (car (car this)) (cons type (cdr (car this))))
+ compilation-regexps))
+ (setq this (cdr this)))))
+
+(defun compile-buffer-substring (index)
+ ;; Get substring matched by INDEXth subexpression.
+ (if index
+ (let ((beg (match-beginning index)))
+ (if beg (buffer-substring beg (match-end index))))))
;; If directory DIR is a subdir of ORIG or of ORIG's parent,
;; return a relative name for it starting from ORIG or its parent.
projects / emacs.git / commitdiff