Commit | Line | Data |
---|---|---|
55dfd2c4 RS |
1 | ;; Run compiler as inferior of Emacs, and parse its error messages. |
2 | ;; Copyright (C) 1985, 1986, 1988, 1989 Free Software Foundation, Inc. | |
3 | ||
4 | ;; This file is part of GNU Emacs. | |
5 | ||
6 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
7 | ;; it under the terms of the GNU General Public License as published by | |
8 | ;; the Free Software Foundation; either version 1, or (at your option) | |
9 | ;; any later version. | |
10 | ||
11 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
12 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;; GNU General Public License for more details. | |
15 | ||
16 | ;; You should have received a copy of the GNU General Public License | |
17 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
18 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
19 | ||
20 | (provide 'compile) | |
21 | ||
22 | (defvar compilation-error-list nil | |
23 | "List of error message descriptors for visiting erring functions. | |
24 | Each error descriptor is a list of length two. | |
25 | Its car is a marker pointing to an error message. | |
26 | Its cadr is a marker pointing to the text of the line the message is about, | |
27 | or nil if that is not interesting. | |
28 | The value may be t instead of a list; | |
29 | this means that the buffer of error messages should be reparsed | |
30 | the next time the list of errors is wanted.") | |
31 | ||
32 | (defvar compilation-old-error-list nil | |
33 | "Value of `compilation-error-list' after errors were parsed.") | |
34 | ||
35 | (defvar compilation-last-error nil | |
36 | "List describing the error found by last call to \\[next-error]. | |
37 | A list of two markers (ERROR-POS CODE-POS), | |
38 | pointing to the error message and the erroneous code, respectively. | |
39 | CODE-POS can be nil, if the error message has no specific source location.") | |
40 | ||
41 | (defvar compilation-parse-errors-hook 'compilation-parse-errors | |
42 | "Function to call (no args) to parse error messages from a compilation. | |
43 | It should read in the source files which have errors | |
44 | and set `compilation-error-list' to a list with an element | |
45 | for each error message found. See that variable for more info.") | |
46 | ||
47 | (defvar compilation-error-buffer nil | |
48 | "Current compilation buffer for compilation error processing.") | |
49 | ||
50 | (defvar compilation-parsing-end nil | |
51 | "Position of end of buffer when last error messages parsed.") | |
52 | ||
53 | (defvar compilation-error-message nil | |
54 | "Message to print when no more matches for compilation-error-regexp are found") | |
55 | ||
56 | ;; The filename excludes colons to avoid confusion when error message | |
57 | ;; starts with digits. | |
58 | (defvar compilation-error-regexp | |
59 | "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)\\|\\(\"[^ \n]+\",L[0-9]+\\)" | |
60 | "Regular expression for filename/linenumber in error in compilation log.") | |
61 | ||
62 | (defvar compile-window-height nil | |
63 | "*Desired height of compilation window. nil means use Emacs default.") | |
64 | ||
65 | (defvar compile-command "make -k " | |
66 | "Last shell command used to do a compilation; default for next compilation. | |
67 | ||
68 | Sometimes it is useful for files to supply local values for this variable. | |
69 | You might also use mode hooks to specify it in certain modes, like this: | |
70 | ||
71 | (setq c-mode-hook | |
72 | '(lambda () (or (file-exists-p \"makefile\") (file-exists-p \"Makefile\") | |
73 | (progn (make-local-variable 'compile-command) | |
74 | (setq compile-command | |
75 | (concat \"make -k \" | |
76 | buffer-file-name))))))") | |
77 | ||
78 | (defvar compilation-search-path '(nil) | |
79 | "List of directories to search for source files named in error messages. | |
80 | Elements should be directory names, not file names of directories. | |
81 | nil as an element means to try the default directory.") | |
82 | ||
83 | (defun compile (command) | |
84 | "Compile the program including the current buffer. Default: run `make'. | |
85 | Runs COMMAND, a shell command, in a separate process asynchronously | |
86 | with output going to the buffer `*compilation*'. | |
87 | You can then use the command \\[next-error] to find the next error message | |
88 | and move to the source code that caused it. | |
89 | ||
90 | To run more than one compilation at once, start one and rename the | |
91 | `*compilation*' buffer to some other name. Then start the next one." | |
92 | (interactive (list (read-string "Compile command: " compile-command))) | |
93 | (setq compile-command command) | |
94 | (save-some-buffers nil nil) | |
95 | (compile-internal compile-command "No more errors") | |
96 | (and compile-window-height | |
97 | (= (window-width) (screen-width)) | |
98 | (enlarge-window (- (- (screen-height) (window-height)) | |
99 | compile-window-height) nil))) | |
100 | ||
101 | (defun grep (command-args) | |
102 | "Run grep, with user-specified args, and collect output in a buffer. | |
103 | While grep runs asynchronously, you can use the \\[next-error] command | |
104 | to find the text that grep hits refer to. It is expected that `grep-command' | |
105 | has a `-n' flag, so that line numbers are displayed for each match." | |
106 | (interactive | |
107 | (list (read-string (concat "Run " | |
108 | (substring grep-command 0 | |
109 | (string-match "[\t ]+" grep-command)) | |
110 | " (with args): ") | |
111 | (progn | |
112 | (string-match "-n[\t ]+" grep-command) | |
113 | (substring grep-command (match-end 0)))))) | |
114 | ;; why a redundant string-match? It might not be interactive ... | |
115 | (setq grep-command (concat (substring grep-command 0 | |
116 | (progn | |
117 | (string-match "-n" grep-command) | |
118 | (match-end 0))) | |
119 | " " command-args)) | |
120 | (compile-internal (concat grep-command " /dev/null") | |
121 | "No more grep hits" "grep")) | |
122 | ||
123 | (defun compile-internal (command error-message | |
124 | &optional name-of-mode parser regexp) | |
125 | "Run compilation command COMMAND (low level interface). | |
126 | ERROR-MESSAGE is a string to print if the user asks to see another error | |
127 | and there are no more errors. Third argument NAME-OF-MODE is the name | |
128 | to display as the major mode in the `*compilation*' buffer. | |
129 | ||
130 | Fourth arg PARSER is the error parser function (nil means the default). | |
131 | Fifth arg REGEXP is the error message regexp to use (nil means the default). | |
132 | The defaults for these variables are the global values of | |
133 | `compilation-parse-errors-hook' and `compilation-error-regexp'." | |
134 | (save-excursion | |
135 | (set-buffer (get-buffer-create "*compilation*")) | |
136 | (setq buffer-read-only nil) | |
137 | (let ((comp-proc (get-buffer-process (current-buffer)))) | |
138 | (if comp-proc | |
139 | (if (or (not (eq (process-status comp-proc) 'run)) | |
140 | (yes-or-no-p "A compilation process is running; kill it? ")) | |
141 | (condition-case () | |
142 | (progn | |
143 | (interrupt-process comp-proc) | |
144 | (sit-for 1) | |
145 | (delete-process comp-proc)) | |
146 | (error nil)) | |
147 | (error "Cannot have two processes in `*compilation*' at once")))) | |
148 | ;; In case *compilation* is current buffer, | |
149 | ;; make sure we get the global values of compilation-error-regexp, etc. | |
150 | (kill-all-local-variables)) | |
151 | (compilation-forget-errors) | |
152 | (start-process-shell-command "compilation" "*compilation*" command) | |
153 | (with-output-to-temp-buffer "*compilation*" | |
154 | (princ "cd ") | |
155 | (princ default-directory) | |
156 | (terpri) | |
157 | (princ command) | |
158 | (terpri)) | |
159 | (let* ((regexp (or regexp compilation-error-regexp)) | |
160 | (parser (or parser compilation-parse-errors-hook)) | |
161 | (thisdir default-directory) | |
162 | (outbuf (get-buffer "*compilation*")) | |
163 | (outwin (get-buffer-window outbuf))) | |
164 | (if (eq outbuf (current-buffer)) | |
165 | (goto-char (point-max))) | |
166 | (set-process-sentinel (get-buffer-process outbuf) | |
167 | 'compilation-sentinel) | |
168 | (save-excursion | |
169 | (set-buffer outbuf) | |
170 | (if (or (eq compilation-error-buffer outbuf) | |
171 | (eq compilation-error-list t) | |
172 | (and (null compilation-error-list) | |
173 | (not (and (get-buffer-process compilation-error-buffer) | |
174 | (eq (process-status compilation-error-buffer) | |
175 | 'run))))) | |
176 | (setq compilation-error-list t | |
177 | compilation-error-buffer outbuf)) | |
178 | (setq default-directory thisdir) | |
179 | (compilation-mode) | |
180 | (set-window-start outwin (point-min)) | |
181 | (setq mode-name (or name-of-mode "Compilation")) | |
182 | (setq buffer-read-only t) | |
183 | (or (eq outwin (selected-window)) | |
184 | (set-window-point outwin (point-min)))))) | |
185 | ||
186 | (defvar compilation-mode-map | |
187 | (let ((map (make-sparse-keymap))) | |
188 | (define-key map "\C-c\C-c" 'compile-goto-error) | |
189 | map) | |
190 | "Keymap for compilation log buffers.") | |
191 | ||
192 | (defun compilation-mode () | |
193 | "Major mode for compilation log buffers. | |
194 | \\<compilation-mode-map>To visit the source for a line-numbered error, | |
195 | move point to the error message line and type \\[compile-goto-error]." | |
196 | (interactive) | |
197 | (fundamental-mode) | |
198 | (use-local-map compilation-mode-map) | |
199 | (make-local-variable 'compilation-parse-errors-hook) | |
200 | (setq compilation-parse-errors-hook parser) | |
201 | (make-local-variable 'compilation-error-message) | |
202 | (setq compilation-error-message error-message) | |
203 | (make-local-variable 'compilation-error-regexp) | |
204 | (setq compilation-error-regexp regexp) | |
205 | (buffer-disable-undo (current-buffer)) | |
206 | (setq major-mode 'compilation-mode) | |
207 | (setq mode-name "Compilation") | |
208 | ;; Make log buffer's mode line show process state | |
209 | (setq mode-line-process '(": %s"))) | |
210 | ||
211 | ;; Called when compilation process changes state. | |
212 | ||
213 | (defun compilation-sentinel (proc msg) | |
214 | (cond ((null (buffer-name (process-buffer proc))) | |
215 | ;; buffer killed | |
216 | (set-process-buffer proc nil)) | |
217 | ((memq (process-status proc) '(signal exit)) | |
218 | (let* ((obuf (current-buffer)) | |
219 | omax opoint) | |
220 | ;; save-excursion isn't the right thing if | |
221 | ;; process-buffer is current-buffer | |
222 | (unwind-protect | |
223 | (progn | |
224 | ;; Write something in *compilation* and hack its mode line, | |
225 | (set-buffer (process-buffer proc)) | |
226 | (setq omax (point-max) opoint (point)) | |
227 | (goto-char (point-max)) | |
228 | (insert ?\n mode-name " " msg) | |
229 | (forward-char -1) | |
230 | (insert " at " (substring (current-time-string) 0 19)) | |
231 | (forward-char 1) | |
232 | (setq mode-line-process | |
233 | (concat ": " | |
234 | (symbol-name (process-status proc)))) | |
235 | ;; If buffer and mode line will show that the process | |
236 | ;; is dead, we can delete it now. Otherwise it | |
237 | ;; will stay around until M-x list-processes. | |
238 | (delete-process proc)) | |
239 | ;; Force mode line redisplay soon | |
240 | (set-buffer-modified-p (buffer-modified-p))) | |
241 | (if (and opoint (< opoint omax)) | |
242 | (goto-char opoint)) | |
243 | (set-buffer obuf))))) | |
244 | ||
245 | (defun kill-compilation () | |
246 | "Kill the process made by the \\[compile] command." | |
247 | (interactive) | |
248 | (let ((buffer | |
249 | (if (assq 'compilation-parse-errors-hook (buffer-local-variables)) | |
250 | (current-buffer) | |
251 | (get-buffer "*compilation*")))) | |
252 | (if (get-buffer-process buffer) | |
253 | (interrupt-process (get-buffer-process buffer))))) | |
254 | ||
255 | ;; Reparse errors or parse more/new errors, if appropriate. | |
256 | (defun compile-reinitialize-errors (argp) | |
257 | ;; If we are out of errors, or if user says "reparse", | |
258 | ;; or if we are in a different buffer from the known errors, | |
259 | ;; discard the info we have, to force reparsing. | |
260 | (if (or (eq compilation-error-list t) | |
261 | (consp argp) | |
262 | (if (assq 'compilation-parse-errors-hook (buffer-local-variables)) | |
263 | (not (eq compilation-error-buffer | |
264 | (setq compilation-error-buffer (current-buffer)))))) | |
265 | (progn (compilation-forget-errors) | |
266 | (setq compilation-parsing-end 1))) | |
267 | (if compilation-error-list | |
268 | nil | |
269 | (save-excursion | |
270 | (switch-to-buffer compilation-error-buffer) | |
271 | (set-buffer-modified-p nil) | |
272 | (let ((at-start (= compilation-parsing-end 1))) | |
273 | (run-hooks 'compilation-parse-errors-hook) | |
274 | ;; Remember the entire list for compilation-forget-errors. | |
275 | ;; If this is an incremental parse, append to previous list. | |
276 | (if at-start | |
277 | (setq compilation-old-error-list compilation-error-list) | |
278 | (setq compilation-old-error-list | |
279 | (nconc compilation-old-error-list compilation-error-list))))))) | |
280 | ||
281 | (defun compile-goto-error (&optional argp) | |
282 | "Visit the source for the error message point is on. | |
283 | Use this command in a compilation log buffer. | |
284 | C-u as a prefix arg means to reparse the buffer's error messages first; | |
285 | other kinds of prefix arguments are ignored." | |
286 | (interactive "P") | |
287 | (compile-reinitialize-errors argp) | |
288 | (save-excursion | |
289 | (beginning-of-line) | |
290 | (setq compilation-error-list | |
291 | (memq (assoc (point-marker) compilation-old-error-list) | |
292 | compilation-old-error-list))) | |
293 | ;; Move to another window, so that next-error's window changes | |
294 | ;; result in the desired setup. | |
295 | (or (one-window-p) | |
296 | (other-window -1)) | |
297 | (next-error 1)) | |
298 | ||
299 | (defun next-error (&optional argp) | |
300 | "Visit next compilation error message and corresponding source code. | |
301 | This operates on the output from the \\[compile] command. | |
302 | If all preparsed error messages have been processed, | |
303 | the error message buffer is checked for new ones. | |
304 | ||
305 | A prefix arg specifies how many error messages to move; | |
306 | negative means move back to previous error messages. | |
307 | Just C-u as a prefix means reparse the error message buffer | |
308 | and start at the first error. | |
309 | ||
310 | \\[next-error] normally applies to the most recent compilation started, | |
311 | but as long as you are in the middle of parsing errors from one compilation | |
312 | output buffer, you stay with that compilation output buffer. | |
313 | ||
314 | Use \\[next-error] in a compilation output buffer to switch to | |
315 | processing errors from that compilation. | |
316 | ||
317 | See variables `compilation-parse-errors-hook' and `compilation-error-regexp' | |
318 | for customization ideas. When we return, `compilation-last-error' | |
319 | points to the error message and the erroneous code." | |
320 | (interactive "P") | |
321 | (compile-reinitialize-errors argp) | |
322 | (if (consp argp) | |
323 | (setq argp nil)) | |
324 | (let* ((next-errors (nthcdr (+ (- (length compilation-old-error-list) | |
325 | (length compilation-error-list) | |
326 | 1) | |
327 | (prefix-numeric-value argp)) | |
328 | compilation-old-error-list)) | |
329 | (next-error (car next-errors))) | |
330 | (if (null next-error) | |
331 | (save-excursion | |
332 | (if argp (if (> (prefix-numeric-value argp) 0) | |
333 | (error "Moved past last error") | |
334 | (error "Moved back past first error"))) | |
335 | (set-buffer compilation-error-buffer) | |
336 | (compilation-forget-errors) | |
337 | (error (concat compilation-error-message | |
338 | (if (and (get-buffer-process (current-buffer)) | |
339 | (eq (process-status (current-buffer)) | |
340 | 'run)) | |
341 | " yet" ""))))) | |
342 | (setq compilation-error-list (cdr next-errors)) | |
343 | ;; If we have an error to go to, go there. | |
344 | (if (null (car (cdr next-error))) | |
345 | nil | |
346 | (switch-to-buffer (marker-buffer (car (cdr next-error)))) | |
347 | (goto-char (car (cdr next-error))) | |
348 | ;; If narrowing got in the way of going to the right place, widen. | |
349 | (or (= (point) (car (cdr next-error))) | |
350 | (progn | |
351 | (widen) | |
352 | (goto-char (car (cdr next-error)))))) | |
353 | ;; Show compilation buffer in other window, scrolled to this error. | |
354 | (let* ((pop-up-windows t) | |
355 | (w (display-buffer (marker-buffer (car next-error))))) | |
356 | (set-window-point w (car next-error)) | |
357 | (set-window-start w (car next-error))) | |
358 | (setq compilation-last-error next-error))) | |
359 | ||
360 | ;; Set compilation-error-list to nil, and | |
361 | ;; unchain the markers that point to the error messages and their text, | |
362 | ;; so that they no longer slow down gap motion. | |
363 | ;; This would happen anyway at the next garbage collection, | |
364 | ;; but it is better to do it right away. | |
365 | (defun compilation-forget-errors () | |
366 | (while compilation-old-error-list | |
367 | (let ((next-error (car compilation-old-error-list))) | |
368 | (set-marker (car next-error) nil) | |
369 | (if (car (cdr next-error)) | |
370 | (set-marker (car (cdr next-error)) nil))) | |
371 | (setq compilation-old-error-list (cdr compilation-old-error-list))) | |
372 | (setq compilation-error-list nil)) | |
373 | ||
374 | (defun compilation-parse-errors () | |
375 | "Parse the current buffer as grep, cc or lint error messages. | |
376 | See variable `compilation-parse-errors-hook' for the interface it uses." | |
377 | (setq compilation-error-list nil) | |
378 | (message "Parsing error messages...") | |
379 | (let (text-buffer | |
380 | last-filename last-linenum) | |
381 | ;; Don't reparse messages already seen at last parse. | |
382 | (goto-char compilation-parsing-end) | |
383 | ;; Don't parse the first two lines as error messages. | |
384 | ;; This matters for grep. | |
385 | (if (bobp) | |
386 | (forward-line 2)) | |
387 | (while (re-search-forward compilation-error-regexp nil t) | |
388 | (let (linenum filename | |
389 | error-marker text-marker) | |
390 | ;; Extract file name and line number from error message. | |
391 | (save-restriction | |
392 | (narrow-to-region (match-beginning 0) (match-end 0)) | |
393 | (goto-char (point-max)) | |
394 | (skip-chars-backward "[0-9]") | |
395 | ;; If it's a lint message, use the last file(linenum) on the line. | |
396 | ;; Normally we use the first on the line. | |
397 | (if (= (preceding-char) ?\() | |
398 | (progn | |
399 | (narrow-to-region (point-min) (1+ (buffer-size))) | |
400 | (end-of-line) | |
401 | (re-search-backward compilation-error-regexp) | |
402 | (skip-chars-backward "^ \t\n") | |
403 | (narrow-to-region (point) (match-end 0)) | |
404 | (goto-char (point-max)) | |
405 | (skip-chars-backward "[0-9]"))) | |
406 | ;; Are we looking at a "filename-first" or "line-number-first" form? | |
407 | (if (looking-at "[0-9]") | |
408 | (progn | |
409 | (setq linenum (read (current-buffer))) | |
410 | (goto-char (point-min))) | |
411 | ;; Line number at start, file name at end. | |
412 | (progn | |
413 | (goto-char (point-min)) | |
414 | (setq linenum (read (current-buffer))) | |
415 | (goto-char (point-max)) | |
416 | (skip-chars-backward "^ \t\n"))) | |
417 | (setq filename (compilation-grab-filename))) | |
418 | ;; Locate the erring file and line. | |
419 | (if (and (equal filename last-filename) | |
420 | (= linenum last-linenum)) | |
421 | nil | |
422 | (beginning-of-line 1) | |
423 | (setq error-marker (point-marker)) | |
424 | ;; text-buffer gets the buffer containing this error's file. | |
425 | (if (not (equal filename last-filename)) | |
426 | (setq last-filename filename | |
427 | text-buffer (compilation-find-file filename) | |
428 | last-linenum 0)) | |
429 | (if text-buffer | |
430 | ;; Go to that buffer and find the erring line. | |
431 | (save-excursion | |
432 | (set-buffer text-buffer) | |
433 | (if (zerop last-linenum) | |
434 | (progn | |
435 | (goto-char 1) | |
436 | (setq last-linenum 1))) | |
437 | (forward-line (- linenum last-linenum)) | |
438 | (setq last-linenum linenum) | |
439 | (setq text-marker (point-marker)) | |
440 | (setq compilation-error-list | |
441 | (cons (list error-marker text-marker) | |
442 | compilation-error-list))))) | |
443 | (forward-line 1))) | |
444 | (setq compilation-parsing-end (point-max))) | |
445 | (message "Parsing error messages...done") | |
446 | (setq compilation-error-list (nreverse compilation-error-list))) | |
447 | ||
448 | ;; Find or create a buffer for file FILENAME. | |
449 | ;; Search the directories in compilation-search-path | |
450 | ;; after trying the current directory. | |
451 | (defun compilation-find-file (filename) | |
452 | (let ((dirs compilation-search-path) | |
453 | result) | |
454 | (while (and dirs (null result)) | |
455 | (let ((name (if (car dirs) | |
456 | (concat (car dirs) filename) | |
457 | filename))) | |
458 | (setq result | |
459 | (and (file-exists-p name) | |
460 | (find-file-noselect name)))) | |
461 | (setq dirs (cdr dirs))) | |
462 | result)) | |
463 | ||
464 | (defun compilation-grab-filename () | |
465 | "Return a string which is a filename, starting at point. | |
466 | Ignore quotes and parentheses around it, as well as trailing colons." | |
467 | (if (eq (following-char) ?\") | |
468 | (save-restriction | |
469 | (narrow-to-region (point) | |
470 | (progn (forward-sexp 1) (point))) | |
471 | (goto-char (point-min)) | |
472 | (read (current-buffer))) | |
473 | (buffer-substring (point) | |
474 | (progn | |
475 | (skip-chars-forward "^ :,\n\t(") | |
476 | (point))))) | |
477 | ||
478 | (define-key ctl-x-map "`" 'next-error) |