;;; compile.el --- run compiler as inferior of Emacs, parse error messages
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 2003
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 03, 2004
;; Free Software Foundation, Inc.
-;; Author: Roland McGrath <roland@gnu.org>
+;; Authors: Roland McGrath <roland@gnu.org>,
+;; Daniel Pfeiffer <occitan@esperanto.org>
;; Maintainer: FSF
;; Keywords: tools, processes
;;; 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
integer)
:group 'compilation)
-(defcustom compile-auto-highlight nil
- "*Specify how many compiler errors to highlight (and parse) initially.
-\(Highlighting applies to an error message when the mouse is over it.)
-If this is a number N, all compiler error messages in the first N lines
-are highlighted and parsed as soon as they arrive in Emacs.
-If t, highlight and parse the whole compilation output as soon as it arrives.
-If nil, don't highlight or parse any of the buffer until you try to
-move to the error messages.
-
-Those messages which are not parsed and highlighted initially
-will be parsed and highlighted as soon as you try to move to them."
- :type '(choice (const :tag "All" t)
- (const :tag "None" nil)
- (integer :tag "First N lines"))
- :group 'compilation)
-
-(defcustom grep-command nil
- "The default grep command for \\[grep].
-If the grep program used supports an option to always include file names
-in its output (such as the `-H' option to GNU grep), it's a good idea to
-include it when specifying `grep-command'.
-
-The default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable in your program."
- :type '(choice string
- (const :tag "Not Set" nil))
- :group 'compilation)
-
-(defcustom grep-use-null-device 'auto-detect
- "If t, append the value of `null-device' to `grep' commands.
-This is done to ensure that the output of grep includes the filename of
-any match in the case where only a single file is searched, and is not
-necessary if the grep program used supports the `-H' option.
-
-The default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable in your program."
- :type 'boolean
- :type '(choice (const :tag "Do Not Append Null Device" nil)
- (const :tag "Append Null Device" t)
- (other :tag "Not Set" auto-detect))
- :group 'compilation)
-
-(defcustom grep-find-command nil
- "The default find command for \\[grep-find].
-The default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable in your program."
- :type '(choice string
- (const :tag "Not Set" nil))
- :group 'compilation)
-
-(defcustom grep-tree-command nil
- "The default find command for \\[grep-tree].
-The default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable in your program.
-The following place holders should be present in the string:
- <D> - base directory for find
- <X> - find options to restrict or expand the directory list
- <F> - find options to limit the files matched
- <C> - place to put -i if case insensitive grep
- <R> - the regular expression searched for."
- :type '(choice string
- (const :tag "Not Set" nil))
- :version "21.4"
- :group 'compilation)
-
-(defcustom grep-tree-files-aliases '(
- ("ch" . "*.[ch]")
- ("c" . "*.c")
- ("h" . "*.h")
- ("m" . "[Mm]akefile*")
- ("asm" . "*.[sS]")
- ("all" . "*")
- ("el" . "*.el")
- )
- "*Alist of aliases for the FILES argument to `grep-tree'."
- :type 'alist
- :group 'compilation)
-
-(defcustom grep-tree-ignore-case t
- "*If non-nil, `grep-tree' ignores case in matches."
- :type 'boolean
- :group 'compilation)
-
-(defcustom grep-tree-ignore-CVS-directories t
- "*If non-nil, `grep-tree' does no recurse into CVS directories."
- :type 'boolean
- :group 'compilation)
-
-(defvar compilation-error-list nil
- "List of error message descriptors for visiting erring functions.
-Each error descriptor is a cons (or nil). Its car is a marker pointing to
-an error message. If its cdr is a marker, it points to the text of the
-line the message is about. If its cdr is a cons, it is a list
-\(\(DIRECTORY . FILE\) LINE [COLUMN]\). Or its cdr may be nil if that
-error is not interesting.
-
-The value may be t instead of a list; this means that the buffer of
-error messages should be reparsed the next time the list of errors is wanted.
-
-Some other commands (like `diff') use this list to control the error
-message tracking facilities; if you change its structure, you should make
-sure you also change those packages. Perhaps it is better not to change
-it at all.")
-
-(defvar compilation-old-error-list nil
- "Value of `compilation-error-list' after errors were parsed.")
-
-(defvar compilation-parse-errors-function 'compilation-parse-errors
- "Function to call to parse error messages from a compilation.
-It takes args LIMIT-SEARCH and FIND-AT-LEAST.
-If LIMIT-SEARCH is non-nil, don't bother parsing past that location.
-If FIND-AT-LEAST is non-nil, don't bother parsing after finding that
-many new errors.
-It should read in the source files which have errors and set
-`compilation-error-list' to a list with an element for each error message
-found. See that variable for more info.")
+(defvar compilation-first-column 1
+ "*This is how compilers number the first column, usually 1 or 0.")
(defvar compilation-parse-errors-filename-function nil
"Function to call to post-process filenames while parsing error messages.
;;;###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
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 <hpj@ximian.com> for his regexp wisdom.
- ("^==[0-9]+==[^(]+\(([^:]+):([0-9]+)" 1 2)
-
- ;; 4.3BSD lint pass 2
- ;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)
- (".*[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$"
- 1 2)
-
- ;; 4.3BSD lint pass 3
- ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used
- ;; This used to be
- ;; ("[ \t(]+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2)
- ;; which is regexp Impressionism - it matches almost anything!
- (".*([ \t]*\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2)
-
- ;; MIPS lint pass<n>; looks good for SunPro lint also
- ;; TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomon.c due to truncation
- ("[^\n ]+ (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
- ;; name defined but never used: LinInt in cmap_calc.c(199)
- (".*in \\([^(\n]+\\)(\\([0-9]+\\))$" 1 2)
-
- ;; 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 </geroup>, got </group>
- ;; in unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml
- ("Error:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)"
- 3 1 2)
- ;; Warning: Start tag for undeclared element geroup
- ;; in unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml
- ("Warning:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)"
+ (bash
+ "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
+
+ (borland
+ "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\
+\\([a-zA-Z]?:?[^:( \t\n]+\\)\
+ \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
+
+ (caml
+ "^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
+\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)"
+ 2 (3 . 4) (5 . 6) (7))
+
+ (comma
+ "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
+\\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
+
+ (epc
+ "^Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1)
+
+ (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:]_/]+: \\(?:[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:]*\\): ?\
+\\([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 at line \\([0-9]+\\), column \\([0-9]+\\), 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)
+
+ ;; Redundant with `mips'
+;; (ultrix
+;; "^\\(?:cfe\\|fort\\): \\(Warning\\)?[^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3 nil (1))
+
+ (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"
+ ,(concat doc-directory "compilation.txt"))
+ :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.
: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.
(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.
and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
write into the compilation buffer, and to put in its mode line.")
+(defvar compilation-environment nil
+ "*List of environment variables for compilation to inherit.
+Each element should be a string of the form ENVVARNAME=VALUE.
+This list is temporarily prepended to `process-environment' prior to
+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
+ '((((type tty) (class color)) (:foreground "cyan" :weight bold))
+ (((class color)) (:foreground "Orange" :weight bold))
+ (t (:weight bold)))
+ "Face used to highlight compiler warnings."
+ :group 'font-lock-highlighting-faces
+ :version "21.4")
+
+(defface compilation-info-face
+ '((((type tty) (class color)) (:foreground "green" :weight bold))
+ (((class color) (background light)) (:foreground "Green3" :weight bold))
+ (((class color) (background dark)) (:foreground "Green" :weight bold))
+ (t (:weight bold)))
+ "Face used to highlight compiler warnings."
+ :group 'font-lock-highlighting-faces
+ :version "21.4")
+
+(defvar compilation-message-face nil
+ "Face name to use for whole messages.
+Faces `compilation-error-face', `compilation-warning-face',
+`compilation-info-face', `compilation-line-face' and
+`compilation-column-face' get prepended to this, when applicable.")
+
+(defvar compilation-error-face 'font-lock-warning-face
+ "Face name to use for file name in error messages.")
+
+(defvar compilation-warning-face 'compilation-warning-face
+ "Face name to use for file name in warning messages.")
+
+(defvar compilation-info-face 'compilation-info-face
+ "Face name to use for file name in informational messages.")
+
+(defvar compilation-line-face 'font-lock-variable-name-face
+ "Face name to use for line number in message.")
+
+(defvar compilation-column-face 'font-lock-type-face
+ "Face name to use for column number in message.")
+
+;; same faces as dired uses
+(defvar compilation-enter-directory-face 'font-lock-function-name-face
+ "Face name to use for column number in message.")
+
+(defvar compilation-leave-directory-face 'font-lock-type-face
+ "Face name to use for column number in message.")
+
+
+
+;; Used for compatibility with the old compile.el.
+(defvar compilation-parsing-end (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)))
+ (and col
+ (setq col (match-string-no-properties col))
+ (setq col (- (string-to-number col) compilation-first-column)))
+ (if (and end-col (setq end-col (match-string-no-properties end-col)))
+ (setq end-col (- (string-to-number end-col) compilation-first-column))
+ (if end-line (setq end-col -1)))
+ (if (consp type) ; not a 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-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 (FILENAME . DIRNAME) or nil."
+ (unless file (setq file '("*unknown*")))
+ (setq file (or (gethash file compilation-locs)
+ (puthash file (list file fmt) compilation-locs)))
+ ;; 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
+ marker-line)
+ (catch 'marker ; find nearest loc, at least one exists
+ (dolist (x (cddr file)) ; loop over lines
+ (if (> (or (car x) 1) loc) ; still bigger
+ (setq marker-line x)
+ (if (or (not marker-line) ; first in list
+ (> (- (or (car marker-line) 1) loc)
+ (- loc (or (car x) 1)))) ; current line is nearer
+ (setq marker-line x))
+ (throw 'marker t))))
+ (setq marker (nth 3 (cadr marker-line))
+ marker-line (car marker-line))
+ (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 (< end-col 0)
+ (end-of-line)
+ (if compilation-error-screen-columns
+ (move-to-column end-col)
+ (forward-char end-col)))
+ (setq end-marker (list (point-marker))))
+ (beginning-of-line (if end-line
+ (- end-line line -1)
+ (- loc marker-line -1)))
+ (if col
+ (if compilation-error-screen-columns
+ (move-to-column col)
+ (forward-char col))
+ (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))
+
+ `(,(nth 0 item)
+
+ ,@(when (integerp file)
+ `((,file ,(if (consp type)
+ `(compilation-face ',type)
+ (aref [compilation-info-face
+ compilation-warning-face
+ compilation-error-face]
+ (or type 2))))))
+
+ ,@(when line
+ `((,line compilation-line-face nil t)))
+ ,@(when end-line
+ `((,end-line compilation-line-face nil t)))
+
+ ,@(when col
+ `((,col compilation-column-face nil t)))
+ ,@(when end-col
+ `((,end-col compilation-column-face nil t)))
+
+ ,@(nthcdr 6 item)
+ (,(or (nth 5 item) 0)
+ (compilation-error-properties ',file ,line ,end-line
+ ,col ,end-col ',(or type 2)
+ ',fmt)
+ append))))) ; for compilation-message-face
+ compilation-error-regexp-alist)
+
+ compilation-mode-font-lock-keywords)))
+
\f
;;;###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.
-To run more than one compilation at once, start one and rename the
-\`*compilation*' buffer to some other name with \\[rename-buffer].
-Then start the next one.
+To run more than one compilation at once, start one and rename
+the \`*compilation*' buffer to some other name with
+\\[rename-buffer]. Then start the next one. On most systems,
+termination of the main compilation process kills its
+subprocesses.
The name used for the buffer is actually whatever is returned by
the function in `compilation-buffer-name-function', so you can set that
(interactive
(if (or compilation-read-command current-prefix-arg)
(list (read-from-minibuffer "Compile command: "
- (eval compile-command) nil nil
- '(compile-history . 1)))
+ (eval compile-command) nil nil
+ '(compile-history . 1)))
(list (eval compile-command))))
(unless (equal command (eval compile-command))
(setq compile-command command))
(save-some-buffers (not compilation-ask-about-save) nil)
- (compile-internal command "No more errors"))
+ (setq compilation-directory default-directory)
+ (compilation-start command comint))
;; run compile with the default command line
(defun recompile ()
"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 " <C>" (substring grep-command glen))))
- (cond ((eq grep-find-use-xargs 'gnu)
- (format "%s <D> <X> -type f <F> -print0 | xargs -0 -e %s <R>"
- find-program gcmd))
- (grep-find-use-xargs
- (format "%s <D> <X> -type f <F> -print | xargs %s <R>"
- find-program gcmd))
- (t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;"
- find-program gcmd null-device)))))))
-
-(defun grep-default-command ()
- (let ((tag-default
- (funcall (or find-tag-default-function
- (get major-mode 'find-tag-default-function)
- ;; We use grep-tag-default instead of
- ;; find-tag-default, to avoid loading etags.
- 'grep-tag-default)))
- (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
- (grep-default (or (car grep-history) grep-command)))
- ;; Replace the thing matching for with that around cursor.
- (when (or (string-match
- (concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*"
- sh-arg-re "\\(\\s +\\(\\S +\\)\\)?")
- grep-default)
- ;; If the string is not yet complete.
- (string-match "\\(\\)\\'" grep-default))
- (unless (or (not (stringp buffer-file-name))
- (when (match-beginning 2)
- (save-match-data
- (string-match
- (wildcard-to-regexp
- (file-name-nondirectory
- (match-string 3 grep-default)))
- (file-name-nondirectory buffer-file-name)))))
- (setq grep-default (concat (substring grep-default
- 0 (match-beginning 2))
- " *."
- (file-name-extension buffer-file-name))))
- (replace-match (or tag-default "") t t grep-default 1))))
-
-;;;###autoload
-(defun grep (command-args)
- "Run grep, with user-specified args, and collect output in a buffer.
-While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
-or \\<compilation-minor-mode-map>\\[compile-goto-error] in the grep \
-output buffer, to go to the lines
-where grep found matches.
-
-This command uses a special history list for its COMMAND-ARGS, so you can
-easily repeat a grep command.
-
-A prefix argument says to default the argument based upon the current
-tag the cursor is over, substituting it into the last grep command
-in the grep command history (or into `grep-command'
-if that history list is empty)."
- (interactive
- (progn
- (unless (and grep-command
- (or (not grep-use-null-device) (eq grep-use-null-device t)))
- (grep-compute-defaults))
- (let ((default (grep-default-command)))
- (list (read-from-minibuffer "Run grep (like this): "
- (if current-prefix-arg
- default grep-command)
- nil nil 'grep-history
- (if current-prefix-arg nil default))))))
-
- ;; Setting process-setup-function makes exit-message-function work
- ;; even when async processes aren't supported.
- (let* ((compilation-process-setup-function 'grep-process-setup)
- (buf (compile-internal (if (and grep-use-null-device null-device)
- (concat command-args " " null-device)
- command-args)
- "No more grep hits" "grep"
- ;; Give it a simpler regexp to match.
- nil grep-regexp-alist)))))
-
-;; This is a copy of find-tag-default from etags.el.
-(defun grep-tag-default ()
- (save-excursion
- (while (looking-at "\\sw\\|\\s_")
- (forward-char 1))
- (when (or (re-search-backward "\\sw\\|\\s_"
- (save-excursion (beginning-of-line) (point))
- t)
- (re-search-forward "\\(\\sw\\|\\s_\\)+"
- (save-excursion (end-of-line) (point))
- t))
- (goto-char (match-end 0))
- (buffer-substring (point)
- (progn (forward-sexp -1)
- (while (looking-at "\\s'")
- (forward-char 1))
- (point))))))
-
-;;;###autoload
-(defun grep-find (command-args)
- "Run grep via find, with user-specified args COMMAND-ARGS.
-Collect output in a buffer.
-While find runs asynchronously, you can use the \\[next-error] command
-to find the text that grep hits refer to.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a find command."
- (interactive
- (progn
- (unless grep-find-command
- (grep-compute-defaults))
- (list (read-from-minibuffer "Run find (like this): "
- grep-find-command nil nil
- 'grep-find-history))))
- (let ((null-device nil)) ; see grep
- (grep command-args)))
-
-(defun grep-expand-command-macros (command &optional regexp files dir excl case-fold)
- "Patch grep COMMAND replacing <D>, etc."
- (setq command
- (replace-regexp-in-string "<D>"
- (or dir ".") command t t))
- (setq command
- (replace-regexp-in-string "<X>"
- (or excl "") command t t))
- (setq command
- (replace-regexp-in-string "<F>"
- (or files "") command t t))
- (setq command
- (replace-regexp-in-string "<C>"
- (if case-fold "-i" "") command t t))
- (setq command
- (replace-regexp-in-string "<R>"
- (or regexp "") command t t))
- command)
-
-(defvar grep-tree-last-regexp "")
-(defvar grep-tree-last-files (car (car grep-tree-files-aliases)))
-
-;;;###autoload
-(defun grep-tree (regexp files dir &optional subdirs)
- "Grep for REGEXP in FILES in directory tree rooted at DIR.
-Collect output in a buffer.
-Interactively, prompt separately for each search parameter.
-With prefix arg, reuse previous REGEXP.
-The search is limited to file names matching shell pattern FILES.
-FILES may use abbreviations defined in `grep-tree-files-aliases', e.g.
-entering `ch' is equivalent to `*.[ch]'.
-
-While find runs asynchronously, you can use the \\[next-error] command
-to find the text that grep hits refer to.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a find command.
-
-When used non-interactively, optional arg SUBDIRS limits the search to
-those sub directories of DIR."
- (interactive
- (let* ((regexp
- (if current-prefix-arg
- grep-tree-last-regexp
- (let* ((default (current-word))
- (spec (read-string
- (concat "Search for"
- (if (and default (> (length default) 0))
- (format " (default %s): " default) ": ")))))
- (if (equal spec "") default spec))))
- (files
- (read-string (concat "Search for \"" regexp "\" in files (default " grep-tree-last-files "): ")))
- (dir
- (read-directory-name "Base directory: " nil default-directory t)))
- (list regexp files dir)))
- (unless grep-tree-command
- (grep-compute-defaults))
- (unless (and (stringp files) (> (length files) 0))
- (setq files grep-tree-last-files))
- (when files
- (setq grep-tree-last-files files)
- (let ((mf (assoc files grep-tree-files-aliases)))
- (if mf
- (setq files (cdr mf)))))
- (let ((command-args (grep-expand-command-macros
- grep-tree-command
- (setq grep-tree-last-regexp regexp)
- (and files (concat "-name '" files "'"))
- (if subdirs
- (if (stringp subdirs)
- subdirs
- (mapconcat 'identity subdirs " "))
- nil) ;; we change default-directory to dir
- (and grep-tree-ignore-CVS-directories "-path '*/CVS' -prune -o ")
- grep-tree-ignore-case))
- (default-directory dir)
- (null-device nil)) ; see grep
- (grep command-args)))
+ (let ((default-directory (or compilation-directory default-directory)))
+ (apply 'compilation-start (or compilation-arguments
+ `(,(eval compile-command))))))
(defcustom compilation-scroll-output nil
"*Non-nil to scroll the *compilation* buffer window as output appears.
-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)
(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.
+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))))
+ (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"))
+ process-environment))
+ (thisdir default-directory)
+ outwin outbuf)
+ (with-current-buffer
+ (setq outbuf
+ (get-buffer-create
+ (compilation-buffer-name name-of-mode name-function)))
(let ((comp-proc (get-buffer-process (current-buffer))))
(if comp-proc
(if (or (not (eq (process-status comp-proc) 'run))
(delete-process comp-proc))
(error nil))
(error "Cannot have two processes in `%s' at once"
- (buffer-name))
- )))
- ;; In case the compilation buffer is current, make sure we get the global
- ;; values of compilation-error-regexp-alist, etc.
- (kill-all-local-variables))
- (or error-regexp-alist
- (setq error-regexp-alist compilation-error-regexp-alist))
- (or enter-regexp-alist
- (setq enter-regexp-alist compilation-enter-directory-regexp-alist))
- (or leave-regexp-alist
- (setq leave-regexp-alist compilation-leave-directory-regexp-alist))
- (or file-regexp-alist
- (setq file-regexp-alist compilation-file-regexp-alist))
- (or nomessage-regexp-alist
- (setq nomessage-regexp-alist compilation-nomessage-regexp-alist))
- (or parser (setq parser compilation-parse-errors-function))
- (let ((thisdir default-directory)
- outwin)
- (save-excursion
- ;; Clear out the compilation buffer and make it writable.
- ;; Change its default-directory to the directory where the compilation
- ;; will happen, and insert a `cd' command to indicate this.
- (set-buffer outbuf)
- (setq buffer-read-only nil)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (buffer-enable-undo (current-buffer))
- (setq default-directory thisdir)
- (insert "cd " thisdir "\n" command "\n")
- (set-buffer-modified-p nil))
- ;; If we're already in the compilation buffer, go to the end
- ;; of the buffer, so point will track the compilation output.
- (if (eq outbuf (current-buffer))
- (goto-char (point-max)))
- ;; Pop up the compilation buffer.
- (setq outwin (display-buffer outbuf nil t))
- (with-current-buffer outbuf
- (compilation-mode name-of-mode)
- ;; In what way is it non-ergonomic ? -stef
- ;; (toggle-read-only 1) ;;; Non-ergonomic.
- (set (make-local-variable 'compilation-parse-errors-function) parser)
- (set (make-local-variable 'compilation-error-message) error-message)
- (set (make-local-variable 'compilation-error-regexp-alist)
- error-regexp-alist)
- (set (make-local-variable 'compilation-enter-directory-regexp-alist)
- enter-regexp-alist)
- (set (make-local-variable 'compilation-leave-directory-regexp-alist)
- leave-regexp-alist)
- (set (make-local-variable 'compilation-file-regexp-alist)
- file-regexp-alist)
- (set (make-local-variable 'compilation-nomessage-regexp-alist)
- nomessage-regexp-alist)
- (set (make-local-variable 'compilation-arguments)
- (list command error-message
- name-of-mode parser
- error-regexp-alist name-function
- enter-regexp-alist leave-regexp-alist
- file-regexp-alist nomessage-regexp-alist))
- ;; This proves a good idea if the buffer's going to scroll
- ;; with lazy-lock on.
- (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)
- (setq default-directory thisdir
- compilation-directory-stack (list default-directory))
- (set-window-start outwin (point-min))
- (or (eq outwin (selected-window))
- (set-window-point outwin (point-min)))
- (compilation-set-window-height outwin)
- (if compilation-process-setup-function
- (funcall compilation-process-setup-function))
- ;; Start the compilation.
- (if (not no-async)
- (let* ((process-environment
- (append
- (if (and (boundp 'system-uses-terminfo)
- system-uses-terminfo)
- (list "TERM=dumb" "TERMCAP="
- (format "COLUMNS=%d" (window-width)))
- (list "TERM=emacs"
- (format "TERMCAP=emacs:co#%d:tc=unknown:"
- (window-width))))
- ;; Set the EMACS variable, but
- ;; don't override users' setting of $EMACS.
- (if (getenv "EMACS")
- process-environment
- (cons "EMACS=t" process-environment))))
- (proc (start-process-shell-command (downcase mode-name)
- outbuf
- command)))
- (set-process-sentinel proc 'compilation-sentinel)
- (set-process-filter proc 'compilation-filter)
- (set-marker (process-mark proc) (point) outbuf)
- (setq compilation-in-progress
- (cons proc compilation-in-progress)))
- ;; No asynchronous processes available.
- (message "Executing `%s'..." command)
- ;; Fake modeline display as if `start-process' were run.
- (setq mode-line-process ":run")
- (force-mode-line-update)
- (sit-for 0) ; Force redisplay
- (let ((status (call-process shell-file-name nil outbuf nil "-c"
- command)))
- (cond ((numberp status)
- (compilation-handle-exit 'exit status
- (if (zerop status)
- "finished\n"
- (format "\
+ (buffer-name)))))
+ ;; Clear out the compilation buffer and make it writable.
+ ;; Change its default-directory to the directory where the compilation
+ ;; will happen, and insert a `cd' command to indicate this.
+ (setq buffer-read-only nil)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (buffer-enable-undo (current-buffer))
+ (setq default-directory thisdir)
+ ;; output a mode setter, for saving and later reloading this buffer
+ (insert "cd " thisdir " # -*-" name-of-mode
+ "-*-\nEntering directory `" thisdir "'\n" command "\n")
+ (set-buffer-modified-p nil))
+ ;; If we're already in the compilation buffer, go to the end
+ ;; of the buffer, so point will track the compilation output.
+ (if (eq outbuf (current-buffer))
+ (goto-char (point-max)))
+ ;; Pop up the compilation buffer.
+ (setq outwin (display-buffer outbuf nil t))
+ (with-current-buffer outbuf
+ (if (not (eq mode t))
+ (funcall mode)
+ (with-no-warnings (comint-mode))
+ (compilation-shell-minor-mode))
+ ;; In what way is it non-ergonomic ? -stef
+ ;; (toggle-read-only 1) ;;; Non-ergonomic.
+ (if highlight-regexp
+ (set (make-local-variable 'compilation-highlight-regexp)
+ highlight-regexp))
+ (set (make-local-variable 'compilation-arguments)
+ (list command mode name-function highlight-regexp))
+ (set (make-local-variable 'revert-buffer-function)
+ 'compilation-revert-buffer)
+ (set-window-start outwin (point-min))
+ (or (eq outwin (selected-window))
+ (set-window-point outwin (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 (fboundp 'start-process)
+ (let ((proc (if (eq mode t)
+ (get-buffer-process
+ (with-no-warnings
+ (comint-exec outbuf (downcase mode-name)
+ shell-file-name nil `("-c" ,command))))
+ (start-process-shell-command (downcase mode-name)
+ outbuf command))))
+ ;; Make the buffer's mode line show process state.
+ (setq mode-line-process '(":%s"))
+ (set-process-sentinel proc 'compilation-sentinel)
+ (set-process-filter proc 'compilation-filter)
+ (set-marker (process-mark proc) (point) outbuf)
+ (setq compilation-in-progress
+ (cons proc compilation-in-progress)))
+ ;; No asynchronous processes available.
+ (message "Executing `%s'..." command)
+ ;; Fake modeline display as if `start-process' were run.
+ (setq mode-line-process ":run")
+ (force-mode-line-update)
+ (let ((status (call-process shell-file-name nil outbuf nil "-c"
+ command)))
+ (cond ((numberp status)
+ (compilation-handle-exit 'exit status
+ (if (zerop status)
+ "finished\n"
+ (format "\
exited abnormally with code %d\n"
- status))))
- ((stringp status)
- (compilation-handle-exit 'signal status
- (concat status "\n")))
- (t
- (compilation-handle-exit 'bizarre status status))))
- (message "Executing `%s'...done" command)))
- (if compilation-scroll-output
- (save-selected-window
- (select-window outwin)
- (goto-char (point-max)))))
+ status))))
+ ((stringp status)
+ (compilation-handle-exit 'signal status
+ (concat status "\n")))
+ (t
+ (compilation-handle-exit 'bizarre status status))))
+ (message "Executing `%s'...done" command)))
+ (if (buffer-local-value 'compilation-scroll-output outbuf)
+ (save-selected-window
+ (select-window outwin)
+ (goto-char (point-max))))
;; Make it so the next C-x ` will use this buffer.
- (setq compilation-last-buffer outbuf)))
+ (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))))
+ ;; This save-current-buffer prevents us from changing the current
+ ;; buffer, which might not be the same as the selected window's buffer.
+ (save-current-buffer
+ (save-selected-window
+ (select-window window)
+ (enlarge-window (- height (window-height))))))))
(defvar compilation-menu-map
(let ((map (make-sparse-keymap "Errors")))
'("Stop Compilation" . kill-compilation))
(define-key map [compilation-mode-separator2]
'("----" . nil))
- (define-key map [compilation-mode-first-error]
+ (define-key map [compilation-first-error]
'("First Error" . first-error))
- (define-key map [compilation-mode-previous-error]
+ (define-key map [compilation-previous-error]
'("Previous Error" . previous-error))
- (define-key map [compilation-mode-next-error]
+ (define-key map [compilation-next-error]
'("Next Error" . next-error))
map))
(defvar compilation-minor-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'compile-mouse-goto-error)
+ (define-key map [mouse-2] 'compile-goto-error)
(define-key map "\C-c\C-c" 'compile-goto-error)
(define-key map "\C-m" 'compile-goto-error)
(define-key map "\C-c\C-k" 'kill-compilation)
(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)
map)
"Keymap for `compilation-shell-minor-mode'.")
+(defvar compilation-button-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'compile-goto-error)
+ (define-key map "\C-m" 'compile-goto-error)
+ map)
+ "Keymap for compilation-message buttons.")
+(fset 'compilation-button-map compilation-button-map)
+
(defvar compilation-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map compilation-minor-mode-map)
(define-key map " " 'scroll-up)
(define-key map "\^?" 'scroll-down)
+
;; Set up the menu-bar
(define-key map [menu-bar compilation]
(cons "Compile" (make-sparse-keymap "Compile")))
(define-key map [menu-bar compilation compilation-separator2]
'("----" . nil))
- (define-key map [menu-bar compilation compilation-mode-grep]
+ (define-key map [menu-bar compilation compilation-grep]
'("Search Files (grep)" . grep))
- (define-key map [menu-bar compilation compilation-mode-recompile]
+ (define-key map [menu-bar compilation compilation-recompile]
'("Recompile" . recompile))
- (define-key map [menu-bar compilation compilation-mode-compile]
+ (define-key map [menu-bar compilation compilation-compile]
'("Compile..." . compile))
map)
"Keymap for compilation log buffers.
(put 'compilation-mode 'mode-class 'special)
+(defvar compilation-skip-to-next-location t
+ "*If non-nil, skip multiple error messages for the same source location.")
+
+(defcustom compilation-skip-threshold 1
+ "*Compilation motion commands skip less important messages.
+The value can be either 2 -- skip anything less than error, 1 --
+skip anything less than warning or 0 -- don't skip any messages.
+Note that all messages not positively identified as warning or
+info, are considered errors."
+ :type '(choice (const :tag "Warnings and info" 2)
+ (const :tag "Info" 1)
+ (const :tag "None" 0))
+ :group 'compilation
+ :version "21.4")
+
+(defcustom compilation-skip-visited nil
+ "*Compilation motion commands skip visited messages if this is t.
+Visited messages are ones for which the file, line and column have been jumped
+to from the current content in the current compilation buffer, even if it was
+from a different message."
+ :type 'boolean
+ :group 'compilation
+ :version "21.4")
+
;;;###autoload
-(defun compilation-mode (&optional name-of-mode)
+(defun compilation-mode ()
"Major mode for compilation log buffers.
\\<compilation-mode-map>To visit the source for a line-numbered error,
move point to the error message line and type \\[compile-goto-error].
(kill-all-local-variables)
(use-local-map compilation-mode-map)
(setq major-mode 'compilation-mode
- mode-name (or name-of-mode "Compilation"))
+ mode-name "Compilation")
+ (set (make-local-variable 'page-delimiter)
+ compilation-page-delimiter)
(compilation-setup)
- (set (make-local-variable 'font-lock-defaults)
- '(compilation-mode-font-lock-keywords t))
- (set (make-local-variable 'revert-buffer-function)
- 'compilation-revert-buffer)
- (run-hooks 'compilation-mode-hook))
+ ;; 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)
+ (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.")
+
+;; 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-error-screen-columns)
- (setq compilation-last-buffer (current-buffer)))
+ (make-local-variable 'overlay-arrow-position)
+ (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
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
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."
+ "Write MSG in the current buffer and hack its mode-line-process."
(let ((buffer-read-only nil)
(status (if compilation-exit-message-function
(funcall compilation-exit-message-function
(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))
(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))
;; 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).
(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 (> n 0)
- ;; Discard the current error and any previous.
- (while (>= (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