Mercurial > emacs
diff lisp/progmodes/compile.el @ 54361:63ef4a00326a
(compile-auto-highlight)
(compilation-error-list, compilation-old-error-list)
(compilation-parse-errors-function, compilation-parsing-end)
(compilation-error-message, compilation-directory-stack)
(compilation-enter-directory-regexp-alist)
(compilation-leave-directory-regexp-alist)
(compilation-file-regexp-alist, compilation-nomessage-regexp-alist)
(compilation-current-file, compilation-regexps): Remove vars.
(compile-error-at-point, compilation-error-filedata)
(compilation-error-filedata-file-name, compile-reinitialize-errors)
(compilation-next-error-locus, compilation-forget-errors)
(count-regexp-groupings, compilation-parse-errors)
(compile-collect-regexps, compile-buffer-substring): Remove funs.
(compile-internal): Make obsolete.
(compilation-first-column, compilation-error)
(compilation-directory-matcher, compilation-page-delimiter)
(compilation-mode-font-lock-keywords, compilation-debug)
(compilation-error-face, compilation-warning-face)
(compilation-info-face, compilation-line-face)
(compilation-column-face, compilation-enter-directory-face)
(compilation-leave-directory-face, compilation-skip-threshold)
(compilation-skip-visited, compilation-context-lines): New vars.
(compilation-warning-face, compilation-info-face)
(compilation-message-face): New faces.
(compilation-error-regexp-alist-alist): New constant.
(compilation-face, compilation-directory-properties)
(compilation-assq, compilation-error-properties, compilation-start)
(define-compilation-mode, compilation-loop)
(compilation-set-window): New functions.
(compile): Additional argument for interactive compiles like TeX.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Thu, 11 Mar 2004 22:39:29 +0000 |
| parents | 227623e374e8 |
| children | 95647cc2d932 |
line wrap: on
line diff
--- a/lisp/progmodes/compile.el Thu Mar 11 21:10:21 2004 +0000 +++ b/lisp/progmodes/compile.el Thu Mar 11 22:39:29 2004 +0000 @@ -1,9 +1,10 @@ ;;; compile.el --- run compiler as inferior of Emacs, parse error messages -;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 2003 +;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 03, 2004 ;; Free Software Foundation, Inc. -;; Author: Roland McGrath <roland@gnu.org> +;; Authors: Roland McGrath <roland@gnu.org>, +;; Daniel Pfeiffer <occitan@esperanto.org> ;; Maintainer: FSF ;; Keywords: tools, processes @@ -26,11 +27,51 @@ ;;; Commentary: -;; This package provides the compile and grep facilities documented in -;; the Emacs user's manual. +;; This package provides the compile facilities documented in the Emacs user's +;; manual. ;;; Code: +;; This is the parsing engine for compile: +(require 'font-lock) ; needed to get font-lock-value-in-major-mode + +;;; This mode uses some complex data-structures: + +;;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE) + +;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe +;; LINE will be nil for a message that doesn't contain them. Then the +;; location refers to a indented beginning of line or beginning of file. +;; Once any location in some file has been jumped to, the list is extended to +;; (COLUMN LINE FILE-STRUCTURE MARKER . VISITED) for all LOCs pertaining to +;; that file. +;; MARKER initially points to LINE and COLUMN in a buffer visiting that file. +;; Being a marker it sticks to some text, when the buffer grows or shrinks +;; before that point. VISITED is t if we have jumped there, else nil. + +;;; FILE-STRUCTURE is a list of ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...) +;;; ...) + +;; FILENAME is a string parsed from an error message. DIRECTORY is a string +;; obtained by following directory change messages. DIRECTORY will be nil for +;; an absolute filename. FORMATS is a list of formats to apply to FILENAME if +;; a file of that name can't be found. +;; The rest of the list is an alist of elements with LINE as key. The keys +;; are either nil or line numbers. If present, nil comes first, followed by +;; the numbers in decreasing order. The LOCs for each line are again an alist +;; ordered the same way. Note that the whole file structure is referenced in +;; every LOC. + +;;; MESSAGE is a list of (LOC TYPE END-LOC) + +;; TYPE is 0 for info or 1 for warning if the message matcher identified it as +;; such, 2 otherwise (for a real error). END-LOC is a LOC pointing to the +;; other end, if the parsed message contained a range. If the end of the +;; range didn't specify a COLUMN, it defaults to -1, meaning end of line. +;; These are the value of the `message' text-properties in the compilation +;; buffer. + + (defgroup compilation nil "Run compiler as inferior of Emacs, parse error messages." :group 'tools @@ -50,50 +91,8 @@ integer) :group 'compilation) -(defcustom compile-auto-highlight nil - "*Specify how many compiler errors to highlight (and parse) initially. -\(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. -If nil, don't highlight or parse any of the buffer until you try to -move to the error messages. - -Those messages which are not parsed and highlighted initially -will be parsed and highlighted as soon as you try to move to them." - :type '(choice (const :tag "All" t) - (const :tag "None" nil) - (integer :tag "First N lines")) - :group 'compilation) - -(defvar compilation-error-list nil - "List of error message descriptors for visiting erring functions. -Each error descriptor is a cons (or nil). Its car is a marker pointing to -an error message. If its cdr is a marker, it points to the text of the -line the message is about. If its cdr is a cons, it is a list -\(\(DIRECTORY . FILE\) LINE [COLUMN]\). Or its cdr may be nil if that -error is not interesting. - -The value may be t instead of a list; this means that the buffer of -error messages should be reparsed the next time the list of errors is wanted. - -Some other commands (like `diff') use this list to control the error -message tracking facilities; if you change its structure, you should make -sure you also change those packages. Perhaps it is better not to change -it at all.") - -(defvar compilation-old-error-list nil - "Value of `compilation-error-list' after errors were parsed.") - -(defvar compilation-parse-errors-function 'compilation-parse-errors - "Function to call to parse error messages from a compilation. -It takes args LIMIT-SEARCH and FIND-AT-LEAST. -If LIMIT-SEARCH is non-nil, don't bother parsing past that location. -If FIND-AT-LEAST is non-nil, don't bother parsing after finding that -many new errors. -It should read in the source files which have errors and set -`compilation-error-list' to a list with an element for each error message -found. See that variable for more info.") +(defvar compilation-first-column 1 + "*This is how compilers number the first column, usually 1 or 0.") (defvar compilation-parse-errors-filename-function nil "Function to call to post-process filenames while parsing error messages. @@ -107,7 +106,7 @@ started. It can be used to set any variables or functions that are used while processing the output of the compilation process. The function is called with variables `compilation-buffer' and `compilation-window' -bound to the compilation buffer and window, respectively.") +bound to the compilation buffer and window, respectively.") ;;;###autoload (defvar compilation-buffer-name-function nil @@ -139,309 +138,234 @@ (setq minor-mode-alist (cons '(compilation-in-progress " Compiling") minor-mode-alist))) -(defvar compilation-parsing-end nil - "Marker position of end of buffer when last error messages were parsed.") - -(defvar compilation-error-message "No more errors" - "Message to print when no more matches are found.") +(defvar compilation-error "error" + "Stem of message to print when no matches are found.") (defvar compilation-arguments nil - "Arguments that were given to `compile-internal'.") + "Arguments that were given to `compilation-start'.") (defvar compilation-num-errors-found) -(defvar compilation-error-regexp-alist - '( - ;; NOTE! See also grep-regexp-alist, below. +(defconst compilation-error-regexp-alist-alist + '((absoft + "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ +of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) + + (ada + "\\(warning: .*\\)? at \\([^ \n]+\\):\\([0-9]+\\)$" 2 3 nil (1)) + + (aix + " in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1) - ;; 4.3BSD grep, cc, lint pass 1: - ;; /usr/src/foo/foo.c(8): warning: w may be used before set - ;; or GNU utilities: - ;; foo.c:8: error message - ;; or HP-UX 7.0 fc: - ;; foo.f :16 some horrible error message - ;; or GNU utilities with column (GNAT 1.82): - ;; foo.adb:2:1: Unit name does not match file name - ;; or with column and program name: - ;; jade:dbcommon.dsl:133:17:E: missing argument for function call - ;; - ;; 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. + (ant + "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):[0-9]+:[0-9]+:\\)?\ +\\( warning\\)?" 1 2 3 (4)) - ;; We insist on a non-digit in the file name - ;; so that we don't mistake the file name for a command name - ;; and take the line number as the file name. - ("\\([a-zA-Z][-a-zA-Z._0-9]+: ?\\)?\ -\\([a-zA-Z]?:?[^:( \t\n]*[^:( \t\n0-9][^:( \t\n]*\\)[:(][ \t]*\\([0-9]+\\)\ -\\([) \t]\\|:\\(\\([0-9]+:\\)\\|[0-9]*[^:0-9]\\)\\)" 2 3 6) + (bash + "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2) + + (borland + "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\ +\\([a-zA-Z]?:?[^:( \t\n]+\\)\ + \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1)) - ;; GNU utilities with precise locations (line and columns), - ;; possibly ranges: - ;; foo.c:8.23-9.1: error message - ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ -\\([0-9]+\\)\\.\\([0-9]+\\)\ --\\([0-9]+\\)\\.\\([0-9]+\\)\ -:" 1 2 3) ;; When ending points are supported, add line = 4 and col = 5. - ;; foo.c:8.23-45: error message - ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ -\\([0-9]+\\)\\.\\([0-9]+\\)\ --\\([0-9]+\\)\ -:" 1 2 3) ;; When ending points are supported, add line = 2 and col = 4. - ;; foo.c:8-45.3: error message - ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ -\\([0-9]+\\)\ --\\([0-9]+\\)\\.\\([0-9]+\\)\ -:" 1 2 nil) ;; When ending points are supported, add line = 2 and col = 4. - ;; foo.c:8.23: error message - ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ -\\([0-9]+\\)\\.\\([0-9]+\\)\ -:" 1 2 3) - ;; foo.c:8-23: error message - ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ -\\([0-9]+\\)\ --\\([0-9]+\\)\ -:" 1 2 nil);; When ending points are supported, add line = 3. + (caml + "^ *File \"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)-?\\([0-9]+\\)?,\ +\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?" + 1 (2 . 3) (4 . 5) (6)) + + (comma + "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\ +\\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4)) + + (epc + "^Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1) - ;; Microsoft C/C++: - ;; keyboard.c(537) : warning C4005: 'min' : macro redefinition - ;; d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if' - ;; This used to be less selective and allow characters other than - ;; parens around the line number, but that caused confusion for - ;; GNU-style error messages. - ;; This used to reject spaces and dashes in file names, - ;; but they are valid now; so I made it more strict about the error - ;; message that follows. - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ -: \\(error\\|warning\\) C[0-9]+:" 1 3) + (iar + "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" + 1 2 nil (3)) - ;; Borland C++, C++Builder: - ;; Error ping.c 15: Unable to open include file 'sys/types.h' - ;; Warning ping.c 68: Call to function 'func' with no prototype - ;; Error E2010 ping.c 15: Unable to open include file 'sys/types.h' - ;; Warning W1022 ping.c 68: Call to function 'func' with no prototype - ("\\(Error\\|Warning\\) \\(\\([FEW][0-9]+\\) \\)?\ -\\([a-zA-Z]?:?[^:( \t\n]+\\)\ - \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 4 5) + (ibm + "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\ + \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5)) - ;; Valgrind (memory debugger for x86 GNU/Linux): - ;; ==1332== at 0x8008621: main (vtest.c:180) - ;; Currently this regexp only matches the first error. - ;; Thanks to Hans Petter Jansson <hpj@ximian.com> for his regexp wisdom. - ("^==[0-9]+==[^(]+\(([^:]+):([0-9]+)" 1 2) - - ;; 4.3BSD lint pass 2 - ;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8) - (".*[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$" - 1 2) - - ;; 4.3BSD lint pass 3 - ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used - ;; This used to be - ;; ("[ \t(]+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2) - ;; which is regexp Impressionism - it matches almost anything! - (".*([ \t]*\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2) + (irix + "^[a-z0-9/]+: \\(?:[eE]rror\\|[wW]arnin\\(g\\)\\)[0-9 ]*:\ + \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 2 3 nil (1)) - ;; MIPS lint pass<n>; looks good for SunPro lint also - ;; TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomon.c due to truncation - ("[^\n ]+ (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1) - ;; name defined but never used: LinInt in cmap_calc.c(199) - (".*in \\([^(\n]+\\)(\\([0-9]+\\))$" 1 2) + (java + "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1)) - ;; Ultrix 3.0 f77: - ;; fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol - ;; Some SGI cc version: - ;; cfe: Warning 835: foo.c, line 2: something - ("\\(cfe\\|fort\\): [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3) - ;; Error on line 3 of t.f: Execution error unclassifiable statement - ;; Unknown who does this: - ;; Line 45 of "foo.c": bloofle undefined - ;; 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]+\ -of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2) + (jikes-file + "^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0) + (jikes-line + "^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)" + nil 1 nil 2 0 + (2 (compilation-face '(3)))) - ;; Apollo cc, 4.3BSD fc: - ;; "foo.f", line 3: Error: syntax error near end of statement - ;; IBM RS6000: - ;; "vvouch.c", line 19.5: 1506-046 (S) Syntax error. - ;; Microtec mcc68k: - ;; "foo.c", line 32 pos 1; (E) syntax error; unexpected symbol: "lossage" - ;; GNAT (as of July 94): - ;; "foo.adb", line 2(11): warning: file name does not match ... - ;; IBM AIX xlc compiler: - ;; "src/swapping.c", line 30.34: 1506-342 (W) "/*" detected in comment. - (".*\"\\([^,\" \n\t]+\\)\", lines? \ -\\([0-9]+\\)\\([\(.]\\([0-9]+\\)\)?\\)?[:., (-]" 1 2 4) + (gcc-include + "^\\(?:In file included\\| \\) from \ +\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4)) - ;; Python: - ;; File "foobar.py", line 5, blah blah - ("^File \"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)," 1 2) - - ;; Caml compiler: - ;; File "foobar.ml", lines 5-8, characters 20-155: blah blah - ("^File \"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[-0-9]*, characters? \\([0-9]+\\)" 1 2 3) - - ;; MIPS RISC CC - the one distributed with Ultrix: - ;; ccom: Error: foo.c, line 2: syntax error - ;; DEC AXP OSF/1 cc - ;; /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah - ("[a-z0-9/]+: \\([eE]rror\\|[wW]arning\\): \\([^,\" \n\t]+\\)[,:] \\(line \\)?\\([0-9]+\\):" 2 4) + (gnu + "^\\(?:[a-zA-Z][-a-zA-Z0-9.]+: ?\\)?\ +\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\): ?\ +\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ +\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\ +\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ + *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\)\\)?" + 1 (2 . 5) (4 . 6) (7 . 8)) - ;; IBM AIX PS/2 C version 1.1: - ;; ****** Error number 140 in line 8 of file errors.c ****** - (".*in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1) - ;; 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) - - ;; This seems to be superfluous because the first pattern matches it. - ;; ;; GNU messages with program name and optional column number. - ;; ("[a-zA-Z]?:?[^0-9 \n\t:]+[^ \n\t:]*:[ \t]*\\([^ \n\t:]+\\):\ - ;;\\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4) + (lcc + "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" + 2 3 4 (1)) - ;; Cray C compiler error messages - ("\\(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. - ;; foo.c(3:8) : warning EDC0833: Implicit return statement encountered. - ;; foo.c(5:5) : error EDC0350: Syntax error. - ("\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) : " 1 2 3) + (makepp + "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile \\)\\|.*?\\)\ +`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'\\)" + 4 5 nil (1 . 2) 3 + ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'" nil nil + (2 compilation-info-face) + (3 compilation-line-face nil t) + (1 (compilation-error-properties 2 3 nil nil nil 2 nil) + append))) - ;; IAR Systems C Compiler: - ;; "foo.c",3 Error[32]: Error message - ;; "foo.c",3 Warning[32]: Error message - ("\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(Error\\|Warning\\)\\[[0-9]+\\]:" 1 2) - - ;; Sun ada (VADS, Solaris): - ;; /home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: "," inserted - ("\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3) + (mips-1 + " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1) + (mips-2 + " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2) - ;; Perl -w: - ;; syntax error at automake line 922, near "':'" - ;; Perl debugging traces - ;; store::odrecall('File_A', 'x2') called at store.pm line 90 - (".* at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 1 2) + (msft + "^\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ +: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3)) - ;; Oracle pro*c: - ;; Semantic error at line 528, column 5, file erosacqdb.pc: - ("Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):" + (oracle + "^Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):$" 3 1 2) - ;; EPC F90 compiler: - ;; Error 24 at (2:progran.f90) : syntax error - ("Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1) + (perl + " at \\([^ \n]+\\) line \\([0-9]+\\)\\(?:[,.]\\|$\\)" 1 2) + + (rxp + "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\ + \\([0-9]+\\) of file://\\(.+\\)" + 4 2 3 (1)) + + (sparc-pascal-file + "^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\ + [12][09][0-9][0-9] +\\(.*\\):$" + 1 nil nil 0) + (sparc-pascal-line + "^\\(\\(?:E\\|\\(w\\)\\) +[0-9]+\\) line \\([0-9]+\\) - " + nil 3 nil (2) nil (1 (compilation-face '(2)))) + (sparc-pascal-example + "^ +\\([0-9]+\\) +.*\n\\(\\(?:e\\|\\(w\\)\\) [0-9]+\\)-+" + nil 1 nil (3) nil (2 (compilation-face '(3)))) - ;; SGI IRIX MipsPro 7.3 compilers: - ;; cc-1070 cc: ERROR File = linkl.c, Line = 38 - (".*: ERROR File = \\(.+\\), Line = \\([0-9]+\\)" 1 2) - (".*: WARNING File = \\(.+\\), Line = \\([0-9]+\\)" 1 2) + (sun + ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[a-zA-Z0-9 ]+, \\)?\ +File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?" + 3 4 5 (1 . 2)) + + (sun-ada + "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3) + + (ultrix + "^\\(?:cfe\\|fort\\): \\(Warning\\)?[^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3 nil (1)) - ;; Sun F90 error messages: - ;; cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3 - (".* ERROR [a-zA-Z0-9 ]+, File = \\(.+\\), Line = \\([0-9]+\\), Column = \\([0-9]+\\)" - 1 2 3) + (4bsd + "\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\ +\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))) + "Alist of values for `compilation-error-regexp-alist'.") + +(defcustom compilation-error-regexp-alist + (mapcar 'car compilation-error-regexp-alist-alist) + "Alist that specifies how to match errors in compiler output. +Note that on Unix exerything is a valid filename, so these +matchers must make some common sense assumptions, which catch +normal cases. A shorter list will be lighter on resource usage. - ;; RXP - GPL XML validator at http://www.cogsci.ed.ac.uk/~richard/rxp.html: - ;; Error: Mismatched end tag: expected </geroup>, got </group> - ;; in unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml - ("Error:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)" - 3 1 2) - ;; Warning: Start tag for undeclared element geroup - ;; in unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml - ("Warning:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)" - 3 1 2) +Instead of an alist element, you can use a symbol, which is +looked up in `compilation-error-regexp-alist-alist'. You can see +the predefined symbols and their effects in the file +`etc/compilation.txt' (linked below if your are customizing this). + +Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK +HIGHLIGHT...]). If REGEXP matches, the FILE'th subexpression +gives the file name, and the LINE'th subexpression gives the line +number. The COLUMN'th subexpression gives the column number on +that line. - ;; See http://ant.apache.org/faq.html - ;; Ant Java: works for jikes - ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([0-9]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:" 1 2 3) +If FILE, LINE or COLUMN are nil or that index didn't match, that +information is not present on the matched line. In that case the +file name is assumed to be the same as the previous one in the +buffer, line number defaults to 1 and column defaults to +beginning of line's indentation. + +FILE can also have the form (FILE FORMAT...), where the FORMATs +\(e.g. \"%s.c\") will be applied in turn to the recognized file +name, until a file of that name is found. Or FILE can also be a +function to return the filename. - ;; Ant Java: works for javac - ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([0-9]+\\):" 1 2) +LINE can also be of the form (LINE . END-LINE) meaning a range +of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) +meaning a range of columns starting on LINE and ending on +END-LINE, if that matched. - ) +TYPE is 2 or nil for a real error or 1 for warning or 0 for info. +TYPE can also be of the form (WARNING . INFO). In that case this +will be equivalent to 1 if the WARNING'th subexpression matched +or else equivalent to 0 if the INFO'th subexpression matched. +See `compilation-error-face', `compilation-warning-face', +`compilation-info-face' and `compilation-skip-threshold'. - "Alist that specifies how to match errors in compiler output. -Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...]) -If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and -the LINE-IDX'th subexpression gives the line number. If COLUMN-IDX is -given, the COLUMN-IDX'th subexpression gives the column number on that line. -If any FILE-FORMAT is given, each is a format string to produce a file name to -try; %s in the string is replaced by the text matching the FILE-IDX'th -subexpression.") +What matched the HYPERLINK'th subexpression has `mouse-face' and +`compilation-message-face' applied. If this is nil, the text +matched by the whole REGEXP becomes the hyperlink. + +Additional HIGHLIGHTs as described under `font-lock-keywords' can +be added." + :type `(set :menu-tag "Pick" + ,@(mapcar (lambda (elt) + (list 'const (car elt))) + compilation-error-regexp-alist-alist)) + :link `(file-link :tag "example file" + ,(concat doc-directory "compilation.txt")) + :group 'compilation) (defvar compilation-directory nil "Directory to restore to when doing `recompile'.") -(defvar compilation-enter-directory-regexp-alist - '( - ;; Matches lines printed by the `-w' option of GNU Make. - (".*: Entering directory `\\(.*\\)'$" 1) - ;; Matches lines made by Emacs byte compiler. - ("^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-directory-matcher + '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1)) + "A list for tracking when directories are entered or left. +Nil means not to track directories, e.g. if all file names are absolute. The +first element is the REGEXP matching these messages. It can match any number +of variants, e.g. different languages. The remaining elements are all of the +form (DIR . LEAVE). If for any one of these the DIR'th subexpression +matches, that is a directory name. If LEAVE is nil or the corresponding +LEAVE'th subexpression doesn't match, this message is about going into another +directory. If it does match anything, this message is about going back to the +directory we were in before the last entering message. If you change this, +you may also want to change `compilation-page-delimiter'.") -(defvar compilation-leave-directory-regexp-alist - '( - ;; Matches lines printed by the `-w' option of GNU Make. - (".*: Leaving directory `\\(.*\\)'$" 1) - ;; Matches lines made by Emacs byte compiler. - ("^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-page-delimiter + "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory `.+'\n\\)+" + "Value of `page-delimiter' in Compilation mode.") -(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-mode-font-lock-keywords + '(;; configure output lines. + ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$" + (1 font-lock-variable-name-face) + (2 (compilation-face '(4 . 3)))) + ;; Command output lines. Recognize `make[n]:' lines too. + ("^\\([A-Za-z_0-9/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:" + (1 font-lock-function-name-face) (3 compilation-line-face nil t)) + (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1) + ("^Compilation finished" . compilation-info-face) + ("^Compilation exited abnormally" . compilation-error-face)) + "Additional things to highlight in Compilation mode. +This gets tacked on the end of the generated expressions.") (defvar compilation-highlight-regexp t "Regexp matching part of visited source lines to highlight temporarily. @@ -495,13 +419,19 @@ (file-exists-p \"Makefile\")) (set (make-local-variable 'compile-command) (concat \"make -k \" - (file-name-sans-extension buffer-file-name))))))" + (file-name-sans-extension buffer-file-name))))))" :type 'string :group 'compilation) -(defvar compilation-directory-stack nil - "Stack of previous directories for `compilation-leave-directory-regexp'. -The last element is the directory the compilation was started in.") +;; A weak per-compilation-buffer hash indexed by (FILENAME . DIRECTORY). Each +;; value is a FILE-STRUCTURE as described above, with the car eq to the hash +;; key. This holds the tree seen from root, for storing new nodes. +(defvar compilation-locs ()) + +(defvar compilation-debug nil + "*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'.") (defvar compilation-exit-message-function nil "\ If non-nil, called when a compilation process dies to return a status message. @@ -518,45 +448,268 @@ ;; History of compile commands. (defvar compile-history nil) +(defface compilation-warning-face + '((((type tty) (class color)) (:foreground "cyan" :weight bold)) + (((class color)) (:foreground "Orange" :weight bold)) + (t (:weight bold))) + "Face used to highlight compiler warnings." + :group 'font-lock-highlighting-faces) + +(defface compilation-info-face + '((((type tty) (class color)) (:foreground "green" :weight bold)) + (((class color) (background light)) (:foreground "Green3" :weight bold)) + (((class color) (background dark)) (:foreground "Green" :weight bold)) + (t (:weight bold))) + "Face used to highlight compiler warnings." + :group 'font-lock-highlighting-faces) + +(defvar compilation-message-face nil + "Face name to use for whole messages. +Faces `compilation-error-face', `compilation-warning-face', +`compilation-info-face', `compilation-line-face' and +`compilation-column-face' get prepended to this, when applicable.") + +(defvar compilation-error-face 'font-lock-warning-face + "Face name to use for file name in error messages.") + +(defvar compilation-warning-face 'compilation-warning-face + "Face name to use for file name in warning messages.") + +(defvar compilation-info-face 'compilation-info-face + "Face name to use for file name in informational messages.") + +(defvar compilation-line-face 'font-lock-variable-name-face + "Face name to use for line number in message.") + +(defvar compilation-column-face 'font-lock-type-face + "Face name to use for column number in message.") + +;; same faces as dired uses +(defvar compilation-enter-directory-face 'font-lock-function-name-face + "Face name to use for column number in message.") + +(defvar compilation-leave-directory-face 'font-lock-type-face + "Face name to use for column number in message.") + + + +(defun compilation-face (type) + (or (and (car type) (match-end (car type)) compilation-warning-face) + (and (cdr type) (match-end (cdr type)) compilation-info-face) + compilation-error-face)) + +(defun compilation-directory-properties (idx leave) + (if leave (setq leave (match-end leave))) + ;; find previous stack, and push onto it, or if `leave' pop it + (let ((dir (previous-single-property-change (point) 'directory))) + (setq dir (if dir (or (get-text-property (1- dir) 'directory) + (get-text-property dir 'directory)))) + `(face ,(if leave + compilation-leave-directory-face + compilation-enter-directory-face) + directory ,(if leave + (or (cdr dir) + '(nil)) ; nil only isn't a property-change + (cons (match-string-no-properties idx) dir)) + mouse-face highlight + help-echo "mouse-2: visit current directory"))) + +;; Data type `reverse-ordered-alist' retriever. This function retrieves the +;; KEY element from the ALIST, creating it in the right position if not already +;; present. ALIST structure is +;; '(ANCHOR (KEY1 ...) (KEY2 ...)... (KEYn ALIST ...)) +;; ANCHOR is ignored, but necessary so that elements can be inserted. KEY1 +;; may be nil. The other KEYs are ordered backwards so that growing line +;; numbers can be inserted in front and searching can abort after half the +;; list on average. +(defmacro compilation-assq (key alist) + `(let* ((l1 ,alist) + (l2 (cdr l1))) + (car (if (if (null ,key) + (if l2 (null (caar l2))) + (while (if l2 (if (caar l2) (< ,key (caar l2)) t)) + (setq l1 l2 + l2 (cdr l1))) + (if l2 (eq ,key (caar l2)))) + l2 + (setcdr l1 (cons (list ,key) l2)))))) + + +;; This function is the central driver, called when font-locking to gather +;; all information needed to later jump to corresponding source code. +;; Return a property list with all meta information on this error location. +(defun compilation-error-properties (file line end-line col end-col type fmt) + (unless (< (next-single-property-change (match-beginning 0) 'directory nil (point)) + (point)) + (if file + (if (functionp file) + (setq file (funcall file)) + (let (dir) + (setq file (match-string-no-properties file)) + (unless (file-name-absolute-p file) + (setq dir (previous-single-property-change (point) 'directory) + dir (if dir (or (get-text-property (1- dir) 'directory) + (get-text-property dir 'directory))))) + (setq file (cons file (car dir)) ; top of dir stack is current + file (or (gethash file compilation-locs) + (puthash file (list file fmt) compilation-locs))))) + ;; This message didn't mention one, get it from previous + (setq file (previous-single-property-change (point) 'message) + file (or (if file + (nth 2 (car (or (get-text-property (1- file) 'message) + (get-text-property file 'message))))) + ;; no previous either -- let font-lock continue + (gethash (setq file '("*unknown*")) compilation-locs) + (puthash file (list file fmt) compilation-locs)))) + ;; All of these fields are optional, get them only if we have an index, and + ;; it matched some part of the message. + (and line + (setq line (match-string-no-properties line)) + (setq line (string-to-number line))) + (and end-line + (setq end-line (match-string-no-properties end-line)) + (setq end-line (string-to-number end-line))) + (and col + (setq col (match-string-no-properties col)) + (setq col (- (string-to-number col) compilation-first-column))) + (if (and end-col (setq end-col (match-string-no-properties end-col))) + (setq end-col (- (string-to-number end-col) compilation-first-column)) + (if end-line (setq end-col -1))) + (if (consp type) ; not a preset 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))) + ;; Get any (first) already existing marker (if any has one, all have one). + ;; Do this first, as the next assq`s may create new nodes. + (let ((marker (nth 3 (car (cdar (cddr file))))) + (loc (compilation-assq line (cdr file))) + end-loc) + (if end-line + (setq end-loc (compilation-assq end-line (cdr file)) + end-loc (compilation-assq end-col end-loc)) + (if end-col ; use same line element + (setq end-loc (compilation-assq end-col loc)))) + (setq loc (compilation-assq col loc)) + ;; If they are new, make the loc(s) reference the file they point to. + (or (cdr loc) (setcdr loc (list line file))) + (if end-loc + (or (cdr end-loc) (setcdr end-loc (list (or end-line line) file)))) + ;; If we'd found a marker, ensure that the new locs also get markers + (when (and marker + (not (or (cddr loc) (cddr end-loc))) ; maybe new node w/o marker + (marker-buffer marker)) ; other marker still valid + (or line (setq line 1)) ; normalize no linenumber to line 1 + (catch 'marker ; find nearest loc, at least one exists + (dolist (x (cddr file)) + (if (> (or (car x) 1) line) + (setq marker x) + (if (eq (or (car x) 1) line) + (if (cdr (cddr x)) ; at least one other column + (throw 'marker (setq marker x)) + (if marker (throw 'marker t))) + (throw 'marker (or marker (setq marker x))))))) + (setq marker (if (eq (car (cddr marker)) col) + (nthcdr 3 marker) + (cddr marker)) + file compilation-error-screen-columns) + (save-excursion + (set-buffer (marker-buffer (cddr marker))) + (save-restriction + (widen) + (goto-char (marker-position (cddr marker))) + (beginning-of-line (- line (car (cadr marker)) -1)) + (if file ; original c.-error-screen-columns + (move-to-column (car loc)) + (forward-char (car loc))) + (setcdr (cdr loc) (point-marker)) + (when end-loc + (beginning-of-line (- end-line line -1)) + (if (< end-col 0) + (end-of-line) + (if file ; original c.-error-screen-columns + (move-to-column (car end-loc)) + (forward-char (car end-loc)))) + (setcdr (cdr end-loc) (point-marker)))))) + ;; Must start with face + `(face ,compilation-message-face + message (,loc ,type ,end-loc) + ,@(if compilation-debug + `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords) + ,@(match-data)))) + help-echo ,(if col + "mouse-2: visit this file, line and column" + (if line + "mouse-2: visit this file and line" + "mouse-2: visit this file")) + mouse-face highlight)))) + (defun compilation-mode-font-lock-keywords () "Return expressions to highlight in Compilation mode." (nconc - ;; + ;; make directory tracking + (if compilation-directory-matcher + `((,(car compilation-directory-matcher) + ,@(mapcar (lambda (elt) + `(,(car elt) + (compilation-directory-properties + ,(car elt) ,(cdr elt)) + t)) + (cdr compilation-directory-matcher))))) + ;; Compiler warning/error lines. - (mapcar (function - (lambda (item) - ;; Prepend "^", adjusting FILE-IDX and LINE-IDX accordingly. - (let ((file-idx (nth 1 item)) - (line-idx (nth 2 item)) - (col-idx (nth 3 item)) - keyword) - (when (numberp col-idx) - (setq keyword - (cons (list (1+ col-idx) 'font-lock-type-face nil t) - keyword))) - (when (numberp line-idx) - (setq keyword - (cons (list (1+ line-idx) 'font-lock-variable-name-face) - keyword))) - (when (numberp file-idx) - (setq keyword - (cons (list (1+ file-idx) 'font-lock-warning-face) - keyword))) - (cons (concat "^\\(" (nth 0 item) "\\)") keyword)))) + (mapcar (lambda (item) + (if (symbolp item) + (setq item (cdr (assq item + compilation-error-regexp-alist-alist)))) + (let ((file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item)) + (type (nth 4 item)) + end-line end-col fmt) + (if (consp file) (setq fmt (cdr file) file (car file))) + (if (consp line) (setq end-line (cdr line) line (car line))) + (if (consp col) (setq end-col (cdr col) col (car col))) + + `(,(nth 0 item) + + ,@(when (integerp file) + `((,file ,(if (consp type) + `(compilation-face ',type) + (aref [compilation-info-face + compilation-warning-face + compilation-error-face] + (or type 2)))))) + + ,@(when line + `((,line compilation-line-face nil t))) + ,@(when end-line + `((,end-line compilation-line-face nil t))) + + ,@(when col + `((,col compilation-column-face nil t))) + ,@(when end-col + `((,end-col compilation-column-face nil t))) + + ,@(nthcdr 6 item) + (,(or (nth 5 item) 0) + (compilation-error-properties ',file ,line ,end-line + ,col ,end-col ',(or type 2) + ',fmt) + append)))) ; for compilation-message-face compilation-error-regexp-alist) - (list - ;; - ;; 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))) - )) + + compilation-mode-font-lock-keywords)) + ;;;###autoload -(defun compile (command) +(defun compile (command &optional comint) "Compile the program including the current buffer. Default: run `make'. Runs COMMAND, a shell command, in a separate process asynchronously with output going to the buffer `*compilation*'. +If optional second arg COMINT is t the buffer will be in comint mode with +`compilation-shell-minor-mode'. + You can then use the command \\[next-error] to find the next error message and move to the source code that caused it. @@ -575,14 +728,14 @@ (interactive (if (or compilation-read-command current-prefix-arg) (list (read-from-minibuffer "Compile command: " - (eval compile-command) nil nil - '(compile-history . 1))) + (eval compile-command) nil nil + '(compile-history . 1))) (list (eval compile-command)))) (unless (equal command (eval compile-command)) (setq compile-command command)) (save-some-buffers (not compilation-ask-about-save) nil) (setq compilation-directory default-directory) - (compile-internal command "No more errors")) + (compilation-start command comint)) ;; run compile with the default command line (defun recompile () @@ -592,9 +745,8 @@ (interactive) (save-some-buffers (not compilation-ask-about-save) nil) (let ((default-directory (or compilation-directory default-directory))) - (apply 'compile-internal (or compilation-arguments - `(,(eval compile-command) - "No more errors"))))) + (apply 'compilation-start (or compilation-arguments + `(,(eval compile-command)))))) (defcustom compilation-scroll-output nil "*Non-nil to scroll the *compilation* buffer window as output appears. @@ -625,51 +777,59 @@ (t (concat "*" (downcase mode-name) "*")))) - +;; This is a rough emulation of the old hack, until the transition to new +;; compile is complete. (defun compile-internal (command error-message &optional name-of-mode parser error-regexp-alist name-function enter-regexp-alist leave-regexp-alist file-regexp-alist nomessage-regexp-alist no-async highlight-regexp local-map) + (if parser + (error "Compile now works very differently, see `compilation-error-regexp-alist'")) + (let ((compilation-error-regexp-alist + (append file-regexp-alist (or error-regexp-alist + compilation-error-regexp-alist))) + (compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?" + "\\1" error-message))) + (compilation-start command nil name-function highlight-regexp))) +(make-obsolete 'compile-internal 'compilation-start) + +(defun compilation-start (command &optional mode name-function highlight-regexp) "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. - The rest of the arguments 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. +MODE is the major mode to set in the compilation buffer. Mode +may also be `t' meaning `compilation-shell-minor-mode' under `comint-mode'. 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. - -If NO-ASYNC is non-nil, start the compilation process synchronously. If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight matching section of the visited source line; the default is to use the global value of `compilation-highlight-regexp'. -If LOCAL-MAP is non-nil, use the given keymap instead of `compilation-mode-map'. - Returns the compilation buffer created." - (unless no-async - (setq no-async (not (fboundp 'start-process)))) - (let (outbuf) + (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 (and (boundp 'system-uses-terminfo) + 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) (save-excursion - (or name-of-mode - (setq name-of-mode "Compilation")) (setq outbuf (get-buffer-create (compilation-buffer-name name-of-mode name-function))) @@ -687,137 +847,89 @@ (delete-process comp-proc)) (error nil)) (error "Cannot have two processes in `%s' at once" - (buffer-name)) - ))) - ;; In case the compilation buffer is current, make sure we get the global - ;; values of compilation-error-regexp-alist, etc. - (kill-all-local-variables)) - (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 highlight-regexp - (setq highlight-regexp compilation-highlight-regexp)) - (or parser (setq parser compilation-parse-errors-function)) - (let ((thisdir default-directory) - outwin) - (save-excursion - ;; 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. - (set-buffer outbuf) - (setq buffer-read-only nil) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (buffer-enable-undo (current-buffer)) - (setq default-directory thisdir) - (insert "cd " thisdir "\n" command "\n") - (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. - (if (eq outbuf (current-buffer)) + (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)) + (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") + (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. + (if (eq outbuf (current-buffer)) + (goto-char (point-max))) + ;; 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 (point))) + ;; 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) + (let ((status (call-process shell-file-name nil outbuf nil "-c" + command))) + (cond ((numberp status) + (compilation-handle-exit 'exit status + (if (zerop status) + "finished\n" + (format "\ +exited abnormally with code %d\n" + status)))) + ((stringp status) + (compilation-handle-exit 'signal status + (concat status "\n"))) + (t + (compilation-handle-exit 'bizarre status status)))) + (message "Executing `%s'...done" command))) + (if (buffer-local-value 'compilation-scroll-output outbuf) + (save-selected-window + (select-window outwin) (goto-char (point-max))) - ;; Pop up the compilation buffer. - (setq outwin (display-buffer outbuf nil t)) - (with-current-buffer outbuf - (compilation-mode name-of-mode) - (if local-map - (use-local-map local-map)) - ;; In what way is it non-ergonomic ? -stef - ;; (toggle-read-only 1) ;;; 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) - 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) - (set (make-local-variable 'compilation-highlight-regexp) - highlight-regexp) - (set (make-local-variable 'compilation-arguments) - (list command error-message - name-of-mode parser - error-regexp-alist name-function - enter-regexp-alist leave-regexp-alist - file-regexp-alist nomessage-regexp-alist - nil ; or no-async ?? - highlight-regexp local-map)) - ;; This proves a good idea if the buffer's going to scroll - ;; with lazy-lock on. - (set (make-local-variable 'lazy-lock-defer-on-scrolling) t) - (setq default-directory thisdir - compilation-directory-stack (list default-directory)) - (set-window-start outwin (point-min)) - (or (eq outwin (selected-window)) - (set-window-point outwin (point))) - ;; 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 (not no-async) - (let* ((process-environment - (append - compilation-environment - (if (and (boundp 'system-uses-terminfo) - 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. - (if (getenv "EMACS") - process-environment - (cons "EMACS=t" process-environment)))) - (proc (start-process-shell-command (downcase mode-name) - outbuf - command))) - (set-process-sentinel proc 'compilation-sentinel) - (set-process-filter proc 'compilation-filter) - (set-marker (process-mark proc) (point) outbuf) - (setq compilation-in-progress - (cons proc compilation-in-progress))) - ;; No asynchronous processes available. - (message "Executing `%s'..." command) - ;; Fake modeline display as if `start-process' were run. - (setq mode-line-process ":run") - (force-mode-line-update) - (sit-for 0) ; Force redisplay - (let ((status (call-process shell-file-name nil outbuf nil "-c" - command))) - (cond ((numberp status) - (compilation-handle-exit 'exit status - (if (zerop status) - "finished\n" - (format "\ -exited abnormally with code %d\n" - status)))) - ((stringp status) - (compilation-handle-exit 'signal status - (concat status "\n"))) - (t - (compilation-handle-exit 'bizarre status status)))) - (message "Executing `%s'...done" command))) - (if (buffer-local-value 'compilation-scroll-output outbuf) - (save-selected-window - (select-window outwin) - (goto-char (point-max))))) - ;; Make it so the next C-x ` will use this buffer. - (setq compilation-last-buffer outbuf))) + ;; Make it so the next C-x ` will use this buffer. + (setq compilation-last-buffer outbuf)))) (defun compilation-set-window-height (window) "Set the height of WINDOW according to `compilation-window-height'." @@ -902,7 +1014,7 @@ (put 'compilation-mode 'mode-class 'special) ;;;###autoload -(defun compilation-mode (&optional name-of-mode) +(defun compilation-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]. @@ -913,32 +1025,86 @@ (kill-all-local-variables) (use-local-map compilation-mode-map) (setq major-mode 'compilation-mode - mode-name (or name-of-mode "Compilation")) + mode-name "Compilation") + (set (make-local-variable 'page-delimiter) + compilation-page-delimiter) (compilation-setup) - (set (make-local-variable 'font-lock-defaults) - '(compilation-mode-font-lock-keywords t)) - (set (make-local-variable 'revert-buffer-function) - 'compilation-revert-buffer) - (run-hooks 'compilation-mode-hook)) + (run-mode-hooks 'compilation-mode-hook)) + +(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-...' +variables are also set from the name of the mode you have chosen, by replacing +the fist word, e.g `compilation-scroll-output' from `grep-scroll-output' if that +variable exists." + (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode)))) + `(define-derived-mode ,mode compilation-mode ,name + ,doc + ,@(mapcar (lambda (v) + (setq v (cons v + (intern-soft (replace-regexp-in-string + "^compilation" mode-name + (symbol-name v))))) + (and (cdr v) + (or (boundp (cdr v)) + (if (boundp 'byte-compile-bound-variables) + (memq (cdr v) byte-compile-bound-variables))) + `(set (make-local-variable ',(car v)) ,(cdr v)))) + '(compilation-buffer-name-function + compilation-directory-matcher + compilation-error + compilation-error-regexp-alist + compilation-error-regexp-alist-alist + compilation-error-screen-columns + compilation-finish-function + compilation-finish-functions + compilation-first-column + compilation-mode-font-lock-keywords + compilation-page-delimiter + compilation-parse-errors-filename-function + compilation-process-setup-function + compilation-scroll-output + compilation-search-path + compilation-skip-threshold + compilation-window-height)) + ,@body))) (defun compilation-revert-buffer (ignore-auto noconfirm) (if buffer-file-name (let (revert-buffer-function) (revert-buffer ignore-auto noconfirm)) (if (or noconfirm (yes-or-no-p (format "Restart compilation? "))) - (apply 'compile-internal compilation-arguments)))) + (apply 'compilation-start compilation-arguments)))) -(defun compilation-setup () +;; A function name can't be a hook, must be something with a value. +(defconst compilation-turn-on-font-lock 'turn-on-font-lock) + +(defun compilation-setup (&optional minor) "Prepare the buffer for the compilation parsing commands to work." - ;; Make the buffer's mode line show process state. - (setq mode-line-process '(":%s")) - (set (make-local-variable 'compilation-error-list) nil) - (set (make-local-variable 'compilation-old-error-list) nil) - (set (make-local-variable 'compilation-parsing-end) (copy-marker 1)) - (set (make-local-variable 'compilation-directory-stack) - (list default-directory)) (make-local-variable 'compilation-error-screen-columns) - (setq compilation-last-buffer (current-buffer))) + (setq compilation-last-buffer (current-buffer)) + (if minor + (if font-lock-defaults + (font-lock-add-keywords nil (compilation-mode-font-lock-keywords)) + (set (make-local-variable 'font-lock-defaults) + '(compilation-mode-font-lock-keywords t))) + (set (make-local-variable 'font-lock-defaults) + '(compilation-mode-font-lock-keywords t))) + (set (make-local-variable 'font-lock-extra-managed-props) + '(directory message help-echo mouse-face debug)) + (set (make-local-variable 'compilation-locs) + (make-hash-table :test 'equal :weakness 'value)) + ;; lazy-lock would never find the message unless it's scrolled to + ;; jit-lock might fontify some things too late + (if (font-lock-value-in-major-mode font-lock-support-mode) + (set (make-local-variable 'font-lock-support-mode) nil)) + (set (make-local-variable 'font-lock-maximum-size) nil) + (if minor + (if font-lock-mode + (font-lock-fontify-buffer) + (turn-on-font-lock)) + ;; maybe defer font-lock till after derived mode is set up + (run-mode-hooks 'compilation-turn-on-font-lock))) ;;;###autoload (define-minor-mode compilation-shell-minor-mode @@ -948,10 +1114,12 @@ Compilation major mode are available but bound to keys that don't collide with Shell mode. See `compilation-mode'. Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'." - nil " Shell-Compile" nil + nil " Shell-Compile" :group 'compilation - (let (mode-line-process) - (compilation-setup))) + (if compilation-shell-minor-mode + (compilation-setup t) + (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords)) + (font-lock-fontify-buffer))) ;;;###autoload (define-minor-mode compilation-minor-mode @@ -960,10 +1128,12 @@ In this minor mode, all the error-parsing commands of the Compilation major mode are available. See `compilation-mode'. Turning the mode on runs the normal hook `compilation-minor-mode-hook'." - nil " Compilation" nil + nil " Compilation" :group 'compilation - (let ((mode-line-process)) - (compilation-setup))) + (if compilation-minor-mode + (compilation-setup t) + (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords)) + (font-lock-fontify-buffer))) (defun compilation-handle-exit (process-status exit-status msg) "Write msg in the current buffer and hack its mode-line-process." @@ -979,8 +1149,8 @@ (goto-char omax) (insert ?\n mode-name " " (car status)) (if (and (numberp compilation-window-height) - (zerop compilation-window-height)) - (message "%s" (cdr status))) + (zerop compilation-window-height)) + (message "%s" (cdr status))) (if (bolp) (forward-char -1)) (insert " at " (substring (current-time-string) 0 19)) @@ -993,14 +1163,6 @@ (force-mode-line-update) (if (and opoint (< opoint omax)) (goto-char opoint)) - ;; Automatically parse (and mouse-highlight) error messages: - (cond ((eq compile-auto-highlight t) - (compile-reinitialize-errors nil (point-max))) - ((numberp compile-auto-highlight) - (compile-reinitialize-errors nil - (save-excursion - (goto-line compile-auto-highlight) - (point))))) (if compilation-finish-function (funcall compilation-finish-function (current-buffer) msg)) (let ((functions compilation-finish-functions)) @@ -1042,33 +1204,36 @@ (if (buffer-name (process-buffer proc)) (save-excursion (set-buffer (process-buffer proc)) - (let ((buffer-read-only nil) - (end (marker-position compilation-parsing-end))) + (let ((buffer-read-only nil)) (save-excursion (goto-char (process-mark proc)) (insert-before-markers string) - (set-marker compilation-parsing-end end) ;don't move it - (run-hooks 'compilation-filter-hook) - ;; this seems redundant since we insert-before-marks -stefan - ;;(set-marker (process-mark proc) (point)) - ))))) - -(defun compile-error-at-point () - "Return the cdr of `compilation-old-error-list' for error containing point." - (compile-reinitialize-errors nil (point)) - (let ((errors compilation-old-error-list)) - (while (and errors - (> (point) (car (car errors)))) - (setq errors (cdr errors))) - errors)) + (run-hooks 'compilation-filter-hook)))))) (defsubst compilation-buffer-p (buffer) - (save-excursion - (set-buffer buffer) - (or compilation-shell-minor-mode compilation-minor-mode - (eq major-mode 'compilation-mode)))) + (local-variable-p 'compilation-locs buffer)) -(defun compilation-next-error (n) +(defmacro compilation-loop (< property-change 1+ error) + `(while (,< n 0) + (or (setq pt (,property-change pt 'message)) + (error ,error compilation-error)) + ;; prop 'message usually has 2 changes, on and off, so re-search if off + (or (setq msg (get-text-property pt 'message)) + (if (setq pt (,property-change pt 'message)) + (setq msg (get-text-property pt 'message))) + (error ,error compilation-error)) + (or (< (cadr msg) compilation-skip-threshold) + (if different-file + (eq (prog1 last (setq last (nth 2 (car msg)))) + last)) + (if compilation-skip-visited + (nthcdr 4 (car msg))) + (if compilation-skip-to-next-location + (eq (car msg) loc)) + ;; count this message only if none of the above are true + (setq n (,1+ n))))) + +(defun compilation-next-error (n &optional different-file) "Move point to the next error in the compilation buffer. Prefix arg N says how many error messages to move forwards (or backwards, if negative). @@ -1077,42 +1242,43 @@ (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer")) (setq compilation-last-buffer (current-buffer)) - - (let ((errors (compile-error-at-point))) - - ;; Move to the error after the one containing point. - (goto-char (car (if (< n 0) - (let ((i 0) - (e compilation-old-error-list)) - ;; See how many cdrs away ERRORS is from the start. - (while (not (eq e errors)) - (setq i (1+ i) - e (cdr e))) - (if (> (- n) i) - (error "Moved back past first error") - (nth (+ i n) compilation-old-error-list))) - (save-excursion - (while (and (> n 0) errors) - ;; Discard the current error and any previous. - (while (and errors (>= (point) (car (car errors)))) - (setq errors (cdr errors))) - ;; Now (car errors) is the next error. - ;; If we want to move down more errors, - ;; put point at this one and start again. - (setq n (1- n)) - (if (and errors (> n 0)) - (goto-char (car (car errors)))))) - (let ((compilation-error-list errors)) - (compile-reinitialize-errors nil nil n) - (if compilation-error-list - (nth (1- n) compilation-error-list) - (error "Moved past last error")))))))) + (let* ((pt (point)) + (msg (get-text-property pt 'message)) + (loc (car msg)) + last) + (if (zerop n) + (unless (or msg ; find message near here + (setq msg (get-text-property (max (1- pt) 1) 'message))) + (setq pt (previous-single-property-change pt 'message nil + (save-excursion + (beginning-of-line) + (point)))) + (if pt + (setq msg (get-text-property (max (1- pt) 1) 'message)) + (setq pt (next-single-property-change pt 'message nil + (save-excursion + (end-of-line) + (point)))) + (if pt + (setq msg (get-text-property pt 'message)) + (setq pt (point))))) + (setq last (nth 2 (car msg))) + ;; These loops search only either forwards or backwards + (compilation-loop > next-single-property-change 1- + (if (get-buffer-process (current-buffer)) + "No more %ss yet" + "Moved past last %s")) + (compilation-loop < previous-single-property-change 1+ + "Moved back before first %s")) + (goto-char pt) + (or msg + (error "No %s here" compilation-error)))) (defun compilation-previous-error (n) "Move point to the previous error in the compilation buffer. Prefix arg N says how many error messages to move backwards (or forwards, if negative). -Does NOT find the source line like \\[next-error]." +Does NOT find the source line like \\[previous-error]." (interactive "p") (compilation-next-error (- n))) @@ -1128,84 +1294,15 @@ (defun previous-error-no-select (n) "Move point to the previous error in the compilation buffer and highlight match. Prefix arg N says how many error messages to move forwards. -Finds and highlights the source line like \\[next-error], but does not +Finds and highlights the source line like \\[previous-error], but does not select the source buffer." (interactive "p") - (next-error (- n)) - (pop-to-buffer compilation-last-buffer)) - -;; Given an elt of `compilation-error-list', return an object representing -;; the referenced file which is equal to (but not necessarily eq to) what -;; this function would return for another error in the same file. -(defsubst compilation-error-filedata (data) - (setq data (cdr data)) - (if (markerp data) - (marker-buffer data) - (car data))) - -;; Return a string describing a value from compilation-error-filedata. -;; This value is not necessarily useful as a file name, but should be -;; indicative to the user of what file's errors are being referred to. -(defsubst compilation-error-filedata-file-name (filedata) - (if (bufferp filedata) - (buffer-file-name filedata) - (car filedata))) + (next-error-no-select (- n))) (defun compilation-next-file (n) "Move point to the next error for a different file than the current one." (interactive "p") - (or (compilation-buffer-p (current-buffer)) - (error "Not in a compilation buffer")) - (setq compilation-last-buffer (current-buffer)) - - (let ((reversed (< n 0)) - errors filedata) - - (if (not reversed) - (setq errors (or (compile-error-at-point) - (error "Moved past last error"))) - - ;; Get a reversed list of the errors up through the one containing point. - (compile-reinitialize-errors nil (point)) - (setq errors (reverse compilation-old-error-list) - n (- n)) - - ;; Ignore errors after point. (car ERRORS) will be the error - ;; containing point, (cadr ERRORS) the one before it. - (while (and errors - (< (point) (car (car errors)))) - (setq errors (cdr errors)))) - - (while (> n 0) - (setq filedata (compilation-error-filedata (car errors))) - - ;; Skip past the following errors for this file. - (while (equal filedata - (compilation-error-filedata - (car (or errors - (if reversed - (error "%s the first erring file" - (compilation-error-filedata-file-name - filedata)) - (let ((compilation-error-list nil)) - ;; Parse some more. - (compile-reinitialize-errors nil nil 2) - (setq errors compilation-error-list))) - (error "%s is the last erring file" - (compilation-error-filedata-file-name - filedata)))))) - (setq errors (cdr errors))) - - (setq n (1- n))) - - ;; Move to the following error. - (goto-char (car (car (or errors - (if reversed - (error "This is the first erring file") - (let ((compilation-error-list nil)) - ;; Parse the last one. - (compile-reinitialize-errors nil nil 1) - compilation-error-list)))))))) + (compilation-next-error n t)) (defun compilation-previous-file (n) "Move point to the previous error for a different file than the current one." @@ -1220,154 +1317,24 @@ (interrupt-process (get-buffer-process buffer)) (error "The compilation process is not running")))) -(defalias 'kill-grep 'kill-compilation) +(defun compile-mouse-goto-error (event) + "Visit the source for the error message the mouse is pointing at." + (interactive "e") + (mouse-set-point event) + (if (get-text-property (point) 'directory) + (dired-other-window (car (get-text-property (point) 'directory))) + (next-error 0))) -;; Parse any new errors in the compilation buffer, -;; or reparse from the beginning if the user has asked for that. -(defun compile-reinitialize-errors (reparse - &optional limit-search find-at-least) - (save-excursion - (set-buffer compilation-last-buffer) - ;; If we are out of errors, or if user says "reparse", - ;; discard the info we have, to force reparsing. - (if (or (eq compilation-error-list t) - reparse) - (compilation-forget-errors)) - (if (and compilation-error-list - (or (not limit-search) - (> compilation-parsing-end limit-search)) - (or (not find-at-least) - (>= (length compilation-error-list) find-at-least))) - ;; Since compilation-error-list is non-nil, it points to a specific - ;; error the user wanted. So don't move it around. - nil - ;; This was here for a long time (before my rewrite); why? --roland - ;;(switch-to-buffer compilation-last-buffer) - (set-buffer-modified-p nil) - (if (< compilation-parsing-end (point-max)) - ;; compilation-error-list might be non-nil if we have a non-nil - ;; LIMIT-SEARCH or FIND-AT-LEAST arg. In that case its value - ;; records the current position in the error list, and we must - ;; preserve that after reparsing. - (let ((error-list-pos compilation-error-list)) - (funcall compilation-parse-errors-function - limit-search - (and find-at-least - ;; We only need enough new parsed errors to reach - ;; FIND-AT-LEAST errors past the current - ;; position. - (- find-at-least (length compilation-error-list)))) - ;; Remember the entire list for compilation-forget-errors. If - ;; this is an incremental parse, append to previous list. If - ;; we are parsing anew, compilation-forget-errors cleared - ;; compilation-old-error-list above. - (setq compilation-old-error-list - (nconc compilation-old-error-list compilation-error-list)) - (if error-list-pos - ;; We started in the middle of an existing list of parsed - ;; errors before parsing more; restore that position. - (setq compilation-error-list error-list-pos)) - ;; Mouse-Highlight (the first line of) each error message when the - ;; mouse pointer moves over it: - (let ((inhibit-read-only t) - (buffer-undo-list t) - deactivate-mark - (buffer-was-modified (buffer-modified-p)) - (error-list compilation-error-list)) - (while error-list - (save-excursion - (add-text-properties (goto-char (car (car error-list))) - (progn (end-of-line) (point)) - '(mouse-face highlight help-echo "\ -mouse-2: visit this file and line"))) - (setq error-list (cdr error-list))) - (set-buffer-modified-p buffer-was-modified)) - ))))) - -(defun compile-mouse-goto-error (event) - "Visit the source for the error message the mouse is pointing at. -This is like `compile-goto-error' called without prefix arg -at the end of the line." - (interactive "e") - (save-excursion - (set-buffer (window-buffer (posn-window (event-end event)))) - (goto-char (posn-point (event-end event))) - - (or (compilation-buffer-p (current-buffer)) - (error "Not in a 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 - ;; 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)) - - ;; Move to bol; the marker for the error on this line will point there. - (beginning-of-line) - - ;; Move compilation-error-list to the elt of compilation-old-error-list - ;; we want. - (setq compilation-error-list compilation-old-error-list) - (while (and compilation-error-list - ;; The marker can point nowhere if we previously - ;; failed to find the relevant file. See - ;; compilation-next-error-locus. - (or (null (marker-buffer (caar compilation-error-list))) - (and (> (point) (caar compilation-error-list)) - (>= (point) - ;; Don't skip too far: the text between - ;; two errors belongs to the first. This - ;; in-between text might be other errors - ;; on the same line (see - ;; compilation-skip-to-next-location). - (if (null (cdr compilation-error-list)) - compilation-parsing-end - (caar (cdr compilation-error-list))))))) - (setq compilation-error-list (cdr compilation-error-list))) - (or compilation-error-list - (error "No error to go to"))) - (select-window (posn-window (event-end event))) - - (push-mark) - (next-error 1)) - -(defun compile-goto-error (&optional argp) +(defun compile-goto-error () "Visit the source for the error message point is on. -Use this command in a compilation log buffer. Sets the mark at point there. -\\[universal-argument] as a prefix arg means to reparse the buffer's error messages first; -other kinds of prefix arguments are ignored." - (interactive "P") +Use this command in a compilation log buffer. Sets the mark at point there." + (interactive) (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer")) - (setq compilation-last-buffer (current-buffer)) - (compile-reinitialize-errors (consp argp) (point)) - - ;; Move to bol; the marker for the error on this line will point there. - (beginning-of-line) - - ;; Move compilation-error-list to the elt of compilation-old-error-list - ;; we want. - (setq compilation-error-list compilation-old-error-list) - (while (and compilation-error-list - ;; The marker can point nowhere if we previously - ;; failed to find the relevant file. See - ;; compilation-next-error-locus. - (or (null (marker-buffer (caar compilation-error-list))) - (and (> (point) (caar compilation-error-list)) - (>= (point) - ;; Don't skip too far: the text between - ;; two errors belongs to the first. This - ;; in-between text might be other errors - ;; on the same line (see - ;; compilation-skip-to-next-location). - (if (null (cdr compilation-error-list)) - compilation-parsing-end - (caar (cdr compilation-error-list))))))) - (setq compilation-error-list (cdr compilation-error-list))) - - (push-mark) - (next-error 1)) + (if (get-text-property (point) 'directory) + (dired-other-window (car (get-text-property (point) 'directory))) + (push-mark) + (next-error 0))) ;; Return a compilation buffer. ;; If the current buffer is a compilation buffer, return it. @@ -1401,16 +1368,11 @@ (error "No compilation started!"))))))) ;;;###autoload -(defun next-error (&optional argp) +(defun next-error (n) "Visit next compilation error message and corresponding source code. -If all the error messages parsed so far have been processed already, -the message buffer is checked for new ones. - A prefix ARGP specifies how many error messages to move; negative means move back to previous error messages. -Just \\[universal-argument] as a prefix means reparse the error message buffer -and start at the first error. \\[next-error] normally uses the most recently started compilation or grep buffer. However, it can operate on any buffer with output from @@ -1423,16 +1385,48 @@ it stays with that buffer until you use it in some other buffer which uses Compilation mode or Compilation Minor mode. -See variables `compilation-parse-errors-function' and -\`compilation-error-regexp-alist' for customization ideas." - (interactive "P") - (setq compilation-last-buffer (compilation-find-buffer)) - (compilation-goto-locus (compilation-next-error-locus - ;; We want to pass a number here only if - ;; we got a numeric prefix arg, not just C-u. - (and (not (consp argp)) - (prefix-numeric-value argp)) - (consp argp)))) +See variable `compilation-error-regexp-alist' for customization ideas." + (interactive "p") + (set-buffer (setq compilation-last-buffer (compilation-find-buffer))) + (let* ((columns compilation-error-screen-columns) ; buffer's local value + (last 1) + (loc (compilation-next-error n)) + (end-loc (nth 2 loc)) + (marker (point-marker))) + (setq loc (car loc)) + ;; If loc contains no marker, no error in that file has been visited. If + ;; the marker is invalid the buffer has been killed. So, recalculate all + ;; markers for that file. + (unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc))) + (save-excursion + (set-buffer (compilation-find-file marker (caar (nth 2 loc)) + (or (cdar (nth 2 loc)) + default-directory))) + (save-restriction + (widen) + (goto-char 1) + ;; Treat file's found lines in forward order, 1 by 1. + (dolist (line (reverse (cddr (nth 2 loc)))) + (when (car line) ; else this is a filename w/o a line# + (beginning-of-line (- (car line) last -1)) + (setq last (car line))) + ;; Treat line's found columns and store/update a marker for each. + (dolist (col (cdr line)) + (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)))) + (beginning-of-line) + (skip-chars-forward " \t")) + (if (nthcdr 3 col) + (set-marker (nth 3 col) (point)) + (setcdr (nthcdr 2 col) `(,(point-marker))))))))) + (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc)) + (setcdr (nthcdr 3 loc) t))) ; Set this one as visited. + ;;;###autoload (define-key ctl-x-map "`" 'next-error) (defun previous-error (argp) @@ -1445,224 +1439,102 @@ (interactive "P") (next-error (- (prefix-numeric-value argp)))) -(defun first-error () - "Reparse the error message buffer and start at the first error. +(defun first-error (arg) + "Restart at the first error. Visit corresponding source code. +With prefix ARG, visit the source code of the ARGth error. This operates on the output from the \\[compile] command." - (interactive) - (next-error '(4))) + (interactive "p") + (set-buffer (setq compilation-last-buffer (compilation-find-buffer))) + (goto-char (point-min)) + (next-error arg)) (defvar compilation-skip-to-next-location nil "*If non-nil, skip multiple error messages for the same source location.") -(defun compilation-next-error-locus (&optional move reparse silent) - "Visit next compilation error and return locus in corresponding source code. -This operates on the output from the \\[compile] command. -If all preparsed error messages have been processed, -the error message buffer is checked for new ones. +(defcustom compilation-skip-threshold 1 + "*Compilation motion commands skip less important messages. +The value can be either 2 -- skip anything less than error, 1 -- +skip anything less than warning or 0 -- don't skip any messages. +Note that all messages not positively identified as warning or +info, are considered errors." + :type '(choice (const :tag "Warnings and info" 2) + (const :tag "Info" 1) + (const :tag "None" 0)) + :group 'compilation) -Returns a cons (ERROR . SOURCE) of two markers: ERROR is a marker at the -location of the error message in the compilation buffer, and SOURCE is a -marker at the location in the source code indicated by the error message. - -Optional first arg MOVE says how many error messages to move forwards (or -backwards, if negative); default is 1. Optional second arg REPARSE, if -non-nil, says to reparse the error message buffer and reset to the first -error (plus MOVE - 1). If optional third argument SILENT is non-nil, return -nil instead of raising an error if there are no more errors. +(defcustom compilation-skip-visited nil + "*Compilation motion commands skip visited messages if this is t. +Visited messages are ones for which the file, line and column have been jumped +to from the current content in the current compilation buffer, even if it was +from a different message." + :type 'boolean + :group 'compilation) -The current buffer should be the desired compilation output buffer." - (or move (setq move 1)) - (compile-reinitialize-errors reparse nil (and (not reparse) (max 0 move))) - (let (next-errors next-error) - (catch 'no-next-error - (save-excursion - (set-buffer compilation-last-buffer) - ;; compilation-error-list points to the "current" error. - (setq next-errors - (if (> move 0) - (nthcdr (1- move) - compilation-error-list) - ;; Zero or negative arg; we need to move back in the list. - (let ((n (1- move)) - (i 0) - (e compilation-old-error-list)) - ;; See how many cdrs away the current error is from the start. - (while (not (eq e compilation-error-list)) - (setq i (1+ i) - e (cdr e))) - (if (> (- n) i) - (error "Moved back past first error") - (nthcdr (+ i n) compilation-old-error-list)))) - next-error (car next-errors)) - (while - (if (null next-error) - (progn - (and move (/= move 1) - (error (if (> move 0) - "Moved past last error") - "Moved back past first error")) - ;; Forget existing error messages if compilation has finished. - (if (not (and (get-buffer-process (current-buffer)) - (eq (process-status - (get-buffer-process - (current-buffer))) - 'run))) - (compilation-forget-errors)) - (if silent - (throw 'no-next-error nil) - (error (concat compilation-error-message - (and (get-buffer-process (current-buffer)) - (eq (process-status - (get-buffer-process - (current-buffer))) - 'run) - " yet"))))) - (setq compilation-error-list (cdr next-errors)) - (if (null (cdr next-error)) - ;; This error is boring. Go to the next. - t - (or (markerp (cdr next-error)) - ;; This error has a filename/lineno pair. - ;; Find the file and turn it into a marker. - (let* ((fileinfo (car (cdr next-error))) - (buffer (apply 'compilation-find-file - (car next-error) fileinfo))) - (if (null buffer) - ;; We can't find this error's file. - ;; Remove all errors in the same file. - (progn - (setq next-errors compilation-old-error-list) - (while next-errors - (and (consp (cdr (car next-errors))) - (equal (car (cdr (car next-errors))) - fileinfo) - (progn - (set-marker (car (car next-errors)) nil) - (setcdr (car next-errors) nil))) - (setq next-errors (cdr next-errors))) - ;; Look for the next error. - t) - ;; We found the file. Get a marker for this error. - ;; compilation-old-error-list and - ;; compilation-error-screen-columns are buffer-local - ;; so we must be careful to extract their value - ;; before switching to the source file buffer. - (let ((errors compilation-old-error-list) - (columns compilation-error-screen-columns) - (last-line (nth 1 (cdr next-error))) - (column (nth 2 (cdr next-error)))) - (set-buffer buffer) - (save-excursion - (save-restriction - (widen) - (goto-line last-line) - (if (and column (> column 0)) - ;; Columns in error msgs are 1-origin. - (if columns - (move-to-column (1- column)) - (forward-char (1- column))) - (beginning-of-line)) - (setcdr next-error (point-marker)) - ;; Make all the other error messages referring - ;; to the same file have markers into the buffer. - (while errors - (and (consp (cdr (car errors))) - (equal (car (cdr (car errors))) fileinfo) - (let* ((this (nth 1 (cdr (car errors)))) - (column (nth 2 (cdr (car errors)))) - (lines (- this last-line))) - (if (eq selective-display t) - ;; When selective-display is t, - ;; each C-m is a line boundary, - ;; as well as each newline. - (if (< lines 0) - (re-search-backward "[\n\C-m]" - nil 'end - (- lines)) - (re-search-forward "[\n\C-m]" - nil 'end - lines)) - (forward-line lines)) - (if (and column (> column 1)) - (if columns - (move-to-column (1- column)) - (forward-char (1- column))) - (beginning-of-line)) - (setq last-line this) - (setcdr (car errors) (point-marker)))) - (setq errors (cdr errors))))))))) - ;; If we didn't get a marker for this error, or this - ;; marker's buffer was killed, go on to the next one. - (or (not (markerp (cdr next-error))) - (not (marker-buffer (cdr next-error)))))) - (setq next-errors compilation-error-list - next-error (car next-errors))))) +(defcustom compilation-context-lines next-screen-context-lines + "*Display this many lines of leading context before message." + :type 'integer + :group 'compilation) - (if compilation-skip-to-next-location - ;; 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))) - (setq compilation-error-list (cdr compilation-error-list)))) +(defsubst compilation-set-window (w mk) + ;; Align the compilation output window W with marker MK near top. + (set-window-start w (save-excursion + (goto-char mk) + (beginning-of-line (- 1 compilation-context-lines)) + (point))) + (set-window-point w mk)) - ;; We now have a marker for the position of the error source code. - ;; NEXT-ERROR is a cons (ERROR . SOURCE) of two markers. - next-error)) - -(defun compilation-goto-locus (next-error) - "Jump to an error locus returned by `compilation-next-error-locus'. -Takes one argument, a cons (ERROR . SOURCE) of two markers. -Selects a window with point at SOURCE, with another window displaying ERROR." +(defun compilation-goto-locus (msg mk end-mk) + "Jump to an error MESSAGE and SOURCE. +All arguments are markers. If SOURCE-END is non nil, mark is set there." (if (eq (window-buffer (selected-window)) - (marker-buffer (car next-error))) + (marker-buffer msg)) ;; If the compilation buffer window is selected, ;; keep the compilation buffer in this window; ;; display the source in another window. (let ((pop-up-windows t)) - (pop-to-buffer (marker-buffer (cdr next-error)))) + (pop-to-buffer (marker-buffer mk))) (if (window-dedicated-p (selected-window)) - (pop-to-buffer (marker-buffer (cdr next-error))) - (switch-to-buffer (marker-buffer (cdr next-error))))) - (goto-char (cdr next-error)) - ;; If narrowing got in the way of - ;; going to the right place, widen. - (or (= (point) (marker-position (cdr next-error))) - (progn - (widen) - (goto-char (cdr next-error)))) + (pop-to-buffer (marker-buffer mk)) + (switch-to-buffer (marker-buffer mk)))) + ;; If narrowing gets in the way of going to the right place, widen. + (unless (eq (goto-char mk) (point)) + (widen) + (goto-char mk)) + (if end-mk + (push-mark end-mk nil t) + (if mark-active (setq mark-active))) ;; If hideshow got in the way of ;; seeing the right place, open permanently. - (mapcar (function (lambda (ov) - (when (eq 'hs (overlay-get ov 'invisible)) - (delete-overlay ov) - (goto-char (cdr next-error))))) - (overlays-at (point))) + (dolist (ov (overlays-at (point))) + (when (eq 'hs (overlay-get ov 'invisible)) + (delete-overlay ov) + (goto-char mk))) ;; Show compilation buffer in other window, scrolled to this error. (let* ((pop-up-windows t) ;; Use an existing window if it is in a visible frame. - (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible) + (w (or (get-buffer-window (marker-buffer msg) 'visible) ;; Pop up a window. - (display-buffer (marker-buffer (car next-error))))) - (highlight-regexp (with-current-buffer (marker-buffer (car next-error)) + (display-buffer (marker-buffer msg)))) + (highlight-regexp (with-current-buffer (marker-buffer msg) + ;; also do this while we change buffer + (compilation-set-window w msg) compilation-highlight-regexp))) - (set-window-point w (car next-error)) - (set-window-start w (car next-error)) (compilation-set-window-height w) - (when highlight-regexp + (when (and highlight-regexp + (not (and end-mk transient-mark-mode))) (unless compilation-highlight-overlay (setq compilation-highlight-overlay (make-overlay 1 1)) (overlay-put compilation-highlight-overlay 'face 'region)) - (with-current-buffer (marker-buffer (cdr next-error)) + (with-current-buffer (marker-buffer mk) (save-excursion (end-of-line) (let ((end (point)) olay) (beginning-of-line) (if (and (stringp highlight-regexp) - (re-search-forward highlight-regexp end t)) + (re-search-forward highlight-regexp end t)) (progn (goto-char (match-beginning 0)) (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0))) @@ -1700,14 +1572,10 @@ fmts (cdr fmts))) (setq dirs (cdr dirs))) (or buffer - ;; The file doesn't exist. - ;; Ask the user where to find it. - ;; If he hits C-g, then the next time he does - ;; next-error, he'll skip past it. - (let* ((pop-up-windows t) - (w (display-buffer (marker-buffer marker)))) - (set-window-point w marker) - (set-window-start w marker) + ;; The file doesn't exist. Ask the user where to find it. + (let ((pop-up-windows t)) + (compilation-set-window (display-buffer (marker-buffer marker)) + marker) (let ((name (expand-file-name (read-file-name (format "Find this error in: (default %s) " @@ -1736,7 +1604,7 @@ ;; by compile-abbreviate-directory). (file-name-absolute-p filename) (setq filename - (concat comint-file-name-prefix filename))) + (concat (with-no-warnings 'comint-file-name-prefix) filename))) ;; If compilation-parse-errors-filename-function is ;; defined, use it to process the filename. @@ -1753,305 +1621,6 @@ ;; up in the buffer. (setq filename (command-line-normalize-file-name filename))) -;; Set compilation-error-list to nil, and unchain the markers that point to the -;; error messages and their text, so that they no longer slow down gap motion. -;; This would happen anyway at the next garbage collection, but it is better to -;; do it right away. -(defun compilation-forget-errors () - (while compilation-old-error-list - (let ((next-error (car compilation-old-error-list))) - (set-marker (car next-error) nil) - (if (markerp (cdr next-error)) - (set-marker (cdr next-error) nil))) - (setq compilation-old-error-list (cdr compilation-old-error-list))) - (setq compilation-error-list nil - compilation-directory-stack (list default-directory)) - (if compilation-parsing-end - (set-marker compilation-parsing-end 1)) - ;; Remove the highlighting added by compile-reinitialize-errors: - (let ((inhibit-read-only t) - (buffer-undo-list t) - deactivate-mark) - (remove-text-properties (point-min) (point-max) - '(mouse-face highlight help-echo nil)))) - - -;; 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) - (len (length regexp)) - (i 0) - c) - (while (< i len) - (setq c (aref regexp i) - i (1+ i)) - (cond ((= c ?\[) - ;; Find the end of this [...]. - (while (and (< i len) - (not (= (aref regexp i) ?\]))) - (setq i (1+ i)))) - ((= c ?\\) - (if (< i len) - (progn - (setq c (aref regexp i) - i (1+ i)) - (if (= c ?\)) - ;; We found the end of a grouping, - ;; so bump our counter. - (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, 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...") - (if (null compilation-error-regexp-alist) - (error "compilation-error-regexp-alist is empty!")) - (let* ((compilation-regexps nil) ; Variable set by compile-collect-regexps. - (default-directory (car compilation-directory-stack)) - (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 'error compilation-error-regexp-alist) - (compile-collect-regexps 'nomessage compilation-nomessage-regexp-alist) - - ;; Don't reparse messages already seen at last parse. - (goto-char compilation-parsing-end) - (when (and (bobp) - (compilation-buffer-p (current-buffer))) - (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) - ;; Don't parse the "compilation finished" message - ;; as a compilation error. - (get-text-property (point) 'compilation-handle-exit))) - (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")) - - ;; Clean up the file name string in several ways. - (setq filename (compilation-normalize-filename 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. - (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 this-error - compilation-error-list ; At least one previous. - (or (and find-at-least - (>= compilation-num-errors-found - find-at-least)) - (and limit-search - (>= end-of-match limit-search))) - ;; `this-error' could contain a pair of - ;; markers already. - (let ((thispos (cdr this-error)) - (lastpos (cdar compilation-error-list))) - (not (equal - (if (markerp thispos) - (marker-buffer thispos) - (car thispos)) - (if (markerp lastpos) - (marker-buffer lastpos) - (car lastpos)))))) - ;; 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 this-error - (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. - (when filename - (setq compilation-current-file - ;; Clean up the file name string in several ways. - (compilation-normalize-filename filename))) - ;; Enter or leave directory. - (setq stack compilation-directory-stack) - ;; Don't check if it is really a directory. - ;; Let the code to search and clean up file names - ;; try to use it in any case. - (when filename - ;; Clean up the directory name string in several ways. - (setq filename (compilation-normalize-filename filename)) - (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) - ;; If we are leaving a specific directory, - ;; as preparation, pop out of all other directories - ;; that we entered nested within it. - (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))) - ))) - - (forward-line 1)) ; End of while loop. Look at next line. - - (set-marker 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)) - (dolist (el this) - (push (cons (car el) (cons type (cdr el))) compilation-regexps)))) - -(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. @@ -2085,7 +1654,7 @@ (substring dir (length parent-expanded))))) dir) -(add-to-list 'debug-ignored-errors "^No more errors\\( yet\\|\\)$") +(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$") (provide 'compile)