Line data Source code
1 : ;;; compile.el --- run compiler as inferior of Emacs, parse error messages -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 1985-1987, 1993-1999, 2001-2017 Free Software
4 : ;; Foundation, Inc.
5 :
6 : ;; Authors: Roland McGrath <roland@gnu.org>,
7 : ;; Daniel Pfeiffer <occitan@esperanto.org>
8 : ;; Maintainer: emacs-devel@gnu.org
9 : ;; Keywords: tools, processes
10 :
11 : ;; This file is part of GNU Emacs.
12 :
13 : ;; GNU Emacs is free software: you can redistribute it and/or modify
14 : ;; it under the terms of the GNU General Public License as published by
15 : ;; the Free Software Foundation, either version 3 of the License, or
16 : ;; (at your option) any later version.
17 :
18 : ;; GNU Emacs is distributed in the hope that it will be useful,
19 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 : ;; GNU General Public License for more details.
22 :
23 : ;; You should have received a copy of the GNU General Public License
24 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 :
26 : ;;; Commentary:
27 :
28 : ;; This package provides the compile facilities documented in the Emacs user's
29 : ;; manual.
30 :
31 : ;;; Code:
32 :
33 : (eval-when-compile (require 'cl-lib))
34 : (require 'tool-bar)
35 : (require 'comint)
36 :
37 : (defgroup compilation nil
38 : "Run compiler as inferior of Emacs, parse error messages."
39 : :group 'tools
40 : :group 'processes)
41 :
42 :
43 : ;;;###autoload
44 : (defcustom compilation-mode-hook nil
45 : "List of hook functions run by `compilation-mode'."
46 : :type 'hook
47 : :group 'compilation)
48 :
49 : ;;;###autoload
50 : (defcustom compilation-start-hook nil
51 : "Hook run after starting a new compilation process.
52 : The hook is run with one argument, the new process."
53 : :type 'hook
54 : :group 'compilation)
55 :
56 : ;;;###autoload
57 : (defcustom compilation-window-height nil
58 : "Number of lines in a compilation window.
59 : If nil, use Emacs default."
60 : :type '(choice (const :tag "Default" nil)
61 : integer)
62 : :group 'compilation)
63 :
64 : (defvar compilation-filter-hook nil
65 : "Hook run after `compilation-filter' has inserted a string into the buffer.
66 : It is called with the variable `compilation-filter-start' bound
67 : to the position of the start of the inserted text, and point at
68 : its end.
69 :
70 : If Emacs lacks asynchronous process support, this hook is run
71 : after `call-process' inserts the grep output into the buffer.")
72 :
73 : (defvar compilation-filter-start nil
74 : "Position of the start of the text inserted by `compilation-filter'.
75 : This is bound before running `compilation-filter-hook'.")
76 :
77 : (defvar compilation-first-column 1
78 : "This is how compilers number the first column, usually 1 or 0.
79 : If this is buffer-local in the destination buffer, Emacs obeys
80 : that value, otherwise it uses the value in the *compilation*
81 : buffer. This enables a major-mode to specify its own value.")
82 :
83 : (defvar compilation-parse-errors-filename-function nil
84 : "Function to call to post-process filenames while parsing error messages.
85 : It takes one arg FILENAME which is the name of a file as found
86 : in the compilation output, and should return a transformed file name.")
87 :
88 : ;;;###autoload
89 : (defvar compilation-process-setup-function nil
90 : "Function to call to customize the compilation process.
91 : This function is called immediately before the compilation process is
92 : started. It can be used to set any variables or functions that are used
93 : while processing the output of the compilation process.")
94 :
95 : ;;;###autoload
96 : (defvar compilation-buffer-name-function nil
97 : "Function to compute the name of a compilation buffer.
98 : The function receives one argument, the name of the major mode of the
99 : compilation buffer. It should return a string.
100 : If nil, compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.")
101 :
102 : ;;;###autoload
103 : (defvar compilation-finish-function nil
104 : "Function to call when a compilation process finishes.
105 : It is called with two arguments: the compilation buffer, and a string
106 : describing how the process finished.")
107 :
108 : (make-obsolete-variable 'compilation-finish-function
109 : "use `compilation-finish-functions', but it works a little differently."
110 : "22.1")
111 :
112 : ;;;###autoload
113 : (defvar compilation-finish-functions nil
114 : "Functions to call when a compilation process finishes.
115 : Each function is called with two arguments: the compilation buffer,
116 : and a string describing how the process finished.")
117 :
118 : (defvar compilation-in-progress nil
119 : "List of compilation processes now running.")
120 : (or (assq 'compilation-in-progress minor-mode-alist)
121 : (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
122 : minor-mode-alist)))
123 :
124 : (defvar compilation-error "error"
125 : "Stem of message to print when no matches are found.")
126 :
127 : (defvar compilation-arguments nil
128 : "Arguments that were given to `compilation-start'.")
129 :
130 : (defvar compilation-num-errors-found 0)
131 : (defvar compilation-num-warnings-found 0)
132 : (defvar compilation-num-infos-found 0)
133 :
134 : (defconst compilation-mode-line-errors
135 : '(" [" (:propertize (:eval (int-to-string compilation-num-errors-found))
136 : face compilation-error
137 : help-echo "Number of errors so far")
138 : " " (:propertize (:eval (int-to-string compilation-num-warnings-found))
139 : face compilation-warning
140 : help-echo "Number of warnings so far")
141 : " " (:propertize (:eval (int-to-string compilation-num-infos-found))
142 : face compilation-info
143 : help-echo "Number of informational messages so far")
144 : "]"))
145 :
146 : ;; If you make any changes to `compilation-error-regexp-alist-alist',
147 : ;; be sure to run the ERT test in test/lisp/progmodes/compile-tests.el.
148 : ;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit
149 :
150 : (defvar compilation-error-regexp-alist-alist
151 : `((absoft
152 : "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
153 : of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
154 :
155 : (ada
156 : "\\(warning: .*\\)? at \\([^ \n]+\\):\\([0-9]+\\)$" 2 3 nil (1))
157 :
158 : (aix
159 : " in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
160 :
161 : (ant
162 : "^[ \t]*\\[[^] \n]+\\][ \t]*\\(\\(?:[A-Za-z]:\\\\\\)?[^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\):\\)?\
163 : \\( warning\\)?" 1 (2 . 4) (3 . 5) (6))
164 :
165 : (bash
166 : "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
167 :
168 : (borland
169 : "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\
170 : \\([a-zA-Z]?:?[^:( \t\n]+\\)\
171 : \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
172 :
173 : (python-tracebacks-and-caml
174 : "^[ \t]*File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
175 : \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning\\(?: [0-9]+\\)?:\\)?\\)"
176 : 2 (3 . 4) (5 . 6) (7))
177 :
178 : (cmake
179 : "^CMake \\(?:Error\\|\\(Warning\\)\\) at \\(.*\\):\\([1-9][0-9]*\\) ([^)]+):$"
180 : 2 3 nil (1))
181 : (cmake-info
182 : "^ \\(?: \\*\\)?\\(.*\\):\\([1-9][0-9]*\\) ([^)]+)$"
183 : 1 2 nil 0)
184 :
185 : (comma
186 : "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
187 : \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
188 :
189 : (cucumber
190 : "\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\
191 : \\(?: \\)\\([^(].*\\):\\([1-9][0-9]*\\)" 1 2)
192 :
193 : (msft
194 : ;; Must be before edg-1, so that MSVC's longer messages are
195 : ;; considered before EDG.
196 : ;; The message may be a "warning", "error", or "fatal error" with
197 : ;; an error code, or "see declaration of" without an error code.
198 : "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) ?\
199 : : \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
200 : 2 3 nil (4))
201 :
202 : (edg-1
203 : "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
204 : 1 2 nil (3 . 4))
205 : (edg-2
206 : "at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$"
207 : 2 1 nil 0)
208 :
209 : (epc
210 : "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
211 :
212 : (ftnchek
213 : "\\(^Warning .*\\)? line[ \n]\\([0-9]+\\)[ \n]\\(?:col \\([0-9]+\\)[ \n]\\)?file \\([^ :;\n]+\\)"
214 : 4 2 3 (1))
215 :
216 : (iar
217 : "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
218 : 1 2 nil (3))
219 :
220 : (ibm
221 : "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\
222 : \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))
223 :
224 : ;; fixme: should be `mips'
225 : (irix
226 : "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\
227 : \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
228 :
229 : (java
230 : "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
231 :
232 : (jikes-file
233 : "^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0)
234 :
235 :
236 : ;; This used to be pathologically slow on long lines (Bug#3441),
237 : ;; due to matching filenames via \\(.*?\\). This might be faster.
238 : (maven
239 : ;; Maven is a popular free software build tool for Java.
240 : "\\(\\[WARNING\\] *\\)?\\([^ \n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 2 3 4 (1))
241 :
242 : (jikes-line
243 : "^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
244 : nil 1 nil 2 0
245 : (2 (compilation-face '(3))))
246 :
247 : (clang-include
248 : ,(rx bol "In file included from "
249 : (group (+ (not (any ?\n ?:)))) ?:
250 : (group (+ (any (?0 . ?9)))) ?:
251 : eol)
252 : 1 2 nil 0)
253 :
254 : (gcc-include
255 : "^\\(?:In file included \\| \\|\t\\)from \
256 : \\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\
257 : \\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?"
258 : 1 2 3 (4 . 5))
259 :
260 : (ruby-Test::Unit
261 : "^[\t ]*\\[\\([^(].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2)
262 :
263 : (gnu
264 : ;; The first line matches the program name for
265 :
266 : ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
267 :
268 : ;; format, which is used for non-interactive programs other than
269 : ;; compilers (e.g. the "jade:" entry in compilation.txt).
270 :
271 : ;; This first line makes things ambiguous with output such as
272 : ;; "foo:344:50:blabla" since the "foo" part can match this first
273 : ;; line (in which case the file name as "344"). To avoid this,
274 : ;; the second line disallows filenames exclusively composed of
275 : ;; digits.
276 :
277 : ;; Similarly, we get lots of false positives with messages including
278 : ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
279 : ;; the last line tries to rule out message where the info after the
280 : ;; line number starts with "SS". --Stef
281 :
282 : ;; The core of the regexp is the one with *?. It says that a file name
283 : ;; can be composed of any non-newline char, but it also rules out some
284 : ;; valid but unlikely cases, such as a trailing space or a space
285 : ;; followed by a -, or a colon followed by a space.
286 : ;;
287 : ;; The "in \\|from " exception was added to handle messages from Ruby.
288 : ,(rx
289 : bol
290 : (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
291 : (regexp "[ \t]+\\(?:in \\|from\\)")))
292 : (group-n 1 (: (regexp "[0-9]*[^0-9\n]")
293 : (*? (| (regexp "[^\n :]")
294 : (regexp " [^-/\n]")
295 : (regexp ":[^ \n]")))))
296 : (regexp ": ?")
297 : (group-n 2 (regexp "[0-9]+"))
298 : (? (| (: "-"
299 : (group-n 4 (regexp "[0-9]+"))
300 : (? "." (group-n 5 (regexp "[0-9]+"))))
301 : (: (in ".:")
302 : (group-n 3 (regexp "[0-9]+"))
303 : (? "-"
304 : (? (group-n 4 (regexp "[0-9]+")) ".")
305 : (group-n 5 (regexp "[0-9]+"))))))
306 : ":"
307 : (| (: (* " ")
308 : (group-n 6 (| "FutureWarning"
309 : "RuntimeWarning"
310 : "Warning"
311 : "warning"
312 : "W:")))
313 : (: (* " ")
314 : (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)")
315 : "I:"
316 : (: "[ skipping " (+ ".") " ]")
317 : "instantiated from"
318 : "required from"
319 : (regexp "[Nn]ote"))))
320 : (: (* " ")
321 : (regexp "[Ee]rror"))
322 : (: (regexp "[0-9]?")
323 : (| (regexp "[^0-9\n]")
324 : eol))
325 : (regexp "[0-9][0-9][0-9]")))
326 : 1 (2 . 4) (3 . 5) (6 . 7))
327 :
328 : (lcc
329 : "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
330 : 2 3 4 (1))
331 :
332 : (makepp
333 : "^makepp\\(?:\\(?:: warning\\(:\\).*?\\|\\(: Scanning\\|: [LR]e?l?oading makefile\\|: Imported\\|log:.*?\\) \\|: .*?\\)\
334 : `\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)"
335 : 4 5 nil (1 . 2) 3
336 : (0 (progn (save-match-data
337 : (compilation-parse-errors
338 : (match-end 0) (line-end-position)
339 : `("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]"
340 : 2 3 nil
341 : ,(cond ((match-end 1) 1) ((match-end 2) 0) (t 2))
342 : 1)))
343 : (end-of-line)
344 : nil)))
345 :
346 : ;; Should be lint-1, lint-2 (SysV lint)
347 : (mips-1
348 : " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
349 : (mips-2
350 : " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
351 :
352 : (msft
353 : ;; The message may be a "warning", "error", or "fatal error" with
354 : ;; an error code, or "see declaration of" without an error code.
355 : "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
356 : : \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
357 : 2 3 nil (4))
358 :
359 : (omake
360 : ;; "omake -P" reports "file foo changed"
361 : ;; (useful if you do "cvs up" and want to see what has changed)
362 : "omake: file \\(.*\\) changed" 1 nil nil nil nil
363 : ;; FIXME-omake: This tries to prevent reusing pre-existing markers
364 : ;; for subsequent messages, since those messages's line numbers
365 : ;; are about another version of the file.
366 : (0 (progn (compilation--flush-file-structure (match-string 1))
367 : nil)))
368 :
369 : (oracle
370 : "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
371 : \\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\
372 : \\(?:,\\| in\\| of\\)? file \\(.*?\\):?$"
373 : 3 1 2)
374 :
375 : ;; "during global destruction": This comes out under "use
376 : ;; warnings" in recent perl when breaking circular references
377 : ;; during program or thread exit.
378 : (perl
379 : " at \\([^ \n]+\\) line \\([0-9]+\\)\\(?:[,.]\\|$\\| \
380 : during global destruction\\.$\\)" 1 2)
381 :
382 : (php
383 : "\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)"
384 : 2 3 nil nil)
385 :
386 : (rxp
387 : "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\
388 : \\([0-9]+\\) of file://\\(.+\\)"
389 : 4 2 3 (1))
390 :
391 : (sparc-pascal-file
392 : "^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\
393 : [12][09][0-9][0-9] +\\(.*\\):$"
394 : 1 nil nil 0)
395 : (sparc-pascal-line
396 : "^\\(\\(?:E\\|\\(w\\)\\) +[0-9]+\\) line \\([0-9]+\\) - "
397 : nil 3 nil (2) nil (1 (compilation-face '(2))))
398 : (sparc-pascal-example
399 : "^ +\\([0-9]+\\) +.*\n\\(\\(?:e\\|\\(w\\)\\) [0-9]+\\)-+"
400 : nil 1 nil (3) nil (2 (compilation-face '(3))))
401 :
402 : (sun
403 : ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\
404 : File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
405 : 3 4 5 (1 . 2))
406 :
407 : (sun-ada
408 : "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., (-]" 1 2 3)
409 :
410 : (watcom
411 : "^[ \t]*\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)): ?\
412 : \\(?:\\(Error! E[0-9]+\\)\\|\\(Warning! W[0-9]+\\)\\):"
413 : 1 2 nil (4))
414 :
415 : (4bsd
416 : "\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
417 : \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))
418 :
419 : (gcov-file
420 : "^ *-: *\\(0\\):Source:\\(.+\\)$"
421 : 2 1 nil 0 nil)
422 : (gcov-header
423 : "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$"
424 : nil 1 nil 0 nil)
425 : ;; Underlines over all lines of gcov output are too uncomfortable to read.
426 : ;; However, hyperlinks embedded in the lines are useful.
427 : ;; So I put default face on the lines; and then put
428 : ;; compilation-*-face by manually to eliminate the underlines.
429 : ;; The hyperlinks are still effective.
430 : (gcov-nomark
431 : "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$"
432 : nil 1 nil 0 nil
433 : (0 'default)
434 : (1 compilation-line-face))
435 : (gcov-called-line
436 : "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$"
437 : nil 2 nil 0 nil
438 : (0 'default)
439 : (1 compilation-info-face) (2 compilation-line-face))
440 : (gcov-never-called
441 : "^ *\\(#####\\): *\\([0-9]+\\):.*$"
442 : nil 2 nil 2 nil
443 : (0 'default)
444 : (1 compilation-error-face) (2 compilation-line-face))
445 :
446 : (perl--Pod::Checker
447 : ;; podchecker error messages, per Pod::Checker.
448 : ;; The style is from the Pod::Checker::poderror() function, eg.
449 : ;; *** ERROR: Spurious text after =cut at line 193 in file foo.pm
450 : ;;
451 : ;; Plus end_pod() can give "at line EOF" instead of a
452 : ;; number, so for that match "on line N" which is the
453 : ;; originating spot, eg.
454 : ;; *** ERROR: =over on line 37 without closing =back at line EOF in file bar.pm
455 : ;;
456 : ;; Plus command() can give both "on line N" and "at line N";
457 : ;; the latter is desired and is matched because the .* is
458 : ;; greedy.
459 : ;; *** ERROR: =over on line 1 without closing =back (at head1) at line 3 in file x.pod
460 : ;;
461 : "^\\*\\*\\* \\(?:ERROR\\|\\(WARNING\\)\\).* \\(?:at\\|on\\) line \
462 : \\([0-9]+\\) \\(?:.* \\)?in file \\([^ \t\n]+\\)"
463 : 3 2 nil (1))
464 : (perl--Test
465 : ;; perl Test module error messages.
466 : ;; Style per the ok() function "$context", eg.
467 : ;; # Failed test 1 in foo.t at line 6
468 : ;;
469 : "^# Failed test [0-9]+ in \\([^ \t\r\n]+\\) at line \\([0-9]+\\)"
470 : 1 2)
471 : (perl--Test2
472 : ;; Or when comparing got/want values, with a "fail #n" if repeated
473 : ;; # Test 2 got: "xx" (t-compilation-perl-2.t at line 10)
474 : ;; # Test 3 got: "xx" (t-compilation-perl-2.t at line 10 fail #2)
475 : ;;
476 : ;; And under Test::Harness they're preceded by progress stuff with
477 : ;; \r and "NOK",
478 : ;; ... NOK 1# Test 1 got: "1234" (t/foo.t at line 46)
479 : ;;
480 : "^\\(.*NOK.*\\)?# Test [0-9]+ got:.* (\\([^ \t\r\n]+\\) at line \
481 : \\([0-9]+\\)\\( fail #[0-9]+\\)?)"
482 : 2 3)
483 : (perl--Test::Harness
484 : ;; perl Test::Harness output, eg.
485 : ;; NOK 1# Test 1 got: "1234" (t/foo.t at line 46)
486 : ;;
487 : ;; Test::Harness is slightly designed for tty output, since
488 : ;; it prints CRs to overwrite progress messages, but if you
489 : ;; run it in with M-x compile this pattern can at least step
490 : ;; through the failures.
491 : ;;
492 : "^.*NOK.* \\([^ \t\r\n]+\\) at line \\([0-9]+\\)"
493 : 1 2)
494 : (weblint
495 : ;; The style comes from HTML::Lint::Error::as_string(), eg.
496 : ;; index.html (13:1) Unknown element <fdjsk>
497 : ;;
498 : ;; The pattern only matches filenames without spaces, since that
499 : ;; should be usual and should help reduce the chance of a false
500 : ;; match of a message from some unrelated program.
501 : ;;
502 : ;; This message style is quite close to the "ibm" entry which is
503 : ;; for IBM C, though that ibm bit doesn't put a space after the
504 : ;; filename.
505 : ;;
506 : "^\\([^ \t\r\n(]+\\) (\\([0-9]+\\):\\([0-9]+\\)) "
507 : 1 2 3)
508 :
509 : ;; Guile compilation yields file-headers in the following format:
510 : ;;
511 : ;; In sourcefile.scm:
512 : ;;
513 : ;; We need to catch those, but we also need to be aware that Emacs
514 : ;; byte-compilation yields compiler headers in similar form of
515 : ;; those:
516 : ;;
517 : ;; In toplevel form:
518 : ;; In end of data:
519 : ;;
520 : ;; We want to catch the Guile file-headers but not the Emacs
521 : ;; byte-compilation headers, because that will cause next-error
522 : ;; and prev-error to break, because the files "toplevel form" and
523 : ;; "end of data" does not exist.
524 : ;;
525 : ;; To differentiate between these two cases, we require that the
526 : ;; file-match must always contain an extension.
527 : ;;
528 : ;; We should also only treat this as "info", not "error", because
529 : ;; we do not know what lines will follow.
530 : (guile-file "^In \\(.+\\..+\\):\n" 1 nil nil 0)
531 : (guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2)
532 : )
533 : "Alist of values for `compilation-error-regexp-alist'.")
534 :
535 : (defcustom compilation-error-regexp-alist
536 : (mapcar 'car compilation-error-regexp-alist-alist)
537 : "Alist that specifies how to match errors in compiler output.
538 : On GNU and Unix, any string is a valid filename, so these
539 : matchers must make some common sense assumptions, which catch
540 : normal cases. A shorter list will be lighter on resource usage.
541 :
542 : Instead of an alist element, you can use a symbol, which is
543 : looked up in `compilation-error-regexp-alist-alist'. You can see
544 : the predefined symbols and their effects in the file
545 : `etc/compilation.txt' (linked below if you are customizing this).
546 :
547 : Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK
548 : HIGHLIGHT...]). If REGEXP matches, the FILE'th subexpression
549 : gives the file name, and the LINE'th subexpression gives the line
550 : number. The COLUMN'th subexpression gives the column number on
551 : that line.
552 :
553 : If FILE, LINE or COLUMN are nil or that index didn't match, that
554 : information is not present on the matched line. In that case the
555 : file name is assumed to be the same as the previous one in the
556 : buffer, line number defaults to 1 and column defaults to
557 : beginning of line's indentation.
558 :
559 : FILE can also have the form (FILE FORMAT...), where the FORMATs
560 : \(e.g. \"%s.c\") will be applied in turn to the recognized file
561 : name, until a file of that name is found. Or FILE can also be a
562 : function that returns (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
563 : In the former case, FILENAME may be relative or absolute.
564 :
565 : LINE can also be of the form (LINE . END-LINE) meaning a range
566 : of lines. COLUMN can also be of the form (COLUMN . END-COLUMN)
567 : meaning a range of columns starting on LINE and ending on
568 : END-LINE, if that matched.
569 :
570 : TYPE is 2 or nil for a real error or 1 for warning or 0 for info.
571 : TYPE can also be of the form (WARNING . INFO). In that case this
572 : will be equivalent to 1 if the WARNING'th subexpression matched
573 : or else equivalent to 0 if the INFO'th subexpression matched.
574 : See `compilation-error-face', `compilation-warning-face',
575 : `compilation-info-face' and `compilation-skip-threshold'.
576 :
577 : What matched the HYPERLINK'th subexpression has `mouse-face' and
578 : `compilation-message-face' applied. If this is nil, the text
579 : matched by the whole REGEXP becomes the hyperlink.
580 :
581 : Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where
582 : SUBMATCH is the number of a submatch and FACE is an expression
583 : which evaluates to a face name (a symbol or string).
584 : Alternatively, FACE can evaluate to a property list of the
585 : form (face FACE PROP1 VAL1 PROP2 VAL2 ...), in which case all the
586 : listed text properties PROP# are given values VAL# as well."
587 : :type '(repeat (choice (symbol :tag "Predefined symbol")
588 : (sexp :tag "Error specification")))
589 : :link `(file-link :tag "example file"
590 : ,(expand-file-name "compilation.txt" data-directory))
591 : :group 'compilation)
592 :
593 : ;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp)
594 : (defvar compilation-directory nil
595 : "Directory to restore to when doing `recompile'.")
596 :
597 : (defvar compilation-directory-matcher
598 : '("\\(?:Entering\\|Leavin\\(g\\)\\) directory [`']\\(.+\\)'$" (2 . 1))
599 : "A list for tracking when directories are entered or left.
600 : If nil, do not track directories, e.g. if all file names are absolute. The
601 : first element is the REGEXP matching these messages. It can match any number
602 : of variants, e.g. different languages. The remaining elements are all of the
603 : form (DIR . LEAVE). If for any one of these the DIR'th subexpression
604 : matches, that is a directory name. If LEAVE is nil or the corresponding
605 : LEAVE'th subexpression doesn't match, this message is about going into another
606 : directory. If it does match anything, this message is about going back to the
607 : directory we were in before the last entering message. If you change this,
608 : you may also want to change `compilation-page-delimiter'.")
609 :
610 : (defvar compilation-page-delimiter
611 : "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory [`'].+'\n\\)+"
612 : "Value of `page-delimiter' in Compilation mode.")
613 :
614 : (defvar compilation-mode-font-lock-keywords
615 : '(;; configure output lines.
616 : ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$"
617 : (1 font-lock-variable-name-face)
618 : (2 (compilation-face '(4 . 3))))
619 : ;; Command output lines. Recognize `make[n]:' lines too.
620 : ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
621 : (1 font-lock-function-name-face) (3 compilation-line-face nil t))
622 : (" --?o\\(?:utfile\\|utput\\)?[= ]\\(\\S +\\)" . 1)
623 : ("^Compilation \\(finished\\).*"
624 : (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
625 : (1 compilation-info-face))
626 : ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
627 : (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
628 : (1 compilation-error-face)
629 : (2 compilation-error-face nil t)))
630 : "Additional things to highlight in Compilation mode.
631 : This gets tacked on the end of the generated expressions.")
632 :
633 : (defvar compilation-highlight-regexp t
634 : "Regexp matching part of visited source lines to highlight temporarily.
635 : Highlight entire line if t; don't highlight source lines if nil.")
636 :
637 : (defvar compilation-highlight-overlay nil
638 : "Overlay used to temporarily highlight compilation matches.")
639 :
640 : (defcustom compilation-error-screen-columns t
641 : "If non-nil, column numbers in error messages are screen columns.
642 : Otherwise they are interpreted as character positions, with
643 : each character occupying one column.
644 : The default is to use screen columns, which requires that the compilation
645 : program and Emacs agree about the display width of the characters,
646 : especially the TAB character.
647 : If this is buffer-local in the destination buffer, Emacs obeys
648 : that value, otherwise it uses the value in the *compilation*
649 : buffer. This enables a major-mode to specify its own value."
650 : :type 'boolean
651 : :group 'compilation
652 : :version "20.4")
653 :
654 : (defcustom compilation-read-command t
655 : "Non-nil means \\[compile] reads the compilation command to use.
656 : Otherwise, \\[compile] just uses the value of `compile-command'.
657 :
658 : Note that changing this to nil may be a security risk, because a
659 : file might define a malicious `compile-command' as a file local
660 : variable, and you might not notice. Therefore, `compile-command'
661 : is considered unsafe if this variable is nil."
662 : :type 'boolean
663 : :group 'compilation)
664 :
665 : ;;;###autoload
666 : (defcustom compilation-ask-about-save t
667 : "Non-nil means \\[compile] asks which buffers to save before compiling.
668 : Otherwise, it saves all modified buffers without asking."
669 : :type 'boolean
670 : :group 'compilation)
671 :
672 : (defcustom compilation-save-buffers-predicate nil
673 : "The second argument (PRED) passed to `save-some-buffers' before compiling.
674 : E.g., one can set this to
675 : (lambda ()
676 : (string-prefix-p my-compilation-root (file-truename (buffer-file-name))))
677 : to limit saving to files located under `my-compilation-root'.
678 : Note, that, in general, `compilation-directory' cannot be used instead
679 : of `my-compilation-root' here."
680 : :type '(choice
681 : (const :tag "Default (save all file-visiting buffers)" nil)
682 : (const :tag "Save all buffers" t)
683 : function)
684 : :group 'compilation
685 : :version "24.1")
686 :
687 : ;;;###autoload
688 : (defcustom compilation-search-path '(nil)
689 : "List of directories to search for source files named in error messages.
690 : Elements should be directory names, not file names of directories.
691 : The value nil as an element means to try the default directory."
692 : :type '(repeat (choice (const :tag "Default" nil)
693 : (string :tag "Directory")))
694 : :group 'compilation)
695 :
696 : ;;;###autoload
697 : (defcustom compile-command (purecopy "make -k ")
698 : "Last shell command used to do a compilation; default for next compilation.
699 :
700 : Sometimes it is useful for files to supply local values for this variable.
701 : You might also use mode hooks to specify it in certain modes, like this:
702 :
703 : (add-hook \\='c-mode-hook
704 : (lambda ()
705 : (unless (or (file-exists-p \"makefile\")
706 : (file-exists-p \"Makefile\"))
707 : (set (make-local-variable \\='compile-command)
708 : (concat \"make -k \"
709 : (if buffer-file-name
710 : (shell-quote-argument
711 : (file-name-sans-extension buffer-file-name))))))))
712 :
713 : It's often useful to leave a space at the end of the value."
714 : :type 'string
715 : :group 'compilation)
716 : ;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (or (not (boundp 'compilation-read-command)) compilation-read-command))))
717 :
718 : ;;;###autoload
719 : (defcustom compilation-disable-input nil
720 : "If non-nil, send end-of-file as compilation process input.
721 : This only affects platforms that support asynchronous processes (see
722 : `start-process'); synchronous compilation processes never accept input."
723 : :type 'boolean
724 : :group 'compilation
725 : :version "22.1")
726 :
727 : ;; A weak per-compilation-buffer hash indexed by (FILENAME . DIRECTORY). Each
728 : ;; value is a FILE-STRUCTURE as described above, with the car eq to the hash
729 : ;; key. This holds the tree seen from root, for storing new nodes.
730 : (defvar compilation-locs ())
731 :
732 : (defvar compilation-debug nil
733 : "Set this to t before creating a *compilation* buffer.
734 : Then every error line will have a debug text property with the matcher that
735 : fit this line and the match data. Use `describe-text-properties'.")
736 :
737 : (defvar compilation-exit-message-function nil "\
738 : If non-nil, called when a compilation process dies to return a status message.
739 : This should be a function of three arguments: process status, exit status,
740 : and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
741 : write into the compilation buffer, and to put in its mode line.")
742 :
743 : (defcustom compilation-environment nil
744 : "List of environment variables for compilation to inherit.
745 : Each element should be a string of the form ENVVARNAME=VALUE.
746 : This list is temporarily prepended to `process-environment' prior to
747 : starting the compilation process."
748 : :type '(repeat (string :tag "ENVVARNAME=VALUE"))
749 : :options '(("LANG=C"))
750 : :group 'compilation
751 : :version "24.1")
752 :
753 : ;; History of compile commands.
754 : (defvar compile-history nil)
755 :
756 : (defface compilation-error
757 : '((t :inherit error))
758 : "Face used to highlight compiler errors."
759 : :group 'compilation
760 : :version "22.1")
761 :
762 : (defface compilation-warning
763 : '((t :inherit warning))
764 : "Face used to highlight compiler warnings."
765 : :group 'compilation
766 : :version "22.1")
767 :
768 : (defface compilation-info
769 : '((t :inherit success))
770 : "Face used to highlight compiler information."
771 : :group 'compilation
772 : :version "22.1")
773 :
774 : ;; The next three faces must be able to stand out against the
775 : ;; `mode-line' and `mode-line-inactive' faces.
776 :
777 : (defface compilation-mode-line-fail
778 : '((default :inherit compilation-error)
779 : (((class color) (min-colors 16)) (:foreground "Red1" :weight bold))
780 : (((class color) (min-colors 8)) (:foreground "red"))
781 : (t (:inverse-video t :weight bold)))
782 : "Face for Compilation mode's \"error\" mode line indicator."
783 : :group 'compilation
784 : :version "24.3")
785 :
786 : (defface compilation-mode-line-run
787 : '((t :inherit compilation-warning))
788 : "Face for Compilation mode's \"running\" mode line indicator."
789 : :group 'compilation
790 : :version "24.3")
791 :
792 : (defface compilation-mode-line-exit
793 : '((default :inherit compilation-info)
794 : (((class color) (min-colors 16))
795 : (:foreground "ForestGreen" :weight bold))
796 : (((class color)) (:foreground "green" :weight bold))
797 : (t (:weight bold)))
798 : "Face for Compilation mode's \"exit\" mode line indicator."
799 : :group 'compilation
800 : :version "24.3")
801 :
802 : (defface compilation-line-number
803 : '((t :inherit font-lock-keyword-face))
804 : "Face for displaying line numbers in compiler messages."
805 : :group 'compilation
806 : :version "22.1")
807 :
808 : (defface compilation-column-number
809 : '((t :inherit font-lock-doc-face))
810 : "Face for displaying column numbers in compiler messages."
811 : :group 'compilation
812 : :version "22.1")
813 :
814 : (defcustom compilation-message-face 'underline
815 : "Face name to use for whole messages.
816 : Faces `compilation-error-face', `compilation-warning-face',
817 : `compilation-info-face', `compilation-line-face' and
818 : `compilation-column-face' get prepended to this, when applicable."
819 : :type 'face
820 : :group 'compilation
821 : :version "22.1")
822 :
823 : (defvar compilation-error-face 'compilation-error
824 : "Face name to use for file name in error messages.")
825 :
826 : (defvar compilation-warning-face 'compilation-warning
827 : "Face name to use for file name in warning messages.")
828 :
829 : (defvar compilation-info-face 'compilation-info
830 : "Face name to use for file name in informational messages.")
831 :
832 : (defvar compilation-line-face 'compilation-line-number
833 : "Face name to use for line numbers in compiler messages.")
834 :
835 : (defvar compilation-column-face 'compilation-column-number
836 : "Face name to use for column numbers in compiler messages.")
837 :
838 : ;; same faces as dired uses
839 : (defvar compilation-enter-directory-face 'font-lock-function-name-face
840 : "Face name to use for entering directory messages.")
841 :
842 : (defvar compilation-leave-directory-face 'font-lock-builtin-face
843 : "Face name to use for leaving directory messages.")
844 :
845 : ;; Used for compatibility with the old compile.el.
846 : (defvar compilation-parse-errors-function nil)
847 : (make-obsolete-variable 'compilation-parse-errors-function
848 : 'compilation-error-regexp-alist "24.1")
849 :
850 : (defcustom compilation-auto-jump-to-first-error nil
851 : "If non-nil, automatically jump to the first error during compilation."
852 : :type 'boolean
853 : :group 'compilation
854 : :version "23.1")
855 :
856 : (defvar compilation-auto-jump-to-next nil
857 : "If non-nil, automatically jump to the next error encountered.")
858 : (make-variable-buffer-local 'compilation-auto-jump-to-next)
859 :
860 : ;; (defvar compilation-buffer-modtime nil
861 : ;; "The buffer modification time, for buffers not associated with files.")
862 : ;; (make-variable-buffer-local 'compilation-buffer-modtime)
863 :
864 : (defvar compilation-skip-to-next-location t
865 : "If non-nil, skip multiple error messages for the same source location.")
866 :
867 : (defcustom compilation-skip-threshold 1
868 : "Compilation motion commands skip less important messages.
869 : The value can be either 2 -- skip anything less than error, 1 --
870 : skip anything less than warning or 0 -- don't skip any messages.
871 : Note that all messages not positively identified as warning or
872 : info, are considered errors."
873 : :type '(choice (const :tag "Skip warnings and info" 2)
874 : (const :tag "Skip info" 1)
875 : (const :tag "No skip" 0))
876 : :group 'compilation
877 : :version "22.1")
878 :
879 : (defun compilation-set-skip-threshold (level)
880 : "Switch the `compilation-skip-threshold' level."
881 : (interactive
882 0 : (list
883 0 : (mod (if current-prefix-arg
884 0 : (prefix-numeric-value current-prefix-arg)
885 0 : (1+ compilation-skip-threshold))
886 0 : 3)))
887 0 : (setq compilation-skip-threshold level)
888 0 : (message "Skipping %s"
889 0 : (pcase compilation-skip-threshold
890 : (0 "Nothing")
891 : (1 "Info messages")
892 0 : (2 "Warnings and info"))))
893 :
894 : (defcustom compilation-skip-visited nil
895 : "Compilation motion commands skip visited messages if this is t.
896 : Visited messages are ones for which the file, line and column have been jumped
897 : to from the current content in the current compilation buffer, even if it was
898 : from a different message."
899 : :type 'boolean
900 : :group 'compilation
901 : :version "22.1")
902 :
903 : (defun compilation-type (type)
904 0 : (or (and (car type) (match-end (car type)) 1)
905 0 : (and (cdr type) (match-end (cdr type)) 0)
906 0 : 2))
907 :
908 : ;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil)
909 :
910 : ;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe
911 : ;; LINE will be nil for a message that doesn't contain them. Then the
912 : ;; location refers to a indented beginning of line or beginning of file.
913 : ;; Once any location in some file has been jumped to, the list is extended to
914 : ;; (COLUMN LINE FILE-STRUCTURE MARKER TIMESTAMP . VISITED)
915 : ;; for all LOCs pertaining to that file.
916 : ;; MARKER initially points to LINE and COLUMN in a buffer visiting that file.
917 : ;; Being a marker it sticks to some text, when the buffer grows or shrinks
918 : ;; before that point. VISITED is t if we have jumped there, else nil.
919 : ;; FIXME-omake: TIMESTAMP was used to try and handle "incremental compilation":
920 : ;; `omake -P' polls filesystem for changes and recompiles when a file is
921 : ;; modified using the same *compilation* buffer. this necessitates
922 : ;; re-parsing markers.
923 :
924 : ;; (cl-defstruct (compilation--loc
925 : ;; (:constructor nil)
926 : ;; (:copier nil)
927 : ;; (:constructor compilation--make-loc
928 : ;; (file-struct line col marker))
929 : ;; (:conc-name compilation--loc->))
930 : ;; col line file-struct marker timestamp visited)
931 :
932 : ;; FIXME: We don't use a defstruct because of compilation-assq which looks up
933 : ;; and creates part of the LOC (only the first cons cell containing the COL).
934 :
935 : (defmacro compilation--make-cdrloc (line file-struct marker)
936 6 : `(list ,line ,file-struct ,marker nil))
937 3 : (defmacro compilation--loc->col (loc) `(car ,loc))
938 0 : (defmacro compilation--loc->line (loc) `(cadr ,loc))
939 8 : (defmacro compilation--loc->file-struct (loc) `(nth 2 ,loc))
940 9 : (defmacro compilation--loc->marker (loc) `(nth 3 ,loc))
941 : ;; (defmacro compilation--loc->timestamp (loc) `(nth 4 ,loc))
942 3 : (defmacro compilation--loc->visited (loc) `(nthcdr 5 ,loc))
943 :
944 : ;; FILE-STRUCTURE is a list of
945 : ;; ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...)
946 :
947 : ;; FILENAME is a string parsed from an error message. DIRECTORY is a string
948 : ;; obtained by following directory change messages. DIRECTORY will be nil for
949 : ;; an absolute filename. FORMATS is a list of formats to apply to FILENAME if
950 : ;; a file of that name can't be found.
951 : ;; The rest of the list is an alist of elements with LINE as key. The keys
952 : ;; are either nil or line numbers. If present, nil comes first, followed by
953 : ;; the numbers in decreasing order. The LOCs for each line are again an alist
954 : ;; ordered the same way. Note that the whole file structure is referenced in
955 : ;; every LOC.
956 :
957 : (defmacro compilation--make-file-struct (file-spec formats &optional loc-tree)
958 1 : `(cons ,file-spec (cons ,formats ,loc-tree)))
959 0 : (defmacro compilation--file-struct->file-spec (fs) `(car ,fs))
960 1 : (defmacro compilation--file-struct->formats (fs) `(cadr ,fs))
961 : ;; The FORMATS field plays the role of ANCHOR in the loc-tree.
962 4 : (defmacro compilation--file-struct->loc-tree (fs) `(cdr ,fs))
963 :
964 : ;; MESSAGE is a list of (LOC TYPE END-LOC)
965 :
966 : ;; TYPE is 0 for info or 1 for warning if the message matcher identified it as
967 : ;; such, 2 otherwise (for a real error). END-LOC is a LOC pointing to the
968 : ;; other end, if the parsed message contained a range. If the end of the
969 : ;; range didn't specify a COLUMN, it defaults to -1, meaning end of line.
970 : ;; These are the value of the `compilation-message' text-properties in the
971 : ;; compilation buffer.
972 :
973 : (cl-defstruct (compilation--message
974 : (:constructor nil)
975 : (:copier nil)
976 : ;; (:type list) ;Old representation.
977 : (:constructor compilation--make-message (loc type end-loc))
978 : (:conc-name compilation--message->))
979 : loc type end-loc)
980 :
981 : (defvar compilation--previous-directory-cache nil
982 : "A pair (POS . RES) caching the result of previous directory search.
983 : Basically, this pair says that calling
984 : (previous-single-property-change POS \\='compilation-directory)
985 : returned RES, i.e. there is no change of `compilation-directory' between
986 : POS and RES.")
987 : (make-variable-buffer-local 'compilation--previous-directory-cache)
988 :
989 : (defun compilation--flush-directory-cache (start _end)
990 0 : (cond
991 0 : ((or (not compilation--previous-directory-cache)
992 0 : (<= (car compilation--previous-directory-cache) start)))
993 0 : ((or (not (cdr compilation--previous-directory-cache))
994 0 : (null (marker-buffer (cdr compilation--previous-directory-cache)))
995 0 : (<= (cdr compilation--previous-directory-cache) start))
996 0 : (set-marker (car compilation--previous-directory-cache) start))
997 0 : (t (setq compilation--previous-directory-cache nil))))
998 :
999 : (defun compilation--previous-directory (pos)
1000 : "Like (previous-single-property-change POS \\='compilation-directory), but faster."
1001 : ;; This avoids an N² behavior when there's no/few compilation-directory
1002 : ;; entries, in which case each call to previous-single-property-change
1003 : ;; ends up having to walk very far back to find the last change.
1004 0 : (if (and compilation--previous-directory-cache
1005 0 : (< pos (car compilation--previous-directory-cache))
1006 0 : (or (null (cdr compilation--previous-directory-cache))
1007 0 : (< (cdr compilation--previous-directory-cache) pos)))
1008 : ;; No need to call previous-single-property-change.
1009 0 : (cdr compilation--previous-directory-cache)
1010 :
1011 0 : (let* ((cache (and compilation--previous-directory-cache
1012 0 : (<= (car compilation--previous-directory-cache) pos)
1013 0 : (car compilation--previous-directory-cache)))
1014 : (prev
1015 0 : (previous-single-property-change
1016 0 : pos 'compilation-directory nil cache))
1017 : (res
1018 0 : (cond
1019 0 : ((null cache)
1020 0 : (setq compilation--previous-directory-cache
1021 0 : (cons (copy-marker pos) (if prev (copy-marker prev))))
1022 0 : prev)
1023 0 : ((and prev (= prev cache))
1024 0 : (set-marker (car compilation--previous-directory-cache) pos)
1025 0 : (cdr compilation--previous-directory-cache))
1026 : (t
1027 0 : (set-marker cache pos)
1028 0 : (setcdr compilation--previous-directory-cache
1029 0 : (copy-marker prev))
1030 0 : prev))))
1031 0 : (if (markerp res) (marker-position res) res))))
1032 :
1033 : ;; Internal function for calculating the text properties of a directory
1034 : ;; change message. The compilation-directory property is important, because it
1035 : ;; is the stack of nested enter-messages. Relative filenames on the following
1036 : ;; lines are relative to the top of the stack.
1037 : (defun compilation-directory-properties (idx leave)
1038 0 : (if leave (setq leave (match-end leave)))
1039 : ;; find previous stack, and push onto it, or if `leave' pop it
1040 0 : (let ((dir (compilation--previous-directory (match-beginning 0))))
1041 0 : (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory)
1042 0 : (get-text-property dir 'compilation-directory))))
1043 0 : `(font-lock-face ,(if leave
1044 0 : compilation-leave-directory-face
1045 0 : compilation-enter-directory-face)
1046 0 : compilation-directory ,(if leave
1047 0 : (or (cdr dir)
1048 0 : '(nil)) ; nil only isn't a property-change
1049 0 : (cons (match-string-no-properties idx) dir))
1050 : ;; Place a `compilation-message' everywhere we change text-properties
1051 : ;; so compilation--remove-properties can know what to remove.
1052 0 : compilation-message ,(compilation--make-message nil 0 nil)
1053 : mouse-face highlight
1054 : keymap compilation-button-map
1055 0 : help-echo "mouse-2: visit destination directory")))
1056 :
1057 : ;; Data type `reverse-ordered-alist' retriever. This function retrieves the
1058 : ;; KEY element from the ALIST, creating it in the right position if not already
1059 : ;; present. ALIST structure is
1060 : ;; '(ANCHOR (KEY1 ...) (KEY2 ...)... (KEYn ALIST ...))
1061 : ;; ANCHOR is ignored, but necessary so that elements can be inserted. KEY1
1062 : ;; may be nil. The other KEYs are ordered backwards so that growing line
1063 : ;; numbers can be inserted in front and searching can abort after half the
1064 : ;; list on average.
1065 : (eval-when-compile ;Don't keep it at runtime if not needed.
1066 : (defmacro compilation-assq (key alist)
1067 : `(let* ((l1 ,alist)
1068 : (l2 (cdr l1)))
1069 : (car (if (if (null ,key)
1070 : (if l2 (null (caar l2)))
1071 : (while (if l2 (if (caar l2) (< ,key (caar l2)) t))
1072 : (setq l1 l2
1073 : l2 (cdr l1)))
1074 : (if l2 (eq ,key (caar l2))))
1075 : l2
1076 : (setcdr l1 (cons (list ,key) l2)))))))
1077 :
1078 : (defun compilation-auto-jump (buffer pos)
1079 0 : (with-current-buffer buffer
1080 0 : (goto-char pos)
1081 0 : (let ((win (get-buffer-window buffer 0)))
1082 0 : (if win (set-window-point win pos)))
1083 0 : (if compilation-auto-jump-to-first-error
1084 0 : (compile-goto-error))))
1085 :
1086 : ;; This function is the central driver, called when font-locking to gather
1087 : ;; all information needed to later jump to corresponding source code.
1088 : ;; Return a property list with all meta information on this error location.
1089 :
1090 : (defun compilation-error-properties (file line end-line col end-col type fmt)
1091 0 : (unless (text-property-not-all (match-beginning 0) (point)
1092 0 : 'compilation-message nil)
1093 0 : (if file
1094 0 : (when (stringp
1095 0 : (setq file (if (functionp file) (funcall file)
1096 0 : (match-string-no-properties file))))
1097 0 : (let ((dir
1098 0 : (unless (file-name-absolute-p file)
1099 0 : (let ((pos (compilation--previous-directory
1100 0 : (match-beginning 0))))
1101 0 : (when pos
1102 0 : (or (get-text-property (1- pos) 'compilation-directory)
1103 0 : (get-text-property pos 'compilation-directory)))))))
1104 0 : (setq file (cons file (car dir)))))
1105 : ;; This message didn't mention one, get it from previous
1106 0 : (let ((prev-pos
1107 : ;; Find the previous message.
1108 0 : (previous-single-property-change (point) 'compilation-message)))
1109 0 : (if prev-pos
1110 : ;; Get the file structure that belongs to it.
1111 0 : (let* ((prev
1112 0 : (or (get-text-property (1- prev-pos) 'compilation-message)
1113 0 : (get-text-property prev-pos 'compilation-message)))
1114 : (prev-file-struct
1115 0 : (and prev
1116 0 : (compilation--loc->file-struct
1117 0 : (compilation--message->loc prev)))))
1118 :
1119 : ;; Construct FILE . DIR from that.
1120 0 : (if prev-file-struct
1121 0 : (setq file (cons (caar prev-file-struct)
1122 0 : (cadr (car prev-file-struct)))))))
1123 0 : (unless file
1124 0 : (setq file '("*unknown*")))))
1125 : ;; All of these fields are optional, get them only if we have an index, and
1126 : ;; it matched some part of the message.
1127 0 : (and line
1128 0 : (setq line (match-string-no-properties line))
1129 0 : (setq line (string-to-number line)))
1130 0 : (and end-line
1131 0 : (setq end-line (match-string-no-properties end-line))
1132 0 : (setq end-line (string-to-number end-line)))
1133 0 : (if col
1134 0 : (if (functionp col)
1135 0 : (setq col (funcall col))
1136 0 : (and
1137 0 : (setq col (match-string-no-properties col))
1138 0 : (setq col (string-to-number col)))))
1139 0 : (if (and end-col (functionp end-col))
1140 0 : (setq end-col (funcall end-col))
1141 0 : (if (and end-col (setq end-col (match-string-no-properties end-col)))
1142 0 : (setq end-col (- (string-to-number end-col) -1))
1143 0 : (if end-line (setq end-col -1))))
1144 0 : (if (consp type) ; not a static type, check what it is.
1145 0 : (setq type (or (and (car type) (match-end (car type)) 1)
1146 0 : (and (cdr type) (match-end (cdr type)) 0)
1147 0 : 2)))
1148 :
1149 0 : (when (and compilation-auto-jump-to-next
1150 0 : (>= type compilation-skip-threshold))
1151 0 : (kill-local-variable 'compilation-auto-jump-to-next)
1152 0 : (run-with-timer 0 nil 'compilation-auto-jump
1153 0 : (current-buffer) (match-beginning 0)))
1154 :
1155 0 : (compilation-internal-error-properties
1156 0 : file line end-line col end-col type fmt)))
1157 :
1158 : (defun compilation-beginning-of-line (&optional n)
1159 : "Like `beginning-of-line', but accounts for lines hidden by `selective-display'."
1160 0 : (if (or (not (eq selective-display t))
1161 0 : (null n)
1162 0 : (= n 1))
1163 0 : (beginning-of-line n)
1164 0 : (re-search-forward "[\n\r]" nil 'end (1- n))
1165 0 : (if (< n 0)
1166 0 : (beginning-of-line))))
1167 :
1168 : (defun compilation-move-to-column (col screen)
1169 : "Go to column COL on the current line.
1170 : If SCREEN is non-nil, columns are screen columns, otherwise, they are
1171 : just char-counts."
1172 0 : (setq col (- col compilation-first-column))
1173 0 : (if screen
1174 : ;; Presumably, the compilation tool doesn't know about our current
1175 : ;; `tab-width' setting, so it probably assumed 8-wide TABs (bug#21038).
1176 0 : (let ((tab-width 8)) (move-to-column (max col 0)))
1177 0 : (goto-char (min (+ (line-beginning-position) col) (line-end-position)))))
1178 :
1179 : (defun compilation-internal-error-properties (file line end-line col end-col type fmts)
1180 : "Get the meta-info that will be added as text-properties.
1181 : LINE, END-LINE, COL, END-COL are integers or nil.
1182 : TYPE can be 0, 1, or 2, meaning error, warning, or just info.
1183 : FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil.
1184 : FMTS is a list of format specs for transforming the file name.
1185 : (See `compilation-error-regexp-alist'.)"
1186 0 : (unless file (setq file '("*unknown*")))
1187 0 : (let* ((file-struct (compilation-get-file-structure file fmts))
1188 : ;; Get first already existing marker (if any has one, all have one).
1189 : ;; Do this first, as the compilation-assq`s may create new nodes.
1190 : (marker-line ; a line structure
1191 0 : (cadr (compilation--file-struct->loc-tree file-struct)))
1192 : (marker
1193 0 : (if marker-line (compilation--loc->marker (cadr marker-line))))
1194 0 : (screen-columns compilation-error-screen-columns)
1195 0 : (first-column compilation-first-column)
1196 : end-marker loc end-loc)
1197 0 : (if (not (and marker (marker-buffer marker)))
1198 0 : (setq marker nil) ; no valid marker for this file
1199 0 : (unless line (setq line 1)) ; normalize no linenumber to line 1
1200 0 : (catch 'marker ; find nearest loc, at least one exists
1201 0 : (dolist (x (cddr (compilation--file-struct->loc-tree
1202 0 : file-struct))) ; Loop over remaining lines.
1203 0 : (if (> (car x) line) ; Still bigger.
1204 0 : (setq marker-line x)
1205 0 : (if (> (- (or (car marker-line) 1) line)
1206 0 : (- line (car x))) ; Current line is nearer.
1207 0 : (setq marker-line x))
1208 0 : (throw 'marker t))))
1209 0 : (setq marker (compilation--loc->marker (cadr marker-line))
1210 0 : marker-line (or (car marker-line) 1))
1211 0 : (with-current-buffer (marker-buffer marker)
1212 0 : (let ((screen-columns
1213 : ;; Obey the compilation-error-screen-columns of the target
1214 : ;; buffer if its major mode set it buffer-locally.
1215 0 : (if (local-variable-p 'compilation-error-screen-columns)
1216 0 : compilation-error-screen-columns screen-columns))
1217 : (compilation-first-column
1218 0 : (if (local-variable-p 'compilation-first-column)
1219 0 : compilation-first-column first-column)))
1220 0 : (save-excursion
1221 0 : (save-restriction
1222 0 : (widen)
1223 0 : (goto-char (marker-position marker))
1224 : ;; Set end-marker if appropriate and go to line.
1225 0 : (if (not (or end-col end-line))
1226 0 : (compilation-beginning-of-line (- line marker-line -1))
1227 0 : (compilation-beginning-of-line (- (or end-line line)
1228 0 : marker-line -1))
1229 0 : (if (or (null end-col) (< end-col 0))
1230 0 : (end-of-line)
1231 0 : (compilation-move-to-column end-col screen-columns))
1232 0 : (setq end-marker (point-marker))
1233 0 : (when end-line
1234 0 : (compilation-beginning-of-line (- line end-line -1))))
1235 0 : (if col
1236 0 : (compilation-move-to-column col screen-columns)
1237 0 : (forward-to-indentation 0))
1238 0 : (setq marker (point-marker)))))))
1239 :
1240 0 : (setq loc (compilation-assq line (compilation--file-struct->loc-tree
1241 0 : file-struct)))
1242 0 : (setq end-loc
1243 0 : (if end-line
1244 0 : (compilation-assq
1245 : end-col (compilation-assq
1246 : end-line (compilation--file-struct->loc-tree
1247 0 : file-struct)))
1248 0 : (if end-col ; use same line element
1249 0 : (compilation-assq end-col loc))))
1250 0 : (setq loc (compilation-assq col loc))
1251 : ;; If they are new, make the loc(s) reference the file they point to.
1252 : ;; FIXME-omake: there's a problem with timestamps here: the markers
1253 : ;; relative to which we computed the current `marker' have a timestamp
1254 : ;; almost guaranteed to be different from compilation-buffer-modtime, so if
1255 : ;; we use their timestamp, we'll never use `loc' since the timestamp won't
1256 : ;; match compilation-buffer-modtime, and if we use
1257 : ;; compilation-buffer-modtime then we have different timestamps for
1258 : ;; locations that were computed together, which doesn't make sense either.
1259 : ;; I think this points to a fundamental problem in our approach to the
1260 : ;; "omake -P" problem. --Stef
1261 0 : (or (cdr loc)
1262 0 : (setcdr loc (compilation--make-cdrloc line file-struct marker)))
1263 0 : (if end-loc
1264 0 : (or (cdr end-loc)
1265 0 : (setcdr end-loc
1266 0 : (compilation--make-cdrloc (or end-line line) file-struct
1267 0 : end-marker))))
1268 :
1269 : ;; Must start with face
1270 0 : `(font-lock-face ,compilation-message-face
1271 0 : compilation-message ,(compilation--make-message loc type end-loc)
1272 0 : help-echo ,(if col
1273 : "mouse-2: visit this file, line and column"
1274 0 : (if line
1275 : "mouse-2: visit this file and line"
1276 0 : "mouse-2: visit this file"))
1277 : keymap compilation-button-map
1278 0 : mouse-face highlight)))
1279 :
1280 : (defun compilation--put-prop (matchnum prop val)
1281 0 : (when (and (integerp matchnum) (match-beginning matchnum))
1282 0 : (put-text-property
1283 0 : (match-beginning matchnum) (match-end matchnum)
1284 0 : prop val)))
1285 :
1286 : (defun compilation--remove-properties (&optional start end)
1287 0 : (with-silent-modifications
1288 : ;; When compile.el used font-lock directly, we could just remove all
1289 : ;; our text-properties in one go, but now that we manually place
1290 : ;; font-lock-face, we have to be careful to only remove the font-lock-face
1291 : ;; we placed.
1292 : ;; (remove-list-of-text-properties
1293 : ;; (or start (point-min)) (or end (point-max))
1294 : ;; '(compilation-debug compilation-directory compilation-message
1295 : ;; font-lock-face help-echo mouse-face))
1296 0 : (let (next)
1297 0 : (unless start (setq start (point-min)))
1298 0 : (unless end (setq end (point-max)))
1299 0 : (compilation--flush-directory-cache start end)
1300 0 : (while
1301 0 : (progn
1302 0 : (setq next (or (next-single-property-change
1303 0 : start 'compilation-message nil end)
1304 0 : end))
1305 0 : (when (get-text-property start 'compilation-message)
1306 0 : (remove-list-of-text-properties
1307 0 : start next
1308 : '(compilation-debug compilation-directory compilation-message
1309 0 : font-lock-face help-echo mouse-face)))
1310 0 : (< next end))
1311 0 : (setq start next)))))
1312 :
1313 : (defun compilation--parse-region (start end)
1314 0 : (goto-char end)
1315 0 : (unless (bolp)
1316 : ;; We generally don't like to parse partial lines.
1317 0 : (cl-assert (eobp))
1318 0 : (when (let ((proc (get-buffer-process (current-buffer))))
1319 0 : (and proc (memq (process-status proc) '(run open))))
1320 0 : (setq end (line-beginning-position))))
1321 0 : (compilation--remove-properties start end)
1322 0 : (if compilation-parse-errors-function
1323 : ;; An old package! Try the compatibility code.
1324 0 : (progn
1325 0 : (goto-char start)
1326 0 : (compilation--compat-parse-errors end))
1327 :
1328 : ;; compilation-directory-matcher is the only part that really needs to be
1329 : ;; parsed sequentially. So we could split it out, handle directories
1330 : ;; like syntax-propertize, and the rest as font-lock-keywords. But since
1331 : ;; we want to have it work even when font-lock is off, we'd then need to
1332 : ;; use our own compilation-parsed text-property to keep track of the parts
1333 : ;; that have already been parsed.
1334 0 : (goto-char start)
1335 0 : (while (re-search-forward (car compilation-directory-matcher)
1336 0 : end t)
1337 0 : (compilation--flush-directory-cache (match-beginning 0) (match-end 0))
1338 0 : (when compilation-debug
1339 0 : (font-lock-append-text-property
1340 0 : (match-beginning 0) (match-end 0)
1341 : 'compilation-debug
1342 0 : (vector 'directory compilation-directory-matcher)))
1343 0 : (dolist (elt (cdr compilation-directory-matcher))
1344 0 : (add-text-properties (match-beginning (car elt))
1345 0 : (match-end (car elt))
1346 0 : (compilation-directory-properties
1347 0 : (car elt) (cdr elt)))))
1348 :
1349 0 : (compilation-parse-errors start end)))
1350 :
1351 : (defun compilation--note-type (type)
1352 : "Note that a new message with severity TYPE was seen.
1353 : This updates the appropriate variable used by the mode-line."
1354 0 : (cl-case type
1355 0 : (0 (cl-incf compilation-num-infos-found))
1356 0 : (1 (cl-incf compilation-num-warnings-found))
1357 0 : (2 (cl-incf compilation-num-errors-found))))
1358 :
1359 : (defun compilation-parse-errors (start end &rest rules)
1360 : "Parse errors between START and END.
1361 : The errors recognized are the ones specified in RULES which default
1362 : to `compilation-error-regexp-alist' if RULES is nil."
1363 0 : (dolist (item (or rules compilation-error-regexp-alist))
1364 0 : (if (symbolp item)
1365 0 : (setq item (cdr (assq item
1366 0 : compilation-error-regexp-alist-alist))))
1367 0 : (let ((file (nth 1 item))
1368 0 : (line (nth 2 item))
1369 0 : (col (nth 3 item))
1370 0 : (type (nth 4 item))
1371 0 : (pat (car item))
1372 : end-line end-col fmt
1373 : props)
1374 :
1375 : ;; omake reports some error indented, so skip the indentation.
1376 : ;; another solution is to modify (some?) regexps in
1377 : ;; `compilation-error-regexp-alist'.
1378 : ;; note that omake usage is not limited to ocaml and C (for stubs).
1379 : ;; FIXME-omake: Doing it here seems wrong, at least it should depend on
1380 : ;; whether or not omake's own error messages are recognized.
1381 0 : (cond
1382 0 : ((not (memq 'omake compilation-error-regexp-alist)) nil)
1383 0 : ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat)
1384 : nil) ;; Not anchored or anchored but already allows empty spaces.
1385 0 : (t (setq pat (concat "^ *" (substring pat 1)))))
1386 :
1387 0 : (if (consp file) (setq fmt (cdr file) file (car file)))
1388 0 : (if (consp line) (setq end-line (cdr line) line (car line)))
1389 0 : (if (consp col) (setq end-col (cdr col) col (car col)))
1390 :
1391 0 : (if (functionp line)
1392 : ;; The old compile.el had here an undocumented hook that
1393 : ;; allowed `line' to be a function that computed the actual
1394 : ;; error location. Let's do our best.
1395 0 : (progn
1396 0 : (goto-char start)
1397 0 : (while (re-search-forward pat end t)
1398 0 : (save-match-data
1399 0 : (when compilation-debug
1400 0 : (font-lock-append-text-property
1401 0 : (match-beginning 0) (match-end 0)
1402 0 : 'compilation-debug (vector 'functionp item)))
1403 0 : (add-text-properties
1404 0 : (match-beginning 0) (match-end 0)
1405 0 : (compilation--compat-error-properties
1406 0 : (funcall line (cons (match-string file)
1407 0 : (cons default-directory
1408 0 : (nthcdr 4 item)))
1409 0 : (if col (match-string col))))))
1410 0 : (compilation--put-prop
1411 0 : file 'font-lock-face compilation-error-face)))
1412 :
1413 0 : (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
1414 0 : (error "HYPERLINK should be an integer: %s" (nth 5 item)))
1415 :
1416 0 : (goto-char start)
1417 0 : (while (re-search-forward pat end t)
1418 0 : (when (setq props (compilation-error-properties
1419 0 : file line end-line col end-col (or type 2) fmt))
1420 :
1421 0 : (when (integerp file)
1422 0 : (setq type (if (consp type)
1423 0 : (compilation-type type)
1424 0 : (or type 2)))
1425 0 : (compilation--note-type type)
1426 :
1427 0 : (compilation--put-prop
1428 0 : file 'font-lock-face
1429 0 : (symbol-value (aref [compilation-info-face
1430 : compilation-warning-face
1431 : compilation-error-face]
1432 0 : type))))
1433 :
1434 0 : (compilation--put-prop
1435 0 : line 'font-lock-face compilation-line-face)
1436 0 : (compilation--put-prop
1437 0 : end-line 'font-lock-face compilation-line-face)
1438 :
1439 0 : (compilation--put-prop
1440 0 : col 'font-lock-face compilation-column-face)
1441 0 : (compilation--put-prop
1442 0 : end-col 'font-lock-face compilation-column-face)
1443 :
1444 : ;; Obey HIGHLIGHT.
1445 0 : (dolist (extra-item (nthcdr 6 item))
1446 0 : (let ((mn (pop extra-item)))
1447 0 : (when (match-beginning mn)
1448 0 : (let ((face (eval (car extra-item))))
1449 0 : (cond
1450 0 : ((null face))
1451 0 : ((or (symbolp face) (stringp face))
1452 0 : (put-text-property
1453 0 : (match-beginning mn) (match-end mn)
1454 0 : 'font-lock-face face))
1455 0 : ((and (listp face)
1456 0 : (eq (car face) 'face)
1457 0 : (or (symbolp (cadr face))
1458 0 : (stringp (cadr face))))
1459 0 : (compilation--put-prop mn 'font-lock-face (cadr face))
1460 0 : (add-text-properties
1461 0 : (match-beginning mn) (match-end mn)
1462 0 : (nthcdr 2 face)))
1463 : (t
1464 0 : (error "Don't know how to handle face %S"
1465 0 : face)))))))
1466 0 : (let ((mn (or (nth 5 item) 0)))
1467 0 : (when compilation-debug
1468 0 : (font-lock-append-text-property
1469 0 : (match-beginning 0) (match-end 0)
1470 0 : 'compilation-debug (vector 'std item props)))
1471 0 : (add-text-properties
1472 0 : (match-beginning mn) (match-end mn)
1473 0 : (cddr props))
1474 0 : (font-lock-append-text-property
1475 0 : (match-beginning mn) (match-end mn)
1476 0 : 'font-lock-face (cadr props)))))))))
1477 :
1478 : (defvar compilation--parsed -1)
1479 : (make-variable-buffer-local 'compilation--parsed)
1480 :
1481 : (defun compilation--ensure-parse (limit)
1482 : "Make sure the text has been parsed up to LIMIT."
1483 0 : (save-excursion
1484 0 : (goto-char limit)
1485 0 : (setq limit (line-beginning-position 2))
1486 0 : (unless (markerp compilation--parsed)
1487 : ;; We use a marker for compilation--parsed so that users (such as
1488 : ;; grep.el) don't need to flush-parse when they modify the buffer
1489 : ;; in a way that impacts buffer positions but does not require
1490 : ;; re-parsing.
1491 0 : (setq compilation--parsed (point-min-marker)))
1492 0 : (when (< compilation--parsed limit)
1493 0 : (let ((start (max compilation--parsed (point-min))))
1494 0 : (move-marker compilation--parsed limit)
1495 0 : (goto-char start)
1496 0 : (forward-line 0) ;Not line-beginning-position: ignore (comint) fields.
1497 0 : (while (and (not (bobp))
1498 0 : (get-text-property (1- (point)) 'compilation-multiline))
1499 0 : (forward-line -1))
1500 0 : (with-silent-modifications
1501 0 : (compilation--parse-region (point) compilation--parsed)))))
1502 : nil)
1503 :
1504 : (defun compilation--flush-parse (start _end)
1505 : "Mark the region between START and END for re-parsing."
1506 0 : (if (markerp compilation--parsed)
1507 0 : (move-marker compilation--parsed (min start compilation--parsed))))
1508 :
1509 : (defun compilation-mode-font-lock-keywords ()
1510 : "Return expressions to highlight in Compilation mode."
1511 0 : (append
1512 : '((compilation--ensure-parse))
1513 0 : compilation-mode-font-lock-keywords))
1514 :
1515 : (defun compilation-read-command (command)
1516 0 : (read-shell-command "Compile command: " command
1517 0 : (if (equal (car compile-history) command)
1518 : '(compile-history . 1)
1519 0 : 'compile-history)))
1520 :
1521 :
1522 : ;;;###autoload
1523 : (defun compile (command &optional comint)
1524 : "Compile the program including the current buffer. Default: run `make'.
1525 : Runs COMMAND, a shell command, in a separate process asynchronously
1526 : with output going to the buffer `*compilation*'.
1527 :
1528 : You can then use the command \\[next-error] to find the next error message
1529 : and move to the source code that caused it.
1530 :
1531 : If optional second arg COMINT is t the buffer will be in Comint mode with
1532 : `compilation-shell-minor-mode'.
1533 :
1534 : Interactively, prompts for the command if the variable
1535 : `compilation-read-command' is non-nil; otherwise uses `compile-command'.
1536 : With prefix arg, always prompts.
1537 : Additionally, with universal prefix arg, compilation buffer will be in
1538 : comint mode, i.e. interactive.
1539 :
1540 : To run more than one compilation at once, start one then rename
1541 : the `*compilation*' buffer to some other name with
1542 : \\[rename-buffer]. Then _switch buffers_ and start the new compilation.
1543 : It will create a new `*compilation*' buffer.
1544 :
1545 : On most systems, termination of the main compilation process
1546 : kills its subprocesses.
1547 :
1548 : The name used for the buffer is actually whatever is returned by
1549 : the function in `compilation-buffer-name-function', so you can set that
1550 : to a function that generates a unique name."
1551 : (interactive
1552 0 : (list
1553 0 : (let ((command (eval compile-command)))
1554 0 : (if (or compilation-read-command current-prefix-arg)
1555 0 : (compilation-read-command command)
1556 0 : command))
1557 0 : (consp current-prefix-arg)))
1558 0 : (unless (equal command (eval compile-command))
1559 0 : (setq compile-command command))
1560 0 : (save-some-buffers (not compilation-ask-about-save)
1561 0 : compilation-save-buffers-predicate)
1562 0 : (setq-default compilation-directory default-directory)
1563 0 : (compilation-start command comint))
1564 :
1565 : ;; run compile with the default command line
1566 : (defun recompile (&optional edit-command)
1567 : "Re-compile the program including the current buffer.
1568 : If this is run in a Compilation mode buffer, re-use the arguments from the
1569 : original use. Otherwise, recompile using `compile-command'.
1570 : If the optional argument `edit-command' is non-nil, the command can be edited."
1571 : (interactive "P")
1572 0 : (save-some-buffers (not compilation-ask-about-save)
1573 0 : compilation-save-buffers-predicate)
1574 0 : (let ((default-directory (or compilation-directory default-directory))
1575 0 : (command (eval compile-command)))
1576 0 : (when edit-command
1577 0 : (setq command (compilation-read-command (or (car compilation-arguments)
1578 0 : command)))
1579 0 : (if compilation-arguments (setcar compilation-arguments command)))
1580 0 : (apply 'compilation-start (or compilation-arguments (list command)))))
1581 :
1582 : (defcustom compilation-scroll-output nil
1583 : "Non-nil to scroll the *compilation* buffer window as output appears.
1584 :
1585 : Setting it causes the Compilation mode commands to put point at the
1586 : end of their output window so that the end of the output is always
1587 : visible rather than the beginning.
1588 :
1589 : The value `first-error' stops scrolling at the first error, and leaves
1590 : point on its location in the *compilation* buffer."
1591 : :type '(choice (const :tag "No scrolling" nil)
1592 : (const :tag "Scroll compilation output" t)
1593 : (const :tag "Stop scrolling at the first error" first-error))
1594 : :version "20.3"
1595 : :group 'compilation)
1596 :
1597 :
1598 : (defun compilation-buffer-name (name-of-mode mode-command name-function)
1599 : "Return the name of a compilation buffer to use.
1600 : If NAME-FUNCTION is non-nil, call it with one argument NAME-OF-MODE
1601 : to determine the buffer name.
1602 : Likewise if `compilation-buffer-name-function' is non-nil.
1603 : If current buffer has the major mode MODE-COMMAND,
1604 : return the name of the current buffer, so that it gets reused.
1605 : Otherwise, construct a buffer name from NAME-OF-MODE."
1606 0 : (cond (name-function
1607 0 : (funcall name-function name-of-mode))
1608 0 : (compilation-buffer-name-function
1609 0 : (funcall compilation-buffer-name-function name-of-mode))
1610 0 : ((eq mode-command major-mode)
1611 0 : (buffer-name))
1612 : (t
1613 0 : (concat "*" (downcase name-of-mode) "*"))))
1614 :
1615 : (defcustom compilation-always-kill nil
1616 : "If t, always kill a running compilation process before starting a new one.
1617 : If nil, ask to kill it."
1618 : :type 'boolean
1619 : :version "24.3"
1620 : :group 'compilation)
1621 :
1622 : ;;;###autoload
1623 : (defun compilation-start (command &optional mode name-function highlight-regexp)
1624 : "Run compilation command COMMAND (low level interface).
1625 : If COMMAND starts with a cd command, that becomes the `default-directory'.
1626 : The rest of the arguments are optional; for them, nil means use the default.
1627 :
1628 : MODE is the major mode to set in the compilation buffer. Mode
1629 : may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'.
1630 :
1631 : If NAME-FUNCTION is non-nil, call it with one argument (the mode name)
1632 : to determine the buffer name. Otherwise, the default is to
1633 : reuses the current buffer if it has the proper major mode,
1634 : else use or create a buffer with name based on the major mode.
1635 :
1636 : If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
1637 : the matching section of the visited source line; the default is to use the
1638 : global value of `compilation-highlight-regexp'.
1639 :
1640 : Returns the compilation buffer created."
1641 0 : (or mode (setq mode 'compilation-mode))
1642 0 : (let* ((name-of-mode
1643 0 : (if (eq mode t)
1644 : "compilation"
1645 0 : (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
1646 0 : (thisdir default-directory)
1647 0 : (thisenv compilation-environment)
1648 : outwin outbuf)
1649 0 : (with-current-buffer
1650 0 : (setq outbuf
1651 0 : (get-buffer-create
1652 0 : (compilation-buffer-name name-of-mode mode name-function)))
1653 0 : (let ((comp-proc (get-buffer-process (current-buffer))))
1654 0 : (if comp-proc
1655 0 : (if (or (not (eq (process-status comp-proc) 'run))
1656 0 : (eq (process-query-on-exit-flag comp-proc) nil)
1657 0 : (yes-or-no-p
1658 0 : (format "A %s process is running; kill it? "
1659 0 : name-of-mode)))
1660 0 : (condition-case ()
1661 0 : (progn
1662 0 : (interrupt-process comp-proc)
1663 0 : (sit-for 1)
1664 0 : (delete-process comp-proc))
1665 0 : (error nil))
1666 0 : (error "Cannot have two processes in `%s' at once"
1667 0 : (buffer-name)))))
1668 : ;; first transfer directory from where M-x compile was called
1669 0 : (setq default-directory thisdir)
1670 : ;; Make compilation buffer read-only. The filter can still write it.
1671 : ;; Clear out the compilation buffer.
1672 0 : (let ((inhibit-read-only t)
1673 0 : (default-directory thisdir))
1674 : ;; Then evaluate a cd command if any, but don't perform it yet, else
1675 : ;; start-command would do it again through the shell: (cd "..") AND
1676 : ;; sh -c "cd ..; make"
1677 0 : (cd (cond
1678 0 : ((not (string-match "\\`\\s *cd\\(?:\\s +\\(\\S +?\\|'[^']*'\\|\"\\(?:[^\"`$\\]\\|\\\\.\\)*\"\\)\\)?\\s *[;&\n]"
1679 0 : command))
1680 0 : default-directory)
1681 0 : ((not (match-end 1)) "~")
1682 0 : ((eq (aref command (match-beginning 1)) ?\')
1683 0 : (substring command (1+ (match-beginning 1))
1684 0 : (1- (match-end 1))))
1685 0 : ((eq (aref command (match-beginning 1)) ?\")
1686 0 : (replace-regexp-in-string
1687 : "\\\\\\(.\\)" "\\1"
1688 0 : (substring command (1+ (match-beginning 1))
1689 0 : (1- (match-end 1)))))
1690 : ;; Try globbing as well (bug#15417).
1691 0 : (t (let* ((substituted-dir
1692 0 : (substitute-env-vars (match-string 1 command)))
1693 : ;; FIXME: This also tries to expand `*' that were
1694 : ;; introduced by the envvar expansion!
1695 : (expanded-dir
1696 0 : (file-expand-wildcards substituted-dir)))
1697 0 : (if (= (length expanded-dir) 1)
1698 0 : (car expanded-dir)
1699 0 : substituted-dir)))))
1700 0 : (erase-buffer)
1701 : ;; Select the desired mode.
1702 0 : (if (not (eq mode t))
1703 0 : (progn
1704 0 : (buffer-disable-undo)
1705 0 : (funcall mode))
1706 0 : (setq buffer-read-only nil)
1707 0 : (with-no-warnings (comint-mode))
1708 0 : (compilation-shell-minor-mode))
1709 : ;; Remember the original dir, so we can use it when we recompile.
1710 : ;; default-directory' can't be used reliably for that because it may be
1711 : ;; affected by the special handling of "cd ...;".
1712 : ;; NB: must be done after (funcall mode) as that resets local variables
1713 0 : (set (make-local-variable 'compilation-directory) thisdir)
1714 0 : (set (make-local-variable 'compilation-environment) thisenv)
1715 0 : (if highlight-regexp
1716 0 : (set (make-local-variable 'compilation-highlight-regexp)
1717 0 : highlight-regexp))
1718 0 : (if (or compilation-auto-jump-to-first-error
1719 0 : (eq compilation-scroll-output 'first-error))
1720 0 : (set (make-local-variable 'compilation-auto-jump-to-next) t))
1721 : ;; Output a mode setter, for saving and later reloading this buffer.
1722 0 : (insert "-*- mode: " name-of-mode
1723 : "; default-directory: "
1724 0 : (prin1-to-string (abbreviate-file-name default-directory))
1725 : " -*-\n"
1726 0 : (format "%s started at %s\n\n"
1727 0 : mode-name
1728 0 : (substring (current-time-string) 0 19))
1729 0 : command "\n")
1730 0 : (setq thisdir default-directory))
1731 0 : (set-buffer-modified-p nil))
1732 : ;; Pop up the compilation buffer.
1733 : ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html
1734 0 : (setq outwin (display-buffer outbuf '(nil (allow-no-window . t))))
1735 0 : (with-current-buffer outbuf
1736 0 : (let ((process-environment
1737 0 : (append
1738 0 : compilation-environment
1739 0 : (if (if (boundp 'system-uses-terminfo);`If' for compiler warning.
1740 0 : system-uses-terminfo)
1741 0 : (list "TERM=dumb" "TERMCAP="
1742 0 : (format "COLUMNS=%d" (window-width)))
1743 0 : (list "TERM=emacs"
1744 0 : (format "TERMCAP=emacs:co#%d:tc=unknown:"
1745 0 : (window-width))))
1746 0 : (list (format "INSIDE_EMACS=%s,compile" emacs-version))
1747 0 : (copy-sequence process-environment))))
1748 0 : (set (make-local-variable 'compilation-arguments)
1749 0 : (list command mode name-function highlight-regexp))
1750 0 : (set (make-local-variable 'revert-buffer-function)
1751 0 : 'compilation-revert-buffer)
1752 0 : (and outwin
1753 : ;; Forcing the window-start overrides the usual redisplay
1754 : ;; feature of bringing point into view, so setting the
1755 : ;; window-start to top of the buffer risks losing the
1756 : ;; effect of moving point to EOB below, per
1757 : ;; compilation-scroll-output, if the command is long
1758 : ;; enough to push point outside of the window. This
1759 : ;; could happen, e.g., in `rgrep'.
1760 0 : (not compilation-scroll-output)
1761 0 : (set-window-start outwin (point-min)))
1762 :
1763 : ;; Position point as the user will see it.
1764 0 : (let ((desired-visible-point
1765 : ;; Put it at the end if `compilation-scroll-output' is set.
1766 0 : (if compilation-scroll-output
1767 0 : (point-max)
1768 : ;; Normally put it at the top.
1769 0 : (point-min))))
1770 0 : (goto-char desired-visible-point)
1771 0 : (when (and outwin (not (eq outwin (selected-window))))
1772 0 : (set-window-point outwin desired-visible-point)))
1773 :
1774 : ;; The setup function is called before compilation-set-window-height
1775 : ;; so it can set the compilation-window-height buffer locally.
1776 0 : (if compilation-process-setup-function
1777 0 : (funcall compilation-process-setup-function))
1778 0 : (and outwin (compilation-set-window-height outwin))
1779 : ;; Start the compilation.
1780 0 : (if (fboundp 'make-process)
1781 0 : (let ((proc
1782 0 : (if (eq mode t)
1783 : ;; comint uses `start-file-process'.
1784 0 : (get-buffer-process
1785 0 : (with-no-warnings
1786 0 : (comint-exec
1787 0 : outbuf (downcase mode-name)
1788 0 : (if (file-remote-p default-directory)
1789 : "/bin/sh"
1790 0 : shell-file-name)
1791 0 : nil `("-c" ,command))))
1792 0 : (start-file-process-shell-command (downcase mode-name)
1793 0 : outbuf command))))
1794 : ;; Make the buffer's mode line show process state.
1795 0 : (setq mode-line-process
1796 : '((:propertize ":%s" face compilation-mode-line-run)
1797 0 : compilation-mode-line-errors))
1798 :
1799 : ;; Set the process as killable without query by default.
1800 : ;; This allows us to start a new compilation without
1801 : ;; getting prompted.
1802 0 : (when compilation-always-kill
1803 0 : (set-process-query-on-exit-flag proc nil))
1804 :
1805 0 : (set-process-sentinel proc 'compilation-sentinel)
1806 0 : (unless (eq mode t)
1807 : ;; Keep the comint filter, since it's needed for proper
1808 : ;; handling of the prompts.
1809 0 : (set-process-filter proc 'compilation-filter))
1810 : ;; Use (point-max) here so that output comes in
1811 : ;; after the initial text,
1812 : ;; regardless of where the user sees point.
1813 0 : (set-marker (process-mark proc) (point-max) outbuf)
1814 0 : (when compilation-disable-input
1815 0 : (condition-case nil
1816 0 : (process-send-eof proc)
1817 : ;; The process may have exited already.
1818 0 : (error nil)))
1819 0 : (run-hook-with-args 'compilation-start-hook proc)
1820 0 : (setq compilation-in-progress
1821 0 : (cons proc compilation-in-progress)))
1822 : ;; No asynchronous processes available.
1823 0 : (message "Executing `%s'..." command)
1824 : ;; Fake mode line display as if `start-process' were run.
1825 0 : (setq mode-line-process
1826 : '((:propertize ":run" face compilation-mode-line-run)
1827 0 : compilation-mode-line-errors))
1828 0 : (force-mode-line-update)
1829 0 : (sit-for 0) ; Force redisplay
1830 0 : (save-excursion
1831 : ;; Insert the output at the end, after the initial text,
1832 : ;; regardless of where the user sees point.
1833 0 : (goto-char (point-max))
1834 0 : (let* ((inhibit-read-only t) ; call-process needs to modify outbuf
1835 0 : (compilation-filter-start (point))
1836 0 : (status (call-process shell-file-name nil outbuf nil "-c"
1837 0 : command)))
1838 0 : (run-hooks 'compilation-filter-hook)
1839 0 : (cond ((numberp status)
1840 0 : (compilation-handle-exit
1841 0 : 'exit status
1842 0 : (if (zerop status)
1843 : "finished\n"
1844 0 : (format "exited abnormally with code %d\n" status))))
1845 0 : ((stringp status)
1846 0 : (compilation-handle-exit 'signal status
1847 0 : (concat status "\n")))
1848 : (t
1849 0 : (compilation-handle-exit 'bizarre status status)))))
1850 0 : (set-buffer-modified-p nil)
1851 0 : (message "Executing `%s'...done" command)))
1852 : ;; Now finally cd to where the shell started make/grep/...
1853 0 : (setq default-directory thisdir)
1854 : ;; The following form selected outwin ever since revision 1.183,
1855 : ;; so possibly messing up point in some other window (bug#1073).
1856 : ;; Moved into the scope of with-current-buffer, though still with
1857 : ;; complete disregard for the case when compilation-scroll-output
1858 : ;; equals 'first-error (martin 2008-10-04).
1859 0 : (when compilation-scroll-output
1860 0 : (goto-char (point-max))))
1861 :
1862 : ;; Make it so the next C-x ` will use this buffer.
1863 0 : (setq next-error-last-buffer outbuf)))
1864 :
1865 : (defun compilation-set-window-height (window)
1866 : "Set the height of WINDOW according to `compilation-window-height'."
1867 0 : (let ((height (buffer-local-value 'compilation-window-height (window-buffer window))))
1868 0 : (and height
1869 0 : (window-full-width-p window)
1870 : ;; If window is alone in its frame, aside from a minibuffer,
1871 : ;; don't change its height.
1872 0 : (not (eq window (frame-root-window (window-frame window))))
1873 : ;; Stef said that doing the saves in this order is safer:
1874 0 : (save-excursion
1875 0 : (save-selected-window
1876 0 : (select-window window)
1877 0 : (enlarge-window (- height (window-height))))))))
1878 :
1879 : (defvar compilation-menu-map
1880 : (let ((map (make-sparse-keymap "Errors"))
1881 : (opt-map (make-sparse-keymap "Skip")))
1882 : (define-key map [stop-subjob]
1883 : '(menu-item "Stop Compilation" kill-compilation
1884 : :help "Kill the process made by the M-x compile or M-x grep commands"))
1885 : (define-key map [compilation-mode-separator3]
1886 : '("----" . nil))
1887 : (define-key map [compilation-next-error-follow-minor-mode]
1888 : '(menu-item
1889 : "Auto Error Display" next-error-follow-minor-mode
1890 : :help "Display the error under cursor when moving the cursor"
1891 : :button (:toggle . next-error-follow-minor-mode)))
1892 : (define-key map [compilation-skip]
1893 : (cons "Skip Less Important Messages" opt-map))
1894 : (define-key opt-map [compilation-skip-none]
1895 : '(menu-item "Don't Skip Any Messages"
1896 : (lambda ()
1897 : (interactive)
1898 : (customize-set-variable 'compilation-skip-threshold 0))
1899 : :help "Do not skip any type of messages"
1900 : :button (:radio . (eq compilation-skip-threshold 0))))
1901 : (define-key opt-map [compilation-skip-info]
1902 : '(menu-item "Skip Info"
1903 : (lambda ()
1904 : (interactive)
1905 : (customize-set-variable 'compilation-skip-threshold 1))
1906 : :help "Skip anything less than warning"
1907 : :button (:radio . (eq compilation-skip-threshold 1))))
1908 : (define-key opt-map [compilation-skip-warning-and-info]
1909 : '(menu-item "Skip Warnings and Info"
1910 : (lambda ()
1911 : (interactive)
1912 : (customize-set-variable 'compilation-skip-threshold 2))
1913 : :help "Skip over Warnings and Info, stop for errors"
1914 : :button (:radio . (eq compilation-skip-threshold 2))))
1915 : (define-key map [compilation-mode-separator2]
1916 : '("----" . nil))
1917 : (define-key map [compilation-first-error]
1918 : '(menu-item "First Error" first-error
1919 : :help "Restart at the first error, visit corresponding source code"))
1920 : (define-key map [compilation-previous-error]
1921 : '(menu-item "Previous Error" previous-error
1922 : :help "Visit previous `next-error' message and corresponding source code"))
1923 : (define-key map [compilation-next-error]
1924 : '(menu-item "Next Error" next-error
1925 : :help "Visit next `next-error' message and corresponding source code"))
1926 : map))
1927 :
1928 : (defvar compilation-minor-mode-map
1929 : (let ((map (make-sparse-keymap)))
1930 : (set-keymap-parent map special-mode-map)
1931 : (define-key map [mouse-2] 'compile-goto-error)
1932 : (define-key map [follow-link] 'mouse-face)
1933 : (define-key map "\C-c\C-c" 'compile-goto-error)
1934 : (define-key map "\C-m" 'compile-goto-error)
1935 : (define-key map "\C-o" 'compilation-display-error)
1936 : (define-key map "\C-c\C-k" 'kill-compilation)
1937 : (define-key map "\M-n" 'compilation-next-error)
1938 : (define-key map "\M-p" 'compilation-previous-error)
1939 : (define-key map "\M-{" 'compilation-previous-file)
1940 : (define-key map "\M-}" 'compilation-next-file)
1941 : (define-key map "g" 'recompile) ; revert
1942 : ;; Set up the menu-bar
1943 : (define-key map [menu-bar compilation]
1944 : (cons "Errors" compilation-menu-map))
1945 : map)
1946 : "Keymap for `compilation-minor-mode'.")
1947 :
1948 : (defvar compilation-shell-minor-mode-map
1949 : (let ((map (make-sparse-keymap)))
1950 : (define-key map "\M-\C-m" 'compile-goto-error)
1951 : (define-key map "\M-\C-n" 'compilation-next-error)
1952 : (define-key map "\M-\C-p" 'compilation-previous-error)
1953 : (define-key map "\M-{" 'compilation-previous-file)
1954 : (define-key map "\M-}" 'compilation-next-file)
1955 : ;; Set up the menu-bar
1956 : (define-key map [menu-bar compilation]
1957 : (cons "Errors" compilation-menu-map))
1958 : map)
1959 : "Keymap for `compilation-shell-minor-mode'.")
1960 :
1961 : (defvar compilation-button-map
1962 : (let ((map (make-sparse-keymap)))
1963 : (define-key map [mouse-2] 'compile-goto-error)
1964 : (define-key map [follow-link] 'mouse-face)
1965 : (define-key map "\C-m" 'compile-goto-error)
1966 : map)
1967 : "Keymap for compilation-message buttons.")
1968 : (fset 'compilation-button-map compilation-button-map)
1969 :
1970 : (defvar compilation-mode-map
1971 : (let ((map (make-sparse-keymap)))
1972 : ;; Don't inherit from compilation-minor-mode-map,
1973 : ;; because that introduces a menu bar item we don't want.
1974 : ;; That confuses C-down-mouse-3.
1975 : (set-keymap-parent map special-mode-map)
1976 : (define-key map [mouse-2] 'compile-goto-error)
1977 : (define-key map [follow-link] 'mouse-face)
1978 : (define-key map "\C-c\C-c" 'compile-goto-error)
1979 : (define-key map "\C-m" 'compile-goto-error)
1980 : (define-key map "\C-o" 'compilation-display-error)
1981 : (define-key map "\C-c\C-k" 'kill-compilation)
1982 : (define-key map "\M-n" 'compilation-next-error)
1983 : (define-key map "\M-p" 'compilation-previous-error)
1984 : (define-key map "\M-{" 'compilation-previous-file)
1985 : (define-key map "\M-}" 'compilation-next-file)
1986 : (define-key map "\t" 'compilation-next-error)
1987 : (define-key map [backtab] 'compilation-previous-error)
1988 : (define-key map "g" 'recompile) ; revert
1989 :
1990 : (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
1991 :
1992 : ;; Set up the menu-bar
1993 : (let ((submap (make-sparse-keymap "Compile")))
1994 : (define-key map [menu-bar compilation]
1995 : (cons "Compile" submap))
1996 : (set-keymap-parent submap compilation-menu-map))
1997 : (define-key map [menu-bar compilation compilation-separator2]
1998 : '("----" . nil))
1999 : (define-key map [menu-bar compilation compilation-grep]
2000 : '(menu-item "Search Files (grep)..." grep
2001 : :help "Run grep, with user-specified args, and collect output in a buffer"))
2002 : (define-key map [menu-bar compilation compilation-recompile]
2003 : '(menu-item "Recompile" recompile
2004 : :help "Re-compile the program including the current buffer"))
2005 : (define-key map [menu-bar compilation compilation-compile]
2006 : '(menu-item "Compile..." compile
2007 : :help "Compile the program including the current buffer. Default: run `make'"))
2008 : map)
2009 : "Keymap for compilation log buffers.
2010 : `compilation-minor-mode-map' is a parent of this.")
2011 :
2012 : (defvar compilation-mode-tool-bar-map
2013 : ;; When bootstrapping, tool-bar-map is not properly initialized yet,
2014 : ;; so don't do anything.
2015 : (when (keymapp tool-bar-map)
2016 : (let ((map (copy-keymap tool-bar-map)))
2017 : (define-key map [undo] nil)
2018 : (define-key map [separator-2] nil)
2019 : (define-key-after map [separator-compile] menu-bar-separator)
2020 : (tool-bar-local-item
2021 : "left-arrow" 'previous-error-no-select 'previous-error-no-select map
2022 : :rtl "right-arrow"
2023 : :help "Goto previous error")
2024 : (tool-bar-local-item
2025 : "right-arrow" 'next-error-no-select 'next-error-no-select map
2026 : :rtl "left-arrow"
2027 : :help "Goto next error")
2028 : (tool-bar-local-item
2029 : "cancel" 'kill-compilation 'kill-compilation map
2030 : :enable '(let ((buffer (compilation-find-buffer)))
2031 : (get-buffer-process buffer))
2032 : :help "Stop compilation")
2033 : (tool-bar-local-item
2034 : "refresh" 'recompile 'recompile map
2035 : :help "Restart compilation")
2036 : map)))
2037 :
2038 : (put 'compilation-mode 'mode-class 'special)
2039 :
2040 : ;;;###autoload
2041 : (defun compilation-mode (&optional name-of-mode)
2042 : "Major mode for compilation log buffers.
2043 : \\<compilation-mode-map>To visit the source for a line-numbered error,
2044 : move point to the error message line and type \\[compile-goto-error].
2045 : To kill the compilation, type \\[kill-compilation].
2046 :
2047 : Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
2048 :
2049 : \\{compilation-mode-map}"
2050 : (interactive)
2051 0 : (kill-all-local-variables)
2052 0 : (use-local-map compilation-mode-map)
2053 : ;; Let windows scroll along with the output.
2054 0 : (set (make-local-variable 'window-point-insertion-type) t)
2055 0 : (set (make-local-variable 'tool-bar-map) compilation-mode-tool-bar-map)
2056 0 : (setq major-mode 'compilation-mode ; FIXME: Use define-derived-mode.
2057 0 : mode-name (or name-of-mode "Compilation"))
2058 0 : (set (make-local-variable 'page-delimiter)
2059 0 : compilation-page-delimiter)
2060 : ;; (set (make-local-variable 'compilation-buffer-modtime) nil)
2061 0 : (compilation-setup)
2062 : ;; Turn off deferred fontifications in the compilation buffer, if
2063 : ;; the user turned them on globally. This is because idle timers
2064 : ;; aren't re-run after receiving input from a subprocess, so the
2065 : ;; buffer is left unfontified after the compilation exits, until
2066 : ;; some other input event happens.
2067 0 : (set (make-local-variable 'jit-lock-defer-time) nil)
2068 0 : (setq buffer-read-only t)
2069 0 : (run-mode-hooks 'compilation-mode-hook))
2070 :
2071 : ;;;###autoload
2072 : (put 'define-compilation-mode 'doc-string-elt 3)
2073 :
2074 : (defmacro define-compilation-mode (mode name doc &rest body)
2075 : "This is like `define-derived-mode' without the PARENT argument.
2076 : The parent is always `compilation-mode' and the customizable `compilation-...'
2077 : variables are also set from the name of the mode you have chosen,
2078 : by replacing the first word, e.g., `compilation-scroll-output' from
2079 : `grep-scroll-output' if that variable exists."
2080 0 : (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
2081 0 : `(define-derived-mode ,mode compilation-mode ,name
2082 0 : ,doc
2083 0 : ,@(mapcar (lambda (v)
2084 0 : (setq v (cons v
2085 0 : (intern-soft (replace-regexp-in-string
2086 0 : "^compilation" mode-name
2087 0 : (symbol-name v)))))
2088 0 : (and (cdr v)
2089 0 : (or (boundp (cdr v))
2090 : ;; FIXME: This is hackish, using undocumented info.
2091 0 : (if (boundp 'byte-compile-bound-variables)
2092 0 : (memq (cdr v) byte-compile-bound-variables)))
2093 0 : `(set (make-local-variable ',(car v)) ,(cdr v))))
2094 : '(compilation-buffer-name-function
2095 : compilation-directory-matcher
2096 : compilation-error
2097 : compilation-error-regexp-alist
2098 : compilation-error-regexp-alist-alist
2099 : compilation-error-screen-columns
2100 : compilation-finish-function
2101 : compilation-finish-functions
2102 : compilation-first-column
2103 : compilation-mode-font-lock-keywords
2104 : compilation-page-delimiter
2105 : compilation-parse-errors-filename-function
2106 : compilation-process-setup-function
2107 : compilation-scroll-output
2108 : compilation-search-path
2109 : compilation-skip-threshold
2110 0 : compilation-window-height))
2111 0 : ,@body)))
2112 :
2113 : (defun compilation-revert-buffer (ignore-auto noconfirm)
2114 0 : (if buffer-file-name
2115 0 : (let (revert-buffer-function)
2116 0 : (revert-buffer ignore-auto noconfirm))
2117 0 : (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
2118 0 : (apply 'compilation-start compilation-arguments))))
2119 :
2120 : (defvar compilation-current-error nil
2121 : "Marker to the location from where the next error will be found.
2122 : The global commands next/previous/first-error/goto-error use this.")
2123 :
2124 : (defvar compilation-messages-start nil
2125 : "Buffer position of the beginning of the compilation messages.
2126 : If nil, use the beginning of buffer.")
2127 :
2128 : (defun compilation-setup (&optional minor)
2129 : "Prepare the buffer for the compilation parsing commands to work.
2130 : Optional argument MINOR indicates this is called from
2131 : `compilation-minor-mode'."
2132 0 : (make-local-variable 'compilation-current-error)
2133 0 : (make-local-variable 'compilation-messages-start)
2134 0 : (make-local-variable 'compilation-error-screen-columns)
2135 0 : (make-local-variable 'overlay-arrow-position)
2136 0 : (setq-local compilation-num-errors-found 0)
2137 0 : (setq-local compilation-num-warnings-found 0)
2138 0 : (setq-local compilation-num-infos-found 0)
2139 0 : (set (make-local-variable 'overlay-arrow-string) "")
2140 0 : (setq next-error-overlay-arrow-position nil)
2141 0 : (add-hook 'kill-buffer-hook
2142 0 : (lambda () (setq next-error-overlay-arrow-position nil)) nil t)
2143 : ;; Note that compilation-next-error-function is for interfacing
2144 : ;; with the next-error function in simple.el, and it's only
2145 : ;; coincidentally named similarly to compilation-next-error.
2146 0 : (setq next-error-function 'compilation-next-error-function)
2147 0 : (set (make-local-variable 'comint-file-name-prefix)
2148 0 : (or (file-remote-p default-directory) ""))
2149 0 : (set (make-local-variable 'compilation-locs)
2150 0 : (make-hash-table :test 'equal :weakness 'value))
2151 : ;; It's generally preferable to use after-change-functions since they
2152 : ;; can be subject to combine-after-change-calls, but if we do that, we risk
2153 : ;; running our hook after font-lock, resulting in incorrect refontification.
2154 0 : (add-hook 'before-change-functions 'compilation--flush-parse nil t)
2155 : ;; Also for minor mode, since it's not permanent-local.
2156 0 : (add-hook 'change-major-mode-hook #'compilation--remove-properties nil t)
2157 0 : (if minor
2158 0 : (progn
2159 0 : (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
2160 0 : (font-lock-flush))
2161 0 : (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))))
2162 :
2163 : (defun compilation--unsetup ()
2164 : ;; Only for minor mode.
2165 0 : (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
2166 0 : (remove-hook 'before-change-functions 'compilation--flush-parse t)
2167 0 : (kill-local-variable 'compilation--parsed)
2168 0 : (compilation--remove-properties)
2169 0 : (font-lock-flush))
2170 :
2171 : ;;;###autoload
2172 : (define-minor-mode compilation-shell-minor-mode
2173 : "Toggle Compilation Shell minor mode.
2174 : With a prefix argument ARG, enable Compilation Shell minor mode
2175 : if ARG is positive, and disable it otherwise. If called from
2176 : Lisp, enable the mode if ARG is omitted or nil.
2177 :
2178 : When Compilation Shell minor mode is enabled, all the
2179 : error-parsing commands of the Compilation major mode are
2180 : available but bound to keys that don't collide with Shell mode.
2181 : See `compilation-mode'."
2182 : nil " Shell-Compile"
2183 : :group 'compilation
2184 0 : (if compilation-shell-minor-mode
2185 0 : (compilation-setup t)
2186 0 : (compilation--unsetup)))
2187 :
2188 : ;;;###autoload
2189 : (define-minor-mode compilation-minor-mode
2190 : "Toggle Compilation minor mode.
2191 : With a prefix argument ARG, enable Compilation minor mode if ARG
2192 : is positive, and disable it otherwise. If called from Lisp,
2193 : enable the mode if ARG is omitted or nil.
2194 :
2195 : When Compilation minor mode is enabled, all the error-parsing
2196 : commands of Compilation major mode are available. See
2197 : `compilation-mode'."
2198 : nil " Compilation"
2199 : :group 'compilation
2200 0 : (if compilation-minor-mode
2201 0 : (compilation-setup t)
2202 0 : (compilation--unsetup)))
2203 :
2204 : (defun compilation-handle-exit (process-status exit-status msg)
2205 : "Write MSG in the current buffer and hack its `mode-line-process'."
2206 0 : (let ((inhibit-read-only t)
2207 0 : (status (if compilation-exit-message-function
2208 0 : (funcall compilation-exit-message-function
2209 0 : process-status exit-status msg)
2210 0 : (cons msg exit-status)))
2211 0 : (omax (point-max))
2212 0 : (opoint (point))
2213 0 : (cur-buffer (current-buffer)))
2214 : ;; Record where we put the message, so we can ignore it later on.
2215 0 : (goto-char omax)
2216 0 : (insert ?\n mode-name " " (car status))
2217 0 : (if (and (numberp compilation-window-height)
2218 0 : (zerop compilation-window-height))
2219 0 : (message "%s" (cdr status)))
2220 0 : (if (bolp)
2221 0 : (forward-char -1))
2222 0 : (insert " at " (substring (current-time-string) 0 19))
2223 0 : (goto-char (point-max))
2224 : ;; Prevent that message from being recognized as a compilation error.
2225 0 : (add-text-properties omax (point)
2226 0 : (append '(compilation-handle-exit t) nil))
2227 0 : (setq mode-line-process
2228 0 : (list
2229 0 : (let ((out-string (format ":%s [%s]" process-status (cdr status)))
2230 0 : (msg (format "%s %s" mode-name
2231 0 : (replace-regexp-in-string "\n?$" ""
2232 0 : (car status)))))
2233 0 : (message "%s" msg)
2234 0 : (propertize out-string
2235 0 : 'help-echo msg
2236 0 : 'face (if (> exit-status 0)
2237 : 'compilation-mode-line-fail
2238 0 : 'compilation-mode-line-exit)))
2239 0 : compilation-mode-line-errors))
2240 : ;; Force mode line redisplay soon.
2241 0 : (force-mode-line-update)
2242 0 : (if (and opoint (< opoint omax))
2243 0 : (goto-char opoint))
2244 0 : (with-no-warnings
2245 0 : (if compilation-finish-function
2246 0 : (funcall compilation-finish-function cur-buffer msg)))
2247 0 : (run-hook-with-args 'compilation-finish-functions cur-buffer msg)))
2248 :
2249 : ;; Called when compilation process changes state.
2250 : (defun compilation-sentinel (proc msg)
2251 : "Sentinel for compilation buffers."
2252 0 : (if (memq (process-status proc) '(exit signal))
2253 0 : (let ((buffer (process-buffer proc)))
2254 0 : (if (null (buffer-name buffer))
2255 : ;; buffer killed
2256 0 : (set-process-buffer proc nil)
2257 0 : (with-current-buffer buffer
2258 : ;; Write something in the compilation buffer
2259 : ;; and hack its mode line.
2260 0 : (compilation-handle-exit (process-status proc)
2261 0 : (process-exit-status proc)
2262 0 : msg)
2263 : ;; Since the buffer and mode line will show that the
2264 : ;; process is dead, we can delete it now. Otherwise it
2265 : ;; will stay around until M-x list-processes.
2266 0 : (delete-process proc)))
2267 0 : (setq compilation-in-progress (delq proc compilation-in-progress)))))
2268 :
2269 : (defun compilation-filter (proc string)
2270 : "Process filter for compilation buffers.
2271 : Just inserts the text,
2272 : handles carriage motion (see `comint-inhibit-carriage-motion'),
2273 : and runs `compilation-filter-hook'."
2274 0 : (when (buffer-live-p (process-buffer proc))
2275 0 : (with-current-buffer (process-buffer proc)
2276 0 : (let ((inhibit-read-only t)
2277 : ;; `save-excursion' doesn't use the right insertion-type for us.
2278 0 : (pos (copy-marker (point) t))
2279 : ;; `save-restriction' doesn't use the right insertion type either:
2280 : ;; If we are inserting at the end of the accessible part of the
2281 : ;; buffer, keep the inserted text visible.
2282 0 : (min (point-min-marker))
2283 0 : (max (copy-marker (point-max) t))
2284 0 : (compilation-filter-start (marker-position (process-mark proc))))
2285 0 : (unwind-protect
2286 0 : (progn
2287 0 : (widen)
2288 0 : (goto-char compilation-filter-start)
2289 : ;; We used to use `insert-before-markers', so that windows with
2290 : ;; point at `process-mark' scroll along with the output, but we
2291 : ;; now use window-point-insertion-type instead.
2292 0 : (insert string)
2293 0 : (unless comint-inhibit-carriage-motion
2294 0 : (comint-carriage-motion (process-mark proc) (point)))
2295 0 : (set-marker (process-mark proc) (point))
2296 : ;; (set (make-local-variable 'compilation-buffer-modtime)
2297 : ;; (current-time))
2298 0 : (run-hooks 'compilation-filter-hook))
2299 0 : (goto-char pos)
2300 0 : (narrow-to-region min max)
2301 0 : (set-marker pos nil)
2302 0 : (set-marker min nil)
2303 0 : (set-marker max nil))))))
2304 :
2305 : ;;; test if a buffer is a compilation buffer, assuming we're in the buffer
2306 : (defsubst compilation-buffer-internal-p ()
2307 : "Test if inside a compilation buffer."
2308 0 : (local-variable-p 'compilation-locs))
2309 :
2310 : ;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p
2311 : (defsubst compilation-buffer-p (buffer)
2312 : "Test if BUFFER is a compilation buffer."
2313 0 : (with-current-buffer buffer
2314 0 : (compilation-buffer-internal-p)))
2315 :
2316 : (defmacro compilation-loop (< property-change 1+ error limit)
2317 2 : `(let (opt)
2318 2 : (while (,< n 0)
2319 : (setq opt pt)
2320 2 : (or (setq pt (,property-change pt 'compilation-message))
2321 : ;; Handle the case where where the first error message is
2322 : ;; at the start of the buffer, and n < 0.
2323 2 : (if (or (eq (get-text-property ,limit 'compilation-message)
2324 : (get-text-property opt 'compilation-message))
2325 : (eq pt opt))
2326 2 : (user-error ,error compilation-error)
2327 2 : (setq pt ,limit)))
2328 : ;; prop 'compilation-message usually has 2 changes, on and off, so
2329 : ;; re-search if off
2330 : (or (setq msg (get-text-property pt 'compilation-message))
2331 2 : (if (setq pt (,property-change pt 'compilation-message nil ,limit))
2332 : (setq msg (get-text-property pt 'compilation-message)))
2333 2 : (user-error ,error compilation-error))
2334 : (or (< (compilation--message->type msg) compilation-skip-threshold)
2335 : (if different-file
2336 : (eq (prog1 last
2337 : (setq last (compilation--loc->file-struct
2338 : (compilation--message->loc msg))))
2339 : last))
2340 : (if compilation-skip-visited
2341 : (compilation--loc->visited (compilation--message->loc msg)))
2342 : (if compilation-skip-to-next-location
2343 : (eq (compilation--message->loc msg) loc))
2344 : ;; count this message only if none of the above are true
2345 2 : (setq n (,1+ n))))))
2346 :
2347 : (defun compilation-next-single-property-change (position prop
2348 : &optional object limit)
2349 0 : (let (parsed res)
2350 0 : (while (progn
2351 : ;; We parse the buffer here "on-demand" by chunks of 500 chars.
2352 : ;; But we could also just parse the whole buffer.
2353 0 : (compilation--ensure-parse
2354 0 : (setq parsed (max compilation--parsed
2355 0 : (min (+ position 500)
2356 0 : (or limit (point-max))))))
2357 0 : (and (or (not (setq res (next-single-property-change
2358 0 : position prop object limit)))
2359 0 : (eq res limit))
2360 0 : (< position (or limit (point-max)))))
2361 0 : (setq position parsed))
2362 0 : res))
2363 :
2364 : (defun compilation-next-error (n &optional different-file pt)
2365 : "Move point to the next error in the compilation buffer.
2366 : This function does NOT find the source line like \\[next-error].
2367 : Prefix arg N says how many error messages to move forwards (or
2368 : backwards, if negative).
2369 : Optional arg DIFFERENT-FILE, if non-nil, means find next error for a
2370 : file that is different from the current one.
2371 : Optional arg PT, if non-nil, specifies the value of point to start
2372 : looking for the next message."
2373 : (interactive "p")
2374 0 : (or (compilation-buffer-p (current-buffer))
2375 0 : (error "Not in a compilation buffer"))
2376 0 : (or pt (setq pt (point)))
2377 0 : (compilation--ensure-parse pt)
2378 0 : (let* ((msg (get-text-property pt 'compilation-message))
2379 : ;; `loc', `msg', and `last' are used by the compilation-loop macro.
2380 0 : (loc (and msg (compilation--message->loc msg)))
2381 : last)
2382 0 : (if (zerop n)
2383 0 : (unless (or msg ; find message near here
2384 0 : (setq msg (get-text-property (max (1- pt) (point-min))
2385 0 : 'compilation-message)))
2386 0 : (setq pt (previous-single-property-change pt 'compilation-message nil
2387 0 : (line-beginning-position)))
2388 0 : (unless (setq msg (get-text-property (max (1- pt) (point-min))
2389 0 : 'compilation-message))
2390 0 : (setq pt (compilation-next-single-property-change
2391 0 : pt 'compilation-message nil
2392 0 : (line-end-position)))
2393 0 : (or (setq msg (get-text-property pt 'compilation-message))
2394 0 : (setq pt (point)))))
2395 0 : (setq last (compilation--loc->file-struct loc))
2396 0 : (if (>= n 0)
2397 0 : (compilation-loop > compilation-next-single-property-change 1-
2398 : (if (get-buffer-process (current-buffer))
2399 : "No more %ss yet"
2400 : "Moved past last %s")
2401 0 : (point-max))
2402 : ;; Don't move "back" to message at or before point.
2403 : ;; Pass an explicit (point-min) to make sure pt is non-nil.
2404 0 : (setq pt (previous-single-property-change
2405 0 : pt 'compilation-message nil (point-min)))
2406 0 : (compilation-loop < previous-single-property-change 1+
2407 0 : "Moved back before first %s" (point-min))))
2408 0 : (goto-char pt)
2409 0 : (or msg
2410 0 : (error "No %s here" compilation-error))))
2411 :
2412 : (defun compilation-previous-error (n)
2413 : "Move point to the previous error in the compilation buffer.
2414 : Prefix arg N says how many error messages to move backwards (or
2415 : forwards, if negative).
2416 : Does NOT find the source line like \\[previous-error]."
2417 : (interactive "p")
2418 0 : (compilation-next-error (- n)))
2419 :
2420 : (defun compilation-next-file (n)
2421 : "Move point to the next error for a different file than the current one.
2422 : Prefix arg N says how many files to move forwards (or backwards, if negative)."
2423 : (interactive "p")
2424 0 : (compilation-next-error n t))
2425 :
2426 : (defun compilation-previous-file (n)
2427 : "Move point to the previous error for a different file than the current one.
2428 : Prefix arg N says how many files to move backwards (or forwards, if negative)."
2429 : (interactive "p")
2430 0 : (compilation-next-file (- n)))
2431 :
2432 : (defun compilation-display-error ()
2433 : "Display the source for current error in another window."
2434 : (interactive)
2435 0 : (setq compilation-current-error (point))
2436 0 : (next-error-no-select 0))
2437 :
2438 : (defun kill-compilation ()
2439 : "Kill the process made by the \\[compile] or \\[grep] commands."
2440 : (interactive)
2441 0 : (let ((buffer (compilation-find-buffer)))
2442 0 : (if (get-buffer-process buffer)
2443 0 : (interrupt-process (get-buffer-process buffer))
2444 0 : (error "The %s process is not running" (downcase mode-name)))))
2445 :
2446 : (defalias 'compile-mouse-goto-error 'compile-goto-error)
2447 :
2448 : (defun compile-goto-error (&optional event)
2449 : "Visit the source for the error message at point.
2450 : Use this command in a compilation log buffer."
2451 0 : (interactive (list last-input-event))
2452 0 : (if event (posn-set-point (event-end event)))
2453 0 : (or (compilation-buffer-p (current-buffer))
2454 0 : (error "Not in a compilation buffer"))
2455 0 : (compilation--ensure-parse (point))
2456 0 : (if (get-text-property (point) 'compilation-directory)
2457 0 : (dired-other-window
2458 0 : (car (get-text-property (point) 'compilation-directory)))
2459 0 : (setq compilation-current-error (point))
2460 0 : (next-error-internal)))
2461 :
2462 : ;; This is mostly unused, but we keep it for the sake of some external
2463 : ;; packages which seem to make use of it.
2464 : (defun compilation-find-buffer (&optional avoid-current)
2465 : "Return a compilation buffer.
2466 : If AVOID-CURRENT is nil, and the current buffer is a compilation buffer,
2467 : return it. If AVOID-CURRENT is non-nil, return the current buffer only
2468 : as a last resort."
2469 0 : (if (and (compilation-buffer-internal-p) (not avoid-current))
2470 0 : (current-buffer)
2471 0 : (next-error-find-buffer avoid-current 'compilation-buffer-internal-p)))
2472 :
2473 : ;;;###autoload
2474 : (defun compilation-next-error-function (n &optional reset)
2475 : "Advance to the next error message and visit the file where the error was.
2476 : This is the value of `next-error-function' in Compilation buffers."
2477 : (interactive "p")
2478 0 : (when reset
2479 0 : (setq compilation-current-error nil))
2480 0 : (let* ((screen-columns compilation-error-screen-columns)
2481 0 : (first-column compilation-first-column)
2482 : (last 1)
2483 0 : (msg (compilation-next-error (or n 1) nil
2484 0 : (or compilation-current-error
2485 0 : compilation-messages-start
2486 0 : (point-min))))
2487 0 : (loc (compilation--message->loc msg))
2488 0 : (end-loc (compilation--message->end-loc msg))
2489 0 : (marker (point-marker)))
2490 0 : (setq compilation-current-error (point-marker)
2491 : overlay-arrow-position
2492 0 : (if (bolp)
2493 0 : compilation-current-error
2494 0 : (copy-marker (line-beginning-position))))
2495 : ;; If loc contains no marker, no error in that file has been visited.
2496 : ;; If the marker is invalid the buffer has been killed.
2497 : ;; So, recalculate all markers for that file.
2498 0 : (unless (and (compilation--loc->marker loc)
2499 0 : (marker-buffer (compilation--loc->marker loc))
2500 : ;; FIXME-omake: For "omake -P", which automatically recompiles
2501 : ;; when the file is modified, the line numbers of new output
2502 : ;; may not be related to line numbers from earlier output
2503 : ;; (earlier markers), so we used to try to detect it here and
2504 : ;; force a reparse. But that caused more problems elsewhere,
2505 : ;; so instead we now flush the file-structure when we see
2506 : ;; omake's message telling it's about to recompile a file.
2507 : ;; (or (null (compilation--loc->timestamp loc)) ;A fake-loc
2508 : ;; (equal (compilation--loc->timestamp loc)
2509 : ;; (setq timestamp compilation-buffer-modtime)))
2510 0 : )
2511 0 : (with-current-buffer
2512 0 : (apply #'compilation-find-file
2513 0 : marker
2514 0 : (caar (compilation--loc->file-struct loc))
2515 0 : (cadr (car (compilation--loc->file-struct loc)))
2516 0 : (compilation--file-struct->formats
2517 0 : (compilation--loc->file-struct loc)))
2518 0 : (let ((screen-columns
2519 : ;; Obey the compilation-error-screen-columns of the target
2520 : ;; buffer if its major mode set it buffer-locally.
2521 0 : (if (local-variable-p 'compilation-error-screen-columns)
2522 0 : compilation-error-screen-columns screen-columns))
2523 : (compilation-first-column
2524 0 : (if (local-variable-p 'compilation-first-column)
2525 0 : compilation-first-column first-column)))
2526 0 : (save-restriction
2527 0 : (widen)
2528 0 : (goto-char (point-min))
2529 : ;; Treat file's found lines in forward order, 1 by 1.
2530 0 : (dolist (line (reverse (cddr (compilation--loc->file-struct loc))))
2531 0 : (when (car line) ; else this is a filename w/o a line#
2532 0 : (compilation-beginning-of-line (- (car line) last -1))
2533 0 : (setq last (car line)))
2534 : ;; Treat line's found columns and store/update a marker for each.
2535 0 : (dolist (col (cdr line))
2536 0 : (if (compilation--loc->col col)
2537 0 : (if (eq (compilation--loc->col col) -1)
2538 : ;; Special case for range end.
2539 0 : (end-of-line)
2540 0 : (compilation-move-to-column (compilation--loc->col col)
2541 0 : screen-columns))
2542 0 : (beginning-of-line)
2543 0 : (skip-chars-forward " \t"))
2544 0 : (if (compilation--loc->marker col)
2545 0 : (set-marker (compilation--loc->marker col) (point))
2546 0 : (setf (compilation--loc->marker col) (point-marker)))
2547 : ;; (setf (compilation--loc->timestamp col) timestamp)
2548 0 : ))))))
2549 0 : (compilation-goto-locus marker (compilation--loc->marker loc)
2550 0 : (compilation--loc->marker end-loc))
2551 0 : (setf (compilation--loc->visited loc) t)))
2552 :
2553 : (defvar compilation-gcpro nil
2554 : "Internal variable used to keep some values from being GC'd.")
2555 : (make-variable-buffer-local 'compilation-gcpro)
2556 :
2557 : (defun compilation-fake-loc (marker file &optional line col)
2558 : "Preassociate MARKER with FILE.
2559 : FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
2560 : This is useful when you compile temporary files, but want
2561 : automatic translation of the messages to the real buffer from
2562 : which the temporary file came. This may also affect previous messages
2563 : about FILE.
2564 :
2565 : Optional args LINE and COL default to 1 and beginning of
2566 : indentation respectively. The marker is expected to reflect
2567 : this. In the simplest case the marker points to the first line
2568 : of the region that was saved to the temp file.
2569 :
2570 : If you concatenate several regions into the temp file (e.g. a
2571 : header with variable assignments and a code region), you must
2572 : call this several times, once each for the last line of one
2573 : region and the first line of the next region."
2574 0 : (or (consp file) (setq file (list file)))
2575 0 : (compilation--flush-file-structure file)
2576 0 : (let ((fs (compilation-get-file-structure file)))
2577 : ;; Between the current call to compilation-fake-loc and the first
2578 : ;; occurrence of an error message referring to `file', the data is
2579 : ;; only kept in the weak hash-table compilation-locs, so we need
2580 : ;; to prevent this entry in compilation-locs from being GC'd
2581 : ;; away. --Stef
2582 0 : (push fs compilation-gcpro)
2583 0 : (let ((loc (compilation-assq (or line 1) (cdr fs))))
2584 0 : (setq loc (compilation-assq col loc))
2585 0 : (cl-assert (null (cdr loc)))
2586 0 : (setcdr loc (compilation--make-cdrloc line fs marker))
2587 0 : loc)))
2588 :
2589 : (defcustom compilation-context-lines nil
2590 : "Display this many lines of leading context before the current message.
2591 : If nil and the left fringe is displayed, don't scroll the
2592 : compilation output window; an arrow in the left fringe points to
2593 : the current message. If nil and there is no left fringe, the message
2594 : displays at the top of the window; there is no arrow."
2595 : :type '(choice integer (const :tag "No window scrolling" nil))
2596 : :group 'compilation
2597 : :version "22.1")
2598 :
2599 : (defsubst compilation-set-window (w mk)
2600 : "Align the compilation output window W with marker MK near top."
2601 0 : (if (integerp compilation-context-lines)
2602 0 : (set-window-start w (save-excursion
2603 0 : (goto-char mk)
2604 0 : (compilation-beginning-of-line
2605 0 : (- 1 compilation-context-lines))
2606 0 : (point)))
2607 : ;; If there is no left fringe.
2608 0 : (when (equal (car (window-fringes w)) 0)
2609 0 : (set-window-start w (save-excursion
2610 0 : (goto-char mk)
2611 0 : (beginning-of-line 1)
2612 0 : (point)))))
2613 0 : (set-window-point w mk))
2614 :
2615 : (defvar next-error-highlight-timer)
2616 :
2617 : (defun compilation-goto-locus (msg mk end-mk)
2618 : "Jump to an error corresponding to MSG at MK.
2619 : All arguments are markers. If END-MK is non-nil, mark is set there
2620 : and overlay is highlighted between MK and END-MK."
2621 : ;; Show compilation buffer in other window, scrolled to this error.
2622 0 : (let* ((from-compilation-buffer (eq (window-buffer)
2623 0 : (marker-buffer msg)))
2624 : ;; Use an existing window if it is in a visible frame.
2625 0 : (pre-existing (get-buffer-window (marker-buffer msg) 0))
2626 0 : (w (if (and from-compilation-buffer pre-existing)
2627 : ;; Calling display-buffer here may end up (partly) hiding
2628 : ;; the error location if the two buffers are in two
2629 : ;; different frames. So don't do it if it's not necessary.
2630 0 : pre-existing
2631 0 : (display-buffer (marker-buffer msg) '(nil (allow-no-window . t)))))
2632 0 : (highlight-regexp (with-current-buffer (marker-buffer msg)
2633 : ;; also do this while we change buffer
2634 0 : (goto-char (marker-position msg))
2635 0 : (and w (compilation-set-window w msg))
2636 0 : compilation-highlight-regexp)))
2637 : ;; Ideally, the window-size should be passed to `display-buffer'
2638 : ;; so it's only used when creating a new window.
2639 0 : (when (and (not pre-existing) w)
2640 0 : (compilation-set-window-height w))
2641 :
2642 0 : (if from-compilation-buffer
2643 : ;; If the compilation buffer window was selected,
2644 : ;; keep the compilation buffer in this window;
2645 : ;; display the source in another window.
2646 0 : (let ((pop-up-windows t))
2647 0 : (pop-to-buffer (marker-buffer mk) 'other-window))
2648 0 : (switch-to-buffer (marker-buffer mk)))
2649 0 : (unless (eq (goto-char mk) (point))
2650 : ;; If narrowing gets in the way of going to the right place, widen.
2651 0 : (widen)
2652 0 : (if next-error-move-function
2653 0 : (funcall next-error-move-function msg mk)
2654 0 : (goto-char mk)))
2655 0 : (if end-mk
2656 0 : (push-mark end-mk t)
2657 0 : (if mark-active (setq mark-active nil)))
2658 : ;; If hideshow got in the way of
2659 : ;; seeing the right place, open permanently.
2660 0 : (dolist (ov (overlays-at (point)))
2661 0 : (when (eq 'hs (overlay-get ov 'invisible))
2662 0 : (delete-overlay ov)
2663 0 : (goto-char mk)))
2664 :
2665 0 : (when highlight-regexp
2666 0 : (if (timerp next-error-highlight-timer)
2667 0 : (cancel-timer next-error-highlight-timer))
2668 0 : (unless compilation-highlight-overlay
2669 0 : (setq compilation-highlight-overlay
2670 0 : (make-overlay (point-min) (point-min)))
2671 0 : (overlay-put compilation-highlight-overlay 'face 'next-error))
2672 0 : (with-current-buffer (marker-buffer mk)
2673 0 : (save-excursion
2674 0 : (if end-mk (goto-char end-mk) (end-of-line))
2675 0 : (let ((end (point)))
2676 0 : (if mk (goto-char mk) (beginning-of-line))
2677 0 : (if (and (stringp highlight-regexp)
2678 0 : (re-search-forward highlight-regexp end t))
2679 0 : (progn
2680 0 : (goto-char (match-beginning 0))
2681 0 : (move-overlay compilation-highlight-overlay
2682 0 : (match-beginning 0) (match-end 0)
2683 0 : (current-buffer)))
2684 0 : (move-overlay compilation-highlight-overlay
2685 0 : (point) end (current-buffer)))
2686 0 : (if (or (eq next-error-highlight t)
2687 0 : (numberp next-error-highlight))
2688 : ;; We want highlighting: delete overlay on next input.
2689 0 : (add-hook 'pre-command-hook
2690 0 : 'compilation-goto-locus-delete-o)
2691 : ;; We don't want highlighting: delete overlay now.
2692 0 : (delete-overlay compilation-highlight-overlay))
2693 : ;; We want highlighting for a limited time:
2694 : ;; set up a timer to delete it.
2695 0 : (when (numberp next-error-highlight)
2696 0 : (setq next-error-highlight-timer
2697 0 : (run-at-time next-error-highlight nil
2698 0 : 'compilation-goto-locus-delete-o)))))))
2699 0 : (when (and (eq next-error-highlight 'fringe-arrow))
2700 : ;; We want a fringe arrow (instead of highlighting).
2701 0 : (setq next-error-overlay-arrow-position
2702 0 : (copy-marker (line-beginning-position))))))
2703 :
2704 : (defun compilation-goto-locus-delete-o ()
2705 0 : (delete-overlay compilation-highlight-overlay)
2706 : ;; Get rid of timer and hook that would try to do this again.
2707 0 : (if (timerp next-error-highlight-timer)
2708 0 : (cancel-timer next-error-highlight-timer))
2709 0 : (remove-hook 'pre-command-hook
2710 0 : 'compilation-goto-locus-delete-o))
2711 :
2712 : (defun compilation-find-file (marker filename directory &rest formats)
2713 : "Find a buffer for file FILENAME.
2714 : If FILENAME is not found at all, ask the user where to find it.
2715 : Pop up the buffer containing MARKER and scroll to MARKER if we ask
2716 : the user where to find the file.
2717 : Search the directories in `compilation-search-path'.
2718 : A nil in `compilation-search-path' means to try the
2719 : \"current\" directory, which is passed in DIRECTORY.
2720 : If DIRECTORY is relative, it is combined with `default-directory'.
2721 : If DIRECTORY is nil, that means use `default-directory'.
2722 : FORMATS, if given, is a list of formats to reformat FILENAME when
2723 : looking for it: for each element FMT in FORMATS, this function
2724 : attempts to find a file whose name is produced by (format FMT FILENAME)."
2725 0 : (or formats (setq formats '("%s")))
2726 0 : (let ((dirs compilation-search-path)
2727 0 : (spec-dir (if directory
2728 0 : (expand-file-name directory)
2729 0 : default-directory))
2730 : buffer thisdir fmts name)
2731 0 : (if (file-name-absolute-p filename)
2732 : ;; The file name is absolute. Use its explicit directory as
2733 : ;; the first in the search path, and strip it from FILENAME.
2734 0 : (setq filename (abbreviate-file-name (expand-file-name filename))
2735 0 : dirs (cons (file-name-directory filename) dirs)
2736 0 : filename (file-name-nondirectory filename)))
2737 : ;; Now search the path.
2738 0 : (while (and dirs (null buffer))
2739 0 : (setq thisdir (or (car dirs) spec-dir)
2740 0 : fmts formats)
2741 : ;; For each directory, try each format string.
2742 0 : (while (and fmts (null buffer))
2743 0 : (setq name (expand-file-name (format (car fmts) filename) thisdir)
2744 0 : buffer (and (file-exists-p name)
2745 0 : (find-file-noselect name))
2746 0 : fmts (cdr fmts)))
2747 0 : (setq dirs (cdr dirs)))
2748 0 : (while (null buffer) ;Repeat until the user selects an existing file.
2749 : ;; The file doesn't exist. Ask the user where to find it.
2750 0 : (save-excursion ;This save-excursion is probably not right.
2751 0 : (let ((w (let ((pop-up-windows t))
2752 0 : (display-buffer (marker-buffer marker)
2753 0 : '(nil (allow-no-window . t))))))
2754 0 : (with-current-buffer (marker-buffer marker)
2755 0 : (goto-char marker)
2756 0 : (and w (compilation-set-window w marker)))
2757 0 : (let* ((name (read-file-name
2758 0 : (format "Find this %s in (default %s): "
2759 0 : compilation-error filename)
2760 0 : spec-dir filename t nil
2761 : ;; The predicate below is fine when called from
2762 : ;; minibuffer-complete-and-exit, but it's too
2763 : ;; restrictive otherwise, since it also prevents the
2764 : ;; user from completing "fo" to "foo/" when she
2765 : ;; wants to enter "foo/bar".
2766 : ;;
2767 : ;; Try to make sure the user can only select
2768 : ;; a valid answer. This predicate may be ignored,
2769 : ;; tho, so we still have to double-check afterwards.
2770 : ;; TODO: We should probably fix read-file-name so
2771 : ;; that it never ignores this predicate, even when
2772 : ;; using popup dialog boxes.
2773 : ;; (lambda (name)
2774 : ;; (if (file-directory-p name)
2775 : ;; (setq name (expand-file-name filename name)))
2776 : ;; (file-exists-p name))
2777 0 : ))
2778 0 : (origname name))
2779 0 : (cond
2780 0 : ((not (file-exists-p name))
2781 0 : (message "Cannot find file `%s'" name)
2782 0 : (ding) (sit-for 2))
2783 0 : ((and (file-directory-p name)
2784 0 : (not (file-exists-p
2785 0 : (setq name (expand-file-name filename name)))))
2786 0 : (message "No `%s' in directory %s" filename origname)
2787 0 : (ding) (sit-for 2))
2788 : (t
2789 0 : (setq buffer (find-file-noselect name))))))))
2790 : ;; Make intangible overlays tangible.
2791 : ;; This is weird: it's not even clear which is the current buffer,
2792 : ;; so the code below can't be expected to DTRT here. -- Stef
2793 0 : (dolist (ov (overlays-in (point-min) (point-max)))
2794 0 : (when (overlay-get ov 'intangible)
2795 0 : (overlay-put ov 'intangible nil)))
2796 0 : buffer))
2797 :
2798 : (defun compilation-get-file-structure (file &optional fmt)
2799 : "Retrieve FILE's file-structure or create a new one.
2800 : FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
2801 : In the former case, FILENAME may be relative or absolute.
2802 :
2803 : The file-structure looks like this:
2804 : ((FILENAME [TRUE-DIRNAME]) FMT ...)
2805 :
2806 : TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
2807 0 : (or (gethash file compilation-locs)
2808 : ;; File was not previously encountered, at least not in the form passed.
2809 : ;; Let's normalize it and look again.
2810 0 : (let ((filename (car file))
2811 : ;; Get the specified directory from FILE.
2812 0 : (spec-directory (if (cdr file)
2813 0 : (file-truename (cdr file)))))
2814 :
2815 : ;; Check for a comint-file-name-prefix and prepend it if appropriate.
2816 : ;; (This is very useful for compilation-minor-mode in an rlogin-mode
2817 : ;; buffer.)
2818 0 : (when (and (boundp 'comint-file-name-prefix)
2819 0 : (not (equal comint-file-name-prefix "")))
2820 0 : (if (file-name-absolute-p filename)
2821 0 : (setq filename
2822 0 : (concat comint-file-name-prefix filename))
2823 0 : (if spec-directory
2824 0 : (setq spec-directory
2825 0 : (file-truename
2826 0 : (concat comint-file-name-prefix spec-directory))))))
2827 :
2828 : ;; If compilation-parse-errors-filename-function is
2829 : ;; defined, use it to process the filename.
2830 0 : (when compilation-parse-errors-filename-function
2831 0 : (setq filename
2832 0 : (funcall compilation-parse-errors-filename-function
2833 0 : filename)))
2834 :
2835 : ;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus
2836 : ;; file names like "./bar//foo.c" for file "bar/foo.c";
2837 : ;; expand-file-name will collapse these into "/foo.c" and fail to find
2838 : ;; the appropriate file. So we look for doubled slashes in the file
2839 : ;; name and fix them.
2840 0 : (setq filename (command-line-normalize-file-name filename))
2841 :
2842 : ;; Store it for the possibly unnormalized name
2843 0 : (puthash file
2844 : ;; Retrieve or create file-structure for normalized name
2845 : ;; The gethash used to not use spec-directory, but
2846 : ;; this leads to errors when files in different
2847 : ;; directories have the same name:
2848 : ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html
2849 0 : (or (gethash (cons filename spec-directory) compilation-locs)
2850 0 : (puthash (cons filename spec-directory)
2851 0 : (compilation--make-file-struct
2852 0 : (list filename spec-directory) fmt)
2853 0 : compilation-locs))
2854 0 : compilation-locs))))
2855 :
2856 : (defun compilation--flush-file-structure (file)
2857 0 : (or (consp file) (setq file (list file)))
2858 0 : (let ((fs (compilation-get-file-structure file)))
2859 0 : (cl-assert (eq fs (gethash file compilation-locs)))
2860 0 : (cl-assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
2861 0 : compilation-locs)))
2862 0 : (maphash (lambda (k v)
2863 0 : (if (eq v fs) (remhash k compilation-locs)))
2864 0 : compilation-locs)))
2865 :
2866 : ;;; Compatibility with the old compile.el.
2867 :
2868 : (defvaralias 'compilation-last-buffer 'next-error-last-buffer)
2869 : (defvar compilation-parsing-end (make-marker))
2870 : (defvar compilation-error-list nil)
2871 : (defvar compilation-old-error-list nil)
2872 :
2873 : (defun compilation--compat-error-properties (err)
2874 : "Map old-style error ERR to new-style message."
2875 : ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or
2876 : ;; (MARKER . MARKER).
2877 0 : (let ((dst (cdr err)))
2878 0 : (if (markerp dst)
2879 0 : `(compilation-message ,(compilation--make-message
2880 0 : (cons nil (compilation--make-cdrloc
2881 0 : nil nil dst))
2882 0 : 2 nil)
2883 : help-echo "mouse-2: visit the source location"
2884 : keymap compilation-button-map
2885 0 : mouse-face highlight)
2886 : ;; Too difficult to do it by hand: dispatch to the normal code.
2887 0 : (let* ((file (pop dst))
2888 0 : (line (pop dst))
2889 0 : (col (pop dst))
2890 0 : (filename (pop file))
2891 0 : (dirname (pop file))
2892 0 : (fmt (pop file)))
2893 0 : (compilation-internal-error-properties
2894 0 : (cons filename dirname) line nil col nil 2 fmt)))))
2895 :
2896 : (defun compilation--compat-parse-errors (limit)
2897 0 : (when compilation-parse-errors-function
2898 : ;; FIXME: We should remove the rest of the compilation keywords
2899 : ;; but we can't do that from here because font-lock is using
2900 : ;; the value right now. --Stef
2901 0 : (save-excursion
2902 0 : (setq compilation-error-list nil)
2903 : ;; Reset compilation-parsing-end each time because font-lock
2904 : ;; might force us the re-parse many times (typically because
2905 : ;; some code adds some text-property to the output that we
2906 : ;; already parsed). You might say "why reparse", well:
2907 : ;; because font-lock has just removed the `compilation-message' property
2908 : ;; so have to do it all over again.
2909 0 : (if compilation-parsing-end
2910 0 : (set-marker compilation-parsing-end (point))
2911 0 : (setq compilation-parsing-end (point-marker)))
2912 0 : (condition-case nil
2913 : ;; Ignore any error: we're calling this function earlier than
2914 : ;; in the old compile.el so things might not all be setup yet.
2915 0 : (funcall compilation-parse-errors-function limit nil)
2916 0 : (error nil))
2917 0 : (dolist (err (if (listp compilation-error-list) compilation-error-list))
2918 0 : (let* ((src (car err))
2919 0 : (dst (cdr err))
2920 0 : (loc (cond ((markerp dst)
2921 0 : (cons nil
2922 0 : (compilation--make-cdrloc nil nil dst)))
2923 0 : ((consp dst)
2924 0 : (cons (nth 2 dst)
2925 0 : (compilation--make-cdrloc
2926 : (nth 1 dst)
2927 : (cons (cdar dst) (caar dst))
2928 0 : nil))))))
2929 0 : (when loc
2930 0 : (goto-char src)
2931 : ;; (put-text-property src (line-end-position)
2932 : ;; 'font-lock-face 'font-lock-warning-face)
2933 0 : (put-text-property src (line-end-position)
2934 : 'compilation-message
2935 0 : (compilation--make-message loc 2 nil)))))))
2936 0 : (goto-char limit)
2937 : nil)
2938 :
2939 : ;; Beware! this is not only compatibility code. New code also uses it. --Stef
2940 : (defun compilation-forget-errors ()
2941 : ;; In case we hit the same file/line specs, we want to recompute a new
2942 : ;; marker for them, so flush our cache.
2943 0 : (clrhash compilation-locs)
2944 0 : (setq compilation-gcpro nil)
2945 : ;; FIXME: the old code reset the directory-stack, so maybe we should
2946 : ;; put a `directory change' marker of some sort, but where? -stef
2947 : ;;
2948 : ;; FIXME: The old code moved compilation-current-error (which was
2949 : ;; virtually represented by a mix of compilation-parsing-end and
2950 : ;; compilation-error-list) to point-min, but that was only meaningful for
2951 : ;; the internal uses of compilation-forget-errors: all calls from external
2952 : ;; packages seem to be followed by a move of compilation-parsing-end to
2953 : ;; something equivalent to point-max. So we heuristically move
2954 : ;; compilation-current-error to point-max (since the external package
2955 : ;; won't know that it should do it). --Stef
2956 0 : (setq compilation-current-error nil)
2957 0 : (let* ((proc (get-buffer-process (current-buffer)))
2958 0 : (mark (if proc (process-mark proc)))
2959 0 : (pos (or mark (point-max))))
2960 0 : (setq compilation-messages-start
2961 : ;; In the future, ignore the text already present in the buffer.
2962 : ;; Since many process filter functions insert before markers,
2963 : ;; we need to put ours just before the insertion point rather
2964 : ;; than at the insertion point. If that's not possible, then
2965 : ;; don't use a marker. --Stef
2966 0 : (if (> pos (point-min)) (copy-marker (1- pos)) pos)))
2967 : ;; Again, since this command is used in buffers that contain several
2968 : ;; compilations, to set the beginning of "this compilation", it's a good
2969 : ;; place to reset compilation-auto-jump-to-next.
2970 0 : (set (make-local-variable 'compilation-auto-jump-to-next)
2971 0 : (or compilation-auto-jump-to-first-error
2972 0 : (eq compilation-scroll-output 'first-error))))
2973 :
2974 : (provide 'compile)
2975 :
2976 : ;;; compile.el ends here
|