compile.el 31.1 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
Eric S. Raymond's avatar
Eric S. Raymond committed
2

Roland McGrath's avatar
Roland McGrath committed
3
;;;!!! dup removal is broken.
Eric S. Raymond's avatar
Eric S. Raymond committed
4

Roland McGrath's avatar
Roland McGrath committed
5
;; Copyright (C) 1985-1991 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
6 7 8 9

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
Roland McGrath's avatar
Roland McGrath committed
10 11 12 13 14 15 16 17 18 19 20 21 22
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.
Richard M. Stallman's avatar
Richard M. Stallman committed
23

Roland McGrath's avatar
Roland McGrath committed
24 25 26 27 28
;;;###autoload
(defvar compilation-mode-hook nil
  "*List of hook functions run by compilation-mode (see `run-hooks').")

;;;###autoload
Roland McGrath's avatar
Roland McGrath committed
29 30 31
(defconst compilation-window-height nil
  "*Number of lines in a compilation window.  If nil, use Emacs default.")

Richard M. Stallman's avatar
Richard M. Stallman committed
32 33
(defvar compilation-error-list nil
  "List of error message descriptors for visiting erring functions.
Roland McGrath's avatar
Roland McGrath committed
34
Each error descriptor is a cons (or nil).
Richard M. Stallman's avatar
Richard M. Stallman committed
35
Its car is a marker pointing to an error message.
Roland McGrath's avatar
Roland McGrath committed
36 37 38 39 40 41 42
If its cdr is a marker, it points to the text of the line the message is about.
If its cdr is a cons, that cons's car is a cons (DIRECTORY . FILE), specifying
file the message is about, and its cdr is the number of the line the message
is about.  Or its cdr may be nil if that error 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.")
Richard M. Stallman's avatar
Richard M. Stallman committed
43 44 45 46

(defvar compilation-old-error-list nil
  "Value of `compilation-error-list' after errors were parsed.")

Roland McGrath's avatar
Roland McGrath committed
47 48 49 50 51
(defvar compilation-parse-errors-function 'compilation-parse-errors 
  "Function to call (with no args) to parse error messages from a compilation.
It should read in the source files which have errors and set
`compilation-error-list' to a list with an element for each error message
found.  See that variable for more info.")
Richard M. Stallman's avatar
Richard M. Stallman committed
52

Jim Blandy's avatar
Jim Blandy committed
53
;;;###autoload
Roland McGrath's avatar
Roland McGrath committed
54
(defvar compilation-buffer-name-function nil
Jim Blandy's avatar
Jim Blandy committed
55
  "*Function to call with one argument, the name of the major mode of the
Roland McGrath's avatar
Roland McGrath committed
56 57 58
compilation buffer, to give the buffer a name.  It should return a string.
If nil, the name \"*compilation*\" is used for compilation buffers,
and the name \"*grep*\" is used for grep buffers.
Jim Blandy's avatar
Jim Blandy committed
59
\(Actually, the name (concat \"*\" (downcase major-mode) \"*\") is used.)")
Richard M. Stallman's avatar
Richard M. Stallman committed
60

Jim Blandy's avatar
Jim Blandy committed
61
;;;###autoload
Roland McGrath's avatar
Roland McGrath committed
62
(defvar compilation-finish-function nil
Jim Blandy's avatar
Jim Blandy committed
63
  "*Function to call when a compilation process finishes.
Roland McGrath's avatar
Roland McGrath committed
64 65
It is called with two arguments: the compilation buffer, and a string
describing how the process finished.")
Richard M. Stallman's avatar
Richard M. Stallman committed
66

Roland McGrath's avatar
Roland McGrath committed
67 68 69
(defvar compilation-last-buffer nil
  "The buffer in which the last compilation was started,
or which was used by the last \\[next-error] or \\[compile-goto-error].")
Richard M. Stallman's avatar
Richard M. Stallman committed
70

Roland McGrath's avatar
Roland McGrath committed
71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
(defvar compilation-parsing-end nil
  "Position of end of buffer when last error messages were parsed.")

(defvar compilation-error-message "No more errors"
  "Message to print when no more matches for `compilation-error-regexp-alist'
are found.")

(defvar compilation-error-regexp-alist
  '(
    ;; 4.3BSD grep, cc, lint pass 1:
    ;; /usr/src/foo/foo.c(8): warning: w may be used before set
    ;; or GNU utilities
    ;; foo.c:8: error message
    ("^\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)
    ;; 4.3BSD lint pass 2
    ;; strcmp: variable # of args. llib-lc(359)  ::  /usr/src/foo/foo.c(8)
Jim Blandy's avatar
Jim Blandy committed
87
    ("[ \t:]+\\([^:( \t\n]+\\)[ \t]*[:(]*(+[ \t]*\\([0-9]+\\))[:) \t]*$" 1 2)
Roland McGrath's avatar
Roland McGrath committed
88 89
    ;; 4.3BSD lint pass 3
    ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used
Jim Blandy's avatar
Jim Blandy committed
90 91 92 93
    ;; This used to be
    ;; ("[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2)
    ;; which is regexp Impressionism - it matches almost anything!
    ("([ \t]*\\([^:( \t\n]+\\)[ \t]*[:(][ \t]*\\([0-9]+\\))" 1 2)
Roland McGrath's avatar
Roland McGrath committed
94
    ;; Line 45 of "foo.c": bloofel undefined (who does this?)
Jim Blandy's avatar
Jim Blandy committed
95
    ("^[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+of[ \t]+\"\\([^\"\n]+\\)\":" 2 1)
Roland McGrath's avatar
Roland McGrath committed
96 97
    ;; Apollo cc, 4.3BSD fc
    ;; "foo.f", line 3: Error: syntax error near end of statement
Jim Blandy's avatar
Jim Blandy committed
98
    ("^\"\\([^\"\n]+\\)\", line \\([0-9]+\\):" 1 2)
Roland McGrath's avatar
Roland McGrath committed
99 100
    ;; HP-UX 7.0 fc
    ;; foo.f          :16    some horrible error message
Jim Blandy's avatar
Jim Blandy committed
101
    ("^\\([^ \t\n:]+\\)[ \t]*:\\([0-9]+\\)" 1 2)
Roland McGrath's avatar
Roland McGrath committed
102 103
    ;; IBM AIX PS/2 C version 1.1
    ;; ****** Error number 140 in line 8 of file errors.c ******
Jim Blandy's avatar
Jim Blandy committed
104
    ("in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
Roland McGrath's avatar
Roland McGrath committed
105 106 107 108 109 110
    ;; IBM AIX lint is too painful to do right this way.  File name
    ;; prefixes entire sections rather than being on each line.
    )
  "Alist (REGEXP FILE-IDX LINE-IDX) of regular expressions to match errors in
compilation.  If REGEXP matches, the FILE-IDX'th subexpression gives the file
name, and the LINE-IDX'th subexpression gives the line number.")
Richard M. Stallman's avatar
Richard M. Stallman committed
111

Roland McGrath's avatar
Roland McGrath committed
112
;;;###autoload
Roland McGrath's avatar
Roland McGrath committed
113
(defvar compilation-search-path '(nil)
Roland McGrath's avatar
Roland McGrath committed
114
  "*List of directories to search for source files named in error messages.
Roland McGrath's avatar
Roland McGrath committed
115 116
Elements should be directory names, not file names of directories.
nil as an element means to try the default directory.")
Richard M. Stallman's avatar
Richard M. Stallman committed
117 118 119 120 121 122 123 124 125 126 127 128 129 130

(defvar compile-command "make -k "
  "Last shell command used to do a compilation; default for next compilation.

Sometimes it is useful for files to supply local values for this variable.
You might also use mode hooks to specify it in certain modes, like this:

    (setq c-mode-hook
      '(lambda () (or (file-exists-p \"makefile\") (file-exists-p \"Makefile\")
		      (progn (make-local-variable 'compile-command)
			     (setq compile-command
				    (concat \"make -k \"
					    buffer-file-name))))))")

Roland McGrath's avatar
Roland McGrath committed
131 132 133 134 135 136 137
;;;###autoload
(defvar grep-command "grep -n "
  "Last shell command used to do a grep search; default for next search.
Typically \"grep -n\" or \"egrep -n\".
\(The \"-n\" option tells grep to output line numbers.)")

(defconst compilation-enter-directory-regexp
Jim Blandy's avatar
Jim Blandy committed
138
  ": Entering directory `\\(.*\\)'$"
Roland McGrath's avatar
Roland McGrath committed
139
  "Regular expression for a line in the compilation log that
Jim Blandy's avatar
Jim Blandy committed
140
changes the current directory.  This must contain one \\(, \\) pair
Roland McGrath's avatar
Roland McGrath committed
141 142 143 144 145
around the directory name.

The default value matches lines printed by the `-w' option of GNU Make.")

(defconst compilation-leave-directory-regexp
Jim Blandy's avatar
Jim Blandy committed
146
  ": Leaving directory `\\(.*\\)'$"
Roland McGrath's avatar
Roland McGrath committed
147 148
  "Regular expression for a line in the compilation log that
changes the current directory to a previous value.  This may
Jim Blandy's avatar
Jim Blandy committed
149
contain one \\(, \\) pair around the name of the directory
Roland McGrath's avatar
Roland McGrath committed
150 151 152 153 154 155 156 157 158 159 160 161
being moved from.  If it does not, the last directory entered
\(by a line matching `compilation-enter-directory-regexp'\) is assumed.

The default value matches lines printed by the `-w' option of GNU Make.")

(defvar compilation-directory-stack nil
  "Stack of directories entered by lines matching
\`compilation-enter-directory-regexp' and not yet left by lines matching
\`compilation-leave-directory-regexp'.  The head element is the directory
the compilation was started in.")

;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
162 163 164 165
(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*'.
Roland McGrath's avatar
Roland McGrath committed
166

Richard M. Stallman's avatar
Richard M. Stallman committed
167 168 169 170
You can then use the command \\[next-error] to find the next error message
and move to the source code that caused it.

To run more than one compilation at once, start one and rename the
Roland McGrath's avatar
Roland McGrath committed
171 172 173 174 175 176
\`*compilation*' buffer to some other name with \\[rename-buffer].
Then start the next one.

The name used for the buffer is actually whatever is returned by
the function in `compilation-buffer-name-function', so you can set that
to a function that generates a unique name."
Richard M. Stallman's avatar
Richard M. Stallman committed
177 178 179
  (interactive (list (read-string "Compile command: " compile-command)))
  (setq compile-command command)
  (save-some-buffers nil nil)
Roland McGrath's avatar
Roland McGrath committed
180
  (compile-internal compile-command "No more errors"))
Richard M. Stallman's avatar
Richard M. Stallman committed
181

Roland McGrath's avatar
Roland McGrath committed
182
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
183 184 185
(defun grep (command-args)
  "Run grep, with user-specified args, and collect output in a buffer.
While grep runs asynchronously, you can use the \\[next-error] command
Roland McGrath's avatar
Roland McGrath committed
186 187 188 189 190 191 192
to find the text that grep hits refer to.

The variable `grep-command' holds the last grep command run,
and is the default for future runs.  The command should use the `-n'
flag, so that line numbers are displayed for each match.
What the user enters in response to the prompt for grep args is
appended to everything up to and including the `-n' in `grep-command'."
Richard M. Stallman's avatar
Richard M. Stallman committed
193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
  (interactive
   (list (read-string (concat "Run "
			      (substring grep-command 0
					 (string-match "[\t ]+" grep-command))
			      " (with args): ")
		      (progn
			(string-match "-n[\t ]+" grep-command)
			(substring grep-command (match-end 0))))))
  ;; why a redundant string-match?  It might not be interactive ...
  (setq grep-command (concat (substring grep-command 0
					(progn
					  (string-match "-n" grep-command)
					  (match-end 0)))
			     " " command-args))
  (compile-internal (concat grep-command " /dev/null")
		    "No more grep hits" "grep"))

(defun compile-internal (command error-message
Roland McGrath's avatar
Roland McGrath committed
211 212
				 &optional name-of-mode parser regexp-alist
				 name-function)
Richard M. Stallman's avatar
Richard M. Stallman committed
213 214 215
  "Run compilation command COMMAND (low level interface).
ERROR-MESSAGE is a string to print if the user asks to see another error
and there are no more errors.  Third argument NAME-OF-MODE is the name
Roland McGrath's avatar
Roland McGrath committed
216 217 218 219 220 221 222 223 224
to display as the major mode in the compilation buffer.

Fourth arg PARSER is the error parser function (nil means the default).  Fifth
arg REGEXP-ALIST is the error message regexp alist to use (nil means the
default).  Sixth arg NAME-FUNCTION is a function called to name the buffer (nil
means the default).  The defaults for these variables are the global values of
\`compilation-parse-errors-function', `compilation-error-regexp-alist', and
\`compilation-buffer-name-function', respectively."
  (let (outbuf)
Richard M. Stallman's avatar
Richard M. Stallman committed
225
    (save-excursion
Roland McGrath's avatar
Roland McGrath committed
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271
      (or name-of-mode
	  (setq name-of-mode "Compilation"))
      (setq outbuf
	    (get-buffer-create
	     (funcall (or name-function compilation-buffer-name-function
			  (function (lambda (mode)
				      (concat "*" (downcase mode) "*"))))
		      name-of-mode)))
      (set-buffer outbuf)
      (let ((comp-proc (get-buffer-process (current-buffer))))
	(if comp-proc
	    (if (or (not (eq (process-status comp-proc) 'run))
		    (yes-or-no-p
		     "A compilation process is running; kill it? "))
		(condition-case ()
		    (progn
		      (interrupt-process comp-proc)
		      (sit-for 1)
		      (delete-process comp-proc))
		  (error nil))
	      (error "Cannot have two processes in `%s' at once"
		     (buffer-name))
	      )))
      ;; In case the compilation buffer is current, make sure we get the global
      ;; values of compilation-error-regexp-alist, etc.
      (kill-all-local-variables))
    (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist))
	  (parser (or parser compilation-parse-errors-function))
	  (thisdir default-directory)
	  outwin) 
      (save-excursion
	;; Clear out the compilation buffer and make it writable.
	;; Change its default-directory to the directory where the compilation
	;; will happen, and insert a `cd' command to indicate this.
	(set-buffer outbuf)
	(setq buffer-read-only nil)
	(erase-buffer)
	(setq default-directory thisdir)
	(insert "cd " thisdir "\n" command "\n")
	(set-buffer-modified-p nil))
      ;; If we're already in the compilation buffer, go to the end
      ;; of the buffer, so point will track the compilation output.
      (if (eq outbuf (current-buffer))
	  (goto-char (point-max)))
      ;; Pop up the compilation buffer.
      (setq outwin (display-buffer outbuf))
Richard M. Stallman's avatar
Richard M. Stallman committed
272 273
      (set-buffer outbuf)
      (compilation-mode)
Eric S. Raymond's avatar
Eric S. Raymond committed
274
      (buffer-disable-undo (current-buffer))
Jim Blandy's avatar
Jim Blandy committed
275
      (setq buffer-read-only t)
Roland McGrath's avatar
Roland McGrath committed
276 277 278 279 280
      (set (make-local-variable 'compilation-parse-errors-function) parser)
      (set (make-local-variable 'compilation-error-message) error-message)
      (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist)
      (setq default-directory thisdir
	    compilation-directory-stack (list default-directory))
Richard M. Stallman's avatar
Richard M. Stallman committed
281
      (set-window-start outwin (point-min))
Roland McGrath's avatar
Roland McGrath committed
282
      (setq mode-name name-of-mode)
Richard M. Stallman's avatar
Richard M. Stallman committed
283
      (or (eq outwin (selected-window))
Roland McGrath's avatar
Roland McGrath committed
284 285 286 287 288 289 290 291 292 293 294
	  (set-window-point outwin (point-min)))
      (and compilation-window-height
	   (= (window-width outwin) (screen-width))
	   (let ((w (selected-window)))
	     (unwind-protect
		 (progn
		   (select-window outwin)
		   (enlarge-window (- compilation-window-height
				      (window-height))))
	       (select-window w))))
      ;; Start the compilation.
Jim Blandy's avatar
Jim Blandy committed
295 296 297
      (set-process-sentinel (start-process-shell-command (downcase mode-name)
							 outbuf
							 command)
Roland McGrath's avatar
Roland McGrath committed
298 299 300
			    'compilation-sentinel))
    ;; Make it so the next C-x ` will use this buffer.
    (setq compilation-last-buffer outbuf)))
Richard M. Stallman's avatar
Richard M. Stallman committed
301 302 303 304

(defvar compilation-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-c" 'compile-goto-error)
Roland McGrath's avatar
Roland McGrath committed
305
    (define-key map "\C-c\C-k" 'kill-compilation)
Richard M. Stallman's avatar
Richard M. Stallman committed
306 307 308 309 310 311
    map)
  "Keymap for compilation log buffers.")

(defun compilation-mode ()
  "Major mode for compilation log buffers.
\\<compilation-mode-map>To visit the source for a line-numbered error,
Roland McGrath's avatar
Roland McGrath committed
312
move point to the error message line and type \\[compile-goto-error].
Roland McGrath's avatar
Roland McGrath committed
313 314 315
To kill the compilation, type \\[kill-compilation].

Runs `compilation-mode-hook' with `run-hooks' (which see)."
Richard M. Stallman's avatar
Richard M. Stallman committed
316 317 318 319 320
  (interactive)
  (fundamental-mode)
  (use-local-map compilation-mode-map)
  (setq major-mode 'compilation-mode)
  (setq mode-name "Compilation")
Roland McGrath's avatar
Roland McGrath committed
321 322 323 324 325 326
  ;; Make buffer's mode line show process state
  (setq mode-line-process '(": %s"))
  (set (make-local-variable 'compilation-error-list) nil)
  (set (make-local-variable 'compilation-old-error-list) nil)
  (set (make-local-variable 'compilation-parsing-end) 1)
  (set (make-local-variable 'compilation-directory-stack) nil)
Roland McGrath's avatar
Roland McGrath committed
327 328
  (setq compilation-last-buffer (current-buffer))
  (run-hooks 'compilation-mode-hook))
Richard M. Stallman's avatar
Richard M. Stallman committed
329 330 331

;; Called when compilation process changes state.
(defun compilation-sentinel (proc msg)
Roland McGrath's avatar
Roland McGrath committed
332 333 334 335 336 337 338 339 340 341 342 343 344 345 346
  "Sentinel for compilation buffers."
  (let ((buffer (process-buffer proc)))
    (cond ((null (buffer-name buffer))
	   ;; 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 the compilation buffer
		   ;; and hack its mode line.
		   (set-buffer buffer)
Jim Blandy's avatar
Jim Blandy committed
347
		   (setq buffer-read-only nil)
Roland McGrath's avatar
Roland McGrath committed
348 349 350
		   (setq omax (point-max)
			 opoint (point))
		   (goto-char omax)
Jim Blandy's avatar
Jim Blandy committed
351 352
		   ;; Record where we put the message, so we can ignore it
		   ;; later on.
Roland McGrath's avatar
Roland McGrath committed
353 354 355 356 357 358 359 360 361 362 363 364
		   (insert ?\n mode-name " " msg)
		   (forward-char -1)
		   (insert " at " (substring (current-time-string) 0 19))
		   (forward-char 1)
		   (setq mode-line-process
			 (concat ": "
				 (symbol-name (process-status proc))))
		   ;; Since the 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))
	       ;; Force mode line redisplay soon.
Jim Blandy's avatar
Jim Blandy committed
365 366
	       (set-buffer-modified-p (buffer-modified-p))
	       (setq buffer-read-only t))
Roland McGrath's avatar
Roland McGrath committed
367 368 369 370 371 372 373
	     (if (and opoint (< opoint omax))
		 (goto-char opoint))
	     (set-buffer obuf)
	     (if compilation-finish-function
		 (funcall compilation-finish-function buffer msg))
	     ))
	  )))
Richard M. Stallman's avatar
Richard M. Stallman committed
374 375 376 377

(defun kill-compilation ()
  "Kill the process made by the \\[compile] command."
  (interactive)
Roland McGrath's avatar
Roland McGrath committed
378
  (let ((buffer (compilation-find-buffer)))
Richard M. Stallman's avatar
Richard M. Stallman committed
379
    (if (get-buffer-process buffer)
Roland McGrath's avatar
Roland McGrath committed
380 381 382
	(interrupt-process (get-buffer-process buffer))
      (error "The compilation process is not running."))))

Richard M. Stallman's avatar
Richard M. Stallman committed
383

Roland McGrath's avatar
Roland McGrath committed
384 385
;; Parse any new errors in the compilation buffer,
;; or reparse from the beginning if the user has asked for that.
Richard M. Stallman's avatar
Richard M. Stallman committed
386
(defun compile-reinitialize-errors (argp)
Roland McGrath's avatar
Roland McGrath committed
387 388 389 390 391 392 393 394 395 396 397 398 399
  (save-excursion
    (set-buffer compilation-last-buffer)
    ;; If we are out of errors, or if user says "reparse",
    ;; discard the info we have, to force reparsing.
    (if (or (eq compilation-error-list t)
	    (consp argp))
	(progn (compilation-forget-errors)
	       (setq compilation-parsing-end 1)))
    (if compilation-error-list
	;; Since compilation-error-list is non-nil, it points to a specific
	;; error the user wanted.  So don't move it around.
	nil
      (switch-to-buffer compilation-last-buffer)
Richard M. Stallman's avatar
Richard M. Stallman committed
400 401
      (set-buffer-modified-p nil)
      (let ((at-start (= compilation-parsing-end 1)))
Roland McGrath's avatar
Roland McGrath committed
402
	(funcall compilation-parse-errors-function)
Richard M. Stallman's avatar
Richard M. Stallman committed
403 404 405 406 407 408 409 410 411 412 413 414 415
	;; Remember the entire list for compilation-forget-errors.
	;; If this is an incremental parse, append to previous list.
	(if at-start
	    (setq compilation-old-error-list compilation-error-list)
	  (setq compilation-old-error-list
		(nconc compilation-old-error-list compilation-error-list)))))))

(defun compile-goto-error (&optional argp)
  "Visit the source for the error message point is on.
Use this command in a compilation log buffer.
C-u as a prefix arg means to reparse the buffer's error messages first;
other kinds of prefix arguments are ignored."
  (interactive "P")
Roland McGrath's avatar
Roland McGrath committed
416 417 418
  (or (compilation-buffer-p (current-buffer))
      (error "Not in a compilation buffer."))
  (setq compilation-last-buffer (current-buffer))
Richard M. Stallman's avatar
Richard M. Stallman committed
419 420 421
  (compile-reinitialize-errors argp)
  (save-excursion
    (beginning-of-line)
Roland McGrath's avatar
Roland McGrath committed
422 423
    ;; Move compilation-error-list to the elt of
    ;; compilation-old-error-list whose car is the error we want.
Richard M. Stallman's avatar
Richard M. Stallman committed
424
    (setq compilation-error-list
Roland McGrath's avatar
Roland McGrath committed
425 426 427 428 429 430 431 432
	  (memq (let (elt)
		  (while (not (or (setq elt (assoc (point-marker)
						   compilation-old-error-list))
				  (eobp)))
		    ;; This line doesn't contain an error.
		    ;; Move forward a line and look again.
		    (forward-line 1))
		  elt)
Richard M. Stallman's avatar
Richard M. Stallman committed
433 434 435 436 437 438 439
		compilation-old-error-list)))
  ;; Move to another window, so that next-error's window changes
  ;; result in the desired setup.
  (or (one-window-p)
      (other-window -1))
  (next-error 1))

Roland McGrath's avatar
Roland McGrath committed
440 441 442 443 444 445 446 447
(defun compilation-buffer-p (buffer)
  (assq 'compilation-error-list (buffer-local-variables buffer)))

;; Return a compilation buffer.
;; If the current buffer is a compilation buffer, return it.
;; If compilation-last-buffer is set to a live buffer, use that.
;; Otherwise, look for a compilation buffer and signal an error
;; if there are none.
Jim Blandy's avatar
Jim Blandy committed
448 449 450
(defun compilation-find-buffer (&optional other-buffer)
  (if (and (not other-buffer)
	   (compilation-buffer-p (current-buffer)))
Roland McGrath's avatar
Roland McGrath committed
451 452
      ;; The current buffer is a compilation buffer.
      (current-buffer)
Jim Blandy's avatar
Jim Blandy committed
453 454 455
    (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
	     (or (not other-buffer) (not (eq compilation-last-buffer
					     (current-buffer)))))
Roland McGrath's avatar
Roland McGrath committed
456 457
	compilation-last-buffer
      (let ((buffers (buffer-list)))
Jim Blandy's avatar
Jim Blandy committed
458 459 460
	(while (and buffers (or (not (compilation-buffer-p (car buffers)))
				(and other-buffer
				     (eq (car buffers) (current-buffer)))))
Roland McGrath's avatar
Roland McGrath committed
461 462 463
	  (setq buffers (cdr buffers)))
	(if buffers
	    (car buffers)
Jim Blandy's avatar
Jim Blandy committed
464 465 466 467 468 469 470 471
	  (or (and other-buffer
		   (compilation-buffer-p (current-buffer))
		   ;; The current buffer is a compilation buffer.
		   (progn
		     (if other-buffer
			 (message "This is the only compilation buffer."))
		     (current-buffer)))
	      (error "No compilation started!")))))))
Roland McGrath's avatar
Roland McGrath committed
472 473

;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491
(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 prefix arg specifies how many error messages to move;
negative means move back to previous error messages.
Just C-u as a prefix means reparse the error message buffer
and start at the first error.

\\[next-error] normally applies to the most recent compilation started,
but as long as you are in the middle of parsing errors from one compilation
output buffer, you stay with that compilation output buffer.

Use \\[next-error] in a compilation output buffer to switch to
processing errors from that compilation.

Roland McGrath's avatar
Roland McGrath committed
492 493
See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
Richard M. Stallman's avatar
Richard M. Stallman committed
494
  (interactive "P")
Roland McGrath's avatar
Roland McGrath committed
495
  (setq compilation-last-buffer (compilation-find-buffer))
Richard M. Stallman's avatar
Richard M. Stallman committed
496
  (compile-reinitialize-errors argp)
Roland McGrath's avatar
Roland McGrath committed
497 498 499 500
  ;; Make ARGP nil if the prefix arg was just C-u,
  ;; since that means to reparse the errors, which the
  ;; compile-reinitialize-errors call just did.
  ;; Now we are only interested in a numeric prefix arg.
Richard M. Stallman's avatar
Richard M. Stallman committed
501 502
  (if (consp argp)
      (setq argp nil))
Roland McGrath's avatar
Roland McGrath committed
503 504 505 506 507 508 509 510 511 512
  (let (next-errors next-error)
    (save-excursion
      (set-buffer compilation-last-buffer)
      (setq next-errors (nthcdr (+ (- (length compilation-old-error-list)
				      (length compilation-error-list)
				      1)
				   (prefix-numeric-value argp))
				compilation-old-error-list)
	    next-error (car next-errors))
      (while
Richard M. Stallman's avatar
Richard M. Stallman committed
513
	  (progn
Roland McGrath's avatar
Roland McGrath committed
514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604
	    (if (null next-error)
		(progn
		  (if argp (if (> (prefix-numeric-value argp) 0)
			       (error "Moved past last error")
			     (error "Moved back past first error")))
		  (compilation-forget-errors)
		  (error (concat compilation-error-message
				 (and (get-buffer-process (current-buffer))
				      (eq (process-status
					   (get-buffer-process
					    (current-buffer)))
					  'run)
				      " yet"))))
	      (setq compilation-error-list (cdr next-errors))
	      (if (null (cdr next-error))
		  ;; This error is boring.  Go to the next.
		  t
		(or (markerp (cdr next-error))
		    ;; This error has a filename/lineno pair.
		    ;; Find the file and turn it into a marker.
		    (let* ((fileinfo (car (cdr next-error)))
			   (buffer (compilation-find-file (cdr fileinfo)
							  (car fileinfo)
							  (car next-error))))
		      (if (null buffer)
			  ;; We can't find this error's file.
			  ;; Remove all errors in the same file.
			  (progn
			    (setq next-errors compilation-old-error-list)
			    (while next-errors
			      (and (consp (cdr (car next-errors)))
				   (equal (car (cdr (car next-errors)))
					  fileinfo)
				   (progn
				     (set-marker (car (car next-errors)) nil)
				     (setcdr (car next-errors) nil)))
			      (setq next-errors (cdr next-errors)))
			    ;; Look for the next error.
			    t)
			;; We found the file.  Get a marker for this error.
			(set-buffer buffer)
			(save-excursion
			  (save-restriction
			    (widen)
			    (let ((errors compilation-old-error-list)
				  (last-line (cdr (cdr next-error))))
			      (goto-line last-line)
			      (beginning-of-line)
			      (setcdr next-error (point-marker))
			      ;; Make all the other error messages referring
			      ;; to the same file have markers into the buffer.
			      (while errors
				(and (consp (cdr (car errors)))
				     (equal (car (cdr (car errors))) fileinfo)
				     (let ((this (cdr (cdr (car errors))))
					   (lines (- (cdr (cdr (car errors)))
						     last-line)))
				       (if (eq selective-display t)
					   (if (< lines 0)
					       (re-search-backward "[\n\C-m]"
								   nil 'end
								   (- lines))
					     (re-search-forward "[\n\C-m]"
								nil 'end
								lines))
					 (forward-line lines))
				       (setq last-line this)
				       (setcdr (car errors) (point-marker))))
				(setq errors (cdr errors)))))))))
		;; If we didn't get a marker for this error,
		;; go on to the next one.
		(not (markerp (cdr next-error))))))
	(setq next-errors compilation-error-list
	      next-error (car next-errors))))

    ;; Skip over multiple error messages for the same source location,
    ;; so the next C-x ` won't go to an error in the same place.
    (while (and compilation-error-list
		(equal (cdr (car compilation-error-list)) (cdr next-error)))
      (setq compilation-error-list (cdr compilation-error-list)))

    ;; We now have a marker for the position of the error.
    (switch-to-buffer (marker-buffer (cdr next-error)))
    (goto-char (cdr next-error))
    ;; If narrowing got in the way of
    ;; going to the right place, widen.
    (or (= (point) (marker-position (cdr next-error)))
	(progn
	  (widen)
	  (goto-char (cdr next-error))))

Richard M. Stallman's avatar
Richard M. Stallman committed
605 606 607 608
    ;; Show compilation buffer in other window, scrolled to this error.
    (let* ((pop-up-windows t)
	   (w (display-buffer (marker-buffer (car next-error)))))
      (set-window-point w (car next-error))
Roland McGrath's avatar
Roland McGrath committed
609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651
      (set-window-start w (car next-error)))))

;;;###autoload
(define-key ctl-x-map "`" 'next-error)

;; Find a buffer for file FILENAME.
;; Search the directories in compilation-search-path.
;; A nil in compilation-search-path means to try the
;; current directory, which is passed in DIR.
;; If FILENAME is not found at all, ask the user where to find it.
;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user.
(defun compilation-find-file (filename dir marker)
  (let ((dirs compilation-search-path)
	result name)
    (while (and dirs (null result))
      (setq name (expand-file-name filename (or (car dirs) dir))
	    result (and (file-exists-p name)
			(find-file-noselect name))
	    dirs (cdr dirs)))
    (or result
	;; The file doesn't exist.
	;; Ask the user where to find it.
	;; If he hits C-g, then the next time he does
	;; next-error, he'll skip past it.
	(progn
	  (let* ((pop-up-windows t)
		 (w (display-buffer (marker-buffer marker))))
	    (set-window-point w marker)
	    (set-window-start w marker))
	  (setq name
		(expand-file-name
		 (read-file-name
		  (format "Find this error in: (default %s) "
			  filename) dir filename t)))
	  (if (file-directory-p name)
	      (setq name (concat (file-name-as-directory name) filename)))
	  (if (file-exists-p name)
	      (find-file-noselect name))))))

;; 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 the right away.
Richard M. Stallman's avatar
Richard M. Stallman committed
652 653 654 655
(defun compilation-forget-errors ()
  (while compilation-old-error-list
    (let ((next-error (car compilation-old-error-list)))
      (set-marker (car next-error) nil)
Roland McGrath's avatar
Roland McGrath committed
656 657
      (if (markerp (cdr next-error))
	  (set-marker (cdr next-error) nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
658
    (setq compilation-old-error-list (cdr compilation-old-error-list)))
Roland McGrath's avatar
Roland McGrath committed
659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687
  (setq compilation-error-list nil)
  (while (cdr compilation-directory-stack)
    (setq compilation-directory-stack (cdr compilation-directory-stack))))


(defun count-regexp-groupings (regexp)
  "Return the number of \\( ... \\) groupings in REGEXP (a string)."
  (let ((groupings 0)
	(len (length regexp))
	(i 0)
	c)
    (while (< i len)
      (setq c (aref regexp i)
	    i (1+ i))
      (cond ((= c ?\[)
	     ;; Find the end of this [...].
	     (while (and (< i len)
			 (not (= (aref regexp i) ?\])))
	       (setq i (1+ i))))
	    ((= c ?\\)
	     (if (< i len)
		 (progn
		   (setq c (aref regexp i)
			 i (1+ i))
		   (if (= c ?\))
		       ;; We found the end of a grouping,
		       ;; so bump our counter.
		       (setq groupings (1+ groupings))))))))
    groupings))
Richard M. Stallman's avatar
Richard M. Stallman committed
688 689 690

(defun compilation-parse-errors ()
  "Parse the current buffer as grep, cc or lint error messages.
Roland McGrath's avatar
Roland McGrath committed
691
See variable `compilation-parse-errors-function' for the interface it uses."
Richard M. Stallman's avatar
Richard M. Stallman committed
692 693 694
  (setq compilation-error-list nil)
  (message "Parsing error messages...")
  (let (text-buffer
Roland McGrath's avatar
Roland McGrath committed
695 696 697
	regexp enter-group leave-group error-group
	alist subexpr error-regexp-groups)

Richard M. Stallman's avatar
Richard M. Stallman committed
698 699 700 701 702 703
    ;; 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))
Roland McGrath's avatar
Roland McGrath committed
704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809

    ;; Compile all the regexps we want to search for into one.
    (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|"
			 "\\(" compilation-leave-directory-regexp "\\)\\|"
			 "\\(" (mapconcat (function
					   (lambda (elt)
					     (concat "\\(" (car elt) "\\)")))
					  compilation-error-regexp-alist
					  "\\|") "\\)"))

    ;; Find out how many \(...\) groupings are in each of the regexps, and set
    ;; *-GROUP to the grouping containing each constituent regexp (whose
    ;; subgroups will come immediately thereafter) of the big regexp we have
    ;; just constructed.
    (setq enter-group 1
	  leave-group (+ enter-group
			 (count-regexp-groupings
			  compilation-enter-directory-regexp)
			 1)
	  error-group (+ leave-group
			 (count-regexp-groupings
			  compilation-leave-directory-regexp)
			 1))

    ;; Compile an alist (IDX FILE LINE), where IDX is the number of the
    ;; subexpression for an entire error-regexp, and FILE and LINE are the
    ;; numbers for the subexpressions giving the file name and line number.
    (setq alist compilation-error-regexp-alist
	  subexpr (1+ error-group))
    (while alist
      (setq error-regexp-groups (cons (list subexpr
					    (+ subexpr (nth 1 (car alist)))
					    (+ subexpr (nth 2 (car alist))))
				      error-regexp-groups))
      (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
      (setq alist (cdr alist)))

    (while (re-search-forward regexp nil t)
      ;; Figure out which constituent regexp matched.
      (cond ((match-beginning enter-group)
	     ;; The match was the enter-directory regexp.
	     (let ((dir
		    (file-name-as-directory
		     (expand-file-name
		      (buffer-substring (match-beginning (+ enter-group 1))
					(match-end (+ enter-group 1)))))))
	       (setq compilation-directory-stack
		     (cons dir compilation-directory-stack))
	       (and (file-directory-p dir)
		    (setq default-directory dir))))
	    
	    ((match-beginning leave-group)
	     ;; The match was the leave-directory regexp.
	     (let ((beg (match-beginning (+ leave-group 1)))
		   (stack compilation-directory-stack))
	       (if beg
		   (let ((dir
			  (file-name-as-directory
			   (expand-file-name
			    (buffer-substring beg
					      (match-end (+ leave-group
							    1)))))))
		     (while (and stack
				 (not (string-equal (car stack) dir)))
		       (setq stack (cdr stack)))))
	       (setq compilation-directory-stack (cdr stack))
	       (setq stack (car compilation-directory-stack))
	       (if stack
		   (setq default-directory stack))
	       ))
	    
	    ((match-beginning error-group)
	     ;; The match was the composite error regexp.
	     ;; Find out which individual regexp matched.
	     (setq alist error-regexp-groups)
	     (while (and alist
			 (null (match-beginning (car (car alist)))))
	       (setq alist (cdr alist)))
	     (if alist
		 (setq alist (car alist))
	       (error "Impossible regexp match!"))
	     
	     ;; Extract the file name and line number from the error message.
	     (let ((filename
		    (cons default-directory
			  (buffer-substring (match-beginning (nth 1 alist))
					    (match-end (nth 1 alist)))))
		   (linenum (save-restriction
			      (narrow-to-region
			       (match-beginning (nth 2 alist))
			       (match-end (nth 2 alist)))
			      (goto-char (point-min))
			      (if (looking-at "[0-9]")
				  (read (current-buffer))))))
	       ;; Locate the erring file and line.
	       ;; Cons a new elt onto compilation-error-list,
	       ;; giving a marker for the current compilation buffer
	       ;; location, and the file and line number of the error.
	       (save-excursion
		 (beginning-of-line 1)
		 (setq compilation-error-list
		       (cons (cons (point-marker)
				   (cons filename linenum))
			     compilation-error-list)))))
	    (t
	     (error "Impossible regexp match!"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
810 811 812 813 814
    (setq compilation-parsing-end (point-max)))
  (message "Parsing error messages...done")
  (setq compilation-error-list (nreverse compilation-error-list)))

(define-key ctl-x-map "`" 'next-error)
Jim Blandy's avatar
Jim Blandy committed
815 816

(provide 'compile)
Eric S. Raymond's avatar
Eric S. Raymond committed
817 818

;;; compile.el ends here