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       (set (make-local-variable 'compilation-parse-errors-function) parser)
 276       (set (make-local-variable 'compilation-error-message) error-message)
 277       (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist)
 278       (setq default-directory thisdir
 279             compilation-directory-stack (list default-directory))
 280       (set-window-start outwin (point-min))
 281       (setq mode-name name-of-mode)
 282       (or (eq outwin (selected-window))
 283           (set-window-point outwin (point-min)))
 284       (and compilation-window-height
 285            (= (window-width outwin) (screen-width))
 286            (let ((w (selected-window)))
 287              (unwind-protect
 288                  (progn
 289                    (select-window outwin)
 290                    (enlarge-window (- compilation-window-height
 291                                       (window-height))))
 292                (select-window w))))
 293       ;; Start the compilation.
 294       (set-process-sentinel (start-process-shell-command (downcase mode-name)
 295                                                          outbuf
 296                                                          command)
 297                             'compilation-sentinel))
 298     ;; Make it so the next C-x ` will use this buffer.
 299     (setq compilation-last-buffer outbuf)))
 300
 301 (defvar compilation-mode-map
 302   (let ((map (make-sparse-keymap)))
 303     (define-key map "\C-c\C-c" 'compile-goto-error)
 304     (define-key map "\C-c\C-k" 'kill-compilation)
 305     map)
 306   "Keymap for compilation log buffers.")
 307
 308 (defun compilation-mode ()
 309   "Major mode for compilation log buffers.
 310 \\<compilation-mode-map>To visit the source for a line-numbered error,
 311 move point to the error message line and type \\[compile-goto-error].
 312 To kill the compilation, type \\[kill-compilation].
 313
 314 Runs `compilation-mode-hook' with `run-hooks' (which see)."
 315   (interactive)
 316   (fundamental-mode)
 317   (use-local-map compilation-mode-map)
 318   (setq major-mode 'compilation-mode)
 319   (setq mode-name "Compilation")
 320   ;; Make buffer's mode line show process state
 321   (setq mode-line-process '(": %s"))
 322   (set (make-local-variable 'compilation-error-list) nil)
 323   (set (make-local-variable 'compilation-old-error-list) nil)
 324   (set (make-local-variable 'compilation-parsing-end) 1)
 325   (set (make-local-variable 'compilation-directory-stack) nil)
 326   (setq compilation-last-buffer (current-buffer))
 327   (run-hooks 'compilation-mode-hook))
 328
 329 ;; Called when compilation process changes state.
 330 (defun compilation-sentinel (proc msg)
 331   "Sentinel for compilation buffers."
 332   (let ((buffer (process-buffer proc)))
 333     (cond ((null (buffer-name buffer))
 334            ;; buffer killed
 335            (set-process-buffer proc nil))
 336           ((memq (process-status proc) '(signal exit))
 337            (let ((obuf (current-buffer))
 338                  omax opoint)
 339              ;; save-excursion isn't the right thing if
 340              ;; process-buffer is current-buffer
 341              (unwind-protect
 342                  (progn
 343                    ;; Write something in the compilation buffer
 344                    ;; and hack its mode line.
 345                    (set-buffer buffer)
 346                    (setq omax (point-max)
 347                          opoint (point))
 348                    (goto-char omax)
 349                    ;; Record where we put the message, so we can ignore it
 350                    ;; later on.
 351                    (insert ?\n mode-name " " msg)
 352                    (forward-char -1)
 353                    (insert " at " (substring (current-time-string) 0 19))
 354                    (forward-char 1)
 355                    (setq mode-line-process
 356                          (concat ": "
 357                                  (symbol-name (process-status proc))))
 358                    ;; Since the buffer and mode line will show that the
 359                    ;; process is dead, we can delete it now.  Otherwise it
 360                    ;; will stay around until M-x list-processes.
 361                    (delete-process proc))
 362                ;; Force mode line redisplay soon.
 363                (set-buffer-modified-p (buffer-modified-p)))
 364              (if (and opoint (< opoint omax))
 365                  (goto-char opoint))
 366              (set-buffer obuf)
 367              (if compilation-finish-function
 368                  (funcall compilation-finish-function buffer msg))
 369              ))
 370           )))
 371
 372 (defun kill-compilation ()
 373   "Kill the process made by the \\[compile] command."
 374   (interactive)
 375   (let ((buffer (compilation-find-buffer)))
 376     (if (get-buffer-process buffer)
 377         (interrupt-process (get-buffer-process buffer))
 378       (error "The compilation process is not running."))))
 379
 380
 381 ;; Parse any new errors in the compilation buffer,
 382 ;; or reparse from the beginning if the user has asked for that.
 383 (defun compile-reinitialize-errors (argp)
 384   (save-excursion
 385     (set-buffer compilation-last-buffer)
 386     ;; If we are out of errors, or if user says "reparse",
 387     ;; discard the info we have, to force reparsing.
 388     (if (or (eq compilation-error-list t)
 389             (consp argp))
 390         (progn (compilation-forget-errors)
 391                (setq compilation-parsing-end 1)))
 392     (if compilation-error-list
 393         ;; Since compilation-error-list is non-nil, it points to a specific
 394         ;; error the user wanted.  So don't move it around.
 395         nil
 396       (switch-to-buffer compilation-last-buffer)
 397       (set-buffer-modified-p nil)
 398       (let ((at-start (= compilation-parsing-end 1)))
 399         (funcall compilation-parse-errors-function)
 400         ;; Remember the entire list for compilation-forget-errors.
 401         ;; If this is an incremental parse, append to previous list.
 402         (if at-start
 403             (setq compilation-old-error-list compilation-error-list)
 404           (setq compilation-old-error-list
 405                 (nconc compilation-old-error-list compilation-error-list)))))))
 406
 407 (defun compile-goto-error (&optional argp)
 408   "Visit the source for the error message point is on.
 409 Use this command in a compilation log buffer.
 410 C-u as a prefix arg means to reparse the buffer's error messages first;
 411 other kinds of prefix arguments are ignored."
 412   (interactive "P")
 413   (or (compilation-buffer-p (current-buffer))
 414       (error "Not in a compilation buffer."))
 415   (setq compilation-last-buffer (current-buffer))
 416   (compile-reinitialize-errors argp)
 417   (save-excursion
 418     (beginning-of-line)
 419     ;; Move compilation-error-list to the elt of
 420     ;; compilation-old-error-list whose car is the error we want.
 421     (setq compilation-error-list
 422           (memq (let (elt)
 423                   (while (not (or (setq elt (assoc (point-marker)
 424                                                    compilation-old-error-list))
 425                                   (eobp)))
 426                     ;; This line doesn't contain an error.
 427                     ;; Move forward a line and look again.
 428                     (forward-line 1))
 429                   elt)
 430                 compilation-old-error-list)))
 431   ;; Move to another window, so that next-error's window changes
 432   ;; result in the desired setup.
 433   (or (one-window-p)
 434       (other-window -1))
 435   (next-error 1))
 436
 437 (defun compilation-buffer-p (buffer)
 438   (assq 'compilation-error-list (buffer-local-variables buffer)))
 439
 440 ;; Return a compilation buffer.
 441 ;; If the current buffer is a compilation buffer, return it.
 442 ;; If compilation-last-buffer is set to a live buffer, use that.
 443 ;; Otherwise, look for a compilation buffer and signal an error
 444 ;; if there are none.
 445 (defun compilation-find-buffer (&optional other-buffer)
 446   (if (and (not other-buffer)
 447            (compilation-buffer-p (current-buffer)))
 448       ;; The current buffer is a compilation buffer.
 449       (current-buffer)
 450     (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
 451              (or (not other-buffer) (not (eq compilation-last-buffer
 452                                              (current-buffer)))))
 453         compilation-last-buffer
 454       (let ((buffers (buffer-list)))
 455         (while (and buffers (or (not (compilation-buffer-p (car buffers)))
 456                                 (and other-buffer
 457                                      (eq (car buffers) (current-buffer)))))
 458           (setq buffers (cdr buffers)))
 459         (if buffers
 460             (car buffers)
 461           (or (and other-buffer
 462                    (compilation-buffer-p (current-buffer))
 463                    ;; The current buffer is a compilation buffer.
 464                    (progn
 465                      (if other-buffer
 466                          (message "This is the only compilation buffer."))
 467                      (current-buffer)))
 468               (error "No compilation started!")))))))
 469
 470 ;;;###autoload
 471 (defun next-error (&optional argp)
 472   "Visit next compilation error message and corresponding source code.
 473 This operates on the output from the \\[compile] command.
 474 If all preparsed error messages have been processed,
 475 the error message buffer is checked for new ones.
 476
 477 A prefix arg specifies how many error messages to move;
 478 negative means move back to previous error messages.
 479 Just C-u as a prefix means reparse the error message buffer
 480 and start at the first error.
 481
 482 \\[next-error] normally applies to the most recent compilation started,
 483 but as long as you are in the middle of parsing errors from one compilation
 484 output buffer, you stay with that compilation output buffer.
 485
 486 Use \\[next-error] in a compilation output buffer to switch to
 487 processing errors from that compilation.
 488
 489 See variables `compilation-parse-errors-function' and
 490 \`compilation-error-regexp-alist' for customization ideas."
 491   (interactive "P")
 492   (setq compilation-last-buffer (compilation-find-buffer))
 493   (compile-reinitialize-errors argp)
 494   ;; Make ARGP nil if the prefix arg was just C-u,
 495   ;; since that means to reparse the errors, which the
 496   ;; compile-reinitialize-errors call just did.
 497   ;; Now we are only interested in a numeric prefix arg.
 498   (if (consp argp)
 499       (setq argp nil))
 500   (let (next-errors next-error)
 501     (save-excursion
 502       (set-buffer compilation-last-buffer)
 503       (setq next-errors (nthcdr (+ (- (length compilation-old-error-list)
 504                                       (length compilation-error-list)
 505                                       1)
 506                                    (prefix-numeric-value argp))
 507                                 compilation-old-error-list)
 508             next-error (car next-errors))
 509       (while
 510           (progn
 511             (if (null next-error)
 512                 (progn
 513                   (if argp (if (> (prefix-numeric-value argp) 0)
 514                                (error "Moved past last error")
 515                              (error "Moved back past first error")))
 516                   (compilation-forget-errors)
 517                   (error (concat compilation-error-message
 518                                  (and (get-buffer-process (current-buffer))
 519                                       (eq (process-status
 520                                            (get-buffer-process
 521                                             (current-buffer)))
 522                                           'run)
 523                                       " yet"))))
 524               (setq compilation-error-list (cdr next-errors))
 525               (if (null (cdr next-error))
 526                   ;; This error is boring.  Go to the next.
 527                   t
 528                 (or (markerp (cdr next-error))
 529                     ;; This error has a filename/lineno pair.
 530                     ;; Find the file and turn it into a marker.
 531                     (let* ((fileinfo (car (cdr next-error)))
 532                            (buffer (compilation-find-file (cdr fileinfo)
 533                                                           (car fileinfo)
 534                                                           (car next-error))))
 535                       (if (null buffer)
 536                           ;; We can't find this error's file.
 537                           ;; Remove all errors in the same file.
 538                           (progn
 539                             (setq next-errors compilation-old-error-list)
 540                             (while next-errors
 541                               (and (consp (cdr (car next-errors)))
 542                                    (equal (car (cdr (car next-errors)))
 543                                           fileinfo)
 544                                    (progn
 545                                      (set-marker (car (car next-errors)) nil)
 546                                      (setcdr (car next-errors) nil)))
 547                               (setq next-errors (cdr next-errors)))
 548                             ;; Look for the next error.
 549                             t)
 550                         ;; We found the file.  Get a marker for this error.
 551                         (set-buffer buffer)
 552                         (save-excursion
 553                           (save-restriction
 554                             (widen)
 555                             (let ((errors compilation-old-error-list)
 556                                   (last-line (cdr (cdr next-error))))
 557                               (goto-line last-line)
 558                               (beginning-of-line)
 559                               (setcdr next-error (point-marker))
 560                               ;; Make all the other error messages referring
 561                               ;; to the same file have markers into the buffer.
 562                               (while errors
 563                                 (and (consp (cdr (car errors)))
 564                                      (equal (car (cdr (car errors))) fileinfo)
 565                                      (let ((this (cdr (cdr (car errors))))
 566                                            (lines (- (cdr (cdr (car errors)))
 567                                                      last-line)))
 568                                        (if (eq selective-display t)
 569                                            (if (< lines 0)
 570                                                (re-search-backward "[\n\C-m]"
 571                                                                    nil 'end
 572                                                                    (- lines))
 573                                              (re-search-forward "[\n\C-m]"
 574                                                                 nil 'end
 575                                                                 lines))
 576                                          (forward-line lines))
 577                                        (setq last-line this)
 578                                        (setcdr (car errors) (point-marker))))
 579                                 (setq errors (cdr errors)))))))))
 580                 ;; If we didn't get a marker for this error,
 581                 ;; go on to the next one.
 582                 (not (markerp (cdr next-error))))))
 583         (setq next-errors compilation-error-list
 584               next-error (car next-errors))))
 585
 586     ;; Skip over multiple error messages for the same source location,
 587     ;; so the next C-x ` won't go to an error in the same place.
 588     (while (and compilation-error-list
 589                 (equal (cdr (car compilation-error-list)) (cdr next-error)))
 590       (setq compilation-error-list (cdr compilation-error-list)))
 591
 592     ;; We now have a marker for the position of the error.
 593     (switch-to-buffer (marker-buffer (cdr next-error)))
 594     (goto-char (cdr next-error))
 595     ;; If narrowing got in the way of
 596     ;; going to the right place, widen.
 597     (or (= (point) (marker-position (cdr next-error)))
 598         (progn
 599           (widen)
 600           (goto-char (cdr next-error))))
 601
 602     ;; Show compilation buffer in other window, scrolled to this error.
 603     (let* ((pop-up-windows t)
 604            (w (display-buffer (marker-buffer (car next-error)))))
 605       (set-window-point w (car next-error))
 606       (set-window-start w (car next-error)))))
 607
 608 ;;;###autoload
 609 (define-key ctl-x-map "`" 'next-error)
 610
 611 ;; Find a buffer for file FILENAME.
 612 ;; Search the directories in compilation-search-path.
 613 ;; A nil in compilation-search-path means to try the
 614 ;; current directory, which is passed in DIR.
 615 ;; If FILENAME is not found at all, ask the user where to find it.
 616 ;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user.
 617 (defun compilation-find-file (filename dir marker)
 618   (let ((dirs compilation-search-path)
 619         result name)
 620     (while (and dirs (null result))
 621       (setq name (expand-file-name filename (or (car dirs) dir))
 622             result (and (file-exists-p name)
 623                         (find-file-noselect name))
 624             dirs (cdr dirs)))
 625     (or result
 626         ;; The file doesn't exist.
 627         ;; Ask the user where to find it.
 628         ;; If he hits C-g, then the next time he does
 629         ;; next-error, he'll skip past it.
 630         (progn
 631           (let* ((pop-up-windows t)
 632                  (w (display-buffer (marker-buffer marker))))
 633             (set-window-point w marker)
 634             (set-window-start w marker))
 635           (setq name
 636                 (expand-file-name
 637                  (read-file-name
 638                   (format "Find this error in: (default %s) "
 639                           filename) dir filename t)))
 640           (if (file-directory-p name)
 641               (setq name (concat (file-name-as-directory name) filename)))
 642           (if (file-exists-p name)
 643               (find-file-noselect name))))))
 644
 645 ;; Set compilation-error-list to nil, and unchain the markers that point to the
 646 ;; error messages and their text, so that they no longer slow down gap motion.
 647 ;; This would happen anyway at the next garbage collection, but it is better to
 648 ;; do it the right away.
 649 (defun compilation-forget-errors ()
 650   (while compilation-old-error-list
 651     (let ((next-error (car compilation-old-error-list)))
 652       (set-marker (car next-error) nil)
 653       (if (markerp (cdr next-error))
 654           (set-marker (cdr next-error) nil)))
 655     (setq compilation-old-error-list (cdr compilation-old-error-list)))
 656   (setq compilation-error-list nil)
 657   (while (cdr compilation-directory-stack)
 658     (setq compilation-directory-stack (cdr compilation-directory-stack))))
 659
 660
 661 (defun count-regexp-groupings (regexp)
 662   "Return the number of \\( ... \\) groupings in REGEXP (a string)."
 663   (let ((groupings 0)
 664         (len (length regexp))
 665         (i 0)
 666         c)
 667     (while (< i len)
 668       (setq c (aref regexp i)
 669             i (1+ i))
 670       (cond ((= c ?\[)
 671              ;; Find the end of this [...].
 672              (while (and (< i len)
 673                          (not (= (aref regexp i) ?\])))
 674                (setq i (1+ i))))
 675             ((= c ?\\)
 676              (if (< i len)
 677                  (progn
 678                    (setq c (aref regexp i)
 679                          i (1+ i))
 680                    (if (= c ?\))
 681                        ;; We found the end of a grouping,
 682                        ;; so bump our counter.
 683                        (setq groupings (1+ groupings))))))))
 684     groupings))
 685
 686 (defun compilation-parse-errors ()
 687   "Parse the current buffer as grep, cc or lint error messages.
 688 See variable `compilation-parse-errors-function' for the interface it uses."
 689   (setq compilation-error-list nil)
 690   (message "Parsing error messages...")
 691   (let (text-buffer
 692         regexp enter-group leave-group error-group
 693         alist subexpr error-regexp-groups)
 694
 695     ;; Don't reparse messages already seen at last parse.
 696     (goto-char compilation-parsing-end)
 697     ;; Don't parse the first two lines as error messages.
 698     ;; This matters for grep.
 699     (if (bobp)
 700         (forward-line 2))
 701
 702     ;; Compile all the regexps we want to search for into one.
 703     (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|"
 704                          "\\(" compilation-leave-directory-regexp "\\)\\|"
 705                          "\\(" (mapconcat (function
 706                                            (lambda (elt)
 707                                              (concat "\\(" (car elt) "\\)")))
 708                                           compilation-error-regexp-alist
 709                                           "\\|") "\\)"))
 710
 711     ;; Find out how many \(...\) groupings are in each of the regexps, and set
 712     ;; *-GROUP to the grouping containing each constituent regexp (whose
 713     ;; subgroups will come immediately thereafter) of the big regexp we have
 714     ;; just constructed.
 715     (setq enter-group 1
 716           leave-group (+ enter-group
 717                          (count-regexp-groupings
 718                           compilation-enter-directory-regexp)
 719                          1)
 720           error-group (+ leave-group
 721                          (count-regexp-groupings
 722                           compilation-leave-directory-regexp)
 723                          1))
 724
 725     ;; Compile an alist (IDX FILE LINE), where IDX is the number of the
 726     ;; subexpression for an entire error-regexp, and FILE and LINE are the
 727     ;; numbers for the subexpressions giving the file name and line number.
 728     (setq alist compilation-error-regexp-alist
 729           subexpr (1+ error-group))
 730     (while alist
 731       (setq error-regexp-groups (cons (list subexpr
 732                                             (+ subexpr (nth 1 (car alist)))
 733                                             (+ subexpr (nth 2 (car alist))))
 734                                       error-regexp-groups))
 735       (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
 736       (setq alist (cdr alist)))
 737
 738     (while (re-search-forward regexp nil t)
 739       ;; Figure out which constituent regexp matched.
 740       (cond ((match-beginning enter-group)
 741              ;; The match was the enter-directory regexp.
 742              (let ((dir
 743                     (file-name-as-directory
 744                      (expand-file-name
 745                       (buffer-substring (match-beginning (+ enter-group 1))
 746                                         (match-end (+ enter-group 1)))))))
 747                (setq compilation-directory-stack
 748                      (cons dir compilation-directory-stack))
 749                (and (file-directory-p dir)
 750                     (setq default-directory dir))))
 751
 752             ((match-beginning leave-group)
 753              ;; The match was the leave-directory regexp.
 754              (let ((beg (match-beginning (+ leave-group 1)))
 755                    (stack compilation-directory-stack))
 756                (if beg
 757                    (let ((dir
 758                           (file-name-as-directory
 759                            (expand-file-name
 760                             (buffer-substring beg
 761                                               (match-end (+ leave-group
 762                                                             1)))))))
 763                      (while (and stack
 764                                  (not (string-equal (car stack) dir)))
 765                        (setq stack (cdr stack)))))
 766                (setq compilation-directory-stack (cdr stack))
 767                (setq stack (car compilation-directory-stack))
 768                (if stack
 769                    (setq default-directory stack))
 770                ))
 771
 772             ((match-beginning error-group)
 773              ;; The match was the composite error regexp.
 774              ;; Find out which individual regexp matched.
 775              (setq alist error-regexp-groups)
 776              (while (and alist
 777                          (null (match-beginning (car (car alist)))))
 778                (setq alist (cdr alist)))
 779              (if alist
 780                  (setq alist (car alist))
 781                (error "Impossible regexp match!"))
 782
 783              ;; Extract the file name and line number from the error message.
 784              (let ((filename
 785                     (cons default-directory
 786                           (buffer-substring (match-beginning (nth 1 alist))
 787                                             (match-end (nth 1 alist)))))
 788                    (linenum (save-restriction
 789                               (narrow-to-region
 790                                (match-beginning (nth 2 alist))
 791                                (match-end (nth 2 alist)))
 792                               (goto-char (point-min))
 793                               (if (looking-at "[0-9]")
 794                                   (read (current-buffer))))))
 795                ;; Locate the erring file and line.
 796                ;; Cons a new elt onto compilation-error-list,
 797                ;; giving a marker for the current compilation buffer
 798                ;; location, and the file and line number of the error.
 799                (save-excursion
 800                  (beginning-of-line 1)
 801                  (setq compilation-error-list
 802                        (cons (cons (point-marker)
 803                                    (cons filename linenum))
 804                              compilation-error-list)))))
 805             (t
 806              (error "Impossible regexp match!"))))
 807     (setq compilation-parsing-end (point-max)))
 808   (message "Parsing error messages...done")
 809   (setq compilation-error-list (nreverse compilation-error-list)))
 810
 811 (define-key ctl-x-map "`" 'next-error)
 812
 813 (provide 'compile)
 814
 815 ;;; compile.el ends here