Mercurial > emacs
diff lisp/progmodes/compile.el @ 17623:a09fd9348b0d
Support compilers that give a message each time the file being
compiled changes but don't include a file name each error message.
Speed up by searching for regexps one by one instead of combining.
(compile-internal): Takes more optional arguments. All five regexp
alists can be given as argument.
Change name of variable regexp-alist to error-regexp-alist. Change
some local variables directly by setq instead of rebinding by let.
(compilation-shell-minor-mode): New minor mode.
Similar to compilation-minor-mode, but key bindings don't
collide with shell mode.
(compilation-shell-minor-mode-map, compilation-shell-minor-mode):
New variables.
(compile-auto-highlight): Doc fix.
(compilation-error-regexp-alist): Removed unnecessary line break
in first regexp. Replaced \\(\\|.* on \\) by \\(.* on \\)? in
regexp for Absoft FORTRAN 77 Compiler 3.1.3. Added regexp for
SPARCcompiler Pascal. Divided long line in regexp for Cray C
compiler error messages. Made comment fit in line at regexp for
Sun Ada (VADS, Solaris). FILE-IDX may be nil, meaning an
error message with no file name, so the file name must be taken
from an earlier message. LINE-IDX may be a function which is
called with two arguments the file name and column strings and
returns an error position descriptor.
(compilation-enter-directory-regexp-alist)
(compilation-leave-directory-regexp-alist): New variables.
(compilation-file-regexp-alist)
(compilation-nomessage-regexp-alist): New variables.
(grep-regexp-alist): Removed unnecessary ^ at beginning of regexp.
(compilation-enter-directory-regexp)
(compilation-leave-directory-regexp): Variables deleted.
Replaced by compilation-enter-directory-regexp-alist and
compilation-leave-directory-regexp-alist.
(compilation-buffer-p): Return true also for buffer in
compilation-shell-minor-mode.
(compilation-next-error-locus): Split a long line.
(count-regexp-groupings): Comment about this function not being
needed any more.
(compilation-current-file, compilation-regexps); New variables.
(compilation-parse-errors): Large parts rewritten. Don't put the
regexps together in one large regexp, instead match them one by one.
Support the generalized subexpression indices.
(compile-collect-regexps, compile-buffer-substring): New functions
supporting compilation-parse-errors.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Sat, 03 May 1997 04:37:52 +0000 |
| parents | 52780f61eb76 |
| children | 5339baa0a334 |
line wrap: on
line diff
--- a/lisp/progmodes/compile.el Fri May 02 07:27:07 1997 +0000 +++ b/lisp/progmodes/compile.el Sat May 03 04:37:52 1997 +0000 @@ -40,7 +40,7 @@ (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. @@ -140,8 +140,7 @@ ;; 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++: @@ -184,7 +183,7 @@ ;; 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: @@ -214,6 +213,16 @@ ;; 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) @@ -223,7 +232,8 @@ \\([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. @@ -237,7 +247,7 @@ ;; 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...]) @@ -248,6 +258,56 @@ 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'.") @@ -257,7 +317,7 @@ 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.) @@ -329,22 +389,6 @@ (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.") @@ -373,7 +417,7 @@ 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))) )) @@ -464,19 +508,27 @@ (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) @@ -508,9 +560,18 @@ ;; 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. @@ -536,7 +597,16 @@ ;; (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)) @@ -612,6 +682,30 @@ 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) @@ -670,6 +764,22 @@ (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 @@ -787,7 +897,8 @@ (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. @@ -979,7 +1090,7 @@ (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)) @@ -1262,7 +1373,8 @@ ;; 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. @@ -1361,6 +1473,8 @@ ) +;; 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) @@ -1386,265 +1500,250 @@ (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))) + (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))) - ;; 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)) + ;; 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) - ;; 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))) + ;; 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.")) - (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))) + ;; 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)))) - ((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))))))) + ;; 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 + (>= 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) - ;; 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)))) - + (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)))))) - ;; 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 - 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!"))) + ;; 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)))) - (message "Parsing error messages...%d (%.0f%% of buffer)" + ;; 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.