lisp/progmodes/compile.el

   1 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
   2
   3 ;;;!!! dup removal is broken.
   4
   5 ;; Copyright (C) 1985-1991 Free Software Foundation, Inc.
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY.  No author or distributor
  11 ;; accepts responsibility to anyone for the consequences of using it
  12 ;; or for whether it serves any particular purpose or works at all,
  13 ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  14 ;; License for full details.
  15
  16 ;; Everyone is granted permission to copy, modify and redistribute
  17 ;; GNU Emacs, but only under the conditions described in the
  18 ;; GNU Emacs General Public License.   A copy of this license is
  19 ;; supposed to have been given to you along with GNU Emacs so you
  20 ;; can know your rights and responsibilities.  It should be in a
  21 ;; file named COPYING.  Among other things, the copyright notice
  22 ;; and this notice must be preserved on all copies.
  23
  24 ;;;###autoload
  25 (defvar compilation-mode-hook nil
  26   "*List of hook functions run by compilation-mode (see `run-hooks').")
  27
  28 ;;;###autoload
  29 (defconst compilation-window-height nil
  30   "*Number of lines in a compilation window.  If nil, use Emacs default.")
  31
  32 (defvar compilation-error-list nil
  33   "List of error message descriptors for visiting erring functions.
  34 Each error descriptor is a cons (or nil).
  35 Its car is a marker pointing to an error message.
  36 If its cdr is a marker, it points to the text of the line the message is about.
  37 If its cdr is a cons, that cons's car is a cons (DIRECTORY . FILE), specifying
  38 file the message is about, and its cdr is the number of the line the message
  39 is about.  Or its cdr may be nil if that error is not interesting.
  40
  41 The value may be t instead of a list; this means that the buffer of
  42 error messages should be reparsed the next time the list of errors is wanted.")
  43
  44 (defvar compilation-old-error-list nil
  45   "Value of `compilation-error-list' after errors were parsed.")
  46
  47 (defvar compilation-parse-errors-function 'compilation-parse-errors
  48   "Function to call (with no args) to parse error messages from a compilation.
  49 It should read in the source files which have errors and set
  50 `compilation-error-list' to a list with an element for each error message
  51 found.  See that variable for more info.")
  52
  53 ;;;###autoload
  54 (defvar compilation-buffer-name-function nil
  55   "*Function to call with one argument, the name of the major mode of the
  56 compilation buffer, to give the buffer a name.  It should return a string.
  57 If nil, the name \"*compilation*\" is used for compilation buffers,
  58 and the name \"*grep*\" is used for grep buffers.
  59 \(Actually, the name (concat \"*\" (downcase major-mode) \"*\") is used.)")
  60
  61 ;;;###autoload
  62 (defvar compilation-finish-function nil
  63   "*Function to call when a compilation process finishes.
  64 It is called with two arguments: the compilation buffer, and a string
  65 describing how the process finished.")
  66
  67 (defvar compilation-last-buffer nil
  68   "The buffer in which the last compilation was started,
  69 or which was used by the last \\[next-error] or \\[compile-goto-error].")
  70
  71 (defvar compilation-parsing-end nil
  72   "Position of end of buffer when last error messages were parsed.")
  73
  74 (defvar compilation-error-message "No more errors"
  75   "Message to print when no more matches for `compilation-error-regexp-alist'
  76 are found.")
  77
  78 (defvar compilation-error-regexp-alist
  79   '(
  80     ;; 4.3BSD grep, cc, lint pass 1:
  81     ;; /usr/src/foo/foo.c(8): warning: w may be used before set
  82     ;; or GNU utilities
  83     ;; foo.c:8: error message
  84     ("^\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)
  85     ;; 4.3BSD lint pass 2
  86     ;; strcmp: variable # of args. llib-lc(359)  ::  /usr/src/foo/foo.c(8)
  87     ("[ \t:]+\\([^:( \t\n]+\\)[ \t]*[:(]*(+[ \t]*\\([0-9]+\\))[:) \t]*$" 1 2)
  88     ;; 4.3BSD lint pass 3
  89     ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used
  90     ;; This used to be
  91     ;; ("[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2)
  92     ;; which is regexp Impressionism - it matches almost anything!
  93     ("([ \t]*\\([^:( \t\n]+\\)[ \t]*[:(][ \t]*\\([0-9]+\\))" 1 2)
  94     ;; Line 45 of "foo.c": bloofel undefined (who does this?)
  95     ("^[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+of[ \t]+\"\\([^\"\n]+\\)\":" 2 1)
  96     ;; Apollo cc, 4.3BSD fc
  97     ;; "foo.f", line 3: Error: syntax error near end of statement
  98     ("^\"\\([^\"\n]+\\)\", line \\([0-9]+\\):" 1 2)
  99     ;; HP-UX 7.0 fc
 100     ;; foo.f          :16    some horrible error message
 101     ("^\\([^ \t\n:]+\\)[ \t]*:\\([0-9]+\\)" 1 2)
 102     ;; IBM AIX PS/2 C version 1.1
 103     ;; ****** Error number 140 in line 8 of file errors.c ******
 104     ("in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
 105     ;; IBM AIX lint is too painful to do right this way.  File name
 106     ;; prefixes entire sections rather than being on each line.
 107     )
 108   "Alist (REGEXP FILE-IDX LINE-IDX) of regular expressions to match errors in
 109 compilation.  If REGEXP matches, the FILE-IDX'th subexpression gives the file
 110 name, and the LINE-IDX'th subexpression gives the line number.")
 111
 112 ;;;###autoload
 113 (defvar compilation-search-path '(nil)
 114   "*List of directories to search for source files named in error messages.
 115 Elements should be directory names, not file names of directories.
 116 nil as an element means to try the default directory.")
 117
 118 (defvar compile-command "make -k "
 119   "Last shell command used to do a compilation; default for next compilation.
 120
 121 Sometimes it is useful for files to supply local values for this variable.
 122 You might also use mode hooks to specify it in certain modes, like this:
 123
 124     (setq c-mode-hook
 125       '(lambda () (or (file-exists-p \"makefile\") (file-exists-p \"Makefile\")
 126                       (progn (make-local-variable 'compile-command)
 127                              (setq compile-command
 128                                     (concat \"make -k \"
 129                                             buffer-file-name))))))")
 130
 131 ;;;###autoload
 132 (defvar grep-command "grep -n "
 133   "Last shell command used to do a grep search; default for next search.
 134 Typically \"grep -n\" or \"egrep -n\".
 135 \(The \"-n\" option tells grep to output line numbers.)")
 136
 137 (defconst compilation-enter-directory-regexp
 138   ": Entering directory `\\(.*\\)'$"
 139   "Regular expression for a line in the compilation log that
 140 changes the current directory.  This must contain one \\(, \\) pair
 141 around the directory name.
 142
 143 The default value matches lines printed by the `-w' option of GNU Make.")
 144
 145 (defconst compilation-leave-directory-regexp
 146   ": Leaving directory `\\(.*\\)'$"
 147   "Regular expression for a line in the compilation log that
 148 changes the current directory to a previous value.  This may
 149 contain one \\(, \\) pair around the name of the directory
 150 being moved from.  If it does not, the last directory entered
 151 \(by a line matching `compilation-enter-directory-regexp'\) is assumed.
 152
 153 The default value matches lines printed by the `-w' option of GNU Make.")
 154
 155 (defvar compilation-directory-stack nil
 156   "Stack of directories entered by lines matching
 157 \`compilation-enter-directory-regexp' and not yet left by lines matching
 158 \`compilation-leave-directory-regexp'.  The head element is the directory
 159 the compilation was started in.")
 160
 161 ;;;###autoload
 162 (defun compile (command)
 163   "Compile the program including the current buffer.  Default: run `make'.
 164 Runs COMMAND, a shell command, in a separate process asynchronously
 165 with output going to the buffer `*compilation*'.
 166
 167 You can then use the command \\[next-error] to find the next error message
 168 and move to the source code that caused it.
 169
 170 To run more than one compilation at once, start one and rename the
 171 \`*compilation*' buffer to some other name with \\[rename-buffer].
 172 Then start the next one.
 173
 174 The name used for the buffer is actually whatever is returned by
 175 the function in `compilation-buffer-name-function', so you can set that
 176 to a function that generates a unique name."
 177   (interactive (list (read-string "Compile command: " compile-command)))
 178   (setq compile-command command)
 179   (save-some-buffers nil nil)
 180   (compile-internal compile-command "No more errors"))
 181
 182 ;;;###autoload
 183 (defun grep (command-args)
 184   "Run grep, with user-specified args, and collect output in a buffer.
 185 While grep runs asynchronously, you can use the \\[next-error] command
 186 to find the text that grep hits refer to.
 187
 188 The variable `grep-command' holds the last grep command run,
 189 and is the default for future runs.  The command should use the `-n'
 190 flag, so that line numbers are displayed for each match.
 191 What the user enters in response to the prompt for grep args is
 192 appended to everything up to and including the `-n' in `grep-command'."
 193   (interactive
 194    (list (read-string (concat "Run "
 195                               (substring grep-command 0
 196                                          (string-match "[\t ]+" grep-command))
 197                               " (with args): ")
 198                       (progn
 199                         (string-match "-n[\t ]+" grep-command)
 200                         (substring grep-command (match-end 0))))))
 201   ;; why a redundant string-match?  It might not be interactive ...
 202   (setq grep-command (concat (substring grep-command 0
 203                                         (progn
 204                                           (string-match "-n" grep-command)
 205                                           (match-end 0)))
 206                              " " command-args))
 207   (compile-internal (concat grep-command " /dev/null")
 208                     "No more grep hits" "grep"))
 209
 210 (defun compile-internal (command error-message
 211                                  &optional name-of-mode parser regexp-alist
 212                                  name-function)
 213   "Run compilation command COMMAND (low level interface).
 214 ERROR-MESSAGE is a string to print if the user asks to see another error
 215 and there are no more errors.  Third argument NAME-OF-MODE is the name
 216 to display as the major mode in the compilation buffer.
 217
 218 Fourth arg PARSER is the error parser function (nil means the default).  Fifth
 219 arg REGEXP-ALIST is the error message regexp alist to use (nil means the
 220 default).  Sixth arg NAME-FUNCTION is a function called to name the buffer (nil
 221 means the default).  The defaults for these variables are the global values of
 222 \`compilation-parse-errors-function', `compilation-error-regexp-alist', and
 223 \`compilation-buffer-name-function', respectively."
 224   (let (outbuf)
 225     (save-excursion
 226       (or name-of-mode
 227           (setq name-of-mode "Compilation"))
 228       (setq outbuf
 229             (get-buffer-create
 230              (funcall (or name-function compilation-buffer-name-function
 231                           (function (lambda (mode)
 232                                       (concat "*" (downcase mode) "*"))))
 233                       name-of-mode)))
 234       (set-buffer outbuf)
 235       (let ((comp-proc (get-buffer-process (current-buffer))))
 236         (if comp-proc
 237             (if (or (not (eq (process-status comp-proc) 'run))
 238                     (yes-or-no-p
 239                      "A compilation process is running; kill it? "))
 240                 (condition-case ()
 241                     (progn
 242                       (interrupt-process comp-proc)
 243                       (sit-for 1)
 244                       (delete-process comp-proc))
 245                   (error nil))
 246               (error "Cannot have two processes in `%s' at once"
 247                      (buffer-name))
 248               )))
 249       ;; In case the compilation buffer is current, make sure we get the global
 250       ;; values of compilation-error-regexp-alist, etc.
 251       (kill-all-local-variables))
 252     (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist))
 253           (parser (or parser compilation-parse-errors-function))
 254           (thisdir default-directory)
 255           outwin)
 256       (save-excursion
 257         ;; Clear out the compilation buffer and make it writable.
 258         ;; Change its default-directory to the directory where the compilation
 259         ;; will happen, and insert a `cd' command to indicate this.
 260         (set-buffer outbuf)
 261         (setq buffer-read-only nil)
 262         (erase-buffer)
 263         (setq default-directory thisdir)
 264         (insert "cd " thisdir "\n" command "\n")
 265         (set-buffer-modified-p nil))
 266       ;; If we're already in the compilation buffer, go to the end
 267       ;; of the buffer, so point will track the compilation output.
 268       (if (eq outbuf (current-buffer))
 269           (goto-char (point-max)))
 270       ;; Pop up the compilation buffer.
 271       (setq outwin (display-buffer outbuf))
 272       (set-buffer outbuf)
 273       (compilation-mode)
 274       (buffer-disable-undo (current-buffer))
 275       (setq buffer-read-only t)
 276       (set (make-local-variable 'compilation-parse-errors-function) parser)
 277       (set (make-local-variable 'compilation-error-message) error-message)
 278       (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist)
 279       (setq default-directory thisdir
 280             compilation-directory-stack (list default-directory))
 281       (set-window-start outwin (point-min))
 282       (setq mode-name name-of-mode)
 283       (or (eq outwin (selected-window))
 284           (set-window-point outwin (point-min)))
 285       (and compilation-window-height
 286            (= (window-width outwin) (screen-width))
 287            (let ((w (selected-window)))
 288              (unwind-protect
 289                  (progn
 290                    (select-window outwin)
 291                    (enlarge-window (- compilation-window-height
 292                                       (window-height))))
 293                (select-window w))))
 294       ;; Start the compilation.
 295       (set-process-sentinel (start-process-shell-command (downcase mode-name)
 296                                                          outbuf
 297                                                          command)
 298                             'compilation-sentinel))
 299     ;; Make it so the next C-x ` will use this buffer.
 300     (setq compilation-last-buffer outbuf)))
 301
 302 (defvar compilation-mode-map
 303   (let ((map (make-sparse-keymap)))
 304     (define-key map "\C-c\C-c" 'compile-goto-error)
 305     (define-key map "\C-c\C-k" 'kill-compilation)
 306     map)
 307   "Keymap for compilation log buffers.")
 308
 309 (defun compilation-mode ()
 310   "Major mode for compilation log buffers.
 311 \\<compilation-mode-map>To visit the source for a line-numbered error,
 312 move point to the error message line and type \\[compile-goto-error].
 313 To kill the compilation, type \\[kill-compilation].
 314
 315 Runs `compilation-mode-hook' with `run-hooks' (which see)."
 316   (interactive)
 317   (fundamental-mode)
 318   (use-local-map compilation-mode-map)
 319   (setq major-mode 'compilation-mode)
 320   (setq mode-name "Compilation")
 321   ;; Make buffer's mode line show process state
 322   (setq mode-line-process '(": %s"))
 323   (set (make-local-variable 'compilation-error-list) nil)
 324   (set (make-local-variable 'compilation-old-error-list) nil)
 325   (set (make-local-variable 'compilation-parsing-end) 1)
 326   (set (make-local-variable 'compilation-directory-stack) nil)
 327   (setq compilation-last-buffer (current-buffer))
 328   (run-hooks 'compilation-mode-hook))
 329
 330 ;; Called when compilation process changes state.
 331 (defun compilation-sentinel (proc msg)
 332   "Sentinel for compilation buffers."
 333   (let ((buffer (process-buffer proc)))
 334     (cond ((null (buffer-name buffer))
 335            ;; buffer killed
 336            (set-process-buffer proc nil))
 337           ((memq (process-status proc) '(signal exit))
 338            (let ((obuf (current-buffer))
 339                  omax opoint)
 340              ;; save-excursion isn't the right thing if
 341              ;; process-buffer is current-buffer
 342              (unwind-protect
 343                  (progn
 344                    ;; Write something in the compilation buffer
 345                    ;; and hack its mode line.
 346                    (set-buffer buffer)
 347                    (setq buffer-read-only nil)
 348                    (setq omax (point-max)
 349                          opoint (point))
 350                    (goto-char omax)
 351                    ;; Record where we put the message, so we can ignore it
 352                    ;; later on.
 353                    (insert ?\n mode-name " " msg)
 354                    (forward-char -1)
 355                    (insert " at " (substring (current-time-string) 0 19))
 356                    (forward-char 1)
 357                    (setq mode-line-process
 358                          (concat ": "
 359                                  (symbol-name (process-status proc))))
 360                    ;; Since the buffer and mode line will show that the
 361                    ;; process is dead, we can delete it now.  Otherwise it
 362                    ;; will stay around until M-x list-processes.
 363                    (delete-process proc))
 364                ;; Force mode line redisplay soon.
 365                (set-buffer-modified-p (buffer-modified-p))
 366                (setq buffer-read-only t))
 367              (if (and opoint (< opoint omax))
 368                  (goto-char opoint))
 369              (set-buffer obuf)
 370              (if compilation-finish-function
 371                  (funcall compilation-finish-function buffer msg))
 372              ))
 373           )))
 374
 375 (defun kill-compilation ()
 376   "Kill the process made by the \\[compile] command."
 377   (interactive)
 378   (let ((buffer (compilation-find-buffer)))
 379     (if (get-buffer-process buffer)
 380         (interrupt-process (get-buffer-process buffer))
 381       (error "The compilation process is not running."))))
 382
 383
 384 ;; Parse any new errors in the compilation buffer,
 385 ;; or reparse from the beginning if the user has asked for that.
 386 (defun compile-reinitialize-errors (argp)
 387   (save-excursion
 388     (set-buffer compilation-last-buffer)
 389     ;; If we are out of errors, or if user says "reparse",
 390     ;; discard the info we have, to force reparsing.
 391     (if (or (eq compilation-error-list t)
 392             (consp argp))
 393         (progn (compilation-forget-errors)
 394                (setq compilation-parsing-end 1)))
 395     (if compilation-error-list
 396         ;; Since compilation-error-list is non-nil, it points to a specific
 397         ;; error the user wanted.  So don't move it around.
 398         nil
 399       (switch-to-buffer compilation-last-buffer)
 400       (set-buffer-modified-p nil)
 401       (let ((at-start (= compilation-parsing-end 1)))
 402         (funcall compilation-parse-errors-function)
 403         ;; Remember the entire list for compilation-forget-errors.
 404         ;; If this is an incremental parse, append to previous list.
 405         (if at-start
 406             (setq compilation-old-error-list compilation-error-list)
 407           (setq compilation-old-error-list
 408                 (nconc compilation-old-error-list compilation-error-list)))))))
 409
 410 (defun compile-goto-error (&optional argp)
 411   "Visit the source for the error message point is on.
 412 Use this command in a compilation log buffer.
 413 C-u as a prefix arg means to reparse the buffer's error messages first;
 414 other kinds of prefix arguments are ignored."
 415   (interactive "P")
 416   (or (compilation-buffer-p (current-buffer))
 417       (error "Not in a compilation buffer."))
 418   (setq compilation-last-buffer (current-buffer))
 419   (compile-reinitialize-errors argp)
 420   (save-excursion
 421     (beginning-of-line)
 422     ;; Move compilation-error-list to the elt of
 423     ;; compilation-old-error-list whose car is the error we want.
 424     (setq compilation-error-list
 425           (memq (let (elt)
 426                   (while (not (or (setq elt (assoc (point-marker)
 427                                                    compilation-old-error-list))
 428                                   (eobp)))
 429                     ;; This line doesn't contain an error.
 430                     ;; Move forward a line and look again.
 431                     (forward-line 1))
 432                   elt)
 433                 compilation-old-error-list)))
 434   ;; Move to another window, so that next-error's window changes
 435   ;; result in the desired setup.
 436   (or (one-window-p)
 437       (other-window -1))
 438   (next-error 1))
 439
 440 (defun compilation-buffer-p (buffer)
 441   (assq 'compilation-error-list (buffer-local-variables buffer)))
 442
 443 ;; Return a compilation buffer.
 444 ;; If the current buffer is a compilation buffer, return it.
 445 ;; If compilation-last-buffer is set to a live buffer, use that.
 446 ;; Otherwise, look for a compilation buffer and signal an error
 447 ;; if there are none.
 448 (defun compilation-find-buffer (&optional other-buffer)
 449   (if (and (not other-buffer)
 450            (compilation-buffer-p (current-buffer)))
 451       ;; The current buffer is a compilation buffer.
 452       (current-buffer)
 453     (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
 454              (or (not other-buffer) (not (eq compilation-last-buffer
 455                                              (current-buffer)))))
 456         compilation-last-buffer
 457       (let ((buffers (buffer-list)))
 458         (while (and buffers (or (not (compilation-buffer-p (car buffers)))
 459                                 (and other-buffer
 460                                      (eq (car buffers) (current-buffer)))))
 461           (setq buffers (cdr buffers)))
 462         (if buffers
 463             (car buffers)
 464           (or (and other-buffer
 465                    (compilation-buffer-p (current-buffer))
 466                    ;; The current buffer is a compilation buffer.
 467                    (progn
 468                      (if other-buffer
 469                          (message "This is the only compilation buffer."))
 470                      (current-buffer)))
 471               (error "No compilation started!")))))))
 472
 473 ;;;###autoload
 474 (defun next-error (&optional argp)
 475   "Visit next compilation error message and corresponding source code.
 476 This operates on the output from the \\[compile] command.
 477 If all preparsed error messages have been processed,
 478 the error message buffer is checked for new ones.
 479
 480 A prefix arg specifies how many error messages to move;
 481 negative means move back to previous error messages.
 482 Just C-u as a prefix means reparse the error message buffer
 483 and start at the first error.
 484
 485 \\[next-error] normally applies to the most recent compilation started,
 486 but as long as you are in the middle of parsing errors from one compilation
 487 output buffer, you stay with that compilation output buffer.
 488
 489 Use \\[next-error] in a compilation output buffer to switch to
 490 processing errors from that compilation.
 491
 492 See variables `compilation-parse-errors-function' and
 493 \`compilation-error-regexp-alist' for customization ideas."
 494   (interactive "P")
 495   (setq compilation-last-buffer (compilation-find-buffer))
 496   (compile-reinitialize-errors argp)
 497   ;; Make ARGP nil if the prefix arg was just C-u,
 498   ;; since that means to reparse the errors, which the
 499   ;; compile-reinitialize-errors call just did.
 500   ;; Now we are only interested in a numeric prefix arg.
 501   (if (consp argp)
 502       (setq argp nil))
 503   (let (next-errors next-error)
 504     (save-excursion
 505       (set-buffer compilation-last-buffer)
 506       (setq next-errors (nthcdr (+ (- (length compilation-old-error-list)
 507                                       (length compilation-error-list)
 508                                       1)
 509                                    (prefix-numeric-value argp))
 510                                 compilation-old-error-list)
 511             next-error (car next-errors))
 512       (while
 513           (progn
 514             (if (null next-error)
 515                 (progn
 516                   (if argp (if (> (prefix-numeric-value argp) 0)
 517                                (error "Moved past last error")
 518                              (error "Moved back past first error")))
 519                   (compilation-forget-errors)
 520                   (error (concat compilation-error-message
 521                                  (and (get-buffer-process (current-buffer))
 522                                       (eq (process-status
 523                                            (get-buffer-process
 524                                             (current-buffer)))
 525                                           'run)
 526                                       " yet"))))
 527               (setq compilation-error-list (cdr next-errors))
 528               (if (null (cdr next-error))
 529                   ;; This error is boring.  Go to the next.
 530                   t
 531                 (or (markerp (cdr next-error))
 532                     ;; This error has a filename/lineno pair.
 533                     ;; Find the file and turn it into a marker.
 534                     (let* ((fileinfo (car (cdr next-error)))
 535                            (buffer (compilation-find-file (cdr fileinfo)
 536                                                           (car fileinfo)
 537                                                           (car next-error))))
 538                       (if (null buffer)
 539                           ;; We can't find this error's file.
 540                           ;; Remove all errors in the same file.
 541                           (progn
 542                             (setq next-errors compilation-old-error-list)
 543                             (while next-errors
 544                               (and (consp (cdr (car next-errors)))
 545                                    (equal (car (cdr (car next-errors)))
 546                                           fileinfo)
 547                                    (progn
 548                                      (set-marker (car (car next-errors)) nil)
 549                                      (setcdr (car next-errors) nil)))
 550                               (setq next-errors (cdr next-errors)))
 551                             ;; Look for the next error.
 552                             t)
 553                         ;; We found the file.  Get a marker for this error.
 554                         (set-buffer buffer)
 555                         (save-excursion
 556                           (save-restriction
 557                             (widen)
 558                             (let ((errors compilation-old-error-list)
 559                                   (last-line (cdr (cdr next-error))))
 560                               (goto-line last-line)
 561                               (beginning-of-line)
 562                               (setcdr next-error (point-marker))
 563                               ;; Make all the other error messages referring
 564                               ;; to the same file have markers into the buffer.
 565                               (while errors
 566                                 (and (consp (cdr (car errors)))
 567                                      (equal (car (cdr (car errors))) fileinfo)
 568                                      (let ((this (cdr (cdr (car errors))))
 569                                            (lines (- (cdr (cdr (car errors)))
 570                                                      last-line)))
 571                                        (if (eq selective-display t)
 572                                            (if (< lines 0)
 573                                                (re-search-backward "[\n\C-m]"
 574                                                                    nil 'end
 575                                                                    (- lines))
 576                                              (re-search-forward "[\n\C-m]"
 577                                                                 nil 'end
 578                                                                 lines))
 579                                          (forward-line lines))
 580                                        (setq last-line this)
 581                                        (setcdr (car errors) (point-marker))))
 582                                 (setq errors (cdr errors)))))))))
 583                 ;; If we didn't get a marker for this error,
 584                 ;; go on to the next one.
 585                 (not (markerp (cdr next-error))))))
 586         (setq next-errors compilation-error-list
 587               next-error (car next-errors))))
 588
 589     ;; Skip over multiple error messages for the same source location,
 590     ;; so the next C-x ` won't go to an error in the same place.
 591     (while (and compilation-error-list
 592                 (equal (cdr (car compilation-error-list)) (cdr next-error)))
 593       (setq compilation-error-list (cdr compilation-error-list)))
 594
 595     ;; We now have a marker for the position of the error.
 596     (switch-to-buffer (marker-buffer (cdr next-error)))
 597     (goto-char (cdr next-error))
 598     ;; If narrowing got in the way of
 599     ;; going to the right place, widen.
 600     (or (= (point) (marker-position (cdr next-error)))
 601         (progn
 602           (widen)
 603           (goto-char (cdr next-error))))
 604
 605     ;; Show compilation buffer in other window, scrolled to this error.
 606     (let* ((pop-up-windows t)
 607            (w (display-buffer (marker-buffer (car next-error)))))
 608       (set-window-point w (car next-error))
 609       (set-window-start w (car next-error)))))
 610
 611 ;;;###autoload
 612 (define-key ctl-x-map "`" 'next-error)
 613
 614 ;; Find a buffer for file FILENAME.
 615 ;; Search the directories in compilation-search-path.
 616 ;; A nil in compilation-search-path means to try the
 617 ;; current directory, which is passed in DIR.
 618 ;; If FILENAME is not found at all, ask the user where to find it.
 619 ;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user.
 620 (defun compilation-find-file (filename dir marker)
 621   (let ((dirs compilation-search-path)
 622         result name)
 623     (while (and dirs (null result))
 624       (setq name (expand-file-name filename (or (car dirs) dir))
 625             result (and (file-exists-p name)
 626                         (find-file-noselect name))
 627             dirs (cdr dirs)))
 628     (or result
 629         ;; The file doesn't exist.
 630         ;; Ask the user where to find it.
 631         ;; If he hits C-g, then the next time he does
 632         ;; next-error, he'll skip past it.
 633         (progn
 634           (let* ((pop-up-windows t)
 635                  (w (display-buffer (marker-buffer marker))))
 636             (set-window-point w marker)
 637             (set-window-start w marker))
 638           (setq name
 639                 (expand-file-name
 640                  (read-file-name
 641                   (format "Find this error in: (default %s) "
 642                           filename) dir filename t)))
 643           (if (file-directory-p name)
 644               (setq name (concat (file-name-as-directory name) filename)))
 645           (if (file-exists-p name)
 646               (find-file-noselect name))))))
 647
 648 ;; Set compilation-error-list to nil, and unchain the markers that point to the
 649 ;; error messages and their text, so that they no longer slow down gap motion.
 650 ;; This would happen anyway at the next garbage collection, but it is better to
 651 ;; do it the right away.
 652 (defun compilation-forget-errors ()
 653   (while compilation-old-error-list
 654     (let ((next-error (car compilation-old-error-list)))
 655       (set-marker (car next-error) nil)
 656       (if (markerp (cdr next-error))
 657           (set-marker (cdr next-error) nil)))
 658     (setq compilation-old-error-list (cdr compilation-old-error-list)))
 659   (setq compilation-error-list nil)
 660   (while (cdr compilation-directory-stack)
 661     (setq compilation-directory-stack (cdr compilation-directory-stack))))
 662
 663
 664 (defun count-regexp-groupings (regexp)
 665   "Return the number of \\( ... \\) groupings in REGEXP (a string)."
 666   (let ((groupings 0)
 667         (len (length regexp))
 668         (i 0)
 669         c)
 670     (while (< i len)
 671       (setq c (aref regexp i)
 672             i (1+ i))
 673       (cond ((= c ?\[)
 674              ;; Find the end of this [...].
 675              (while (and (< i len)
 676                          (not (= (aref regexp i) ?\])))
 677                (setq i (1+ i))))
 678             ((= c ?\\)
 679              (if (< i len)
 680                  (progn
 681                    (setq c (aref regexp i)
 682                          i (1+ i))
 683                    (if (= c ?\))
 684                        ;; We found the end of a grouping,
 685                        ;; so bump our counter.
 686                        (setq groupings (1+ groupings))))))))
 687     groupings))
 688
 689 (defun compilation-parse-errors ()
 690   "Parse the current buffer as grep, cc or lint error messages.
 691 See variable `compilation-parse-errors-function' for the interface it uses."
 692   (setq compilation-error-list nil)
 693   (message "Parsing error messages...")
 694   (let (text-buffer
 695         regexp enter-group leave-group error-group
 696         alist subexpr error-regexp-groups)
 697
 698     ;; Don't reparse messages already seen at last parse.
 699     (goto-char compilation-parsing-end)
 700     ;; Don't parse the first two lines as error messages.
 701     ;; This matters for grep.
 702     (if (bobp)
 703         (forward-line 2))
 704
 705     ;; Compile all the regexps we want to search for into one.
 706     (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|"
 707                          "\\(" compilation-leave-directory-regexp "\\)\\|"
 708                          "\\(" (mapconcat (function
 709                                            (lambda (elt)
 710                                              (concat "\\(" (car elt) "\\)")))
 711                                           compilation-error-regexp-alist
 712                                           "\\|") "\\)"))
 713
 714     ;; Find out how many \(...\) groupings are in each of the regexps, and set
 715     ;; *-GROUP to the grouping containing each constituent regexp (whose
 716     ;; subgroups will come immediately thereafter) of the big regexp we have
 717     ;; just constructed.
 718     (setq enter-group 1
 719           leave-group (+ enter-group
 720                          (count-regexp-groupings
 721                           compilation-enter-directory-regexp)
 722                          1)
 723           error-group (+ leave-group
 724                          (count-regexp-groupings
 725                           compilation-leave-directory-regexp)
 726                          1))
 727
 728     ;; Compile an alist (IDX FILE LINE), where IDX is the number of the
 729     ;; subexpression for an entire error-regexp, and FILE and LINE are the
 730     ;; numbers for the subexpressions giving the file name and line number.
 731     (setq alist compilation-error-regexp-alist
 732           subexpr (1+ error-group))
 733     (while alist
 734       (setq error-regexp-groups (cons (list subexpr
 735                                             (+ subexpr (nth 1 (car alist)))
 736                                             (+ subexpr (nth 2 (car alist))))
 737                                       error-regexp-groups))
 738       (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
 739       (setq alist (cdr alist)))
 740
 741     (while (re-search-forward regexp nil t)
 742       ;; Figure out which constituent regexp matched.
 743       (cond ((match-beginning enter-group)
 744              ;; The match was the enter-directory regexp.
 745              (let ((dir
 746                     (file-name-as-directory
 747                      (expand-file-name
 748                       (buffer-substring (match-beginning (+ enter-group 1))
 749                                         (match-end (+ enter-group 1)))))))
 750                (setq compilation-directory-stack
 751                      (cons dir compilation-directory-stack))
 752                (and (file-directory-p dir)
 753                     (setq default-directory dir))))
 754
 755             ((match-beginning leave-group)
 756              ;; The match was the leave-directory regexp.
 757              (let ((beg (match-beginning (+ leave-group 1)))
 758                    (stack compilation-directory-stack))
 759                (if beg
 760                    (let ((dir
 761                           (file-name-as-directory
 762                            (expand-file-name
 763                             (buffer-substring beg
 764                                               (match-end (+ leave-group
 765                                                             1)))))))
 766                      (while (and stack
 767                                  (not (string-equal (car stack) dir)))
 768                        (setq stack (cdr stack)))))
 769                (setq compilation-directory-stack (cdr stack))
 770                (setq stack (car compilation-directory-stack))
 771                (if stack
 772                    (setq default-directory stack))
 773                ))
 774
 775             ((match-beginning error-group)
 776              ;; The match was the composite error regexp.
 777              ;; Find out which individual regexp matched.
 778              (setq alist error-regexp-groups)
 779              (while (and alist
 780                          (null (match-beginning (car (car alist)))))
 781                (setq alist (cdr alist)))
 782              (if alist
 783                  (setq alist (car alist))
 784                (error "Impossible regexp match!"))
 785
 786              ;; Extract the file name and line number from the error message.
 787              (let ((filename
 788                     (cons default-directory
 789                           (buffer-substring (match-beginning (nth 1 alist))
 790                                             (match-end (nth 1 alist)))))
 791                    (linenum (save-restriction
 792                               (narrow-to-region
 793                                (match-beginning (nth 2 alist))
 794                                (match-end (nth 2 alist)))
 795                               (goto-char (point-min))
 796                               (if (looking-at "[0-9]")
 797                                   (read (current-buffer))))))
 798                ;; Locate the erring file and line.
 799                ;; Cons a new elt onto compilation-error-list,
 800                ;; giving a marker for the current compilation buffer
 801                ;; location, and the file and line number of the error.
 802                (save-excursion
 803                  (beginning-of-line 1)
 804                  (setq compilation-error-list
 805                        (cons (cons (point-marker)
 806                                    (cons filename linenum))
 807                              compilation-error-list)))))
 808             (t
 809              (error "Impossible regexp match!"))))
 810     (setq compilation-parsing-end (point-max)))
 811   (message "Parsing error messages...done")
 812   (setq compilation-error-list (nreverse compilation-error-list)))
 813
 814 (define-key ctl-x-map "`" 'next-error)
 815
 816 (provide 'compile)
 817
 818 ;;; compile.el ends here