/lisp/progmodes/compile.el
Emacs Lisp | 1631 lines | 1189 code | 189 blank | 253 comment | 49 complexity | 9f8286d71ab4b0b6e6e9819a40d98c39 MD5 | raw file
Possible License(s): GPL-3.0, LGPL-2.0, AGPL-3.0
Large files files are truncated, but you can click here to view the full file
- ;;; compile.el --- run compiler as inferior of Emacs, parse error messages
- ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
- ;; Free Software Foundation, Inc.
- ;; Authors: Roland McGrath <roland@gnu.org>,
- ;; Daniel Pfeiffer <occitan@esperanto.org>
- ;; Maintainer: FSF
- ;; Keywords: tools, processes
- ;; This file is part of GNU Emacs.
- ;; 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 3 of the License, or
- ;; (at your option) any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; 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
- ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
- ;;; Commentary:
- ;; This package provides the compile facilities documented in the Emacs user's
- ;; manual.
- ;; This mode uses some complex data-structures:
- ;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE)
- ;; 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 TIMESTAMP . 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.
- ;; TIMESTAMP is necessary because of "incremental compilation": `omake -P'
- ;; polls filesystem for changes and recompiles when a file is modified
- ;; using the same *compilation* buffer. this necessitates re-parsing markers.
- ;; FILE-STRUCTURE is a list of
- ;; ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...) ...)
- ;; 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.
- ;; MESSAGE is a list of (LOC TYPE END-LOC)
- ;; 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.
- ;;; Code:
- (eval-when-compile (require 'cl))
- (require 'tool-bar)
- (require 'comint)
- (defvar font-lock-extra-managed-props)
- (defvar font-lock-keywords)
- (defvar font-lock-maximum-size)
- (defvar font-lock-support-mode)
- (defgroup compilation nil
- "Run compiler as inferior of Emacs, parse error messages."
- :group 'tools
- :group 'processes)
- ;;;###autoload
- (defcustom compilation-mode-hook nil
- "List of hook functions run by `compilation-mode' (see `run-mode-hooks')."
- :type 'hook
- :group 'compilation)
- ;;;###autoload
- (defcustom compilation-start-hook nil
- "List of hook functions run by `compilation-start' on the compilation process.
- \(See `run-hook-with-args').
- If you use \"omake -P\" and do not want \\[save-buffers-kill-terminal] to ask whether you want
- the compilation to be killed, you can use this hook:
- (add-hook 'compilation-start-hook
- (lambda (process) (set-process-query-on-exit-flag process nil)) nil t)"
- :type 'hook
- :group 'compilation)
- ;;;###autoload
- (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)
- (defvar compilation-first-column 1
- "*This is how compilers number the first column, usually 1 or 0.")
- (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.")
- ;;;###autoload
- (defvar compilation-process-setup-function nil
- "*Function to call to customize the compilation process.
- This function is called immediately before the compilation process is
- started. It can be used to set any variables or functions that are used
- while processing the output of the compilation process. The function
- is called with variables `compilation-buffer' and `compilation-window'
- bound to the compilation buffer and window, respectively.")
- ;;;###autoload
- (defvar compilation-buffer-name-function nil
- "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.
- If nil, compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.")
- ;;;###autoload
- (defvar compilation-finish-function nil
- "Function to call when a compilation process finishes.
- It is called with two arguments: the compilation buffer, and a string
- describing how the process finished.")
- (make-obsolete-variable 'compilation-finish-function
- "use `compilation-finish-functions', but it works a little differently."
- "22.1")
- ;;;###autoload
- (defvar compilation-finish-functions nil
- "Functions to call when a compilation process finishes.
- Each function is called with two arguments: the compilation buffer,
- and a string describing how the process finished.")
- (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)))
- (defvar compilation-error "error"
- "Stem of message to print when no matches are found.")
- (defvar compilation-arguments nil
- "Arguments that were given to `compilation-start'.")
- (defvar compilation-num-errors-found)
- (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))
- (ada
- "\\(warning: .*\\)? at \\([^ \n]+\\):\\([0-9]+\\)$" 2 3 nil (1))
- (aix
- " in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
- (ant
- "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):[0-9]+:[0-9]+:\\)?\
- \\( warning\\)?" 1 2 3 (4))
- (bash
- "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
- (borland
- "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\
- \\([a-zA-Z]?:?[^:( \t\n]+\\)\
- \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
- (caml
- "^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
- \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)"
- 2 (3 . 4) (5 . 6) (7))
- (comma
- "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
- \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
- (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)
- (epc
- "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
- (ftnchek
- "\\(^Warning .*\\)? line[ \n]\\([0-9]+\\)[ \n]\\(?:col \\([0-9]+\\)[ \n]\\)?file \\([^ :;\n]+\\)"
- 4 2 3 (1))
- (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))
- ;; fixme: should be `mips'
- (irix
- "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\
- \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
- (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))))
- (gnu
- ;; The first line matches the program name for
- ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
- ;; format, which is used for non-interactive programs other than
- ;; compilers (e.g. the "jade:" entry in compilation.txt).
- ;; This first line makes things ambiguous with output such as
- ;; "foo:344:50:blabla" since the "foo" part can match this first
- ;; line (in which case the file name as "344"). To avoid this,
- ;; the second line disallows filenames exclusively composed of
- ;; digits.
- ;; Similarly, we get lots of false positives with messages including
- ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
- ;; the last line tries to rule out message where the info after the
- ;; line number starts with "SS". --Stef
- ;; The core of the regexp is the one with *?. It says that a file name
- ;; can be composed of any non-newline char, but it also rules out some
- ;; valid but unlikely cases, such as a trailing space or a space
- ;; followed by a -.
- "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
- \\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\
- \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
- \\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\
- \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
- *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\|[Nn]ote\\)\\|\
- \[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
- 1 (2 . 5) (4 . 6) (7 . 8))
- ;; The `gnu' style above can incorrectly match gcc's "In file
- ;; included from" message, so we process that first. -- cyd
- (gcc-include
- "^\\(?:In file included\\| \\) from \
- \\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
- (lcc
- "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
- 2 3 4 (1))
- (makepp
- "^makepp\\(?:\\(?:: warning\\(:\\).*?\\|\\(: Scanning\\|: [LR]e?l?oading makefile\\|: Imported\\|log:.*?\\) \\|: .*?\\)\
- `\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)"
- 4 5 nil (1 . 2) 3
- ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]" nil nil
- (2 compilation-info-face)
- (3 compilation-line-face nil t)
- (1 (compilation-error-properties 2 3 nil nil nil 0 nil)
- append)))
- ;; This regexp is pathologically slow on long lines (Bug#3441).
- ;; (maven
- ;; ;; Maven is a popular build tool for Java. Maven is Free Software.
- ;; "\\(.*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\]" 1 2 3)
- ;; Should be lint-1, lint-2 (SysV lint)
- (mips-1
- " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
- (mips-2
- " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
- (msft
- ;; AFAWK, The message may be a "warning", "error", or "fatal error".
- "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
- : \\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:" 2 3 nil (4))
- (omake
- ;; "omake -P" reports "file foo changed"
- ;; (useful if you do "cvs up" and want to see what has changed)
- "omake: file \\(.*\\) changed" 1)
- (oracle
- "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
- \\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\
- \\(?:,\\| in\\| of\\)? file \\(.*?\\):?$"
- 3 1 2)
- ;; "during global destruction": This comes out under "use
- ;; warnings" in recent perl when breaking circular references
- ;; during program or thread exit.
- (perl
- " at \\([^ \n]+\\) line \\([0-9]+\\)\\(?:[,.]\\|$\\| \
- during global destruction\\.$\\)" 1 2)
- (php
- "\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)"
- 2 3 nil nil)
- (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
- ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\
- 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)
- (watcom
- "\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)): ?\
- \\(?:\\(Error! E[0-9]+\\)\\|\\(Warning! W[0-9]+\\)\\):"
- 1 2 nil (4))
- (4bsd
- "\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
- \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))
- (gcov-file
- "^ *-: *\\(0\\):Source:\\(.+\\)$"
- 2 1 nil 0 nil
- (1 compilation-line-face prepend) (2 compilation-info-face prepend))
- (gcov-header
- "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$"
- nil 1 nil 0 nil
- (1 compilation-line-face prepend))
- ;; Underlines over all lines of gcov output are too uncomfortable to read.
- ;; However, hyperlinks embedded in the lines are useful.
- ;; So I put default face on the lines; and then put
- ;; compilation-*-face by manually to eliminate the underlines.
- ;; The hyperlinks are still effective.
- (gcov-nomark
- "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$"
- nil 1 nil 0 nil
- (0 'default t)
- (1 compilation-line-face prepend))
- (gcov-called-line
- "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$"
- nil 2 nil 0 nil
- (0 'default t)
- (1 compilation-info-face prepend) (2 compilation-line-face prepend))
- (gcov-never-called
- "^ *\\(#####\\): *\\([0-9]+\\):.*$"
- nil 2 nil 2 nil
- (0 'default t)
- (1 compilation-error-face prepend) (2 compilation-line-face prepend))
- (perl--Pod::Checker
- ;; podchecker error messages, per Pod::Checker.
- ;; The style is from the Pod::Checker::poderror() function, eg.
- ;; *** ERROR: Spurious text after =cut at line 193 in file foo.pm
- ;;
- ;; Plus end_pod() can give "at line EOF" instead of a
- ;; number, so for that match "on line N" which is the
- ;; originating spot, eg.
- ;; *** ERROR: =over on line 37 without closing =back at line EOF in file bar.pm
- ;;
- ;; Plus command() can give both "on line N" and "at line N";
- ;; the latter is desired and is matched because the .* is
- ;; greedy.
- ;; *** ERROR: =over on line 1 without closing =back (at head1) at line 3 in file x.pod
- ;;
- "^\\*\\*\\* \\(?:ERROR\\|\\(WARNING\\)\\).* \\(?:at\\|on\\) line \
- \\([0-9]+\\) \\(?:.* \\)?in file \\([^ \t\n]+\\)"
- 3 2 nil (1))
- (perl--Test
- ;; perl Test module error messages.
- ;; Style per the ok() function "$context", eg.
- ;; # Failed test 1 in foo.t at line 6
- ;;
- "^# Failed test [0-9]+ in \\([^ \t\r\n]+\\) at line \\([0-9]+\\)"
- 1 2)
- (perl--Test2
- ;; Or when comparing got/want values,
- ;; # Test 2 got: "xx" (t-compilation-perl-2.t at line 10)
- ;;
- ;; And under Test::Harness they're preceded by progress stuff with
- ;; \r and "NOK",
- ;; ... NOK 1# Test 1 got: "1234" (t/foo.t at line 46)
- ;;
- "^\\(.*NOK.*\\)?# Test [0-9]+ got:.* (\\([^ \t\r\n]+\\) at line \
- \\([0-9]+\\))"
- 2 3)
- (perl--Test::Harness
- ;; perl Test::Harness output, eg.
- ;; NOK 1# Test 1 got: "1234" (t/foo.t at line 46)
- ;;
- ;; Test::Harness is slightly designed for tty output, since
- ;; it prints CRs to overwrite progress messages, but if you
- ;; run it in with M-x compile this pattern can at least step
- ;; through the failures.
- ;;
- "^.*NOK.* \\([^ \t\r\n]+\\) at line \\([0-9]+\\)"
- 1 2)
- (weblint
- ;; The style comes from HTML::Lint::Error::as_string(), eg.
- ;; index.html (13:1) Unknown element <fdjsk>
- ;;
- ;; The pattern only matches filenames without spaces, since that
- ;; should be usual and should help reduce the chance of a false
- ;; match of a message from some unrelated program.
- ;;
- ;; This message style is quite close to the "ibm" entry which is
- ;; for IBM C, though that ibm bit doesn't put a space after the
- ;; filename.
- ;;
- "^\\([^ \t\r\n(]+\\) (\\([0-9]+\\):\\([0-9]+\\)) "
- 1 2 3)
- )
- "Alist of values for `compilation-error-regexp-alist'.")
- (defcustom compilation-error-regexp-alist
- (mapcar 'car compilation-error-regexp-alist-alist)
- "Alist that specifies how to match errors in compiler output.
- On GNU and Unix, any string is a valid filename, so these
- 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
- `etc/compilation.txt' (linked below if you are customizing this).
- 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 that returns (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
- In the former case, FILENAME may be relative or absolute.
- 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"
- ,(expand-file-name "compilation.txt" data-directory))
- :group 'compilation)
- ;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp)
- (defvar compilation-directory nil
- "Directory to restore to when doing `recompile'.")
- (defvar compilation-directory-matcher
- '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1))
- "A list for tracking when directories are entered or left.
- If nil, do not 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.
- ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
- (1 font-lock-function-name-face) (3 compilation-line-face nil t))
- (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1)
- ("^Compilation \\(finished\\).*"
- (0 '(face nil message nil help-echo nil mouse-face nil) t)
- (1 compilation-info-face))
- ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
- (0 '(face nil message nil help-echo nil mouse-face nil) t)
- (1 compilation-error-face)
- (2 compilation-error-face nil t)))
- "Additional things to highlight in Compilation mode.
- This gets tacked on the end of the generated expressions.")
- (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.")
- (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")
- (defcustom compilation-read-command t
- "Non-nil means \\[compile] reads the compilation command to use.
- Otherwise, \\[compile] just uses the value of `compile-command'."
- :type 'boolean
- :group 'compilation)
- ;;;###autoload
- (defcustom compilation-ask-about-save t
- "Non-nil means \\[compile] asks which buffers to save before compiling.
- Otherwise, it saves all modified buffers without asking."
- :type 'boolean
- :group 'compilation)
- ;;;###autoload
- (defcustom compilation-search-path '(nil)
- "List of directories to search for source files named in error messages.
- Elements should be directory names, not file names of directories.
- The value nil as an element means to try the default directory."
- :type '(repeat (choice (const :tag "Default" nil)
- (string :tag "Directory")))
- :group 'compilation)
- ;;;###autoload
- (defcustom compile-command "make -k "
- "Last shell command used to do a compilation; default for next compilation.
- 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:
- (add-hook 'c-mode-hook
- (lambda ()
- (unless (or (file-exists-p \"makefile\")
- (file-exists-p \"Makefile\"))
- (set (make-local-variable 'compile-command)
- (concat \"make -k \"
- (file-name-sans-extension buffer-file-name))))))"
- :type 'string
- :group 'compilation)
- ;;;###autoload(put 'compile-command 'safe-local-variable 'stringp)
- ;;;###autoload
- (defcustom compilation-disable-input nil
- "If non-nil, send end-of-file as compilation process input.
- This only affects platforms that support asynchronous processes (see
- `start-process'); synchronous compilation processes never accept input."
- :type 'boolean
- :group 'compilation
- :version "22.1")
- ;; 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
- "*Set this to t before creating a *compilation* buffer.
- 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'.")
- (defvar compilation-exit-message-function nil "\
- If non-nil, called when a compilation process dies to return a status message.
- 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.")
- (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.")
- ;; History of compile commands.
- (defvar compile-history nil)
- (defface compilation-error
- '((t :inherit font-lock-warning-face))
- "Face used to highlight compiler errors."
- :group 'compilation
- :version "22.1")
- (defface compilation-warning
- '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold))
- (((class color)) (:foreground "cyan" :weight bold))
- (t (:weight bold)))
- "Face used to highlight compiler warnings."
- :group 'compilation
- :version "22.1")
- (defface compilation-info
- '((((class color) (min-colors 16) (background light))
- (:foreground "Green3" :weight bold))
- (((class color) (min-colors 88) (background dark))
- (:foreground "Green1" :weight bold))
- (((class color) (min-colors 16) (background dark))
- (:foreground "Green" :weight bold))
- (((class color)) (:foreground "green" :weight bold))
- (t (:weight bold)))
- "Face used to highlight compiler information."
- :group 'compilation
- :version "22.1")
- (defface compilation-line-number
- '((t :inherit font-lock-variable-name-face))
- "Face for displaying line numbers in compiler messages."
- :group 'compilation
- :version "22.1")
- (defface compilation-column-number
- '((t :inherit font-lock-type-face))
- "Face for displaying column numbers in compiler messages."
- :group 'compilation
- :version "22.1")
- (defcustom compilation-message-face 'underline
- "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."
- :type 'face
- :group 'compilation
- :version "22.1")
- (defvar compilation-error-face 'compilation-error
- "Face name to use for file name in error messages.")
- (defvar compilation-warning-face 'compilation-warning
- "Face name to use for file name in warning messages.")
- (defvar compilation-info-face 'compilation-info
- "Face name to use for file name in informational messages.")
- (defvar compilation-line-face 'compilation-line-number
- "Face name to use for line numbers in compiler messages.")
- (defvar compilation-column-face 'compilation-column-number
- "Face name to use for column numbers in compiler messages.")
- ;; same faces as dired uses
- (defvar compilation-enter-directory-face 'font-lock-function-name-face
- "Face name to use for entering directory messages.")
- (defvar compilation-leave-directory-face 'font-lock-type-face
- "Face name to use for leaving directory messages.")
- ;; Used for compatibility with the old compile.el.
- (defvaralias 'compilation-last-buffer 'next-error-last-buffer)
- (defvar compilation-parsing-end (make-marker))
- (defvar compilation-parse-errors-function nil)
- (defvar compilation-error-list nil)
- (defvar compilation-old-error-list nil)
- (defcustom compilation-auto-jump-to-first-error nil
- "If non-nil, automatically jump to the first error during compilation."
- :type 'boolean
- :group 'compilation
- :version "23.1")
- (defvar compilation-auto-jump-to-next nil
- "If non-nil, automatically jump to the next error encountered.")
- (make-variable-buffer-local 'compilation-auto-jump-to-next)
- (defvar compilation-skip-to-next-location t
- "*If non-nil, skip multiple error messages for the same source location.")
- (defcustom compilation-skip-threshold 1
- "Compilation motion commands skip less important messages.
- The value can be either 2 -- skip anything less than error, 1 --
- skip anything less than warning or 0 -- don't skip any messages.
- Note that all messages not positively identified as warning or
- info, are considered errors."
- :type '(choice (const :tag "Warnings and info" 2)
- (const :tag "Info" 1)
- (const :tag "None" 0))
- :group 'compilation
- :version "22.1")
- (defcustom compilation-skip-visited nil
- "Compilation motion commands skip visited messages if this is t.
- Visited messages are ones for which the file, line and column have been jumped
- to from the current content in the current compilation buffer, even if it was
- from a different message."
- :type 'boolean
- :group 'compilation
- :version "22.1")
- (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))
- ;; 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.
- (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
- keymap compilation-button-map
- help-echo "mouse-2: visit destination 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.
- (eval-when-compile ;Don't keep it at runtime if not needed.
- (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
- (setcdr l1 (cons (list ,key) l2)))))))
- (defun compilation-auto-jump (buffer pos)
- (with-current-buffer buffer
- (goto-char pos)
- (let ((win (get-buffer-window buffer 0)))
- (if win (set-window-point win pos)))
- (if compilation-auto-jump-to-first-error
- (compile-goto-error))))
- ;; 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)))))
- (setq file (cons file (car dir)))))
- ;; This message didn't mention one, get it from previous
- (let ((prev-pos
- ;; Find the previous message.
- (previous-single-property-change (point) 'message)))
- (if prev-pos
- ;; Get the file structure that belongs to it.
- (let* ((prev
- (or (get-text-property (1- prev-pos) 'message)
- (get-text-property prev-pos 'message)))
- (prev-struct
- (car (nth 2 (car prev)))))
- ;; Construct FILE . DIR from that.
- (if prev-struct
- (setq file (cons (car prev-struct)
- (cadr prev-struct))))))
- (unless file
- (setq file '("*unknown*")))))
- ;; 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)))
- (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))))
- (if (consp type) ; not a static type, check what it is.
- (setq type (or (and (car type) (match-end (car type)) 1)
- (and (cdr type) (match-end (cdr type)) 0)
- 2)))
- (when (and compilation-auto-jump-to-next
- (>= type compilation-skip-threshold))
- (kill-local-variable 'compilation-auto-jump-to-next)
- (run-with-timer 0 nil 'compilation-auto-jump
- (current-buffer) (match-beginning 0)))
- (compilation-internal-error-properties file line end-line col end-col type fmt)))
- (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 (max col 0))
- (goto-char (min (+ (line-beginning-position) col) (line-end-position)))))
- (defun compilation-internal-error-properties (file line end-line col end-col type fmts)
- "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, meaning error, warning, or just info.
- FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil.
- FMTS is a list of format specs for transforming the file name.
- (See `compilation-error-regexp-alist'.)"
- (unless file (setq file '("*unknown*")))
- (let* ((file-struct (compilation-get-file-structure file fmts))
- ;; Get first already existing marker (if any has one, all have one).
- ;; Do this first, as the compilation-assq`s may create new nodes.
- (marker-line (car (cddr file-struct))) ; 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 nil) ; no valid marker for this file
- (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-struct)) ; loop over remaining lines
- (if (> (car x) loc) ; still bigger
- (setq marker-line x)
- (if (> (- (or (car marker-line) 1) loc)
- (- loc (car x))) ; current line is nearer
- (setq marker-line x))
- (throw 'marker t))))
- (setq marker (nth 3 (cadr marker-line))
- marker-line (or (car marker-line) 1))
- (with-current-buffer (marker-buffer marker)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (marker-position marker))
- (when (or end-col end-line)
- (beginning-of-line (- (or end-line line) marker-line -1))
- (if (or (null end-col) (< end-col 0))
- (end-of-line)
- (compilation-move-to-column
- end-col compilation-error-screen-columns))
- (setq end-marker (list (point-marker))))
- (beginning-of-line (if end-line
- (- line end-line -1)
- (- loc marker-line -1)))
- (if col
- (compilation-move-to-column
- col compilation-error-screen-columns)
- (forward-to-indentation 0))
- (setq marker (list (point-marker)))))))
- (setq loc (compilation-assq line (cdr file-struct)))
- (if end-line
- (setq end-loc (compilation-assq end-line (cdr file-struct))
- 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-struct ,@marker)))
- (if end-loc
- (or (cdr end-loc)
- (setcdr end-loc `(,(or end-line line) ,file-struct ,@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)))
- (defun compilation-mode-font-lock-keywords ()
- "Return expressions to highlight in Compilation mode."
- (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 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))
- (pat (car item))
- end-line end-col fmt)
- ;; omake reports some error indented, so skip the indentation.
- ;; another solution is to modify (some?) regexps in
- ;; `compilation-error-regexp-alist'.
- ;; note that omake usage is not limited to ocaml and C (for stubs).
- (unless (string-match (concat "^" (regexp-quote "^ *")) pat)
- (setq pat (concat "^ *"
- (if (= ?^ (aref pat 0))
- (substring pat 1)
- pat))))
- (if (consp file) (setq fmt (cdr file) file (car file)))
- (if (consp line) (setq end-line (cdr line) line (car line)))
- (if (consp col) (setq end-col (cdr col) col (car col)))
- (if (functionp line)
- ;; 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.
- `(,pat
- (0 (save-match-data
- (compilation-compat-error-properties
- (funcall ',line (cons (match-string ,file)
- (cons default-directory
- ',(nthcdr 4 item)))
- ,(if col `(match-string ,col))))))
- (,file compilation-error-face t))
- (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
- (error "HYPERLINK should be an integer: %s" (nth 5 item)))
- `(,pat
- ,@(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)))
- ,@(when (integerp col)
- `((,col compilation-column-face nil t)))
- ,@(when (integerp end-col)
- `((,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)))
- (defun compilation-read-command (command)
- (read-shell-command "Compile command: " command
- (if (equal (car compile-history) command)
- '(compile-history . 1)
- 'compile-history)))
- ;;;###autoload
- (defun compile (command &optional comint)
- "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*'.
- You can then use the command \\[next-error] to find the next error message
- and move to the source code that caused it.
- If optional second arg COMINT is t the buffer will be in Comint mode with
- `compilation-shell-minor-mode'.
- Interactively, prompts for the command if `compilation-read-command' is
- non-nil; otherwise uses `compile-command'. With prefix arg, always prompts.
- Additionally, with universal prefix arg, compilation buffer will be in
- comint mode, i.e. interactive.
- To run more than one compilation at once, start one then rename
- the \`*compilation*' buffer to some other name with
- \\[rename-buffer]. Then _switch buffers_ and start the new compilation.
- It will create a new \`*compilation*' buffer.
- On most systems, termination of the main compilation process
- kills its subprocesses.
- 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."
- (interactive
- (list
- (let ((command (eval compile-command)))
- (if (or compilation-read-command current-prefix-arg)
- (compilation-read-command command)
- command))
- (consp current-prefix-arg)))
- (unless (equal command (eval compile-command))
- (setq compile-command command))
- (save-some-buffers (not compilation-ask-about-save) nil)
- (setq-default compilation-directory default-directory)
- (compilation-start command comint))
- ;; run compile with the default command line
- (defun recompile (&optional edit-command)
- "Re-compile the program including the current buffer.
- If this is run in a Compilation mode buffer, re-use the arguments from the
- original use. Otherwise, recompile using `compile-command'.
- If the optional argument `edit-command' is non-nil, the command can be edited."
- (interactive "P")
- (save-some-buffers (not compilation-ask-about-save) nil)
- (let ((default-directory (or compilation-directory default-directory)))
- (when edit-command
- (setcar compilation-arguments
- (compilation-read-command (car compilation-arguments))))
- (apply 'compilation-start (or compilation-arguments
- `(,(eval compile-command))))))
- (defcustom compilation-scroll-output nil
- "Non-nil to scroll the *compilation* buffer window as output appears.
- Setting it causes the Compilation mode commands to put point at the
- end of their output window so that the end of the output is always
- visible rather than the beginning.
- The value `first-error' stops scrolling at the first error, and leaves
- point on its location in the *compilation* buffer."
- :type '(choice (const :tag "No scrolling" nil)
- (const :tag "Scroll compilation output" t)
- (const :tag "Stop scrolling at the first error" first-error))
- :version "20.3"
- :group 'compilation)
- (defun compilation-buffer-name (mode-name mode-command 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 has the major mode MODE-COMMAND,
- return the name of the current buffer, so that it gets reused.
- Otherwise, construct a buffer name from MODE-NAME."
- (cond (name-function
- (funcall name-function mode-name))
- (compilation-buffer-name-function
- (funcall compilation-buffer-name-function mode-name))
- ((eq mode-command major-mode)
- (buffer-name))
- (t
- (concat "*" (downcase mode-name) "*"))))
- ;; This is a rough emulation of the old hack, until the transition to new
- ;; compile is complete.
- (defun compile-internal (command error-message
- &optional name-of-mode parser
- error-regexp-alist name-function
- enter-regexp-alist leave-regexp-alist
- file-regexp-alist nomessage-regexp-alist
- no-async highlight-regexp local-map)
- (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 "22.1")
- ;;;###autoload
- (defun compilation-start (command &optional mode name-function highlight-regexp)
- "Run compilation command COMMAND (low level interface).
- If COMMAND starts with a cd command, that becomes the `default-directory'.
- The rest of the arguments are optional; for them, nil means use the default.
- MODE is the major mode to set in the compilation buffer. Mode
- may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'.
- If NAME-FUNCTION is non-nil, call it with one argument (the mode name)
- to determine the buffer name. Otherwise, the default is to
- reuses the current buffer if it has the proper major mode,
- else use or create a buffer with name based on the major mode.
- If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
- the matching section of the visited source line; the default is to use the
- global value of `compilation-highlight-regexp'.
- Returns the compilation buffer created."
- (or mode (setq mode 'compilation-mode))
- (let* ((name-of-mode
- (if (eq mode t)
- "compilation"
- (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
- (thisdir default-directory)
- outwin outbuf)
- (with-current-buffer
- (setq outbuf
- (get-buffer-create
- (compilation-buffer-name name-of-mode mode name-function)))
- (let ((comp-proc (get-buffer-process (current-buffer))))
- (if comp-proc
- (if (or (not (eq (process-status comp-proc) 'run))
- (yes-or-no-p
- (format "A %s process is running; kill it? "
- name-of-mode)))
- (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"
- (buffer-name)))))
- ;; first transfer directory from where M-x compile was called
- (setq default-directory thisdir)
- ;; Make compilation buffer read-only. The filter can still write it.
- ;; Clear out the compilation buffer.
- (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)
- (substitute-env-vars (match-string 1 command))
- "~")
- default-directory))
- (erase-buffer)
- ;; Select the desired mode.
- (if (not (eq mode t))
- (progn
- (buffer-disable-undo)
- (funcall mode))
- (setq buffer-read-only nil)
- (with-no-warnings (comint-mode))
- (compilation-shell-minor-mode))
- ;; Remember the original dir, so we can use it when we recompile.
- ;; default-directory' can't be used reliably for that because it may be
- ;; affected by the special handling of "cd ...;".
- ;; NB: must be fone after (funcall mode) as that resets local variables
- (set (make-local-variable 'compilation-directory) thisdir)
- (if highlight-regexp
- (set (make-local-variable 'compilation-highlight-regexp)
- highlight-regexp))
- (if (or compilation-auto-jump-to-first-error
- (eq compilation-scroll-output 'first-error))
- (set (make-local-variable 'compilation-auto-jump-to-next) t))
- ;; Output a mode setter, for saving and later reloading this buffer.
- (insert "-*- mode: " name-of-mode
- "; default-directory: " (prin1-to-string default-directory)
- " -*-\n"
- (format "%s started at %s\n\n"
- mode-name
- (substring (current-time-string) 0 19))
- command "\n")
- (setq thisdir default-directory))
- (set-buffer-modified-p nil))
- ;; Pop up the compilation buffer.
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html
- (setq outwin (display-buffer outbuf))
- (with-current-buffer outb…
Large files files are truncated, but you can click here to view the full file