X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/00c8f41844afc3149536a134479870c3442e9070..cf63e6fa17ead6154ec0f4253e9e8a27618100da:/lisp/progmodes/compile.el diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index f2bffa1a08..7b401da794 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -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 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2001, 2003, 2004 Free Software Foundation, Inc. -;; Author: Roland McGrath +;; Authors: Roland McGrath , +;; Daniel Pfeiffer ;; 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: - - base directory for find - - find options to restrict or expand the directory list - - find options to limit the files matched - - place to put -i if case insensitive grep - - 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. @@ -175,9 +100,11 @@ in the compilation output, and should return a transformed file name.") ;;;###autoload (defvar compilation-process-setup-function nil "*Function to call to customize the compilation process. -This functions is called immediately before the compilation process is +This function is called immediately before the compilation process is started. It can be used to set any variables or functions that are used -while processing the output of the compilation process.") +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 @@ -198,317 +125,259 @@ describing how the process finished.") Each function is called with two arguments: the compilation buffer, and a string describing how the process finished.") -(defvar compilation-last-buffer nil - "The most recent compilation buffer. -A buffer becomes most recent when its compilation is started -or when it is used with \\[next-error] or \\[compile-goto-error].") - (defvar compilation-in-progress nil "List of compilation processes now running.") (or (assq 'compilation-in-progress minor-mode-alist) (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. - - ;; 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. - - ;; 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) - - ;; 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. - - ;; 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) - - ;; 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) - - ;; 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 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) - - ;; MIPS lint pass; 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) - - ;; 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) - - ;; 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) - - ;; 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) - - ;; 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) - - ;; 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) - - ;; 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) - - ;; 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) - - ;; Oracle pro*c: - ;; Semantic error at line 528, column 5, file erosacqdb.pc: - ("Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):" - 3 1 2) +(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)) - ;; EPC F90 compiler: - ;; Error 24 at (2:progran.f90) : syntax error - ("Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1) + (ada + "\\(warning: .*\\)? at \\([^ \n]+\\):\\([0-9]+\\)$" 2 3 nil (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) + (aix + " in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1) - ;; Sun F90 error messages: - ;; cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3 - (".* ERROR [a-zA-Z0-9 ]+, File = \\(.+\\), Line = \\([0-9]+\\), Column = \\([0-9]+\\)" - 1 2 3) + (ant + "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):[0-9]+:[0-9]+:\\)?\ +\\( warning\\)?" 1 2 3 (4)) - ;; RXP - GPL XML validator at http://www.cogsci.ed.ac.uk/~richard/rxp.html: - ;; Error: Mismatched end tag: expected , got - ;; 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) - - ;; See http://ant.apache.org/faq.html - ;; Ant Java: works for jikes - ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([0-9]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:" 1 2 3) + (bash + "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2) - ;; Ant Java: works for javac - ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([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)) + + (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)) + + (edg-1 + "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)" + 1 2 nil (3 . 4)) + (edg-2 + "at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$" + 2 1 nil 0) + + (epc + "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1) + + (ftnchek + "\\(^Warning .*\\)? line[ \n]\\([0-9]+\\)[ \n]\\(?:col \\([0-9]+\\)[ \n]\\)?file \\([^ :;\n]+\\)" + 4 2 3 (1)) + + (iar + "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" + 1 2 nil (3)) + + (ibm + "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\ + \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5)) + + ;; fixme: should be `mips' + (irix + "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\ +\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) + + (java + "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1)) + + (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)))) + + (gcc-include + "^\\(?:In file included\\| \\) from \ +\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4)) + + (gnu + "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\ +\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\ +\\([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)) + + (lcc + "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" + 2 3 4 (1)) + + (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))) + + ;; Should be lint-1, lint-2 (SysV lint) + (mips-1 + " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1) + (mips-2 + " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2) + + (msft + "^\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ +: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3)) + + (oracle + "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ +\\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\ +\\(?:,\\| in\\| of\\)? file \\(.*?\\):?$" + 3 1 2) + (perl + " at \\([^ \n]+\\) line \\([0-9]+\\)\\(?:[,.]\\|$\\)" 1 2) + + (rxp + "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\ + \\([0-9]+\\) of file://\\(.+\\)" + 4 2 3 (1)) + + (sparc-pascal-file + "^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\ + [12][09][0-9][0-9] +\\(.*\\):$" + 1 nil nil 0) + (sparc-pascal-line + "^\\(\\(?:E\\|\\(w\\)\\) +[0-9]+\\) line \\([0-9]+\\) - " + nil 3 nil (2) nil (1 (compilation-face '(2)))) + (sparc-pascal-example + "^ +\\([0-9]+\\) +.*\n\\(\\(?:e\\|\\(w\\)\\) [0-9]+\\)-+" + nil 1 nil (3) nil (2 (compilation-face '(3)))) + + (sun + ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\ +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) + + (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. -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.") - -(defvar compilation-enter-directory-regexp-alist - '( - ;; Matches lines printed by the `-w' option of GNU Make. - (".*: Entering directory `\\(.*\\)'$" 1) - ;; Matches lines made by Emacs byte compiler. - ("^Entering directory `\\(.*\\)'$" 1) - ) - "Alist specifying how to match lines that indicate a new current directory. -Note that the match is done at the beginning of lines. -Each elt has the form (REGEXP IDX). -If REGEXP matches, the IDX'th subexpression gives the directory name. - -The default value matches lines printed by the `-w' option of GNU Make.") - -(defvar compilation-leave-directory-regexp-alist - '( - ;; Matches lines printed by the `-w' option of GNU Make. - (".*: Leaving directory `\\(.*\\)'$" 1) - ;; Matches lines made by Emacs byte compiler. - ("^Leaving directory `\\(.*\\)'$" 1) - ) -"Alist specifying how to match lines that indicate restoring current directory. -Note that the match is done at the beginning of lines. -Each elt has the form (REGEXP IDX). -If REGEXP matches, the IDX'th subexpression gives the name of the directory -being moved from. If IDX is nil, the last directory entered \(by a line -matching `compilation-enter-directory-regexp-alist'\) is assumed. - -The default value matches lines printed by the `-w' option of GNU Make.") - -(defvar compilation-file-regexp-alist - '( - ;; This matches entries with date time year file-name: like - ;; Thu May 14 10:46:12 1992 mom3.p: - ("\\w\\w\\w \\w\\w\\w +[0-9]+ [0-9][0-9]:[0-9][0-9]:[0-9][0-9] [0-9][0-9][0-9][0-9] \\(.*\\):$" 1) - ) - "Alist specifying how to match lines that indicate a new current file. -Note that the match is done at the beginning of lines. -Each elt has the form (REGEXP IDX). -If REGEXP matches, the IDX'th subexpression gives the file name. This is -used with compilers that don't indicate file name in every error message.") - -;; There is no generally useful regexp that will match non messages, but -;; in special cases there might be one. The lines that are not matched by -;; a regexp take much longer time than the ones that are recognized so if -;; you have same regexeps here, parsing is faster. -(defvar compilation-nomessage-regexp-alist - '( - ) - "Alist specifying how to match lines that have no message. -Note that the match is done at the beginning of lines. -Each elt has the form (REGEXP). This alist is by default empty, but if -you have some good regexps here, the parsing of messages will be faster.") +Note that on Unix everything 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 you are customizing this). + +Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK +HIGHLIGHT...]). If REGEXP matches, the FILE'th subexpression +gives the file name, and the LINE'th subexpression gives the line +number. The COLUMN'th subexpression gives the column number on +that line. + +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. + +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'. + +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" + ,(expand-file-name "compilation.txt" data-directory)) + :group 'compilation) + +(defvar compilation-directory nil + "Directory to restore to when doing `recompile'.") + +(defvar compilation-directory-matcher + '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1)) + "A list for tracking when directories are entered or left. +Nil means not to track directories, e.g. if all file names are absolute. The +first element is the REGEXP matching these messages. It can match any number +of variants, e.g. different languages. The remaining elements are all of the +form (DIR . LEAVE). If for any one of these the DIR'th subexpression +matches, that is a directory name. If LEAVE is nil or the corresponding +LEAVE'th subexpression doesn't match, this message is about going into another +directory. If it does match anything, this message is about going back to the +directory we were in before the last entering message. If you change this, +you may also want to change `compilation-page-delimiter'.") + +(defvar compilation-page-delimiter + "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory `.+'\n\\)+" + "Value of `page-delimiter' in Compilation mode.") + +(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. + ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:" + (1 font-lock-function-name-face) (3 compilation-line-face nil t)) + (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1) + ("^Compilation finished" . compilation-info-face) + ("^Compilation exited abnormally" . compilation-error-face)) + "Additional things to highlight in Compilation mode. +This gets tacked on the end of the generated expressions.") + +(defvar compilation-highlight-regexp t + "Regexp matching part of visited source lines to highlight temporarily. +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. @@ -534,38 +403,6 @@ Otherwise, it saves all modified buffers without asking." :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. @@ -587,13 +424,19 @@ You might also use mode hooks to specify it in certain modes, like this: (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. @@ -609,54 +452,327 @@ starting the compilation process.") ;; 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 + '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold)) + (((class color)) (:foreground "cyan" :weight bold)) + (t (:weight bold))) + "Face used to highlight compiler warnings." + :group 'font-lock-highlighting-faces + :version "21.4") + +(defface compilation-info-face + '((((class color) (min-colors 16) (background light)) + (:foreground "Green3" :weight bold)) + (((class color) (min-colors 16) (background dark)) + (:foreground "Green" :weight bold)) + (((class color)) (: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. +(defvaralias 'compilation-last-buffer 'next-error-last-buffer) +(defvar compilation-parsing-end (make-marker)) +(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 + keymap compilation-button-map + 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. +(eval-when-compile ;Don't keep it at runtime if not needed. +(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))))) + ;; This message didn't mention one, get it from previous + (setq file (previous-single-property-change (point) 'message) + file (or (if file + (car (nth 2 (car (or (get-text-property (1- file) 'message) + (get-text-property file 'message)))))) + '("*unknown*")))) + ;; 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))) + (if col + (if (functionp col) + (setq col (funcall col)) + (and + (setq col (match-string-no-properties col)) + (setq col (- (string-to-number col) compilation-first-column))))) + (if (and end-col (functionp end-col)) + (setq end-col (funcall end-col)) + (if (and end-col (setq end-col (match-string-no-properties end-col))) + (setq end-col (- (string-to-number end-col) compilation-first-column -1)) + (if end-line (setq end-col -1)))) + (if (consp type) ; not a static 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))) + (compilation-internal-error-properties file line end-line col end-col type fmt))) + +(defun compilation-move-to-column (col screen) + "Go to column COL on the current line. +If SCREEN is non-nil, columns are screen columns, otherwise, they are +just char-counts." + (if screen + (move-to-column col) + (goto-char (min (+ (line-beginning-position) col) (line-end-position))))) + +(defun compilation-internal-error-properties (file line end-line col end-col type fmt) + "Get the meta-info that will be added as text-properties. +LINE, END-LINE, COL, END-COL are integers or nil. +TYPE can be 0, 1, or 2. +FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." + (unless file (setq file '("*unknown*"))) + (setq file (compilation-get-file-structure file fmt)) + ;; Get first already existing marker (if any has one, all have one). + ;; Do this first, as the compilation-assq`s may create new nodes. + (let* ((marker-line (car (cddr file))) ; a line structure + (marker (nth 3 (cadr marker-line))) ; its marker + (compilation-error-screen-columns compilation-error-screen-columns) + end-marker loc end-loc) + (if (not (and marker (marker-buffer marker))) + (setq marker) ; no valid marker for this file + (setq loc (or line 1)) ; normalize no linenumber to line 1 + (catch 'marker ; find nearest loc, at least one exists + (dolist (x (nthcdr 3 file)) ; loop over remaining lines + (if (> (car x) loc) ; still bigger + (setq marker-line x) + (if (> (- (or (car marker-line) 1) loc) + (- loc (car x))) ; current line is nearer + (setq marker-line x)) + (throw 'marker t)))) + (setq marker (nth 3 (cadr marker-line)) + marker-line (or (car marker-line) 1)) + (with-current-buffer (marker-buffer marker) + (save-restriction + (widen) + (goto-char (marker-position marker)) + (when (or end-col end-line) + (beginning-of-line (- (or end-line line) marker-line -1)) + (if (or (null end-col) (< end-col 0)) + (end-of-line) + (compilation-move-to-column + end-col compilation-error-screen-columns)) + (setq end-marker (list (point-marker)))) + (beginning-of-line (if end-line + (- line end-line -1) + (- loc marker-line -1))) + (if col + (compilation-move-to-column + col compilation-error-screen-columns) + (forward-to-indentation 0)) + (setq marker (list (point-marker)))))) + + (setq loc (compilation-assq line (cdr file))) + (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 `(,line ,file ,@marker))) + (if end-loc + (or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-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 (cons (match-string ,file) + (cons default-directory + ',(nthcdr 4 item))) + ,(if col `(match-string ,col))))) + (,file compilation-error-face t)) + + (unless (or (null (nth 5 item)) (integerp (nth 5 item))) + (error "HYPERLINK should be an integer: %s" (nth 5 item))) + + `(,(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 (integerp col) + `((,col compilation-column-face nil t))) + ,@(when (integerp 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. Interactively, prompts for the command if `compilation-read-command' is non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. +Additionally, with universal prefix arg, compilation buffer will be in +comint mode, i.e. interactive. To run more than one compilation at once, start one and rename the \`*compilation*' buffer to some other name with @@ -668,295 +784,42 @@ The name used for the buffer is actually whatever is returned by the function in `compilation-buffer-name-function', so you can set that to a function that generates a unique name." (interactive - (if (or compilation-read-command current-prefix-arg) - (list (read-from-minibuffer "Compile command: " - (eval compile-command) nil nil - '(compile-history . 1))) - (list (eval compile-command)))) + (list + (let ((command (eval compile-command))) + (if (or compilation-read-command current-prefix-arg) + (read-from-minibuffer "Compile command: " + command nil nil + (if (equal (car compile-history) command) + '(compile-history . 1) + 'compile-history)) + command)) + (consp current-prefix-arg))) (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 () "Re-compile the program including the current buffer. -If this is run in a compilation-mode buffer, re-use the arguments from the -original use. Otherwise, it recompiles using `compile-command'." +If this is run in a Compilation mode buffer, re-use the arguments from the +original use. Otherwise, recompile 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 " " (substring grep-command glen)))) - (cond ((eq grep-find-use-xargs 'gnu) - (format "%s -type f -print0 | xargs -0 -e %s " - find-program gcmd)) - (grep-find-use-xargs - (format "%s -type f -print | xargs %s " - find-program gcmd)) - (t (format "%s -type f -exec %s {} %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 \\\\[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 , etc." - (setq command - (replace-regexp-in-string "" - (or dir ".") command t t)) - (setq command - (replace-regexp-in-string "" - (or excl "") command t t)) - (setq command - (replace-regexp-in-string "" - (or files "") command t t)) - (setq command - (replace-regexp-in-string "" - (if case-fold "-i" "") command t t)) - (setq command - (replace-regexp-in-string "" - (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 (and (not (eq major-mode (nth 1 compilation-arguments))) + 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. -Setting it causes the compilation-mode commands to put point at the +Setting it causes the Compilation mode commands to put point at the end of their output window so that the end of the output is always -visible rather than the begining." +visible rather than the beginning." :type 'boolean :version "20.3" :group 'compilation) @@ -974,50 +837,54 @@ Otherwise, construct a buffer name from MODE-NAME." (funcall name-function mode-name)) (compilation-buffer-name-function (funcall compilation-buffer-name-function mode-name)) - ((and (eq major-mode 'compilation-mode) - (equal mode-name (nth 2 compilation-arguments))) + ((eq major-mode (nth 1 compilation-arguments)) (buffer-name)) (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. - -If NO-ASYNC is non-nil, start the compilation process synchronously. +If COMMAND starts with a cd command, that becomes the `default-directory'. +The rest of the arguments are optional; for them, nil means use the default. + +MODE is the major mode to set in the compilation buffer. Mode +may also be t meaning use `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 +the 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)))) + (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)) @@ -1031,95 +898,82 @@ Returns the compilation buffer created." (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)) + (buffer-name))))) + (buffer-disable-undo (current-buffer)) + ;; first transfer directory from where M-x compile was called + (setq default-directory thisdir) + ;; Make compilation buffer read-only. The filter can still write it. + ;; Clear out the compilation buffer. + (let ((inhibit-read-only t) + (default-directory thisdir)) + ;; Then evaluate a cd command if any, but don't perform it yet, else start-command + ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make" + (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command) + (if (match-end 1) + (substitute-env-vars (match-string 1 command)) + "~") + default-directory)) (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) + ;; output a mode setter, for saving and later reloading this buffer + (insert "-*- mode: " name-of-mode + "; default-directory: " (prin1-to-string default-directory) + " -*-\n" command "\n") + (setq thisdir default-directory)) + (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 + (let ((process-environment + (append + compilation-environment + (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning + 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")) + (copy-sequence process-environment)))) + (if (not (eq mode t)) + (funcall mode) + (setq buffer-read-only nil) + (with-no-warnings (comint-mode)) + (compilation-shell-minor-mode)) + (if highlight-regexp + (set (make-local-variable 'compilation-highlight-regexp) + highlight-regexp)) (set (make-local-variable 'compilation-arguments) - (list command error-message - name-of-mode parser - error-regexp-alist name-function - enter-regexp-alist leave-regexp-alist - file-regexp-alist nomessage-regexp-alist)) - ;; 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)) + (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-min))) - (compilation-set-window-height outwin) + (set-window-point outwin (if compilation-scroll-output + (point) + (point-min)))) + ;; The setup function is called before compilation-set-window-height + ;; so it can set the compilation-window-height buffer locally. (if compilation-process-setup-function (funcall compilation-process-setup-function)) + (compilation-set-window-height outwin) ;; Start the compilation. - (if (not no-async) - (let* ((process-environment - (append - compilation-environment - (if (and (boundp 'system-uses-terminfo) - system-uses-terminfo) - (list "TERM=dumb" "TERMCAP=" - (format "COLUMNS=%d" (window-width))) - (list "TERM=emacs" - (format "TERMCAP=emacs:co#%d:tc=unknown:" - (window-width)))) - ;; Set the EMACS variable, but - ;; don't override users' setting of $EMACS. - (if (getenv "EMACS") - process-environment - (cons "EMACS=t" process-environment)))) - (proc (start-process-shell-command (downcase mode-name) - outbuf - command))) + (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) @@ -1131,8 +985,9 @@ Returns the compilation buffer created." (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))) + (let* ((buffer-read-only nil) ; call-process needs to modify outbuf + (status (call-process shell-file-name nil outbuf nil "-c" + command))) (cond ((numberp status) (compilation-handle-exit 'exit status (if (zerop status) @@ -1145,28 +1000,34 @@ exited abnormally with code %d\n" (concat status "\n"))) (t (compilation-handle-exit 'bizarre status status)))) + ;; Without async subprocesses, the buffer is not yet + ;; fontified, so fontify it now. + (let ((font-lock-verbose nil)) ; shut up font-lock messages + (font-lock-fontify-buffer)) + (set-buffer-modified-p nil) (message "Executing `%s'...done" command))) - (if compilation-scroll-output - (save-selected-window - (select-window outwin) - (goto-char (point-max))))) + ;; Now finally cd to where the shell started make/grep/... + (setq default-directory thisdir)) + (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))) + (setq next-error-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)))) + ;; Stef said that doing the saves in this order is safer: + (save-excursion + (save-selected-window + (select-window window) + (enlarge-window (- height (window-height)))))))) (defvar compilation-menu-map (let ((map (make-sparse-keymap "Errors"))) @@ -1174,17 +1035,18 @@ exited abnormally with code %d\n" '("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 [follow-link] 'mouse-face) (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) @@ -1200,7 +1062,6 @@ exited abnormally with code %d\n" (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) @@ -1212,21 +1073,46 @@ exited abnormally with code %d\n" 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 [follow-link] 'mouse-face) + (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) + ;; Don't inherit from compilation-minor-mode-map, + ;; because that introduces a menu bar item we don't want. + ;; That confuses C-down-mouse-3. + (define-key map [mouse-2] 'compile-goto-error) + (define-key map [follow-link] 'mouse-face) + (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) + (define-key map "\M-n" 'compilation-next-error) + (define-key map "\M-p" 'compilation-previous-error) + (define-key map "\M-{" 'compilation-previous-file) + (define-key map "\M-}" 'compilation-next-file) + (define-key map " " 'scroll-up) (define-key map "\^?" 'scroll-down) + (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) + ;; Set up the menu-bar - (define-key map [menu-bar compilation] - (cons "Compile" (make-sparse-keymap "Compile"))) + (let ((submap (make-sparse-keymap "Compile"))) + (define-key map [menu-bar compilation] + (cons "Compile" submap)) + (set-keymap-parent submap compilation-menu-map)) (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. @@ -1234,6 +1120,30 @@ exited abnormally with code %d\n" (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) "Major mode for compilation log buffers. @@ -1241,37 +1151,109 @@ exited abnormally with code %d\n" move point to the error message line and type \\[compile-goto-error]. To kill the compilation, type \\[kill-compilation]. -Runs `compilation-mode-hook' with `run-hooks' (which see)." +Runs `compilation-mode-hook' with `run-hooks' (which see). + +\\{compilation-mode-map}" (interactive) (kill-all-local-variables) (use-local-map compilation-mode-map) (setq major-mode 'compilation-mode mode-name (or name-of-mode "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)) + (setq buffer-read-only t) + (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)))) - -(defun compilation-setup () - "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)) + (apply 'compilation-start compilation-arguments)))) + +(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.") + +(defvar compilation-messages-start nil + "Buffer position of the beginning of the compilation messages. +If nil, use the beginning of buffer.") + +;; 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. +Optional argument MINOR indicates this is called from +`compilation-minor-mode'." + (make-local-variable 'compilation-current-error) + (make-local-variable 'compilation-messages-start) (make-local-variable 'compilation-error-screen-columns) - (setq compilation-last-buffer (current-buffer))) + (make-local-variable 'overlay-arrow-position) + ;; Note that compilation-next-error-function is for interfacing + ;; with the next-error function in simple.el, and it's only + ;; coincidentally named similarly to compilation-next-error. + (setq next-error-function 'compilation-next-error-function) + (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 @@ -1281,10 +1263,12 @@ In this minor mode, all the error-parsing commands of the Compilation major mode are available but bound to keys that don't collide with Shell mode. 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 @@ -1293,27 +1277,28 @@ With arg, turn compilation mode on if and only if arg is positive. 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." - (let ((buffer-read-only nil) + "Write MSG in the current buffer and hack its mode-line-process." + (let ((inhibit-read-only t) (status (if compilation-exit-message-function (funcall compilation-exit-message-function process-status exit-status msg) (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)) @@ -1326,14 +1311,6 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'." (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)) @@ -1344,64 +1321,66 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'." ;; 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)))) +;;; test if a buffer is a compilation buffer, assuming we're in the buffer +(defsubst compilation-buffer-internal-p () + "Test if inside a compilation buffer." + (local-variable-p 'compilation-locs)) -(defun compilation-next-error (n) +;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p +(defsubst compilation-buffer-p (buffer) + "Test if BUFFER is a compilation buffer." + (with-current-buffer buffer + (compilation-buffer-internal-p))) + +(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). @@ -1409,122 +1388,53 @@ Does NOT find the source line like \\[next-error]." (interactive "p") (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer")) - (setq compilation-last-buffer (current-buffer)) - - (let ((errors (compile-error-at-point))) - - ;; Move to the error after the one containing point. - (goto-char (car (if (< n 0) - (let ((i 0) - (e compilation-old-error-list)) - ;; See how many cdrs away ERRORS is from the start. - (while (not (eq e errors)) - (setq i (1+ i) - e (cdr e))) - (if (> (- n) i) - (error "Moved back past first error") - (nth (+ i n) compilation-old-error-list))) - (save-excursion - (while (and (> n 0) errors) - ;; Discard the current error and any previous. - (while (and errors (>= (point) (car (car errors)))) - (setq errors (cdr errors))) - ;; Now (car errors) is the next error. - ;; If we want to move down more errors, - ;; put point at this one and start again. - (setq n (1- n)) - (if (and errors (> n 0)) - (goto-char (car (car errors)))))) - (let ((compilation-error-list errors)) - (compile-reinitialize-errors nil nil n) - (if compilation-error-list - (nth (1- n) compilation-error-list) - (error "Moved past last error")))))))) + (or pt (setq pt (point))) + (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))) - -;; 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 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))) @@ -1536,435 +1446,194 @@ Does NOT find the source line like \\[next-error]." (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. -;; If compilation-last-buffer is set to a live buffer, use that. ;; Otherwise, look for a compilation buffer and signal an error ;; if there are none. -(defun compilation-find-buffer (&optional other-buffer) - (if (and (not other-buffer) - (compilation-buffer-p (current-buffer))) - ;; The current buffer is a compilation buffer. - (current-buffer) - (if (and compilation-last-buffer (buffer-name compilation-last-buffer) - (compilation-buffer-p compilation-last-buffer) - (or (not other-buffer) (not (eq compilation-last-buffer - (current-buffer))))) - compilation-last-buffer - (let ((buffers (buffer-list))) - (while (and buffers (or (not (compilation-buffer-p (car buffers))) - (and other-buffer - (eq (car buffers) (current-buffer))))) - (setq buffers (cdr buffers))) - (if buffers - (car buffers) - (or (and other-buffer - (compilation-buffer-p (current-buffer)) - ;; The current buffer is a compilation buffer. - (progn - (if other-buffer - (message "This is the only compilation buffer.")) - (current-buffer))) - (error "No compilation started!"))))))) +(defun compilation-find-buffer (&optional avoid-current) + (next-error-find-buffer avoid-current 'compilation-buffer-internal-p)) ;;;###autoload -(defun next-error (&optional argp) - "Visit next compilation error message and corresponding source code. - -If all the error messages parsed so far have been processed already, -the message buffer is checked for new ones. - -A prefix ARGP specifies how many error messages to move; -negative means move back to previous error messages. -Just \\[universal-argument] as a prefix means reparse the error message buffer -and start at the first error. - -\\[next-error] normally uses the most recently started compilation or -grep buffer. However, it can operate on any buffer with output from -the \\[compile] and \\[grep] commands, or, more generally, on any -buffer in Compilation mode or with Compilation Minor mode enabled. To -specify use of a particular buffer for error messages, type -\\[next-error] in that buffer. - -Once \\[next-error] has chosen the buffer for error messages, -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)))) -;;;###autoload (define-key ctl-x-map "`" 'next-error) - -(defun previous-error (argp) - "Visit previous compilation error message and corresponding source code. - -A prefix ARGP specifies how many error messages to move; -negative means move forward to next error messages. - -This operates on the output from the \\[compile] and \\[grep] commands." - (interactive "P") - (next-error (- (prefix-numeric-value argp)))) - -(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.") - -(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. - -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))))) - - (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)))) - - ;; 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-next-error-function (n &optional reset) + (interactive "p") + (set-buffer (compilation-find-buffer)) + (when reset + (setq compilation-current-error nil)) + (let* ((columns compilation-error-screen-columns) ; buffer's local value + (last 1) + (loc (compilation-next-error (or n 1) nil + (or compilation-current-error + compilation-messages-start + (point-min)))) + (end-loc (nth 2 loc)) + (marker (point-marker))) + (setq compilation-current-error (point-marker) + overlay-arrow-position + (if (bolp) + compilation-current-error + (copy-marker (line-beginning-position))) + 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 (nth 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) + (compilation-move-to-column (car col) columns)) + (beginning-of-line) + (skip-chars-forward " \t")) + (if (nth 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. + +(defvar compilation-gcpro nil + "Internal variable used to keep some values from being GC'd.") +(make-variable-buffer-local 'compilation-gcpro) + +(defun compilation-fake-loc (marker file &optional line col) + "Preassociate MARKER with FILE. +FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME). +This is useful when you compile temporary files, but want +automatic translation of the messages to the real buffer from +which the temporary file came. This only works if done before a +message about FILE appears! + +Optional args LINE and COL default to 1 and beginning of +indentation respectively. The marker is expected to reflect +this. In the simplest case the marker points to the first line +of the region that was saved to the temp file. + +If you concatenate several regions into the temp file (e.g. a +header with variable assignments and a code region), you must +call this several times, once each for the last line of one +region and the first line of the next region." + (or (consp file) (setq file (list file))) + (setq file (compilation-get-file-structure file)) + ;; Between the current call to compilation-fake-loc and the first occurrence + ;; of an error message referring to `file', the data is only kept is the + ;; weak hash-table compilation-locs, so we need to prevent this entry + ;; in compilation-locs from being GC'd away. --Stef + (push file compilation-gcpro) + (let ((loc (compilation-assq (or line 1) (cdr file)))) + (setq loc (compilation-assq col loc)) + (if (cdr loc) + (setcdr (cddr loc) (list marker)) + (setcdr loc (list line file marker))) + loc)) + +(defcustom compilation-context-lines 0 + "*Display this many lines of leading context before message. +If nil, don't scroll the compilation output window." + :type '(choice integer (const :tag "No window scrolling" nil)) + :group 'compilation + :version "21.4") + +(defsubst compilation-set-window (w mk) + "Align the compilation output window W with marker MK near top." + (if (integerp compilation-context-lines) + (set-window-start w (save-excursion + (goto-char mk) + (beginning-of-line (- 1 compilation-context-lines)) + (point)))) + (set-window-point w mk)) + +(defun compilation-goto-locus (msg mk end-mk) + "Jump to an error corresponding to MSG at MK. +All arguments are markers. If END-MK is non-nil, mark is set there +and overlay is highlighted between MK and END-MK." (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 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 highlight-regexp + (unless compilation-highlight-overlay + (setq compilation-highlight-overlay + (make-overlay (point-min) (point-min))) + (overlay-put compilation-highlight-overlay 'face 'next-error)) + (with-current-buffer (marker-buffer mk) + (save-excursion + (if end-mk (goto-char end-mk) (end-of-line)) + (let ((end (point))) + (if mk (goto-char mk) (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) + (current-buffer))) + (move-overlay compilation-highlight-overlay + (point) end (current-buffer))) + (if (numberp next-error-highlight) + (sit-for next-error-highlight)) + (if (not (eq next-error-highlight t)) + (delete-overlay compilation-highlight-overlay)))))) + (when (and (eq next-error-highlight 'fringe-arrow)) + (set (make-local-variable 'overlay-arrow-position) + (copy-marker (line-beginning-position)))))) (defun compilation-find-file (marker filename dir &rest formats) "Find a buffer for file FILENAME. @@ -1995,14 +1664,10 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user." 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,369 +1684,153 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user." (overlays-in (point-min) (point-max))) buffer))) -(defun compilation-normalize-filename (filename) - "Convert a filename string found in an error message to make it usable." - - ;; Check for a comint-file-name-prefix and prepend it if - ;; appropriate. (This is very useful for - ;; compilation-minor-mode in an rlogin-mode buffer.) - (and (boundp 'comint-file-name-prefix) - ;; If file name is relative, default-directory will - ;; already contain the comint-file-name-prefix (done - ;; by compile-abbreviate-directory). - (file-name-absolute-p filename) - (setq filename - (concat comint-file-name-prefix filename))) - - ;; If compilation-parse-errors-filename-function is - ;; defined, use it to process the filename. - (when compilation-parse-errors-filename-function - (setq filename - (funcall compilation-parse-errors-filename-function - filename))) - - ;; Some compilers (e.g. Sun's java compiler, reportedly) - ;; produce bogus file names like "./bar//foo.c" for file - ;; "bar/foo.c"; expand-file-name will collapse these into - ;; "/foo.c" and fail to find the appropriate file. So we - ;; look for doubled slashes in the file name and fix them - ;; up in the buffer. - (setq filename (command-line-normalize-file-name filename))) - -;; 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-get-file-structure (file &optional fmt) + "Retrieve FILE's file-structure or create a new one. +FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)." + + (or (gethash file compilation-locs) + ;; File was not previously encountered, at least not in the form passed. + ;; Let's normalize it and look again. + (let ((filename (car file)) + (default-directory (if (cdr file) + (file-truename (cdr file)) + default-directory))) + + ;; Check for a comint-file-name-prefix and prepend it if appropriate. + ;; (This is very useful for compilation-minor-mode in an rlogin-mode + ;; buffer.) + (if (boundp 'comint-file-name-prefix) + (if (file-name-absolute-p filename) + (setq filename + (concat (with-no-warnings comint-file-name-prefix) filename)) + (setq default-directory + (file-truename + (concat (with-no-warnings comint-file-name-prefix) default-directory))))) + + ;; If compilation-parse-errors-filename-function is + ;; defined, use it to process the filename. + (when compilation-parse-errors-filename-function + (setq filename + (funcall compilation-parse-errors-filename-function + filename))) + + ;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus + ;; file names like "./bar//foo.c" for file "bar/foo.c"; + ;; expand-file-name will collapse these into "/foo.c" and fail to find + ;; the appropriate file. So we look for doubled slashes in the file + ;; name and fix them. + (setq filename (command-line-normalize-file-name filename)) + + ;; Now eliminate any "..", because find-file would get them wrong. + ;; Make relative and absolute filenames, with or without links, the + ;; same. + (setq filename + (list (abbreviate-file-name + (file-truename (if (cdr file) + (expand-file-name filename) + filename))))) + + ;; Store it for the possibly unnormalized name + (puthash file + ;; Retrieve or create file-structure for normalized name + (or (gethash filename compilation-locs) + (puthash filename (list filename fmt) compilation-locs)) + compilation-locs)))) + +(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 ERR to new-style message." + ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or + ;; (MARKER . MARKER). + (let ((dst (cdr err))) + (if (markerp dst) + ;; Must start with a face, for font-lock. + `(face nil + message ,(list (list nil nil nil dst) 2) + help-echo "mouse-2: visit the source location" + keymap compilation-button-map + mouse-face highlight) + ;; Too difficult to do it by hand: dispatch to the normal code. + (let* ((file (pop dst)) + (line (pop dst)) + (col (pop dst)) + (filename (pop file)) + (dirname (pop file)) + (fmt (pop file))) + (compilation-internal-error-properties + (cons filename dirname) line nil col nil 2 fmt))))) + +(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) + +;; Beware: this is not only compatiblity code. New code stil uses it. --Stef (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. -;; ORIG-EXPANDED is an expanded version of ORIG. -;; PARENT-EXPANDED is an expanded version of ORIG's parent. -;; Those two args could be computed here, but we run faster by -;; having the caller compute them just once. -(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded) - ;; Apply canonical abbreviations to DIR first thing. - ;; Those abbreviations are already done in the other arguments passed. - (setq dir (abbreviate-file-name dir)) - - ;; Check for a comint-file-name-prefix and prepend it if appropriate. - ;; (This is very useful for compilation-minor-mode in an rlogin-mode - ;; buffer.) - (if (boundp 'comint-file-name-prefix) - (setq dir (concat comint-file-name-prefix dir))) - - (if (and (> (length dir) (length orig-expanded)) - (string= orig-expanded - (substring dir 0 (length orig-expanded)))) - (setq dir - (concat orig - (substring dir (length orig-expanded))))) - (if (and (> (length dir) (length parent-expanded)) - (string= parent-expanded - (substring dir 0 (length parent-expanded)))) - (setq dir - (concat (file-name-directory - (directory-file-name orig)) - (substring dir (length parent-expanded))))) - dir) - -(add-to-list 'debug-ignored-errors "^No more errors\\( yet\\|\\)$") + ;; 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)) + (setq compilation-gcpro nil) + ;; 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 nil) + (let* ((proc (get-buffer-process (current-buffer))) + (mark (if proc (process-mark proc))) + (pos (or mark (point-max)))) + (setq compilation-messages-start + ;; In the future, ignore the text already present in the buffer. + ;; Since many process filter functions insert before markers, + ;; we need to put ours just before the insertion point rather + ;; than at the insertion point. If that's not possible, then + ;; don't use a marker. --Stef + (if (> pos (point-min)) (copy-marker (1- pos)) pos)))) (provide 'compile) +;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c ;;; compile.el ends here