Mercurial > emacs
diff lisp/progmodes/compile.el @ 89909:68c22ea6027c
Sync to HEAD
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Fri, 16 Apr 2004 12:51:06 +0000 |
| parents | 375f2633d815 |
| children | 4c90ffeb71c5 |
line wrap: on
line diff
--- a/lisp/progmodes/compile.el Thu Apr 15 01:08:34 2004 +0000 +++ b/lisp/progmodes/compile.el Fri Apr 16 12:51:06 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,49 @@ ;;; 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. + +;; 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. ;;; Code: +(eval-when-compile (require 'cl)) + (defgroup compilation nil "Run compiler as inferior of Emacs, parse error messages." :group 'tools @@ -50,122 +89,8 @@ integer) :group 'compilation) -(defcustom compile-auto-highlight t - "*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) - -(defcustom grep-command nil - "The default grep command for \\[grep]. -If the grep program used supports an option to always include file names -in its output (such as the `-H' option to GNU grep), it's a good idea to -include it when specifying `grep-command'. - -The default value of this variable is set up by `grep-compute-defaults'; -call that function before using this variable in your program." - :type '(choice string - (const :tag "Not Set" nil)) - :group 'compilation) - -(defcustom grep-use-null-device 'auto-detect - "If t, append the value of `null-device' to `grep' commands. -This is done to ensure that the output of grep includes the filename of -any match in the case where only a single file is searched, and is not -necessary if the grep program used supports the `-H' option. - -The default value of this variable is set up by `grep-compute-defaults'; -call that function before using this variable in your program." - :type 'boolean - :type '(choice (const :tag "Do Not Append Null Device" nil) - (const :tag "Append Null Device" t) - (other :tag "Not Set" auto-detect)) - :group 'compilation) - -(defcustom grep-find-command nil - "The default find command for \\[grep-find]. -The default value of this variable is set up by `grep-compute-defaults'; -call that function before using this variable in your program." - :type '(choice string - (const :tag "Not Set" nil)) - :group 'compilation) - -(defcustom grep-tree-command nil - "The default find command for \\[grep-tree]. -The default value of this variable is set up by `grep-compute-defaults'; -call that function before using this variable in your program. -The following place holders should be present in the string: - <D> - base directory for find - <X> - find options to restrict or expand the directory list - <F> - find options to limit the files matched - <C> - place to put -i if case insensitive grep - <R> - the regular expression searched for." - :type '(choice string - (const :tag "Not Set" nil)) - :version "21.4" - :group 'compilation) - -(defcustom grep-tree-files-aliases '( - ("ch" . "*.[ch]") - ("c" . "*.c") - ("h" . "*.h") - ("m" . "[Mm]akefile*") - ("asm" . "*.[sS]") - ("all" . "*") - ("el" . "*.el") - ) - "*Alist of aliases for the FILES argument to `grep-tree'." - :type 'alist - :group 'compilation) - -(defcustom grep-tree-ignore-case t - "*If non-nil, `grep-tree' ignores case in matches." - :type 'boolean - :group 'compilation) - -(defcustom grep-tree-ignore-CVS-directories t - "*If non-nil, `grep-tree' does no recurse into CVS directories." - :type 'boolean - :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. @@ -177,7 +102,9 @@ "*Function to call to customize the compilation process. This functions is called immediately before the compilation process is started. It can be used to set any variables or functions that are used -while processing the output of the compilation process.") +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.") ;;;###autoload (defvar compilation-buffer-name-function nil @@ -209,298 +136,241 @@ (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<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\ +\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)" + 2 (3 . 4) (5 . 6) (7)) + + (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\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\ + \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) - ;; 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 0 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)) - ;; 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) + (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)))) - ;; 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) + (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)) - ;; 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) - ) + (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. + +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). - "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.") +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. + +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. -(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. +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'. -The default value matches lines printed by the `-w' option of GNU Make.") +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-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. +(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'.") -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.") +(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.") -;; 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-highlight-regexp t + "Regexp matching part of visited source lines to highlight temporarily. +Highlight entire line if t; don't highlight source lines if nil.") + +(defvar compilation-highlight-overlay nil + "Overlay used to temporarily highlight compilation matches.") (defcustom compilation-error-screen-columns t "*If non-nil, column numbers in error messages are screen columns. @@ -526,38 +396,6 @@ :type 'boolean :group 'compilation) -;; Note: the character class after the optional drive letter does not -;; include a space to support file names with blanks. -(defvar grep-regexp-alist - '(("\\([a-zA-Z]?:?[^:(\t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)) - "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") - -(defvar grep-program - ;; Currently zgrep has trouble. It runs egrep instead of grep, - ;; and it doesn't pass along long options right. - "grep" - ;; (if (equal (condition-case nil ; in case "zgrep" isn't in exec-path - ;; (call-process "zgrep" nil nil nil - ;; "foo" null-device) - ;; (error nil)) - ;; 1) - ;; "zgrep" - ;; "grep") - "The default grep program for `grep-command' and `grep-find-command'. -This variable's value takes effect when `grep-compute-defaults' is called.") - -(defvar find-program "find" - "The default find program for `grep-find-command'. -This variable's value takes effect when `grep-compute-defaults' is called.") - -(defvar grep-find-use-xargs nil - "Whether \\[grep-find] uses the `xargs' utility by default. - -If nil, it uses `find -exec'; if `gnu', it uses `find -print0' and `xargs -0'; -if not nil and not `gnu', it uses `find -print' and `xargs'. - -This variable's value takes effect when `grep-compute-defaults' is called.") - ;;;###autoload (defcustom compilation-search-path '(nil) "*List of directories to search for source files named in error messages. @@ -579,13 +417,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. @@ -601,49 +445,293 @@ ;; History of compile commands. (defvar compile-history nil) -;; History of grep commands. -(defvar grep-history nil) -(defvar grep-find-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 + :version "21.4") + +(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 + :version "21.4") + +(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.") + + + +;; Used for compatibility with the old compile.el. +(defvar compilation-parsing-end nil) +(defvar compilation-parse-errors-function nil) +(defvar compilation-error-list nil) +(defvar compilation-old-error-list nil) + +(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) + (with-current-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")) + keymap compilation-button-map + mouse-face highlight)))) (defun compilation-mode-font-lock-keywords () "Return expressions to highlight in Compilation mode." - (nconc - ;; - ;; 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)))) - 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))) - )) + (if compilation-parse-errors-function + ;; An old package! Try the compatibility code. + '((compilation-compat-parse-errors)) + (append + ;; 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 + (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))) + + (if (functionp line) + ;; The old compile.el had here an undocumented hook that + ;; allowed `line' to be a function that computed the actual + ;; error location. Let's do our best. + `(,(car item) + (0 (compilation-compat-error-properties + (funcall ',line (list* (match-string ,file) + default-directory + ',(nthcdr 4 item)) + ,(if col `(match-string ,col))))) + (,file compilation-error-face t)) + + `(,(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) + + 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. @@ -662,13 +750,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) - (compile-internal command "No more errors")) + (setq compilation-directory default-directory) + (compilation-start command comint)) ;; run compile with the default command line (defun recompile () @@ -677,271 +766,9 @@ original use. Otherwise, it recompiles using `compile-command'." (interactive) (save-some-buffers (not compilation-ask-about-save) nil) - (apply 'compile-internal (or compilation-arguments - `(,(eval compile-command) "No more errors")))) - -(defun grep-process-setup () - "Set up `compilation-exit-message-function' for `grep'." - (set (make-local-variable 'compilation-exit-message-function) - (lambda (status code msg) - (if (eq status 'exit) - (cond ((zerop code) - '("finished (matches found)\n" . "matched")) - ((= code 1) - '("finished with no matches found\n" . "no match")) - (t - (cons msg code))) - (cons msg code))))) - -(defun grep-compute-defaults () - (unless (or (not grep-use-null-device) (eq grep-use-null-device t)) - (setq grep-use-null-device - (with-temp-buffer - (let ((hello-file (expand-file-name "HELLO" data-directory))) - (not - (and (equal (condition-case nil - (if grep-command - ;; `grep-command' is already set, so - ;; use that for testing. - (call-process-shell-command - grep-command nil t nil - "^English" hello-file) - ;; otherwise use `grep-program' - (call-process grep-program nil t nil - "-nH" "^English" hello-file)) - (error nil)) - 0) - (progn - (goto-char (point-min)) - (looking-at - (concat (regexp-quote hello-file) - ":[0-9]+:English"))))))))) - (unless grep-command - (setq grep-command - (let ((required-options (if grep-use-null-device "-n" "-nH"))) - (if (equal (condition-case nil ; in case "grep" isn't in exec-path - (call-process grep-program nil nil nil - "-e" "foo" null-device) - (error nil)) - 1) - (format "%s %s -e " grep-program required-options) - (format "%s %s " grep-program required-options))))) - (unless grep-find-use-xargs - (setq grep-find-use-xargs - (if (and - (equal (call-process "find" nil nil nil - null-device "-print0") - 0) - (equal (call-process "xargs" nil nil nil - "-0" "-e" "echo") - 0)) - 'gnu))) - (unless grep-find-command - (setq grep-find-command - (cond ((eq grep-find-use-xargs 'gnu) - (format "%s . -type f -print0 | xargs -0 -e %s" - find-program grep-command)) - (grep-find-use-xargs - (format "%s . -type f -print | xargs %s" - find-program grep-command)) - (t (cons (format "%s . -type f -exec %s {} %s \\;" - find-program grep-command null-device) - (+ 22 (length grep-command))))))) - (unless grep-tree-command - (setq grep-tree-command - (let* ((glen (length grep-program)) - (gcmd (concat grep-program " <C>" (substring grep-command glen)))) - (cond ((eq grep-find-use-xargs 'gnu) - (format "%s <D> <X> -type f <F> -print0 | xargs -0 -e %s <R>" - find-program gcmd)) - (grep-find-use-xargs - (format "%s <D> <X> -type f <F> -print | xargs %s <R>" - find-program gcmd)) - (t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;" - find-program gcmd null-device))))))) - -(defun grep-default-command () - (let ((tag-default - (funcall (or find-tag-default-function - (get major-mode 'find-tag-default-function) - ;; We use grep-tag-default instead of - ;; find-tag-default, to avoid loading etags. - 'grep-tag-default))) - (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") - (grep-default (or (car grep-history) grep-command))) - ;; Replace the thing matching for with that around cursor. - (when (or (string-match - (concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*" - sh-arg-re "\\(\\s +\\(\\S +\\)\\)?") - grep-default) - ;; If the string is not yet complete. - (string-match "\\(\\)\\'" grep-default)) - (unless (or (not (stringp buffer-file-name)) - (when (match-beginning 2) - (save-match-data - (string-match - (wildcard-to-regexp - (file-name-nondirectory - (match-string 3 grep-default))) - (file-name-nondirectory buffer-file-name))))) - (setq grep-default (concat (substring grep-default - 0 (match-beginning 2)) - " *." - (file-name-extension buffer-file-name)))) - (replace-match (or tag-default "") t t grep-default 1)))) - -;;;###autoload -(defun grep (command-args) - "Run grep, with user-specified args, and collect output in a buffer. -While grep runs asynchronously, you can use \\[next-error] (M-x next-error), -or \\<compilation-minor-mode-map>\\[compile-goto-error] in the grep \ -output buffer, to go to the lines -where grep found matches. - -This command uses a special history list for its COMMAND-ARGS, so you can -easily repeat a grep command. - -A prefix argument says to default the argument based upon the current -tag the cursor is over, substituting it into the last grep command -in the grep command history (or into `grep-command' -if that history list is empty)." - (interactive - (progn - (unless (and grep-command - (or (not grep-use-null-device) (eq grep-use-null-device t))) - (grep-compute-defaults)) - (let ((default (grep-default-command))) - (list (read-from-minibuffer "Run grep (like this): " - (if current-prefix-arg - default grep-command) - nil nil 'grep-history - (if current-prefix-arg nil default)))))) - - ;; Setting process-setup-function makes exit-message-function work - ;; even when async processes aren't supported. - (let* ((compilation-process-setup-function 'grep-process-setup) - (buf (compile-internal (if (and grep-use-null-device null-device) - (concat command-args " " null-device) - command-args) - "No more grep hits" "grep" - ;; Give it a simpler regexp to match. - nil grep-regexp-alist))))) - -;; This is a copy of find-tag-default from etags.el. -(defun grep-tag-default () - (save-excursion - (while (looking-at "\\sw\\|\\s_") - (forward-char 1)) - (when (or (re-search-backward "\\sw\\|\\s_" - (save-excursion (beginning-of-line) (point)) - t) - (re-search-forward "\\(\\sw\\|\\s_\\)+" - (save-excursion (end-of-line) (point)) - t)) - (goto-char (match-end 0)) - (buffer-substring (point) - (progn (forward-sexp -1) - (while (looking-at "\\s'") - (forward-char 1)) - (point)))))) - -;;;###autoload -(defun grep-find (command-args) - "Run grep via find, with user-specified args COMMAND-ARGS. -Collect output in a buffer. -While find runs asynchronously, you can use the \\[next-error] command -to find the text that grep hits refer to. - -This command uses a special history list for its arguments, so you can -easily repeat a find command." - (interactive - (progn - (unless grep-find-command - (grep-compute-defaults)) - (list (read-from-minibuffer "Run find (like this): " - grep-find-command nil nil - 'grep-find-history)))) - (let ((null-device nil)) ; see grep - (grep command-args))) - -(defun grep-expand-command-macros (command &optional regexp files dir excl case-fold) - "Patch grep COMMAND replacing <D>, etc." - (setq command - (replace-regexp-in-string "<D>" - (or dir ".") command t t)) - (setq command - (replace-regexp-in-string "<X>" - (or excl "") command t t)) - (setq command - (replace-regexp-in-string "<F>" - (or files "") command t t)) - (setq command - (replace-regexp-in-string "<C>" - (if case-fold "-i" "") command t t)) - (setq command - (replace-regexp-in-string "<R>" - (or regexp "") command t t)) - command) - -(defvar grep-tree-last-regexp "") -(defvar grep-tree-last-files (car (car grep-tree-files-aliases))) - -;;;###autoload -(defun grep-tree (regexp files dir &optional subdirs) - "Grep for REGEXP in FILES in directory tree rooted at DIR. -Collect output in a buffer. -Interactively, prompt separately for each search parameter. -With prefix arg, reuse previous REGEXP. -The search is limited to file names matching shell pattern FILES. -FILES may use abbreviations defined in `grep-tree-files-aliases', e.g. -entering `ch' is equivalent to `*.[ch]'. - -While find runs asynchronously, you can use the \\[next-error] command -to find the text that grep hits refer to. - -This command uses a special history list for its arguments, so you can -easily repeat a find command. - -When used non-interactively, optional arg SUBDIRS limits the search to -those sub directories of DIR." - (interactive - (let* ((regexp - (if current-prefix-arg - grep-tree-last-regexp - (let* ((default (current-word)) - (spec (read-string - (concat "Search for" - (if (and default (> (length default) 0)) - (format " (default %s): " default) ": "))))) - (if (equal spec "") default spec)))) - (files - (read-string (concat "Search for \"" regexp "\" in files (default " grep-tree-last-files "): "))) - (dir - (read-directory-name "Base directory: " nil default-directory t))) - (list regexp files dir))) - (unless grep-tree-command - (grep-compute-defaults)) - (unless (and (stringp files) (> (length files) 0)) - (setq files grep-tree-last-files)) - (when files - (setq grep-tree-last-files files) - (let ((mf (assoc files grep-tree-files-aliases))) - (if mf - (setq files (cdr mf))))) - (let ((command-args (grep-expand-command-macros - grep-tree-command - (setq grep-tree-last-regexp regexp) - (and files (concat "-name '" files "'")) - (if subdirs - (if (stringp subdirs) - subdirs - (mapconcat 'identity subdirs " ")) - nil) ;; we change default-directory to dir - (and grep-tree-ignore-CVS-directories "-path '*/CVS' -prune -o ") - grep-tree-ignore-case)) - (default-directory dir) - (null-device nil)) ; see grep - (grep command-args))) + (let ((default-directory (or compilation-directory default-directory))) + (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. @@ -972,44 +799,62 @@ (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) + 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, 3-10 are optional. -For them nil means use the default. -NAME-OF-MODE is the name to display as the major mode in the compilation -buffer. PARSER is the error parser function. ERROR-REGEXP-ALIST is the error -message regexp alist to use. NAME-FUNCTION is a function called to name the -buffer. ENTER-REGEXP-ALIST is the enter directory message regexp alist to use. -LEAVE-REGEXP-ALIST is the leave directory message regexp alist to use. -FILE-REGEXP-ALIST is the change current file message regexp alist to use. -NOMESSAGE-REGEXP-ALIST is the nomessage regexp alist to use. - The defaults for these variables are the global values of -\`compilation-parse-errors-function', `compilation-error-regexp-alist', -\`compilation-buffer-name-function', `compilation-enter-directory-regexp-alist', -\`compilation-leave-directory-regexp-alist', `compilation-file-regexp-alist', -\ and `compilation-nomessage-regexp-alist', respectively. -For arg 7-10 a value t means an empty alist. +The rest of the arguments are optional; for them, nil means use the default. -If NO-ASYNC is non-nil, start the compilation process synchronously. +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. + +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'. Returns the compilation buffer created." - (unless no-async - (setq no-async (not (fboundp 'start-process)))) - (let (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))) - (set-buffer 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) + (with-current-buffer + (setq outbuf + (get-buffer-create + (compilation-buffer-name name-of-mode name-function))) (let ((comp-proc (get-buffer-process (current-buffer)))) (if comp-proc (if (or (not (eq (process-status comp-proc) 'run)) @@ -1023,142 +868,104 @@ (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 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)) - (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) - ;; 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-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)) - ;; 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-min))) - (compilation-set-window-height outwin) - (if compilation-process-setup-function - (funcall compilation-process-setup-function)) - ;; 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 "\ + (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 compilation-scroll-output - (save-selected-window - (select-window outwin) - (goto-char (point-max))))) + 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))) (defun compilation-set-window-height (window) "Set the height of WINDOW according to `compilation-window-height'." - (and compilation-window-height - (= (window-width window) (frame-width (window-frame window))) - ;; If window is alone in its frame, aside from a minibuffer, - ;; don't change its height. - (not (eq window (frame-root-window (window-frame window)))) - ;; This save-current-buffer prevents us from changing the current - ;; buffer, which might not be the same as the selected window's buffer. - (save-current-buffer - (save-selected-window - (select-window window) - (enlarge-window (- compilation-window-height - (window-height))))))) + (let ((height (buffer-local-value 'compilation-window-height (window-buffer window)))) + (and height + (= (window-width window) (frame-width (window-frame window))) + ;; If window is alone in its frame, aside from a minibuffer, + ;; don't change its height. + (not (eq window (frame-root-window (window-frame window)))) + ;; This save-current-buffer prevents us from changing the current + ;; buffer, which might not be the same as the selected window's buffer. + (save-current-buffer + (save-selected-window + (select-window window) + (enlarge-window (- height (window-height)))))))) (defvar compilation-menu-map (let ((map (make-sparse-keymap "Errors"))) @@ -1166,17 +973,17 @@ '("Stop Compilation" . kill-compilation)) (define-key map [compilation-mode-separator2] '("----" . nil)) - (define-key map [compilation-mode-first-error] + (define-key map [compilation-first-error] '("First Error" . first-error)) - (define-key map [compilation-mode-previous-error] + (define-key map [compilation-previous-error] '("Previous Error" . previous-error)) - (define-key map [compilation-mode-next-error] + (define-key map [compilation-next-error] '("Next Error" . next-error)) map)) (defvar compilation-minor-mode-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'compile-mouse-goto-error) + (define-key map [mouse-2] 'compile-goto-error) (define-key map "\C-c\C-c" 'compile-goto-error) (define-key map "\C-m" 'compile-goto-error) (define-key map "\C-c\C-k" 'kill-compilation) @@ -1192,7 +999,6 @@ (defvar compilation-shell-minor-mode-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'compile-mouse-goto-error) (define-key map "\M-\C-m" 'compile-goto-error) (define-key map "\M-\C-n" 'compilation-next-error) (define-key map "\M-\C-p" 'compilation-previous-error) @@ -1204,21 +1010,30 @@ map) "Keymap for `compilation-shell-minor-mode'.") +(defvar compilation-button-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'compile-goto-error) + (define-key map "\C-m" 'compile-goto-error) + map) + "Keymap for compilation-message buttons.") +(fset 'compilation-button-map compilation-button-map) + (defvar compilation-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map compilation-minor-mode-map) (define-key map " " 'scroll-up) (define-key map "\^?" 'scroll-down) + ;; Set up the menu-bar (define-key map [menu-bar compilation] (cons "Compile" (make-sparse-keymap "Compile"))) (define-key map [menu-bar compilation compilation-separator2] '("----" . nil)) - (define-key map [menu-bar compilation compilation-mode-grep] + (define-key map [menu-bar compilation compilation-grep] '("Search Files (grep)" . grep)) - (define-key map [menu-bar compilation compilation-mode-recompile] + (define-key map [menu-bar compilation compilation-recompile] '("Recompile" . recompile)) - (define-key map [menu-bar compilation compilation-mode-compile] + (define-key map [menu-bar compilation compilation-compile] '("Compile..." . compile)) map) "Keymap for compilation log buffers. @@ -1226,8 +1041,32 @@ (put 'compilation-mode 'mode-class 'special) +(defvar compilation-skip-to-next-location t + "*If non-nil, skip multiple error messages for the same source location.") + +(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 + :version "21.4") + +(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 + :version "21.4") + ;;;###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]. @@ -1238,32 +1077,91 @@ (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 preserve-modes)) + (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 () +(defvar compilation-current-error nil + "Marker to the location from where the next error will be found. +The global commands next/previous/first-error/goto-error use this.") + +;; 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-current-error) (make-local-variable 'compilation-error-screen-columns) - (setq compilation-last-buffer (current-buffer))) + (make-local-variable 'overlay-arrow-position) + (setq compilation-last-buffer (current-buffer)) + (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. + (set (make-local-variable 'font-lock-support-mode) nil) + (set (make-local-variable 'font-lock-maximum-size) nil) + (let ((fld font-lock-defaults)) + (if (and minor fld) + (font-lock-add-keywords nil (compilation-mode-font-lock-keywords)) + (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))) + (if minor + (if font-lock-mode + (if fld + (font-lock-fontify-buffer) + (font-lock-change-mode) + (turn-on-font-lock)) + (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 @@ -1273,10 +1171,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 @@ -1285,10 +1185,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." @@ -1299,13 +1201,12 @@ (cons msg exit-status))) (omax (point-max)) (opoint (point))) - ;; Record where we put the message, so we can ignore it - ;; later on. + ;; Record where we put the message, so we can ignore it later on. (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)) @@ -1318,14 +1219,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)) @@ -1336,64 +1229,58 @@ ;; Called when compilation process changes state. (defun compilation-sentinel (proc msg) "Sentinel for compilation buffers." - (let ((buffer (process-buffer proc))) - (if (memq (process-status proc) '(signal exit)) - (progn - (if (null (buffer-name buffer)) - ;; buffer killed - (set-process-buffer proc nil) - (let ((obuf (current-buffer))) - ;; save-excursion isn't the right thing if - ;; process-buffer is current-buffer - (unwind-protect - (progn - ;; Write something in the compilation buffer - ;; and hack its mode line. - (set-buffer buffer) - (compilation-handle-exit (process-status proc) - (process-exit-status proc) - msg) - ;; Since the buffer and mode line will show that the - ;; process is dead, we can delete it now. Otherwise it - ;; will stay around until M-x list-processes. - (delete-process proc)) - (set-buffer obuf)))) - (setq compilation-in-progress (delq proc compilation-in-progress)) - )))) + (if (memq (process-status proc) '(exit signal)) + (let ((buffer (process-buffer proc))) + (if (null (buffer-name buffer)) + ;; buffer killed + (set-process-buffer proc nil) + (with-current-buffer buffer + ;; Write something in the compilation buffer + ;; and hack its mode line. + (compilation-handle-exit (process-status proc) + (process-exit-status proc) + msg) + ;; Since the buffer and mode line will show that the + ;; process is dead, we can delete it now. Otherwise it + ;; will stay around until M-x list-processes. + (delete-process proc))) + (setq compilation-in-progress (delq proc compilation-in-progress))))) (defun compilation-filter (proc string) "Process filter for compilation buffers. Just inserts the text, but uses `insert-before-markers'." (if (buffer-name (process-buffer proc)) - (save-excursion - (set-buffer (process-buffer proc)) - (let ((buffer-read-only nil) - (end (marker-position compilation-parsing-end))) + (with-current-buffer (process-buffer proc) + (let ((inhibit-read-only t)) (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 pt) "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). @@ -1401,122 +1288,73 @@ (interactive "p") (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer")) + (or pt (setq pt (point))) (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* ((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) (point-min)) + 'message))) + (setq pt (previous-single-property-change pt 'message nil + (line-beginning-position))) + (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'message)) + (setq pt (next-single-property-change pt 'message nil + (line-end-position))) + (or (setq msg (get-text-property pt 'message)) + (setq pt (point))))) + (setq last (nth 2 (car msg))) + (if (>= n 0) + (compilation-loop > next-single-property-change 1- + (if (get-buffer-process (current-buffer)) + "No more %ss yet" + "Moved past last %s")) + ;; Don't move "back" to message at or before point. + ;; Pass an explicit (point-min) to make sure pt is non-nil. + (setq pt (previous-single-property-change pt 'message nil (point-min))) + (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))) +(defun next-error-no-select (n) + "Move point to the next error in the compilation buffer and highlight match. +Prefix arg N says how many error messages to move forwards (or +backwards, if negative). +Finds and highlights the source line like \\[next-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))) +(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 backwards (or +forwards, if negative). +Finds and highlights the source line like \\[previous-error], but does not +select the source buffer." + (interactive "p") + (next-error-no-select (- n))) (defun compilation-next-file (n) - "Move point to the next error for a different file than the current one." + "Move point to the next error for a different file than the current one. +Prefix arg N says how many files to move forwards (or backwards, if negative)." (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." + "Move point to the previous error for a different file than the current one. +Prefix arg N says how many files to move backwards (or forwards, if negative)." (interactive "p") (compilation-next-file (- n))) @@ -1528,154 +1366,20 @@ (interrupt-process (get-buffer-process buffer)) (error "The compilation process is not running")))) -(defalias 'kill-grep 'kill-compilation) +(defalias 'compile-mouse-goto-error 'compile-goto-error) -;; 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) - "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") +(defun compile-goto-error (&optional event) + "Visit the source for the error message at point. +Use this command in a compilation log buffer. Sets the mark at point there." + (interactive (list last-input-event)) + (if event (posn-set-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 (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) + (setq compilation-current-error (point)) + (next-error 0))) ;; Return a compilation buffer. ;; If the current buffer is a compilation buffer, return it. @@ -1709,16 +1413,10 @@ (error "No compilation started!"))))))) ;;;###autoload -(defun next-error (&optional argp) +(defun next-error (&optional 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. +Prefix arg N says how many error messages to move forwards (or +backwards, if negative). \\[next-error] normally uses the most recently started compilation or grep buffer. However, it can operate on any buffer with output from @@ -1731,228 +1429,149 @@ 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 (or n 1) nil + (or compilation-current-error (point-min)))) + (end-loc (nth 2 loc)) + (marker (point-marker))) + (setq compilation-current-error (point-marker) + overlay-arrow-position + (if (bolp) + compilation-current-error + (save-excursion + (beginning-of-line) + (point-marker))) + 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))) + (with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) + (or (cdar (nth 2 loc)) + default-directory)) + (save-restriction + (widen) + (goto-char (point-min)) + ;; 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 () +(defun previous-error (n) "Visit previous compilation error message and corresponding source code. -This operates on the output from the \\[compile] command." - (interactive) - (next-error -1)) +Prefix arg N says how many error messages to move backwards (or +forwards, if negative). -(defun first-error () - "Reparse the error message buffer and start at the first error. -Visit corresponding source code. -This operates on the output from the \\[compile] command." - (interactive) - (next-error '(4))) - -(defvar compilation-skip-to-next-location nil - "*If non-nil, skip multiple error messages for the same source location.") +This operates on the output from the \\[compile] and \\[grep] commands." + (interactive "p") + (next-error (- n))) -(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. - -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. +(defun first-error (n) + "Restart at the first error. +Visit corresponding source code. +With prefix arg N, visit the source code of the Nth error. +This operates on the output from the \\[compile] command." + (interactive "p") + (set-buffer (setq compilation-last-buffer (compilation-find-buffer))) + (setq compilation-current-error nil) + (next-error n)) -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 + :version "21.4") - (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)))))) - (set-window-point w (car next-error)) - (set-window-start w (car next-error)) - (compilation-set-window-height w))) + (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))) + (compilation-set-window-height w) + + (when (and highlight-regexp + (not (and end-mk transient-mark-mode))) + (unless compilation-highlight-overlay + (setq compilation-highlight-overlay + (make-overlay (point-min) (point-min))) + (overlay-put compilation-highlight-overlay 'face 'region)) + (with-current-buffer (marker-buffer mk) + (save-excursion + (end-of-line) + (let ((end (point))) + (beginning-of-line) + (if (and (stringp highlight-regexp) + (re-search-forward highlight-regexp end t)) + (progn + (goto-char (match-beginning 0)) + (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0))) + (move-overlay compilation-highlight-overlay (point) end)) + (sit-for 0.5) + (delete-overlay compilation-highlight-overlay))))))) + (defun compilation-find-file (marker filename dir &rest formats) "Find a buffer for file FILENAME. @@ -1983,14 +1602,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) " @@ -2019,7 +1634,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. @@ -2036,305 +1651,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. @@ -2368,8 +1684,79 @@ (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$") + +;;; Compatibility with the old compile.el. + +(defun compile-buffer-substring (n) (if n (match-string n))) + +(defun compilation-compat-error-properties (err) + ;; Map old-style ERROR to new-style MESSAGE. + (let* ((dst (cdr err)) + (loc (cond ((markerp dst) (list nil nil nil dst)) + ((consp dst) + (list (nth 2 dst) (nth 1 dst) + (cons (cdar dst) (caar dst))))))) + ;; Must start with a face, for font-lock. + `(face nil + message ,(list loc 2) + help-echo "mouse-2: visit the source location" + mouse-face highlight))) + +(defun compilation-compat-parse-errors (limit) + (when compilation-parse-errors-function + ;; FIXME: We should remove the rest of the compilation keywords + ;; but we can't do that from here because font-lock is using + ;; the value right now. --stef + (save-excursion + (setq compilation-error-list nil) + ;; Reset compilation-parsing-end each time because font-lock + ;; might force us the re-parse many times (typically because + ;; some code adds some text-property to the output that we + ;; already parsed). You might say "why reparse", well: + ;; because font-lock has just removed the `message' property so + ;; have to do it all over again. + (if compilation-parsing-end + (set-marker compilation-parsing-end (point)) + (setq compilation-parsing-end (point-marker))) + (condition-case nil + ;; Ignore any error: we're calling this function earlier than + ;; in the old compile.el so things might not all be setup yet. + (funcall compilation-parse-errors-function limit nil) + (error nil)) + (dolist (err (if (listp compilation-error-list) compilation-error-list)) + (let* ((src (car err)) + (dst (cdr err)) + (loc (cond ((markerp dst) (list nil nil nil dst)) + ((consp dst) + (list (nth 2 dst) (nth 1 dst) + (cons (cdar dst) (caar dst))))))) + (when loc + (goto-char src) + ;; (put-text-property src (line-end-position) 'font-lock-face 'font-lock-warning-face) + (put-text-property src (line-end-position) + 'message (list loc 2))))))) + (goto-char limit) + nil) + +(defun compilation-forget-errors () + ;; In case we hit the same file/line specs, we want to recompute a new + ;; marker for them, so flush our cache. + (setq compilation-locs (make-hash-table :test 'equal :weakness 'value)) + ;; FIXME: the old code reset the directory-stack, so maybe we should + ;; put a `directory change' marker of some sort, but where? -stef + ;; + ;; FIXME: The old code moved compilation-current-error (which was + ;; virtually represented by a mix of compilation-parsing-end and + ;; compilation-error-list) to point-min, but that was only meaningful for + ;; the internal uses of compilation-forget-errors: all calls from external + ;; packages seem to be followed by a move of compilation-parsing-end to + ;; something equivalent to point-max. So we speculatively move + ;; compilation-current-error to point-max (since the external package + ;; won't know that it should do it). --stef + (setq compilation-current-error (point-max))) (provide 'compile) +;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c ;;; compile.el ends here