318 lines
12 KiB
EmacsLisp
318 lines
12 KiB
EmacsLisp
;; Run compiler as inferior of Emacs, and parse its error messages.
|
|
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 1, or (at your option)
|
|
;; any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
(provide 'compile)
|
|
|
|
(defvar compilation-process nil
|
|
"Process created by compile command, or nil if none exists now.
|
|
Note that the process may have been \"deleted\" and still
|
|
be the value of this variable.")
|
|
|
|
(defvar compilation-error-list nil
|
|
"List of error message descriptors for visiting erring functions.
|
|
Each error descriptor is a list of length two.
|
|
Its car is a marker pointing to an error message.
|
|
Its cadr is a marker pointing to the text of the line the message is about,
|
|
or nil if that is not interesting.
|
|
The value may be t instead of a list;
|
|
this means that the buffer of error messages should be reparsed
|
|
the next time the list of errors is wanted.")
|
|
|
|
(defvar compilation-parsing-end nil
|
|
"Position of end of buffer when last error messages parsed.")
|
|
|
|
(defvar compilation-error-message nil
|
|
"Message to print when no more matches for compilation-error-regexp are found")
|
|
|
|
;; The filename excludes colons to avoid confusion when error message
|
|
;; starts with digits.
|
|
(defvar compilation-error-regexp
|
|
"\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)"
|
|
"Regular expression for filename/linenumber in error in compilation log.")
|
|
|
|
(defun compile (command)
|
|
"Compile the program including the current buffer. Default: run `make'.
|
|
Runs COMMAND, a shell command, in a separate process asynchronously
|
|
with output going to the buffer *compilation*.
|
|
You can then use the command \\[next-error] to find the next error message
|
|
and move to the source code that caused it."
|
|
(interactive (list (read-string "Compile command: " compile-command)))
|
|
(setq compile-command command)
|
|
(compile1 compile-command "No more errors"))
|
|
|
|
(defun grep (command)
|
|
"Run grep, with user-specified args, and collect output in a buffer.
|
|
While grep runs asynchronously, you can use the \\[next-error] command
|
|
to find the text that grep hits refer to."
|
|
(interactive "sRun grep (with args): ")
|
|
(compile1 (concat "grep -n " command " /dev/null")
|
|
"No more grep hits" "grep"))
|
|
|
|
(defun compile1 (command error-message &optional name-of-mode)
|
|
(save-some-buffers)
|
|
(if compilation-process
|
|
(if (or (not (eq (process-status compilation-process) 'run))
|
|
(yes-or-no-p "A compilation process is running; kill it? "))
|
|
(condition-case ()
|
|
(let ((comp-proc compilation-process))
|
|
(interrupt-process comp-proc)
|
|
(sit-for 1)
|
|
(delete-process comp-proc))
|
|
(error nil))
|
|
(error "Cannot have two compilation processes")))
|
|
(setq compilation-process nil)
|
|
(compilation-forget-errors)
|
|
(setq compilation-error-list t)
|
|
(setq compilation-error-message error-message)
|
|
(setq compilation-process
|
|
(start-process "compilation" "*compilation*"
|
|
shell-file-name
|
|
"-c" (concat "exec " command)))
|
|
(with-output-to-temp-buffer "*compilation*"
|
|
(princ "cd ")
|
|
(princ default-directory)
|
|
(terpri)
|
|
(princ command)
|
|
(terpri))
|
|
(set-process-sentinel compilation-process 'compilation-sentinel)
|
|
(let* ((thisdir default-directory)
|
|
(outbuf (process-buffer compilation-process))
|
|
(outwin (get-buffer-window outbuf))
|
|
(regexp compilation-error-regexp))
|
|
(if (eq outbuf (current-buffer))
|
|
(goto-char (point-max)))
|
|
(save-excursion
|
|
(set-buffer outbuf)
|
|
(buffer-flush-undo outbuf)
|
|
(let ((start (save-excursion (set-buffer outbuf) (point-min))))
|
|
(set-window-start outwin start)
|
|
(or (eq outwin (selected-window))
|
|
(set-window-point outwin start)))
|
|
(setq default-directory thisdir)
|
|
(fundamental-mode)
|
|
(make-local-variable 'compilation-error-regexp)
|
|
(setq compilation-error-regexp regexp)
|
|
(setq mode-name (or name-of-mode "Compilation"))
|
|
;; Make log buffer's mode line show process state
|
|
(setq mode-line-process '(": %s")))))
|
|
|
|
;; Called when compilation process changes state.
|
|
|
|
(defun compilation-sentinel (proc msg)
|
|
(cond ((null (buffer-name (process-buffer proc)))
|
|
;; buffer killed
|
|
(set-process-buffer proc nil))
|
|
((memq (process-status proc) '(signal exit))
|
|
(let* ((obuf (current-buffer))
|
|
omax opoint)
|
|
;; save-excursion isn't the right thing if
|
|
;; process-buffer is current-buffer
|
|
(unwind-protect
|
|
(progn
|
|
;; Write something in *compilation* and hack its mode line,
|
|
(set-buffer (process-buffer proc))
|
|
(setq omax (point-max) opoint (point))
|
|
(goto-char (point-max))
|
|
(insert ?\n mode-name " " msg)
|
|
(forward-char -1)
|
|
(insert " at "
|
|
(substring (current-time-string) 0 -5))
|
|
(forward-char 1)
|
|
(setq mode-line-process
|
|
(concat ": "
|
|
(symbol-name (process-status proc))))
|
|
;; If buffer and mode line will show that the process
|
|
;; is dead, we can delete it now. Otherwise it
|
|
;; will stay around until M-x list-processes.
|
|
(delete-process proc))
|
|
(setq compilation-process nil)
|
|
;; Force mode line redisplay soon
|
|
(set-buffer-modified-p (buffer-modified-p)))
|
|
(if (and opoint (< opoint omax))
|
|
(goto-char opoint))
|
|
(set-buffer obuf)))))
|
|
|
|
(defun kill-compilation ()
|
|
"Kill the process made by the \\[compile] command."
|
|
(interactive)
|
|
(if compilation-process
|
|
(interrupt-process compilation-process)))
|
|
|
|
(defun kill-grep ()
|
|
"Kill the process made by the \\[grep] command."
|
|
(interactive)
|
|
(if compilation-process
|
|
(interrupt-process compilation-process)))
|
|
|
|
(defun next-error (&optional argp)
|
|
"Visit next compilation error message and corresponding source code.
|
|
This operates on the output from the \\[compile] command.
|
|
If all preparsed error messages have been processed,
|
|
the error message buffer is checked for new ones.
|
|
A non-nil argument (prefix arg, if interactive)
|
|
means reparse the error message buffer and start at the first error."
|
|
(interactive "P")
|
|
(if (or (eq compilation-error-list t)
|
|
argp)
|
|
(progn (compilation-forget-errors)
|
|
(setq compilation-parsing-end 1)))
|
|
(if compilation-error-list
|
|
nil
|
|
(save-excursion
|
|
(set-buffer "*compilation*")
|
|
(set-buffer-modified-p nil)
|
|
(compilation-parse-errors)))
|
|
(let ((next-error (car compilation-error-list)))
|
|
(if (null next-error)
|
|
(error (concat compilation-error-message
|
|
(if (and compilation-process
|
|
(eq (process-status compilation-process)
|
|
'run))
|
|
" yet" ""))))
|
|
(setq compilation-error-list (cdr compilation-error-list))
|
|
(if (null (car (cdr next-error)))
|
|
nil
|
|
(switch-to-buffer (marker-buffer (car (cdr next-error))))
|
|
(goto-char (car (cdr next-error)))
|
|
(set-marker (car (cdr next-error)) nil))
|
|
(let* ((pop-up-windows t)
|
|
(w (display-buffer (marker-buffer (car next-error)))))
|
|
(set-window-point w (car next-error))
|
|
(set-window-start w (car next-error)))
|
|
(set-marker (car next-error) nil)))
|
|
|
|
;; Set compilation-error-list to nil, and
|
|
;; unchain the markers that point to the error messages and their text,
|
|
;; so that they no longer slow down gap motion.
|
|
;; This would happen anyway at the next garbage collection,
|
|
;; but it is better to do it right away.
|
|
(defun compilation-forget-errors ()
|
|
(if (eq compilation-error-list t)
|
|
(setq compilation-error-list nil))
|
|
(while compilation-error-list
|
|
(let ((next-error (car compilation-error-list)))
|
|
(set-marker (car next-error) nil)
|
|
(if (car (cdr next-error))
|
|
(set-marker (car (cdr next-error)) nil)))
|
|
(setq compilation-error-list (cdr compilation-error-list))))
|
|
|
|
(defun compilation-parse-errors ()
|
|
"Parse the current buffer as error messages.
|
|
This makes a list of error descriptors, compilation-error-list.
|
|
For each source-file, line-number pair in the buffer,
|
|
the source file is read in, and the text location is saved in compilation-error-list.
|
|
The function next-error, assigned to \\[next-error], takes the next error off the list
|
|
and visits its location."
|
|
(setq compilation-error-list nil)
|
|
(message "Parsing error messages...")
|
|
(let (text-buffer
|
|
last-filename last-linenum)
|
|
;; Don't reparse messages already seen at last parse.
|
|
(goto-char compilation-parsing-end)
|
|
;; Don't parse the first two lines as error messages.
|
|
;; This matters for grep.
|
|
(if (bobp)
|
|
(forward-line 2))
|
|
(while (re-search-forward compilation-error-regexp nil t)
|
|
(let (linenum filename
|
|
error-marker text-marker)
|
|
;; Extract file name and line number from error message.
|
|
(save-restriction
|
|
(narrow-to-region (match-beginning 0) (match-end 0))
|
|
(goto-char (point-max))
|
|
(skip-chars-backward "[0-9]")
|
|
;; If it's a lint message, use the last file(linenum) on the line.
|
|
;; Normally we use the first on the line.
|
|
(if (= (preceding-char) ?\()
|
|
(progn
|
|
(narrow-to-region (point-min) (1+ (buffer-size)))
|
|
(end-of-line)
|
|
(re-search-backward compilation-error-regexp)
|
|
(skip-chars-backward "^ \t\n")
|
|
(narrow-to-region (point) (match-end 0))
|
|
(goto-char (point-max))
|
|
(skip-chars-backward "[0-9]")))
|
|
;; Are we looking at a "filename-first" or "line-number-first" form?
|
|
(if (looking-at "[0-9]")
|
|
(progn
|
|
(setq linenum (read (current-buffer)))
|
|
(goto-char (point-min)))
|
|
;; Line number at start, file name at end.
|
|
(progn
|
|
(goto-char (point-min))
|
|
(setq linenum (read (current-buffer)))
|
|
(goto-char (point-max))
|
|
(skip-chars-backward "^ \t\n")))
|
|
(setq filename (compilation-grab-filename)))
|
|
;; Locate the erring file and line.
|
|
(if (and (equal filename last-filename)
|
|
(= linenum last-linenum))
|
|
nil
|
|
(beginning-of-line 1)
|
|
(setq error-marker (point-marker))
|
|
;; text-buffer gets the buffer containing this error's file.
|
|
(if (not (equal filename last-filename))
|
|
(setq text-buffer
|
|
(and (file-exists-p (setq last-filename filename))
|
|
(find-file-noselect filename))
|
|
last-linenum 0))
|
|
(if text-buffer
|
|
;; Go to that buffer and find the erring line.
|
|
(save-excursion
|
|
(set-buffer text-buffer)
|
|
(if (zerop last-linenum)
|
|
(progn
|
|
(goto-char 1)
|
|
(setq last-linenum 1)))
|
|
;; Move the right number of lines from the old position.
|
|
;; If we can't move that many, put 0 in last-linenum
|
|
;; so the next error message will be handled starting from
|
|
;; scratch.
|
|
(if (eq selective-display t)
|
|
(or (re-search-forward "[\n\C-m]" nil 'end
|
|
(- linenum last-linenum))
|
|
(setq last-linenum 0))
|
|
(or (= 0 (forward-line (- linenum last-linenum)))
|
|
(setq last-linenum 0)))
|
|
(setq last-linenum linenum)
|
|
(setq text-marker (point-marker))
|
|
(setq compilation-error-list
|
|
(cons (list error-marker text-marker)
|
|
compilation-error-list)))))
|
|
(forward-line 1)))
|
|
(setq compilation-parsing-end (point-max)))
|
|
(message "Parsing error messages...done")
|
|
(setq compilation-error-list (nreverse compilation-error-list)))
|
|
|
|
(defun compilation-grab-filename ()
|
|
"Return a string which is a filename, starting at point.
|
|
Ignore quotes and parentheses around it, as well as trailing colons."
|
|
(if (eq (following-char) ?\")
|
|
(save-restriction
|
|
(narrow-to-region (point)
|
|
(progn (forward-sexp 1) (point)))
|
|
(goto-char (point-min))
|
|
(read (current-buffer)))
|
|
(buffer-substring (point)
|
|
(progn
|
|
(skip-chars-forward "^ :,\n\t(")
|
|
(point)))))
|
|
|
|
(define-key ctl-x-map "`" 'next-error)
|