|
0
|
1 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
|
|
|
2
|
|
2
|
3 ;; Copyright (C) 1985, 86, 87, 93, 94, 1995, 1996 Free Software Foundation, Inc.
|
|
0
|
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
|
|
|
5
|
|
|
6 ;; Author: Roland McGrath <roland@prep.ai.mit.edu>
|
|
|
7 ;; Maintainer: FSF
|
|
|
8 ;; Keywords: tools, processes
|
|
|
9
|
|
|
10 ;; This file is part of XEmacs.
|
|
|
11
|
|
|
12 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
13 ;; under the terms of the GNU General Public License as published by
|
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;; any later version.
|
|
|
16
|
|
|
17 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
20 ;; General Public License for more details.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
|
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
2
|
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
25 ;; 02111-1307, USA.
|
|
0
|
26
|
|
2
|
27 ;;; Synched up with: FSF 19.34, with a lot of divergence.
|
|
0
|
28
|
|
|
29 ;;; Commentary:
|
|
|
30
|
|
|
31 ;; This package provides the compile and grep facilities documented in
|
|
|
32 ;; the Emacs user's manual.
|
|
|
33
|
|
|
34 ;;; Code:
|
|
|
35
|
|
120
|
36 (defgroup compilation nil
|
|
189
|
37 "Run compiler as inferior of Emacs, parse error messages."
|
|
|
38 :group 'programming
|
|
|
39 :group 'tools
|
|
|
40 :group 'processes)
|
|
120
|
41
|
|
0
|
42
|
|
|
43 ;;;###autoload
|
|
120
|
44 (defcustom compilation-mode-hook nil
|
|
|
45 "*List of hook functions run by `compilation-mode' (see `run-hooks')."
|
|
|
46 :type 'hook
|
|
|
47 :group 'compilation)
|
|
|
48
|
|
|
49 ;;;###autoload
|
|
|
50 (defcustom compilation-window-height nil
|
|
|
51 "*Number of lines in a compilation window. If nil, use Emacs default."
|
|
|
52 :type '(choice (const nil)
|
|
|
53 integer)
|
|
|
54 :group 'compilation)
|
|
0
|
55
|
|
2
|
56 ;; XEmacs change
|
|
0
|
57 (defvar compilation-error-list 'invalid ; only valid buffer-local
|
|
|
58 "List of error message descriptors for visiting erring functions.
|
|
|
59 Each error descriptor is a cons (or nil). Its car is a marker pointing to
|
|
|
60 an error message. If its cdr is a marker, it points to the text of the
|
|
|
61 line the message is about. If its cdr is a cons, it is a list
|
|
|
62 \(\(DIRECTORY . FILE\) LINE [COLUMN]\). Or its cdr may be nil if that
|
|
|
63 error is not interesting.
|
|
|
64
|
|
|
65 The value may be t instead of a list; this means that the buffer of
|
|
|
66 error messages should be reparsed the next time the list of errors is wanted.
|
|
|
67
|
|
|
68 Some other commands (like `diff') use this list to control the error
|
|
2
|
69 message tracking facilities; if you change its structure, you should make
|
|
0
|
70 sure you also change those packages. Perhaps it is better not to change
|
|
|
71 it at all.")
|
|
|
72
|
|
|
73 (defvar compilation-old-error-list nil
|
|
|
74 "Value of `compilation-error-list' after errors were parsed.")
|
|
|
75
|
|
|
76 (defvar compilation-parse-errors-function 'compilation-parse-errors
|
|
|
77 "Function to call to parse error messages from a compilation.
|
|
|
78 It takes args LIMIT-SEARCH and FIND-AT-LEAST.
|
|
|
79 If LIMIT-SEARCH is non-nil, don't bother parsing past that location.
|
|
|
80 If FIND-AT-LEAST is non-nil, don't bother parsing after finding that
|
|
|
81 many new errors.
|
|
|
82 It should read in the source files which have errors and set
|
|
|
83 `compilation-error-list' to a list with an element for each error message
|
|
|
84 found. See that variable for more info.")
|
|
|
85
|
|
|
86 ;;;###autoload
|
|
120
|
87 (defcustom compilation-buffer-name-function nil
|
|
0
|
88 "Function to compute the name of a compilation buffer.
|
|
|
89 The function receives one argument, the name of the major mode of the
|
|
|
90 compilation buffer. It should return a string.
|
|
120
|
91 nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'."
|
|
|
92 :type 'function
|
|
|
93 :group 'compilation)
|
|
0
|
94
|
|
|
95 ;;;###autoload
|
|
120
|
96 (defcustom compilation-finish-function nil
|
|
0
|
97 "*Function to call when a compilation process finishes.
|
|
|
98 It is called with two arguments: the compilation buffer, and a string
|
|
120
|
99 describing how the process finished."
|
|
|
100 :type 'function
|
|
|
101 :group 'compilation)
|
|
0
|
102
|
|
|
103 (defvar compilation-last-buffer nil
|
|
|
104 "The most recent compilation buffer.
|
|
|
105 A buffer becomes most recent when its compilation is started
|
|
|
106 or when it is used with \\[next-error] or \\[compile-goto-error].")
|
|
|
107
|
|
|
108 (defvar compilation-in-progress nil
|
|
|
109 "List of compilation processes now running.")
|
|
|
110 (or (assq 'compilation-in-progress minor-mode-alist)
|
|
|
111 (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
|
|
|
112 minor-mode-alist)))
|
|
|
113
|
|
2
|
114 ;; XEmacs change
|
|
120
|
115 (defcustom compilation-always-signal-completion nil
|
|
|
116 "*Always give an audible signal upon compilation completion.
|
|
0
|
117 By default that signal is only given if the bottom of the compilation
|
|
120
|
118 buffer is not visible in its window."
|
|
|
119 :type 'boolean
|
|
|
120 :group 'compilation)
|
|
0
|
121
|
|
|
122 (defvar compilation-parsing-end nil
|
|
|
123 "Position of end of buffer when last error messages were parsed.")
|
|
|
124
|
|
|
125 (defvar compilation-error-message "No more errors"
|
|
|
126 "Message to print when no more matches are found.")
|
|
|
127
|
|
|
128 (defvar compilation-num-errors-found)
|
|
|
129
|
|
116
|
130 (defun compilation-build-compilation-error-regexp-alist ()
|
|
213
|
131 "Set the regular expressions used for parsing compiler
|
|
|
132 errors based on the compilers listed in the variable
|
|
|
133 `compilation-error-regexp-systems-list'. Updates the
|
|
|
134 variable `compilation-error-regexp-alist'."
|
|
116
|
135 (interactive)
|
|
|
136 (setq compilation-error-regexp-alist
|
|
|
137 (apply 'append
|
|
|
138 (mapcar
|
|
|
139 '(lambda (elt)
|
|
|
140 (if (or (not (consp compilation-error-regexp-systems-list))
|
|
|
141 (and (consp (car elt))
|
|
|
142 (intersection (car elt)
|
|
|
143 compilation-error-regexp-systems-list))
|
|
|
144 (memq (car elt) compilation-error-regexp-systems-list))
|
|
|
145 (cdr elt)
|
|
|
146 nil))
|
|
|
147 compilation-error-regexp-alist-alist))))
|
|
|
148
|
|
|
149 (defvar compilation-error-regexp-alist-alist
|
|
0
|
150 '(
|
|
|
151 ;; NOTE! See also grep-regexp-alist, below.
|
|
|
152
|
|
|
153 ;; 4.3BSD grep, cc, lint pass 1:
|
|
|
154 ;; /usr/src/foo/foo.c(8): warning: w may be used before set
|
|
|
155 ;; or GNU utilities:
|
|
|
156 ;; foo.c:8: error message
|
|
|
157 ;; or HP-UX 7.0 fc:
|
|
|
158 ;; foo.f :16 some horrible error message
|
|
|
159 ;; or GNU utilities with column (GNAT 1.82):
|
|
|
160 ;; foo.adb:2:1: Unit name does not match file name
|
|
|
161 ;;
|
|
|
162 ;; We'll insist that the number be followed by a colon or closing
|
|
|
163 ;; paren, because otherwise this matches just about anything
|
|
|
164 ;; containing a number with spaces around it.
|
|
116
|
165 ((4bsd gnu)
|
|
88
|
166 ("\
|
|
2
|
167 \\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
|
|
0
|
168 :\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5)
|
|
116
|
169 )
|
|
0
|
170
|
|
2
|
171 ;; Microsoft C/C++:
|
|
|
172 ;; keyboard.c(537) : warning C4005: 'min' : macro redefinition
|
|
|
173 ;; d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if'
|
|
116
|
174 (msft
|
|
88
|
175 ("\\(\\([a-zA-Z]:\\)?[^:( \t\n-]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" 1 3)
|
|
116
|
176 )
|
|
2
|
177
|
|
0
|
178 ;; Borland C++:
|
|
|
179 ;; Error ping.c 15: Unable to open include file 'sys/types.h'
|
|
|
180 ;; Warning ping.c 68: Call to function 'func' with no prototype
|
|
116
|
181 (borland
|
|
88
|
182 ("\\(Error\\|Warning\\) \\([a-zA-Z]?:?[^:( \t\n]+\\)\
|
|
0
|
183 \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 2 3)
|
|
116
|
184 )
|
|
0
|
185
|
|
|
186 ;; 4.3BSD lint pass 2
|
|
|
187 ;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)
|
|
116
|
188 (4bsd
|
|
88
|
189 ("[^\n]*[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$"
|
|
2
|
190 1 2)
|
|
116
|
191 )
|
|
0
|
192
|
|
|
193 ;; 4.3BSD lint pass 3
|
|
|
194 ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used
|
|
|
195 ;; This used to be
|
|
2
|
196 ;; ("[ \t(]+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2)
|
|
0
|
197 ;; which is regexp Impressionism - it matches almost anything!
|
|
116
|
198 (4bsd
|
|
88
|
199 ("[^\n]*([ \t]*\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2)
|
|
116
|
200 )
|
|
2
|
201
|
|
|
202 ;; MIPS lint pass<n>; looks good for SunPro lint also
|
|
|
203 ;; TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomon.c due to truncation
|
|
116
|
204 (mips
|
|
88
|
205 ("[^ \n]+ (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
|
|
2
|
206 ;; name defined but never used: LinInt in cmap_calc.c(199)
|
|
88
|
207 ("[^\n]*in \\([^(\n]+\\)(\\([0-9]+\\))$" 1 2)
|
|
116
|
208 )
|
|
0
|
209
|
|
|
210 ;; Ultrix 3.0 f77:
|
|
|
211 ;; fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol
|
|
|
212 ;; Some SGI cc version:
|
|
|
213 ;; cfe: Warning 835: foo.c, line 2: something
|
|
116
|
214 ((sgi ultrix)
|
|
88
|
215 ("\\(cfe\\|fort\\): [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3)
|
|
116
|
216 )
|
|
0
|
217 ;; Error on line 3 of t.f: Execution error unclassifiable statement
|
|
|
218 ;; Unknown who does this:
|
|
2
|
219 ;; Line 45 of "foo.c": bloofle undefined
|
|
0
|
220 ;; Absoft FORTRAN 77 Compiler 3.1.3
|
|
|
221 ;; error on line 19 of fplot.f: spelling error?
|
|
|
222 ;; warning on line 17 of fplot.f: data type is undefined for variable d
|
|
116
|
223 (of
|
|
88
|
224 ("\\(\\|[^\n]* on \\)[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
|
|
2
|
225 of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
|
|
116
|
226 )
|
|
0
|
227
|
|
|
228 ;; Apollo cc, 4.3BSD fc:
|
|
|
229 ;; "foo.f", line 3: Error: syntax error near end of statement
|
|
|
230 ;; IBM RS6000:
|
|
|
231 ;; "vvouch.c", line 19.5: 1506-046 (S) Syntax error.
|
|
|
232 ;; Unknown compiler:
|
|
|
233 ;; File "foobar.ml", lines 5-8, characters 20-155: blah blah
|
|
|
234 ;; Microtec mcc68k:
|
|
|
235 ;; "foo.c", line 32 pos 1; (E) syntax error; unexpected symbol: "lossage"
|
|
|
236 ;; GNAT (as of July 94):
|
|
|
237 ;; "foo.adb", line 2(11): warning: file name does not match ...
|
|
2
|
238 ;; IBM AIX xlc compiler:
|
|
|
239 ;; "src/swapping.c", line 30.34: 1506-342 (W) "/*" detected in comment.
|
|
116
|
240 (comma
|
|
88
|
241 ("[^\n]*\"\\([^,\" \n\t]+\\)\", lines? \
|
|
2
|
242 \\([0-9]+\\)\\([\(.]\\([0-9]+\\)\)?\\)?[:., (-]" 1 2 4)
|
|
116
|
243 )
|
|
0
|
244
|
|
|
245 ;; MIPS RISC CC - the one distributed with Ultrix:
|
|
|
246 ;; ccom: Error: foo.c, line 2: syntax error
|
|
|
247 ;; DEC AXP OSF/1 cc
|
|
|
248 ;; /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah
|
|
116
|
249 ((mips ultrix)
|
|
88
|
250 ("[^\n]*rror: \\([^,\" \n\t]+\\)[,:] \\(line \\)?\\([0-9]+\\):" 1 3)
|
|
116
|
251 )
|
|
0
|
252
|
|
|
253 ;; IBM AIX PS/2 C version 1.1:
|
|
|
254 ;; ****** Error number 140 in line 8 of file errors.c ******
|
|
116
|
255 (aix
|
|
88
|
256 ("[^\n]*in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
|
|
116
|
257 )
|
|
0
|
258 ;; IBM AIX lint is too painful to do right this way. File name
|
|
|
259 ;; prefixes entire sections rather than being on each line.
|
|
|
260
|
|
|
261 ;; Lucid Compiler, lcc 3.x
|
|
|
262 ;; E, file.cc(35,52) Illegal operation on pointers
|
|
116
|
263 (lcc
|
|
88
|
264 ("[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3)
|
|
116
|
265 )
|
|
0
|
266
|
|
|
267 ;; GNU messages with program name and optional column number.
|
|
116
|
268 (gnu
|
|
88
|
269 ("[a-zA-Z]?:?[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\
|
|
0
|
270 \\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
|
|
116
|
271 )
|
|
0
|
272
|
|
88
|
273 ;; GNU messages with program name and optional column number
|
|
|
274 ;; and a severity letter after that. nsgmls makes them.
|
|
116
|
275 (gnu
|
|
88
|
276 ("[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\
|
|
|
277 \\([0-9]+\\):\\(\\([0-9]+\\):\\)?[A-Za-z]:" 1 2 4)
|
|
116
|
278 )
|
|
88
|
279
|
|
0
|
280 ;; jwz:
|
|
|
281 ;; IRIX 5.2
|
|
|
282 ;; cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ...
|
|
116
|
283 (sgi
|
|
88
|
284 ("[^\n]* \\([^ \n,\"]+\\), line \\([0-9]+\\):" 1 2)
|
|
116
|
285 )
|
|
0
|
286 ;; IRIX 5.2
|
|
|
287 ;; cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ...
|
|
116
|
288 (sgi
|
|
88
|
289 ("[^\n]*: \\([^ \n,\"]+\\): \\([0-9]+\\):" 1 2)
|
|
116
|
290 )
|
|
0
|
291
|
|
|
292 ;; Cray C compiler error messages
|
|
116
|
293 (cray
|
|
88
|
294 ("\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5)
|
|
116
|
295 )
|
|
0
|
296
|
|
|
297 ;; IBM C/C++ Tools 2.01:
|
|
|
298 ;; foo.c(2:0) : informational EDC0804: Function foo is not referenced.
|
|
|
299 ;; foo.c(3:8) : warning EDC0833: Implicit return statement encountered.
|
|
|
300 ;; foo.c(5:5) : error EDC0350: Syntax error.
|
|
116
|
301 (ibm
|
|
88
|
302 ("\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) : " 1 2 3)
|
|
116
|
303 )
|
|
0
|
304
|
|
|
305 ;; Sun ada (VADS, Solaris):
|
|
|
306 ;; /home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: "," inserted
|
|
116
|
307 (ada
|
|
88
|
308 ("\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
|
|
0
|
309 )
|
|
116
|
310 )
|
|
|
311 "Alist of (system regexp-alist) for building
|
|
|
312 `compilation-error-regexp-alist'. SYSTEM is either a system identifier,
|
|
|
313 or a list of system identifiers. See the variable
|
|
|
314 `compilation-error-regexp-systems-list'")
|
|
|
315
|
|
|
316 (defvar compilation-error-regexp-alist nil
|
|
88
|
317 "Alist that specifies how to match errors in compiler output.
|
|
0
|
318 Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...])
|
|
88
|
319 If REGEXP matches constrained to the beginning of the line, the
|
|
|
320 FILE-IDX'th subexpression gives the file name, and the LINE-IDX'th
|
|
|
321 subexpression gives the line number. If COLUMN-IDX is given, the
|
|
|
322 COLUMN-IDX'th subexpression gives the column number on that line. If
|
|
|
323 any FILE-FORMAT is given, each is a format string to produce a file name
|
|
|
324 to try; %s in the string is replaced by the text matching the
|
|
|
325 FILE-IDX'th subexpression. Note previously REGEXP was not constrained
|
|
|
326 to the beginning of the line, so old patterns without leading `^' or `\\n'
|
|
116
|
327 may now require a leading `.*'.
|
|
|
328
|
|
|
329 Note that this now gets set by the function
|
|
|
330 `compilation-build-compilation-error-regexp-alist' using the
|
|
|
331 value of the variable `compilation-error-regexp-alist-alist'")
|
|
|
332
|
|
213
|
333 (defcustom compilation-error-regexp-systems-list 'all
|
|
|
334 "*This is either the symbol `all', or a list of systems for which
|
|
|
335 compilation error regexps should be included in
|
|
|
336 `compilation-error-regexp-alist'. You must run the function
|
|
|
337 `compilation-build-compilation-error-regexp-alist' after changing
|
|
|
338 the value of this variable for the change to take effect.
|
|
|
339
|
|
|
340 The list of known systems is:
|
|
|
341 gnu: but of course
|
|
|
342 lcc: Lucid compilers
|
|
|
343 ada: Ada compilers
|
|
|
344 of: Using tool that says line xx of foo.c
|
|
|
345 comma: Using tool that says \"foo.c\", line 12
|
|
|
346 4bsd: Using 4bsd
|
|
|
347 msft: Using microsoft
|
|
|
348 borland: Using Borland
|
|
|
349 mips: Using Mips
|
|
|
350 sgi: Using SGI
|
|
|
351 cray: Using Cray
|
|
|
352 ibm: IBM C compilers
|
|
|
353 aix: the operating system
|
|
|
354 ultrix: the operating system
|
|
|
355
|
|
|
356 See also the variable `compilation-error-regexp-alist-alist'."
|
|
|
357 :type '(choice (const all)
|
|
|
358 (set :menu-tag "Pick"
|
|
|
359 (const gnu) (const lcc) (const ada)
|
|
|
360 (const of) (const comma) (const 4bsd)
|
|
|
361 (const msft) (const borland) (const mips)
|
|
|
362 (const sgi) (const cray) (const ibm)
|
|
|
363 (const aix) (const ultrix)))
|
|
|
364 :set (lambda (symbol value)
|
|
|
365 (set-default symbol value)
|
|
|
366 (compilation-build-compilation-error-regexp-alist))
|
|
|
367 :group 'compilation)
|
|
|
368
|
|
116
|
369 (compilation-build-compilation-error-regexp-alist)
|
|
0
|
370
|
|
120
|
371 (defcustom compilation-read-command t
|
|
|
372 "*If not nil, M-x compile reads the compilation command to use.
|
|
|
373 Otherwise, M-x compile just uses the value of `compile-command'."
|
|
|
374 :type 'boolean
|
|
|
375 :group 'compilation)
|
|
0
|
376
|
|
120
|
377 (defcustom compilation-ask-about-save t
|
|
|
378 "*If not nil, M-x compile asks which buffers to save before compiling.
|
|
|
379 Otherwise, it saves all modified buffers without asking."
|
|
|
380 :type 'boolean
|
|
|
381 :group 'compilation)
|
|
0
|
382
|
|
|
383 (defvar grep-regexp-alist
|
|
2
|
384 '(("^\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
|
|
0
|
385 "Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
|
|
|
386
|
|
120
|
387 (defcustom grep-command "grep -n "
|
|
|
388 "*Last grep command used in \\[grep]; default for next grep."
|
|
|
389 :type 'string
|
|
|
390 :group 'compilation)
|
|
0
|
391
|
|
|
392 ;;;###autoload
|
|
120
|
393 (defcustom compilation-search-path '(nil)
|
|
0
|
394 "*List of directories to search for source files named in error messages.
|
|
|
395 Elements should be directory names, not file names of directories.
|
|
120
|
396 nil as an element means to try the default directory."
|
|
|
397 :type '(repeat (choice (const :tag "Default" nil)
|
|
|
398 directory))
|
|
|
399 :group 'compilation)
|
|
0
|
400
|
|
120
|
401 (defcustom compile-command "make -k "
|
|
|
402 "*Last shell command used to do a compilation; default for next compilation.
|
|
0
|
403
|
|
|
404 Sometimes it is useful for files to supply local values for this variable.
|
|
|
405 You might also use mode hooks to specify it in certain modes, like this:
|
|
|
406
|
|
|
407 (setq c-mode-hook
|
|
|
408 '(lambda () (or (file-exists-p \"makefile\") (file-exists-p \"Makefile\")
|
|
|
409 (progn (make-local-variable 'compile-command)
|
|
|
410 (setq compile-command
|
|
|
411 (concat \"make -k \"
|
|
120
|
412 buffer-file-name))))))"
|
|
|
413 :type 'string
|
|
|
414 :group 'compilation)
|
|
0
|
415
|
|
|
416 (defvar compilation-enter-directory-regexp
|
|
88
|
417 "[^\n]*: Entering directory `\\([^\n]*\\)'$"
|
|
0
|
418 "Regular expression matching lines that indicate a new current directory.
|
|
|
419 This must contain one \\(, \\) pair around the directory name.
|
|
|
420
|
|
|
421 The default value matches lines printed by the `-w' option of GNU Make.")
|
|
|
422
|
|
|
423 (defvar compilation-leave-directory-regexp
|
|
88
|
424 "[^\n]*: Leaving directory `\\([^\n]*\\)'$"
|
|
0
|
425 "Regular expression matching lines that indicate restoring current directory.
|
|
|
426 This may contain one \\(, \\) pair around the name of the directory
|
|
|
427 being moved from. If it does not, the last directory entered \(by a
|
|
|
428 line matching `compilation-enter-directory-regexp'\) is assumed.
|
|
|
429
|
|
|
430 The default value matches lines printed by the `-w' option of GNU Make.")
|
|
|
431
|
|
|
432 (defvar compilation-directory-stack nil
|
|
|
433 "Stack of previous directories for `compilation-leave-directory-regexp'.
|
|
|
434 The head element is the directory the compilation was started in.")
|
|
|
435
|
|
|
436 (defvar compilation-exit-message-function nil "\
|
|
|
437 If non-nil, called when a compilation process dies to return a status message.
|
|
2
|
438 This should be a function of three arguments: process status, exit status,
|
|
|
439 and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
|
|
|
440 write into the compilation buffer, and to put in its mode line.")
|
|
0
|
441
|
|
|
442 ;; History of compile commands.
|
|
|
443 (defvar compile-history nil)
|
|
|
444 ;; History of grep commands.
|
|
|
445 (defvar grep-history nil)
|
|
|
446
|
|
2
|
447 ;; XEmacs
|
|
74
|
448 (defvar compilation-font-lock-keywords (purecopy
|
|
0
|
449 (list
|
|
|
450 '("^[-_.\"A-Za-z0-9/+]+\\(:\\|, line \\)[0-9]+: \\([wW]arning:\\).*$" .
|
|
|
451 font-lock-keyword-face)
|
|
|
452 '("^[-_.\"A-Za-z0-9/+]+\\(: *\\|, line \\)[0-9]+:.*$" . font-lock-function-name-face)
|
|
|
453 '("^[^:\n]+-[a-zA-Z][^:\n]+$" . font-lock-doc-string-face)
|
|
|
454 '("\\(^[-_.\"A-Za-z0-9/+]+\\)\\(: *\\|, line \\)[0-9]+" 1 font-lock-string-face t)
|
|
|
455 '("^[-_.\"A-Za-z0-9/+]+\\(: *[0-9]+\\|, line [0-9]+\\)" 1 bold t)
|
|
|
456 ))
|
|
|
457 "Additional expressions to highlight in Compilation mode.")
|
|
|
458
|
|
|
459 ;FSF's version. Ours looks better.
|
|
2
|
460 ;(defvar compilation-mode-font-lock-keywords
|
|
0
|
461 ; ;; This regexp needs a bit of rewriting. What is the third grouping for?
|
|
2
|
462 ; '(("^\\([a-zA-Z]?:?[^ \n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$"
|
|
|
463 ; 1 font-lock-function-name-face))
|
|
|
464 ;;; ("^\\([^\n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 0 font-lock-keyword-face keep)
|
|
|
465
|
|
|
466 ;; XEmacs change
|
|
0
|
467 (put 'compilation-mode 'font-lock-defaults
|
|
|
468 '(compilation-font-lock-keywords t))
|
|
|
469
|
|
213
|
470 (defcustom compilation-mouse-motion-initiate-parsing nil
|
|
120
|
471 "*Should mouse motion over the compilation buffer initiate parsing?
|
|
|
472 When set to a non-nil value, mouse motion over the compilation/grep
|
|
|
473 buffer may initiate parsing of the error messages or grep hits.
|
|
|
474 When this is nil, errors and grep matches will no longer be
|
|
|
475 highlighted until they have been parsed, but may still be selected
|
|
|
476 with the center mouse button. This will then initiate parsing
|
|
|
477 and jump to the corresponding source line."
|
|
|
478 :type 'boolean
|
|
|
479 :group 'compilation)
|
|
0
|
480
|
|
|
481 ;;;###autoload
|
|
|
482 (defun compile (command)
|
|
|
483 "Compile the program including the current buffer. Default: run `make'.
|
|
|
484 Runs COMMAND, a shell command, in a separate process asynchronously
|
|
|
485 with output going to the buffer `*compilation*'.
|
|
|
486
|
|
|
487 You can then use the command \\[next-error] to find the next error message
|
|
|
488 and move to the source code that caused it.
|
|
|
489
|
|
|
490 Interactively, prompts for the command if `compilation-read-command' is
|
|
|
491 non-nil; otherwise uses `compile-command'. With prefix arg, always prompts.
|
|
|
492
|
|
|
493 To run more than one compilation at once, start one and rename the
|
|
|
494 \`*compilation*' buffer to some other name with \\[rename-buffer].
|
|
|
495 Then start the next one.
|
|
|
496
|
|
|
497 The name used for the buffer is actually whatever is returned by
|
|
|
498 the function in `compilation-buffer-name-function', so you can set that
|
|
|
499 to a function that generates a unique name."
|
|
|
500 (interactive
|
|
|
501 (if (or compilation-read-command current-prefix-arg)
|
|
2
|
502 ;; XEmacs change
|
|
0
|
503 (list (read-shell-command "Compile command: "
|
|
|
504 compile-command
|
|
|
505 ;; #### minibuffer code should do this
|
|
|
506 (if (equal (car compile-history)
|
|
|
507 compile-command)
|
|
|
508 '(compile-history . 1)
|
|
|
509 'compile-history)))
|
|
|
510 (list compile-command)))
|
|
|
511 (setq compile-command command)
|
|
|
512 (save-some-buffers (not compilation-ask-about-save) nil)
|
|
|
513 (compile-internal compile-command "No more errors"))
|
|
|
514
|
|
|
515 ;;; run compile with the default command line
|
|
|
516 (defun recompile ()
|
|
|
517 "Re-compile the program including the current buffer."
|
|
|
518 (interactive)
|
|
|
519 (save-some-buffers (not compilation-ask-about-save) nil)
|
|
|
520 (compile-internal compile-command "No more errors"))
|
|
|
521
|
|
|
522 ;; The system null device. (Should reference NULL_DEVICE from C.)
|
|
|
523 (defvar grep-null-device "/dev/null" "The system null device.")
|
|
|
524
|
|
|
525 ;;;###autoload
|
|
|
526 (defun grep (command-args)
|
|
|
527 "Run grep, with user-specified args, and collect output in a buffer.
|
|
|
528 While grep runs asynchronously, you can use the \\[next-error] command
|
|
|
529 to find the text that grep hits refer to.
|
|
|
530
|
|
|
531 This command uses a special history list for its arguments, so you can
|
|
|
532 easily repeat a grep command."
|
|
|
533 (interactive
|
|
2
|
534 ;; XEmacs change
|
|
0
|
535 (list (read-shell-command "Run grep (like this): "
|
|
|
536 grep-command 'grep-history)))
|
|
|
537 (let ((buf (compile-internal (concat command-args " " grep-null-device)
|
|
|
538 "No more grep hits" "grep"
|
|
|
539 ;; Give it a simpler regexp to match.
|
|
|
540 nil grep-regexp-alist)))
|
|
|
541 (save-excursion
|
|
|
542 (set-buffer buf)
|
|
|
543 (set (make-local-variable 'compilation-exit-message-function)
|
|
2
|
544 ;; XEmacs change
|
|
0
|
545 (lambda (proc msg)
|
|
|
546 (let ((code (process-exit-status proc)))
|
|
|
547 (if (eq (process-status proc) 'exit)
|
|
|
548 (cond ((zerop code)
|
|
|
549 '("finished (matches found)\n" . "matched"))
|
|
|
550 ((= code 1)
|
|
|
551 '("finished with no matches found\n" . "no match"))
|
|
|
552 (t
|
|
|
553 (cons msg code)))
|
|
|
554 (cons msg code))))))))
|
|
|
555
|
|
|
556 (defun compile-internal (command error-message
|
|
|
557 &optional name-of-mode parser regexp-alist
|
|
|
558 name-function)
|
|
|
559 "Run compilation command COMMAND (low level interface).
|
|
|
560 ERROR-MESSAGE is a string to print if the user asks to see another error
|
|
|
561 and there are no more errors. Third argument NAME-OF-MODE is the name
|
|
|
562 to display as the major mode in the compilation buffer.
|
|
|
563
|
|
|
564 Fourth arg PARSER is the error parser function (nil means the default). Fifth
|
|
|
565 arg REGEXP-ALIST is the error message regexp alist to use (nil means the
|
|
|
566 default). Sixth arg NAME-FUNCTION is a function called to name the buffer (nil
|
|
|
567 means the default). The defaults for these variables are the global values of
|
|
|
568 \`compilation-parse-errors-function', `compilation-error-regexp-alist', and
|
|
|
569 \`compilation-buffer-name-function', respectively.
|
|
|
570
|
|
|
571 Returns the compilation buffer created."
|
|
|
572 (let (outbuf)
|
|
|
573 (save-excursion
|
|
|
574 (or name-of-mode
|
|
|
575 (setq name-of-mode "Compilation"))
|
|
|
576 (setq outbuf
|
|
|
577 (get-buffer-create
|
|
|
578 (funcall (or name-function compilation-buffer-name-function
|
|
|
579 (function (lambda (mode)
|
|
|
580 (concat "*" (downcase mode) "*"))))
|
|
|
581 name-of-mode)))
|
|
|
582 (set-buffer outbuf)
|
|
|
583 (let ((comp-proc (get-buffer-process (current-buffer))))
|
|
|
584 (if comp-proc
|
|
|
585 (if (or (not (eq (process-status comp-proc) 'run))
|
|
|
586 (yes-or-no-p
|
|
|
587 (format "A %s process is running; kill it? "
|
|
|
588 name-of-mode)))
|
|
|
589 (condition-case ()
|
|
|
590 (progn
|
|
|
591 (interrupt-process comp-proc)
|
|
|
592 (sit-for 1)
|
|
|
593 (delete-process comp-proc))
|
|
|
594 (error nil))
|
|
|
595 (error "Cannot have two processes in `%s' at once"
|
|
|
596 (buffer-name))
|
|
|
597 )))
|
|
|
598 ;; In case the compilation buffer is current, make sure we get the global
|
|
|
599 ;; values of compilation-error-regexp-alist, etc.
|
|
|
600 (kill-all-local-variables))
|
|
|
601 (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist))
|
|
|
602 (parser (or parser compilation-parse-errors-function))
|
|
|
603 (thisdir default-directory)
|
|
2
|
604 ;; XEmacs change
|
|
0
|
605 (buffer-save (current-buffer))
|
|
|
606 outwin)
|
|
2
|
607
|
|
|
608 ;; XEmacs change
|
|
0
|
609 ;; Pop up the compilation buffer.
|
|
|
610 (setq outwin (display-buffer outbuf))
|
|
|
611
|
|
|
612 (unwind-protect
|
|
|
613 (progn
|
|
|
614 ;; Clear out the compilation buffer and make it writable.
|
|
|
615 ;; Change its default-directory to the directory where the compilation
|
|
|
616 ;; will happen, and insert a `cd' command to indicate this.
|
|
|
617 (set-buffer outbuf)
|
|
2
|
618
|
|
0
|
619 (setq buffer-read-only nil)
|
|
|
620 (buffer-disable-undo (current-buffer))
|
|
|
621 (erase-buffer)
|
|
|
622 (buffer-enable-undo (current-buffer))
|
|
|
623 (setq default-directory thisdir)
|
|
|
624 (insert "cd " thisdir "\n" command "\n")
|
|
|
625 (set-buffer-modified-p nil)
|
|
|
626
|
|
2
|
627 ;; XEmacs change
|
|
0
|
628 ;; set it so the window will scroll to show compile output
|
|
|
629 (save-window-excursion
|
|
|
630 (select-window outwin)
|
|
|
631 (goto-char (point-max)))
|
|
|
632
|
|
2
|
633 ;; XEmacs change
|
|
0
|
634 (compilation-mode name-of-mode)
|
|
|
635 ;; (setq buffer-read-only t) ;;; Non-ergonomic.
|
|
2
|
636 ;; XEmacs change
|
|
0
|
637 (set (make-local-variable 'compile-command) command)
|
|
|
638 (set (make-local-variable 'compilation-parse-errors-function) parser)
|
|
|
639 (set (make-local-variable 'compilation-error-message) error-message)
|
|
|
640 (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist)
|
|
|
641 (setq default-directory thisdir
|
|
|
642 compilation-directory-stack (list default-directory))
|
|
|
643 (set-window-start outwin (point-min))
|
|
|
644 (setq mode-name name-of-mode)
|
|
2
|
645 ;; XEmacs change
|
|
0
|
646 ; (or (eq outwin (selected-window))
|
|
|
647 ; (set-window-point outwin (point-min)))
|
|
|
648 (compilation-set-window-height outwin)
|
|
|
649 ;; Start the compilation.
|
|
|
650 (if (fboundp 'start-process)
|
|
|
651 (let* ((process-environment (cons "EMACS=t" process-environment))
|
|
|
652 (proc (start-process-shell-command (downcase mode-name)
|
|
|
653 outbuf
|
|
|
654 command)))
|
|
|
655 (set-process-sentinel proc 'compilation-sentinel)
|
|
|
656 (set-process-filter proc 'compilation-filter)
|
|
|
657 (set-marker (process-mark proc) (point) outbuf)
|
|
|
658 (setq compilation-in-progress
|
|
|
659 (cons proc compilation-in-progress)))
|
|
2
|
660 ;; No asynchronous processes available.
|
|
193
|
661 (display-message
|
|
|
662 'progress
|
|
|
663 (format "Executing `%s'..." command))
|
|
2
|
664 ; FSF
|
|
|
665 ; (setq mode-line-process ":run")
|
|
|
666 ; (force-mode-line-update)
|
|
|
667 (sit-for 0) ;; Force redisplay
|
|
0
|
668 (let ((status (call-process shell-file-name nil outbuf nil "-c"
|
|
|
669 command))))
|
|
193
|
670 (display-message
|
|
|
671 'progress
|
|
|
672 (format "Executing `%s'...done" command))))
|
|
0
|
673 (set-buffer buffer-save)))
|
|
|
674
|
|
|
675 ;; Make it so the next C-x ` will use this buffer.
|
|
|
676 (setq compilation-last-buffer outbuf)))
|
|
|
677
|
|
|
678 ;; Set the height of WINDOW according to compilation-window-height.
|
|
|
679 (defun compilation-set-window-height (window)
|
|
|
680 (and compilation-window-height
|
|
|
681 (= (window-width window) (frame-width (window-frame window)))
|
|
|
682 ;; If window is alone in its frame, aside from a minibuffer,
|
|
|
683 ;; don't change its height.
|
|
|
684 (not (eq window (frame-root-window (window-frame window))))
|
|
|
685 ;; This save-excursion prevents us from changing the current buffer,
|
|
|
686 ;; which might not be the same as the selected window's buffer.
|
|
|
687 (save-excursion
|
|
|
688 (let ((w (selected-window)))
|
|
|
689 (unwind-protect
|
|
|
690 (progn
|
|
|
691 (select-window window)
|
|
|
692 (enlarge-window (- compilation-window-height
|
|
|
693 (window-height))))
|
|
|
694 (select-window w))))))
|
|
|
695
|
|
|
696 (defvar compilation-minor-mode-map
|
|
|
697 (let ((map (make-sparse-keymap)))
|
|
|
698 (set-keymap-name map 'compilation-minor-mode-map)
|
|
|
699 (define-key map "\C-c\C-c" 'compile-goto-error)
|
|
|
700 (define-key map "\C-m" 'compile-goto-error)
|
|
|
701 (define-key map "\C-c\C-k" 'kill-compilation)
|
|
|
702 (define-key map "\M-n" 'compilation-next-error)
|
|
|
703 (define-key map "\M-p" 'compilation-previous-error)
|
|
|
704 (define-key map "\M-{" 'compilation-previous-file)
|
|
|
705 (define-key map "\M-}" 'compilation-next-file)
|
|
|
706 map)
|
|
|
707 "Keymap for `compilation-minor-mode'.")
|
|
|
708
|
|
|
709 (defvar compilation-mode-map
|
|
|
710 (let ((map (make-sparse-keymap)))
|
|
|
711 (set-keymap-parents map (list compilation-minor-mode-map))
|
|
|
712 (set-keymap-name map 'compilation-mode-map)
|
|
|
713 (define-key map " " 'scroll-up)
|
|
|
714 (define-key map "\^?" 'scroll-down)
|
|
|
715 (define-key map 'button2 'compile-mouse-goto-error)
|
|
|
716 map)
|
|
|
717 "Keymap for compilation log buffers.
|
|
|
718 `compilation-minor-mode-map' is a parent of this.")
|
|
|
719
|
|
|
720 ;;; XEmacs menus
|
|
|
721
|
|
|
722 (defun compilation-errors-exist-p (&optional buffer)
|
|
|
723 "Whether we are in a state where the `next-error' command will work,
|
|
|
724 that is, whether there exist (or may exist) error targets in the *compile*
|
|
|
725 or *grep* buffers."
|
|
|
726 (or buffer
|
|
|
727 (setq buffer (condition-case nil
|
|
|
728 (compilation-find-buffer)
|
|
|
729 (error nil))))
|
|
|
730 (and buffer
|
|
|
731 (compilation-buffer-p buffer)
|
|
|
732 (save-excursion
|
|
|
733 (set-buffer buffer)
|
|
|
734 ;; Has errors on the list, or needs to be parsed.
|
|
|
735 ;; But don't parse it now!
|
|
|
736 (or (not (null compilation-error-list))
|
|
|
737 (< compilation-parsing-end (point-max))))))
|
|
|
738
|
|
|
739 (defvar Compilation-mode-popup-menu
|
|
|
740 '("Compilation Mode Commands"
|
|
|
741 :filter compile-menu-filter
|
|
|
742 ["Compile..." compile t]
|
|
|
743 ["Recompile" recompile t]
|
|
|
744 ["Kill Compilation" kill-compilation (get-buffer-process (current-buffer))]
|
|
|
745 "---"
|
|
|
746 ["Goto Error" compile-goto-error (compilation-errors-exist-p)]
|
|
|
747 ["Next Error" next-error (compilation-errors-exist-p)]
|
|
|
748 ["Previous Error" previous-error (compilation-errors-exist-p)]
|
|
|
749 ["First Error" first-error (compilation-errors-exist-p)]
|
|
|
750 ))
|
|
|
751
|
|
|
752 (defvar Compilation-mode-menubar-menu
|
|
|
753 (cons "Compile" (cdr Compilation-mode-popup-menu)))
|
|
|
754
|
|
|
755 (defvar grep-mode-popup-menu
|
|
|
756 '("Grep Mode Commands"
|
|
|
757 :filter grep-menu-filter
|
|
|
758 ["Grep..." grep t]
|
|
|
759 ["Repeat Grep" recompile t]
|
|
|
760 ["Kill Grep" kill-compilation (get-buffer-process (current-buffer))]
|
|
|
761 "---"
|
|
|
762 ["Goto Match" compile-goto-error (default-value 'compilation-error-list)]
|
|
|
763 ["Next Match" next-error (default-value 'compilation-error-list)]
|
|
|
764 ["Previous Match" previous-error (default-value 'compilation-error-list)]
|
|
|
765 ["First Match" first-error (default-value 'compilation-error-list)]
|
|
|
766 ))
|
|
|
767
|
|
|
768 (defvar grep-mode-menubar-menu
|
|
|
769 (cons "Grep" (cdr grep-mode-popup-menu)))
|
|
|
770
|
|
|
771 (defun compile-menu-filter-1 (menu history-list item-name command-name)
|
|
|
772 (let ((submenu (mapcar #'(lambda (string)
|
|
|
773 (vector string
|
|
|
774 (list command-name string)
|
|
|
775 t))
|
|
|
776 history-list))
|
|
|
777 (existing (assoc item-name menu)))
|
|
|
778 (if existing
|
|
|
779 (progn
|
|
|
780 (setcdr existing submenu)
|
|
|
781 menu)
|
|
|
782 (nconc menu (list (cons item-name submenu))))))
|
|
|
783
|
|
|
784 (defun compile-menu-filter (menu)
|
|
|
785 (compile-menu-filter-1 menu compile-history "Compile History" 'compile))
|
|
|
786
|
|
|
787 (defun grep-menu-filter (menu)
|
|
|
788 (compile-menu-filter-1 menu grep-history "Grep History" 'grep))
|
|
|
789
|
|
|
790 (defun compilation-mode (&optional name-of-mode)
|
|
|
791 "Major mode for compilation log buffers.
|
|
|
792 \\<compilation-mode-map>To visit the source for a line-numbered error,
|
|
|
793 move point to the error message line and type \\[compile-goto-error],
|
|
|
794 or click on the line with \\[compile-mouse-goto-error].
|
|
|
795 There is a menu of commands on \\[compile-popup-menu].
|
|
|
796 To kill the compilation, type \\[kill-compilation].
|
|
|
797
|
|
|
798 Runs `compilation-mode-hook' with `run-hooks' (which see)."
|
|
|
799 (interactive)
|
|
|
800 (kill-all-local-variables)
|
|
|
801 (use-local-map compilation-mode-map)
|
|
|
802 (setq major-mode 'compilation-mode
|
|
|
803 mode-name "Compilation")
|
|
|
804 (compilation-setup)
|
|
|
805 (font-lock-set-defaults)
|
|
|
806 (if (not name-of-mode) nil
|
|
|
807 (let ((sym (intern (concat name-of-mode "-mode-popup-menu"))))
|
|
|
808 (if (boundp sym)
|
|
|
809 (setq mode-popup-menu (symbol-value sym))))
|
|
|
810 (if (featurep 'menubar)
|
|
|
811 (progn
|
|
|
812 ;; make a local copy of the menubar, so our modes don't
|
|
|
813 ;; change the global menubar
|
|
|
814 (set-buffer-menubar current-menubar)
|
|
|
815 (let ((sym (intern (concat name-of-mode "-mode-menubar-menu"))))
|
|
|
816 (if (boundp sym)
|
|
|
817 (add-submenu nil (symbol-value sym)))))))
|
|
|
818 (run-hooks 'compilation-mode-hook))
|
|
|
819
|
|
|
820 ;; XEmacs addition, hacked by Mly
|
|
|
821 (defun compilation-mode-motion-hook (event)
|
|
|
822 (mode-motion-highlight-internal
|
|
|
823 event
|
|
|
824 #'beginning-of-line
|
|
|
825 #'(lambda ()
|
|
|
826 (let* ((p (point))
|
|
|
827 (e (progn (end-of-line) (point)))
|
|
|
828 (l (progn
|
|
116
|
829 (if (and compilation-mouse-motion-initiate-parsing
|
|
|
830 (or (eq compilation-error-list 't)
|
|
|
831 (>= p compilation-parsing-end)))
|
|
0
|
832 ;; #### Does it suck too badly to have mouse-movement
|
|
|
833 ;; #### over a buffer parse errors in that buffer??
|
|
|
834 (save-window-excursion
|
|
|
835 (compile-reinitialize-errors nil p)))
|
|
|
836 (if (and compilation-error-list
|
|
|
837 (<= (car (car compilation-error-list)) p))
|
|
|
838 ;; Perhaps save time by only searching tail
|
|
|
839 compilation-error-list
|
|
|
840 compilation-old-error-list))))
|
|
|
841 (if (catch 'found
|
|
|
842 (while l
|
|
|
843 (let ((x (marker-position (car (car l)))))
|
|
|
844 (cond ((< x p)
|
|
|
845 (setq l (cdr l)))
|
|
|
846 ((<= x e)
|
|
|
847 (throw 'found t))
|
|
|
848 (t
|
|
|
849 (throw 'found nil)))))
|
|
|
850 nil)
|
|
|
851 (goto-char e)
|
|
|
852 (goto-char p))))))
|
|
|
853
|
|
|
854 ;; Prepare the buffer for the compilation parsing commands to work.
|
|
|
855 (defun compilation-setup ()
|
|
|
856 ;; Make the buffer's mode line show process state.
|
|
|
857 (setq mode-line-process '(":%s"))
|
|
|
858 (set (make-local-variable 'compilation-error-list) nil)
|
|
|
859 (set (make-local-variable 'compilation-old-error-list) nil)
|
|
|
860 (set (make-local-variable 'compilation-parsing-end) 1)
|
|
|
861 (set (make-local-variable 'compilation-directory-stack) nil)
|
|
|
862 (setq compilation-last-buffer (current-buffer))
|
|
|
863 ;; XEmacs change: highlight lines, install menubar.
|
|
|
864 (require 'mode-motion)
|
|
|
865 (setq mode-motion-hook 'compilation-mode-motion-hook)
|
|
|
866 (make-local-variable 'mouse-track-click-hook)
|
|
|
867 (add-hook 'mouse-track-click-hook 'compile-mouse-maybe-goto-error)
|
|
|
868 )
|
|
|
869
|
|
|
870 (defvar compilation-minor-mode nil
|
|
|
871 "Non-nil when in compilation-minor-mode.
|
|
|
872 In this minor mode, all the error-parsing commands of the
|
|
|
873 Compilation major mode are available.")
|
|
|
874 (make-variable-buffer-local 'compilation-minor-mode)
|
|
|
875
|
|
|
876 (or (assq 'compilation-minor-mode minor-mode-alist)
|
|
|
877 (setq minor-mode-alist (cons '(compilation-minor-mode " Compilation")
|
|
|
878 minor-mode-alist)))
|
|
|
879 (or (assq 'compilation-minor-mode minor-mode-map-alist)
|
|
|
880 (setq minor-mode-map-alist (cons (cons 'compilation-minor-mode
|
|
|
881 compilation-minor-mode-map)
|
|
|
882 minor-mode-map-alist)))
|
|
|
883
|
|
|
884 ;;;###autoload
|
|
|
885 (defun compilation-minor-mode (&optional arg)
|
|
|
886 "Toggle compilation minor mode.
|
|
|
887 With arg, turn compilation mode on if and only if arg is positive.
|
|
|
888 See `compilation-mode'.
|
|
|
889 ! \\{compilation-mode-map}"
|
|
|
890 (interactive "P")
|
|
|
891 (if (setq compilation-minor-mode (if (null arg)
|
|
|
892 (null compilation-minor-mode)
|
|
|
893 (> (prefix-numeric-value arg) 0)))
|
|
2
|
894 (progn
|
|
|
895 (compilation-setup)
|
|
|
896 (run-hooks 'compilation-minor-mode-hook))))
|
|
|
897
|
|
|
898 ;; Write msg in the current buffer and hack its mode-line-process.
|
|
|
899 (defun compilation-handle-exit (process-status exit-status msg)
|
|
|
900 (let ((buffer-read-only nil)
|
|
|
901 (status (if compilation-exit-message-function
|
|
|
902 (funcall compilation-exit-message-function
|
|
|
903 process-status exit-status msg)
|
|
|
904 (cons msg exit-status)))
|
|
|
905 (omax (point-max))
|
|
|
906 (opoint (point)))
|
|
|
907 ;; Record where we put the message, so we can ignore it
|
|
|
908 ;; later on.
|
|
|
909 (goto-char omax)
|
|
|
910 (insert ?\n mode-name " " (car status))
|
|
|
911 (forward-char -1)
|
|
|
912 (insert " at " (substring (current-time-string) 0 19))
|
|
|
913 (forward-char 1)
|
|
|
914 (setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
|
|
|
915 ;; Force mode line redisplay soon.
|
|
|
916 (force-mode-line-update)
|
|
|
917 (if (and opoint (< opoint omax))
|
|
|
918 (goto-char opoint))
|
|
|
919 (if compilation-finish-function
|
|
|
920 (funcall compilation-finish-function (current-buffer) msg))))
|
|
0
|
921
|
|
|
922 ;; Called when compilation process changes state.
|
|
|
923 (defun compilation-sentinel (proc msg)
|
|
|
924 "Sentinel for compilation buffers."
|
|
2
|
925 ;; XEmacs change
|
|
0
|
926 (let* ((buffer (process-buffer proc))
|
|
|
927 (window (get-buffer-window buffer)))
|
|
|
928 (if (memq (process-status proc) '(signal exit))
|
|
|
929 (progn
|
|
|
930 (if (null (buffer-name buffer))
|
|
|
931 ;; buffer killed
|
|
|
932 (set-process-buffer proc nil)
|
|
|
933 (let ((obuf (current-buffer))
|
|
|
934 omax opoint estatus)
|
|
|
935 ;; save-excursion isn't the right thing if
|
|
|
936 ;; process-buffer is current-buffer
|
|
|
937 (unwind-protect
|
|
|
938 (progn
|
|
|
939 ;; Write something in the compilation buffer
|
|
|
940 ;; and hack its mode line.
|
|
|
941 (set-buffer buffer)
|
|
|
942 (let ((buffer-read-only nil)
|
|
|
943 (status (if compilation-exit-message-function
|
|
|
944 (funcall compilation-exit-message-function
|
|
|
945 proc msg)
|
|
|
946 (cons msg (process-exit-status proc)))))
|
|
|
947 (setq omax (point-max)
|
|
|
948 opoint (point))
|
|
|
949 (goto-char omax)
|
|
|
950 ;; Record where we put the message, so we can ignore it
|
|
|
951 ;; later on.
|
|
|
952 (insert ?\n mode-name " " (car status))
|
|
|
953 (forward-char -1)
|
|
|
954 (insert " at " (substring (current-time-string) 0 19))
|
|
|
955 (forward-char 1)
|
|
|
956 (setq mode-line-process
|
|
|
957 (concat ":"
|
|
|
958 (symbol-name (process-status proc))
|
|
|
959 (if (zerop (process-exit-status proc))
|
|
|
960 " OK"
|
|
|
961 (setq estatus
|
|
|
962 (format " [exit-status %d]"
|
|
|
963 (process-exit-status proc))))
|
|
|
964 ))
|
|
|
965 ;; XEmacs - tedium should let you know when it's ended...
|
|
|
966 (if (and (not compilation-always-signal-completion)
|
|
|
967 window
|
|
|
968 (pos-visible-in-window-p (point-max) window))
|
|
|
969 nil ; assume that the user will see it...
|
|
|
970 (ding t 'ready)
|
|
193
|
971 (display-message
|
|
|
972 'progress
|
|
|
973 (format "Compilation process completed%s."
|
|
0
|
974 (or estatus " successfully")
|
|
193
|
975 )))
|
|
0
|
976 ;; Since the buffer and mode line will show that the
|
|
|
977 ;; process is dead, we can delete it now. Otherwise it
|
|
|
978 ;; will stay around until M-x list-processes.
|
|
|
979 (delete-process proc)
|
|
|
980 ;; Force mode line redisplay soon.
|
|
|
981 (redraw-modeline))
|
|
|
982 (if (and opoint (< opoint omax))
|
|
|
983 (goto-char opoint))
|
|
|
984 (if compilation-finish-function
|
|
|
985 (funcall compilation-finish-function buffer msg)))
|
|
|
986 (set-buffer obuf))))
|
|
|
987 (setq compilation-in-progress (delq proc compilation-in-progress))
|
|
|
988 ))))
|
|
|
989
|
|
|
990 (defun compilation-filter (proc string)
|
|
|
991 "Process filter for compilation buffers.
|
|
|
992 Just inserts the text, but uses `insert-before-markers'."
|
|
|
993 (if (buffer-name (process-buffer proc))
|
|
|
994 (save-excursion
|
|
|
995 (set-buffer (process-buffer proc))
|
|
|
996 (let ((buffer-read-only nil))
|
|
|
997 (save-excursion
|
|
|
998 (goto-char (process-mark proc))
|
|
|
999 (insert-before-markers string)
|
|
2
|
1000 (run-hooks 'compilation-filter-hook)
|
|
0
|
1001 (set-marker (process-mark proc) (point)))))))
|
|
|
1002
|
|
|
1003 ;; Return the cdr of compilation-old-error-list for the error containing point.
|
|
|
1004 (defun compile-error-at-point ()
|
|
|
1005 (compile-reinitialize-errors nil (point))
|
|
|
1006 (let ((errors compilation-old-error-list))
|
|
|
1007 (while (and errors
|
|
|
1008 (> (point) (car (car errors))))
|
|
|
1009 (setq errors (cdr errors)))
|
|
|
1010 errors))
|
|
|
1011
|
|
2
|
1012 (defsubst compilation-buffer-p (buffer)
|
|
0
|
1013 (save-excursion
|
|
|
1014 (set-buffer buffer)
|
|
|
1015 (or compilation-minor-mode (eq major-mode 'compilation-mode))))
|
|
|
1016
|
|
|
1017 (defun compilation-next-error (n)
|
|
|
1018 "Move point to the next error in the compilation buffer.
|
|
|
1019 Does NOT find the source line like \\[next-error]."
|
|
|
1020 (interactive "p")
|
|
|
1021 (or (compilation-buffer-p (current-buffer))
|
|
|
1022 (error "Not in a compilation buffer."))
|
|
|
1023 (setq compilation-last-buffer (current-buffer))
|
|
|
1024
|
|
|
1025 (let ((errors (compile-error-at-point)))
|
|
|
1026
|
|
|
1027 ;; Move to the error after the one containing point.
|
|
|
1028 (goto-char (car (if (< n 0)
|
|
|
1029 (let ((i 0)
|
|
|
1030 (e compilation-old-error-list))
|
|
|
1031 ;; See how many cdrs away ERRORS is from the start.
|
|
|
1032 (while (not (eq e errors))
|
|
|
1033 (setq i (1+ i)
|
|
|
1034 e (cdr e)))
|
|
|
1035 (if (> (- n) i)
|
|
|
1036 (error "Moved back past first error")
|
|
|
1037 (nth (+ i n) compilation-old-error-list)))
|
|
|
1038 (let ((compilation-error-list (cdr errors)))
|
|
|
1039 (compile-reinitialize-errors nil nil n)
|
|
|
1040 (if compilation-error-list
|
|
|
1041 (nth (1- n) compilation-error-list)
|
|
|
1042 (error "Moved past last error"))))))))
|
|
|
1043
|
|
|
1044 (defun compilation-previous-error (n)
|
|
|
1045 "Move point to the previous error in the compilation buffer.
|
|
|
1046 Does NOT find the source line like \\[next-error]."
|
|
|
1047 (interactive "p")
|
|
|
1048 (compilation-next-error (- n)))
|
|
|
1049
|
|
|
1050
|
|
|
1051 ;; Given an elt of `compilation-error-list', return an object representing
|
|
|
1052 ;; the referenced file which is equal to (but not necessarily eq to) what
|
|
|
1053 ;; this function would return for another error in the same file.
|
|
|
1054 (defsubst compilation-error-filedata (data)
|
|
|
1055 (setq data (cdr data))
|
|
|
1056 (if (markerp data)
|
|
|
1057 (marker-buffer data)
|
|
|
1058 (car data)))
|
|
|
1059
|
|
|
1060 ;; Return a string describing a value from compilation-error-filedata.
|
|
|
1061 ;; This value is not necessarily useful as a file name, but should be
|
|
|
1062 ;; indicative to the user of what file's errors are being referred to.
|
|
|
1063 (defsubst compilation-error-filedata-file-name (filedata)
|
|
|
1064 (if (bufferp filedata)
|
|
|
1065 (buffer-file-name filedata)
|
|
|
1066 (car filedata)))
|
|
|
1067
|
|
|
1068 (defun compilation-next-file (n)
|
|
|
1069 "Move point to the next error for a different file than the current one."
|
|
|
1070 (interactive "p")
|
|
|
1071 (or (compilation-buffer-p (current-buffer))
|
|
|
1072 (error "Not in a compilation buffer."))
|
|
|
1073 (setq compilation-last-buffer (current-buffer))
|
|
|
1074
|
|
|
1075 (let ((reversed (< n 0))
|
|
|
1076 errors filedata)
|
|
|
1077
|
|
|
1078 (if (not reversed)
|
|
|
1079 (setq errors (or (compile-error-at-point)
|
|
|
1080 (error "Moved past last error")))
|
|
|
1081
|
|
|
1082 ;; Get a reversed list of the errors up through the one containing point.
|
|
|
1083 (compile-reinitialize-errors nil (point))
|
|
|
1084 (setq errors (reverse compilation-old-error-list)
|
|
|
1085 n (- n))
|
|
|
1086
|
|
|
1087 ;; Ignore errors after point. (car ERRORS) will be the error
|
|
|
1088 ;; containing point, (cadr ERRORS) the one before it.
|
|
|
1089 (while (and errors
|
|
|
1090 (< (point) (car (car errors))))
|
|
|
1091 (setq errors (cdr errors))))
|
|
|
1092
|
|
|
1093 (while (> n 0)
|
|
|
1094 (setq filedata (compilation-error-filedata (car errors)))
|
|
|
1095
|
|
|
1096 ;; Skip past the following errors for this file.
|
|
|
1097 (while (equal filedata
|
|
|
1098 (compilation-error-filedata
|
|
|
1099 (car (or errors
|
|
|
1100 (if reversed
|
|
|
1101 (error "%s the first erring file"
|
|
|
1102 (compilation-error-filedata-file-name
|
|
|
1103 filedata))
|
|
|
1104 (let ((compilation-error-list nil))
|
|
|
1105 ;; Parse some more.
|
|
|
1106 (compile-reinitialize-errors nil nil 2)
|
|
|
1107 (setq errors compilation-error-list)))
|
|
|
1108 (error "%s is the last erring file"
|
|
|
1109 (compilation-error-filedata-file-name
|
|
|
1110 filedata))))))
|
|
|
1111 (setq errors (cdr errors)))
|
|
|
1112
|
|
|
1113 (setq n (1- n)))
|
|
|
1114
|
|
|
1115 ;; Move to the following error.
|
|
|
1116 (goto-char (car (car (or errors
|
|
|
1117 (if reversed
|
|
|
1118 (error "This is the first erring file")
|
|
|
1119 (let ((compilation-error-list nil))
|
|
|
1120 ;; Parse the last one.
|
|
|
1121 (compile-reinitialize-errors nil nil 1)
|
|
|
1122 compilation-error-list))))))))
|
|
|
1123
|
|
|
1124 (defun compilation-previous-file (n)
|
|
|
1125 "Move point to the previous error for a different file than the current one."
|
|
|
1126 (interactive "p")
|
|
|
1127 (compilation-next-file (- n)))
|
|
|
1128
|
|
|
1129
|
|
|
1130 (defun kill-compilation ()
|
|
|
1131 "Kill the process made by the \\[compile] command."
|
|
|
1132 (interactive)
|
|
|
1133 (let ((buffer (compilation-find-buffer)))
|
|
|
1134 (if (get-buffer-process buffer)
|
|
|
1135 (interrupt-process (get-buffer-process buffer))
|
|
|
1136 (error "The compilation process is not running."))))
|
|
|
1137
|
|
|
1138
|
|
|
1139 ;; Parse any new errors in the compilation buffer,
|
|
|
1140 ;; or reparse from the beginning if the user has asked for that.
|
|
|
1141 (defun compile-reinitialize-errors (reparse
|
|
|
1142 &optional limit-search find-at-least)
|
|
|
1143 (save-excursion
|
|
|
1144 ;; XEmacs change: Below we made a change to possibly change the
|
|
|
1145 ;; selected window. If we don't save and restore the old window
|
|
|
1146 ;; then if we get an error such as 'no more errors' we'll end up
|
|
|
1147 ;; in the compilation buffer.
|
|
|
1148 (save-window-excursion
|
|
|
1149 (set-buffer compilation-last-buffer)
|
|
|
1150 ;; If we are out of errors, or if user says "reparse",
|
|
|
1151 ;; discard the info we have, to force reparsing.
|
|
|
1152 (if (or (eq compilation-error-list t)
|
|
|
1153 reparse)
|
|
|
1154 (compilation-forget-errors))
|
|
|
1155 (if (and compilation-error-list
|
|
|
1156 (or (not limit-search)
|
|
|
1157 (> compilation-parsing-end limit-search))
|
|
|
1158 (or (not find-at-least)
|
|
|
1159 (>= (length compilation-error-list) find-at-least)))
|
|
|
1160 ;; Since compilation-error-list is non-nil, it points to a specific
|
|
|
1161 ;; error the user wanted. So don't move it around.
|
|
|
1162 nil
|
|
|
1163
|
|
|
1164 ;; XEmacs change: if the compilation buffer is already visible
|
|
|
1165 ;; in a window, use that instead of thrashing the display.
|
|
|
1166 (let ((w (get-buffer-window compilation-last-buffer)))
|
|
|
1167 (if w
|
|
|
1168 (select-window w)
|
|
|
1169 (switch-to-buffer compilation-last-buffer)))
|
|
|
1170
|
|
2
|
1171 ;; This was here for a long time (before my rewrite); why? --roland
|
|
|
1172 ;;(switch-to-buffer compilation-last-buffer)
|
|
0
|
1173 (set-buffer-modified-p nil)
|
|
|
1174 (if (< compilation-parsing-end (point-max))
|
|
|
1175 ;; compilation-error-list might be non-nil if we have a non-nil
|
|
|
1176 ;; LIMIT-SEARCH or FIND-AT-LEAST arg. In that case its value
|
|
|
1177 ;; records the current position in the error list, and we must
|
|
|
1178 ;; preserve that after reparsing.
|
|
|
1179 (let ((error-list-pos compilation-error-list))
|
|
|
1180 (funcall compilation-parse-errors-function
|
|
|
1181 limit-search
|
|
|
1182 (and find-at-least
|
|
|
1183 ;; We only need enough new parsed errors to reach
|
|
|
1184 ;; FIND-AT-LEAST errors past the current
|
|
|
1185 ;; position.
|
|
|
1186 (- find-at-least (length compilation-error-list))))
|
|
|
1187 ;; Remember the entire list for compilation-forget-errors. If
|
|
|
1188 ;; this is an incremental parse, append to previous list. If
|
|
|
1189 ;; we are parsing anew, compilation-forget-errors cleared
|
|
|
1190 ;; compilation-old-error-list above.
|
|
|
1191 (setq compilation-old-error-list
|
|
|
1192 (nconc compilation-old-error-list compilation-error-list))
|
|
|
1193 (if error-list-pos
|
|
|
1194 ;; We started in the middle of an existing list of parsed
|
|
|
1195 ;; errors before parsing more; restore that position.
|
|
|
1196 (setq compilation-error-list error-list-pos))
|
|
|
1197 ))))))
|
|
|
1198
|
|
2
|
1199 ;; XEmacs addition
|
|
|
1200 ;; FSF has added this by 19.34, but it is highly complex, why? -sb
|
|
|
1201 (defun compile-mouse-goto-error (event)
|
|
|
1202 "Visit the source for the error under the mouse.
|
|
|
1203 Use this command in a compilation log buffer."
|
|
|
1204 (interactive "e")
|
|
|
1205 (mouse-set-point event)
|
|
|
1206 (beginning-of-line)
|
|
|
1207 (compile-goto-error))
|
|
|
1208
|
|
0
|
1209 (defun compile-goto-error (&optional argp)
|
|
|
1210 "Visit the source for the error message point is on.
|
|
|
1211 Use this command in a compilation log buffer. Sets the mark at point there.
|
|
|
1212 \\[universal-argument] as a prefix arg means to reparse the buffer's error messages first;
|
|
|
1213 other kinds of prefix arguments are ignored."
|
|
|
1214 (interactive "P")
|
|
|
1215 (or (compilation-buffer-p (current-buffer))
|
|
|
1216 (error "Not in a compilation buffer."))
|
|
|
1217 (setq compilation-last-buffer (current-buffer))
|
|
|
1218 (compile-reinitialize-errors (consp argp) (point))
|
|
|
1219
|
|
|
1220 ;; Move to bol; the marker for the error on this line will point there.
|
|
|
1221 (beginning-of-line)
|
|
|
1222
|
|
|
1223 ;; Move compilation-error-list to the elt of compilation-old-error-list
|
|
|
1224 ;; we want.
|
|
|
1225 (setq compilation-error-list compilation-old-error-list)
|
|
|
1226 (while (and compilation-error-list
|
|
|
1227 (> (point) (car (car compilation-error-list))))
|
|
|
1228 (setq compilation-error-list (cdr compilation-error-list)))
|
|
|
1229
|
|
|
1230 ;; Move to another window, so that next-error's window changes
|
|
|
1231 ;; result in the desired setup.
|
|
|
1232 (or (one-window-p)
|
|
|
1233 (progn
|
|
|
1234 (other-window -1)
|
|
|
1235 ;; other-window changed the selected buffer,
|
|
|
1236 ;; but we didn't want to do that.
|
|
|
1237 (set-buffer compilation-last-buffer)))
|
|
|
1238
|
|
|
1239 (push-mark)
|
|
|
1240 (next-error 1))
|
|
|
1241
|
|
|
1242 ;; XEmacs addition
|
|
|
1243 (defun compile-mouse-maybe-goto-error (event &optional click-count)
|
|
|
1244 (interactive "e")
|
|
|
1245 (if (equal (event-button event) 2)
|
|
|
1246 (let ((buffer (current-buffer))
|
|
|
1247 (point (point))
|
|
|
1248 (config (current-window-configuration)))
|
|
|
1249 (condition-case nil
|
|
|
1250 (progn
|
|
|
1251 (compile-mouse-goto-error event)
|
|
|
1252 t)
|
|
|
1253 (error
|
|
|
1254 (set-window-configuration config)
|
|
|
1255 (set-buffer buffer)
|
|
|
1256 (goto-char point)
|
|
|
1257 nil)))))
|
|
|
1258
|
|
|
1259 ;; Return a compilation buffer.
|
|
|
1260 ;; If the current buffer is a compilation buffer, return it.
|
|
|
1261 ;; If compilation-last-buffer is set to a live buffer, use that.
|
|
|
1262 ;; Otherwise, look for a compilation buffer and signal an error
|
|
|
1263 ;; if there are none.
|
|
|
1264 (defun compilation-find-buffer (&optional other-buffer)
|
|
|
1265 (if (and (not other-buffer)
|
|
|
1266 (compilation-buffer-p (current-buffer)))
|
|
|
1267 ;; The current buffer is a compilation buffer.
|
|
|
1268 (current-buffer)
|
|
|
1269 (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
|
|
2
|
1270 (compilation-buffer-p compilation-last-buffer)
|
|
0
|
1271 (or (not other-buffer) (not (eq compilation-last-buffer
|
|
|
1272 (current-buffer)))))
|
|
|
1273 compilation-last-buffer
|
|
|
1274 (let ((buffers (buffer-list)))
|
|
|
1275 (while (and buffers (or (not (compilation-buffer-p (car buffers)))
|
|
|
1276 (and other-buffer
|
|
|
1277 (eq (car buffers) (current-buffer)))))
|
|
|
1278 (setq buffers (cdr buffers)))
|
|
|
1279 (if buffers
|
|
|
1280 (car buffers)
|
|
|
1281 (or (and other-buffer
|
|
|
1282 (compilation-buffer-p (current-buffer))
|
|
|
1283 ;; The current buffer is a compilation buffer.
|
|
|
1284 (progn
|
|
|
1285 (if other-buffer
|
|
|
1286 (message "This is the only compilation buffer."))
|
|
|
1287 (current-buffer)))
|
|
|
1288 (error "No compilation started!")))))))
|
|
|
1289
|
|
|
1290 ;;;###autoload
|
|
|
1291 (defun next-error (&optional argp)
|
|
|
1292 "Visit next compilation error message and corresponding source code.
|
|
|
1293 This operates on the output from the \\[compile] command.
|
|
|
1294 If all preparsed error messages have been processed,
|
|
|
1295 the error message buffer is checked for new ones.
|
|
|
1296
|
|
|
1297 A prefix arg specifies how many error messages to move;
|
|
|
1298 negative means move back to previous error messages.
|
|
|
1299 Just C-u as a prefix means reparse the error message buffer
|
|
|
1300 and start at the first error.
|
|
|
1301
|
|
|
1302 \\[next-error] normally applies to the most recent compilation started,
|
|
|
1303 but as long as you are in the middle of parsing errors from one compilation
|
|
|
1304 output buffer, you stay with that compilation output buffer.
|
|
|
1305
|
|
|
1306 Use \\[next-error] in a compilation output buffer to switch to
|
|
|
1307 processing errors from that compilation.
|
|
|
1308
|
|
|
1309 See variables `compilation-parse-errors-function' and
|
|
|
1310 \`compilation-error-regexp-alist' for customization ideas."
|
|
|
1311 (interactive "P")
|
|
|
1312 (setq compilation-last-buffer (compilation-find-buffer))
|
|
|
1313 (compilation-goto-locus (compilation-next-error-locus
|
|
|
1314 ;; We want to pass a number here only if
|
|
|
1315 ;; we got a numeric prefix arg, not just C-u.
|
|
|
1316 (and (not (consp argp))
|
|
|
1317 (prefix-numeric-value argp))
|
|
|
1318 (consp argp))))
|
|
2
|
1319 ;;;###autoload (define-key ctl-x-map "`" 'next-error)
|
|
0
|
1320
|
|
|
1321 ;; XEmacs change
|
|
|
1322 ;;;###autoload
|
|
|
1323 (defun previous-error (&optional argp)
|
|
|
1324 "Visit previous compilation error message and corresponding source code.
|
|
|
1325 This operates on the output from the \\[compile] command."
|
|
|
1326 (interactive "P")
|
|
|
1327 (next-error (cond ((null argp) -1)
|
|
|
1328 ((numberp argp) (- argp))
|
|
|
1329 (t argp))))
|
|
|
1330
|
|
|
1331 ;;;###autoload
|
|
|
1332 (defun first-error ()
|
|
|
1333 "Reparse the error message buffer and start at the first error
|
|
|
1334 Visit corresponding source code.
|
|
|
1335 This operates on the output from the \\[compile] command."
|
|
|
1336 (interactive)
|
|
|
1337 (next-error '(4)))
|
|
|
1338
|
|
|
1339 (defun compilation-next-error-locus (&optional move reparse silent)
|
|
|
1340 "Visit next compilation error and return locus in corresponding source code.
|
|
|
1341 This operates on the output from the \\[compile] command.
|
|
|
1342 If all preparsed error messages have been processed,
|
|
|
1343 the error message buffer is checked for new ones.
|
|
|
1344
|
|
|
1345 Returns a cons (ERROR . SOURCE) of two markers: ERROR is a marker at the
|
|
|
1346 location of the error message in the compilation buffer, and SOURCE is a
|
|
|
1347 marker at the location in the source code indicated by the error message.
|
|
|
1348
|
|
|
1349 Optional first arg MOVE says how many error messages to move forwards (or
|
|
|
1350 backwards, if negative); default is 1. Optional second arg REPARSE, if
|
|
|
1351 non-nil, says to reparse the error message buffer and reset to the first
|
|
|
1352 error (plus MOVE - 1). If optional third argument SILENT is non-nil, return
|
|
|
1353 nil instead of raising an error if there are no more errors.
|
|
|
1354
|
|
|
1355 The current buffer should be the desired compilation output buffer."
|
|
|
1356 (or move (setq move 1))
|
|
|
1357 (compile-reinitialize-errors reparse nil (and (not reparse)
|
|
|
1358 (if (< move 1) 0 (1- move))))
|
|
|
1359 (let (next-errors next-error)
|
|
|
1360 (catch 'no-next-error
|
|
|
1361 (save-excursion
|
|
|
1362 (set-buffer compilation-last-buffer)
|
|
|
1363 ;; compilation-error-list points to the "current" error.
|
|
|
1364 (setq next-errors
|
|
|
1365 (if (> move 0)
|
|
|
1366 (nthcdr (1- move)
|
|
|
1367 compilation-error-list)
|
|
|
1368 ;; Zero or negative arg; we need to move back in the list.
|
|
|
1369 (let ((n (1- move))
|
|
|
1370 (i 0)
|
|
|
1371 (e compilation-old-error-list))
|
|
|
1372 ;; See how many cdrs away the current error is from the start.
|
|
|
1373 (while (not (eq e compilation-error-list))
|
|
|
1374 (setq i (1+ i)
|
|
|
1375 e (cdr e)))
|
|
|
1376 (if (> (- n) i)
|
|
|
1377 (error "Moved back past first error")
|
|
|
1378 (nthcdr (+ i n) compilation-old-error-list))))
|
|
|
1379 next-error (car next-errors))
|
|
|
1380 (while
|
|
|
1381 (if (null next-error)
|
|
|
1382 (progn
|
|
|
1383 (and move (/= move 1)
|
|
|
1384 (error (if (> move 0)
|
|
|
1385 "Moved past last error"
|
|
|
1386 "Moved back past first error")))
|
|
|
1387 ;; Forget existing error messages if compilation has finished.
|
|
|
1388 ;;; XEmacs change by Barry Warsaw.
|
|
|
1389 ;;; Without this, if you get a "no more errors" error, then you can't do
|
|
|
1390 ;;; previous-error or goto-error until you kill the buffer.
|
|
|
1391 ; (if (not (and (get-buffer-process (current-buffer))
|
|
|
1392 ; (eq (process-status
|
|
|
1393 ; (get-buffer-process
|
|
|
1394 ; (current-buffer)))
|
|
|
1395 ; 'run)))
|
|
|
1396 ; (compilation-forget-errors))
|
|
|
1397 (if silent
|
|
|
1398 (throw 'no-next-error nil)
|
|
|
1399 (error (concat compilation-error-message
|
|
|
1400 (and (get-buffer-process (current-buffer))
|
|
2
|
1401 (eq (process-status
|
|
|
1402 (get-buffer-process
|
|
0
|
1403 (current-buffer)))
|
|
|
1404 'run)
|
|
|
1405 " yet")))))
|
|
|
1406 (setq compilation-error-list (cdr next-errors))
|
|
|
1407 (if (null (cdr next-error))
|
|
|
1408 ;; This error is boring. Go to the next.
|
|
|
1409 t
|
|
|
1410 (or (markerp (cdr next-error))
|
|
|
1411 ;; This error has a filename/lineno pair.
|
|
|
1412 ;; Find the file and turn it into a marker.
|
|
|
1413 (let* ((fileinfo (car (cdr next-error)))
|
|
|
1414 (cbuf (current-buffer)) ;XEmacs addition
|
|
|
1415 (buffer (apply 'compilation-find-file
|
|
|
1416 (car next-error) fileinfo)))
|
|
|
1417 (if (null buffer)
|
|
|
1418 ;; We can't find this error's file.
|
|
|
1419 ;; Remove all errors in the same file.
|
|
|
1420 (progn
|
|
|
1421 (setq next-errors compilation-old-error-list)
|
|
|
1422 (while next-errors
|
|
|
1423 (and (consp (cdr (car next-errors)))
|
|
|
1424 (equal (car (cdr (car next-errors)))
|
|
|
1425 fileinfo)
|
|
|
1426 (progn
|
|
|
1427 (set-marker (car (car next-errors)) nil)
|
|
|
1428 (setcdr (car next-errors) nil)))
|
|
|
1429 (setq next-errors (cdr next-errors)))
|
|
|
1430 ;; Look for the next error.
|
|
|
1431 t)
|
|
|
1432 ;; We found the file. Get a marker for this error.
|
|
|
1433 ;; compilation-old-error-list is a buffer-local
|
|
|
1434 ;; variable, so we must be careful to extract its value
|
|
|
1435 ;; before switching to the source file buffer.
|
|
|
1436 (let ((errors compilation-old-error-list)
|
|
|
1437 (last-line (nth 1 (cdr next-error)))
|
|
|
1438 (column (nth 2 (cdr next-error))))
|
|
|
1439 (set-buffer buffer)
|
|
|
1440 (save-excursion
|
|
|
1441 (save-restriction
|
|
|
1442 (widen)
|
|
|
1443 (goto-line last-line)
|
|
|
1444 (if (and column (> column 0))
|
|
|
1445 ;; Columns in error msgs are 1-origin.
|
|
|
1446 (move-to-column (1- column))
|
|
|
1447 (beginning-of-line))
|
|
|
1448 (setcdr next-error (point-marker))
|
|
|
1449 ;; Make all the other error messages referring
|
|
|
1450 ;; to the same file have markers into the buffer.
|
|
|
1451 (while errors
|
|
|
1452 (and (consp (cdr (car errors)))
|
|
|
1453 (equal (car (cdr (car errors))) fileinfo)
|
|
|
1454 (let* ((this (nth 1 (cdr (car errors))))
|
|
|
1455 (column (nth 2 (cdr (car errors))))
|
|
|
1456 (lines (- this last-line)))
|
|
|
1457 (if (eq selective-display t)
|
|
|
1458 ;; When selective-display is t,
|
|
|
1459 ;; each C-m is a line boundary,
|
|
|
1460 ;; as well as each newline.
|
|
|
1461 (if (< lines 0)
|
|
|
1462 (re-search-backward "[\n\C-m]"
|
|
|
1463 nil 'end
|
|
|
1464 (- lines))
|
|
|
1465 (re-search-forward "[\n\C-m]"
|
|
|
1466 nil 'end
|
|
|
1467 lines))
|
|
|
1468 (forward-line lines))
|
|
|
1469 (if (and column (> column 1))
|
|
|
1470 (move-to-column (1- column))
|
|
|
1471 (beginning-of-line))
|
|
|
1472 (setq last-line this)
|
|
|
1473 (setcdr (car errors) (point-marker))))
|
|
|
1474 (setq errors (cdr errors)))))
|
|
|
1475 ;; XEmacs addition
|
|
|
1476 (set-buffer cbuf)))))
|
|
|
1477 ;; If we didn't get a marker for this error, or this
|
|
|
1478 ;; marker's buffer was killed, go on to the next one.
|
|
|
1479 (or (not (markerp (cdr next-error)))
|
|
|
1480 (not (marker-buffer (cdr next-error))))))
|
|
|
1481 (setq next-errors compilation-error-list
|
|
|
1482 next-error (car next-errors)))
|
|
|
1483
|
|
|
1484 ;; XEmacs -- move this inside save-excursion
|
|
|
1485 ;; Skip over multiple error messages for the same source location,
|
|
|
1486 ;; so the next C-x ` won't go to an error in the same place.
|
|
|
1487 (while (and compilation-error-list
|
|
|
1488 (equal (cdr (car compilation-error-list))
|
|
|
1489 (cdr next-error)))
|
|
|
1490 (setq compilation-error-list (cdr compilation-error-list)))
|
|
|
1491 ))
|
|
|
1492
|
|
|
1493 ;; XEmacs change: If a new window has to be displayed, select the other
|
|
|
1494 ;; window to avoid swapping the position of the compilation error buffer.
|
|
|
1495 (and next-error (get-buffer-window (marker-buffer (car next-error)))
|
|
|
1496 (progn
|
|
|
1497 (select-window (get-buffer-window (marker-buffer (car next-error))))
|
|
|
1498 (other-window -1)))
|
|
|
1499
|
|
|
1500 ;; We now have a marker for the position of the error source code.
|
|
|
1501 ;; NEXT-ERROR is a cons (ERROR . SOURCE) of two markers.
|
|
|
1502 next-error))
|
|
|
1503
|
|
|
1504 (defun compilation-goto-locus (next-error)
|
|
|
1505 "Jump to an error locus returned by `compilation-next-error-locus'.
|
|
|
1506 Takes one argument, a cons (ERROR . SOURCE) of two markers.
|
|
|
1507 Selects a window with point at SOURCE, with another window displaying ERROR."
|
|
|
1508 ;; XEmacs: this code is horrendous, and makes windows do all sorts of
|
|
|
1509 ;; weird things when you're using separate frames for the compilation
|
|
|
1510 ;; and source buffer.
|
|
|
1511 ; (if (and (window-dedicated-p (selected-window))
|
|
|
1512 ; (eq (selected-window) (frame-root-window)))
|
|
|
1513 ; (switch-to-buffer-other-frame (marker-buffer (cdr next-error)))
|
|
|
1514 ; (switch-to-buffer (marker-buffer (cdr next-error))))
|
|
|
1515 ; (goto-char (cdr next-error))
|
|
|
1516 ; ;; If narrowing got in the way of
|
|
|
1517 ; ;; going to the right place, widen.
|
|
|
1518 ; (or (= (point) (marker-position (cdr next-error)))
|
|
|
1519 ; (progn
|
|
|
1520 ; (widen)
|
|
|
1521 ; (goto-char (cdr next-error))))
|
|
|
1522 ;
|
|
|
1523 ; ;; Show compilation buffer in other window, scrolled to this error.
|
|
|
1524 ; (let* ((pop-up-windows t)
|
|
|
1525 ; (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible)
|
|
|
1526 ; (display-buffer (marker-buffer (car next-error))))))
|
|
|
1527 ; (set-window-point w (car next-error))
|
|
|
1528 ; (set-window-start w (car next-error))
|
|
|
1529 ; (compilation-set-window-height w)))
|
|
|
1530
|
|
|
1531 (let* ((pop-up-windows t)
|
|
|
1532 (compilation-buffer (marker-buffer (car next-error)))
|
|
|
1533 (source-buffer (marker-buffer (cdr next-error)))
|
|
|
1534 ;; make sure compilation buffer is visible ...
|
|
|
1535 (compilation-window
|
|
|
1536 ;; Use an existing window if it is in a visible frame.
|
|
|
1537 (or (get-buffer-window compilation-buffer 'visible)
|
|
|
1538 ;; Pop up a window.
|
|
|
1539 (display-buffer compilation-buffer))))
|
|
|
1540
|
|
|
1541 ;; now, make the compilation buffer **STAY WHERE IT IS** and
|
|
|
1542 ;; make sure the source buffer is visible
|
|
|
1543
|
|
|
1544 (select-window compilation-window)
|
|
|
1545 (pop-to-buffer source-buffer)
|
|
|
1546
|
|
|
1547 ;; now put things aright in the compilation window.
|
|
|
1548 (set-window-point compilation-window (car next-error))
|
|
|
1549 (set-window-start compilation-window (car next-error))
|
|
|
1550 (compilation-set-window-height compilation-window)
|
|
|
1551
|
|
|
1552 ;; now put things aright in the source window.
|
|
|
1553
|
|
|
1554 (set-buffer source-buffer)
|
|
|
1555 (goto-char (cdr next-error))
|
|
|
1556 ;; If narrowing got in the way of
|
|
|
1557 ;; going to the right place, widen.
|
|
|
1558 (or (= (point) (marker-position (cdr next-error)))
|
|
|
1559 (progn
|
|
|
1560 (widen)
|
|
|
1561 (goto-char (cdr next-error))))))
|
|
2
|
1562
|
|
0
|
1563
|
|
|
1564 ;; Find a buffer for file FILENAME.
|
|
|
1565 ;; Search the directories in compilation-search-path.
|
|
|
1566 ;; A nil in compilation-search-path means to try the
|
|
|
1567 ;; current directory, which is passed in DIR.
|
|
|
1568 ;; If FILENAME is not found at all, ask the user where to find it.
|
|
|
1569 ;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user.
|
|
|
1570 (defun compilation-find-file (marker filename dir &rest formats)
|
|
|
1571 (or formats (setq formats '("%s")))
|
|
|
1572 (let ((dirs compilation-search-path)
|
|
|
1573 buffer thisdir fmts name)
|
|
|
1574 (if (file-name-absolute-p filename)
|
|
|
1575 ;; The file name is absolute. Use its explicit directory as
|
|
|
1576 ;; the first in the search path, and strip it from FILENAME.
|
|
|
1577 (setq filename (abbreviate-file-name (expand-file-name filename))
|
|
|
1578 dirs (cons (file-name-directory filename) dirs)
|
|
|
1579 filename (file-name-nondirectory filename)))
|
|
|
1580 ;; Now search the path.
|
|
|
1581 (while (and dirs (null buffer))
|
|
|
1582 (setq thisdir (or (car dirs) dir)
|
|
|
1583 fmts formats)
|
|
|
1584 ;; For each directory, try each format string.
|
|
|
1585 (while (and fmts (null buffer))
|
|
|
1586 (setq name (expand-file-name (format (car fmts) filename) thisdir)
|
|
|
1587 buffer (and (file-exists-p name)
|
|
|
1588 (find-file-noselect name))
|
|
|
1589 fmts (cdr fmts)))
|
|
|
1590 (setq dirs (cdr dirs)))
|
|
|
1591 (or buffer
|
|
|
1592 ;; The file doesn't exist.
|
|
|
1593 ;; Ask the user where to find it.
|
|
|
1594 ;; If he hits C-g, then the next time he does
|
|
|
1595 ;; next-error, he'll skip past it.
|
|
|
1596 (let* ((pop-up-windows t)
|
|
|
1597 (w (display-buffer (marker-buffer marker))))
|
|
|
1598 (set-window-point w marker)
|
|
|
1599 (set-window-start w marker)
|
|
|
1600 (let ((name (expand-file-name
|
|
|
1601 (read-file-name
|
|
|
1602 (format "Find this error in: (default %s) "
|
|
|
1603 filename)
|
|
|
1604 dir filename t))))
|
|
|
1605 (if (file-directory-p name)
|
|
|
1606 (setq name (expand-file-name filename name)))
|
|
|
1607 (and (file-exists-p name)
|
|
|
1608 (find-file-noselect name)))))))
|
|
|
1609
|
|
|
1610 ;; Set compilation-error-list to nil, and unchain the markers that point to the
|
|
|
1611 ;; error messages and their text, so that they no longer slow down gap motion.
|
|
|
1612 ;; This would happen anyway at the next garbage collection, but it is better to
|
|
|
1613 ;; do it right away.
|
|
|
1614 (defun compilation-forget-errors ()
|
|
|
1615 (while compilation-old-error-list
|
|
|
1616 (let ((next-error (car compilation-old-error-list)))
|
|
|
1617 (set-marker (car next-error) nil)
|
|
|
1618 (if (markerp (cdr next-error))
|
|
|
1619 (set-marker (cdr next-error) nil)))
|
|
|
1620 (setq compilation-old-error-list (cdr compilation-old-error-list)))
|
|
|
1621 (setq compilation-error-list nil
|
|
|
1622 compilation-directory-stack nil
|
|
|
1623 compilation-parsing-end 1))
|
|
|
1624
|
|
|
1625
|
|
|
1626 (defun count-regexp-groupings (regexp)
|
|
|
1627 "Return the number of \\( ... \\) groupings in REGEXP (a string)."
|
|
|
1628 (let ((groupings 0)
|
|
|
1629 (len (length regexp))
|
|
|
1630 (i 0)
|
|
|
1631 c)
|
|
|
1632 (while (< i len)
|
|
|
1633 (setq c (aref regexp i)
|
|
|
1634 i (1+ i))
|
|
|
1635 (cond ((= c ?\[)
|
|
|
1636 ;; Find the end of this [...].
|
|
|
1637 (while (and (< i len)
|
|
|
1638 (not (= (aref regexp i) ?\])))
|
|
|
1639 (setq i (1+ i))))
|
|
|
1640 ((= c ?\\)
|
|
|
1641 (if (< i len)
|
|
|
1642 (progn
|
|
|
1643 (setq c (aref regexp i)
|
|
|
1644 i (1+ i))
|
|
|
1645 (if (= c ?\))
|
|
|
1646 ;; We found the end of a grouping,
|
|
|
1647 ;; so bump our counter.
|
|
|
1648 (setq groupings (1+ groupings))))))))
|
|
|
1649 groupings))
|
|
|
1650
|
|
|
1651 (defun compilation-parse-errors (limit-search find-at-least)
|
|
|
1652 "Parse the current buffer as grep, cc or lint error messages.
|
|
|
1653 See variable `compilation-parse-errors-function' for the interface it uses."
|
|
|
1654 (setq compilation-error-list nil)
|
|
193
|
1655 (display-message 'progress "Parsing error messages...")
|
|
0
|
1656 (let (;;text-buffer -- unused
|
|
|
1657 orig orig-expanded parent-expanded
|
|
|
1658 regexp enter-group leave-group error-group
|
|
|
1659 alist subexpr error-regexp-groups
|
|
|
1660 (found-desired nil)
|
|
116
|
1661 (compilation-num-errors-found 0)
|
|
|
1662 (message-freq (max 1 (/ (count-lines (point-min) (point-max)) 50))))
|
|
0
|
1663
|
|
|
1664 ;; Don't reparse messages already seen at last parse.
|
|
|
1665 (goto-char compilation-parsing-end)
|
|
|
1666 ;; Don't parse the first two lines as error messages.
|
|
|
1667 ;; This matters for grep.
|
|
|
1668 (if (bobp)
|
|
|
1669 (progn
|
|
|
1670 (forward-line 2)
|
|
|
1671 ;; Move back so point is before the newline.
|
|
|
1672 ;; This matters because some error regexps use \n instead of ^
|
|
|
1673 ;; to be faster.
|
|
|
1674 (forward-char -1)))
|
|
|
1675
|
|
|
1676 ;; Compile all the regexps we want to search for into one.
|
|
|
1677 (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|"
|
|
|
1678 "\\(" compilation-leave-directory-regexp "\\)\\|"
|
|
|
1679 "\\(" (mapconcat (function
|
|
|
1680 (lambda (elt)
|
|
|
1681 (concat "\\(" (car elt) "\\)")))
|
|
|
1682 compilation-error-regexp-alist
|
|
|
1683 "\\|") "\\)"))
|
|
|
1684
|
|
|
1685 ;; Find out how many \(...\) groupings are in each of the regexps, and set
|
|
|
1686 ;; *-GROUP to the grouping containing each constituent regexp (whose
|
|
|
1687 ;; subgroups will come immediately thereafter) of the big regexp we have
|
|
|
1688 ;; just constructed.
|
|
|
1689 (setq enter-group 1
|
|
|
1690 leave-group (+ enter-group
|
|
|
1691 (count-regexp-groupings
|
|
|
1692 compilation-enter-directory-regexp)
|
|
|
1693 1)
|
|
|
1694 error-group (+ leave-group
|
|
|
1695 (count-regexp-groupings
|
|
|
1696 compilation-leave-directory-regexp)
|
|
|
1697 1))
|
|
|
1698
|
|
|
1699 ;; Compile an alist (IDX FILE LINE [COL]), where IDX is the number of
|
|
|
1700 ;; the subexpression for an entire error-regexp, and FILE and LINE (and
|
|
|
1701 ;; possibly COL) are the numbers for the subexpressions giving the file
|
|
|
1702 ;; name and line number (and possibly column number).
|
|
|
1703 (setq alist (or compilation-error-regexp-alist
|
|
|
1704 (error "compilation-error-regexp-alist is empty!"))
|
|
|
1705 subexpr (1+ error-group))
|
|
|
1706 (while alist
|
|
2
|
1707 (setq error-regexp-groups
|
|
|
1708 (cons (list subexpr
|
|
|
1709 (+ subexpr (nth 1 (car alist)))
|
|
|
1710 (+ subexpr (nth 2 (car alist)))
|
|
|
1711 ;;#### This is buggy in FSFmacs
|
|
|
1712 (let ((col (nth 3 (car alist))))
|
|
|
1713 (and col
|
|
|
1714 (+ subexpr col))))
|
|
|
1715 error-regexp-groups))
|
|
0
|
1716 (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
|
|
|
1717 (setq alist (cdr alist)))
|
|
|
1718
|
|
|
1719 ;; Set up now the expanded, abbreviated directory variables
|
|
|
1720 ;; that compile-abbreviate-directory will need, so we can
|
|
|
1721 ;; compute them just once here.
|
|
|
1722 (setq orig (abbreviate-file-name default-directory)
|
|
|
1723 orig-expanded (abbreviate-file-name
|
|
|
1724 (file-truename default-directory))
|
|
|
1725 parent-expanded (abbreviate-file-name
|
|
|
1726 (expand-file-name "../" orig-expanded)))
|
|
|
1727
|
|
|
1728 (while (and (not found-desired)
|
|
|
1729 ;; We don't just pass LIMIT-SEARCH to re-search-forward
|
|
|
1730 ;; because we want to find matches containing LIMIT-SEARCH
|
|
|
1731 ;; but which extend past it.
|
|
88
|
1732 ;; Instead of using re-search-forward,
|
|
|
1733 ;; we use this loop which tries only at each line.
|
|
|
1734 (progn
|
|
|
1735 (while (and (not (eobp))
|
|
|
1736 (not (looking-at regexp)))
|
|
|
1737 (forward-line 1))
|
|
|
1738 (not (eobp))))
|
|
|
1739
|
|
|
1740 ;; Move to the end of the match we just found.
|
|
|
1741 (goto-char (match-end 0))
|
|
0
|
1742
|
|
|
1743 ;; Figure out which constituent regexp matched.
|
|
|
1744 (cond ((match-beginning enter-group)
|
|
|
1745 ;; The match was the enter-directory regexp.
|
|
|
1746 (let ((dir
|
|
|
1747 (file-name-as-directory
|
|
|
1748 (expand-file-name
|
|
|
1749 (buffer-substring (match-beginning (+ enter-group 1))
|
|
|
1750 (match-end (+ enter-group 1)))))))
|
|
|
1751 ;; The directory name in the "entering" message
|
|
|
1752 ;; is a truename. Try to convert it to a form
|
|
|
1753 ;; like what the user typed in.
|
|
|
1754 (setq dir
|
|
|
1755 (compile-abbreviate-directory dir orig orig-expanded
|
|
|
1756 parent-expanded))
|
|
|
1757 (setq compilation-directory-stack
|
|
|
1758 (cons dir compilation-directory-stack))
|
|
|
1759 (and (file-directory-p dir)
|
|
|
1760 (setq default-directory dir)))
|
|
|
1761
|
|
|
1762 (and limit-search (>= (point) limit-search)
|
|
|
1763 ;; The user wanted a specific error, and we're past it.
|
|
|
1764 ;; We do this check here (and in the leave-group case)
|
|
|
1765 ;; rather than at the end of the loop because if the last
|
|
|
1766 ;; thing seen is an error message, we must carefully
|
|
|
1767 ;; discard the last error when it is the first in a new
|
|
|
1768 ;; file (see below in the error-group case).
|
|
|
1769 (setq found-desired t)))
|
|
|
1770
|
|
|
1771 ((match-beginning leave-group)
|
|
|
1772 ;; The match was the leave-directory regexp.
|
|
|
1773 (let ((beg (match-beginning (+ leave-group 1)))
|
|
|
1774 (stack compilation-directory-stack))
|
|
|
1775 (if beg
|
|
|
1776 (let ((dir
|
|
|
1777 (file-name-as-directory
|
|
|
1778 (expand-file-name
|
|
|
1779 (buffer-substring beg
|
|
|
1780 (match-end (+ leave-group
|
|
|
1781 1)))))))
|
|
|
1782 ;; The directory name in the "leaving" message
|
|
|
1783 ;; is a truename. Try to convert it to a form
|
|
|
1784 ;; like what the user typed in.
|
|
|
1785 (setq dir
|
|
|
1786 (compile-abbreviate-directory dir orig orig-expanded
|
|
|
1787 parent-expanded))
|
|
|
1788 (while (and stack
|
|
|
1789 (not (string-equal (car stack) dir)))
|
|
|
1790 (setq stack (cdr stack)))))
|
|
|
1791 (setq compilation-directory-stack (cdr stack))
|
|
|
1792 (setq stack (car compilation-directory-stack))
|
|
|
1793 (if stack
|
|
|
1794 (setq default-directory stack))
|
|
|
1795 )
|
|
|
1796
|
|
|
1797 (and limit-search (>= (point) limit-search)
|
|
|
1798 ;; The user wanted a specific error, and we're past it.
|
|
|
1799 ;; We do this check here (and in the enter-group case)
|
|
|
1800 ;; rather than at the end of the loop because if the last
|
|
|
1801 ;; thing seen is an error message, we must carefully
|
|
|
1802 ;; discard the last error when it is the first in a new
|
|
|
1803 ;; file (see below in the error-group case).
|
|
|
1804 (setq found-desired t)))
|
|
|
1805
|
|
|
1806 ((match-beginning error-group)
|
|
|
1807 ;; The match was the composite error regexp.
|
|
|
1808 ;; Find out which individual regexp matched.
|
|
|
1809 (setq alist error-regexp-groups)
|
|
|
1810 (while (and alist
|
|
|
1811 (null (match-beginning (car (car alist)))))
|
|
|
1812 (setq alist (cdr alist)))
|
|
|
1813 (if alist
|
|
|
1814 (setq alist (car alist))
|
|
|
1815 (error "compilation-parse-errors: impossible regexp match!"))
|
|
|
1816
|
|
|
1817 ;; Extract the file name and line number from the error message.
|
|
|
1818 (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes
|
|
|
1819 (filename (buffer-substring (match-beginning (nth 1 alist))
|
|
|
1820 (match-end (nth 1 alist))))
|
|
|
1821 (linenum (string-to-int
|
|
|
1822 (buffer-substring
|
|
|
1823 (match-beginning (nth 2 alist))
|
|
|
1824 (match-end (nth 2 alist)))))
|
|
|
1825 (column (and (nth 3 alist)
|
|
|
1826 (match-beginning (nth 3 alist))
|
|
|
1827 (string-to-int
|
|
|
1828 (buffer-substring
|
|
|
1829 (match-beginning (nth 3 alist))
|
|
|
1830 (match-end (nth 3 alist)))))))
|
|
|
1831
|
|
|
1832 ;; Check for a comint-file-name-prefix and prepend it if
|
|
|
1833 ;; appropriate. (This is very useful for
|
|
|
1834 ;; compilation-minor-mode in an rlogin-mode buffer.)
|
|
|
1835 (and (boundp 'comint-file-name-prefix)
|
|
|
1836 ;; If the file name is relative, default-directory will
|
|
|
1837 ;; already contain the comint-file-name-prefix (done by
|
|
|
1838 ;; compile-abbreviate-directory).
|
|
|
1839 (file-name-absolute-p filename)
|
|
|
1840 (setq filename (concat comint-file-name-prefix filename)))
|
|
2
|
1841
|
|
|
1842 ;; Some compilers (e.g. Sun's java compiler, reportedly)
|
|
|
1843 ;; produce bogus file names like "./bar//foo.c" for the file
|
|
|
1844 ;; "bar/foo.c"; expand-file-name will collapse these into
|
|
|
1845 ;; "/foo.c" and fail to find the appropriate file. So we look
|
|
|
1846 ;; for doubled slashes in the file name and fix them up in the
|
|
|
1847 ;; buffer.
|
|
|
1848 (when (fboundp 'command-line-normalize-file-name)
|
|
|
1849 (setq filename (command-line-normalize-file-name filename)))
|
|
0
|
1850 (setq filename (cons filename (cons default-directory
|
|
|
1851 (nthcdr 4 alist))))
|
|
|
1852
|
|
|
1853
|
|
|
1854 ;; Locate the erring file and line.
|
|
|
1855 ;; Cons a new elt onto compilation-error-list,
|
|
|
1856 ;; giving a marker for the current compilation buffer
|
|
|
1857 ;; location, and the file and line number of the error.
|
|
|
1858 (save-excursion
|
|
|
1859 ;; Save as the start of the error the beginning of the
|
|
|
1860 ;; line containing the match unless the match starts at a
|
|
|
1861 ;; newline, in which case the beginning of the next line.
|
|
|
1862 (goto-char beginning-of-match)
|
|
|
1863 (forward-line (if (eolp) 1 0))
|
|
|
1864 (let ((this (cons (point-marker)
|
|
|
1865 (list filename linenum column))))
|
|
|
1866 ;; Don't add the same source line more than once.
|
|
|
1867 (if (equal (cdr this) (cdr (car compilation-error-list)))
|
|
|
1868 nil
|
|
|
1869 (setq compilation-error-list
|
|
|
1870 (cons this
|
|
|
1871 compilation-error-list))
|
|
|
1872 (setq compilation-num-errors-found
|
|
|
1873 (1+ compilation-num-errors-found)))))
|
|
|
1874 (and (or (and find-at-least (> compilation-num-errors-found
|
|
|
1875 find-at-least))
|
|
|
1876 (and limit-search (>= (point) limit-search)))
|
|
|
1877 ;; We have found as many new errors as the user wants,
|
|
|
1878 ;; or past the buffer position he indicated. We
|
|
|
1879 ;; continue to parse until we have seen all the
|
|
|
1880 ;; consecutive errors in the same file, so the error
|
|
|
1881 ;; positions will be recorded as markers in this buffer
|
|
|
1882 ;; that might change.
|
|
|
1883 (cdr compilation-error-list) ; Must check at least two.
|
|
|
1884 (not (equal (car (cdr (nth 0 compilation-error-list)))
|
|
|
1885 (car (cdr (nth 1 compilation-error-list)))))
|
|
|
1886 (progn
|
|
|
1887 ;; Discard the error just parsed, so that the next
|
|
|
1888 ;; parsing run can get it and the following errors in
|
|
|
1889 ;; the same file all at once. If we didn't do this, we
|
|
|
1890 ;; would have the same problem we are trying to avoid
|
|
|
1891 ;; with the test above, just delayed until the next run!
|
|
|
1892 (setq compilation-error-list
|
|
|
1893 (cdr compilation-error-list))
|
|
|
1894 (goto-char beginning-of-match)
|
|
|
1895 (setq found-desired t)))
|
|
|
1896 )
|
|
|
1897 )
|
|
|
1898 (t
|
|
|
1899 (error "compilation-parse-errors: known groups didn't match!")))
|
|
|
1900
|
|
116
|
1901 (when (= (% compilation-num-errors-found message-freq) 0)
|
|
193
|
1902 (display-message
|
|
|
1903 'progress
|
|
|
1904 (format "Parsing error messages...%d (%.0f%% of buffer)"
|
|
116
|
1905 compilation-num-errors-found
|
|
|
1906 ;; Use floating-point because (* 100 (point)) frequently
|
|
|
1907 ;; exceeds the range of Emacs Lisp integers.
|
|
193
|
1908 (/ (* 100.0 (point)) (point-max)))))
|
|
0
|
1909
|
|
116
|
1910 ;;; This is broken - it foils the logic above which is supposed to ensure
|
|
|
1911 ;;; that all errors for the current file are found before we quit.
|
|
|
1912 ; (and limit-search (>= (point) limit-search)
|
|
|
1913 ; ;; The user wanted a specific error, and we're past it.
|
|
|
1914 ; (setq found-desired t))
|
|
|
1915 )
|
|
0
|
1916 (setq compilation-parsing-end (if found-desired
|
|
|
1917 (point)
|
|
|
1918 ;; We have searched the whole buffer.
|
|
|
1919 (point-max))))
|
|
|
1920 (setq compilation-error-list (nreverse compilation-error-list))
|
|
193
|
1921 (display-message 'progress "Parsing error messages...done"))
|
|
0
|
1922
|
|
|
1923 ;; If directory DIR is a subdir of ORIG or of ORIG's parent,
|
|
|
1924 ;; return a relative name for it starting from ORIG or its parent.
|
|
|
1925 ;; ORIG-EXPANDED is an expanded version of ORIG.
|
|
|
1926 ;; PARENT-EXPANDED is an expanded version of ORIG's parent.
|
|
|
1927 ;; Those two args could be computed here, but we run faster by
|
|
|
1928 ;; having the caller compute them just once.
|
|
|
1929 (defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded)
|
|
|
1930 ;; Apply canonical abbreviations to DIR first thing.
|
|
|
1931 ;; Those abbreviations are already done in the other arguments passed.
|
|
|
1932 (setq dir (abbreviate-file-name dir))
|
|
|
1933
|
|
|
1934 ;; Check for a comint-file-name-prefix and prepend it if appropriate.
|
|
|
1935 ;; (This is very useful for compilation-minor-mode in an rlogin-mode
|
|
|
1936 ;; buffer.)
|
|
|
1937 (if (boundp 'comint-file-name-prefix)
|
|
|
1938 (setq dir (concat comint-file-name-prefix dir)))
|
|
|
1939
|
|
|
1940 (if (and (> (length dir) (length orig-expanded))
|
|
|
1941 (string= orig-expanded
|
|
|
1942 (substring dir 0 (length orig-expanded))))
|
|
|
1943 (setq dir
|
|
|
1944 (concat orig
|
|
|
1945 (substring dir (length orig-expanded)))))
|
|
|
1946 (if (and (> (length dir) (length parent-expanded))
|
|
|
1947 (string= parent-expanded
|
|
|
1948 (substring dir 0 (length parent-expanded))))
|
|
|
1949 (setq dir
|
|
|
1950 (concat (file-name-directory
|
|
|
1951 (directory-file-name orig))
|
|
|
1952 (substring dir (length parent-expanded)))))
|
|
|
1953 dir)
|
|
|
1954
|
|
|
1955 (provide 'compile)
|
|
|
1956
|
|
|
1957 ;;; compile.el ends here
|
