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

3
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4
;;   2001, 2003, 2004, 2005  Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5

Stefan Monnier's avatar
Stefan Monnier committed
6 7
;; Authors: Roland McGrath <roland@gnu.org>,
;;	    Daniel Pfeiffer <occitan@esperanto.org>
Eric S. Raymond's avatar
Eric S. Raymond committed
8
;; Maintainer: FSF
Eric S. Raymond's avatar
Eric S. Raymond committed
9
;; Keywords: tools, processes
Eric S. Raymond's avatar
Eric S. Raymond committed
10

Richard M. Stallman's avatar
Richard M. Stallman committed
11 12
;; This file is part of GNU Emacs.

Roland McGrath's avatar
Roland McGrath committed
13 14 15 16 17
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

Richard M. Stallman's avatar
Richard M. Stallman committed
18
;; GNU Emacs is distributed in the hope that it will be useful,
Roland McGrath's avatar
Roland McGrath committed
19 20 21 22 23
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
24 25 26
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
27

Eric S. Raymond's avatar
Eric S. Raymond committed
28 29
;;; Commentary:

Stefan Monnier's avatar
Stefan Monnier committed
30 31
;; This package provides the compile facilities documented in the Emacs user's
;; manual.
Eric S. Raymond's avatar
Eric S. Raymond committed
32

33
;; This mode uses some complex data-structures:
Stefan Monnier's avatar
Stefan Monnier committed
34

35
;;   LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE)
Stefan Monnier's avatar
Stefan Monnier committed
36 37 38 39 40 41 42 43 44 45 46

;; COLUMN and LINE are numbers parsed from an error message.  COLUMN and maybe
;; LINE will be nil for a message that doesn't contain them.  Then the
;; location refers to a indented beginning of line or beginning of file.
;; Once any location in some file has been jumped to, the list is extended to
;; (COLUMN LINE FILE-STRUCTURE MARKER . VISITED) for all LOCs pertaining to
;; that file.
;; MARKER initially points to LINE and COLUMN in a buffer visiting that file.
;; Being a marker it sticks to some text, when the buffer grows or shrinks
;; before that point.  VISITED is t if we have jumped there, else nil.

47 48
;;   FILE-STRUCTURE is a list of
;;   ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...) ...)
Stefan Monnier's avatar
Stefan Monnier committed
49 50 51 52 53 54 55 56 57 58 59

;; FILENAME is a string parsed from an error message.  DIRECTORY is a string
;; obtained by following directory change messages.  DIRECTORY will be nil for
;; an absolute filename.  FORMATS is a list of formats to apply to FILENAME if
;; a file of that name can't be found.
;; The rest of the list is an alist of elements with LINE as key.  The keys
;; are either nil or line numbers.  If present, nil comes first, followed by
;; the numbers in decreasing order.  The LOCs for each line are again an alist
;; ordered the same way.  Note that the whole file structure is referenced in
;; every LOC.

60
;;   MESSAGE is a list of (LOC TYPE END-LOC)
Stefan Monnier's avatar
Stefan Monnier committed
61 62 63 64 65 66 67 68

;; TYPE is 0 for info or 1 for warning if the message matcher identified it as
;; such, 2 otherwise (for a real error).  END-LOC is a LOC pointing to the
;; other end, if the parsed message contained a range.	If the end of the
;; range didn't specify a COLUMN, it defaults to -1, meaning end of line.
;; These are the value of the `message' text-properties in the compilation
;; buffer.

69 70
;;; Code:

Stefan Monnier's avatar
Stefan Monnier committed
71 72
(eval-when-compile (require 'cl))

73 74 75 76 77 78
(defgroup compilation nil
  "Run compiler as inferior of Emacs, parse error messages."
  :group 'tools
  :group 'processes)


Roland McGrath's avatar
Roland McGrath committed
79
;;;###autoload
80 81 82 83
(defcustom compilation-mode-hook nil
  "*List of hook functions run by `compilation-mode' (see `run-hooks')."
  :type 'hook
  :group 'compilation)
Roland McGrath's avatar
Roland McGrath committed
84 85

;;;###autoload
86 87 88 89 90
(defcustom compilation-window-height nil
  "*Number of lines in a compilation window.  If nil, use Emacs default."
  :type '(choice (const :tag "Default" nil)
		 integer)
  :group 'compilation)
Roland McGrath's avatar
Roland McGrath committed
91

Stefan Monnier's avatar
Stefan Monnier committed
92 93
(defvar compilation-first-column 1
  "*This is how compilers number the first column, usually 1 or 0.")
Richard M. Stallman's avatar
Richard M. Stallman committed
94

