lisp/progmodes/compile.el

   1 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages
   2
   3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 03, 2004
   4 ;;  Free Software Foundation, Inc.
   5
   6 ;; Authors: Roland McGrath <roland@gnu.org>,
   7 ;;          Daniel Pfeiffer <occitan@esperanto.org>
   8 ;; Maintainer: FSF
   9 ;; Keywords: tools, processes
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This package provides the compile facilities documented in the Emacs user's
  31 ;; manual.
  32
  33 ;; This mode uses some complex data-structures:
  34
  35 ;;   LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE)
  36
  37 ;; COLUMN and LINE are numbers parsed from an error message.  COLUMN and maybe
  38 ;; LINE will be nil for a message that doesn't contain them.  Then the
  39 ;; location refers to a indented beginning of line or beginning of file.
  40 ;; Once any location in some file has been jumped to, the list is extended to
  41 ;; (COLUMN LINE FILE-STRUCTURE MARKER . VISITED) for all LOCs pertaining to
  42 ;; that file.
  43 ;; MARKER initially points to LINE and COLUMN in a buffer visiting that file.
  44 ;; Being a marker it sticks to some text, when the buffer grows or shrinks
  45 ;; before that point.  VISITED is t if we have jumped there, else nil.
  46
  47 ;;   FILE-STRUCTURE is a list of
  48 ;;   ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...) ...)
  49
  50 ;; FILENAME is a string parsed from an error message.  DIRECTORY is a string
  51 ;; obtained by following directory change messages.  DIRECTORY will be nil for
  52 ;; an absolute filename.  FORMATS is a list of formats to apply to FILENAME if
  53 ;; a file of that name can't be found.
  54 ;; The rest of the list is an alist of elements with LINE as key.  The keys
  55 ;; are either nil or line numbers.  If present, nil comes first, followed by
  56 ;; the numbers in decreasing order.  The LOCs for each line are again an alist
  57 ;; ordered the same way.  Note that the whole file structure is referenced in
  58 ;; every LOC.
  59
  60 ;;   MESSAGE is a list of (LOC TYPE END-LOC)
  61
  62 ;; TYPE is 0 for info or 1 for warning if the message matcher identified it as
  63 ;; such, 2 otherwise (for a real error).  END-LOC is a LOC pointing to the
  64 ;; other end, if the parsed message contained a range.  If the end of the
  65 ;; range didn't specify a COLUMN, it defaults to -1, meaning end of line.
  66 ;; These are the value of the `message' text-properties in the compilation
  67 ;; buffer.
  68
  69 ;;; Code:
  70
  71 (eval-when-compile (require 'cl))
  72
  73 (defgroup compilation nil
  74   "Run compiler as inferior of Emacs, parse error messages."
  75   :group 'tools
  76   :group 'processes)
  77
  78
  79 ;;;###autoload
  80 (defcustom compilation-mode-hook nil
  81   "*List of hook functions run by `compilation-mode' (see `run-hooks')."
  82   :type 'hook
  83   :group 'compilation)
  84
  85 ;;;###autoload
  86 (defcustom compilation-window-height nil
  87   "*Number of lines in a compilation window.  If nil, use Emacs default."
  88   :type '(choice (const :tag "Default" nil)
  89                  integer)
  90   :group 'compilation)
  91
  92 (defvar compilation-first-column 1
  93   "*This is how compilers number the first column, usually 1 or 0.")
  94
  95 (defvar compilation-parse-errors-filename-function nil
  96   "Function to call to post-process filenames while parsing error messages.
  97 It takes one arg FILENAME which is the name of a file as found
  98 in the compilation output, and should return a transformed file name.")
  99
 100 ;;;###autoload
 101 (defvar compilation-process-setup-function nil
 102   "*Function to call to customize the compilation process.
 103 This functions is called immediately before the compilation process is
 104 started.  It can be used to set any variables or functions that are used
 105 while processing the output of the compilation process.  The function
 106 is called with variables `compilation-buffer' and `compilation-window'
 107 bound to the compilation buffer and window, respectively.")
 108
 109 ;;;###autoload
 110 (defvar compilation-buffer-name-function nil
 111   "Function to compute the name of a compilation buffer.
 112 The function receives one argument, the name of the major mode of the
 113 compilation buffer.  It should return a string.
 114 nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.")
 115
 116 ;;;###autoload
 117 (defvar compilation-finish-function nil
 118   "Function to call when a compilation process finishes.
 119 It is called with two arguments: the compilation buffer, and a string
 120 describing how the process finished.")
 121
 122 ;;;###autoload
 123 (defvar compilation-finish-functions nil
 124   "Functions to call when a compilation process finishes.
 125 Each function is called with two arguments: the compilation buffer,
 126 and a string describing how the process finished.")
 127
 128 (defvar compilation-last-buffer nil
 129   "The most recent compilation buffer.
 130 A buffer becomes most recent when its compilation is started
 131 or when it is used with \\[next-error] or \\[compile-goto-error].")
 132
 133 (defvar compilation-in-progress nil
 134   "List of compilation processes now running.")
 135 (or (assq 'compilation-in-progress minor-mode-alist)
 136     (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
 137                                  minor-mode-alist)))
 138
 139 (defvar compilation-error "error"
 140   "Stem of message to print when no matches are found.")
 141
 142 (defvar compilation-arguments nil
 143   "Arguments that were given to `compilation-start'.")
 144
 145 (defvar compilation-num-errors-found)
 146
 147 (defconst compilation-error-regexp-alist-alist
 148   '((absoft
 149      "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
 150 of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
 151
 152     (ada
 153      "\\(warning: .*\\)? at \\([^ \n]+\\):\\([0-9]+\\)$" 2 3 nil (1))
 154
 155     (aix
 156      " in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
 157
 158     (ant
 159      "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):[0-9]+:[0-9]+:\\)?\
 160 \\( warning\\)?" 1 2 3 (4))
 161
 162     (bash
 163      "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
 164
 165     (borland
 166      "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\
 167 \\([a-zA-Z]?:?[^:( \t\n]+\\)\
 168  \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
 169
 170     (caml
 171      "^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
 172 \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)"
 173      2 (3 . 4) (5 . 6) (7))
 174
 175     (comma
 176      "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
 177 \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
 178
 179     (epc
 180      "^Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1)
 181
 182     (iar
 183      "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
 184      1 2 nil (3))
 185
 186     (ibm
 187      "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\
 188  \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))
 189
 190     (irix
 191      "^[a-z0-9/]+: \\(?:[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
 192  \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
 193
 194     (java
 195      "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
 196
 197     (jikes-file
 198      "^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0)
 199     (jikes-line
 200      "^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
 201      nil 1 nil 2 0
 202      (2 (compilation-face '(3))))
 203
 204     (gcc-include
 205      "^\\(?:In file included\\|                \\) from \
 206 \\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
 207
 208     (gnu
 209      "^\\(?:[a-zA-Z][-a-zA-Z0-9.]+: ?\\)?\
 210 \\([/.]*[a-zA-Z]:?[^ \t\n:]*\\): ?\
 211 \\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
 212 \\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
 213 \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
 214  *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\)\\)?"
 215      1 (2 . 5) (4 . 6) (7 . 8))
 216
 217     (lcc
 218      "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
 219      2 3 4 (1))
 220
 221     (makepp
 222      "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\) \\|.*?\\)\
 223 `\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'\\)"
 224      4 5 nil (1 . 2) 3
 225      ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'" nil nil
 226       (2 compilation-info-face)
 227       (3 compilation-line-face nil t)
 228       (1 (compilation-error-properties 2 3 nil nil nil 0 nil)
 229          append)))
 230
 231     (mips-1
 232      " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
 233     (mips-2
 234      " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
 235
 236     (msft
 237      "^\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
 238 : \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3))
 239
 240     (oracle
 241      "^Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):$"
 242      3 1 2)
 243
 244     (perl
 245      " at \\([^ \n]+\\) line \\([0-9]+\\)\\(?:[,.]\\|$\\)" 1 2)
 246
 247     (rxp
 248      "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\
 249  \\([0-9]+\\) of file://\\(.+\\)"
 250      4 2 3 (1))
 251
 252     (sparc-pascal-file
 253      "^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\
 254  [12][09][0-9][0-9] +\\(.*\\):$"
 255      1 nil nil 0)
 256     (sparc-pascal-line
 257      "^\\(\\(?:E\\|\\(w\\)\\) +[0-9]+\\) line \\([0-9]+\\) -  "
 258      nil 3 nil (2) nil (1 (compilation-face '(2))))
 259     (sparc-pascal-example
 260      "^ +\\([0-9]+\\) +.*\n\\(\\(?:e\\|\\(w\\)\\) [0-9]+\\)-+"
 261      nil 1 nil (3) nil (2 (compilation-face '(3))))
 262
 263     (sun
 264      ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[a-zA-Z0-9 ]+, \\)?\
 265 File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
 266      3 4 5 (1 . 2))
 267
 268     (sun-ada
 269      "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
 270
 271     (ultrix
 272      "^\\(?:cfe\\|fort\\): \\(Warning\\)?[^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3 nil (1))
 273
 274     (4bsd
 275      "\\(?:^\\|::  \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
 276 \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)))
 277   "Alist of values for `compilation-error-regexp-alist'.")
 278
 279 (defcustom compilation-error-regexp-alist
 280   (mapcar 'car compilation-error-regexp-alist-alist)
 281   "Alist that specifies how to match errors in compiler output.
 282 Note that on Unix exerything is a valid filename, so these
 283 matchers must make some common sense assumptions, which catch
 284 normal cases.  A shorter list will be lighter on resource usage.
 285
 286 Instead of an alist element, you can use a symbol, which is
 287 looked up in `compilation-error-regexp-alist-alist'.  You can see
 288 the predefined symbols and their effects in the file
 289 `etc/compilation.txt' (linked below if your are customizing this).
 290
 291 Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK
 292 HIGHLIGHT...]).  If REGEXP matches, the FILE'th subexpression
 293 gives the file name, and the LINE'th subexpression gives the line
 294 number.  The COLUMN'th subexpression gives the column number on
 295 that line.
 296
 297 If FILE, LINE or COLUMN are nil or that index didn't match, that
 298 information is not present on the matched line.  In that case the
 299 file name is assumed to be the same as the previous one in the
 300 buffer, line number defaults to 1 and column defaults to
 301 beginning of line's indentation.
 302
 303 FILE can also have the form (FILE FORMAT...), where the FORMATs
 304 \(e.g. \"%s.c\") will be applied in turn to the recognized file
 305 name, until a file of that name is found.  Or FILE can also be a
 306 function to return the filename.
 307
 308 LINE can also be of the form (LINE . END-LINE) meaning a range
 309 of lines.  COLUMN can also be of the form (COLUMN . END-COLUMN)
 310 meaning a range of columns starting on LINE and ending on
 311 END-LINE, if that matched.
 312
 313 TYPE is 2 or nil for a real error or 1 for warning or 0 for info.
 314 TYPE can also be of the form (WARNING . INFO).  In that case this
 315 will be equivalent to 1 if the WARNING'th subexpression matched
 316 or else equivalent to 0 if the INFO'th subexpression matched.
 317 See `compilation-error-face', `compilation-warning-face',
 318 `compilation-info-face' and `compilation-skip-threshold'.
 319
 320 What matched the HYPERLINK'th subexpression has `mouse-face' and
 321 `compilation-message-face' applied.  If this is nil, the text
 322 matched by the whole REGEXP becomes the hyperlink.
 323
 324 Additional HIGHLIGHTs as described under `font-lock-keywords' can
 325 be added."
 326   :type `(set :menu-tag "Pick"
 327               ,@(mapcar (lambda (elt)
 328                           (list 'const (car elt)))
 329                         compilation-error-regexp-alist-alist))
 330   :link `(file-link :tag "example file"
 331                     ,(concat doc-directory "compilation.txt"))
 332   :group 'compilation)
 333
 334 (defvar compilation-directory nil
 335   "Directory to restore to when doing `recompile'.")
 336
 337 (defvar compilation-directory-matcher
 338   '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1))
 339   "A list for tracking when directories are entered or left.
 340 Nil means not to track directories, e.g. if all file names are absolute.  The
 341 first element is the REGEXP matching these messages.  It can match any number
 342 of variants, e.g. different languages.  The remaining elements are all of the
 343 form (DIR .  LEAVE).  If for any one of these the DIR'th subexpression
 344 matches, that is a directory name.  If LEAVE is nil or the corresponding
 345 LEAVE'th subexpression doesn't match, this message is about going into another
 346 directory.  If it does match anything, this message is about going back to the
 347 directory we were in before the last entering message.  If you change this,
 348 you may also want to change `compilation-page-delimiter'.")
 349
 350 (defvar compilation-page-delimiter
 351   "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory `.+'\n\\)+"
 352   "Value of `page-delimiter' in Compilation mode.")
 353
 354 (defvar compilation-mode-font-lock-keywords
 355    '(;; configure output lines.
 356      ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$"
 357       (1 font-lock-variable-name-face)
 358       (2 (compilation-face '(4 . 3))))
 359      ;; Command output lines.  Recognize `make[n]:' lines too.
 360      ("^\\([A-Za-z_0-9/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
 361       (1 font-lock-function-name-face) (3 compilation-line-face nil t))
 362      (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1)
 363      ("^Compilation finished" . compilation-info-face)
 364      ("^Compilation exited abnormally" . compilation-error-face))
 365    "Additional things to highlight in Compilation mode.
 366 This gets tacked on the end of the generated expressions.")
 367
 368 (defvar compilation-highlight-regexp t
 369   "Regexp matching part of visited source lines to highlight temporarily.
 370 Highlight entire line if t; don't highlight source lines if nil.")
 371
 372 (defvar compilation-highlight-overlay nil
 373   "Overlay used to temporarily highlight compilation matches.")
 374
 375 (defcustom compilation-error-screen-columns t
 376   "*If non-nil, column numbers in error messages are screen columns.
 377 Otherwise they are interpreted as character positions, with
 378 each character occupying one column.
 379 The default is to use screen columns, which requires that the compilation
 380 program and Emacs agree about the display width of the characters,
 381 especially the TAB character."
 382   :type 'boolean
 383   :group 'compilation
 384   :version "20.4")
 385
 386 (defcustom compilation-read-command t
 387   "*Non-nil means \\[compile] reads the compilation command to use.
 388 Otherwise, \\[compile] just uses the value of `compile-command'."
 389   :type 'boolean
 390   :group 'compilation)
 391
 392 ;;;###autoload
 393 (defcustom compilation-ask-about-save t
 394   "*Non-nil means \\[compile] asks which buffers to save before compiling.
 395 Otherwise, it saves all modified buffers without asking."
 396   :type 'boolean
 397   :group 'compilation)
 398
 399 ;;;###autoload
 400 (defcustom compilation-search-path '(nil)
 401   "*List of directories to search for source files named in error messages.
 402 Elements should be directory names, not file names of directories.
 403 nil as an element means to try the default directory."
 404   :type '(repeat (choice (const :tag "Default" nil)
 405                          (string :tag "Directory")))
 406   :group 'compilation)
 407
 408 (defcustom compile-command "make -k "
 409   "*Last shell command used to do a compilation; default for next compilation.
 410
 411 Sometimes it is useful for files to supply local values for this variable.
 412 You might also use mode hooks to specify it in certain modes, like this:
 413
 414     (add-hook 'c-mode-hook
 415        (lambda ()
 416          (unless (or (file-exists-p \"makefile\")
 417                      (file-exists-p \"Makefile\"))
 418            (set (make-local-variable 'compile-command)
 419                 (concat \"make -k \"
 420                         (file-name-sans-extension buffer-file-name))))))"
 421   :type 'string
 422   :group 'compilation)
 423
 424 ;; A weak per-compilation-buffer hash indexed by (FILENAME . DIRECTORY).  Each
 425 ;; value is a FILE-STRUCTURE as described above, with the car eq to the hash
 426 ;; key.  This holds the tree seen from root, for storing new nodes.
 427 (defvar compilation-locs ())
 428
 429 (defvar compilation-debug nil
 430   "*Set this to `t' before creating a *compilation* buffer.
 431 Then every error line will have a debug text property with the matcher that
 432 fit this line and the match data.  Use `describe-text-properties'.")
 433
 434 (defvar compilation-exit-message-function nil "\
 435 If non-nil, called when a compilation process dies to return a status message.
 436 This should be a function of three arguments: process status, exit status,
 437 and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
 438 write into the compilation buffer, and to put in its mode line.")
 439
 440 (defvar compilation-environment nil
 441   "*List of environment variables for compilation to inherit.
 442 Each element should be a string of the form ENVVARNAME=VALUE.
 443 This list is temporarily prepended to `process-environment' prior to
 444 starting the compilation process.")
 445
 446 ;; History of compile commands.
 447 (defvar compile-history nil)
 448
 449 (defface compilation-warning-face
 450   '((((type tty) (class color)) (:foreground "cyan" :weight bold))
 451     (((class color)) (:foreground "Orange" :weight bold))
 452     (t (:weight bold)))
 453   "Face used to highlight compiler warnings."
 454   :group 'font-lock-highlighting-faces
 455   :version "21.4")
 456
 457 (defface compilation-info-face
 458   '((((type tty) (class color)) (:foreground "green" :weight bold))
 459     (((class color) (background light)) (:foreground "Green3" :weight bold))
 460     (((class color) (background dark)) (:foreground "Green" :weight bold))
 461     (t (:weight bold)))
 462   "Face used to highlight compiler warnings."
 463   :group 'font-lock-highlighting-faces
 464   :version "21.4")
 465
 466 (defvar compilation-message-face nil
 467   "Face name to use for whole messages.
 468 Faces `compilation-error-face', `compilation-warning-face',
 469 `compilation-info-face', `compilation-line-face' and
 470 `compilation-column-face' get prepended to this, when applicable.")
 471
 472 (defvar compilation-error-face 'font-lock-warning-face
 473   "Face name to use for file name in error messages.")
 474
 475 (defvar compilation-warning-face 'compilation-warning-face
 476   "Face name to use for file name in warning messages.")
 477
 478 (defvar compilation-info-face 'compilation-info-face
 479   "Face name to use for file name in informational messages.")
 480
 481 (defvar compilation-line-face 'font-lock-variable-name-face
 482   "Face name to use for line number in message.")
 483
 484 (defvar compilation-column-face 'font-lock-type-face
 485   "Face name to use for column number in message.")
 486
 487 ;; same faces as dired uses
 488 (defvar compilation-enter-directory-face 'font-lock-function-name-face
 489   "Face name to use for column number in message.")
 490
 491 (defvar compilation-leave-directory-face 'font-lock-type-face
 492   "Face name to use for column number in message.")
 493
 494
 495
 496 ;; Used for compatibility with the old compile.el.
 497 (defvar compilation-parsing-end nil)
 498 (defvar compilation-parse-errors-function nil)
 499 (defvar compilation-error-list nil)
 500 (defvar compilation-old-error-list nil)
 501
 502 (defun compilation-face (type)
 503   (or (and (car type) (match-end (car type)) compilation-warning-face)
 504       (and (cdr type) (match-end (cdr type)) compilation-info-face)
 505       compilation-error-face))
 506
 507 (defun compilation-directory-properties (idx leave)
 508   (if leave (setq leave (match-end leave)))
 509   ;; find previous stack, and push onto it, or if `leave' pop it
 510   (let ((dir (previous-single-property-change (point) 'directory)))
 511     (setq dir (if dir (or (get-text-property (1- dir) 'directory)
 512                           (get-text-property dir 'directory))))
 513     `(face ,(if leave
 514                 compilation-leave-directory-face
 515               compilation-enter-directory-face)
 516       directory ,(if leave
 517                      (or (cdr dir)
 518                          '(nil))        ; nil only isn't a property-change
 519                    (cons (match-string-no-properties idx) dir))
 520       mouse-face highlight
 521       help-echo "mouse-2: visit current directory")))
 522
 523 ;; Data type `reverse-ordered-alist' retriever.  This function retrieves the
 524 ;; KEY element from the ALIST, creating it in the right position if not already
 525 ;; present. ALIST structure is
 526 ;; '(ANCHOR (KEY1 ...) (KEY2 ...)... (KEYn ALIST ...))
 527 ;; ANCHOR is ignored, but necessary so that elements can be inserted.  KEY1
 528 ;; may be nil.  The other KEYs are ordered backwards so that growing line
 529 ;; numbers can be inserted in front and searching can abort after half the
 530 ;; list on average.
 531 (defmacro compilation-assq (key alist)
 532   `(let* ((l1 ,alist)
 533           (l2 (cdr l1)))
 534      (car (if (if (null ,key)
 535                   (if l2 (null (caar l2)))
 536                 (while (if l2 (if (caar l2) (< ,key (caar l2)) t))
 537                   (setq l1 l2
 538                         l2 (cdr l1)))
 539                 (if l2 (eq ,key (caar l2))))
 540               l2
 541             (setcdr l1 (cons (list ,key) l2))))))
 542
 543
 544 ;; This function is the central driver, called when font-locking to gather
 545 ;; all information needed to later jump to corresponding source code.
 546 ;; Return a property list with all meta information on this error location.
 547 (defun compilation-error-properties (file line end-line col end-col type fmt)
 548   (unless (< (next-single-property-change (match-beginning 0) 'directory nil (point))
 549              (point))
 550     (if file
 551         (if (functionp file)
 552             (setq file (funcall file))
 553           (let (dir)
 554             (setq file (match-string-no-properties file))
 555             (unless (file-name-absolute-p file)
 556               (setq dir (previous-single-property-change (point) 'directory)
 557                     dir (if dir (or (get-text-property (1- dir) 'directory)
 558                                     (get-text-property dir 'directory)))))
 559             (setq file (cons file (car dir)) ; top of dir stack is current
 560                   file (or (gethash file compilation-locs)
 561                            (puthash file (list file fmt) compilation-locs)))))
 562       ;; This message didn't mention one, get it from previous
 563       (setq file (previous-single-property-change (point) 'message)
 564             file (or (if file
 565                          (nth 2 (car (or (get-text-property (1- file) 'message)
 566                                          (get-text-property file 'message)))))
 567                      ;; no previous either -- let font-lock continue
 568                      (gethash (setq file '("*unknown*")) compilation-locs)
 569                      (puthash file (list file fmt) compilation-locs))))
 570     ;; All of these fields are optional, get them only if we have an index, and
 571     ;; it matched some part of the message.
 572     (and line
 573          (setq line (match-string-no-properties line))
 574          (setq line (string-to-number line)))
 575     (and end-line
 576          (setq end-line (match-string-no-properties end-line))
 577          (setq end-line (string-to-number end-line)))
 578     (and col
 579          (setq col (match-string-no-properties col))
 580          (setq col (- (string-to-number col) compilation-first-column)))
 581     (if (and end-col (setq end-col (match-string-no-properties end-col)))
 582         (setq end-col (- (string-to-number end-col) compilation-first-column))
 583       (if end-line (setq end-col -1)))
 584     (if (consp type)                    ; not a preset type, check what it is.
 585         (setq type (or (and (car type) (match-end (car type)) 1)
 586                        (and (cdr type) (match-end (cdr type)) 0)
 587                        2)))
 588     ;; Get any (first) already existing marker (if any has one, all have one).
 589     ;; Do this first, as the next assq`s may create new nodes.
 590     (let ((marker (nth 3 (car (cdar (cddr file)))))
 591           (loc (compilation-assq line (cdr file)))
 592           end-loc)
 593       (if end-line
 594           (setq end-loc (compilation-assq end-line (cdr file))
 595                 end-loc (compilation-assq end-col end-loc))
 596         (if end-col                     ; use same line element
 597             (setq end-loc (compilation-assq end-col loc))))
 598       (setq loc (compilation-assq col loc))
 599       ;; If they are new, make the loc(s) reference the file they point to.
 600       (or (cdr loc) (setcdr loc (list line file)))
 601       (if end-loc
 602           (or (cdr end-loc) (setcdr end-loc (list (or end-line line) file))))
 603       ;; If we'd found a marker, ensure that the new locs also get markers
 604       (when (and marker
 605                  (not (or (cddr loc) (cddr end-loc))) ; maybe new node w/o marker
 606                  (marker-buffer marker)) ; other marker still valid
 607         (or line (setq line 1))          ; normalize no linenumber to line 1
 608         (catch 'marker                 ; find nearest loc, at least one exists
 609           (dolist (x (cddr file))
 610             (if (> (or (car x) 1) line)
 611                 (setq marker x)
 612               (if (eq (or (car x) 1) line)
 613                   (if (cdr (cddr x))    ; at least one other column
 614                       (throw 'marker (setq marker x))
 615                     (if marker (throw 'marker t)))
 616                 (throw 'marker (or marker (setq marker x)))))))
 617         (setq marker (if (eq (car (cddr marker)) col)
 618                          (nthcdr 3 marker)
 619                        (cddr marker))
 620               file compilation-error-screen-columns)
 621         (with-current-buffer (marker-buffer (cddr marker))
 622           (save-restriction
 623             (widen)
 624             (goto-char (marker-position (cddr marker)))
 625             (beginning-of-line (- line (car (cadr marker)) -1))
 626             (if file                    ; original c.-error-screen-columns
 627                 (move-to-column (car loc))
 628               (forward-char (car loc)))
 629             (setcdr (cdr loc) (point-marker))
 630             (when end-loc
 631               (beginning-of-line (- end-line line -1))
 632               (if (< end-col 0)
 633                   (end-of-line)
 634                 (if file                ; original c.-error-screen-columns
 635                     (move-to-column (car end-loc))
 636                   (forward-char (car end-loc))))
 637               (setcdr (cdr end-loc) (point-marker))))))
 638       ;; Must start with face
 639       `(face ,compilation-message-face
 640              message (,loc ,type ,end-loc)
 641              ,@(if compilation-debug
 642                    `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
 643                             ,@(match-data))))
 644              help-echo ,(if col
 645                             "mouse-2: visit this file, line and column"
 646                           (if line
 647                               "mouse-2: visit this file and line"
 648                             "mouse-2: visit this file"))
 649              mouse-face highlight))))
 650
 651 (defun compilation-mode-font-lock-keywords ()
 652   "Return expressions to highlight in Compilation mode."
 653   (nconc
 654    ;; make directory tracking
 655    (if compilation-directory-matcher
 656        `((,(car compilation-directory-matcher)
 657           ,@(mapcar (lambda (elt)
 658                       `(,(car elt)
 659                         (compilation-directory-properties
 660                          ,(car elt) ,(cdr elt))
 661                         t))
 662                     (cdr compilation-directory-matcher)))))
 663
 664    ;; Compiler warning/error lines.
 665    (mapcar (lambda (item)
 666              (if (symbolp item)
 667                  (setq item (cdr (assq item
 668                                        compilation-error-regexp-alist-alist))))
 669              (let ((file (nth 1 item))
 670                    (line (nth 2 item))
 671                    (col (nth 3 item))
 672                    (type (nth 4 item))
 673                    end-line end-col fmt)
 674                (if (consp file) (setq fmt (cdr file)      file (car file)))
 675                (if (consp line) (setq end-line (cdr line) line (car line)))
 676                (if (consp col)  (setq end-col (cdr col)   col (car col)))
 677
 678                (if (symbolp line)
 679                    ;; The old compile.el had here an undocumented hook that
 680                    ;; allowed `line' to be a function that computed the actual
 681                    ;; error location.  Let's do our best.
 682                    `(,(car item)
 683                      (0 (compilation-compat-error-properties
 684                          (funcall ',line (list* (match-string ,file)
 685                                                 default-directory
 686                                                 ',(nthcdr 4 item))
 687                                   ,(if col `(match-string ,col)))))
 688                      (,file compilation-error-face t))
 689
 690                  `(,(nth 0 item)
 691
 692                    ,@(when (integerp file)
 693                        `((,file ,(if (consp type)
 694                                      `(compilation-face ',type)
 695                                    (aref [compilation-info-face
 696                                           compilation-warning-face
 697                                           compilation-error-face]
 698                                          (or type 2))))))
 699
 700                    ,@(when line
 701                        `((,line compilation-line-face nil t)))
 702                    ,@(when end-line
 703                        `((,end-line compilation-line-face nil t)))
 704
 705                    ,@(when col
 706                        `((,col compilation-column-face nil t)))
 707                    ,@(when end-col
 708                        `((,end-col compilation-column-face nil t)))
 709
 710                    ,@(nthcdr 6 item)
 711                    (,(or (nth 5 item) 0)
 712                     (compilation-error-properties ',file ,line ,end-line
 713                                                   ,col ,end-col ',(or type 2)
 714                                                   ',fmt)
 715                     append)))))         ; for compilation-message-face
 716            compilation-error-regexp-alist)
 717
 718    compilation-mode-font-lock-keywords))
 719
 720 \f
 721 ;;;###autoload
 722 (defun compile (command &optional comint)
 723   "Compile the program including the current buffer.  Default: run `make'.
 724 Runs COMMAND, a shell command, in a separate process asynchronously
 725 with output going to the buffer `*compilation*'.
 726
 727 If optional second arg COMINT is t the buffer will be in comint mode with
 728 `compilation-shell-minor-mode'.
 729
 730 You can then use the command \\[next-error] to find the next error message
 731 and move to the source code that caused it.
 732
 733 Interactively, prompts for the command if `compilation-read-command' is
 734 non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
 735
 736 To run more than one compilation at once, start one and rename
 737 the \`*compilation*' buffer to some other name with
 738 \\[rename-buffer].  Then start the next one.  On most systems,
 739 termination of the main compilation process kills its
 740 subprocesses.
 741
 742 The name used for the buffer is actually whatever is returned by
 743 the function in `compilation-buffer-name-function', so you can set that
 744 to a function that generates a unique name."
 745   (interactive
 746    (if (or compilation-read-command current-prefix-arg)
 747        (list (read-from-minibuffer "Compile command: "
 748                                  (eval compile-command) nil nil
 749                                  '(compile-history . 1)))
 750      (list (eval compile-command))))
 751   (unless (equal command (eval compile-command))
 752     (setq compile-command command))
 753   (save-some-buffers (not compilation-ask-about-save) nil)
 754   (setq compilation-directory default-directory)
 755   (compilation-start command comint))
 756
 757 ;; run compile with the default command line
 758 (defun recompile ()
 759   "Re-compile the program including the current buffer.
 760 If this is run in a compilation-mode buffer, re-use the arguments from the
 761 original use.  Otherwise, it recompiles using `compile-command'."
 762   (interactive)
 763   (save-some-buffers (not compilation-ask-about-save) nil)
 764   (let ((default-directory (or compilation-directory default-directory)))
 765     (apply 'compilation-start (or compilation-arguments
 766                                   `(,(eval compile-command))))))
 767
 768 (defcustom compilation-scroll-output nil
 769   "*Non-nil to scroll the *compilation* buffer window as output appears.
 770
 771 Setting it causes the compilation-mode commands to put point at the
 772 end of their output window so that the end of the output is always
 773 visible rather than the begining."
 774   :type 'boolean
 775   :version "20.3"
 776   :group 'compilation)
 777
 778
 779 (defun compilation-buffer-name (mode-name name-function)
 780   "Return the name of a compilation buffer to use.
 781 If NAME-FUNCTION is non-nil, call it with one argument MODE-NAME
 782 to determine the buffer name.
 783 Likewise if `compilation-buffer-name-function' is non-nil.
 784 If current buffer is in Compilation mode for the same mode name
 785 return the name of the current buffer, so that it gets reused.
 786 Otherwise, construct a buffer name from MODE-NAME."
 787   (cond (name-function
 788          (funcall name-function mode-name))
 789         (compilation-buffer-name-function
 790          (funcall compilation-buffer-name-function mode-name))
 791         ((and (eq major-mode 'compilation-mode)
 792               (equal mode-name (nth 2 compilation-arguments)))
 793          (buffer-name))
 794         (t
 795          (concat "*" (downcase mode-name) "*"))))
 796
 797 ;; This is a rough emulation of the old hack, until the transition to new
 798 ;; compile is complete.
 799 (defun compile-internal (command error-message
 800                                  &optional name-of-mode parser
 801                                  error-regexp-alist name-function
 802                                  enter-regexp-alist leave-regexp-alist
 803                                  file-regexp-alist nomessage-regexp-alist
 804                                  no-async highlight-regexp local-map)
 805   (if parser
 806       (error "Compile now works very differently, see `compilation-error-regexp-alist'"))
 807   (let ((compilation-error-regexp-alist
 808          (append file-regexp-alist (or error-regexp-alist
 809                                        compilation-error-regexp-alist)))
 810         (compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?"
 811                                                      "\\1" error-message)))
 812     (compilation-start command nil name-function highlight-regexp)))
 813 (make-obsolete 'compile-internal 'compilation-start)
 814
 815 (defun compilation-start (command &optional mode name-function highlight-regexp)
 816   "Run compilation command COMMAND (low level interface).
 817 The rest of the arguments are optional; for them, nil means use the default.
 818
 819 MODE is the major mode to set in the compilation buffer.  Mode
 820 may also be `t' meaning `compilation-shell-minor-mode' under `comint-mode'.
 821 NAME-FUNCTION is a function called to name the buffer.
 822
 823 If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
 824 matching section of the visited source line; the default is to use the
 825 global value of `compilation-highlight-regexp'.
 826
 827 Returns the compilation buffer created."
 828   (or mode (setq mode 'compilation-mode))
 829   (let ((name-of-mode
 830          (if (eq mode t)
 831              (prog1 "compilation" (require 'comint))
 832            (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
 833         (process-environment
 834          (append
 835           compilation-environment
 836           (if (and (boundp 'system-uses-terminfo)
 837                    system-uses-terminfo)
 838               (list "TERM=dumb" "TERMCAP="
 839                     (format "COLUMNS=%d" (window-width)))
 840             (list "TERM=emacs"
 841                   (format "TERMCAP=emacs:co#%d:tc=unknown:"
 842                           (window-width))))
 843           ;; Set the EMACS variable, but
 844           ;; don't override users' setting of $EMACS.
 845           (unless (getenv "EMACS") '("EMACS=t"))
 846           process-environment))
 847         (thisdir default-directory)
 848         outwin outbuf)
 849     (with-current-buffer
 850         (setq outbuf
 851               (get-buffer-create
 852                (compilation-buffer-name name-of-mode name-function)))
 853       (let ((comp-proc (get-buffer-process (current-buffer))))
 854         (if comp-proc
 855             (if (or (not (eq (process-status comp-proc) 'run))
 856                     (yes-or-no-p
 857                      (format "A %s process is running; kill it? "
 858                              name-of-mode)))
 859                 (condition-case ()
 860                     (progn
 861                       (interrupt-process comp-proc)
 862                       (sit-for 1)
 863                       (delete-process comp-proc))
 864                   (error nil))
 865               (error "Cannot have two processes in `%s' at once"
 866                      (buffer-name)))))
 867       ;; Clear out the compilation buffer and make it writable.
 868       ;; Change its default-directory to the directory where the compilation
 869       ;; will happen, and insert a `cd' command to indicate this.
 870       (setq buffer-read-only nil)
 871       (buffer-disable-undo (current-buffer))
 872       (erase-buffer)
 873       (buffer-enable-undo (current-buffer))
 874       (setq default-directory thisdir)
 875       ;; output a mode setter, for saving and later reloading this buffer
 876       (insert "cd " thisdir "   # -*-" name-of-mode
 877               "-*-\nEntering directory `" thisdir "'\n" command "\n")
 878       (set-buffer-modified-p nil))
 879     ;; If we're already in the compilation buffer, go to the end
 880     ;; of the buffer, so point will track the compilation output.
 881     (if (eq outbuf (current-buffer))
 882         (goto-char (point-max)))
 883     ;; Pop up the compilation buffer.
 884     (setq outwin (display-buffer outbuf nil t))
 885     (with-current-buffer outbuf
 886       (if (not (eq mode t))
 887           (funcall mode)
 888         (with-no-warnings (comint-mode))
 889         (compilation-shell-minor-mode))
 890       ;; In what way is it non-ergonomic ?  -stef
 891       ;; (toggle-read-only 1) ;;; Non-ergonomic.
 892       (if highlight-regexp
 893           (set (make-local-variable 'compilation-highlight-regexp)
 894                highlight-regexp))
 895       (set (make-local-variable 'compilation-arguments)
 896            (list command mode name-function highlight-regexp))
 897       (set (make-local-variable 'revert-buffer-function)
 898            'compilation-revert-buffer)
 899       (set-window-start outwin (point-min))
 900       (or (eq outwin (selected-window))
 901           (set-window-point outwin (point)))
 902       ;; The setup function is called before compilation-set-window-height
 903       ;; so it can set the compilation-window-height buffer locally.
 904       (if compilation-process-setup-function
 905           (funcall compilation-process-setup-function))
 906       (compilation-set-window-height outwin)
 907       ;; Start the compilation.
 908       (if (fboundp 'start-process)
 909           (let ((proc (if (eq mode t)
 910                           (get-buffer-process
 911                            (with-no-warnings
 912                             (comint-exec outbuf (downcase mode-name)
 913                                          shell-file-name nil `("-c" ,command))))
 914                         (start-process-shell-command (downcase mode-name)
 915                                                      outbuf command))))
 916             ;; Make the buffer's mode line show process state.
 917             (setq mode-line-process '(":%s"))
 918             (set-process-sentinel proc 'compilation-sentinel)
 919             (set-process-filter proc 'compilation-filter)
 920             (set-marker (process-mark proc) (point) outbuf)
 921             (setq compilation-in-progress
 922                   (cons proc compilation-in-progress)))
 923         ;; No asynchronous processes available.
 924         (message "Executing `%s'..." command)
 925         ;; Fake modeline display as if `start-process' were run.
 926         (setq mode-line-process ":run")
 927         (force-mode-line-update)
 928         (let ((status (call-process shell-file-name nil outbuf nil "-c"
 929                                     command)))
 930           (cond ((numberp status)
 931                  (compilation-handle-exit 'exit status
 932                                           (if (zerop status)
 933                                               "finished\n"
 934                                             (format "\
 935 exited abnormally with code %d\n"
 936                                                     status))))
 937                 ((stringp status)
 938                  (compilation-handle-exit 'signal status
 939                                           (concat status "\n")))
 940                 (t
 941                  (compilation-handle-exit 'bizarre status status))))
 942         (message "Executing `%s'...done" command)))
 943     (if (buffer-local-value 'compilation-scroll-output outbuf)
 944         (save-selected-window
 945           (select-window outwin)
 946           (goto-char (point-max))))
 947     ;; Make it so the next C-x ` will use this buffer.
 948     (setq compilation-last-buffer outbuf)))
 949
 950 (defun compilation-set-window-height (window)
 951   "Set the height of WINDOW according to `compilation-window-height'."
 952   (let ((height (buffer-local-value 'compilation-window-height (window-buffer window))))
 953     (and height
 954          (= (window-width window) (frame-width (window-frame window)))
 955          ;; If window is alone in its frame, aside from a minibuffer,
 956          ;; don't change its height.
 957          (not (eq window (frame-root-window (window-frame window))))
 958          ;; This save-current-buffer prevents us from changing the current
 959          ;; buffer, which might not be the same as the selected window's buffer.
 960          (save-current-buffer
 961            (save-selected-window
 962              (select-window window)
 963              (enlarge-window (- height (window-height))))))))
 964
 965 (defvar compilation-menu-map
 966   (let ((map (make-sparse-keymap "Errors")))
 967     (define-key map [stop-subjob]
 968       '("Stop Compilation" . kill-compilation))
 969     (define-key map [compilation-mode-separator2]
 970       '("----" . nil))
 971     (define-key map [compilation-first-error]
 972       '("First Error" . first-error))
 973     (define-key map [compilation-previous-error]
 974       '("Previous Error" . previous-error))
 975     (define-key map [compilation-next-error]
 976       '("Next Error" . next-error))
 977     map))
 978
 979 (defvar compilation-minor-mode-map
 980   (let ((map (make-sparse-keymap)))
 981     (define-key map [mouse-2] 'compile-goto-error)
 982     (define-key map "\C-c\C-c" 'compile-goto-error)
 983     (define-key map "\C-m" 'compile-goto-error)
 984     (define-key map "\C-c\C-k" 'kill-compilation)
 985     (define-key map "\M-n" 'compilation-next-error)
 986     (define-key map "\M-p" 'compilation-previous-error)
 987     (define-key map "\M-{" 'compilation-previous-file)
 988     (define-key map "\M-}" 'compilation-next-file)
 989     ;; Set up the menu-bar
 990     (define-key map [menu-bar compilation]
 991       (cons "Errors" compilation-menu-map))
 992     map)
 993   "Keymap for `compilation-minor-mode'.")
 994
 995 (defvar compilation-shell-minor-mode-map
 996   (let ((map (make-sparse-keymap)))
 997     (define-key map [mouse-2] 'compile-goto-error)
 998     (define-key map "\M-\C-m" 'compile-goto-error)
 999     (define-key map "\M-\C-n" 'compilation-next-error)
1000     (define-key map "\M-\C-p" 'compilation-previous-error)
1001     (define-key map "\M-{" 'compilation-previous-file)
1002     (define-key map "\M-}" 'compilation-next-file)
1003     ;; Set up the menu-bar
1004     (define-key map [menu-bar compilation]
1005       (cons "Errors" compilation-menu-map))
1006     map)
1007   "Keymap for `compilation-shell-minor-mode'.")
1008
1009 (defvar compilation-mode-map
1010   (let ((map (make-sparse-keymap)))
1011     (set-keymap-parent map compilation-minor-mode-map)
1012     (define-key map " " 'scroll-up)
1013     (define-key map "\^?" 'scroll-down)
1014
1015     ;; Set up the menu-bar
1016     (define-key map [menu-bar compilation]
1017       (cons "Compile" (make-sparse-keymap "Compile")))
1018     (define-key map [menu-bar compilation compilation-separator2]
1019       '("----" . nil))
1020     (define-key map [menu-bar compilation compilation-grep]
1021       '("Search Files (grep)" . grep))
1022     (define-key map [menu-bar compilation compilation-recompile]
1023       '("Recompile" . recompile))
1024     (define-key map [menu-bar compilation compilation-compile]
1025       '("Compile..." . compile))
1026     map)
1027   "Keymap for compilation log buffers.
1028 `compilation-minor-mode-map' is a parent of this.")
1029
1030 (put 'compilation-mode 'mode-class 'special)
1031
1032 (defvar compilation-skip-to-next-location t
1033   "*If non-nil, skip multiple error messages for the same source location.")
1034
1035 (defcustom compilation-skip-threshold 1
1036   "*Compilation motion commands skip less important messages.
1037 The value can be either 2 -- skip anything less than error, 1 --
1038 skip anything less than warning or 0 -- don't skip any messages.
1039 Note that all messages not positively identified as warning or
1040 info, are considered errors."
1041   :type '(choice (const :tag "Warnings and info" 2)
1042                  (const :tag "Info" 1)
1043                  (const :tag "None" 0))
1044   :group 'compilation
1045   :version "21.4")
1046
1047 (defcustom compilation-skip-visited nil
1048   "*Compilation motion commands skip visited messages if this is t.
1049 Visited messages are ones for which the file, line and column have been jumped
1050 to from the current content in the current compilation buffer, even if it was
1051 from a different message."
1052   :type 'boolean
1053   :group 'compilation
1054   :version "21.4")
1055
1056 ;;;###autoload
1057 (defun compilation-mode ()
1058   "Major mode for compilation log buffers.
1059 \\<compilation-mode-map>To visit the source for a line-numbered error,
1060 move point to the error message line and type \\[compile-goto-error].
1061 To kill the compilation, type \\[kill-compilation].
1062
1063 Runs `compilation-mode-hook' with `run-hooks' (which see)."
1064   (interactive)
1065   (kill-all-local-variables)
1066   (use-local-map compilation-mode-map)
1067   (setq major-mode 'compilation-mode
1068         mode-name "Compilation")
1069   (set (make-local-variable 'page-delimiter)
1070        compilation-page-delimiter)
1071   (compilation-setup)
1072   (run-mode-hooks 'compilation-mode-hook))
1073
1074 (defmacro define-compilation-mode (mode name doc &rest body)
1075   "This is like `define-derived-mode' without the PARENT argument.
1076 The parent is always `compilation-mode' and the customizable `compilation-...'
1077 variables are also set from the name of the mode you have chosen, by replacing
1078 the fist word, e.g `compilation-scroll-output' from `grep-scroll-output' if that
1079 variable exists."
1080   (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
1081     `(define-derived-mode ,mode compilation-mode ,name
1082        ,doc
1083        ,@(mapcar (lambda (v)
1084                    (setq v (cons v
1085                                  (intern-soft (replace-regexp-in-string
1086                                                "^compilation" mode-name
1087                                                (symbol-name v)))))
1088                    (and (cdr v)
1089                         (or (boundp (cdr v))
1090                             (if (boundp 'byte-compile-bound-variables)
1091                                 (memq (cdr v) byte-compile-bound-variables)))
1092                         `(set (make-local-variable ',(car v)) ,(cdr v))))
1093                  '(compilation-buffer-name-function
1094                    compilation-directory-matcher
1095                    compilation-error
1096                    compilation-error-regexp-alist
1097                    compilation-error-regexp-alist-alist
1098                    compilation-error-screen-columns
1099                    compilation-finish-function
1100                    compilation-finish-functions
1101                    compilation-first-column
1102                    compilation-mode-font-lock-keywords
1103                    compilation-page-delimiter
1104                    compilation-parse-errors-filename-function
1105                    compilation-process-setup-function
1106                    compilation-scroll-output
1107                    compilation-search-path
1108                    compilation-skip-threshold
1109                    compilation-window-height))
1110        ,@body)))
1111
1112 (defun compilation-revert-buffer (ignore-auto noconfirm)
1113   (if buffer-file-name
1114       (let (revert-buffer-function)
1115         (revert-buffer ignore-auto noconfirm))
1116     (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
1117         (apply 'compilation-start compilation-arguments))))
1118
1119 (defvar compilation-current-error nil
1120   "Marker to the location from where the next error will be found.
1121 The global commands next/previous/first-error/goto-error use this.")
1122
1123 ;; A function name can't be a hook, must be something with a value.
1124 (defconst compilation-turn-on-font-lock 'turn-on-font-lock)
1125
1126 (defun compilation-setup (&optional minor)
1127   "Prepare the buffer for the compilation parsing commands to work."
1128   (make-local-variable 'compilation-current-error)
1129   (make-local-variable 'compilation-error-screen-columns)
1130   (setq compilation-last-buffer (current-buffer))
1131   (set (make-local-variable 'font-lock-extra-managed-props)
1132        '(directory message help-echo mouse-face debug))
1133   (set (make-local-variable 'compilation-locs)
1134        (make-hash-table :test 'equal :weakness 'value))
1135   ;; lazy-lock would never find the message unless it's scrolled to
1136   ;; jit-lock might fontify some things too late.
1137   (set (make-local-variable 'font-lock-support-mode) nil)
1138   (set (make-local-variable 'font-lock-maximum-size) nil)
1139   (let ((fld font-lock-defaults))
1140     (if (and minor fld)
1141         (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
1142       (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))
1143     (if minor
1144         (if font-lock-mode
1145             (if fld
1146                 (font-lock-fontify-buffer)
1147               (font-lock-change-mode)
1148               (turn-on-font-lock))
1149           (turn-on-font-lock))
1150       ;; maybe defer font-lock till after derived mode is set up
1151       (run-mode-hooks 'compilation-turn-on-font-lock))))
1152
1153 ;;;###autoload
1154 (define-minor-mode compilation-shell-minor-mode
1155   "Toggle compilation shell minor mode.
1156 With arg, turn compilation mode on if and only if arg is positive.
1157 In this minor mode, all the error-parsing commands of the
1158 Compilation major mode are available but bound to keys that don't
1159 collide with Shell mode.  See `compilation-mode'.
1160 Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'."
1161   nil " Shell-Compile"
1162   :group 'compilation
1163   (if compilation-shell-minor-mode
1164       (compilation-setup t)
1165     (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
1166     (font-lock-fontify-buffer)))
1167
1168 ;;;###autoload
1169 (define-minor-mode compilation-minor-mode
1170   "Toggle compilation minor mode.
1171 With arg, turn compilation mode on if and only if arg is positive.
1172 In this minor mode, all the error-parsing commands of the
1173 Compilation major mode are available.  See `compilation-mode'.
1174 Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
1175   nil " Compilation"
1176   :group 'compilation
1177   (if compilation-minor-mode
1178       (compilation-setup t)
1179     (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
1180     (font-lock-fontify-buffer)))
1181
1182 (defun compilation-handle-exit (process-status exit-status msg)
1183   "Write msg in the current buffer and hack its mode-line-process."
1184   (let ((buffer-read-only nil)
1185         (status (if compilation-exit-message-function
1186                     (funcall compilation-exit-message-function
1187                              process-status exit-status msg)
1188                   (cons msg exit-status)))
1189         (omax (point-max))
1190         (opoint (point)))
1191     ;; Record where we put the message, so we can ignore it
1192     ;; later on.
1193     (goto-char omax)
1194     (insert ?\n mode-name " " (car status))
1195     (if (and (numberp compilation-window-height)
1196              (zerop compilation-window-height))
1197         (message "%s" (cdr status)))
1198     (if (bolp)
1199         (forward-char -1))
1200     (insert " at " (substring (current-time-string) 0 19))
1201     (goto-char (point-max))
1202     ;; Prevent that message from being recognized as a compilation error.
1203     (add-text-properties omax (point)
1204                          (append '(compilation-handle-exit t) nil))
1205     (setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
1206     ;; Force mode line redisplay soon.
1207     (force-mode-line-update)
1208     (if (and opoint (< opoint omax))
1209         (goto-char opoint))
1210     (if compilation-finish-function
1211         (funcall compilation-finish-function (current-buffer) msg))
1212     (let ((functions compilation-finish-functions))
1213       (while functions
1214         (funcall (car functions) (current-buffer) msg)
1215         (setq functions (cdr functions))))))
1216
1217 ;; Called when compilation process changes state.
1218 (defun compilation-sentinel (proc msg)
1219   "Sentinel for compilation buffers."
1220   (let ((buffer (process-buffer proc)))
1221     (if (memq (process-status proc) '(signal exit))
1222         (progn
1223           (if (null (buffer-name buffer))
1224               ;; buffer killed
1225               (set-process-buffer proc nil)
1226             (with-current-buffer buffer
1227               ;; Write something in the compilation buffer
1228               ;; and hack its mode line.
1229               (compilation-handle-exit (process-status proc)
1230                                        (process-exit-status proc)
1231                                        msg)
1232               ;; Since the buffer and mode line will show that the
1233               ;; process is dead, we can delete it now.  Otherwise it
1234               ;; will stay around until M-x list-processes.
1235               (delete-process proc)))
1236           (setq compilation-in-progress (delq proc compilation-in-progress))
1237           ))))
1238
1239 (defun compilation-filter (proc string)
1240   "Process filter for compilation buffers.
1241 Just inserts the text, but uses `insert-before-markers'."
1242   (if (buffer-name (process-buffer proc))
1243       (with-current-buffer (process-buffer proc)
1244         (let ((inhibit-read-only t))
1245           (save-excursion
1246             (goto-char (process-mark proc))
1247             (insert-before-markers string)
1248             (run-hooks 'compilation-filter-hook))))))
1249
1250 (defsubst compilation-buffer-p (buffer)
1251   (local-variable-p 'compilation-locs buffer))
1252
1253 (defmacro compilation-loop (< property-change 1+ error)
1254   `(while (,< n 0)
1255       (or (setq pt (,property-change pt 'message))
1256           (error ,error compilation-error))
1257       ;; prop 'message usually has 2 changes, on and off, so re-search if off
1258       (or (setq msg (get-text-property pt 'message))
1259           (if (setq pt (,property-change pt 'message))
1260               (setq msg (get-text-property pt 'message)))
1261           (error ,error compilation-error))
1262       (or (< (cadr msg) compilation-skip-threshold)
1263           (if different-file
1264               (eq (prog1 last (setq last (nth 2 (car msg))))
1265                   last))
1266           (if compilation-skip-visited
1267               (nthcdr 4 (car msg)))
1268           (if compilation-skip-to-next-location
1269               (eq (car msg) loc))
1270           ;; count this message only if none of the above are true
1271           (setq n (,1+ n)))))
1272
1273 (defun compilation-next-error (n &optional different-file pt)
1274   "Move point to the next error in the compilation buffer.
1275 Prefix arg N says how many error messages to move forwards (or
1276 backwards, if negative).
1277 Does NOT find the source line like \\[next-error]."
1278   (interactive "p")
1279   (or (compilation-buffer-p (current-buffer))
1280       (error "Not in a compilation buffer"))
1281   (or pt (setq pt (point)))
1282   (setq compilation-last-buffer (current-buffer))
1283   (let* ((msg (get-text-property pt 'message))
1284          (loc (car msg))
1285          last)
1286     (if (zerop n)
1287         (unless (or msg                 ; find message near here
1288                     (setq msg (get-text-property (max (1- pt) (point-min))
1289                                                  'message)))
1290           (setq pt (previous-single-property-change pt 'message nil
1291                                                     (line-beginning-position)))
1292           (if pt         ; FIXME: `pt' can never be nil here anyway.  --stef
1293               (setq msg (get-text-property (max (1- pt) (point-min)) 'message))
1294             (setq pt (next-single-property-change pt 'message nil
1295                                                   (line-end-position)))
1296             (if pt       ; FIXME: `pt' can never be nil here anyway.  --stef
1297                 (setq msg (get-text-property pt 'message))
1298               (setq pt (point)))))
1299       (setq last (nth 2 (car msg)))
1300       (if (>= n 0)
1301           (compilation-loop > next-single-property-change 1-
1302                             (if (get-buffer-process (current-buffer))
1303                                 "No more %ss yet"
1304                               "Moved past last %s"))
1305         ;; Don't move "back" to message at or before point.
1306         ;; Pass an explicit (point-min) to make sure pt is non-nil.
1307         (setq pt (previous-single-property-change pt 'message nil (point-min)))
1308         (compilation-loop < previous-single-property-change 1+
1309                           "Moved back before first %s")))
1310     (goto-char pt)
1311     (or msg
1312         (error "No %s here" compilation-error))))
1313
1314 (defun compilation-previous-error (n)
1315   "Move point to the previous error in the compilation buffer.
1316 Prefix arg N says how many error messages to move backwards (or
1317 forwards, if negative).
1318 Does NOT find the source line like \\[previous-error]."
1319   (interactive "p")
1320   (compilation-next-error (- n)))
1321
1322 (defun next-error-no-select (n)
1323   "Move point to the next error in the compilation buffer and highlight match.
1324 Prefix arg N says how many error messages to move forwards (or
1325 backwards, if negative).
1326 Finds and highlights the source line like \\[next-error], but does not
1327 select the source buffer."
1328   (interactive "p")
1329   (next-error n)
1330   (pop-to-buffer compilation-last-buffer))
1331
1332 (defun previous-error-no-select (n)
1333   "Move point to the previous error in the compilation buffer and highlight match.
1334 Prefix arg N says how many error messages to move backwards (or
1335 forwards, if negative).
1336 Finds and highlights the source line like \\[previous-error], but does not
1337 select the source buffer."
1338   (interactive "p")
1339   (next-error-no-select (- n)))
1340
1341 (defun compilation-next-file (n)
1342   "Move point to the next error for a different file than the current one.
1343 Prefix arg N says how many files to move forwards (or backwards, if negative)."
1344   (interactive "p")
1345   (compilation-next-error n t))
1346
1347 (defun compilation-previous-file (n)
1348   "Move point to the previous error for a different file than the current one.
1349 Prefix arg N says how many files to move backwards (or forwards, if negative)."
1350   (interactive "p")
1351   (compilation-next-file (- n)))
1352
1353 (defun kill-compilation ()
1354   "Kill the process made by the \\[compile] or \\[grep] commands."
1355   (interactive)
1356   (let ((buffer (compilation-find-buffer)))
1357     (if (get-buffer-process buffer)
1358         (interrupt-process (get-buffer-process buffer))
1359       (error "The compilation process is not running"))))
1360
1361 (defalias 'compile-mouse-goto-error 'compile-goto-error)
1362
1363 (defun compile-goto-error (&optional event)
1364   "Visit the source for the error message at point.
1365 Use this command in a compilation log buffer.  Sets the mark at point there."
1366   (interactive (list last-input-event))
1367   (or (compilation-buffer-p (current-buffer))
1368       (error "Not in a compilation buffer"))
1369   (let ((pos (if event (posn-point (event-end event)) (point))))
1370     (if (get-text-property (point) 'directory)
1371         (dired-other-window (car (get-text-property pos 'directory)))
1372       (push-mark)
1373       (setq compilation-current-error pos)
1374       (next-error 0))))
1375
1376 ;; Return a compilation buffer.
1377 ;; If the current buffer is a compilation buffer, return it.
1378 ;; If compilation-last-buffer is set to a live buffer, use that.
1379 ;; Otherwise, look for a compilation buffer and signal an error
1380 ;; if there are none.
1381 (defun compilation-find-buffer (&optional other-buffer)
1382   (if (and (not other-buffer)
1383            (compilation-buffer-p (current-buffer)))
1384       ;; The current buffer is a compilation buffer.
1385       (current-buffer)
1386     (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
1387              (compilation-buffer-p compilation-last-buffer)
1388              (or (not other-buffer) (not (eq compilation-last-buffer
1389                                              (current-buffer)))))
1390         compilation-last-buffer
1391       (let ((buffers (buffer-list)))
1392         (while (and buffers (or (not (compilation-buffer-p (car buffers)))
1393                                 (and other-buffer
1394                                      (eq (car buffers) (current-buffer)))))
1395           (setq buffers (cdr buffers)))
1396         (if buffers
1397             (car buffers)
1398           (or (and other-buffer
1399                    (compilation-buffer-p (current-buffer))
1400                    ;; The current buffer is a compilation buffer.
1401                    (progn
1402                      (if other-buffer
1403                          (message "This is the only compilation buffer."))
1404                      (current-buffer)))
1405               (error "No compilation started!")))))))
1406
1407 ;;;###autoload
1408 (defun next-error (&optional n)
1409   "Visit next compilation error message and corresponding source code.
1410 Prefix arg N says how many error messages to move forwards (or
1411 backwards, if negative).
1412
1413 \\[next-error] normally uses the most recently started compilation or
1414 grep buffer.  However, it can operate on any buffer with output from
1415 the \\[compile] and \\[grep] commands, or, more generally, on any
1416 buffer in Compilation mode or with Compilation Minor mode enabled.  To
1417 specify use of a particular buffer for error messages, type
1418 \\[next-error] in that buffer.
1419
1420 Once \\[next-error] has chosen the buffer for error messages,
1421 it stays with that buffer until you use it in some other buffer which
1422 uses Compilation mode or Compilation Minor mode.
1423
1424 See variable `compilation-error-regexp-alist' for customization ideas."
1425   (interactive "p")
1426   (set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
1427   (let* ((columns compilation-error-screen-columns) ; buffer's local value
1428          (last 1)
1429          (loc (compilation-next-error (or n 1) nil
1430                                       (or compilation-current-error (point-min))))
1431          (end-loc (nth 2 loc))
1432          (marker (point-marker)))
1433     (setq compilation-current-error (point-marker)
1434           loc (car loc))
1435     ;; If loc contains no marker, no error in that file has been visited.  If
1436     ;; the marker is invalid the buffer has been killed.  So, recalculate all
1437     ;; markers for that file.
1438     (unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc)))
1439       (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
1440                                                   (or (cdar (nth 2 loc))
1441                                                       default-directory))
1442         (save-restriction
1443           (widen)
1444           (goto-char (point-min))
1445           ;; Treat file's found lines in forward order, 1 by 1.
1446           (dolist (line (reverse (cddr (nth 2 loc))))
1447             (when (car line)            ; else this is a filename w/o a line#
1448               (beginning-of-line (- (car line) last -1))
1449               (setq last (car line)))
1450             ;; Treat line's found columns and store/update a marker for each.
1451             (dolist (col (cdr line))
1452               (if (car col)
1453                   (if (eq (car col) -1) ; special case for range end
1454                       (end-of-line)
1455                     (if columns
1456                         (move-to-column (car col))
1457                       (beginning-of-line)
1458                       (forward-char (car col))))
1459                 (beginning-of-line)
1460                 (skip-chars-forward " \t"))
1461               (if (nthcdr 3 col)
1462                   (set-marker (nth 3 col) (point))
1463                 (setcdr (nthcdr 2 col) `(,(point-marker)))))))))
1464     (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
1465     (setcdr (nthcdr 3 loc) t)))         ; Set this one as visited.
1466
1467 ;;;###autoload (define-key ctl-x-map "`" 'next-error)
1468
1469 (defun previous-error (n)
1470   "Visit previous compilation error message and corresponding source code.
1471 Prefix arg N says how many error messages to move backwards (or
1472 forwards, if negative).
1473
1474 This operates on the output from the \\[compile] and \\[grep] commands."
1475   (interactive "p")
1476   (next-error (- n)))
1477
1478 (defun first-error (n)
1479   "Restart at the first error.
1480 Visit corresponding source code.
1481 With prefix arg N, visit the source code of the Nth error.
1482 This operates on the output from the \\[compile] command."
1483   (interactive "p")
1484   (set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
1485   (setq compilation-current-error nil)
1486   (next-error n))
1487
1488 (defcustom compilation-context-lines next-screen-context-lines
1489   "*Display this many lines of leading context before message."
1490   :type 'integer
1491   :group 'compilation
1492   :version "21.4")
1493
1494 (defsubst compilation-set-window (w mk)
1495   ;; Align the compilation output window W with marker MK near top.
1496   (set-window-start w (save-excursion
1497                         (goto-char mk)
1498                         (beginning-of-line (- 1 compilation-context-lines))
1499                         (point)))
1500   (set-window-point w mk))
1501
1502 (defun compilation-goto-locus (msg mk end-mk)
1503   "Jump to an error MESSAGE and SOURCE.
1504 All arguments are markers.  If SOURCE-END is non nil, mark is set there."
1505   (if (eq (window-buffer (selected-window))
1506           (marker-buffer msg))
1507       ;; If the compilation buffer window is selected,
1508       ;; keep the compilation buffer in this window;
1509       ;; display the source in another window.
1510       (let ((pop-up-windows t))
1511         (pop-to-buffer (marker-buffer mk)))
1512     (if (window-dedicated-p (selected-window))
1513         (pop-to-buffer (marker-buffer mk))
1514       (switch-to-buffer (marker-buffer mk))))
1515   ;; If narrowing gets in the way of going to the right place, widen.
1516   (unless (eq (goto-char mk) (point))
1517     (widen)
1518     (goto-char mk))
1519   (if end-mk
1520       (push-mark end-mk nil t)
1521     (if mark-active (setq mark-active)))
1522   ;; If hideshow got in the way of
1523   ;; seeing the right place, open permanently.
1524   (dolist (ov (overlays-at (point)))
1525     (when (eq 'hs (overlay-get ov 'invisible))
1526       (delete-overlay ov)
1527       (goto-char mk)))
1528
1529   ;; Show compilation buffer in other window, scrolled to this error.
1530   (let* ((pop-up-windows t)
1531          ;; Use an existing window if it is in a visible frame.
1532          (w (or (get-buffer-window (marker-buffer msg) 'visible)
1533                 ;; Pop up a window.
1534                 (display-buffer (marker-buffer msg))))
1535          (highlight-regexp (with-current-buffer (marker-buffer msg)
1536                              ;; also do this while we change buffer
1537                              (compilation-set-window w msg)
1538                              compilation-highlight-regexp)))
1539     (compilation-set-window-height w)
1540
1541     (when (and highlight-regexp
1542                (not (and end-mk transient-mark-mode)))
1543       (unless compilation-highlight-overlay
1544         (setq compilation-highlight-overlay
1545               (make-overlay (point-min) (point-min)))
1546         (overlay-put compilation-highlight-overlay 'face 'region))
1547       (with-current-buffer (marker-buffer mk)
1548         (save-excursion
1549           (end-of-line)
1550           (let ((end (point)))
1551             (beginning-of-line)
1552             (if (and (stringp highlight-regexp)
1553                      (re-search-forward highlight-regexp end t))
1554                 (progn
1555                   (goto-char (match-beginning 0))
1556                   (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0)))
1557               (move-overlay compilation-highlight-overlay (point) end))
1558             (sit-for 0.5)
1559             (delete-overlay compilation-highlight-overlay)))))))
1560
1561 \f
1562 (defun compilation-find-file (marker filename dir &rest formats)
1563   "Find a buffer for file FILENAME.
1564 Search the directories in `compilation-search-path'.
1565 A nil in `compilation-search-path' means to try the
1566 current directory, which is passed in DIR.
1567 If FILENAME is not found at all, ask the user where to find it.
1568 Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
1569   (or formats (setq formats '("%s")))
1570   (save-excursion
1571     (let ((dirs compilation-search-path)
1572           buffer thisdir fmts name)
1573       (if (file-name-absolute-p filename)
1574           ;; The file name is absolute.  Use its explicit directory as
1575           ;; the first in the search path, and strip it from FILENAME.
1576           (setq filename (abbreviate-file-name (expand-file-name filename))
1577                 dirs (cons (file-name-directory filename) dirs)
1578                 filename (file-name-nondirectory filename)))
1579       ;; Now search the path.
1580       (while (and dirs (null buffer))
1581         (setq thisdir (or (car dirs) dir)
1582               fmts formats)
1583         ;; For each directory, try each format string.
1584         (while (and fmts (null buffer))
1585           (setq name (expand-file-name (format (car fmts) filename) thisdir)
1586                 buffer (and (file-exists-p name)
1587                             (find-file-noselect name))
1588                 fmts (cdr fmts)))
1589         (setq dirs (cdr dirs)))
1590       (or buffer
1591           ;; The file doesn't exist.  Ask the user where to find it.
1592           (let ((pop-up-windows t))
1593             (compilation-set-window (display-buffer (marker-buffer marker))
1594                                     marker)
1595             (let ((name (expand-file-name
1596                          (read-file-name
1597                           (format "Find this error in: (default %s) "
1598                                   filename)
1599                           dir filename t))))
1600               (if (file-directory-p name)
1601                   (setq name (expand-file-name filename name)))
1602               (setq buffer (and (file-exists-p name)
1603                                 (find-file name))))))
1604       ;; Make intangible overlays tangible.
1605       (mapcar (function (lambda (ov)
1606                           (when (overlay-get ov 'intangible)
1607                             (overlay-put ov 'intangible nil))))
1608               (overlays-in (point-min) (point-max)))
1609       buffer)))
1610
1611 (defun compilation-normalize-filename (filename)
1612   "Convert a filename string found in an error message to make it usable."
1613
1614   ;; Check for a comint-file-name-prefix and prepend it if
1615   ;; appropriate.  (This is very useful for
1616   ;; compilation-minor-mode in an rlogin-mode buffer.)
1617   (and (boundp 'comint-file-name-prefix)
1618        ;; If file name is relative, default-directory will
1619        ;; already contain the comint-file-name-prefix (done
1620        ;; by compile-abbreviate-directory).
1621        (file-name-absolute-p filename)
1622        (setq filename
1623              (concat (with-no-warnings 'comint-file-name-prefix) filename)))
1624
1625   ;; If compilation-parse-errors-filename-function is
1626   ;; defined, use it to process the filename.
1627   (when compilation-parse-errors-filename-function
1628     (setq filename
1629           (funcall compilation-parse-errors-filename-function
1630                    filename)))
1631
1632   ;; Some compilers (e.g. Sun's java compiler, reportedly)
1633   ;; produce bogus file names like "./bar//foo.c" for file
1634   ;; "bar/foo.c"; expand-file-name will collapse these into
1635   ;; "/foo.c" and fail to find the appropriate file.  So we
1636   ;; look for doubled slashes in the file name and fix them
1637   ;; up in the buffer.
1638   (setq filename (command-line-normalize-file-name filename)))
1639
1640
1641 ;; If directory DIR is a subdir of ORIG or of ORIG's parent,
1642 ;; return a relative name for it starting from ORIG or its parent.
1643 ;; ORIG-EXPANDED is an expanded version of ORIG.
1644 ;; PARENT-EXPANDED is an expanded version of ORIG's parent.
1645 ;; Those two args could be computed here, but we run faster by
1646 ;; having the caller compute them just once.
1647 (defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded)
1648   ;; Apply canonical abbreviations to DIR first thing.
1649   ;; Those abbreviations are already done in the other arguments passed.
1650   (setq dir (abbreviate-file-name dir))
1651
1652   ;; Check for a comint-file-name-prefix and prepend it if appropriate.
1653   ;; (This is very useful for compilation-minor-mode in an rlogin-mode
1654   ;; buffer.)
1655   (if (boundp 'comint-file-name-prefix)
1656       (setq dir (concat comint-file-name-prefix dir)))
1657
1658   (if (and (> (length dir) (length orig-expanded))
1659            (string= orig-expanded
1660                     (substring dir 0 (length orig-expanded))))
1661       (setq dir
1662             (concat orig
1663                     (substring dir (length orig-expanded)))))
1664   (if (and (> (length dir) (length parent-expanded))
1665            (string= parent-expanded
1666                     (substring dir 0 (length parent-expanded))))
1667     (setq dir
1668           (concat (file-name-directory
1669                    (directory-file-name orig))
1670                   (substring dir (length parent-expanded)))))
1671   dir)
1672
1673 (add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
1674
1675 ;;; Compatibility with the old compile.el.
1676
1677 (defun compile-buffer-substring (n) (if n (match-string n)))
1678
1679 (defun compilation-compat-error-properties (err)
1680   ;; Map old-style ERROR to new-style MESSAGE.
1681   (let* ((dst (cdr err))
1682          (loc (cond ((markerp dst) (list nil nil nil dst))
1683                     ((consp dst)
1684                      (list (nth 2 dst) (nth 1 dst)
1685                            (cons (cdar dst) (caar dst)))))))
1686     ;; Must start with a face, for font-lock.
1687     `(face nil
1688       message ,(list loc 2)
1689       help-echo "mouse-2: visit the source location"
1690       mouse-face highlight)))
1691
1692 (defun compilation-compat-parse-errors (limit)
1693   (when compilation-parse-errors-function
1694     ;; FIXME: We should remove the rest of the compilation keywords
1695     ;; but we can't do that from here because font-lock is using
1696     ;; the value right now.  --stef
1697     (save-excursion
1698       (setq compilation-error-list nil)
1699       ;; Reset compilation-parsing-end each time because font-lock
1700       ;; might force us the re-parse many times (typically because
1701       ;; some code adds some text-property to the output that we
1702       ;; already parsed).  You might say "why reparse", well:
1703       ;; because font-lock has just removed the `message' property so
1704       ;; have to do it all over again.
1705       (if compilation-parsing-end
1706           (set-marker compilation-parsing-end (point))
1707         (setq compilation-parsing-end (point-marker)))
1708       (condition-case nil
1709           ;; Ignore any error: we're calling this function earlier than
1710           ;; in the old compile.el so things might not all be setup yet.
1711           (funcall compilation-parse-errors-function limit nil)
1712         (error nil))
1713       (dolist (err (if (listp compilation-error-list) compilation-error-list))
1714         (let* ((src (car err))
1715                (dst (cdr err))
1716                (loc (cond ((markerp dst) (list nil nil nil dst))
1717                           ((consp dst)
1718                            (list (nth 2 dst) (nth 1 dst)
1719                                  (cons (cdar dst) (caar dst)))))))
1720           (when loc
1721             (goto-char src)
1722             ;; (put-text-property src (line-end-position) 'font-lock-face 'font-lock-warning-face)
1723             (put-text-property src (line-end-position)
1724                                'message (list loc 2)))))))
1725   (goto-char limit)
1726   nil)
1727
1728 (defun compilation-forget-errors ()
1729   ;; In case we hit the same file/line specs, we want to recompute a new
1730   ;; marker for them, so flush our cache.
1731   (set (make-local-variable 'compilation-locs)
1732        (make-hash-table :test 'equal :weakness 'value))
1733   ;; FIXME: the old code reset the directory-stack, so maybe we should
1734   ;; put a `directory change' marker of some sort, but where?  -stef
1735   ;;
1736   ;; FIXME: The old code moved compilation-current-error (which was
1737   ;; virtually represented by a mix of compilation-parsing-end and
1738   ;; compilation-error-list) to point-min, but that was only meaningful for
1739   ;; the internal uses of compilation-forget-errors: all calls from external
1740   ;; packages seem to be followed by a move of compilation-parsing-end to
1741   ;; something equivalent to point-max.  So we speculatively move
1742   ;; compilation-current-error to point-max (since the external package
1743   ;; won't know that it should do it).  --stef
1744   (setq compilation-current-error (point-max))
1745   ;; FIXME the old code removed the mouse-face and help-echo properties.
1746   ;; Should we font-lock-fontify-buffer?  --stef
1747   )
1748
1749 (provide 'compile)
1750
1751 ;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
1752 ;;; compile.el ends here