Mercurial > emacs
comparison lisp/progmodes/compile.el @ 71:a35b34e246fe
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 13 Jul 1990 03:12:54 +0000 |
parents | |
children | 21a228b6a238 |
comparison
equal
deleted
inserted
replaced
70:28fb18d48c35 | 71:a35b34e246fe |
---|---|
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) |