Mercurial > emacs
comparison lisp/progmodes/compile.el @ 418:21a228b6a238
*** empty log message ***
author | Roland McGrath <roland@gnu.org> |
---|---|
date | Mon, 07 Oct 1991 22:49:33 +0000 |
parents | a35b34e246fe |
children | c3bbd755b7da |
comparison
equal
deleted
inserted
replaced
417:51793184f9a9 | 418:21a228b6a238 |
---|---|
1 ;;;!!! dup removal is broken. | |
1 ;; Run compiler as inferior of Emacs, and parse its error messages. | 2 ;; Run compiler as inferior of Emacs, and parse its error messages. |
2 ;; Copyright (C) 1985, 1986, 1988, 1989 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1985-1991 Free Software Foundation, Inc. |
3 | 4 |
4 ;; This file is part of GNU Emacs. | 5 ;; This file is part of GNU Emacs. |
5 | 6 |
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, | 7 ;; GNU Emacs is distributed in the hope that it will be useful, |
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 8 ;; but WITHOUT ANY WARRANTY. No author or distributor |
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 9 ;; accepts responsibility to anyone for the consequences of using it |
14 ;; GNU General Public License for more details. | 10 ;; or for whether it serves any particular purpose or works at all, |
15 | 11 ;; unless he says so in writing. Refer to the GNU Emacs General Public |
16 ;; You should have received a copy of the GNU General Public License | 12 ;; License for full details. |
17 ;; along with GNU Emacs; see the file COPYING. If not, write to | 13 |
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | 14 ;; Everyone is granted permission to copy, modify and redistribute |
15 ;; GNU Emacs, but only under the conditions described in the | |
16 ;; GNU Emacs General Public License. A copy of this license is | |
17 ;; supposed to have been given to you along with GNU Emacs so you | |
18 ;; can know your rights and responsibilities. It should be in a | |
19 ;; file named COPYING. Among other things, the copyright notice | |
20 ;; and this notice must be preserved on all copies. | |
19 | 21 |
20 (provide 'compile) | 22 (provide 'compile) |
23 | |
24 (defconst compilation-window-height nil | |
25 "*Number of lines in a compilation window. If nil, use Emacs default.") | |
21 | 26 |
22 (defvar compilation-error-list nil | 27 (defvar compilation-error-list nil |
23 "List of error message descriptors for visiting erring functions. | 28 "List of error message descriptors for visiting erring functions. |
24 Each error descriptor is a list of length two. | 29 Each error descriptor is a cons (or nil). |
25 Its car is a marker pointing to an error message. | 30 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, | 31 If its cdr is a marker, it points to the text of the line the message is about. |
27 or nil if that is not interesting. | 32 If its cdr is a cons, that cons's car is a cons (DIRECTORY . FILE), specifying |
28 The value may be t instead of a list; | 33 file the message is about, and its cdr is the number of the line the message |
29 this means that the buffer of error messages should be reparsed | 34 is about. Or its cdr may be nil if that error is not interesting. |
30 the next time the list of errors is wanted.") | 35 |
36 The value may be t instead of a list; this means that the buffer of | |
37 error messages should be reparsed the next time the list of errors is wanted.") | |
31 | 38 |
32 (defvar compilation-old-error-list nil | 39 (defvar compilation-old-error-list nil |
33 "Value of `compilation-error-list' after errors were parsed.") | 40 "Value of `compilation-error-list' after errors were parsed.") |
34 | 41 |
35 (defvar compilation-last-error nil | 42 (defvar compilation-parse-errors-function 'compilation-parse-errors |
36 "List describing the error found by last call to \\[next-error]. | 43 "Function to call (with no args) to parse error messages from a compilation. |
37 A list of two markers (ERROR-POS CODE-POS), | 44 It should read in the source files which have errors and set |
38 pointing to the error message and the erroneous code, respectively. | 45 `compilation-error-list' to a list with an element for each error message |
39 CODE-POS can be nil, if the error message has no specific source location.") | 46 found. See that variable for more info.") |
40 | 47 |
41 (defvar compilation-parse-errors-hook 'compilation-parse-errors | 48 (defvar compilation-buffer-name-function nil |
42 "Function to call (no args) to parse error messages from a compilation. | 49 "Function to call with one argument, the name of the major mode of the |
43 It should read in the source files which have errors | 50 compilation buffer, to give the buffer a name. It should return a string. |
44 and set `compilation-error-list' to a list with an element | 51 If nil, the name \"*compilation*\" is used for compilation buffers, |
45 for each error message found. See that variable for more info.") | 52 and the name \"*grep*\" is used for grep buffers. |
46 | 53 \(Actually, the name (concat "*" (downcase major-mode) "*") is used.)") |
47 (defvar compilation-error-buffer nil | 54 |
48 "Current compilation buffer for compilation error processing.") | 55 (defvar compilation-finish-function nil |
56 "Function to call when a compilation process finishes. | |
57 It is called with two arguments: the compilation buffer, and a string | |
58 describing how the process finished.") | |
59 | |
60 (defvar compilation-last-buffer nil | |
61 "The buffer in which the last compilation was started, | |
62 or which was used by the last \\[next-error] or \\[compile-goto-error].") | |
49 | 63 |
50 (defvar compilation-parsing-end nil | 64 (defvar compilation-parsing-end nil |
51 "Position of end of buffer when last error messages parsed.") | 65 "Position of end of buffer when last error messages were parsed.") |
52 | 66 |
53 (defvar compilation-error-message nil | 67 (defvar compilation-error-message "No more errors" |
54 "Message to print when no more matches for compilation-error-regexp are found") | 68 "Message to print when no more matches for `compilation-error-regexp-alist' |
55 | 69 are found.") |
56 ;; The filename excludes colons to avoid confusion when error message | 70 |
57 ;; starts with digits. | 71 (defvar compilation-error-regexp-alist |
58 (defvar compilation-error-regexp | 72 '( |
59 "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)\\|\\(\"[^ \n]+\",L[0-9]+\\)" | 73 ;; 4.3BSD grep, cc, lint pass 1: |
60 "Regular expression for filename/linenumber in error in compilation log.") | 74 ;; /usr/src/foo/foo.c(8): warning: w may be used before set |
61 | 75 ;; or GNU utilities |
62 (defvar compile-window-height nil | 76 ;; foo.c:8: error message |
63 "*Desired height of compilation window. nil means use Emacs default.") | 77 ("^\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2) |
78 ;; 4.3BSD lint pass 2 | |
79 ;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8) | |
80 ("[ \t:]+\\([^:( \t\n]+\\)[ \t]*[:(]+[ \t]*\\([0-9]+\\)[:) \t]*$" 1 2) | |
81 ;; 4.3BSD lint pass 3 | |
82 ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used | |
83 ("[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2) | |
84 ;; Line 45 of "foo.c": bloofel undefined (who does this?) | |
85 ("^[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+of[ \t]+\"\\([^\"]+\\)\":" 2 1) | |
86 ;; Apollo cc, 4.3BSD fc | |
87 ;; "foo.f", line 3: Error: syntax error near end of statement | |
88 ("^\"\\([^\"]+\\)\", line \\([0-9]+\\):" 1 2) | |
89 ;; HP-UX 7.0 fc | |
90 ;; foo.f :16 some horrible error message | |
91 ("\\([^ \t:]+\\)[ \t]*:\\([0-9]+\\)" 1 2) | |
92 ;; IBM AIX PS/2 C version 1.1 | |
93 ;; ****** Error number 140 in line 8 of file errors.c ****** | |
94 ("in line \\([0-9]+\\) of file \\([^ ]+[^. ]\\)\\.? " 2 1) | |
95 ;; IBM AIX lint is too painful to do right this way. File name | |
96 ;; prefixes entire sections rather than being on each line. | |
97 ) | |
98 "Alist (REGEXP FILE-IDX LINE-IDX) of regular expressions to match errors in | |
99 compilation. If REGEXP matches, the FILE-IDX'th subexpression gives the file | |
100 name, and the LINE-IDX'th subexpression gives the line number.") | |
101 | |
102 (defvar compilation-search-path '(nil) | |
103 "List of directories to search for source files named in error messages. | |
104 Elements should be directory names, not file names of directories. | |
105 nil as an element means to try the default directory.") | |
64 | 106 |
65 (defvar compile-command "make -k " | 107 (defvar compile-command "make -k " |
66 "Last shell command used to do a compilation; default for next compilation. | 108 "Last shell command used to do a compilation; default for next compilation. |
67 | 109 |
68 Sometimes it is useful for files to supply local values for this variable. | 110 Sometimes it is useful for files to supply local values for this variable. |
73 (progn (make-local-variable 'compile-command) | 115 (progn (make-local-variable 'compile-command) |
74 (setq compile-command | 116 (setq compile-command |
75 (concat \"make -k \" | 117 (concat \"make -k \" |
76 buffer-file-name))))))") | 118 buffer-file-name))))))") |
77 | 119 |
78 (defvar compilation-search-path '(nil) | 120 ;;;###autoload |
79 "List of directories to search for source files named in error messages. | 121 (defvar grep-command "grep -n " |
80 Elements should be directory names, not file names of directories. | 122 "Last shell command used to do a grep search; default for next search. |
81 nil as an element means to try the default directory.") | 123 Typically \"grep -n\" or \"egrep -n\". |
82 | 124 \(The \"-n\" option tells grep to output line numbers.)") |
125 | |
126 (defconst compilation-enter-directory-regexp | |
127 ": Entering directory `\\\(.*\\\)'$" | |
128 "Regular expression for a line in the compilation log that | |
129 changes the current directory. This must contain one \\\(, \\\) pair | |
130 around the directory name. | |
131 | |
132 The default value matches lines printed by the `-w' option of GNU Make.") | |
133 | |
134 (defconst compilation-leave-directory-regexp | |
135 ": Leaving directory `\\\(.*\\\)'$" | |
136 "Regular expression for a line in the compilation log that | |
137 changes the current directory to a previous value. This may | |
138 contain one \\\(, \\\) pair around the name of the directory | |
139 being moved from. If it does not, the last directory entered | |
140 \(by a line matching `compilation-enter-directory-regexp'\) is assumed. | |
141 | |
142 The default value matches lines printed by the `-w' option of GNU Make.") | |
143 | |
144 (defvar compilation-directory-stack nil | |
145 "Stack of directories entered by lines matching | |
146 \`compilation-enter-directory-regexp' and not yet left by lines matching | |
147 \`compilation-leave-directory-regexp'. The head element is the directory | |
148 the compilation was started in.") | |
149 | |
150 ;;;###autoload | |
83 (defun compile (command) | 151 (defun compile (command) |
84 "Compile the program including the current buffer. Default: run `make'. | 152 "Compile the program including the current buffer. Default: run `make'. |
85 Runs COMMAND, a shell command, in a separate process asynchronously | 153 Runs COMMAND, a shell command, in a separate process asynchronously |
86 with output going to the buffer `*compilation*'. | 154 with output going to the buffer `*compilation*'. |
155 | |
87 You can then use the command \\[next-error] to find the next error message | 156 You can then use the command \\[next-error] to find the next error message |
88 and move to the source code that caused it. | 157 and move to the source code that caused it. |
89 | 158 |
90 To run more than one compilation at once, start one and rename the | 159 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." | 160 \`*compilation*' buffer to some other name with \\[rename-buffer]. |
161 Then start the next one. | |
162 | |
163 The name used for the buffer is actually whatever is returned by | |
164 the function in `compilation-buffer-name-function', so you can set that | |
165 to a function that generates a unique name." | |
92 (interactive (list (read-string "Compile command: " compile-command))) | 166 (interactive (list (read-string "Compile command: " compile-command))) |
93 (setq compile-command command) | 167 (setq compile-command command) |
94 (save-some-buffers nil nil) | 168 (save-some-buffers nil nil) |
95 (compile-internal compile-command "No more errors") | 169 (compile-internal compile-command "No more errors")) |
96 (and compile-window-height | 170 |
97 (= (window-width) (screen-width)) | 171 ;;;###autoload |
98 (enlarge-window (- (- (screen-height) (window-height)) | |
99 compile-window-height) nil))) | |
100 | |
101 (defun grep (command-args) | 172 (defun grep (command-args) |
102 "Run grep, with user-specified args, and collect output in a buffer. | 173 "Run grep, with user-specified args, and collect output in a buffer. |
103 While grep runs asynchronously, you can use the \\[next-error] command | 174 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' | 175 to find the text that grep hits refer to. |
105 has a `-n' flag, so that line numbers are displayed for each match." | 176 |
177 The variable `grep-command' holds the last grep command run, | |
178 and is the default for future runs. The command should use the `-n' | |
179 flag, so that line numbers are displayed for each match. | |
180 What the user enters in response to the prompt for grep args is | |
181 appended to everything up to and including the `-n' in `grep-command'." | |
106 (interactive | 182 (interactive |
107 (list (read-string (concat "Run " | 183 (list (read-string (concat "Run " |
108 (substring grep-command 0 | 184 (substring grep-command 0 |
109 (string-match "[\t ]+" grep-command)) | 185 (string-match "[\t ]+" grep-command)) |
110 " (with args): ") | 186 " (with args): ") |
119 " " command-args)) | 195 " " command-args)) |
120 (compile-internal (concat grep-command " /dev/null") | 196 (compile-internal (concat grep-command " /dev/null") |
121 "No more grep hits" "grep")) | 197 "No more grep hits" "grep")) |
122 | 198 |
123 (defun compile-internal (command error-message | 199 (defun compile-internal (command error-message |
124 &optional name-of-mode parser regexp) | 200 &optional name-of-mode parser regexp-alist |
201 name-function) | |
125 "Run compilation command COMMAND (low level interface). | 202 "Run compilation command COMMAND (low level interface). |
126 ERROR-MESSAGE is a string to print if the user asks to see another error | 203 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 | 204 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. | 205 to display as the major mode in the compilation buffer. |
129 | 206 |
130 Fourth arg PARSER is the error parser function (nil means the default). | 207 Fourth arg PARSER is the error parser function (nil means the default). Fifth |
131 Fifth arg REGEXP is the error message regexp to use (nil means the default). | 208 arg REGEXP-ALIST is the error message regexp alist to use (nil means the |
132 The defaults for these variables are the global values of | 209 default). Sixth arg NAME-FUNCTION is a function called to name the buffer (nil |
133 `compilation-parse-errors-hook' and `compilation-error-regexp'." | 210 means the default). The defaults for these variables are the global values of |
134 (save-excursion | 211 \`compilation-parse-errors-function', `compilation-error-regexp-alist', and |
135 (set-buffer (get-buffer-create "*compilation*")) | 212 \`compilation-buffer-name-function', respectively." |
136 (setq buffer-read-only nil) | 213 (let (outbuf) |
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 | 214 (save-excursion |
215 (or name-of-mode | |
216 (setq name-of-mode "Compilation")) | |
217 (setq outbuf | |
218 (get-buffer-create | |
219 (funcall (or name-function compilation-buffer-name-function | |
220 (function (lambda (mode) | |
221 (concat "*" (downcase mode) "*")))) | |
222 name-of-mode))) | |
169 (set-buffer outbuf) | 223 (set-buffer outbuf) |
170 (if (or (eq compilation-error-buffer outbuf) | 224 (let ((comp-proc (get-buffer-process (current-buffer)))) |
171 (eq compilation-error-list t) | 225 (if comp-proc |
172 (and (null compilation-error-list) | 226 (if (or (not (eq (process-status comp-proc) 'run)) |
173 (not (and (get-buffer-process compilation-error-buffer) | 227 (yes-or-no-p |
174 (eq (process-status compilation-error-buffer) | 228 "A compilation process is running; kill it? ")) |
175 'run))))) | 229 (condition-case () |
176 (setq compilation-error-list t | 230 (progn |
177 compilation-error-buffer outbuf)) | 231 (interrupt-process comp-proc) |
178 (setq default-directory thisdir) | 232 (sit-for 1) |
233 (delete-process comp-proc)) | |
234 (error nil)) | |
235 (error "Cannot have two processes in `%s' at once" | |
236 (buffer-name)) | |
237 ))) | |
238 ;; In case the compilation buffer is current, make sure we get the global | |
239 ;; values of compilation-error-regexp-alist, etc. | |
240 (kill-all-local-variables)) | |
241 (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist)) | |
242 (parser (or parser compilation-parse-errors-function)) | |
243 (thisdir default-directory) | |
244 outwin) | |
245 (save-excursion | |
246 ;; Clear out the compilation buffer and make it writable. | |
247 ;; Change its default-directory to the directory where the compilation | |
248 ;; will happen, and insert a `cd' command to indicate this. | |
249 (set-buffer outbuf) | |
250 (setq buffer-read-only nil) | |
251 (erase-buffer) | |
252 (setq default-directory thisdir) | |
253 (insert "cd " thisdir "\n" command "\n") | |
254 (set-buffer-modified-p nil)) | |
255 ;; If we're already in the compilation buffer, go to the end | |
256 ;; of the buffer, so point will track the compilation output. | |
257 (if (eq outbuf (current-buffer)) | |
258 (goto-char (point-max))) | |
259 ;; Pop up the compilation buffer. | |
260 (setq outwin (display-buffer outbuf)) | |
261 (set-buffer outbuf) | |
179 (compilation-mode) | 262 (compilation-mode) |
263 (set (make-local-variable 'compilation-parse-errors-function) parser) | |
264 (set (make-local-variable 'compilation-error-message) error-message) | |
265 (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist) | |
266 (setq default-directory thisdir | |
267 compilation-directory-stack (list default-directory)) | |
180 (set-window-start outwin (point-min)) | 268 (set-window-start outwin (point-min)) |
181 (setq mode-name (or name-of-mode "Compilation")) | 269 (setq mode-name name-of-mode) |
182 (setq buffer-read-only t) | |
183 (or (eq outwin (selected-window)) | 270 (or (eq outwin (selected-window)) |
184 (set-window-point outwin (point-min)))))) | 271 (set-window-point outwin (point-min))) |
272 (and compilation-window-height | |
273 (= (window-width outwin) (screen-width)) | |
274 (let ((w (selected-window))) | |
275 (unwind-protect | |
276 (progn | |
277 (select-window outwin) | |
278 (enlarge-window (- compilation-window-height | |
279 (window-height)))) | |
280 (select-window w)))) | |
281 ;; Start the compilation. | |
282 (start-process-shell-command (downcase mode-name) outbuf command) | |
283 (set-process-sentinel (get-buffer-process outbuf) | |
284 'compilation-sentinel)) | |
285 ;; Make it so the next C-x ` will use this buffer. | |
286 (setq compilation-last-buffer outbuf))) | |
185 | 287 |
186 (defvar compilation-mode-map | 288 (defvar compilation-mode-map |
187 (let ((map (make-sparse-keymap))) | 289 (let ((map (make-sparse-keymap))) |
188 (define-key map "\C-c\C-c" 'compile-goto-error) | 290 (define-key map "\C-c\C-c" 'compile-goto-error) |
291 (define-key map "\C-c\C-k" 'kill-compilation) | |
189 map) | 292 map) |
190 "Keymap for compilation log buffers.") | 293 "Keymap for compilation log buffers.") |
191 | 294 |
192 (defun compilation-mode () | 295 (defun compilation-mode () |
193 "Major mode for compilation log buffers. | 296 "Major mode for compilation log buffers. |
194 \\<compilation-mode-map>To visit the source for a line-numbered error, | 297 \\<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]." | 298 move point to the error message line and type \\[compile-goto-error]. |
299 To kill the compilation, type \\[kill-compilation]." | |
196 (interactive) | 300 (interactive) |
197 (fundamental-mode) | 301 (fundamental-mode) |
198 (use-local-map compilation-mode-map) | 302 (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)) | 303 (buffer-disable-undo (current-buffer)) |
206 (setq major-mode 'compilation-mode) | 304 (setq major-mode 'compilation-mode) |
207 (setq mode-name "Compilation") | 305 (setq mode-name "Compilation") |
208 ;; Make log buffer's mode line show process state | 306 ;; Make buffer's mode line show process state |
209 (setq mode-line-process '(": %s"))) | 307 (setq mode-line-process '(": %s")) |
308 (set (make-local-variable 'compilation-error-list) nil) | |
309 (set (make-local-variable 'compilation-old-error-list) nil) | |
310 (set (make-local-variable 'compilation-parsing-end) 1) | |
311 (set (make-local-variable 'compilation-directory-stack) nil) | |
312 (setq compilation-last-buffer (current-buffer))) | |
210 | 313 |
211 ;; Called when compilation process changes state. | 314 ;; Called when compilation process changes state. |
212 | |
213 (defun compilation-sentinel (proc msg) | 315 (defun compilation-sentinel (proc msg) |
214 (cond ((null (buffer-name (process-buffer proc))) | 316 "Sentinel for compilation buffers." |
215 ;; buffer killed | 317 (let ((buffer (process-buffer proc))) |
216 (set-process-buffer proc nil)) | 318 (cond ((null (buffer-name buffer)) |
217 ((memq (process-status proc) '(signal exit)) | 319 ;; buffer killed |
218 (let* ((obuf (current-buffer)) | 320 (set-process-buffer proc nil)) |
219 omax opoint) | 321 ((memq (process-status proc) '(signal exit)) |
220 ;; save-excursion isn't the right thing if | 322 (let ((obuf (current-buffer)) |
221 ;; process-buffer is current-buffer | 323 omax opoint) |
222 (unwind-protect | 324 ;; save-excursion isn't the right thing if |
223 (progn | 325 ;; process-buffer is current-buffer |
224 ;; Write something in *compilation* and hack its mode line, | 326 (unwind-protect |
225 (set-buffer (process-buffer proc)) | 327 (progn |
226 (setq omax (point-max) opoint (point)) | 328 ;; Write something in the compilation buffer |
227 (goto-char (point-max)) | 329 ;; and hack its mode line. |
228 (insert ?\n mode-name " " msg) | 330 (set-buffer buffer) |
229 (forward-char -1) | 331 (setq omax (point-max) |
230 (insert " at " (substring (current-time-string) 0 19)) | 332 opoint (point)) |
231 (forward-char 1) | 333 (goto-char omax) |
232 (setq mode-line-process | 334 (insert ?\n mode-name " " msg) |
233 (concat ": " | 335 (forward-char -1) |
234 (symbol-name (process-status proc)))) | 336 (insert " at " (substring (current-time-string) 0 19)) |
235 ;; If buffer and mode line will show that the process | 337 (forward-char 1) |
236 ;; is dead, we can delete it now. Otherwise it | 338 (setq mode-line-process |
237 ;; will stay around until M-x list-processes. | 339 (concat ": " |
238 (delete-process proc)) | 340 (symbol-name (process-status proc)))) |
239 ;; Force mode line redisplay soon | 341 ;; Since the buffer and mode line will show that the |
240 (set-buffer-modified-p (buffer-modified-p))) | 342 ;; process is dead, we can delete it now. Otherwise it |
241 (if (and opoint (< opoint omax)) | 343 ;; will stay around until M-x list-processes. |
242 (goto-char opoint)) | 344 (delete-process proc)) |
243 (set-buffer obuf))))) | 345 ;; Force mode line redisplay soon. |
346 (set-buffer-modified-p (buffer-modified-p))) | |
347 (if (and opoint (< opoint omax)) | |
348 (goto-char opoint)) | |
349 (set-buffer obuf) | |
350 (if compilation-finish-function | |
351 (funcall compilation-finish-function buffer msg)) | |
352 )) | |
353 ))) | |
244 | 354 |
245 (defun kill-compilation () | 355 (defun kill-compilation () |
246 "Kill the process made by the \\[compile] command." | 356 "Kill the process made by the \\[compile] command." |
247 (interactive) | 357 (interactive) |
248 (let ((buffer | 358 (let ((buffer (compilation-find-buffer))) |
249 (if (assq 'compilation-parse-errors-hook (buffer-local-variables)) | |
250 (current-buffer) | |
251 (get-buffer "*compilation*")))) | |
252 (if (get-buffer-process buffer) | 359 (if (get-buffer-process buffer) |
253 (interrupt-process (get-buffer-process buffer))))) | 360 (interrupt-process (get-buffer-process buffer)) |
254 | 361 (error "The compilation process is not running.")))) |
255 ;; Reparse errors or parse more/new errors, if appropriate. | 362 |
363 | |
364 ;; Parse any new errors in the compilation buffer, | |
365 ;; or reparse from the beginning if the user has asked for that. | |
256 (defun compile-reinitialize-errors (argp) | 366 (defun compile-reinitialize-errors (argp) |
257 ;; If we are out of errors, or if user says "reparse", | 367 (save-excursion |
258 ;; or if we are in a different buffer from the known errors, | 368 (set-buffer compilation-last-buffer) |
259 ;; discard the info we have, to force reparsing. | 369 ;; If we are out of errors, or if user says "reparse", |
260 (if (or (eq compilation-error-list t) | 370 ;; discard the info we have, to force reparsing. |
261 (consp argp) | 371 (if (or (eq compilation-error-list t) |
262 (if (assq 'compilation-parse-errors-hook (buffer-local-variables)) | 372 (consp argp)) |
263 (not (eq compilation-error-buffer | 373 (progn (compilation-forget-errors) |
264 (setq compilation-error-buffer (current-buffer)))))) | 374 (setq compilation-parsing-end 1))) |
265 (progn (compilation-forget-errors) | 375 (if compilation-error-list |
266 (setq compilation-parsing-end 1))) | 376 ;; Since compilation-error-list is non-nil, it points to a specific |
267 (if compilation-error-list | 377 ;; error the user wanted. So don't move it around. |
268 nil | 378 nil |
269 (save-excursion | 379 (switch-to-buffer compilation-last-buffer) |
270 (switch-to-buffer compilation-error-buffer) | |
271 (set-buffer-modified-p nil) | 380 (set-buffer-modified-p nil) |
272 (let ((at-start (= compilation-parsing-end 1))) | 381 (let ((at-start (= compilation-parsing-end 1))) |
273 (run-hooks 'compilation-parse-errors-hook) | 382 (funcall compilation-parse-errors-function) |
274 ;; Remember the entire list for compilation-forget-errors. | 383 ;; Remember the entire list for compilation-forget-errors. |
275 ;; If this is an incremental parse, append to previous list. | 384 ;; If this is an incremental parse, append to previous list. |
276 (if at-start | 385 (if at-start |
277 (setq compilation-old-error-list compilation-error-list) | 386 (setq compilation-old-error-list compilation-error-list) |
278 (setq compilation-old-error-list | 387 (setq compilation-old-error-list |
282 "Visit the source for the error message point is on. | 391 "Visit the source for the error message point is on. |
283 Use this command in a compilation log buffer. | 392 Use this command in a compilation log buffer. |
284 C-u as a prefix arg means to reparse the buffer's error messages first; | 393 C-u as a prefix arg means to reparse the buffer's error messages first; |
285 other kinds of prefix arguments are ignored." | 394 other kinds of prefix arguments are ignored." |
286 (interactive "P") | 395 (interactive "P") |
396 (or (compilation-buffer-p (current-buffer)) | |
397 (error "Not in a compilation buffer.")) | |
398 (setq compilation-last-buffer (current-buffer)) | |
287 (compile-reinitialize-errors argp) | 399 (compile-reinitialize-errors argp) |
288 (save-excursion | 400 (save-excursion |
289 (beginning-of-line) | 401 (beginning-of-line) |
402 ;; Move compilation-error-list to the elt of | |
403 ;; compilation-old-error-list whose car is the error we want. | |
290 (setq compilation-error-list | 404 (setq compilation-error-list |
291 (memq (assoc (point-marker) compilation-old-error-list) | 405 (memq (let (elt) |
406 (while (not (or (setq elt (assoc (point-marker) | |
407 compilation-old-error-list)) | |
408 (eobp))) | |
409 ;; This line doesn't contain an error. | |
410 ;; Move forward a line and look again. | |
411 (forward-line 1)) | |
412 elt) | |
292 compilation-old-error-list))) | 413 compilation-old-error-list))) |
293 ;; Move to another window, so that next-error's window changes | 414 ;; Move to another window, so that next-error's window changes |
294 ;; result in the desired setup. | 415 ;; result in the desired setup. |
295 (or (one-window-p) | 416 (or (one-window-p) |
296 (other-window -1)) | 417 (other-window -1)) |
297 (next-error 1)) | 418 (next-error 1)) |
298 | 419 |
420 (defun compilation-buffer-p (buffer) | |
421 (assq 'compilation-error-list (buffer-local-variables buffer))) | |
422 | |
423 ;; Return a compilation buffer. | |
424 ;; If the current buffer is a compilation buffer, return it. | |
425 ;; If compilation-last-buffer is set to a live buffer, use that. | |
426 ;; Otherwise, look for a compilation buffer and signal an error | |
427 ;; if there are none. | |
428 (defun compilation-find-buffer () | |
429 (if (compilation-buffer-p (current-buffer)) | |
430 ;; The current buffer is a compilation buffer. | |
431 (current-buffer) | |
432 (if (and compilation-last-buffer (buffer-name compilation-last-buffer)) | |
433 compilation-last-buffer | |
434 (let ((buffers (buffer-list))) | |
435 (while (and buffers (not (compilation-buffer-p (car buffers)))) | |
436 (setq buffers (cdr buffers))) | |
437 (if buffers | |
438 (car buffers) | |
439 (error "No compilation started!")))))) | |
440 | |
441 ;;;###autoload | |
299 (defun next-error (&optional argp) | 442 (defun next-error (&optional argp) |
300 "Visit next compilation error message and corresponding source code. | 443 "Visit next compilation error message and corresponding source code. |
301 This operates on the output from the \\[compile] command. | 444 This operates on the output from the \\[compile] command. |
302 If all preparsed error messages have been processed, | 445 If all preparsed error messages have been processed, |
303 the error message buffer is checked for new ones. | 446 the error message buffer is checked for new ones. |
312 output buffer, you stay with that compilation output buffer. | 455 output buffer, you stay with that compilation output buffer. |
313 | 456 |
314 Use \\[next-error] in a compilation output buffer to switch to | 457 Use \\[next-error] in a compilation output buffer to switch to |
315 processing errors from that compilation. | 458 processing errors from that compilation. |
316 | 459 |
317 See variables `compilation-parse-errors-hook' and `compilation-error-regexp' | 460 See variables `compilation-parse-errors-function' and |
318 for customization ideas. When we return, `compilation-last-error' | 461 \`compilation-error-regexp-alist' for customization ideas." |
319 points to the error message and the erroneous code." | |
320 (interactive "P") | 462 (interactive "P") |
463 (setq compilation-last-buffer (compilation-find-buffer)) | |
321 (compile-reinitialize-errors argp) | 464 (compile-reinitialize-errors argp) |
465 ;; Make ARGP nil if the prefix arg was just C-u, | |
466 ;; since that means to reparse the errors, which the | |
467 ;; compile-reinitialize-errors call just did. | |
468 ;; Now we are only interested in a numeric prefix arg. | |
322 (if (consp argp) | 469 (if (consp argp) |
323 (setq argp nil)) | 470 (setq argp nil)) |
324 (let* ((next-errors (nthcdr (+ (- (length compilation-old-error-list) | 471 (let (next-errors next-error) |
325 (length compilation-error-list) | 472 (save-excursion |
326 1) | 473 (set-buffer compilation-last-buffer) |
327 (prefix-numeric-value argp)) | 474 (setq next-errors (nthcdr (+ (- (length compilation-old-error-list) |
328 compilation-old-error-list)) | 475 (length compilation-error-list) |
329 (next-error (car next-errors))) | 476 1) |
330 (if (null next-error) | 477 (prefix-numeric-value argp)) |
331 (save-excursion | 478 compilation-old-error-list) |
332 (if argp (if (> (prefix-numeric-value argp) 0) | 479 next-error (car next-errors)) |
333 (error "Moved past last error") | 480 (while |
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 | 481 (progn |
351 (widen) | 482 (if (null next-error) |
352 (goto-char (car (cdr next-error)))))) | 483 (progn |
484 (if argp (if (> (prefix-numeric-value argp) 0) | |
485 (error "Moved past last error") | |
486 (error "Moved back past first error"))) | |
487 (compilation-forget-errors) | |
488 (error (concat compilation-error-message | |
489 (and (get-buffer-process (current-buffer)) | |
490 (eq (process-status | |
491 (get-buffer-process | |
492 (current-buffer))) | |
493 'run) | |
494 " yet")))) | |
495 (setq compilation-error-list (cdr next-errors)) | |
496 (if (null (cdr next-error)) | |
497 ;; This error is boring. Go to the next. | |
498 t | |
499 (or (markerp (cdr next-error)) | |
500 ;; This error has a filename/lineno pair. | |
501 ;; Find the file and turn it into a marker. | |
502 (let* ((fileinfo (car (cdr next-error))) | |
503 (buffer (compilation-find-file (cdr fileinfo) | |
504 (car fileinfo) | |
505 (car next-error)))) | |
506 (if (null buffer) | |
507 ;; We can't find this error's file. | |
508 ;; Remove all errors in the same file. | |
509 (progn | |
510 (setq next-errors compilation-old-error-list) | |
511 (while next-errors | |
512 (and (consp (cdr (car next-errors))) | |
513 (equal (car (cdr (car next-errors))) | |
514 fileinfo) | |
515 (progn | |
516 (set-marker (car (car next-errors)) nil) | |
517 (setcdr (car next-errors) nil))) | |
518 (setq next-errors (cdr next-errors))) | |
519 ;; Look for the next error. | |
520 t) | |
521 ;; We found the file. Get a marker for this error. | |
522 (set-buffer buffer) | |
523 (save-excursion | |
524 (save-restriction | |
525 (widen) | |
526 (let ((errors compilation-old-error-list) | |
527 (last-line (cdr (cdr next-error)))) | |
528 (goto-line last-line) | |
529 (beginning-of-line) | |
530 (setcdr next-error (point-marker)) | |
531 ;; Make all the other error messages referring | |
532 ;; to the same file have markers into the buffer. | |
533 (while errors | |
534 (and (consp (cdr (car errors))) | |
535 (equal (car (cdr (car errors))) fileinfo) | |
536 (let ((this (cdr (cdr (car errors)))) | |
537 (lines (- (cdr (cdr (car errors))) | |
538 last-line))) | |
539 (if (eq selective-display t) | |
540 (if (< lines 0) | |
541 (re-search-backward "[\n\C-m]" | |
542 nil 'end | |
543 (- lines)) | |
544 (re-search-forward "[\n\C-m]" | |
545 nil 'end | |
546 lines)) | |
547 (forward-line lines)) | |
548 (setq last-line this) | |
549 (setcdr (car errors) (point-marker)))) | |
550 (setq errors (cdr errors))))))))) | |
551 ;; If we didn't get a marker for this error, | |
552 ;; go on to the next one. | |
553 (not (markerp (cdr next-error)))))) | |
554 (setq next-errors compilation-error-list | |
555 next-error (car next-errors)))) | |
556 | |
557 ;; Skip over multiple error messages for the same source location, | |
558 ;; so the next C-x ` won't go to an error in the same place. | |
559 (while (and compilation-error-list | |
560 (equal (cdr (car compilation-error-list)) (cdr next-error))) | |
561 (setq compilation-error-list (cdr compilation-error-list))) | |
562 | |
563 ;; We now have a marker for the position of the error. | |
564 (switch-to-buffer (marker-buffer (cdr next-error))) | |
565 (goto-char (cdr next-error)) | |
566 ;; If narrowing got in the way of | |
567 ;; going to the right place, widen. | |
568 (or (= (point) (marker-position (cdr next-error))) | |
569 (progn | |
570 (widen) | |
571 (goto-char (cdr next-error)))) | |
572 | |
353 ;; Show compilation buffer in other window, scrolled to this error. | 573 ;; Show compilation buffer in other window, scrolled to this error. |
354 (let* ((pop-up-windows t) | 574 (let* ((pop-up-windows t) |
355 (w (display-buffer (marker-buffer (car next-error))))) | 575 (w (display-buffer (marker-buffer (car next-error))))) |
356 (set-window-point w (car next-error)) | 576 (set-window-point w (car next-error)) |
357 (set-window-start w (car next-error))) | 577 (set-window-start w (car next-error))))) |
358 (setq compilation-last-error next-error))) | 578 |
359 | 579 ;;;###autoload |
360 ;; Set compilation-error-list to nil, and | 580 (define-key ctl-x-map "`" 'next-error) |
361 ;; unchain the markers that point to the error messages and their text, | 581 |
362 ;; so that they no longer slow down gap motion. | 582 ;; Find a buffer for file FILENAME. |
363 ;; This would happen anyway at the next garbage collection, | 583 ;; Search the directories in compilation-search-path. |
364 ;; but it is better to do it right away. | 584 ;; A nil in compilation-search-path means to try the |
585 ;; current directory, which is passed in DIR. | |
586 ;; If FILENAME is not found at all, ask the user where to find it. | |
587 ;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user. | |
588 (defun compilation-find-file (filename dir marker) | |
589 (let ((dirs compilation-search-path) | |
590 result name) | |
591 (while (and dirs (null result)) | |
592 (setq name (expand-file-name filename (or (car dirs) dir)) | |
593 result (and (file-exists-p name) | |
594 (find-file-noselect name)) | |
595 dirs (cdr dirs))) | |
596 (or result | |
597 ;; The file doesn't exist. | |
598 ;; Ask the user where to find it. | |
599 ;; If he hits C-g, then the next time he does | |
600 ;; next-error, he'll skip past it. | |
601 (progn | |
602 (let* ((pop-up-windows t) | |
603 (w (display-buffer (marker-buffer marker)))) | |
604 (set-window-point w marker) | |
605 (set-window-start w marker)) | |
606 (setq name | |
607 (expand-file-name | |
608 (read-file-name | |
609 (format "Find this error in: (default %s) " | |
610 filename) dir filename t))) | |
611 (if (file-directory-p name) | |
612 (setq name (concat (file-name-as-directory name) filename))) | |
613 (if (file-exists-p name) | |
614 (find-file-noselect name)))))) | |
615 | |
616 ;; Set compilation-error-list to nil, and unchain the markers that point to the | |
617 ;; error messages and their text, so that they no longer slow down gap motion. | |
618 ;; This would happen anyway at the next garbage collection, but it is better to | |
619 ;; do it the right away. | |
365 (defun compilation-forget-errors () | 620 (defun compilation-forget-errors () |
366 (while compilation-old-error-list | 621 (while compilation-old-error-list |
367 (let ((next-error (car compilation-old-error-list))) | 622 (let ((next-error (car compilation-old-error-list))) |
368 (set-marker (car next-error) nil) | 623 (set-marker (car next-error) nil) |
369 (if (car (cdr next-error)) | 624 (if (markerp (cdr next-error)) |
370 (set-marker (car (cdr next-error)) nil))) | 625 (set-marker (cdr next-error) nil))) |
371 (setq compilation-old-error-list (cdr compilation-old-error-list))) | 626 (setq compilation-old-error-list (cdr compilation-old-error-list))) |
372 (setq compilation-error-list nil)) | 627 (setq compilation-error-list nil) |
628 (while (cdr compilation-directory-stack) | |
629 (setq compilation-directory-stack (cdr compilation-directory-stack)))) | |
630 | |
631 | |
632 (defun count-regexp-groupings (regexp) | |
633 "Return the number of \\( ... \\) groupings in REGEXP (a string)." | |
634 (let ((groupings 0) | |
635 (len (length regexp)) | |
636 (i 0) | |
637 c) | |
638 (while (< i len) | |
639 (setq c (aref regexp i) | |
640 i (1+ i)) | |
641 (cond ((= c ?\[) | |
642 ;; Find the end of this [...]. | |
643 (while (and (< i len) | |
644 (not (= (aref regexp i) ?\]))) | |
645 (setq i (1+ i)))) | |
646 ((= c ?\\) | |
647 (if (< i len) | |
648 (progn | |
649 (setq c (aref regexp i) | |
650 i (1+ i)) | |
651 (if (= c ?\)) | |
652 ;; We found the end of a grouping, | |
653 ;; so bump our counter. | |
654 (setq groupings (1+ groupings)))))))) | |
655 groupings)) | |
373 | 656 |
374 (defun compilation-parse-errors () | 657 (defun compilation-parse-errors () |
375 "Parse the current buffer as grep, cc or lint error messages. | 658 "Parse the current buffer as grep, cc or lint error messages. |
376 See variable `compilation-parse-errors-hook' for the interface it uses." | 659 See variable `compilation-parse-errors-function' for the interface it uses." |
377 (setq compilation-error-list nil) | 660 (setq compilation-error-list nil) |
378 (message "Parsing error messages...") | 661 (message "Parsing error messages...") |
379 (let (text-buffer | 662 (let (text-buffer |
380 last-filename last-linenum) | 663 regexp enter-group leave-group error-group |
664 alist subexpr error-regexp-groups) | |
665 | |
381 ;; Don't reparse messages already seen at last parse. | 666 ;; Don't reparse messages already seen at last parse. |
382 (goto-char compilation-parsing-end) | 667 (goto-char compilation-parsing-end) |
383 ;; Don't parse the first two lines as error messages. | 668 ;; Don't parse the first two lines as error messages. |
384 ;; This matters for grep. | 669 ;; This matters for grep. |
385 (if (bobp) | 670 (if (bobp) |
386 (forward-line 2)) | 671 (forward-line 2)) |
387 (while (re-search-forward compilation-error-regexp nil t) | 672 |
388 (let (linenum filename | 673 ;; Compile all the regexps we want to search for into one. |
389 error-marker text-marker) | 674 (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|" |
390 ;; Extract file name and line number from error message. | 675 "\\(" compilation-leave-directory-regexp "\\)\\|" |
391 (save-restriction | 676 "\\(" (mapconcat (function |
392 (narrow-to-region (match-beginning 0) (match-end 0)) | 677 (lambda (elt) |
393 (goto-char (point-max)) | 678 (concat "\\(" (car elt) "\\)"))) |
394 (skip-chars-backward "[0-9]") | 679 compilation-error-regexp-alist |
395 ;; If it's a lint message, use the last file(linenum) on the line. | 680 "\\|") "\\)")) |
396 ;; Normally we use the first on the line. | 681 |
397 (if (= (preceding-char) ?\() | 682 ;; Find out how many \(...\) groupings are in each of the regexps, and set |
398 (progn | 683 ;; *-GROUP to the grouping containing each constituent regexp (whose |
399 (narrow-to-region (point-min) (1+ (buffer-size))) | 684 ;; subgroups will come immediately thereafter) of the big regexp we have |
400 (end-of-line) | 685 ;; just constructed. |
401 (re-search-backward compilation-error-regexp) | 686 (setq enter-group 1 |
402 (skip-chars-backward "^ \t\n") | 687 leave-group (+ enter-group |
403 (narrow-to-region (point) (match-end 0)) | 688 (count-regexp-groupings |
404 (goto-char (point-max)) | 689 compilation-enter-directory-regexp) |
405 (skip-chars-backward "[0-9]"))) | 690 1) |
406 ;; Are we looking at a "filename-first" or "line-number-first" form? | 691 error-group (+ leave-group |
407 (if (looking-at "[0-9]") | 692 (count-regexp-groupings |
408 (progn | 693 compilation-leave-directory-regexp) |
409 (setq linenum (read (current-buffer))) | 694 1)) |
410 (goto-char (point-min))) | 695 |
411 ;; Line number at start, file name at end. | 696 ;; Compile an alist (IDX FILE LINE), where IDX is the number of the |
412 (progn | 697 ;; subexpression for an entire error-regexp, and FILE and LINE are the |
413 (goto-char (point-min)) | 698 ;; numbers for the subexpressions giving the file name and line number. |
414 (setq linenum (read (current-buffer))) | 699 (setq alist compilation-error-regexp-alist |
415 (goto-char (point-max)) | 700 subexpr (1+ error-group)) |
416 (skip-chars-backward "^ \t\n"))) | 701 (while alist |
417 (setq filename (compilation-grab-filename))) | 702 (setq error-regexp-groups (cons (list subexpr |
418 ;; Locate the erring file and line. | 703 (+ subexpr (nth 1 (car alist))) |
419 (if (and (equal filename last-filename) | 704 (+ subexpr (nth 2 (car alist)))) |
420 (= linenum last-linenum)) | 705 error-regexp-groups)) |
421 nil | 706 (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist))))) |
422 (beginning-of-line 1) | 707 (setq alist (cdr alist))) |
423 (setq error-marker (point-marker)) | 708 |
424 ;; text-buffer gets the buffer containing this error's file. | 709 (while (re-search-forward regexp nil t) |
425 (if (not (equal filename last-filename)) | 710 ;; Figure out which constituent regexp matched. |
426 (setq last-filename filename | 711 (cond ((match-beginning enter-group) |
427 text-buffer (compilation-find-file filename) | 712 ;; The match was the enter-directory regexp. |
428 last-linenum 0)) | 713 (let ((dir |
429 (if text-buffer | 714 (file-name-as-directory |
430 ;; Go to that buffer and find the erring line. | 715 (expand-file-name |
431 (save-excursion | 716 (buffer-substring (match-beginning (+ enter-group 1)) |
432 (set-buffer text-buffer) | 717 (match-end (+ enter-group 1))))))) |
433 (if (zerop last-linenum) | 718 (setq compilation-directory-stack |
434 (progn | 719 (cons dir compilation-directory-stack)) |
435 (goto-char 1) | 720 (and (file-directory-p dir) |
436 (setq last-linenum 1))) | 721 (setq default-directory dir)))) |
437 (forward-line (- linenum last-linenum)) | 722 |
438 (setq last-linenum linenum) | 723 ((match-beginning leave-group) |
439 (setq text-marker (point-marker)) | 724 ;; The match was the leave-directory regexp. |
440 (setq compilation-error-list | 725 (let ((beg (match-beginning (+ leave-group 1))) |
441 (cons (list error-marker text-marker) | 726 (stack compilation-directory-stack)) |
442 compilation-error-list))))) | 727 (if beg |
443 (forward-line 1))) | 728 (let ((dir |
729 (file-name-as-directory | |
730 (expand-file-name | |
731 (buffer-substring beg | |
732 (match-end (+ leave-group | |
733 1))))))) | |
734 (while (and stack | |
735 (not (string-equal (car stack) dir))) | |
736 (setq stack (cdr stack))))) | |
737 (setq compilation-directory-stack (cdr stack)) | |
738 (setq stack (car compilation-directory-stack)) | |
739 (if stack | |
740 (setq default-directory stack)) | |
741 )) | |
742 | |
743 ((match-beginning error-group) | |
744 ;; The match was the composite error regexp. | |
745 ;; Find out which individual regexp matched. | |
746 (setq alist error-regexp-groups) | |
747 (while (and alist | |
748 (null (match-beginning (car (car alist))))) | |
749 (setq alist (cdr alist))) | |
750 (if alist | |
751 (setq alist (car alist)) | |
752 (error "Impossible regexp match!")) | |
753 | |
754 ;; Extract the file name and line number from the error message. | |
755 (let ((filename | |
756 (cons default-directory | |
757 (buffer-substring (match-beginning (nth 1 alist)) | |
758 (match-end (nth 1 alist))))) | |
759 (linenum (save-restriction | |
760 (narrow-to-region | |
761 (match-beginning (nth 2 alist)) | |
762 (match-end (nth 2 alist))) | |
763 (goto-char (point-min)) | |
764 (if (looking-at "[0-9]") | |
765 (read (current-buffer)))))) | |
766 ;; Locate the erring file and line. | |
767 ;; Cons a new elt onto compilation-error-list, | |
768 ;; giving a marker for the current compilation buffer | |
769 ;; location, and the file and line number of the error. | |
770 (save-excursion | |
771 (beginning-of-line 1) | |
772 (setq compilation-error-list | |
773 (cons (cons (point-marker) | |
774 (cons filename linenum)) | |
775 compilation-error-list))))) | |
776 (t | |
777 (error "Impossible regexp match!")))) | |
444 (setq compilation-parsing-end (point-max))) | 778 (setq compilation-parsing-end (point-max))) |
445 (message "Parsing error messages...done") | 779 (message "Parsing error messages...done") |
446 (setq compilation-error-list (nreverse compilation-error-list))) | 780 (setq compilation-error-list (nreverse compilation-error-list))) |
447 | 781 |
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) | 782 (define-key ctl-x-map "`" 'next-error) |