![[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] / 43BSD / contrib / emacs / lisp|
Return to compile.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 root 1: ;; Run compiler as inferior of Emacs, and parse its error messages.
2: ;; Copyright (C) 1985 Richard M. Stallman.
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: (defvar compilation-error-regexp
45: "\\([^ \n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+.*of *[^ \n]+\\)"
46: "Regular expression for filename/linenumber in error in compilation log.")
47:
48: (defun compile (command)
49: "Compile the program including the current buffer. Default: run make.
50: Runs COMMAND, a shell command, in a separate process asynchronously
51: with output going to the buffer *compilation*.
52: You can then use the command \\[next-error] to find the next error message
53: and move to the source code that caused it."
54: (interactive (list (read-input "Compile command: " compile-command)))
55: (setq compile-command command)
56: (compile1 compile-command "No more errors"))
57:
58: (defun grep (command)
59: "Run grep, with user-specified args, and collect output in a buffer.
60: While grep runs asynchronously, you can use the \\[next-error] command
61: to find the text that grep hits refer to."
62: (interactive "sRun grep (with args): ")
63: (compile1 (concat "grep -n " command " /dev/null")
64: "No more grep hits" "grep"))
65:
66: (defun compile1 (command error-message &optional name-of-mode)
67: (save-some-buffers)
68: (if compilation-process
69: (if (or (not (eq (process-status compilation-process) 'run))
70: (yes-or-no-p "A compilation process is running; kill it? "))
71: (condition-case ()
72: (delete-process compilation-process)
73: (error nil))
74: (error "Cannot have two compilation processes")))
75: (setq compilation-process nil)
76: (compilation-forget-errors)
77: (setq compilation-error-list t)
78: (setq compilation-error-message error-message)
79: (setq compilation-process
80: (start-process "compilation" "*compilation*"
81: shell-file-name
82: "-c" (concat "exec " command)))
83: (with-output-to-temp-buffer "*compilation*"
84: (princ "cd ")
85: (princ default-directory)
86: (terpri)
87: (princ command)
88: (terpri))
89: (let ((regexp compilation-error-regexp))
90: (save-excursion
91: (switch-to-buffer "*compilation*")
92: (make-local-variable 'compilation-error-regexp)
93: (setq compilation-error-regexp regexp)))
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: (if (eq outbuf (current-buffer))
99: (goto-char (point-max)))
100: (save-excursion
101: (set-buffer outbuf)
102: (buffer-flush-undo outbuf)
103: (set-window-start outwin 1)
104: (or (eq outwin (selected-window))
105: (set-window-point outwin 1))
106: (setq default-directory thisdir)
107: (fundamental-mode)
108: (setq mode-name (or name-of-mode "Compilation"))
109: ;; Make log buffer's mode line show process state
110: (setq mode-line-format
111: "--%1*%1*-Emacs: %17b % %[(%m: %s)%]----%3p--%-"))))
112:
113: ;; Called when compilation process changes state.
114: (defun compilation-sentinel (proc msg)
115: (if (memq (process-status proc) '(signal exit))
116: (let* ((obuf (current-buffer))
117: (omax (point-max))
118: (opoint (point)))
119: (unwind-protect
120: (progn
121: (set-buffer (process-buffer proc))
122: (goto-char (point-max))
123: (insert ?\n mode-name " " msg)
124: (setq mode-line-format
125: (concat
126: "--%1*%1*-Emacs: %17b %M %[(%m: "
127: (symbol-name (process-status proc))
128: ")%]----%3p--%-"))
129: (delete-process proc)
130: (setq compilation-process nil)
131: ;; Force mode line redisplay soon
132: (set-buffer-modified-p (buffer-modified-p)))
133: (if (< opoint omax)
134: (goto-char opoint))
135: (set-buffer obuf)))))
136:
137: (defun kill-compilation ()
138: "Kill the process made by the \\[compile] command."
139: (interactive)
140: (if compilation-process
141: (interrupt-process compilation-process)))
142:
143: (defun kill-grep ()
144: "Kill the process made by the \\[grep] command."
145: (interactive)
146: (if compilation-process
147: (interrupt-process compilation-process)))
148:
149: (defun next-error (&optional argp)
150: "Visit next compilation error message and corresponding source code.
151: This operates on the output from the \\[compile] command.
152: If all preparsed error messages have been processed,
153: the error message buffer is checked for new ones.
154: A non-nil argument (prefix arg, if interactive)
155: means reparse the error message buffer and start at the first error."
156: (interactive "P")
157: (if (or (eq compilation-error-list t)
158: argp)
159: (progn (compilation-forget-errors)
160: (setq compilation-parsing-end 1)))
161: (if compilation-error-list
162: nil
163: (save-excursion
164: (switch-to-buffer "*compilation*")
165: (set-buffer-modified-p nil)
166: (compilation-parse-errors)))
167: (let ((next-error (car compilation-error-list)))
168: (if (null next-error)
169: (error (concat compilation-error-message
170: (if (and compilation-process
171: (eq (process-status compilation-process)
172: 'run))
173: " yet" ""))))
174: (setq compilation-error-list (cdr compilation-error-list))
175: (if (null (car (cdr next-error)))
176: nil
177: (switch-to-buffer (marker-buffer (car (cdr next-error))))
178: (goto-char (car (cdr next-error)))
179: (set-marker (car (cdr next-error)) nil))
180: (let* ((pop-up-windows t)
181: (w (display-buffer (marker-buffer (car next-error)))))
182: (set-window-point w (car next-error))
183: (set-window-start w (car next-error)))
184: (set-marker (car next-error) nil)))
185:
186: ;; Set compilation-error-list to nil, and
187: ;; unchain the markers that point to the error messages and their text,
188: ;; so that they no longer slow down gap motion.
189: ;; This would happen anyway at the next garbage collection,
190: ;; but it is better to do it right away.
191: (defun compilation-forget-errors ()
192: (if (eq compilation-error-list t)
193: (setq compilation-error-list nil))
194: (while compilation-error-list
195: (let ((next-error (car compilation-error-list)))
196: (set-marker (car next-error) nil)
197: (if (car (cdr next-error))
198: (set-marker (car (cdr next-error)) nil)))
199: (setq compilation-error-list (cdr compilation-error-list))))
200:
201: (defun compilation-parse-errors ()
202: "Parse the current buffer as error messages.
203: This makes a list of error descriptors, compilation-error-list.
204: For each source-file, line-number pair in the buffer,
205: the source file is read in, and the text location is saved in compilation-error-list.
206: The function next-error, assigned to \\[next-error], takes the next error off the list
207: and visits its location."
208: (setq compilation-error-list nil)
209: (message "Parsing error messages...")
210: (let (text-buffer
211: last-filename last-linenum)
212: ;; Don't reparse messages already seen at last parse.
213: (goto-char compilation-parsing-end)
214: ;; Don't parse the first two lines as error messages.
215: ;; This matters for grep.
216: (if (bobp)
217: (forward-line 2))
218: (while (re-search-forward compilation-error-regexp nil t)
219: (let (linenum filename
220: error-marker text-marker)
221: ;; Extract file name and line number from error message.
222: (save-restriction
223: (narrow-to-region (match-beginning 0) (match-end 0))
224: (goto-char (point-max))
225: (skip-chars-backward "[0-9]")
226: ;; If it's a lint message, use the last file(linenum) on the line.
227: ;; Normally we use the first on the line.
228: (if (= (preceding-char) ?\()
229: (progn
230: (narrow-to-region (point-min) (1+ (buffer-size)))
231: (end-of-line)
232: (re-search-backward compilation-error-regexp)
233: (skip-chars-backward "^ \t\n")
234: (narrow-to-region (point) (match-end 0))
235: (goto-char (point-max))
236: (skip-chars-backward "[0-9]")))
237: ;; Are we looking at a "filename-first" or "line-number-first" form?
238: (if (looking-at "[0-9]")
239: (progn
240: (setq linenum (read (current-buffer)))
241: (goto-char (point-min)))
242: ;; Line number at start, file name at end.
243: (progn
244: (goto-char (point-min))
245: (setq linenum (read (current-buffer)))
246: (goto-char (point-max))
247: (skip-chars-backward "^ \t\n")))
248: (setq filename (compilation-grab-filename)))
249: ;; Locate the erring file and line.
250: (if (and (equal filename last-filename)
251: (= linenum last-linenum))
252: nil
253: (beginning-of-line 1)
254: (setq error-marker (point-marker))
255: (setq last-linenum linenum)
256: (if (not (equal filename last-filename))
257: (setq text-buffer
258: (and (file-exists-p (setq last-filename filename))
259: (find-file-noselect filename))))
260: (if text-buffer
261: (save-excursion
262: (set-buffer text-buffer)
263: (goto-char 1)
264: (forward-line (1- linenum))
265: (setq text-marker (point-marker))
266: (setq compilation-error-list
267: (cons (list error-marker text-marker)
268: compilation-error-list)))))
269: (forward-line 1)))
270: (setq compilation-parsing-end (point-max)))
271: (message "Parsing error messages...done")
272: (setq compilation-error-list (nreverse compilation-error-list)))
273:
274: (defun compilation-grab-filename ()
275: "Return a string which is a filename, starting at point.
276: Ignore quotes and parentheses around it, as well as trailing colons."
277: (if (eq (following-char) ?\")
278: (save-restriction
279: (narrow-to-region (point)
280: (progn (forward-sexp 1) (point)))
281: (goto-char (point-min))
282: (read (current-buffer)))
283: (buffer-substring (point)
284: (progn
285: (skip-chars-forward "^ :,\n\t(")
286: (point)))))
287:
288: (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.