![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to compile.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to compile.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Run compiler as inferior of Emacs, and parse its error messages.
2: ;; Copyright (C) 1985, 1986 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-process nil
23: "Process created by compile command, or nil if none exists now.
24: Note that the process may have been \"deleted\" and still
25: be the value of this variable.")
26:
27: (defvar compilation-error-list nil
28: "List of error message descriptors for visiting erring functions.
29: Each error descriptor is a list of length two.
30: Its car is a marker pointing to an error message.
31: Its cadr is a marker pointing to the text of the line the message is about,
32: or nil if that is not interesting.
33: The value may be t instead of a list;
34: this means that the buffer of error messages should be reparsed
35: the next time the list of errors is wanted.")
36:
37: (defvar compilation-parsing-end nil
38: "Position of end of buffer when last error messages parsed.")
39:
40: (defvar compilation-error-message nil
41: "Message to print when no more matches for compilation-error-regexp are found")
42:
43: ;; The filename excludes colons to avoid confusion when error message
44: ;; starts with digits.
45: (defvar compilation-error-regexp
46: "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)"
47: "Regular expression for filename/linenumber in error in compilation log.")
48:
49: (defun compile (command)
50: "Compile the program including the current buffer. Default: run `make'.
51: Runs COMMAND, a shell command, in a separate process asynchronously
52: with output going to the buffer *compilation*.
53: You can then use the command \\[next-error] to find the next error message
54: and move to the source code that caused it."
55: (interactive (list (read-string "Compile command: " compile-command)))
56: (setq compile-command command)
57: (compile1 compile-command "No more errors"))
58:
59: (defun grep (command)
60: "Run grep, with user-specified args, and collect output in a buffer.
61: While grep runs asynchronously, you can use the \\[next-error] command
62: to find the text that grep hits refer to."
63: (interactive "sRun grep (with args): ")
64: (compile1 (concat "grep -n " command " /dev/null")
65: "No more grep hits" "grep"))
66:
67: (defun compile1 (command error-message &optional name-of-mode)
68: (save-some-buffers)
69: (if compilation-process
70: (if (or (not (eq (process-status compilation-process) 'run))
71: (yes-or-no-p "A compilation process is running; kill it? "))
72: (condition-case ()
73: (if compilation-process
74: (let ((comp-proc compilation-process))
75: (interrupt-process comp-proc)
76: (sit-for 1)
77: (delete-process comp-proc)))
78: (error nil))
79: (error "Cannot have two compilation processes")))
80: (setq compilation-process nil)
81: (compilation-forget-errors)
82: (setq compilation-error-list t)
83: (setq compilation-error-message error-message)
84: (setq compilation-process
85: (start-process "compilation" "*compilation*"
86: shell-file-name
87: "-c" (concat "exec " command)))
88: (with-output-to-temp-buffer "*compilation*"
89: (princ "cd ")
90: (princ default-directory)
91: (terpri)
92: (princ command)
93: (terpri))
94: (set-process-sentinel compilation-process 'compilation-sentinel)
95: (let* ((thisdir default-directory)
96: (outbuf (process-buffer compilation-process))
97: (outwin (get-buffer-window outbuf))
98: (regexp compilation-error-regexp))
99: (if (eq outbuf (current-buffer))
100: (goto-char (point-max)))
101: (save-excursion
102: (set-buffer outbuf)
103: (buffer-flush-undo outbuf)
104: (let ((start (save-excursion (set-buffer outbuf) (point-min))))
105: (set-window-start outwin start)
106: (or (eq outwin (selected-window))
107: (set-window-point outwin start)))
108: (setq default-directory thisdir)
109: (fundamental-mode)
110: (make-local-variable 'compilation-error-regexp)
111: (setq compilation-error-regexp regexp)
112: (setq mode-name (or name-of-mode "Compilation"))
113: ;; Make log buffer's mode line show process state
114: (setq mode-line-process '(": %s")))))
115:
116: ;; Called when compilation process changes state.
117:
118: (defun compilation-sentinel (proc msg)
119: (cond ((null (buffer-name (process-buffer proc)))
120: ;; buffer killed
121: (set-process-buffer proc nil))
122: ((memq (process-status proc) '(signal exit))
123: (let* ((obuf (current-buffer))
124: omax opoint)
125: ;; save-excursion isn't the right thing if
126: ;; process-buffer is current-buffer
127: (unwind-protect
128: (progn
129: ;; Write something in *compilation* and hack its mode line,
130: (set-buffer (process-buffer proc))
131: (setq omax (point-max) opoint (point))
132: (goto-char (point-max))
133: (insert ?\n mode-name " " msg)
134: (forward-char -1)
135: (insert " at "
136: (substring (current-time-string) 0 -5))
137: (forward-char 1)
138: (setq mode-line-process
139: (concat ": "
140: (symbol-name (process-status proc))))
141: ;; If buffer and mode line will show that the process
142: ;; is dead, we can delete it now. Otherwise it
143: ;; will stay around until M-x list-processes.
144: (delete-process proc))
145: (setq compilation-process nil)
146: ;; Force mode line redisplay soon
147: (set-buffer-modified-p (buffer-modified-p)))
148: (if (and opoint (< opoint omax))
149: (goto-char opoint))
150: (set-buffer obuf)))))
151:
152: (defun kill-compilation ()
153: "Kill the process made by the \\[compile] command."
154: (interactive)
155: (if compilation-process
156: (interrupt-process compilation-process)))
157:
158: (defun kill-grep ()
159: "Kill the process made by the \\[grep] command."
160: (interactive)
161: (if compilation-process
162: (interrupt-process compilation-process)))
163:
164: (defun next-error (&optional argp)
165: "Visit next compilation error message and corresponding source code.
166: This operates on the output from the \\[compile] command.
167: If all preparsed error messages have been processed,
168: the error message buffer is checked for new ones.
169: A non-nil argument (prefix arg, if interactive)
170: means reparse the error message buffer and start at the first error."
171: (interactive "P")
172: (if (or (eq compilation-error-list t)
173: argp)
174: (progn (compilation-forget-errors)
175: (setq compilation-parsing-end 1)))
176: (if compilation-error-list
177: nil
178: (save-excursion
179: (set-buffer "*compilation*")
180: (set-buffer-modified-p nil)
181: (compilation-parse-errors)))
182: (let ((next-error (car compilation-error-list)))
183: (if (null next-error)
184: (error (concat compilation-error-message
185: (if (and compilation-process
186: (eq (process-status compilation-process)
187: 'run))
188: " yet" ""))))
189: (setq compilation-error-list (cdr compilation-error-list))
190: (if (null (car (cdr next-error)))
191: nil
192: (switch-to-buffer (marker-buffer (car (cdr next-error))))
193: (goto-char (car (cdr next-error)))
194: (set-marker (car (cdr next-error)) nil))
195: (let* ((pop-up-windows t)
196: (w (display-buffer (marker-buffer (car next-error)))))
197: (set-window-point w (car next-error))
198: (set-window-start w (car next-error)))
199: (set-marker (car next-error) nil)))
200:
201: ;; Set compilation-error-list to nil, and
202: ;; unchain the markers that point to the error messages and their text,
203: ;; so that they no longer slow down gap motion.
204: ;; This would happen anyway at the next garbage collection,
205: ;; but it is better to do it right away.
206: (defun compilation-forget-errors ()
207: (if (eq compilation-error-list t)
208: (setq compilation-error-list nil))
209: (while compilation-error-list
210: (let ((next-error (car compilation-error-list)))
211: (set-marker (car next-error) nil)
212: (if (car (cdr next-error))
213: (set-marker (car (cdr next-error)) nil)))
214: (setq compilation-error-list (cdr compilation-error-list))))
215:
216: (defun compilation-parse-errors ()
217: "Parse the current buffer as error messages.
218: This makes a list of error descriptors, compilation-error-list.
219: For each source-file, line-number pair in the buffer,
220: the source file is read in, and the text location is saved in compilation-error-list.
221: The function next-error, assigned to \\[next-error], takes the next error off the list
222: and visits its location."
223: (setq compilation-error-list nil)
224: (message "Parsing error messages...")
225: (let (text-buffer
226: last-filename last-linenum)
227: ;; Don't reparse messages already seen at last parse.
228: (goto-char compilation-parsing-end)
229: ;; Don't parse the first two lines as error messages.
230: ;; This matters for grep.
231: (if (bobp)
232: (forward-line 2))
233: (while (re-search-forward compilation-error-regexp nil t)
234: (let (linenum filename
235: error-marker text-marker)
236: ;; Extract file name and line number from error message.
237: (save-restriction
238: (narrow-to-region (match-beginning 0) (match-end 0))
239: (goto-char (point-max))
240: (skip-chars-backward "[0-9]")
241: ;; If it's a lint message, use the last file(linenum) on the line.
242: ;; Normally we use the first on the line.
243: (if (= (preceding-char) ?\()
244: (progn
245: (narrow-to-region (point-min) (1+ (buffer-size)))
246: (end-of-line)
247: (re-search-backward compilation-error-regexp)
248: (skip-chars-backward "^ \t\n")
249: (narrow-to-region (point) (match-end 0))
250: (goto-char (point-max))
251: (skip-chars-backward "[0-9]")))
252: ;; Are we looking at a "filename-first" or "line-number-first" form?
253: (if (looking-at "[0-9]")
254: (progn
255: (setq linenum (read (current-buffer)))
256: (goto-char (point-min)))
257: ;; Line number at start, file name at end.
258: (progn
259: (goto-char (point-min))
260: (setq linenum (read (current-buffer)))
261: (goto-char (point-max))
262: (skip-chars-backward "^ \t\n")))
263: (setq filename (compilation-grab-filename)))
264: ;; Locate the erring file and line.
265: (if (and (equal filename last-filename)
266: (= linenum last-linenum))
267: nil
268: (beginning-of-line 1)
269: (setq error-marker (point-marker))
270: ;; text-buffer gets the buffer containing this error's file.
271: (if (not (equal filename last-filename))
272: (setq text-buffer
273: (and (file-exists-p (setq last-filename filename))
274: (find-file-noselect filename))
275: last-linenum 0))
276: (if text-buffer
277: ;; Go to that buffer and find the erring line.
278: (save-excursion
279: (set-buffer text-buffer)
280: (if (zerop last-linenum)
281: (progn
282: (goto-char 1)
283: (setq last-linenum 1)))
284: ;; Move the right number of lines from the old position.
285: ;; If we can't move that many, put 0 in last-linenum
286: ;; so the next error message will be handled starting from
287: ;; scratch.
288: (if (eq selective-display t)
289: (or (re-search-forward "[\n\C-m]" nil 'end
290: (- linenum last-linenum))
291: (setq last-linenum 0))
292: (or (= 0 (forward-line (- linenum last-linenum)))
293: (setq last-linenum 0)))
294: (setq last-linenum linenum)
295: (setq text-marker (point-marker))
296: (setq compilation-error-list
297: (cons (list error-marker text-marker)
298: compilation-error-list)))))
299: (forward-line 1)))
300: (setq compilation-parsing-end (point-max)))
301: (message "Parsing error messages...done")
302: (setq compilation-error-list (nreverse compilation-error-list)))
303:
304: (defun compilation-grab-filename ()
305: "Return a string which is a filename, starting at point.
306: Ignore quotes and parentheses around it, as well as trailing colons."
307: (if (eq (following-char) ?\")
308: (save-restriction
309: (narrow-to-region (point)
310: (progn (forward-sexp 1) (point)))
311: (goto-char (point-min))
312: (read (current-buffer)))
313: (buffer-substring (point)
314: (progn
315: (skip-chars-forward "^ :,\n\t(")
316: (point)))))
317:
318: (define-key ctl-x-map "`" 'next-error)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.