![[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 [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to compile.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / 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 distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21: (provide 'compile)
22:
23: (defvar compilation-process nil
24: "Process created by compile command, or nil if none exists now.
25: Note that the process may have been \"deleted\" and still
26: be the value of this variable.")
27:
28: (defvar compilation-error-list nil
29: "List of error message descriptors for visiting erring functions.
30: Each error descriptor is a list of length two.
31: Its car is a marker pointing to an error message.
32: Its cadr is a marker pointing to the text of the line the message is about,
33: or nil if that is not interesting.
34: The value may be t instead of a list;
35: this means that the buffer of error messages should be reparsed
36: the next time the list of errors is wanted.")
37:
38: (defvar compilation-parsing-end nil
39: "Position of end of buffer when last error messages parsed.")
40:
41: (defvar compilation-error-message nil
42: "Message to print when no more matches for compilation-error-regexp are found")
43:
44: ;; The filename excludes colons to avoid confusion when error message
45: ;; starts with digits.
46: (defvar compilation-error-regexp
47: "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)"
48: "Regular expression for filename/linenumber in error in compilation log.")
49:
50: (defun compile (command)
51: "Compile the program including the current buffer. Default: run `make'.
52: Runs COMMAND, a shell command, in a separate process asynchronously
53: with output going to the buffer *compilation*.
54: You can then use the command \\[next-error] to find the next error message
55: and move to the source code that caused it."
56: (interactive (list (read-string "Compile command: " compile-command)))
57: (setq compile-command command)
58: (compile1 compile-command "No more errors"))
59:
60: (defun grep (command)
61: "Run grep, with user-specified args, and collect output in a buffer.
62: While grep runs asynchronously, you can use the \\[next-error] command
63: to find the text that grep hits refer to."
64: (interactive "sRun grep (with args): ")
65: (compile1 (concat "grep -n " command " /dev/null")
66: "No more grep hits" "grep"))
67:
68: (defun compile1 (command error-message &optional name-of-mode)
69: (save-some-buffers)
70: (if compilation-process
71: (if (or (not (eq (process-status compilation-process) 'run))
72: (yes-or-no-p "A compilation process is running; kill it? "))
73: (condition-case ()
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: (let ((regexp compilation-error-regexp))
95: (save-excursion
96: (set-buffer "*compilation*")
97: (make-local-variable 'compilation-error-regexp)
98: (setq compilation-error-regexp regexp)))
99: (set-process-sentinel compilation-process 'compilation-sentinel)
100: (let* ((thisdir default-directory)
101: (outbuf (process-buffer compilation-process))
102: (outwin (get-buffer-window outbuf)))
103: (if (eq outbuf (current-buffer))
104: (goto-char (point-max)))
105: (save-excursion
106: (set-buffer outbuf)
107: (buffer-flush-undo outbuf)
108: (let ((start (save-excursion (set-buffer outbuf) (point-min))))
109: (set-window-start outwin start)
110: (or (eq outwin (selected-window))
111: (set-window-point outwin start)))
112: (setq default-directory thisdir)
113: (fundamental-mode)
114: (setq mode-name (or name-of-mode "Compilation"))
115: ;; Make log buffer's mode line show process state
116: (setq mode-line-process '(": %s")))))
117:
118: ;; Called when compilation process changes state.
119:
120: (defun compilation-sentinel (proc msg)
121: (cond ((null (buffer-name (process-buffer proc)))
122: ;; buffer killed
123: (set-process-buffer proc nil))
124: ((memq (process-status proc) '(signal exit))
125: (let* ((obuf (current-buffer))
126: omax opoint)
127: ;; save-excursion isn't the right thing if
128: ;; process-buffer is current-buffer
129: (unwind-protect
130: (progn
131: ;; Write something in *compilation* and hack its mode line,
132: (set-buffer (process-buffer proc))
133: (setq omax (point-max) opoint (point))
134: (goto-char (point-max))
135: (insert ?\n mode-name " " msg)
136: (forward-char -1)
137: (insert " at "
138: (substring (current-time-string) 0 -5))
139: (forward-char 1)
140: (setq mode-line-process
141: (concat ": "
142: (symbol-name (process-status proc))))
143: ;; If buffer and mode line will show that the process
144: ;; is dead, we can delete it now. Otherwise it
145: ;; will stay around until M-x list-processes.
146: (delete-process proc))
147: (setq compilation-process nil)
148: ;; Force mode line redisplay soon
149: (set-buffer-modified-p (buffer-modified-p)))
150: (if (and opoint (< opoint omax))
151: (goto-char opoint))
152: (set-buffer obuf)))))
153:
154: (defun kill-compilation ()
155: "Kill the process made by the \\[compile] command."
156: (interactive)
157: (if compilation-process
158: (interrupt-process compilation-process)))
159:
160: (defun kill-grep ()
161: "Kill the process made by the \\[grep] command."
162: (interactive)
163: (if compilation-process
164: (interrupt-process compilation-process)))
165:
166: (defun next-error (&optional argp)
167: "Visit next compilation error message and corresponding source code.
168: This operates on the output from the \\[compile] command.
169: If all preparsed error messages have been processed,
170: the error message buffer is checked for new ones.
171: A non-nil argument (prefix arg, if interactive)
172: means reparse the error message buffer and start at the first error."
173: (interactive "P")
174: (if (or (eq compilation-error-list t)
175: argp)
176: (progn (compilation-forget-errors)
177: (setq compilation-parsing-end 1)))
178: (if compilation-error-list
179: nil
180: (save-excursion
181: (switch-to-buffer "*compilation*")
182: (set-buffer-modified-p nil)
183: (compilation-parse-errors)))
184: (let ((next-error (car compilation-error-list)))
185: (if (null next-error)
186: (error (concat compilation-error-message
187: (if (and compilation-process
188: (eq (process-status compilation-process)
189: 'run))
190: " yet" ""))))
191: (setq compilation-error-list (cdr compilation-error-list))
192: (if (null (car (cdr next-error)))
193: nil
194: (switch-to-buffer (marker-buffer (car (cdr next-error))))
195: (goto-char (car (cdr next-error)))
196: (set-marker (car (cdr next-error)) nil))
197: (let* ((pop-up-windows t)
198: (w (display-buffer (marker-buffer (car next-error)))))
199: (set-window-point w (car next-error))
200: (set-window-start w (car next-error)))
201: (set-marker (car next-error) nil)))
202:
203: ;; Set compilation-error-list to nil, and
204: ;; unchain the markers that point to the error messages and their text,
205: ;; so that they no longer slow down gap motion.
206: ;; This would happen anyway at the next garbage collection,
207: ;; but it is better to do it right away.
208: (defun compilation-forget-errors ()
209: (if (eq compilation-error-list t)
210: (setq compilation-error-list nil))
211: (while compilation-error-list
212: (let ((next-error (car compilation-error-list)))
213: (set-marker (car next-error) nil)
214: (if (car (cdr next-error))
215: (set-marker (car (cdr next-error)) nil)))
216: (setq compilation-error-list (cdr compilation-error-list))))
217:
218: (defun compilation-parse-errors ()
219: "Parse the current buffer as error messages.
220: This makes a list of error descriptors, compilation-error-list.
221: For each source-file, line-number pair in the buffer,
222: the source file is read in, and the text location is saved in compilation-error-list.
223: The function next-error, assigned to \\[next-error], takes the next error off the list
224: and visits its location."
225: (setq compilation-error-list nil)
226: (message "Parsing error messages...")
227: (let (text-buffer
228: last-filename last-linenum)
229: ;; Don't reparse messages already seen at last parse.
230: (goto-char compilation-parsing-end)
231: ;; Don't parse the first two lines as error messages.
232: ;; This matters for grep.
233: (if (bobp)
234: (forward-line 2))
235: (while (re-search-forward compilation-error-regexp nil t)
236: (let (linenum filename
237: error-marker text-marker)
238: ;; Extract file name and line number from error message.
239: (save-restriction
240: (narrow-to-region (match-beginning 0) (match-end 0))
241: (goto-char (point-max))
242: (skip-chars-backward "[0-9]")
243: ;; If it's a lint message, use the last file(linenum) on the line.
244: ;; Normally we use the first on the line.
245: (if (= (preceding-char) ?\()
246: (progn
247: (narrow-to-region (point-min) (1+ (buffer-size)))
248: (end-of-line)
249: (re-search-backward compilation-error-regexp)
250: (skip-chars-backward "^ \t\n")
251: (narrow-to-region (point) (match-end 0))
252: (goto-char (point-max))
253: (skip-chars-backward "[0-9]")))
254: ;; Are we looking at a "filename-first" or "line-number-first" form?
255: (if (looking-at "[0-9]")
256: (progn
257: (setq linenum (read (current-buffer)))
258: (goto-char (point-min)))
259: ;; Line number at start, file name at end.
260: (progn
261: (goto-char (point-min))
262: (setq linenum (read (current-buffer)))
263: (goto-char (point-max))
264: (skip-chars-backward "^ \t\n")))
265: (setq filename (compilation-grab-filename)))
266: ;; Locate the erring file and line.
267: (if (and (equal filename last-filename)
268: (= linenum last-linenum))
269: nil
270: (beginning-of-line 1)
271: (setq error-marker (point-marker))
272: ;; text-buffer gets the buffer containing this error's file.
273: (if (not (equal filename last-filename))
274: (setq text-buffer
275: (and (file-exists-p (setq last-filename filename))
276: (find-file-noselect filename))
277: last-linenum 0))
278: (if text-buffer
279: ;; Go to that buffer and find the erring line.
280: (save-excursion
281: (set-buffer text-buffer)
282: (if (zerop last-linenum)
283: (progn
284: (goto-char 1)
285: (setq last-linenum 1)))
286: (forward-line (- linenum last-linenum))
287: (setq last-linenum linenum)
288: (setq text-marker (point-marker))
289: (setq compilation-error-list
290: (cons (list error-marker text-marker)
291: compilation-error-list)))))
292: (forward-line 1)))
293: (setq compilation-parsing-end (point-max)))
294: (message "Parsing error messages...done")
295: (setq compilation-error-list (nreverse compilation-error-list)))
296:
297: (defun compilation-grab-filename ()
298: "Return a string which is a filename, starting at point.
299: Ignore quotes and parentheses around it, as well as trailing colons."
300: (if (eq (following-char) ?\")
301: (save-restriction
302: (narrow-to-region (point)
303: (progn (forward-sexp 1) (point)))
304: (goto-char (point-min))
305: (read (current-buffer)))
306: (buffer-substring (point)
307: (progn
308: (skip-chars-forward "^ :,\n\t(")
309: (point)))))
310:
311: (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.