code.delx.au - gnu-emacs/blob - 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   (if compilation-parse-errors-function
 654       ;; An old package!  Try the compatibility code.
 655       '((compilation-compat-parse-errors))
 656     (append
 657      ;; make directory tracking
 658      (if compilation-directory-matcher
 659          `((,(car compilation-directory-matcher)
 660             ,@(mapcar (lambda (elt)
 661                         `(,(car elt)
 662                           (compilation-directory-properties
 663                            ,(car elt) ,(cdr elt))
 664                           t))
 665                       (cdr compilation-directory-matcher)))))
 666
 667      ;; Compiler warning/error lines.
 668      (mapcar
 669       (lambda (item)
 670         (if (symbolp item)
 671             (setq item (cdr (assq item
 672                                   compilation-error-regexp-alist-alist))))
 673         (let ((file (nth 1 item))
 674               (line (nth 2 item))
 675               (col (nth 3 item))
 676               (type (nth 4 item))
 677               end-line end-col fmt)
 678           (if (consp file)      (setq fmt (cdr file)      file (car file)))
 679           (if (consp line)      (setq end-line (cdr line) line (car line)))
 680           (if (consp col)       (setq end-col (cdr col)   col (car col)))
 681
 682           (if (functionp line)
 683               ;; The old compile.el had here an undocumented hook that
 684               ;; allowed `line' to be a function that computed the actual
 685               ;; error location.  Let's do our best.
 686               `(,(car item)
 687                 (0 (compilation-compat-error-properties
 688                     (funcall ',line (list* (match-string ,file)
 689                                            default-directory
 690                                            ',(nthcdr 4 item))
 691                              ,(if col `(match-string ,col)))))
 692                 (,file compilation-error-face t))
 693
 694             `(,(nth 0 item)
 695
 696               ,@(when (integerp file)
 697                   `((,file ,(if (consp type)
 698                                 `(compilation-face ',type)
 699                               (aref [compilation-info-face
 700                                      compilation-warning-face
 701                                      compilation-error-face]
 702                                     (or type 2))))))
 703
 704               ,@(when line
 705                   `((,line compilation-line-face nil t)))
 706               ,@(when end-line
 707                   `((,end-line compilation-line-face nil t)))
 708
 709               ,@(when col
 710                   `((,col compilation-column-face nil t)))
 711               ,@(when end-col
 712                   `((,end-col compilation-column-face nil t)))
 713
 714               ,@(nthcdr 6 item)
 715               (,(or (nth 5 item) 0)
 716                (compilation-error-properties ',file ,line ,end-line
 717                                              ,col ,end-col ',(or type 2)
 718                                              ',fmt)
 719                append)))))              ; for compilation-message-face
 720       compilation-error-regexp-alist)
 721
 722      compilation-mode-font-lock-keywords)))
 723
 724 \f
 725 ;;;###autoload
 726 (defun compile (command &optional comint)
 727   "Compile the program including the current buffer.  Default: run `make'.
 728 Runs COMMAND, a shell command, in a separate process asynchronously
 729 with output going to the buffer `*compilation*'.
 730
 731 If optional second arg COMINT is t the buffer will be in comint mode with
 732 `compilation-shell-minor-mode'.
 733
 734 You can then use the command \\[next-error] to find the next error message
 735 and move to the source code that caused it.
 736
 737 Interactively, prompts for the command if `compilation-read-command' is
 738 non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
 739
 740 To run more than one compilation at once, start one and rename
 741 the \`*compilation*' buffer to some other name with
 742 \\[rename-buffer].  Then start the next one.  On most systems,
 743 termination of the main compilation process kills its
 744 subprocesses.
 745
 746 The name used for the buffer is actually whatever is returned by
 747 the function in `compilation-buffer-name-function', so you can set that
 748 to a function that generates a unique name."
 749   (interactive
 750    (if (or compilation-read-command current-prefix-arg)
 751        (list (read-from-minibuffer "Compile command: "
 752                                  (eval compile-command) nil nil
 753                                  '(compile-history . 1)))
 754      (list (eval compile-command))))
 755   (unless (equal command (eval compile-command))
 756     (setq compile-command command))
 757   (save-some-buffers (not compilation-ask-about-save) nil)
 758   (setq compilation-directory default-directory)
 759   (compilation-start command comint))
 760
 761 ;; run compile with the default command line
 762 (defun recompile ()
 763   "Re-compile the program including the current buffer.
 764 If this is run in a compilation-mode buffer, re-use the arguments from the
 765 original use.  Otherwise, it recompiles using `compile-command'."
 766   (interactive)
 767   (save-some-buffers (not compilation-ask-about-save) nil)
 768   (let ((default-directory (or compilation-directory default-directory)))
 769     (apply 'compilation-start (or compilation-arguments
 770                                   `(,(eval compile-command))))))
 771
 772 (defcustom compilation-scroll-output nil
 773   "*Non-nil to scroll the *compilation* buffer window as output appears.
 774
 775 Setting it causes the compilation-mode commands to put point at the
 776 end of their output window so that the end of the output is always
 777 visible rather than the begining."
 778   :type 'boolean
 779   :version "20.3"
 780   :group 'compilation)
 781
 782
 783 (defun compilation-buffer-name (mode-name name-function)
 784   "Return the name of a compilation buffer to use.
 785 If NAME-FUNCTION is non-nil, call it with one argument MODE-NAME
 786 to determine the buffer name.
 787 Likewise if `compilation-buffer-name-function' is non-nil.
 788 If current buffer is in Compilation mode for the same mode name
 789 return the name of the current buffer, so that it gets reused.
 790 Otherwise, construct a buffer name from MODE-NAME."
 791   (cond (name-function
 792          (funcall name-function mode-name))
 793         (compilation-buffer-name-function
 794          (funcall compilation-buffer-name-function mode-name))
 795         ((and (eq major-mode 'compilation-mode)
 796               (equal mode-name (nth 2 compilation-arguments)))
 797          (buffer-name))
 798         (t
 799          (concat "*" (downcase mode-name) "*"))))
 800
 801 ;; This is a rough emulation of the old hack, until the transition to new
 802 ;; compile is complete.
 803 (defun compile-internal (command error-message
 804                                  &optional name-of-mode parser
 805                                  error-regexp-alist name-function
 806                                  enter-regexp-alist leave-regexp-alist
 807                                  file-regexp-alist nomessage-regexp-alist
 808                                  no-async highlight-regexp local-map)
 809   (if parser
 810       (error "Compile now works very differently, see `compilation-error-regexp-alist'"))
 811   (let ((compilation-error-regexp-alist
 812          (append file-regexp-alist (or error-regexp-alist
 813                                        compilation-error-regexp-alist)))
 814         (compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?"
 815                                                      "\\1" error-message)))
 816     (compilation-start command nil name-function highlight-regexp)))
 817 (make-obsolete 'compile-internal 'compilation-start)
 818
 819 (defun compilation-start (command &optional mode name-function highlight-regexp)
 820   "Run compilation command COMMAND (low level interface).
 821 The rest of the arguments are optional; for them, nil means use the default.
 822
 823 MODE is the major mode to set in the compilation buffer.  Mode
 824 may also be `t' meaning `compilation-shell-minor-mode' under `comint-mode'.
 825 NAME-FUNCTION is a function called to name the buffer.
 826
 827 If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
 828 matching section of the visited source line; the default is to use the
 829 global value of `compilation-highlight-regexp'.
 830
 831 Returns the compilation buffer created."
 832   (or mode (setq mode 'compilation-mode))
 833   (let ((name-of-mode
 834          (if (eq mode t)
 835              (prog1 "compilation" (require 'comint))
 836            (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
 837         (process-environment
 838          (append
 839           compilation-environment
 840           (if (and (boundp 'system-uses-terminfo)
 841                    system-uses-terminfo)
 842               (list "TERM=dumb" "TERMCAP="
 843                     (format "COLUMNS=%d" (window-width)))
 844             (list "TERM=emacs"
 845                   (format "TERMCAP=emacs:co#%d:tc=unknown:"
 846                           (window-width))))
 847           ;; Set the EMACS variable, but
 848           ;; don't override users' setting of $EMACS.
 849           (unless (getenv "EMACS") '("EMACS=t"))
 850           process-environment))
 851         (thisdir default-directory)
 852         outwin outbuf)
 853     (with-current-buffer
 854         (setq outbuf
 855               (get-buffer-create
 856                (compilation-buffer-name name-of-mode name-function)))
 857       (let ((comp-proc (get-buffer-process (current-buffer))))
 858         (if comp-proc
 859             (if (or (not (eq (process-status comp-proc) 'run))
 860                     (yes-or-no-p
 861                      (format "A %s process is running; kill it? "
 862                              name-of-mode)))
 863                 (condition-case ()
 864                     (progn
 865                       (interrupt-process comp-proc)
 866                       (sit-for 1)
 867                       (delete-process comp-proc))
 868                   (error nil))
 869               (error "Cannot have two processes in `%s' at once"
 870                      (buffer-name)))))
 871       ;; Clear out the compilation buffer and make it writable.
 872       ;; Change its default-directory to the directory where the compilation
 873       ;; will happen, and insert a `cd' command to indicate this.
 874       (setq buffer-read-only nil)
 875       (buffer-disable-undo (current-buffer))
 876       (erase-buffer)
 877       (buffer-enable-undo (current-buffer))
 878       (setq default-directory thisdir)
 879       ;; output a mode setter, for saving and later reloading this buffer
 880       (insert "cd " thisdir "   # -*-" name-of-mode
 881               "-*-\nEntering directory `" thisdir "'\n" command "\n")
 882       (set-buffer-modified-p nil))
 883     ;; If we're already in the compilation buffer, go to the end
 884     ;; of the buffer, so point will track the compilation output.
 885     (if (eq outbuf (current-buffer))
 886         (goto-char (point-max)))
 887     ;; Pop up the compilation buffer.
 888     (setq outwin (display-buffer outbuf nil t))
 889     (with-current-buffer outbuf
 890       (if (not (eq mode t))
 891           (funcall mode)
 892         (with-no-warnings (comint-mode))
 893         (compilation-shell-minor-mode))
 894       ;; In what way is it non-ergonomic ?  -stef
 895       ;; (toggle-read-only 1) ;;; Non-ergonomic.
 896       (if highlight-regexp
 897           (set (make-local-variable 'compilation-highlight-regexp)
 898                highlight-regexp))
 899       (set (make-local-variable 'compilation-arguments)
 900            (list command mode name-function highlight-regexp))
 901       (set (make-local-variable 'revert-buffer-function)
 902            'compilation-revert-buffer)
 903       (set-window-start outwin (point-min))
 904       (or (eq outwin (selected-window))
 905           (set-window-point outwin (point)))
 906       ;; The setup function is called before compilation-set-window-height
 907       ;; so it can set the compilation-window-height buffer locally.
 908       (if compilation-process-setup-function
 909           (funcall compilation-process-setup-function))
 910       (compilation-set-window-height outwin)
 911       ;; Start the compilation.
 912       (if (fboundp 'start-process)
 913           (let ((proc (if (eq mode t)
 914                           (get-buffer-process
 915                            (with-no-warnings
 916                             (comint-exec outbuf (downcase mode-name)
 917                                          shell-file-name nil `("-c" ,command))))
 918                         (start-process-shell-command (downcase mode-name)
 919                                                      outbuf command))))
 920             ;; Make the buffer's mode line show process state.
 921             (setq mode-line-process '(":%s"))
 922             (set-process-sentinel proc 'compilation-sentinel)
 923             (set-process-filter proc 'compilation-filter)
 924             (set-marker (process-mark proc) (point) outbuf)
 925             (setq compilation-in-progress
 926                   (cons proc compilation-in-progress)))
 927         ;; No asynchronous processes available.
 928         (message "Executing `%s'..." command)
 929         ;; Fake modeline display as if `start-process' were run.
 930         (setq mode-line-process ":run")
 931         (force-mode-line-update)
 932         (let ((status (call-process shell-file-name nil outbuf nil "-c"
 933                                     command)))
 934           (cond ((numberp status)
 935                  (compilation-handle-exit 'exit status
 936                                           (if (zerop status)
 937                                               "finished\n"
 938                                             (format "\
 939 exited abnormally with code %d\n"
 940                                                     status))))
 941                 ((stringp status)
 942                  (compilation-handle-exit 'signal status
 943                                           (concat status "\n")))
 944                 (t
 945                  (compilation-handle-exit 'bizarre status status))))
 946         (message "Executing `%s'...done" command)))
 947     (if (buffer-local-value 'compilation-scroll-output outbuf)
 948         (save-selected-window
 949           (select-window outwin)
 950           (goto-char (point-max))))
 951     ;; Make it so the next C-x ` will use this buffer.
 952     (setq compilation-last-buffer outbuf)))
 953
 954 (defun compilation-set-window-height (window)
 955   "Set the height of WINDOW according to `compilation-window-height'."
 956   (let ((height (buffer-local-value 'compilation-window-height (window-buffer window))))
 957     (and height
 958          (= (window-width window) (frame-width (window-frame window)))
 959          ;; If window is alone in its frame, aside from a minibuffer,
 960          ;; don't change its height.
 961          (not (eq window (frame-root-window (window-frame window))))
 962          ;; This save-current-buffer prevents us from changing the current
 963          ;; buffer, which might not be the same as the selected window's buffer.
 964          (save-current-buffer
 965            (save-selected-window
 966              (select-window window)
 967              (enlarge-window (- height (window-height))))))))
 968
 969 (defvar compilation-menu-map
 970   (let ((map (make-sparse-keymap "Errors")))
 971     (define-key map [stop-subjob]
 972       '("Stop Compilation" . kill-compilation))
 973     (define-key map [compilation-mode-separator2]
 974       '("----" . nil))
 975     (define-key map [compilation-first-error]
 976       '("First Error" . first-error))
 977     (define-key map [compilation-previous-error]
 978       '("Previous Error" . previous-error))
 979     (define-key map [compilation-next-error]
 980       '("Next Error" . next-error))
 981     map))
 982
 983 (defvar compilation-minor-mode-map
 984   (let ((map (make-sparse-keymap)))
 985     (define-key map [mouse-2] 'compile-mouse-goto-error)
 986     (define-key map "\C-c\C-c" 'compile-goto-error)
 987     (define-key map "\C-m" 'compile-goto-error)
 988     (define-key map "\C-c\C-k" 'kill-compilation)
 989     (define-key map "\M-n" 'compilation-next-error)
 990     (define-key map "\M-p" 'compilation-previous-error)
 991     (define-key map "\M-{" 'compilation-previous-file)
 992     (define-key map "\M-}" 'compilation-next-file)
 993     ;; Set up the menu-bar
 994     (define-key map [menu-bar compilation]
 995       (cons "Errors" compilation-menu-map))
 996     map)
 997   "Keymap for `compilation-minor-mode'.")
 998
 999 (defvar compilation-shell-minor-mode-map
1000   (let ((map (make-sparse-keymap)))
1001     (define-key map [mouse-2] 'compile-mouse-goto-error)
1002     (define-key map "\M-\C-m" 'compile-goto-error)
1003     (define-key map "\M-\C-n" 'compilation-next-error)
1004     (define-key map "\M-\C-p" 'compilation-previous-error)
1005     (define-key map "\M-{" 'compilation-previous-file)
1006     (define-key map "\M-}" 'compilation-next-file)
1007     ;; Set up the menu-bar
1008     (define-key map [menu-bar compilation]
1009       (cons "Errors" compilation-menu-map))
1010     map)
1011   "Keymap for `compilation-shell-minor-mode'.")
1012
1013 (defvar compilation-mode-map
1014   (let ((map (make-sparse-keymap)))
1015     (set-keymap-parent map compilation-minor-mode-map)
1016     (define-key map " " 'scroll-up)
1017     (define-key map "\^?" 'scroll-down)
1018
1019     ;; Set up the menu-bar
1020     (define-key map [menu-bar compilation]
1021       (cons "Compile" (make-sparse-keymap "Compile")))
1022     (define-key map [menu-bar compilation compilation-separator2]
1023       '("----" . nil))
1024     (define-key map [menu-bar compilation compilation-grep]
1025       '("Search Files (grep)" . grep))
1026     (define-key map [menu-bar compilation compilation-recompile]
1027       '("Recompile" . recompile))
1028     (define-key map [menu-bar compilation compilation-compile]
1029       '("Compile..." . compile))
1030     map)
1031   "Keymap for compilation log buffers.
1032 `compilation-minor-mode-map' is a parent of this.")
1033
1034 (put 'compilation-mode 'mode-class 'special)
1035
1036 (defvar compilation-skip-to-next-location t
1037   "*If non-nil, skip multiple error messages for the same source location.")
1038
1039 (defcustom compilation-skip-threshold 1
1040   "*Compilation motion commands skip less important messages.
1041 The value can be either 2 -- skip anything less than error, 1 --
1042 skip anything less than warning or 0 -- don't skip any messages.
1043 Note that all messages not positively identified as warning or
1044 info, are considered errors."
1045   :type '(choice (const :tag "Warnings and info" 2)
1046                  (const :tag "Info" 1)
1047                  (const :tag "None" 0))
1048   :group 'compilation
1049   :version "21.4")
1050
1051 (defcustom compilation-skip-visited nil
1052   "*Compilation motion commands skip visited messages if this is t.
1053 Visited messages are ones for which the file, line and column have been jumped
1054 to from the current content in the current compilation buffer, even if it was
1055 from a different message."
1056   :type 'boolean
1057   :group 'compilation
1058   :version "21.4")
1059
1060 ;;;###autoload
1061 (defun compilation-mode ()
1062   "Major mode for compilation log buffers.
1063 \\<compilation-mode-map>To visit the source for a line-numbered error,
1064 move point to the error message line and type \\[compile-goto-error].
1065 To kill the compilation, type \\[kill-compilation].
1066
1067 Runs `compilation-mode-hook' with `run-hooks' (which see)."
1068   (interactive)
1069   (kill-all-local-variables)
1070   (use-local-map compilation-mode-map)
1071   (setq major-mode 'compilation-mode
1072         mode-name "Compilation")
1073   (set (make-local-variable 'page-delimiter)
1074        compilation-page-delimiter)
1075   (compilation-setup)
1076   (run-mode-hooks 'compilation-mode-hook))
1077
1078 (defmacro define-compilation-mode (mode name doc &rest body)
1079   "This is like `define-derived-mode' without the PARENT argument.
1080 The parent is always `compilation-mode' and the customizable `compilation-...'
1081 variables are also set from the name of the mode you have chosen, by replacing
1082 the fist word, e.g `compilation-scroll-output' from `grep-scroll-output' if that
1083 variable exists."
1084   (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
1085     `(define-derived-mode ,mode compilation-mode ,name
1086        ,doc
1087        ,@(mapcar (lambda (v)
1088                    (setq v (cons v
1089                                  (intern-soft (replace-regexp-in-string
1090                                                "^compilation" mode-name
1091                                                (symbol-name v)))))
1092                    (and (cdr v)
1093                         (or (boundp (cdr v))
1094                             (if (boundp 'byte-compile-bound-variables)
1095                                 (memq (cdr v) byte-compile-bound-variables)))
1096                         `(set (make-local-variable ',(car v)) ,(cdr v))))
1097                  '(compilation-buffer-name-function
1098                    compilation-directory-matcher
1099                    compilation-error
1100                    compilation-error-regexp-alist
1101                    compilation-error-regexp-alist-alist
1102                    compilation-error-screen-columns
1103                    compilation-finish-function
1104                    compilation-finish-functions
1105                    compilation-first-column
1106                    compilation-mode-font-lock-keywords
1107                    compilation-page-delimiter
1108                    compilation-parse-errors-filename-function
1109                    compilation-process-setup-function
1110                    compilation-scroll-output
1111                    compilation-search-path
1112                    compilation-skip-threshold
1113                    compilation-window-height))
1114        ,@body)))
1115
1116 (defun compilation-revert-buffer (ignore-auto noconfirm)
1117   (if buffer-file-name
1118       (let (revert-buffer-function)
1119         (revert-buffer ignore-auto noconfirm))
1120     (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
1121         (apply 'compilation-start compilation-arguments))))
1122
1123 (defvar compilation-current-error nil
1124   "Marker to the location from where the next error will be found.
1125 The global commands next/previous/first-error/goto-error use this.")
1126
1127 ;; A function name can't be a hook, must be something with a value.
1128 (defconst compilation-turn-on-font-lock 'turn-on-font-lock)
1129
1130 (defun compilation-setup (&optional minor)
1131   "Prepare the buffer for the compilation parsing commands to work."
1132   (make-local-variable 'compilation-current-error)
1133   (make-local-variable 'compilation-error-screen-columns)
1134   (make-local-variable 'overlay-arrow-position)
1135   (setq compilation-last-buffer (current-buffer))
1136   (set (make-local-variable 'font-lock-extra-managed-props)
1137        '(directory message help-echo mouse-face debug))
1138   (set (make-local-variable 'compilation-locs)
1139        (make-hash-table :test 'equal :weakness 'value))
1140   ;; lazy-lock would never find the message unless it's scrolled to
1141   ;; jit-lock might fontify some things too late.
1142   (set (make-local-variable 'font-lock-support-mode) nil)
1143   (set (make-local-variable 'font-lock-maximum-size) nil)
1144   (let ((fld font-lock-defaults))
1145     (if (and minor fld)
1146         (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
1147       (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))
1148     (if minor
1149         (if font-lock-mode
1150             (if fld
1151                 (font-lock-fontify-buffer)
1152               (font-lock-change-mode)
1153               (turn-on-font-lock))
1154           (turn-on-font-lock))
1155       ;; maybe defer font-lock till after derived mode is set up
1156       (run-mode-hooks 'compilation-turn-on-font-lock))))
1157
1158 ;;;###autoload
1159 (define-minor-mode compilation-shell-minor-mode
1160   "Toggle compilation shell minor mode.
1161 With arg, turn compilation mode on if and only if arg is positive.
1162 In this minor mode, all the error-parsing commands of the
1163 Compilation major mode are available but bound to keys that don't
1164 collide with Shell mode.  See `compilation-mode'.
1165 Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'."
1166   nil " Shell-Compile"
1167   :group 'compilation
1168   (if compilation-shell-minor-mode
1169       (compilation-setup t)
1170     (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
1171     (font-lock-fontify-buffer)))
1172
1173 ;;;###autoload
1174 (define-minor-mode compilation-minor-mode
1175   "Toggle compilation minor mode.
1176 With arg, turn compilation mode on if and only if arg is positive.
1177 In this minor mode, all the error-parsing commands of the
1178 Compilation major mode are available.  See `compilation-mode'.
1179 Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
1180   nil " Compilation"
1181   :group 'compilation
1182   (if compilation-minor-mode
1183       (compilation-setup t)
1184     (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
1185     (font-lock-fontify-buffer)))
1186
1187 (defun compilation-handle-exit (process-status exit-status msg)
1188   "Write msg in the current buffer and hack its mode-line-process."
1189   (let ((buffer-read-only nil)
1190         (status (if compilation-exit-message-function
1191                     (funcall compilation-exit-message-function
1192                              process-status exit-status msg)
1193                   (cons msg exit-status)))
1194         (omax (point-max))
1195         (opoint (point)))
1196     ;; Record where we put the message, so we can ignore it later on.
1197     (goto-char omax)
1198     (insert ?\n mode-name " " (car status))
1199     (if (and (numberp compilation-window-height)
1200              (zerop compilation-window-height))
1201         (message "%s" (cdr status)))
1202     (if (bolp)
1203         (forward-char -1))
1204     (insert " at " (substring (current-time-string) 0 19))
1205     (goto-char (point-max))
1206     ;; Prevent that message from being recognized as a compilation error.
1207     (add-text-properties omax (point)
1208                          (append '(compilation-handle-exit t) nil))
1209     (setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
1210     ;; Force mode line redisplay soon.
1211     (force-mode-line-update)
1212     (if (and opoint (< opoint omax))
1213         (goto-char opoint))
1214     (if compilation-finish-function
1215         (funcall compilation-finish-function (current-buffer) msg))
1216     (let ((functions compilation-finish-functions))
1217       (while functions
1218         (funcall (car functions) (current-buffer) msg)
1219         (setq functions (cdr functions))))))
1220
1221 ;; Called when compilation process changes state.
1222 (defun compilation-sentinel (proc msg)
1223   "Sentinel for compilation buffers."
1224   (if (memq (process-status proc) '(exit signal))
1225       (let ((buffer (process-buffer proc)))
1226         (if (null (buffer-name buffer))
1227             ;; buffer killed
1228             (set-process-buffer proc nil)
1229           (with-current-buffer buffer
1230             ;; Write something in the compilation buffer
1231             ;; and hack its mode line.
1232             (compilation-handle-exit (process-status proc)
1233                                      (process-exit-status proc)
1234                                      msg)
1235             ;; Since the buffer and mode line will show that the
1236             ;; process is dead, we can delete it now.  Otherwise it
1237             ;; will stay around until M-x list-processes.
1238             (delete-process proc)))
1239         (setq compilation-in-progress (delq proc compilation-in-progress)))))
1240
1241 (defun compilation-filter (proc string)
1242   "Process filter for compilation buffers.
1243 Just inserts the text, but uses `insert-before-markers'."
1244   (if (buffer-name (process-buffer proc))
1245       (with-current-buffer (process-buffer proc)
1246         (let ((inhibit-read-only t))
1247           (save-excursion
1248             (goto-char (process-mark proc))
1249             (insert-before-markers string)
1250             (run-hooks 'compilation-filter-hook))))))
1251
1252 (defsubst compilation-buffer-p (buffer)
1253   (local-variable-p 'compilation-locs buffer))
1254
1255 (defmacro compilation-loop (< property-change 1+ error)
1256   `(while (,< n 0)
1257       (or (setq pt (,property-change pt 'message))
1258           (error ,error compilation-error))
1259       ;; prop 'message usually has 2 changes, on and off, so re-search if off
1260       (or (setq msg (get-text-property pt 'message))
1261           (if (setq pt (,property-change pt 'message))
1262               (setq msg (get-text-property pt 'message)))
1263           (error ,error compilation-error))
1264       (or (< (cadr msg) compilation-skip-threshold)
1265           (if different-file
1266               (eq (prog1 last (setq last (nth 2 (car msg))))
1267                   last))
1268           (if compilation-skip-visited
1269               (nthcdr 4 (car msg)))
1270           (if compilation-skip-to-next-location
1271               (eq (car msg) loc))
1272           ;; count this message only if none of the above are true
1273           (setq n (,1+ n)))))
1274
1275 (defun compilation-next-error (n &optional different-file pt)
1276   "Move point to the next error in the compilation buffer.
1277 Prefix arg N says how many error messages to move forwards (or
1278 backwards, if negative).
1279 Does NOT find the source line like \\[next-error]."
1280   (interactive "p")
1281   (or (compilation-buffer-p (current-buffer))
1282       (error "Not in a compilation buffer"))
1283   (or pt (setq pt (point)))
1284   (setq compilation-last-buffer (current-buffer))
1285   (let* ((msg (get-text-property pt 'message))
1286          (loc (car msg))
1287          last)
1288     (if (zerop n)
1289         (unless (or msg                 ; find message near here
1290                     (setq msg (get-text-property (max (1- pt) (point-min))
1291                                                  'message)))
1292           (setq pt (previous-single-property-change pt 'message nil
1293                                                     (line-beginning-position)))
1294           (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'message))
1295             (setq pt (next-single-property-change pt 'message nil
1296                                                   (line-end-position)))
1297             (or (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 (defun compile-mouse-goto-error (event)
1362   "Visit the source for the error message the mouse is pointing at."
1363   (interactive "e")
1364   (mouse-set-point event)
1365   (compile-goto-error))
1366
1367 (defun compile-goto-error ()
1368   "Visit the source for the error message point is on.
1369 Use this command in a compilation log buffer.  Sets the mark at point there."
1370   (interactive)
1371   (or (compilation-buffer-p (current-buffer))
1372       (error "Not in a compilation buffer"))
1373   (if (get-text-property (point) 'directory)
1374       (dired-other-window (car (get-text-property (point) 'directory)))
1375     (push-mark)
1376     (setq compilation-current-error (point))
1377     (next-error 0)))
1378
1379 ;; Return a compilation buffer.
1380 ;; If the current buffer is a compilation buffer, return it.
1381 ;; If compilation-last-buffer is set to a live buffer, use that.
1382 ;; Otherwise, look for a compilation buffer and signal an error
1383 ;; if there are none.
1384 (defun compilation-find-buffer (&optional other-buffer)
1385   (if (and (not other-buffer)
1386            (compilation-buffer-p (current-buffer)))
1387       ;; The current buffer is a compilation buffer.
1388       (current-buffer)
1389     (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
1390              (compilation-buffer-p compilation-last-buffer)
1391              (or (not other-buffer) (not (eq compilation-last-buffer
1392                                              (current-buffer)))))
1393         compilation-last-buffer
1394       (let ((buffers (buffer-list)))
1395         (while (and buffers (or (not (compilation-buffer-p (car buffers)))
1396                                 (and other-buffer
1397                                      (eq (car buffers) (current-buffer)))))
1398           (setq buffers (cdr buffers)))
1399         (if buffers
1400             (car buffers)
1401           (or (and other-buffer
1402                    (compilation-buffer-p (current-buffer))
1403                    ;; The current buffer is a compilation buffer.
1404                    (progn
1405                      (if other-buffer
1406                          (message "This is the only compilation buffer."))
1407                      (current-buffer)))
1408               (error "No compilation started!")))))))
1409
1410 ;;;###autoload
1411 (defun next-error (&optional n)
1412   "Visit next compilation error message and corresponding source code.
1413 Prefix arg N says how many error messages to move forwards (or
1414 backwards, if negative).
1415
1416 \\[next-error] normally uses the most recently started compilation or
1417 grep buffer.  However, it can operate on any buffer with output from
1418 the \\[compile] and \\[grep] commands, or, more generally, on any
1419 buffer in Compilation mode or with Compilation Minor mode enabled.  To
1420 specify use of a particular buffer for error messages, type
1421 \\[next-error] in that buffer.
1422
1423 Once \\[next-error] has chosen the buffer for error messages,
1424 it stays with that buffer until you use it in some other buffer which
1425 uses Compilation mode or Compilation Minor mode.
1426
1427 See variable `compilation-error-regexp-alist' for customization ideas."
1428   (interactive "p")
1429   (set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
1430   (let* ((columns compilation-error-screen-columns) ; buffer's local value
1431          (last 1)
1432          (loc (compilation-next-error (or n 1) nil
1433                                       (or compilation-current-error (point-min))))
1434          (end-loc (nth 2 loc))
1435          (marker (point-marker)))
1436     (setq compilation-current-error (point-marker)
1437           overlay-arrow-position
1438             (if (bolp)
1439                 compilation-current-error
1440               (save-excursion
1441                 (beginning-of-line)
1442                 (point-marker)))
1443           loc (car loc))
1444     ;; If loc contains no marker, no error in that file has been visited.  If
1445     ;; the marker is invalid the buffer has been killed.  So, recalculate all
1446     ;; markers for that file.
1447     (unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc)))
1448       (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
1449                                                   (or (cdar (nth 2 loc))
1450                                                       default-directory))
1451         (save-restriction
1452           (widen)
1453           (goto-char (point-min))
1454           ;; Treat file's found lines in forward order, 1 by 1.
1455           (dolist (line (reverse (cddr (nth 2 loc))))
1456             (when (car line)            ; else this is a filename w/o a line#
1457               (beginning-of-line (- (car line) last -1))
1458               (setq last (car line)))
1459             ;; Treat line's found columns and store/update a marker for each.
1460             (dolist (col (cdr line))
1461               (if (car col)
1462                   (if (eq (car col) -1) ; special case for range end
1463                       (end-of-line)
1464                     (if columns
1465                         (move-to-column (car col))
1466                       (beginning-of-line)
1467                       (forward-char (car col))))
1468                 (beginning-of-line)
1469                 (skip-chars-forward " \t"))
1470               (if (nthcdr 3 col)
1471                   (set-marker (nth 3 col) (point))
1472                 (setcdr (nthcdr 2 col) `(,(point-marker)))))))))
1473     (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
1474     (setcdr (nthcdr 3 loc) t)))         ; Set this one as visited.
1475
1476 ;;;###autoload (define-key ctl-x-map "`" 'next-error)
1477
1478 (defun previous-error (n)
1479   "Visit previous compilation error message and corresponding source code.
1480 Prefix arg N says how many error messages to move backwards (or
1481 forwards, if negative).
1482
1483 This operates on the output from the \\[compile] and \\[grep] commands."
1484   (interactive "p")
1485   (next-error (- n)))
1486
1487 (defun first-error (n)
1488   "Restart at the first error.
1489 Visit corresponding source code.
1490 With prefix arg N, visit the source code of the Nth error.
1491 This operates on the output from the \\[compile] command."
1492   (interactive "p")
1493   (set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
1494   (setq compilation-current-error nil)
1495   (next-error n))
1496
1497 (defcustom compilation-context-lines next-screen-context-lines
1498   "*Display this many lines of leading context before message."
1499   :type 'integer
1500   :group 'compilation
1501   :version "21.4")
1502
1503 (defsubst compilation-set-window (w mk)
1504   ;; Align the compilation output window W with marker MK near top.
1505   (set-window-start w (save-excursion
1506                         (goto-char mk)
1507                         (beginning-of-line (- 1 compilation-context-lines))
1508                         (point)))
1509   (set-window-point w mk))
1510
1511 (defun compilation-goto-locus (msg mk end-mk)
1512   "Jump to an error MESSAGE and SOURCE.
1513 All arguments are markers.  If SOURCE-END is non nil, mark is set there."
1514   (if (eq (window-buffer (selected-window))
1515           (marker-buffer msg))
1516       ;; If the compilation buffer window is selected,
1517       ;; keep the compilation buffer in this window;
1518       ;; display the source in another window.
1519       (let ((pop-up-windows t))
1520         (pop-to-buffer (marker-buffer mk)))
1521     (if (window-dedicated-p (selected-window))
1522         (pop-to-buffer (marker-buffer mk))
1523       (switch-to-buffer (marker-buffer mk))))
1524   ;; If narrowing gets in the way of going to the right place, widen.
1525   (unless (eq (goto-char mk) (point))
1526     (widen)
1527     (goto-char mk))
1528   (if end-mk
1529       (push-mark end-mk nil t)
1530     (if mark-active (setq mark-active)))
1531   ;; If hideshow got in the way of
1532   ;; seeing the right place, open permanently.
1533   (dolist (ov (overlays-at (point)))
1534     (when (eq 'hs (overlay-get ov 'invisible))
1535       (delete-overlay ov)
1536       (goto-char mk)))
1537
1538   ;; Show compilation buffer in other window, scrolled to this error.
1539   (let* ((pop-up-windows t)
1540          ;; Use an existing window if it is in a visible frame.
1541          (w (or (get-buffer-window (marker-buffer msg) 'visible)
1542                 ;; Pop up a window.
1543                 (display-buffer (marker-buffer msg))))
1544          (highlight-regexp (with-current-buffer (marker-buffer msg)
1545                              ;; also do this while we change buffer
1546                              (compilation-set-window w msg)
1547                              compilation-highlight-regexp)))
1548     (compilation-set-window-height w)
1549
1550     (when (and highlight-regexp
1551                (not (and end-mk transient-mark-mode)))
1552       (unless compilation-highlight-overlay
1553         (setq compilation-highlight-overlay
1554               (make-overlay (point-min) (point-min)))
1555         (overlay-put compilation-highlight-overlay 'face 'region))
1556       (with-current-buffer (marker-buffer mk)
1557         (save-excursion
1558           (end-of-line)
1559           (let ((end (point)))
1560             (beginning-of-line)
1561             (if (and (stringp highlight-regexp)
1562                      (re-search-forward highlight-regexp end t))
1563                 (progn
1564                   (goto-char (match-beginning 0))
1565                   (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0)))
1566               (move-overlay compilation-highlight-overlay (point) end))
1567             (sit-for 0.5)
1568             (delete-overlay compilation-highlight-overlay)))))))
1569
1570 \f
1571 (defun compilation-find-file (marker filename dir &rest formats)
1572   "Find a buffer for file FILENAME.
1573 Search the directories in `compilation-search-path'.
1574 A nil in `compilation-search-path' means to try the
1575 current directory, which is passed in DIR.
1576 If FILENAME is not found at all, ask the user where to find it.
1577 Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
1578   (or formats (setq formats '("%s")))
1579   (save-excursion
1580     (let ((dirs compilation-search-path)
1581           buffer thisdir fmts name)
1582       (if (file-name-absolute-p filename)
1583           ;; The file name is absolute.  Use its explicit directory as
1584           ;; the first in the search path, and strip it from FILENAME.
1585           (setq filename (abbreviate-file-name (expand-file-name filename))
1586                 dirs (cons (file-name-directory filename) dirs)
1587                 filename (file-name-nondirectory filename)))
1588       ;; Now search the path.
1589       (while (and dirs (null buffer))
1590         (setq thisdir (or (car dirs) dir)
1591               fmts formats)
1592         ;; For each directory, try each format string.
1593         (while (and fmts (null buffer))
1594           (setq name (expand-file-name (format (car fmts) filename) thisdir)
1595                 buffer (and (file-exists-p name)
1596                             (find-file-noselect name))
1597                 fmts (cdr fmts)))
1598         (setq dirs (cdr dirs)))
1599       (or buffer
1600           ;; The file doesn't exist.  Ask the user where to find it.
1601           (let ((pop-up-windows t))
1602             (compilation-set-window (display-buffer (marker-buffer marker))
1603                                     marker)
1604             (let ((name (expand-file-name
1605                          (read-file-name
1606                           (format "Find this error in: (default %s) "
1607                                   filename)
1608                           dir filename t))))
1609               (if (file-directory-p name)
1610                   (setq name (expand-file-name filename name)))
1611               (setq buffer (and (file-exists-p name)
1612                                 (find-file name))))))
1613       ;; Make intangible overlays tangible.
1614       (mapcar (function (lambda (ov)
1615                           (when (overlay-get ov 'intangible)
1616                             (overlay-put ov 'intangible nil))))
1617               (overlays-in (point-min) (point-max)))
1618       buffer)))
1619
1620 (defun compilation-normalize-filename (filename)
1621   "Convert a filename string found in an error message to make it usable."
1622
1623   ;; Check for a comint-file-name-prefix and prepend it if
1624   ;; appropriate.  (This is very useful for
1625   ;; compilation-minor-mode in an rlogin-mode buffer.)
1626   (and (boundp 'comint-file-name-prefix)
1627        ;; If file name is relative, default-directory will
1628        ;; already contain the comint-file-name-prefix (done
1629        ;; by compile-abbreviate-directory).
1630        (file-name-absolute-p filename)
1631        (setq filename
1632              (concat (with-no-warnings 'comint-file-name-prefix) filename)))
1633
1634   ;; If compilation-parse-errors-filename-function is
1635   ;; defined, use it to process the filename.
1636   (when compilation-parse-errors-filename-function
1637     (setq filename
1638           (funcall compilation-parse-errors-filename-function
1639                    filename)))
1640
1641   ;; Some compilers (e.g. Sun's java compiler, reportedly)
1642   ;; produce bogus file names like "./bar//foo.c" for file
1643   ;; "bar/foo.c"; expand-file-name will collapse these into
1644   ;; "/foo.c" and fail to find the appropriate file.  So we
1645   ;; look for doubled slashes in the file name and fix them
1646   ;; up in the buffer.
1647   (setq filename (command-line-normalize-file-name filename)))
1648
1649
1650 ;; If directory DIR is a subdir of ORIG or of ORIG's parent,
1651 ;; return a relative name for it starting from ORIG or its parent.
1652 ;; ORIG-EXPANDED is an expanded version of ORIG.
1653 ;; PARENT-EXPANDED is an expanded version of ORIG's parent.
1654 ;; Those two args could be computed here, but we run faster by
1655 ;; having the caller compute them just once.
1656 (defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded)
1657   ;; Apply canonical abbreviations to DIR first thing.
1658   ;; Those abbreviations are already done in the other arguments passed.
1659   (setq dir (abbreviate-file-name dir))
1660
1661   ;; Check for a comint-file-name-prefix and prepend it if appropriate.
1662   ;; (This is very useful for compilation-minor-mode in an rlogin-mode
1663   ;; buffer.)
1664   (if (boundp 'comint-file-name-prefix)
1665       (setq dir (concat comint-file-name-prefix dir)))
1666
1667   (if (and (> (length dir) (length orig-expanded))
1668            (string= orig-expanded
1669                     (substring dir 0 (length orig-expanded))))
1670       (setq dir
1671             (concat orig
1672                     (substring dir (length orig-expanded)))))
1673   (if (and (> (length dir) (length parent-expanded))
1674            (string= parent-expanded
1675                     (substring dir 0 (length parent-expanded))))
1676     (setq dir
1677           (concat (file-name-directory
1678                    (directory-file-name orig))
1679                   (substring dir (length parent-expanded)))))
1680   dir)
1681
1682 (add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
1683
1684 ;;; Compatibility with the old compile.el.
1685
1686 (defun compile-buffer-substring (n) (if n (match-string n)))
1687
1688 (defun compilation-compat-error-properties (err)
1689   ;; Map old-style ERROR to new-style MESSAGE.
1690   (let* ((dst (cdr err))
1691          (loc (cond ((markerp dst) (list nil nil nil dst))
1692                     ((consp dst)
1693                      (list (nth 2 dst) (nth 1 dst)
1694                            (cons (cdar dst) (caar dst)))))))
1695     ;; Must start with a face, for font-lock.
1696     `(face nil
1697       message ,(list loc 2)
1698       help-echo "mouse-2: visit the source location"
1699       mouse-face highlight)))
1700
1701 (defun compilation-compat-parse-errors (limit)
1702   (when compilation-parse-errors-function
1703     ;; FIXME: We should remove the rest of the compilation keywords
1704     ;; but we can't do that from here because font-lock is using
1705     ;; the value right now.  --stef
1706     (save-excursion
1707       (setq compilation-error-list nil)
1708       ;; Reset compilation-parsing-end each time because font-lock
1709       ;; might force us the re-parse many times (typically because
1710       ;; some code adds some text-property to the output that we
1711       ;; already parsed).  You might say "why reparse", well:
1712       ;; because font-lock has just removed the `message' property so
1713       ;; have to do it all over again.
1714       (if compilation-parsing-end
1715           (set-marker compilation-parsing-end (point))
1716         (setq compilation-parsing-end (point-marker)))
1717       (condition-case nil
1718           ;; Ignore any error: we're calling this function earlier than
1719           ;; in the old compile.el so things might not all be setup yet.
1720           (funcall compilation-parse-errors-function limit nil)
1721         (error nil))
1722       (dolist (err (if (listp compilation-error-list) compilation-error-list))
1723         (let* ((src (car err))
1724                (dst (cdr err))
1725                (loc (cond ((markerp dst) (list nil nil nil dst))
1726                           ((consp dst)
1727                            (list (nth 2 dst) (nth 1 dst)
1728                                  (cons (cdar dst) (caar dst)))))))
1729           (when loc
1730             (goto-char src)
1731             ;; (put-text-property src (line-end-position) 'font-lock-face 'font-lock-warning-face)
1732             (put-text-property src (line-end-position)
1733                                'message (list loc 2)))))))
1734   (goto-char limit)
1735   nil)
1736
1737 (defun compilation-forget-errors ()
1738   ;; In case we hit the same file/line specs, we want to recompute a new
1739   ;; marker for them, so flush our cache.
1740   (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
1741   ;; FIXME: the old code reset the directory-stack, so maybe we should
1742   ;; put a `directory change' marker of some sort, but where?  -stef
1743   ;;
1744   ;; FIXME: The old code moved compilation-current-error (which was
1745   ;; virtually represented by a mix of compilation-parsing-end and
1746   ;; compilation-error-list) to point-min, but that was only meaningful for
1747   ;; the internal uses of compilation-forget-errors: all calls from external
1748   ;; packages seem to be followed by a move of compilation-parsing-end to
1749   ;; something equivalent to point-max.  So we speculatively move
1750   ;; compilation-current-error to point-max (since the external package
1751   ;; won't know that it should do it).  --stef
1752   (setq compilation-current-error (point-max)))
1753
1754 (provide 'compile)
1755
1756 ;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
1757 ;;; compile.el ends here