/lisp/progmodes/compile.el
Emacs Lisp | 1562 lines | 1106 code | 198 blank | 258 comment | 46 complexity | 117582c06079ed1cc7c82c55fd6acf57 MD5 | raw file
✨ Summary
Large 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-1987, 1993-1999, 2001-2012
- ;; 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.
- ;;; Code:
- (eval-when-compile (require 'cl-lib))
- (require 'tool-bar)
- (require 'comint)
- (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-filter-hook nil
- "Hook run after `compilation-filter' has inserted a string into the buffer.
- It is called with the variable `compilation-filter-start' bound
- to the position of the start of the inserted text, and point at
- its end.
- If Emacs lacks asynchronous process support, this hook is run
- after `call-process' inserts the grep output into the buffer.")
- (defvar compilation-filter-start nil
- "Position of the start of the text inserted by `compilation-filter'.
- This is bound before running `compilation-filter-hook'.")
- (defvar compilation-first-column 1
- "This is how compilers number the first column, usually 1 or 0.
- If this is buffer-local in the destination buffer, Emacs obeys
- that value, otherwise it uses the value in the *compilation*
- buffer. This enables a major-mode to specify its own value.")
- (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.")
- ;;;###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)
- ;; If you make any changes to `compilation-error-regexp-alist-alist',
- ;; be sure to run the ERT test in test/automated/compile-tests.el.
- (defvar 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 . 4) (3 . 5) (6))
- (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))
- (python-tracebacks-and-caml
- "^[ \t]*File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
- \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning\\(?: [0-9]+\\)?:\\)?\\)"
- 2 (3 . 4) (5 . 6) (7))
- (comma
- "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
- \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
- (cucumber
- "\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\
- \\(?: \\)\\([^\(].*\\):\\([1-9][0-9]*\\)" 1 2)
- (msft
- ;; Must be before edg-1, so that MSVC's longer messages are
- ;; considered before EDG.
- ;; The message may be a "warning", "error", or "fatal error" with
- ;; an error code, or "see declaration of" without an error code.
- "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) ?\
- : \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
- 2 3 nil (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)
- ;; This used to be pathologically slow on long lines (Bug#3441),
- ;; due to matching filenames via \\(.*?\\). This might be faster.
- (maven
- ;; Maven is a popular free software build tool for Java.
- "\\([^ \n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 1 2 3)
- (jikes-line
- "^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
- nil 1 nil 2 0
- (2 (compilation-face '(3))))
- (gcc-include
- "^\\(?:In file included \\| \\|\t\\)from \
- \\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\
- \\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?"
- 1 2 3 (4 . 5))
- (ruby-Test::Unit
- "^[\t ]*\\[\\([^\(].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2)
- (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 -, or a colon followed by a space.
- ;; The "in \\|from " exception was added to handle messages from Ruby.
- "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\
- \\([0-9]*[^0-9\n]\\(?:[^\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\\)\\|\
- *[Ee]rror\\|\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
- 1 (2 . 4) (3 . 5) (6 . 7))
- (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
- (0 (progn (save-match-data
- (compilation-parse-errors
- (match-end 0) (line-end-position)
- `("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]"
- 2 3 nil
- ,(cond ((match-end 1) 1) ((match-end 2) 0) (t 2))
- 1)))
- (end-of-line)
- nil)))
- ;; 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
- ;; The message may be a "warning", "error", or "fatal error" with
- ;; an error code, or "see declaration of" without an error code.
- "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
- : \\(?:see declaration\\|\\(?: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 nil nil nil nil
- ;; FIXME-omake: This tries to prevent reusing pre-existing markers
- ;; for subsequent messages, since those messages's line numbers
- ;; are about another version of the file.
- (0 (progn (compilation--flush-file-structure (match-string 1))
- nil)))
- (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
- "^[ \t]*\\(\\(?:[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)
- (gcov-header
- "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$"
- nil 1 nil 0 nil)
- ;; 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)
- (1 compilation-line-face))
- (gcov-called-line
- "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$"
- nil 2 nil 0 nil
- (0 'default)
- (1 compilation-info-face) (2 compilation-line-face))
- (gcov-never-called
- "^ *\\(#####\\): *\\([0-9]+\\):.*$"
- nil 2 nil 2 nil
- (0 'default)
- (1 compilation-error-face) (2 compilation-line-face))
- (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, with a "fail #n" if repeated
- ;; # Test 2 got: "xx" (t-compilation-perl-2.t at line 10)
- ;; # Test 3 got: "xx" (t-compilation-perl-2.t at line 10 fail #2)
- ;;
- ;; 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]+\\)\\( fail #[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 take the shape (SUBMATCH FACE), where
- SUBMATCH is the number of a submatch and FACE is an expression
- which evaluates to a face name (a symbol or string).
- Alternatively, FACE can evaluate to a property list of the
- form (face FACE PROP1 VAL1 PROP2 VAL2 ...), in which case all the
- listed text properties PROP# are given values VAL# as well."
- :type '(repeat (choice (symbol :tag "Predefined symbol")
- (sexp :tag "Error specification")))
- :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 compilation-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 compilation-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.
- If this is buffer-local in the destination buffer, Emacs obeys
- that value, otherwise it uses the value in the *compilation*
- buffer. This enables a major-mode to specify its own value."
- :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'.
- Note that changing this to nil may be a security risk, because a
- file might define a malicious `compile-command' as a file local
- variable, and you might not notice. Therefore, `compile-command'
- is considered unsafe if this variable is nil."
- :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)
- (defcustom compilation-save-buffers-predicate nil
- "The second argument (PRED) passed to `save-some-buffers' before compiling.
- E.g., one can set this to
- (lambda ()
- (string-prefix-p my-compilation-root (file-truename (buffer-file-name))))
- to limit saving to files located under `my-compilation-root'.
- Note, that, in general, `compilation-directory' cannot be used instead
- of `my-compilation-root' here."
- :type '(choice
- (const :tag "Default (save all file-visiting buffers)" nil)
- (const :tag "Save all buffers" t)
- function)
- :group 'compilation
- :version "24.1")
- ;;;###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 (purecopy "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 (lambda (a) (and (stringp a) (or (not (boundp 'compilation-read-command)) compilation-read-command))))
- ;;;###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.")
- (defcustom 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."
- :type '(repeat (string :tag "ENVVARNAME=VALUE"))
- :options '(("LANG=C"))
- :group 'compilation
- :version "24.1")
- ;; History of compile commands.
- (defvar compile-history nil)
- (defface compilation-error
- '((t :inherit error))
- "Face used to highlight compiler errors."
- :group 'compilation
- :version "22.1")
- (defface compilation-warning
- '((t :inherit warning))
- "Face used to highlight compiler warnings."
- :group 'compilation
- :version "22.1")
- (defface compilation-info
- '((t :inherit success))
- "Face used to highlight compiler information."
- :group 'compilation
- :version "22.1")
- ;; The next three faces must be able to stand out against the
- ;; `mode-line' and `mode-line-inactive' faces.
- (defface compilation-mode-line-fail
- '((default :inherit compilation-error)
- (((class color) (min-colors 16)) (:foreground "Red1" :weight bold))
- (((class color) (min-colors 8)) (:foreground "red"))
- (t (:inverse-video t :weight bold)))
- "Face for Compilation mode's \"error\" mode line indicator."
- :group 'compilation
- :version "24.3")
- (defface compilation-mode-line-run
- '((t :inherit compilation-warning))
- "Face for Compilation mode's \"running\" mode line indicator."
- :group 'compilation
- :version "24.3")
- (defface compilation-mode-line-exit
- '((default :inherit compilation-info)
- (((class color) (min-colors 16))
- (:foreground "ForestGreen" :weight bold))
- (((class color)) (:foreground "green" :weight bold))
- (t (:weight bold)))
- "Face for Compilation mode's \"exit\" mode line indicator."
- :group 'compilation
- :version "24.3")
- (defface compilation-line-number
- '((t :inherit font-lock-keyword-face))
- "Face for displaying line numbers in compiler messages."
- :group 'compilation
- :version "22.1")
- (defface compilation-column-number
- '((t :inherit font-lock-doc-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-builtin-face
- "Face name to use for leaving directory messages.")
- ;; Used for compatibility with the old compile.el.
- (defvar compilation-parse-errors-function nil)
- (make-obsolete-variable 'compilation-parse-errors-function
- 'compilation-error-regexp-alist "24.1")
- (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-buffer-modtime nil
- ;; "The buffer modification time, for buffers not associated with files.")
- ;; (make-variable-buffer-local 'compilation-buffer-modtime)
- (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 "Skip warnings and info" 2)
- (const :tag "Skip info" 1)
- (const :tag "No skip" 0))
- :group 'compilation
- :version "22.1")
- (defun compilation-set-skip-threshold (level)
- "Switch the `compilation-skip-threshold' level."
- (interactive
- (list
- (mod (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg)
- (1+ compilation-skip-threshold))
- 3)))
- (setq compilation-skip-threshold level)
- (message "Skipping %s"
- (pcase compilation-skip-threshold
- (0 "Nothing")
- (1 "Info messages")
- (2 "Warnings and info"))))
- (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))
- ;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil)
- ;; 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.
- ;; FIXME-omake: TIMESTAMP was used to try and handle "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.
- ;; (cl-defstruct (compilation--loc
- ;; (:constructor nil)
- ;; (:copier nil)
- ;; (:constructor compilation--make-loc
- ;; (file-struct line col marker))
- ;; (:conc-name compilation--loc->))
- ;; col line file-struct marker timestamp visited)
- ;; FIXME: We don't use a defstruct because of compilation-assq which looks up
- ;; and creates part of the LOC (only the first cons cell containing the COL).
- (defmacro compilation--make-cdrloc (line file-struct marker)
- `(list ,line ,file-struct ,marker nil))
- (defmacro compilation--loc->col (loc) `(car ,loc))
- (defmacro compilation--loc->line (loc) `(cadr ,loc))
- (defmacro compilation--loc->file-struct (loc) `(nth 2 ,loc))
- (defmacro compilation--loc->marker (loc) `(nth 3 ,loc))
- ;; (defmacro compilation--loc->timestamp (loc) `(nth 4 ,loc))
- (defmacro compilation--loc->visited (loc) `(nthcdr 5 ,loc))
- ;; 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.
- (defmacro compilation--make-file-struct (file-spec formats &optional loc-tree)
- `(cons ,file-spec (cons ,formats ,loc-tree)))
- (defmacro compilation--file-struct->file-spec (fs) `(car ,fs))
- (defmacro compilation--file-struct->formats (fs) `(cadr ,fs))
- ;; The FORMATS field plays the role of ANCHOR in the loc-tree.
- (defmacro compilation--file-struct->loc-tree (fs) `(cdr ,fs))
- ;; 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 `compilation-message' text-properties in the
- ;; compilation buffer.
- (cl-defstruct (compilation--message
- (:constructor nil)
- (:copier nil)
- ;; (:type list) ;Old representation.
- (:constructor compilation--make-message (loc type end-loc))
- (:conc-name compilation--message->))
- loc type end-loc)
- (defvar compilation--previous-directory-cache nil
- "A pair (POS . RES) caching the result of previous directory search.
- Basically, this pair says that calling
- (previous-single-property-change POS 'compilation-directory)
- returned RES, i.e. there is no change of `compilation-directory' between
- POS and RES.")
- (make-variable-buffer-local 'compilation--previous-directory-cache)
- (defun compilation--flush-directory-cache (start _end)
- (cond
- ((or (not compilation--previous-directory-cache)
- (<= (car compilation--previous-directory-cache) start)))
- ((or (not (cdr compilation--previous-directory-cache))
- (null (marker-buffer (cdr compilation--previous-directory-cache)))
- (<= (cdr compilation--previous-directory-cache) start))
- (set-marker (car compilation--previous-directory-cache) start))
- (t (setq compilation--previous-directory-cache nil))))
- (defun compilation--previous-directory (pos)
- "Like (previous-single-property-change POS 'compilation-directory), but faster."
- ;; This avoids an NÂ? behavior when there's no/few compilation-directory
- ;; entries, in which case each call to previous-single-property-change
- ;; ends up having to walk very far back to find the last change.
- (if (and compilation--previous-directory-cache
- (< pos (car compilation--previous-directory-cache))
- (or (null (cdr compilation--previous-directory-cache))
- (< (cdr compilation--previous-directory-cache) pos)))
- ;; No need to call previous-single-property-change.
- (cdr compilation--previous-directory-cache)
- (let* ((cache (and compilation--previous-directory-cache
- (<= (car compilation--previous-directory-cache) pos)
- (car compilation--previous-directory-cache)))
- (prev
- (previous-single-property-change
- pos 'compilation-directory nil cache))
- (res
- (cond
- ((null cache)
- (setq compilation--previous-directory-cache
- (cons (copy-marker pos) (if prev (copy-marker prev))))
- prev)
- ((and prev (= prev cache))
- (if cache
- (set-marker (car compilation--previous-directory-cache) pos)
- (setq compilation--previous-directory-cache
- (cons (copy-marker pos) nil)))
- (cdr compilation--previous-directory-cache))
- (t
- (if cache
- (progn
- (set-marker cache pos)
- (setcdr compilation--previous-directory-cache
- (copy-marker prev)))
- (setq compilation--previous-directory-cache
- (cons (copy-marker pos) (if prev (copy-marker prev)))))
- prev))))
- (if (markerp res) (marker-position res) res))))
- ;; Internal function for calculating the text properties of a directory
- ;; change message. The compilation-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 (compilation--previous-directory (match-beginning 0))))
- (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory)
- (get-text-property dir 'compilation-directory))))
- `(font-lock-face ,(if leave
- compilation-leave-directory-face
- compilation-enter-directory-face)
- compilation-directory ,(if leave
- (or (cdr dir)
- '(nil)) ; nil only isn't a property-change
- (cons (match-string-no-properties idx) dir))
- ;; Place a `compilation-message' everywhere we change text-properties
- ;; so compilation--remove-properties can know what to remove.
- compilation-message ,(compilation--make-message nil 0 nil)
- 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 (text-property-not-all (match-beginning 0) (point)
- 'compilation-message nil)
- (if file
- (when (stringp
- (setq file (if (functionp file) (funcall file)
- (match-string-no-properties file))))
- (let ((dir
- (unless (file-name-absolute-p file)
- (let ((pos (compilation--previous-directory
- (match-beginning 0))))
- (when pos
- (or (get-text-property (1- pos) 'compilation-directory)
- (get-text-property pos 'compilation-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) 'compilation-message)))
- (if prev-pos
- ;; Get the file structure that belongs to it.
- (let* ((prev
- (or (get-text-property (1- prev-pos) 'compilation-message)
- (get-text-property prev-pos 'compilation-message)))
- (prev-file-struct
- (and prev
- (compilation--loc->file-struct
- (compilation--message->loc prev)))))
- ;; Construct FILE . DIR from that.
- (if prev-file-struct
- (setq file (cons (caar prev-file-struct)
- (cadr (car prev-file-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)))))
- (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) -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."
- (setq col (- col compilation-first-column))
- (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 ; a line structure
- (cadr (compilation--file-struct->loc-tree file-struct)))
- (marker
- (if marker-line (compilation--loc->marker (cadr marker-line))))
- (screen-columns compilation-error-screen-columns)
- (first-column compilation-first-column)
- end-marker loc end-loc)
- (if (not (and marker (marker-buffer marker)))
- (setq marker nil) ; no valid marker for this file
- (unless line (setq line 1)) ; normalize no linenumber to line 1
- (catch 'marker ; find nearest loc, at least one exists
- (dolist (x (cddr (compilation--file-struct->loc-tree
- file-struct))) ; Loop over remaining lines.
- (if (> (car x) line) ; Still bigger.
- (setq marker-line x)
- (if (> (- (or (car marker-line) 1) line)
- (- line (car x))) ; Current line is nearer.
- (setq marker-line x))
- (throw 'marker t))))
- (setq marker (compilation--loc->marker (cadr marker-line))
- marker-line (or (car marker-line) 1))
- (with-current-buffer (marker-buffer marker)
- (let ((screen-columns
- ;; Obey the compilation-error-screen-columns of the target
- ;; buffer if its major mode set it buffer-locally.
- (if (local-variable-p 'compilation-error-screen-columns)
- compilation-error-screen-columns screen-columns))
- (compilation-first-column
- (if (local-variable-p 'compilation-first-column)
- compilation-first-column first-column)))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (marker-position marker))
- ;; Set end-marker if appropriate and go to line.
- (if (not (or end-col end-line))
- (beginning-of-line (- line marker-line -1))
- (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 screen-columns))
- (setq end-marker (point-marker))
- (when end-line (beginning-of-line (- line end-line -1))))
- (if col
- (compilation-move-to-column col screen-columns)
- (forward-to-indentation 0))
- (setq marker (point-marker)))))))
- (setq loc (compilation-assq line (compilation--file-struct->loc-tree
- file-struct)))
- (setq end-loc
- (if end-line
- (compilation-assq
- end-col (compilation-assq
- end-line (compilation--file-struct->loc-tree
- file-struct)))
- (if end-col ; use same line element
- (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.
- ;; FIXME-omake: there's a problem with timestamps here: the markers
- ;; relative to which we computed the current `marker' have a timestamp
- ;; almost guaranteed to be different from compilation-buffer-modtime, so if
- ;; we use their timestamp, we'll never use `loc' since the timestamp won't
- ;; match compilation-buffer-modtime, and if we use
- ;; compilation-buffer-modtime then we have different timestamps for
- ;; locations that were computed together, which doesn't make sense either.
- ;; I think this points to a fundamental problem in our approach to the
- ;; "omake -P" problem. --Stef
- (or (cdr loc)
- (setcdr loc (compilation--make-cdrloc line file-struct marker)))
- (if end-loc
- (or (cdr end-loc)
- (setcdr end-loc
- (compilation--make-cdrloc (or end-line line) file-struct
- end-marker))))
- ;; Must start with face
- `(font-lock-face ,compilation-message-face
- compilation-message ,(compilation--make-message loc type end-loc)
- 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--put-prop (matchnum prop val)
- (when (and (integerp matchnum) (match-beginning matchnum))
- (put-text-property
- (match-beginning matchnum) (match-end matchnum)
- prop val)))
- (defun compilation--remove-properties (&optional start end)
- (with-silent-modifications
- ;; When compile.el used font-lock directly, we could just remove all
- ;; our text-properties in one go, but now that we ma…
Large files are truncated, but you can click here to view the full file