95 96 97 98 99
(defvar compilation-parse-errors-filename-function nil
  "Function to call to post-process filenames while parsing error messages.
It takes one arg FILENAME which is the name of a file as found
in the compilation output, and should return a transformed file name.")

100 101 102
;;;###autoload
(defvar compilation-process-setup-function nil
  "*Function to call to customize the compilation process.
Stefan Monnier's avatar
Stefan Monnier committed
103
This function is called immediately before the compilation process is
104
started.  It can be used to set any variables or functions that are used
105 106
while processing the output of the compilation process.  The function
is called with variables `compilation-buffer' and `compilation-window'
Stefan Monnier's avatar
Stefan Monnier committed
107
bound to the compilation buffer and window, respectively.")
108

Jim Blandy's avatar
Jim Blandy committed
109
;;;###autoload
Roland McGrath's avatar
Roland McGrath committed
110
(defvar compilation-buffer-name-function nil
Richard M. Stallman's avatar
Richard M. Stallman committed
111 112 113 114
  "Function to compute the name of a compilation buffer.
The function receives one argument, the name of the major mode of the
compilation buffer.  It should return a string.
nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.")
Richard M. Stallman's avatar
Richard M. Stallman committed
115

Jim Blandy's avatar
Jim Blandy committed
116
;;;###autoload
Roland McGrath's avatar
Roland McGrath committed
117
(defvar compilation-finish-function nil
118
  "Function to call when a compilation process finishes.
Roland McGrath's avatar
Roland McGrath committed
119 120
It is called with two arguments: the compilation buffer, and a string
describing how the process finished.")
Richard M. Stallman's avatar
Richard M. Stallman committed
121

122 123
;;;###autoload
(defvar compilation-finish-functions nil
124
  "Functions to call when a compilation process finishes.
125 126 127
Each function is called with two arguments: the compilation buffer,
and a string describing how the process finished.")

Roland McGrath's avatar
Roland McGrath committed
128 129 130 131 132 133
(defvar compilation-in-progress nil
  "List of compilation processes now running.")
(or (assq 'compilation-in-progress minor-mode-alist)
    (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
				 minor-mode-alist)))

Stefan Monnier's avatar
Stefan Monnier committed
134 135
(defvar compilation-error "error"
  "Stem of message to print when no matches are found.")
Richard M. Stallman's avatar
Richard M. Stallman committed
136

137
(defvar compilation-arguments nil
Stefan Monnier's avatar
Stefan Monnier committed
138
  "Arguments that were given to `compilation-start'.")
139

Richard M. Stallman's avatar
Richard M. Stallman committed
140
(defvar compilation-num-errors-found)
Roland McGrath's avatar
Roland McGrath committed
141

Stefan Monnier's avatar
Stefan Monnier committed
142 143 144 145
(defconst compilation-error-regexp-alist-alist
  '((absoft
     "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
146

Stefan Monnier's avatar
Stefan Monnier committed
147 148
    (ada
     "\\(warning: .*\\)? at \\([^ \n]+\\):\\([0-9]+\\)$" 2 3 nil (1))
Karl Heuer's avatar
Karl Heuer committed
149

Stefan Monnier's avatar
Stefan Monnier committed
150 151
    (aix
     " in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
152

Stefan Monnier's avatar
Stefan Monnier committed
153 154 155
    (ant
     "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):[0-9]+:[0-9]+:\\)?\
\\( warning\\)?" 1 2 3 (4))
156

Stefan Monnier's avatar
Stefan Monnier committed
157 158
    (bash
     "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
159

Stefan Monnier's avatar
Stefan Monnier committed
160 161 162 163 164 165
    (borland
     "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\
\\([a-zA-Z]?:?[^:( \t\n]+\\)\
 \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))

    (caml
166 167 168
     "^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)"
     2 (3 . 4) (5 . 6) (7))
Stefan Monnier's avatar
Stefan Monnier committed
169 170 171 172 173

    (comma
     "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
\\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))

174 175 176 177 178 179 180
    (edg-1
     "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
     1 2 nil (3 . 4))
    (edg-2
     "at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$"
     2 1 nil 0)

Stefan Monnier's avatar
Stefan Monnier committed
181
    (epc
182
     "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
Stefan Monnier's avatar
Stefan Monnier committed
183

184 185 186
    (ftnchek
     "\\(^Warning .*\\)? line[ \n]\\([0-9]+\\)[ \n]\\(?:col \\([0-9]+\\)[ \n]\\)?file \\([^ :;\n]+\\)"
     4 2 3 (1))
187

Stefan Monnier's avatar
Stefan Monnier committed
188 189 190 191 192 193 194 195
    (iar
     "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
     1 2 nil (3))

    (ibm
     "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\
 \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))

Stefan Monnier's avatar
Stefan Monnier committed
196
    ;; fixme: should be `mips'
Stefan Monnier's avatar
Stefan Monnier committed
197
    (irix
198 199
     "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\
\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
Stefan Monnier's avatar
Stefan Monnier committed
200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215

    (java
     "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))

    (jikes-file
     "^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0)
    (jikes-line
     "^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
     nil 1 nil 2 0
     (2 (compilation-face '(3))))

    (gcc-include
     "^\\(?:In file included\\|                \\) from \
\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))

    (gnu
Stefan Monnier's avatar
Stefan Monnier committed
216
     "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
217
\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\
Stefan Monnier's avatar
Stefan Monnier committed
218 219 220 221 222 223 224 225 226 227 228
\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
 *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\)\\)?"
     1 (2 . 5) (4 . 6) (7 . 8))

    (lcc
     "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
     2 3 4 (1))

    (makepp
229
     "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\) \\|.*?\\)\
Stefan Monnier's avatar
Stefan Monnier committed
230 231 232 233 234
`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'\\)"
     4 5 nil (1 . 2) 3
     ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'" nil nil
      (2 compilation-info-face)
      (3 compilation-line-face nil t)
Daniel Pfeiffer's avatar
Daniel Pfeiffer committed
235
      (1 (compilation-error-properties 2 3 nil nil nil 0 nil)
Stefan Monnier's avatar
Stefan Monnier committed
236 237
	 append)))

Stefan Monnier's avatar
Stefan Monnier committed
238
    ;; Should be lint-1, lint-2 (SysV lint)
Stefan Monnier's avatar
Stefan Monnier committed
239 240 241 242 243 244 245 246 247 248
    (mips-1
     " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
    (mips-2
     " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)

    (msft
     "^\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3))

    (oracle
249 250 251
     "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
\\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\
\\(?:,\\| in\\| of\\)? file \\(.*?\\):?$"
Stefan Monnier's avatar
Stefan Monnier committed
252
     3 1 2)
253

Stefan Monnier's avatar
Stefan Monnier committed
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
    (perl
     " at \\([^ \n]+\\) line \\([0-9]+\\)\\(?:[,.]\\|$\\)" 1 2)

    (rxp
     "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\
 \\([0-9]+\\) of file://\\(.+\\)"
     4 2 3 (1))

    (sparc-pascal-file
     "^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\
 [12][09][0-9][0-9] +\\(.*\\):$"
     1 nil nil 0)
    (sparc-pascal-line
     "^\\(\\(?:E\\|\\(w\\)\\) +[0-9]+\\) line \\([0-9]+\\) -  "
     nil 3 nil (2) nil (1 (compilation-face '(2))))
    (sparc-pascal-example
     "^ +\\([0-9]+\\) +.*\n\\(\\(?:e\\|\\(w\\)\\) [0-9]+\\)-+"
     nil 1 nil (3) nil (2 (compilation-face '(3))))

    (sun
Stefan Monnier's avatar
Stefan Monnier committed
274
     ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\
Stefan Monnier's avatar
Stefan Monnier committed
275 276 277 278 279 280 281 282
File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
     3 4 5 (1 . 2))

    (sun-ada
     "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)

    (4bsd
     "\\(?:^\\|::  \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
283 284 285 286 287 288 289 290 291 292 293 294
\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))

    (gcov-file
     "^ +-:    \\(0\\):Source:\\(.+\\)$" 2 1 nil 0)    
    (gcov-bb-file
     "^ +-:    \\(0\\):Object:\\(?:.+\\)$" nil 1 nil 0)    
    (gcov-never-called-line
     "^ +\\(#####\\): +\\([0-9]+\\):.+$" nil 2 nil 2 nil 
     (1 compilation-error-face))
    (gcov-called-line
     "^ +[-0-9]+: +\\([1-9]\\|[0-9]\\{2,\\}\\):.*$" nil 1 nil 0)
)
Stefan Monnier's avatar
Stefan Monnier committed
295 296 297 298
  "Alist of values for `compilation-error-regexp-alist'.")

(defcustom compilation-error-regexp-alist
  (mapcar 'car compilation-error-regexp-alist-alist)
Richard M. Stallman's avatar
Richard M. Stallman committed
299
  "Alist that specifies how to match errors in compiler output.
Stefan Monnier's avatar
Stefan Monnier committed
300
Note that on Unix everything is a valid filename, so these
Stefan Monnier's avatar
Stefan Monnier committed
301 302 303 304 305 306
matchers must make some common sense assumptions, which catch
normal cases.  A shorter list will be lighter on resource usage.

Instead of an alist element, you can use a symbol, which is
looked up in `compilation-error-regexp-alist-alist'.  You can see
the predefined symbols and their effects in the file
Stefan Monnier's avatar
Stefan Monnier committed
307
`etc/compilation.txt' (linked below if you are customizing this).
Stefan Monnier's avatar
Stefan Monnier committed
308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348

Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK
HIGHLIGHT...]).  If REGEXP matches, the FILE'th subexpression
gives the file name, and the LINE'th subexpression gives the line
number.  The COLUMN'th subexpression gives the column number on
that line.

If FILE, LINE or COLUMN are nil or that index didn't match, that
information is not present on the matched line.  In that case the
file name is assumed to be the same as the previous one in the
buffer, line number defaults to 1 and column defaults to
beginning of line's indentation.

FILE can also have the form (FILE FORMAT...), where the FORMATs
\(e.g. \"%s.c\") will be applied in turn to the recognized file
name, until a file of that name is found.  Or FILE can also be a
function to return the filename.

LINE can also be of the form (LINE . END-LINE) meaning a range
of lines.  COLUMN can also be of the form (COLUMN . END-COLUMN)
meaning a range of columns starting on LINE and ending on
END-LINE, if that matched.

TYPE is 2 or nil for a real error or 1 for warning or 0 for info.
TYPE can also be of the form (WARNING . INFO).  In that case this
will be equivalent to 1 if the WARNING'th subexpression matched
or else equivalent to 0 if the INFO'th subexpression matched.
See `compilation-error-face', `compilation-warning-face',
`compilation-info-face' and `compilation-skip-threshold'.

What matched the HYPERLINK'th subexpression has `mouse-face' and
`compilation-message-face' applied.  If this is nil, the text
matched by the whole REGEXP becomes the hyperlink.

Additional HIGHLIGHTs as described under `font-lock-keywords' can
be added."
  :type `(set :menu-tag "Pick"
	      ,@(mapcar (lambda (elt)
			  (list 'const (car elt)))
			compilation-error-regexp-alist-alist))
  :link `(file-link :tag "example file"
349
		    ,(expand-file-name "compilation.txt" data-directory))
Stefan Monnier's avatar
Stefan Monnier committed
350
  :group 'compilation)
Richard M. Stallman's avatar
Richard M. Stallman committed
351

352 353 354
(defvar compilation-directory nil
  "Directory to restore to when doing `recompile'.")

Stefan Monnier's avatar
Stefan Monnier committed
355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377
(defvar compilation-directory-matcher
  '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1))
  "A list for tracking when directories are entered or left.
Nil means not to track directories, e.g. if all file names are absolute.  The
first element is the REGEXP matching these messages.  It can match any number
of variants, e.g. different languages.  The remaining elements are all of the
form (DIR .  LEAVE).  If for any one of these the DIR'th subexpression
matches, that is a directory name.  If LEAVE is nil or the corresponding
LEAVE'th subexpression doesn't match, this message is about going into another
directory.  If it does match anything, this message is about going back to the
directory we were in before the last entering message.  If you change this,
you may also want to change `compilation-page-delimiter'.")

(defvar compilation-page-delimiter
  "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory `.+'\n\\)+"
  "Value of `page-delimiter' in Compilation mode.")

(defvar compilation-mode-font-lock-keywords
   '(;; configure output lines.
     ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$"
      (1 font-lock-variable-name-face)
      (2 (compilation-face '(4 . 3))))
     ;; Command output lines.  Recognize `make[n]:' lines too.
Stefan Monnier's avatar
Stefan Monnier committed
378
     ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
Stefan Monnier's avatar
Stefan Monnier committed
379 380 381 382 383 384
      (1 font-lock-function-name-face) (3 compilation-line-face nil t))
     (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1)
     ("^Compilation finished" . compilation-info-face)
     ("^Compilation exited abnormally" . compilation-error-face))
   "Additional things to highlight in Compilation mode.
This gets tacked on the end of the generated expressions.")
385

386 387 388 389 390 391 392
(defvar compilation-highlight-regexp t
  "Regexp matching part of visited source lines to highlight temporarily.
Highlight entire line if t; don't highlight source lines if nil.")

(defvar compilation-highlight-overlay nil
  "Overlay used to temporarily highlight compilation matches.")

393 394 395 396 397 398 399 400 401 402 403
(defcustom compilation-error-screen-columns t
  "*If non-nil, column numbers in error messages are screen columns.
Otherwise they are interpreted as character positions, with
each character occupying one column.
The default is to use screen columns, which requires that the compilation
program and Emacs agree about the display width of the characters,
especially the TAB character."
  :type 'boolean
  :group 'compilation
  :version "20.4")

404
(defcustom compilation-read-command t
Dave Love's avatar
Dave Love committed
405 406
  "*Non-nil means \\[compile] reads the compilation command to use.
Otherwise, \\[compile] just uses the value of `compile-command'."
407 408
  :type 'boolean
  :group 'compilation)
409

410
;;;###autoload
411
(defcustom compilation-ask-about-save t
Dave Love's avatar
Dave Love committed
412
  "*Non-nil means \\[compile] asks which buffers to save before compiling.
413 414 415
Otherwise, it saves all modified buffers without asking."
  :type 'boolean
  :group 'compilation)
416

Roland McGrath's avatar
Roland McGrath committed
417
;;;###autoload
418
(defcustom compilation-search-path '(nil)
Roland McGrath's avatar
Roland McGrath committed
419
  "*List of directories to search for source files named in error messages.
Roland McGrath's avatar
Roland McGrath committed
420
Elements should be directory names, not file names of directories.
421 422 423 424
nil as an element means to try the default directory."
  :type '(repeat (choice (const :tag "Default" nil)
			 (string :tag "Directory")))
  :group 'compilation)
Richard M. Stallman's avatar
Richard M. Stallman committed
425

426 427
(defcustom compile-command "make -k "
  "*Last shell command used to do a compilation; default for next compilation.
Richard M. Stallman's avatar
Richard M. Stallman committed
428 429 430 431

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

432 433 434 435
    (add-hook 'c-mode-hook
       (lambda ()
	 (unless (or (file-exists-p \"makefile\")
		     (file-exists-p \"Makefile\"))
436 437
	   (set (make-local-variable 'compile-command)
		(concat \"make -k \"
Stefan Monnier's avatar
Stefan Monnier committed
438
			(file-name-sans-extension buffer-file-name))))))"
439 440
  :type 'string
  :group 'compilation)
Richard M. Stallman's avatar
Richard M. Stallman committed
441

Stefan Monnier's avatar
Stefan Monnier committed
442 443 444 445 446 447
;; A weak per-compilation-buffer hash indexed by (FILENAME . DIRECTORY).  Each
;; value is a FILE-STRUCTURE as described above, with the car eq to the hash
;; key.	 This holds the tree seen from root, for storing new nodes.
(defvar compilation-locs ())

(defvar compilation-debug nil
Stefan Monnier's avatar
Stefan Monnier committed
448
  "*Set this to t before creating a *compilation* buffer.
Stefan Monnier's avatar
Stefan Monnier committed
449 450
Then every error line will have a debug text property with the matcher that
fit this line and the match data.  Use `describe-text-properties'.")
Roland McGrath's avatar
Roland McGrath committed
451

452 453
(defvar compilation-exit-message-function nil "\
If non-nil, called when a compilation process dies to return a status message.
454 455 456
This should be a function of three arguments: process status, exit status,
and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
write into the compilation buffer, and to put in its mode line.")
457

458 459 460 461 462 463
(defvar compilation-environment nil
  "*List of environment variables for compilation to inherit.
Each element should be a string of the form ENVVARNAME=VALUE.
This list is temporarily prepended to `process-environment' prior to
starting the compilation process.")

464 465 466
;; History of compile commands.
(defvar compile-history nil)

Stefan Monnier's avatar
Stefan Monnier committed
467
(defface compilation-warning-face
468 469
  '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold))
    (((class color)) (:foreground "cyan" :weight bold))
Stefan Monnier's avatar
Stefan Monnier committed
470 471
    (t (:weight bold)))
  "Face used to highlight compiler warnings."
472
  :group 'font-lock-highlighting-faces
473
  :version "22.1")
Stefan Monnier's avatar
Stefan Monnier committed
474 475

(defface compilation-info-face
476
  '((((class color) (min-colors 16) (background light))
477
     (:foreground "Green3" :weight bold))
478 479
    (((class color) (min-colors 88) (background dark))
     (:foreground "Green1" :weight bold))
480
    (((class color) (min-colors 16) (background dark))
481 482
     (:foreground "Green" :weight bold))
    (((class color)) (:foreground "green" :weight bold))
Stefan Monnier's avatar
Stefan Monnier committed
483 484
    (t (:weight bold)))
  "Face used to highlight compiler warnings."
485
  :group 'font-lock-highlighting-faces
486
  :version "22.1")
Stefan Monnier's avatar
Stefan Monnier committed
487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517

(defvar compilation-message-face nil
  "Face name to use for whole messages.
Faces `compilation-error-face', `compilation-warning-face',
`compilation-info-face', `compilation-line-face' and
`compilation-column-face' get prepended to this, when applicable.")

(defvar compilation-error-face 'font-lock-warning-face
  "Face name to use for file name in error messages.")

(defvar compilation-warning-face 'compilation-warning-face
  "Face name to use for file name in warning messages.")

(defvar compilation-info-face 'compilation-info-face
  "Face name to use for file name in informational messages.")

(defvar compilation-line-face 'font-lock-variable-name-face
  "Face name to use for line number in message.")

(defvar compilation-column-face 'font-lock-type-face
  "Face name to use for column number in message.")

;; same faces as dired uses
(defvar compilation-enter-directory-face 'font-lock-function-name-face
  "Face name to use for column number in message.")

(defvar compilation-leave-directory-face 'font-lock-type-face
  "Face name to use for column number in message.")



518
;; Used for compatibility with the old compile.el.
519
(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
Stefan Monnier's avatar
Stefan Monnier committed
520
(defvar compilation-parsing-end (make-marker))
521 522 523 524
(defvar compilation-parse-errors-function nil)
(defvar compilation-error-list nil)
(defvar compilation-old-error-list nil)

Stefan Monnier's avatar
Stefan Monnier committed
525 526 527 528 529
(defun compilation-face (type)
  (or (and (car type) (match-end (car type)) compilation-warning-face)
      (and (cdr type) (match-end (cdr type)) compilation-info-face)
      compilation-error-face))

530 531 532 533
;; Internal function for calculating the text properties of a directory
;; change message.  The directory property is important, because it is
;; the stack of nested enter-messages.  Relative filenames on the following
;; lines are relative to the top of the stack.
Stefan Monnier's avatar
Stefan Monnier committed
534 535 536 537 538 539 540 541 542 543 544 545 546 547
(defun compilation-directory-properties (idx leave)
  (if leave (setq leave (match-end leave)))
  ;; find previous stack, and push onto it, or if `leave' pop it
  (let ((dir (previous-single-property-change (point) 'directory)))
    (setq dir (if dir (or (get-text-property (1- dir) 'directory)
			  (get-text-property dir 'directory))))
    `(face ,(if leave
		compilation-leave-directory-face
	      compilation-enter-directory-face)
      directory ,(if leave
		     (or (cdr dir)
			 '(nil))	; nil only isn't a property-change
		   (cons (match-string-no-properties idx) dir))
      mouse-face highlight
Stefan Monnier's avatar
Stefan Monnier committed
548
      keymap compilation-button-map
Stefan Monnier's avatar
Stefan Monnier committed
549 550 551 552 553 554 555 556 557 558
      help-echo "mouse-2: visit current directory")))

;; Data type `reverse-ordered-alist' retriever.	 This function retrieves the
;; KEY element from the ALIST, creating it in the right position if not already
;; present. ALIST structure is
;; '(ANCHOR (KEY1 ...) (KEY2 ...)... (KEYn ALIST ...))
;; ANCHOR is ignored, but necessary so that elements can be inserted.  KEY1
;; may be nil.	The other KEYs are ordered backwards so that growing line
;; numbers can be inserted in front and searching can abort after half the
;; list on average.
Stefan Monnier's avatar
Stefan Monnier committed
559
(eval-when-compile		    ;Don't keep it at runtime if not needed.
Stefan Monnier's avatar
Stefan Monnier committed
560 561 562 563 564 565 566 567 568 569
(defmacro compilation-assq (key alist)
  `(let* ((l1 ,alist)
	  (l2 (cdr l1)))
     (car (if (if (null ,key)
		  (if l2 (null (caar l2)))
		(while (if l2 (if (caar l2) (< ,key (caar l2)) t))
		  (setq l1 l2
			l2 (cdr l1)))
		(if l2 (eq ,key (caar l2))))
	      l2
Stefan Monnier's avatar
Stefan Monnier committed
570
	    (setcdr l1 (cons (list ,key) l2)))))))
Stefan Monnier's avatar
Stefan Monnier committed
571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587


;; This function is the central driver, called when font-locking to gather
;; all information needed to later jump to corresponding source code.
;; Return a property list with all meta information on this error location.
(defun compilation-error-properties (file line end-line col end-col type fmt)
  (unless (< (next-single-property-change (match-beginning 0) 'directory nil (point))
	     (point))
    (if file
	(if (functionp file)
	    (setq file (funcall file))
	  (let (dir)
	    (setq file (match-string-no-properties file))
	    (unless (file-name-absolute-p file)
	      (setq dir (previous-single-property-change (point) 'directory)
		    dir (if dir (or (get-text-property (1- dir) 'directory)
				    (get-text-property dir 'directory)))))
588
	    (setq file (cons file (car dir)))))
Stefan Monnier's avatar
Stefan Monnier committed
589 590 591
      ;; This message didn't mention one, get it from previous
      (setq file (previous-single-property-change (point) 'message)
	    file (or (if file
592 593 594
			 (car (nth 2 (car (or (get-text-property (1- file) 'message)
					 (get-text-property file 'message))))))
		     '("*unknown*"))))
Stefan Monnier's avatar
Stefan Monnier committed
595 596 597 598 599 600 601 602
    ;; All of these fields are optional, get them only if we have an index, and
    ;; it matched some part of the message.
    (and line
	 (setq line (match-string-no-properties line))
	 (setq line (string-to-number line)))
    (and end-line
	 (setq end-line (match-string-no-properties end-line))
	 (setq end-line (string-to-number end-line)))
603 604 605 606 607 608 609 610 611 612 613
    (if col
        (if (functionp col)
            (setq col (funcall col))
          (and
           (setq col (match-string-no-properties col))
           (setq col (- (string-to-number col) compilation-first-column)))))
    (if (and end-col (functionp end-col))
        (setq end-col (funcall end-col))
      (if (and end-col (setq end-col (match-string-no-properties end-col)))
          (setq end-col (- (string-to-number end-col) compilation-first-column -1))
        (if end-line (setq end-col -1))))
614
    (if (consp type)			; not a static type, check what it is.
Stefan Monnier's avatar
Stefan Monnier committed
615 616 617
	(setq type (or (and (car type) (match-end (car type)) 1)
		       (and (cdr type) (match-end (cdr type)) 0)
		       2)))
618 619
    (compilation-internal-error-properties file line end-line col end-col type fmt)))

620 621 622 623 624 625 626 627
(defun compilation-move-to-column (col screen)
  "Go to column COL on the current line.
If SCREEN is non-nil, columns are screen columns, otherwise, they are
just char-counts."
  (if screen
      (move-to-column col)
    (goto-char (min (+ (line-beginning-position) col) (line-end-position)))))

628 629 630 631
(defun compilation-internal-error-properties (file line end-line col end-col type fmt)
  "Get the meta-info that will be added as text-properties.
LINE, END-LINE, COL, END-COL are integers or nil.
TYPE can be 0, 1, or 2.
632
FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
633
  (unless file (setq file '("*unknown*")))
634
  (setq file (compilation-get-file-structure file fmt))
635 636 637 638 639 640 641 642
  ;; Get first already existing marker (if any has one, all have one).
  ;; Do this first, as the compilation-assq`s may create new nodes.
  (let* ((marker-line (car (cddr file)))	; a line structure
	 (marker (nth 3 (cadr marker-line)))	; its marker
	 (compilation-error-screen-columns compilation-error-screen-columns)
	 end-marker loc end-loc)
    (if (not (and marker (marker-buffer marker)))
	(setq marker)			; no valid marker for this file
643 644 645 646
      (setq loc (or line 1))		; normalize no linenumber to line 1
      (catch 'marker			; find nearest loc, at least one exists
	(dolist (x (nthcdr 3 file))	; loop over remaining lines
	  (if (> (car x) loc)		; still bigger
647
	      (setq marker-line x)
648 649
	    (if (> (- (or (car marker-line) 1) loc)
		   (- loc (car x)))	; current line is nearer
650 651 652
		(setq marker-line x))
	    (throw 'marker t))))
      (setq marker (nth 3 (cadr marker-line))
653
	    marker-line (or (car marker-line) 1))
654 655 656 657 658 659
      (with-current-buffer (marker-buffer marker)
	(save-restriction
	  (widen)
	  (goto-char (marker-position marker))
	  (when (or end-col end-line)
	    (beginning-of-line (- (or end-line line) marker-line -1))
660
	    (if (or (null end-col) (< end-col 0))
661
		(end-of-line)
662 663
	      (compilation-move-to-column
	       end-col compilation-error-screen-columns))
664 665
	    (setq end-marker (list (point-marker))))
	  (beginning-of-line (if end-line
666
				 (- line end-line -1)
667 668
			       (- loc marker-line -1)))
	  (if col
669 670
	      (compilation-move-to-column
	       col compilation-error-screen-columns)
671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698
	    (forward-to-indentation 0))
	  (setq marker (list (point-marker))))))

    (setq loc (compilation-assq line (cdr file)))
    (if end-line
	(setq end-loc (compilation-assq end-line (cdr file))
	      end-loc (compilation-assq end-col end-loc))
      (if end-col			; use same line element
	  (setq end-loc (compilation-assq end-col loc))))
    (setq loc (compilation-assq col loc))
    ;; If they are new, make the loc(s) reference the file they point to.
    (or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
    (if end-loc
	(or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))

    ;; Must start with face
    `(face ,compilation-message-face
	   message (,loc ,type ,end-loc)
	   ,@(if compilation-debug
		 `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
			  ,@(match-data))))
	   help-echo ,(if col
			  "mouse-2: visit this file, line and column"
			(if line
			    "mouse-2: visit this file and line"
			  "mouse-2: visit this file"))
	   keymap compilation-button-map
	   mouse-face highlight)))
Stefan Monnier's avatar
Stefan Monnier committed
699

Simon Marshall's avatar
Simon Marshall committed
700 701
(defun compilation-mode-font-lock-keywords ()
  "Return expressions to highlight in Compilation mode."
702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726
  (if compilation-parse-errors-function
      ;; An old package!  Try the compatibility code.
      '((compilation-compat-parse-errors))
    (append
     ;; make directory tracking
     (if compilation-directory-matcher
	 `((,(car compilation-directory-matcher)
	    ,@(mapcar (lambda (elt)
			`(,(car elt)
			  (compilation-directory-properties
			   ,(car elt) ,(cdr elt))
			  t))
		      (cdr compilation-directory-matcher)))))

     ;; Compiler warning/error lines.
     (mapcar
      (lambda (item)
	(if (symbolp item)
	    (setq item (cdr (assq item
				  compilation-error-regexp-alist-alist))))
	(let ((file (nth 1 item))
	      (line (nth 2 item))
	      (col (nth 3 item))
	      (type (nth 4 item))
	      end-line end-col fmt)
727 728
	  (if (consp file)	(setq fmt (cdr file)	  file (car file)))
	  (if (consp line)	(setq end-line (cdr line) line (car line)))
729
	  (if (consp col)	(setq end-col (cdr col)	  col (car col)))
730

731
	  (if (functionp line)
732 733 734 735 736
	      ;; The old compile.el had here an undocumented hook that
	      ;; allowed `line' to be a function that computed the actual
	      ;; error location.  Let's do our best.
	      `(,(car item)
		(0 (compilation-compat-error-properties
Stefan Monnier's avatar
Stefan Monnier committed
737 738 739
		    (funcall ',line (cons (match-string ,file)
					  (cons default-directory
						',(nthcdr 4 item)))
740 741
			     ,(if col `(match-string ,col)))))
		(,file compilation-error-face t))
742

743 744 745
	    (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
	      (error "HYPERLINK should be an integer: %s" (nth 5 item)))

746 747 748 749 750 751 752 753 754 755 756 757 758 759 760
	    `(,(nth 0 item)

	      ,@(when (integerp file)
		  `((,file ,(if (consp type)
				`(compilation-face ',type)
			      (aref [compilation-info-face
				     compilation-warning-face
				     compilation-error-face]
				    (or type 2))))))

	      ,@(when line
		  `((,line compilation-line-face nil t)))
	      ,@(when end-line
		  `((,end-line compilation-line-face nil t)))

761
	      ,@(when (integerp col)
762
		  `((,col compilation-column-face nil t)))
763
	      ,@(when (integerp end-col)
764 765 766 767 768 769 770 771 772 773 774
		  `((,end-col compilation-column-face nil t)))

	      ,@(nthcdr 6 item)
	      (,(or (nth 5 item) 0)
	       (compilation-error-properties ',file ,line ,end-line
					     ,col ,end-col ',(or type 2)
					     ',fmt)
	       append)))))		; for compilation-message-face
      compilation-error-regexp-alist)

     compilation-mode-font-lock-keywords)))
Stefan Monnier's avatar
Stefan Monnier committed
775

776

Roland McGrath's avatar
Roland McGrath committed
777
;;;###autoload
Stefan Monnier's avatar
Stefan Monnier committed
778
(defun compile (command &optional comint)
Richard M. Stallman's avatar
Richard M. Stallman committed
779 780 781
  "Compile the program including the current buffer.  Default: run `make'.
Runs COMMAND, a shell command, in a separate process asynchronously
with output going to the buffer `*compilation*'.
Roland McGrath's avatar
Roland McGrath committed
782

Stefan Monnier's avatar
Stefan Monnier committed
783
If optional second arg COMINT is t the buffer will be in Comint mode with
Stefan Monnier's avatar
Stefan Monnier committed
784 785
`compilation-shell-minor-mode'.

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

789 790
Interactively, prompts for the command if `compilation-read-command' is
non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
791 792
Additionally, with universal prefix arg, compilation buffer will be in
comint mode, i.e. interactive.
793

794 795 796 797 798
To run more than one compilation at once, start one and rename
the \`*compilation*' buffer to some other name with
\\[rename-buffer].  Then start the next one.  On most systems,
termination of the main compilation process kills its
subprocesses.
Roland McGrath's avatar
Roland McGrath committed
799 800 801 802

The name used for the buffer is actually whatever is returned by
the function in `compilation-buffer-name-function', so you can set that
to a function that generates a unique name."
803
  (interactive
804
   (list
805 806 807 808 809 810 811 812
    (let ((command (eval compile-command)))
      (if (or compilation-read-command current-prefix-arg)
	  (read-from-minibuffer "Compile command: "
				command nil nil
				(if (equal (car compile-history) command)
				    '(compile-history . 1)
				  'compile-history))
	command))
813
    (consp current-prefix-arg)))
814 815
  (unless (equal command (eval compile-command))
    (setq compile-command command))
816
  (save-some-buffers (not compilation-ask-about-save) nil)
817
  (setq compilation-directory default-directory)
Stefan Monnier's avatar
Stefan Monnier committed
818
  (compilation-start command comint))
Richard M. Stallman's avatar
Richard M. Stallman committed
819

820
;; run compile with the default command line
821
(defun recompile ()
822
  "Re-compile the program including the current buffer.
Stefan Monnier's avatar
Stefan Monnier committed
823 824
If this is run in a Compilation mode buffer, re-use the arguments from the
original use.  Otherwise, recompile using `compile-command'."
825 826
  (interactive)
  (save-some-buffers (not compilation-ask-about-save) nil)
827 828 829 830
  (let ((default-directory
          (or (and (not (eq major-mode (nth 1 compilation-arguments)))
                   compilation-directory)
              default-directory)))
Stefan Monnier's avatar
Stefan Monnier committed
831 832
    (apply 'compilation-start (or compilation-arguments
				  `(,(eval compile-command))))))
833

834 835 836
(defcustom compilation-scroll-output nil
  "*Non-nil to scroll the *compilation* buffer window as output appears.

Stefan Monnier's avatar
Stefan Monnier committed
837
Setting it causes the Compilation mode commands to put point at the
838
end of their output window so that the end of the output is always
Stefan Monnier's avatar
Stefan Monnier committed
839
visible rather than the beginning."
840
  :type 'boolean
841
  :version "20.3"
842 843
  :group 'compilation)

844 845 846 847 848 849 850 851 852

(defun compilation-buffer-name (mode-name name-function)
  "Return the name of a compilation buffer to use.
If NAME-FUNCTION is non-nil, call it with one argument MODE-NAME
to determine the buffer name.
Likewise if `compilation-buffer-name-function' is non-nil.
If current buffer is in Compilation mode for the same mode name
return the name of the current buffer, so that it gets reused.
Otherwise, construct a buffer name from MODE-NAME."
853
  (cond (name-function
854
	 (funcall name-function mode-name))
855
	(compilation-buffer-name-function
856
	 (funcall compilation-buffer-name-function mode-name))
857
	((eq major-mode (nth 1 compilation-arguments))
858 859 860 861
	 (buffer-name))
	(t
	 (concat "*" (downcase mode-name) "*"))))

Stefan Monnier's avatar
Stefan Monnier committed
862 863
;; This is a rough emulation of the old hack, until the transition to new
;; compile is complete.
Richard M. Stallman's avatar
Richard M. Stallman committed
864
(defun compile-internal (command error-message
865 866 867
				 &optional name-of-mode parser
				 error-regexp-alist name-function
				 enter-regexp-alist leave-regexp-alist
868
				 file-regexp-alist nomessage-regexp-alist
869
				 no-async highlight-regexp local-map)
Stefan Monnier's avatar
Stefan Monnier committed
870 871 872 873 874 875 876 877 878 879 880
  (if parser
      (error "Compile now works very differently, see `compilation-error-regexp-alist'"))
  (let ((compilation-error-regexp-alist
	 (append file-regexp-alist (or error-regexp-alist
				       compilation-error-regexp-alist)))
	(compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?"
						     "\\1" error-message)))
    (compilation-start command nil name-function highlight-regexp)))
(make-obsolete 'compile-internal 'compilation-start)

(defun compilation-start (command &optional mode name-function highlight-regexp)
Richard M. Stallman's avatar
Richard M. Stallman committed
881
  "Run compilation command COMMAND (low level interface).
882
If COMMAND starts with a cd command, that becomes the `default-directory'.
883 884
The rest of the arguments are optional; for them, nil means use the default.

Stefan Monnier's avatar
Stefan Monnier committed
885
MODE is the major mode to set in the compilation buffer.  Mode
Stefan Monnier's avatar
Stefan Monnier committed
886
may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'.
887
NAME-FUNCTION is a function called to name the buffer.
888

889
If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
Stefan Monnier's avatar
Stefan Monnier committed
890
the matching section of the visited source line; the default is to use the
891 892
global value of `compilation-highlight-regexp'.

Roland McGrath's avatar
Roland McGrath committed
893
Returns the compilation buffer created."
Stefan Monnier's avatar
Stefan Monnier committed
894
  (or mode (setq mode 'compilation-mode))
895 896 897 898
  (let* ((name-of-mode
	  (if (eq mode t)
	      (prog1 "compilation" (require 'comint))
	    (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
899
	 (thisdir default-directory)
900
	 outwin outbuf)
901 902 903 904
    (with-current-buffer
	(setq outbuf
	      (get-buffer-create
	       (compilation-buffer-name name-of-mode name-function)))
Roland McGrath's avatar
Roland McGrath committed
905 906 907 908
      (let ((comp-proc (get-buffer-process (current-buffer))))
	(if comp-proc
	    (if (or (not (eq (process-status comp-proc) 'run))
		    (yes-or-no-p
909 910
		     (format "A %s process is running; kill it? "
			     name-of-mode)))
Roland McGrath's avatar
Roland McGrath committed
911 912 913 914 915 916 917
		(condition-case ()
		    (progn
		      (interrupt-process comp-proc)
		      (sit-for 1)
		      (delete-process comp-proc))
		  (error nil))
	      (error "Cannot have two processes in `%s' at once"
Stefan Monnier's avatar
Stefan Monnier committed
918 919
		     (buffer-name)))))
      (buffer-disable-undo (current-buffer))
920 921
      ;; first transfer directory from where M-x compile was called
      (setq default-directory thisdir)
922 923
      ;; Make compilation buffer read-only.  The filter can still write it.
      ;; Clear out the compilation buffer.
924 925 926 927 928 929
      (let ((inhibit-read-only t)
	    (default-directory thisdir))
	;; Then evaluate a cd command if any, but don't perform it yet, else start-command
	;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make"
	(cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
		(if (match-end 1)
930
		    (substitute-env-vars (match-string 1 command))
931 932
		  "~")
	      default-directory))
933 934 935 936
	(erase-buffer)
	;; output a mode setter, for saving and later reloading this buffer
	(insert "-*- mode: " name-of-mode
		"; default-directory: " (prin1-to-string default-directory)
937 938
		" -*-\n" command "\n")
	(setq thisdir default-directory))
Stefan Monnier's avatar
Stefan Monnier committed
939 940 941 942 943 944 945 946
      (set-buffer-modified-p nil))
    ;; If we're already in the compilation buffer, go to the end
    ;; of the buffer, so point will track the compilation output.
    (if (eq outbuf (current-buffer))
	(goto-char (point-max)))
    ;; Pop up the compilation buffer.
    (setq outwin (display-buffer outbuf nil t))
    (with-current-buffer outbuf
947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004
      (let ((process-environment
	     (append
	      compilation-environment
	      (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
		      system-uses-terminfo)
		  (list "TERM=dumb" "TERMCAP="
			(format "COLUMNS=%d" (window-width)))
		(list "TERM=emacs"
		      (format "TERMCAP=emacs:co#%d:tc=unknown:"
			      (window-width))))
	      ;; Set the EMACS variable, but
	      ;; don't override users' setting of $EMACS.
	      (unless (getenv "EMACS") '("EMACS=t"))
	      (copy-sequence process-environment))))
	(if (not (eq mode t))
	    (funcall mode)
	  (setq buffer-read-only nil)
	  (with-no-warnings (comint-mode))
	  (compilation-shell-minor-mode))
	(if highlight-regexp
	    (set (make-local-variable 'compilation-highlight-regexp)
		 highlight-regexp))
	(set (make-local-variable 'compilation-arguments)
	     (list command mode name-function highlight-regexp))
	(set (make-local-variable 'revert-buffer-function)
	     'compilation-revert-buffer)
	(set-window-start outwin (point-min))
	(or (eq outwin (selected-window))
	    (set-window-point outwin (if compilation-scroll-output
					 (point)
				       (point-min))))
	;; The setup function is called before compilation-set-window-height
	;; so it can set the compilation-window-height buffer locally.
	(if compilation-process-setup-function
	    (funcall compilation-process-setup-function))
	(compilation-set-window-height outwin)
	;; Start the compilation.
	(if (fboundp 'start-process)
	    (let ((proc (if (eq mode t)
			    (get-buffer-process
			     (with-no-warnings
			      (comint-exec outbuf (downcase mode-name)
					   shell-file-name nil `("-c" ,command))))
			  (start-process-shell-command (downcase mode-name)
						       outbuf command))))
	      ;; Make the buffer's mode line show process state.
	      (setq mode-line-process '(":%s"))
	      (set-process-sentinel proc 'compilation-sentinel)
	      (set-process-filter proc 'compilation-filter)
	      (set-marker (process-mark proc) (point) outbuf)
	      (setq compilation-in-progress
		    (cons proc compilation-in-progress)))
	  ;; No asynchronous processes available.
	  (message "Executing `%s'..." command)
	  ;; Fake modeline display as if `start-process' were run.
	  (setq mode-line-process ":run")
	  (force-mode-line-update)
	  (sit-for 0)			; Force redisplay
1005 1006 1007
	  (let* ((buffer-read-only nil)	; call-process needs to modify outbuf
		 (status (call-process shell-file-name nil outbuf nil "-c"
				       command)))
1008 1009 1010 1011 1012
	    (cond ((numberp status)
		   (compilation-handle-exit 'exit status
					    (if (zerop status)
						"finished\n"
					      (format "\
1013
exited abnormally with code %d\n"
1014 1015 1016 1017 1018 1019 1020 1021 1022 1023
						      status))))
		  ((stringp status)
		   (compilation-handle-exit 'signal status
					    (concat status "\n")))
		  (t
		   (compilation-handle-exit 'bizarre status status))))
	  ;; Without async subprocesses, the buffer is not yet
	  ;; fontified, so fontify it now.
	  (let ((font-lock-verbose nil)) ; shut up font-lock messages
	    (font-lock-fontify-buffer))
1024
	  (set-buffer-modified-p nil)
1025 1026 1027
	  (message "Executing `%s'...done" command)))
      ;; Now finally cd to where the shell started make/grep/...
      (setq default-directory thisdir))
Stefan Monnier's avatar
Stefan Monnier committed
1028 1029 1030
    (if (buffer-local-value 'compilation-scroll-output outbuf)
	(save-selected-window
	  (select-window outwin)
1031 1032
	  (goto-char (point-max))))
    ;; Make it so the next C-x ` will use this buffer.
1033
    (setq next-error-last-buffer outbuf)))
Richard M. Stallman's avatar
Richard M. Stallman committed
1034

1035
(defun compilation-set-window-height (window)
Dave Love's avatar
Dave Love committed
1036
  "Set the height of WINDOW according to `compilation-window-height'."
1037 1038 1039 1040 1041 1042
  (let ((height (buffer-local-value 'compilation-window-height (window-buffer window))))
    (and height
	 (= (window-width window) (frame-width (window-frame window)))
	 ;; If window is alone in its frame, aside from a minibuffer,
	 ;; don't change its height.
	 (not (eq window (frame-root-window (window-frame window))))
1043 1044
	 ;; Stef said that doing the saves in this order is safer:
	 (save-excursion
1045
	   (save-selected-window
1046 1047
	     (select-window window)
	     (enlarge-window (- height (window-height))))))))
1048

1049 1050 1051
(defvar compilation-menu-map
  (let ((map (make-sparse-keymap "Errors")))
    (define-key map [stop-subjob]
1052
      '("Stop Compilation" . kill-compilation))
1053 1054
    (define-key map [compilation-mode-separator2]
      '("----" . nil))
1055
    (define-key map [compilation-first-error]
1056
      '("First Error" . first-error))
1057
    (define-key map [compilation-previous-error]
1058
      '("Previous Error" . previous-error))
1059
    (define-key map [compilation-next-error]
1060 1061 1062
      '("Next Error" . next-error))
    map))

1063
(defvar compilation-minor-mode-map
Richard M. Stallman's avatar
Richard M. Stallman committed
1064
  (let ((map (make-sparse-keymap)))
Stefan Monnier's avatar
Stefan Monnier committed
1065
    (define-key map [mouse-2] 'compile-goto-error)
Kim F. Storm's avatar
Kim F. Storm committed
1066
    (define-key map [follow-link] 'mouse-face)
Richard M. Stallman's avatar
Richard M. Stallman committed
1067
    (define-key map "\C-c\C-c" 'compile-goto-error)
1068
    (define-key map "\C-m" 'compile-goto-error)
Roland McGrath's avatar
Roland McGrath committed
1069
    (define-key map "\C-c\C-k" 'kill-compilation)
Roland McGrath's avatar
Roland McGrath committed
1070 1071
    (define-key map "\M-n" 'compilation-next-error)
    (define-key map "\M-p" 'compilation-previous-error)
Roland McGrath's avatar
Roland McGrath committed
1072 1073
    (define-key map "\M-{" 'compilation-previous-file)
    (define-key map "\M-}" 'compilation-next-file)
1074 1075 1076
    ;; Set up the menu-bar
    (define-key map [menu-bar compilation]
      (cons "Errors" compilation-menu-map))