;;; 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, 2010, 2011, 2012
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2012
;; Free Software Foundation, Inc.
;; Authors: Roland McGrath <roland@gnu.org>,
;; 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
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.")
+ "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.
;;;###autoload
(defvar compilation-process-setup-function nil
- "*Function to call to customize the compilation process.
+ "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.")
+while processing the output of the compilation process.")
;;;###autoload
(defvar compilation-buffer-name-function nil
(defvar compilation-num-errors-found)
-(defconst compilation-error-regexp-alist-alist
+;; 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))
" 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))
+ "^[ \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)
\\([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:\\)?\\)"
+ (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)
+
(edg-1
"^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
1 2 nil (3 . 4))
(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.
+ "\\([0-9]*[^0-9\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
;; 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]+\\)\\)?\
+ ;; 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\\)\\|\
-\[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))
+ *[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]+\\)"
"^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)
+ (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
(omake
;; "omake -P" reports "file foo changed"
;; (useful if you do "cvs up" and want to see what has changed)
- "omake: file \\(.*\\) changed" 1)
+ "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]+\\)\
(gcov-file
"^ *-: *\\(0\\):Source:\\(.+\\)$"
- 2 1 nil 0 nil
- (1 compilation-line-face prepend) (2 compilation-info-face prepend))
+ 2 1 nil 0 nil)
(gcov-header
"^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$"
- nil 1 nil 0 nil
- (1 compilation-line-face prepend))
+ 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
(gcov-nomark
"^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$"
nil 1 nil 0 nil
- (0 'default t)
- (1 compilation-line-face prepend))
+ (0 'default)
+ (1 compilation-line-face))
(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))
+ (0 'default)
+ (1 compilation-info-face) (2 compilation-line-face))
(gcov-never-called
"^ *\\(#####\\): *\\([0-9]+\\):.*$"
nil 2 nil 2 nil
- (0 'default t)
- (1 compilation-error-face prepend) (2 compilation-line-face prepend))
+ (0 'default)
+ (1 compilation-error-face) (2 compilation-line-face))
(perl--Pod::Checker
;; podchecker error messages, per Pod::Checker.
"^# Failed test [0-9]+ in \\([^ \t\r\n]+\\) at line \\([0-9]+\\)"
1 2)
(perl--Test2
- ;; Or when comparing got/want values,
+ ;; 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]+\\))"
+\\([0-9]+\\)\\( fail #[0-9]+\\)?)"
2 3)
(perl--Test::Harness
;; perl Test::Harness output, eg.
`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."
+Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where SUBMATCH is
+the number of a submatch that should be highlighted when it matches,
+and FACE is an expression returning the face to use for that submatch.."
:type '(repeat (choice (symbol :tag "Predefined symbol")
(sexp :tag "Error specification")))
:link `(file-link :tag "example file"
;; 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)
+ (" --?o\\(?:utfile\\|utput\\)?[= ]\\(\\S +\\)" . 1)
("^Compilation \\(finished\\).*"
- (0 '(face nil message nil help-echo nil mouse-face nil) t)
+ (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 message nil help-echo nil mouse-face nil) t)
+ (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.
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."
+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")
: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.
(defvar compilation-locs ())
(defvar compilation-debug nil
- "*Set this to t before creating a *compilation* buffer.
+ "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'.")
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.
+(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.")
+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 font-lock-warning-face))
+ '((t :inherit error))
"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)))
+ '((t :inherit warning))
"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)))
+ '((t :inherit success))
"Face used to highlight compiler information."
:group 'compilation
:version "22.1")
(defface compilation-line-number
- '((t :inherit font-lock-variable-name-face))
+ '((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-type-face))
+ '((t :inherit font-lock-doc-face))
"Face for displaying column numbers in compiler messages."
:group 'compilation
:version "22.1")
(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
+(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.
-(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)
+(make-obsolete '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."
"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.")
+ "If non-nil, skip multiple error messages for the same source location.")
(defcustom compilation-skip-threshold 1
"Compilation motion commands skip less important messages.
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))
+ :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"
+ (case 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
(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.
+
+;; (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.
+
+(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 directory property is important, because it is
-;; the stack of nested enter-messages. Relative filenames on the following
+;; 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 (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))
+ (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")))
;; 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))
+ (unless (text-property-not-all (match-beginning 0) (point)
+ 'compilation-message nil)
(if file
- (if (functionp file)
- (setq file (funcall file))
- (let (dir)
- (setq file (match-string-no-properties file))
+ (when (stringp
+ (setq file (if (functionp file) (funcall file)
+ (match-string-no-properties file))))
+ (let ((dir
(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)))))
+ (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) '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) 'message)
- (get-text-property prev-pos 'message)))
- (prev-struct
- (car (nth 2 (car 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-struct
- (setq file (cons (car prev-struct)
- (cadr prev-struct))))))
+ (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
(setq col (funcall col))
(and
(setq col (match-string-no-properties col))
- (setq col (- (string-to-number col) compilation-first-column)))))
+ (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) compilation-first-column -1))
+ (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)
(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)))
+ (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)))))
(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)
+ (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
- (setq loc (or line 1)) ; normalize no linenumber to line 1
+ (unless line (setq 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
+ (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) loc)
- (- loc (car x))) ; current line is nearer
+ (if (> (- (or (car marker-line) 1) line)
+ (- line (car x))) ; Current line is nearer.
(setq marker-line x))
(throw 'marker t))))
- (setq marker (nth 3 (cadr marker-line))
+ (setq marker (compilation--loc->marker (cadr marker-line))
marker-line (or (car marker-line) 1))
(with-current-buffer (marker-buffer marker)
- (save-excursion
+ (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))
- (when (or end-col end-line)
+ ;; 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 compilation-error-screen-columns))
- (setq end-marker (list (point-marker))))
- (beginning-of-line (if end-line
- (- line end-line -1)
- (- loc marker-line -1)))
+ (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 compilation-error-screen-columns)
+ (compilation-move-to-column col screen-columns)
(forward-to-indentation 0))
- (setq marker (list (point-marker)))))))
+ (setq marker (point-marker)))))))
- (setq loc (compilation-assq line (cdr file-struct)))
+ (setq loc (compilation-assq line (compilation--file-struct->loc-tree
+ file-struct)))
+ (setq end-loc
(if end-line
- (setq end-loc (compilation-assq end-line (cdr file-struct))
- end-loc (compilation-assq end-col end-loc))
+ (compilation-assq
+ end-col (compilation-assq
+ end-line (compilation--file-struct->loc-tree
+ file-struct)))
(if end-col ; use same line element
- (setq end-loc (compilation-assq end-col 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)))
+ ;; 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 `(,(or end-line line) ,file-struct ,@end-marker))))
+ (setcdr end-loc
+ (compilation--make-cdrloc (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)))
+ `(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 manually place
+ ;; font-lock-face, we have to be careful to only remove the font-lock-face
+ ;; we placed.
+ ;; (remove-list-of-text-properties
+ ;; (or start (point-min)) (or end (point-max))
+ ;; '(compilation-debug compilation-directory compilation-message
+ ;; font-lock-face help-echo mouse-face))
+ (let (next)
+ (unless start (setq start (point-min)))
+ (unless end (setq end (point-max)))
+ (compilation--flush-directory-cache start end)
+ (while
+ (progn
+ (setq next (or (next-single-property-change
+ start 'compilation-message nil end)
+ end))
+ (when (get-text-property start 'compilation-message)
+ (remove-list-of-text-properties
+ start next
+ '(compilation-debug compilation-directory compilation-message
+ font-lock-face help-echo mouse-face)))
+ (< next end))
+ (setq start next)))))
+
+(defun compilation--parse-region (start end)
+ (goto-char end)
+ (unless (bolp)
+ ;; We generally don't like to parse partial lines.
+ (assert (eobp))
+ (when (let ((proc (get-buffer-process (current-buffer))))
+ (and proc (memq (process-status proc) '(run open))))
+ (setq end (line-beginning-position))))
+ (compilation--remove-properties start end)
+ (if compilation-parse-errors-function
+ ;; An old package! Try the compatibility code.
+ (progn
+ (goto-char start)
+ (compilation--compat-parse-errors end))
+
+ ;; compilation-directory-matcher is the only part that really needs to be
+ ;; parsed sequentially. So we could split it out, handle directories
+ ;; like syntax-propertize, and the rest as font-lock-keywords. But since
+ ;; we want to have it work even when font-lock is off, we'd then need to
+ ;; use our own compilation-parsed text-property to keep track of the parts
+ ;; that have already been parsed.
+ (goto-char start)
+ (while (re-search-forward (car compilation-directory-matcher)
+ end t)
+ (compilation--flush-directory-cache (match-beginning 0) (match-end 0))
+ (when compilation-debug
+ (font-lock-append-text-property
+ (match-beginning 0) (match-end 0)
+ 'compilation-debug
+ (vector 'directory compilation-directory-matcher)))
+ (dolist (elt (cdr compilation-directory-matcher))
+ (add-text-properties (match-beginning (car elt))
+ (match-end (car elt))
+ (compilation-directory-properties
+ (car elt) (cdr elt)))))
+
+ (compilation-parse-errors start end)))
+
+(defun compilation-parse-errors (start end &rest rules)
+ "Parse errors between START and END.
+The errors recognized are the ones specified in RULES which default
+to `compilation-error-regexp-alist' if RULES is nil."
+ (dolist (item (or rules compilation-error-regexp-alist))
+ (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
+ props)
+
+ ;; 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).
+ ;; FIXME-omake: Doing it here seems wrong, at least it should depend on
+ ;; whether or not omake's own error messages are recognized.
+ (cond
+ ((not (memq 'omake compilation-error-regexp-alist)) nil)
+ ((string-match "\\`\\([^^]\\|^\\( \\*\\|\\[\\)\\)" pat)
+ nil) ;; Not anchored or anchored but already allows empty spaces.
+ (t (setq pat (concat "^ *" (substring pat 1)))))
+
+ (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.
+ (progn
+ (goto-char start)
+ (while (re-search-forward pat end t)
+ (save-match-data
+ (when compilation-debug
+ (font-lock-append-text-property
+ (match-beginning 0) (match-end 0)
+ 'compilation-debug (vector 'functionp item)))
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ (compilation--compat-error-properties
+ (funcall line (cons (match-string file)
+ (cons default-directory
+ (nthcdr 4 item)))
+ (if col (match-string col))))))
+ (compilation--put-prop
+ file 'font-lock-face compilation-error-face)))
+
+ (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
+ (error "HYPERLINK should be an integer: %s" (nth 5 item)))
+
+ (goto-char start)
+ (while (re-search-forward pat end t)
+ (when (setq props (compilation-error-properties
+ file line end-line col end-col (or type 2) fmt))
+
+ (when (integerp file)
+ (compilation--put-prop
+ file 'font-lock-face
+ (if (consp type)
+ (compilation-face type)
+ (symbol-value (aref [compilation-info-face
+ compilation-warning-face
+ compilation-error-face]
+ (or type 2))))))
+
+ (compilation--put-prop
+ line 'font-lock-face compilation-line-face)
+ (compilation--put-prop
+ end-line 'font-lock-face compilation-line-face)
+
+ (compilation--put-prop
+ col 'font-lock-face compilation-column-face)
+ (compilation--put-prop
+ end-col 'font-lock-face compilation-column-face)
+
+ (dolist (extra-item (nthcdr 6 item))
+ (let ((mn (pop extra-item)))
+ (when (match-beginning mn)
+ (let ((face (eval (car extra-item))))
+ (cond
+ ((null face))
+ ((symbolp face)
+ (put-text-property
+ (match-beginning mn) (match-end mn)
+ 'font-lock-face face))
+ (t
+ (error "Don't know how to handle face %S"
+ face)))))))
+ (let ((mn (or (nth 5 item) 0)))
+ (when compilation-debug
+ (font-lock-append-text-property
+ (match-beginning 0) (match-end 0)
+ 'compilation-debug (vector 'std item props)))
+ (add-text-properties
+ (match-beginning mn) (match-end mn)
+ (cddr props))
+ (font-lock-append-text-property
+ (match-beginning mn) (match-end mn)
+ 'font-lock-face (cadr props)))))))))
+
+(defvar compilation--parsed -1)
+(make-variable-buffer-local 'compilation--parsed)
+
+(defun compilation--ensure-parse (limit)
+ "Make sure the text has been parsed up to LIMIT."
+ (save-excursion
+ (goto-char limit)
+ (setq limit (line-beginning-position 2))
+ (unless (markerp compilation--parsed)
+ ;; We use a marker for compilation--parsed so that users (such as
+ ;; grep.el) don't need to flush-parse when they modify the buffer
+ ;; in a way that impacts buffer positions but does not require
+ ;; re-parsing.
+ (setq compilation--parsed (point-min-marker)))
+ (when (< compilation--parsed limit)
+ (let ((start (max compilation--parsed (point-min))))
+ (move-marker compilation--parsed limit)
+ (goto-char start)
+ (forward-line 0) ;Not line-beginning-position: ignore (comint) fields.
+ (with-silent-modifications
+ (compilation--parse-region (point) compilation--parsed)))))
+ nil)
+
+(defun compilation--flush-parse (start _end)
+ "Mark the region between START and END for re-parsing."
+ (if (markerp compilation--parsed)
+ (move-marker compilation--parsed (min start compilation--parsed))))
(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).
- (when (and (= ?^ (aref pat 0)) ; anchored: starts with "^"
- ;; but does not allow an arbitrary number of leading spaces
- (not (and (= ? (aref pat 1)) (= ?* (aref pat 2)))))
- (setq pat (concat "^ *" (substring pat 1))))
- (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)))
+ (append
+ '((compilation--ensure-parse))
+ compilation-mode-font-lock-keywords))
(defun compilation-read-command (command)
(read-shell-command "Compile 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)
+ (save-some-buffers (not compilation-ask-about-save)
+ compilation-save-buffers-predicate)
(setq-default compilation-directory default-directory)
(compilation-start command comint))
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)
+ (save-some-buffers (not compilation-ask-about-save)
+ compilation-save-buffers-predicate)
(let ((default-directory (or compilation-directory default-directory)))
(when edit-command
(setcar compilation-arguments
:group 'compilation)
-(defun compilation-buffer-name (mode-name mode-command name-function)
+(defun compilation-buffer-name (name-of-mode 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
+If NAME-FUNCTION is non-nil, call it with one argument NAME-OF-MODE
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."
+Otherwise, construct a buffer name from NAME-OF-MODE."
(cond (name-function
- (funcall name-function mode-name))
+ (funcall name-function name-of-mode))
(compilation-buffer-name-function
- (funcall compilation-buffer-name-function mode-name))
+ (funcall compilation-buffer-name-function name-of-mode))
((eq mode-command major-mode)
(buffer-name))
(t
- (concat "*" (downcase mode-name) "*"))))
+ (concat "*" (downcase name-of-mode) "*"))))
;; 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
+ &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)
+ _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
(let* ((name-of-mode
(if (eq mode t)
"compilation"
- (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
+ (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
(thisdir default-directory)
+ (thisenv compilation-environment)
outwin outbuf)
(with-current-buffer
(setq outbuf
;; 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)
+ (cd (if (string-match "\\`\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]"
+ command)
(if (match-end 1)
(substitute-env-vars (match-string 1 command))
"~")
;; 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
+ ;; NB: must be done after (funcall mode) as that resets local variables
(set (make-local-variable 'compilation-directory) thisdir)
+ (set (make-local-variable 'compilation-environment) thisenv)
(if highlight-regexp
(set (make-local-variable 'compilation-highlight-regexp)
highlight-regexp))
(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)
+ "; default-directory: "
+ (prin1-to-string (abbreviate-file-name default-directory))
" -*-\n"
(format "%s started at %s\n\n"
mode-name
;; Insert the output at the end, after the initial text,
;; regardless of where the user sees point.
(goto-char (point-max))
- (let* ((buffer-read-only nil) ; call-process needs to modify outbuf
+ (let* ((inhibit-read-only t) ; call-process needs to modify outbuf
+ (compilation-filter-start (point))
(status (call-process shell-file-name nil outbuf nil "-c"
command)))
+ (run-hooks 'compilation-filter-hook)
(cond ((numberp status)
(compilation-handle-exit
'exit status
(concat status "\n")))
(t
(compilation-handle-exit 'bizarre status status)))))
- ;; Without async subprocesses, the buffer is not yet
- ;; fontified, so fontify it now.
- (let ((font-lock-verbose nil)) ; shut up font-lock messages
- (font-lock-fontify-buffer))
(set-buffer-modified-p nil)
(message "Executing `%s'...done" command)))
;; Now finally cd to where the shell started make/grep/...
(defvar compilation-minor-mode-map
(let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
(define-key map [mouse-2] 'compile-goto-error)
(define-key map [follow-link] 'mouse-face)
(define-key map "\C-c\C-c" 'compile-goto-error)
(define-key map "\M-{" 'compilation-previous-file)
(define-key map "\M-}" 'compilation-next-file)
(define-key map "g" 'recompile) ; revert
- (define-key map "q" 'quit-window)
;; Set up the menu-bar
(define-key map [menu-bar compilation]
(cons "Errors" compilation-menu-map))
;; Don't inherit from compilation-minor-mode-map,
;; because that introduces a menu bar item we don't want.
;; That confuses C-down-mouse-3.
+ (set-keymap-parent map special-mode-map)
(define-key map [mouse-2] 'compile-goto-error)
(define-key map [follow-link] 'mouse-face)
(define-key map "\C-c\C-c" 'compile-goto-error)
(define-key map "\t" 'compilation-next-error)
(define-key map [backtab] 'compilation-previous-error)
(define-key map "g" 'recompile) ; revert
- (define-key map "q" 'quit-window)
- (define-key map " " 'scroll-up)
- (define-key map "\^?" 'scroll-down)
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
;; Set up the menu-bar
(defvar compilation-mode-tool-bar-map
;; When bootstrapping, tool-bar-map is not properly initialized yet,
;; so don't do anything.
- (when (keymapp (butlast tool-bar-map))
- (let ((map (butlast (copy-keymap tool-bar-map)))
- (help (last tool-bar-map))) ;; Keep Help last in tool bar
+ (when (keymapp tool-bar-map)
+ (let ((map (copy-keymap tool-bar-map)))
+ (define-key map [undo] nil)
+ (define-key map [separator-2] nil)
+ (define-key-after map [separator-compile] menu-bar-separator)
(tool-bar-local-item
"left-arrow" 'previous-error-no-select 'previous-error-no-select map
:rtl "right-arrow"
(tool-bar-local-item
"refresh" 'recompile 'recompile map
:help "Restart compilation")
- (append map help))))
+ map)))
(put 'compilation-mode 'mode-class 'special)
;; Let windows scroll along with the output.
(set (make-local-variable 'window-point-insertion-type) t)
(set (make-local-variable 'tool-bar-map) compilation-mode-tool-bar-map)
- (setq major-mode 'compilation-mode
+ (setq major-mode 'compilation-mode ; FIXME: Use define-derived-mode.
mode-name (or name-of-mode "Compilation"))
(set (make-local-variable 'page-delimiter)
compilation-page-delimiter)
+ ;; (set (make-local-variable 'compilation-buffer-modtime) nil)
(compilation-setup)
(setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
+;;;###autoload
+(put 'define-compilation-mode 'doc-string-elt 3)
+
(defmacro define-compilation-mode (mode name doc &rest body)
"This is like `define-derived-mode' without the PARENT argument.
The parent is always `compilation-mode' and the customizable `compilation-...'
(symbol-name v)))))
(and (cdr v)
(or (boundp (cdr v))
+ ;; FIXME: This is hackish, using undocumented info.
(if (boundp 'byte-compile-bound-variables)
(memq (cdr v) byte-compile-bound-variables)))
`(set (make-local-variable ',(car v)) ,(cdr v))))
"Buffer position of the beginning of the compilation messages.
If nil, use the beginning of buffer.")
-;; A function name can't be a hook, must be something with a value.
-(defconst compilation-turn-on-font-lock 'turn-on-font-lock)
-
(defun compilation-setup (&optional minor)
"Prepare the buffer for the compilation parsing commands to work.
Optional argument MINOR indicates this is called from
(setq next-error-function 'compilation-next-error-function)
(set (make-local-variable 'comint-file-name-prefix)
(or (file-remote-p default-directory) ""))
- (set (make-local-variable 'font-lock-extra-managed-props)
- '(directory message help-echo mouse-face debug))
(set (make-local-variable 'compilation-locs)
(make-hash-table :test 'equal :weakness 'value))
- ;; lazy-lock would never find the message unless it's scrolled to.
- ;; jit-lock might fontify some things too late.
- (set (make-local-variable 'font-lock-support-mode) nil)
- (set (make-local-variable 'font-lock-maximum-size) nil)
+ ;; It's generally preferable to use after-change-functions since they
+ ;; can be subject to combine-after-change-calls, but if we do that, we risk
+ ;; running our hook after font-lock, resulting in incorrect refontification.
+ (add-hook 'before-change-functions 'compilation--flush-parse nil t)
+ ;; Also for minor mode, since it's not permanent-local.
+ (add-hook 'change-major-mode-hook #'compilation--remove-properties nil t)
(if minor
- (let ((fld font-lock-defaults))
+ (progn
(font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
(if font-lock-mode
- (if fld
- (font-lock-fontify-buffer)
- (font-lock-change-mode)
- (turn-on-font-lock))
- (turn-on-font-lock)))
- (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))
- ;; maybe defer font-lock till after derived mode is set up
- (run-mode-hooks 'compilation-turn-on-font-lock)))
+ (font-lock-fontify-buffer)))
+ (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))))
+
+(defun compilation--unsetup ()
+ ;; Only for minor mode.
+ (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
+ (remove-hook 'before-change-functions 'compilation--flush-parse t)
+ (kill-local-variable 'compilation--parsed)
+ (compilation--remove-properties)
+ (if font-lock-mode
+ (font-lock-fontify-buffer)))
;;;###autoload
(define-minor-mode compilation-shell-minor-mode
- "Toggle compilation shell minor mode.
-With arg, turn compilation mode on if and only if arg is positive.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available but bound to keys that don't
-collide with Shell mode. See `compilation-mode'.
-Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'."
+ "Toggle Compilation Shell minor mode.
+With a prefix argument ARG, enable Compilation Shell minor mode
+if ARG is positive, and disable it otherwise. If called from
+Lisp, enable the mode if ARG is omitted or nil.
+
+When Compilation Shell minor mode is enabled, all the
+error-parsing commands of the Compilation major mode are
+available but bound to keys that don't collide with Shell mode.
+See `compilation-mode'."
nil " Shell-Compile"
:group 'compilation
(if compilation-shell-minor-mode
(compilation-setup t)
- (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
- (font-lock-fontify-buffer)))
+ (compilation--unsetup)))
;;;###autoload
(define-minor-mode compilation-minor-mode
- "Toggle compilation minor mode.
-With arg, turn compilation mode on if and only if arg is positive.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available. See `compilation-mode'.
-Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
+ "Toggle Compilation minor mode.
+With a prefix argument ARG, enable Compilation minor mode if ARG
+is positive, and disable it otherwise. If called from Lisp,
+enable the mode if ARG is omitted or nil.
+
+When Compilation minor mode is enabled, all the error-parsing
+commands of Compilation major mode are available. See
+`compilation-mode'."
nil " Compilation"
:group 'compilation
(if compilation-minor-mode
(compilation-setup t)
- (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
- (font-lock-fontify-buffer)))
+ (compilation--unsetup)))
(defun compilation-handle-exit (process-status exit-status msg)
"Write MSG in the current buffer and hack its `mode-line-process'."
(setq mode-line-process
(let ((out-string (format ":%s [%s]" process-status (cdr status)))
(msg (format "%s %s" mode-name
- (replace-regexp-in-string "\n?$" "" (car status)))))
+ (replace-regexp-in-string "\n?$" ""
+ (car status)))))
(message "%s" msg)
(propertize out-string
'help-echo msg 'face (if (> exit-status 0)
(let ((inhibit-read-only t)
;; `save-excursion' doesn't use the right insertion-type for us.
(pos (copy-marker (point) t))
+ ;; `save-restriction' doesn't use the right insertion type either:
+ ;; If we are inserting at the end of the accessible part of the
+ ;; buffer, keep the inserted text visible.
(min (point-min-marker))
- (max (point-max-marker)))
+ (max (copy-marker (point-max) t))
+ (compilation-filter-start (marker-position (process-mark proc))))
(unwind-protect
(progn
- ;; If we are inserting at the end of the accessible part
- ;; of the buffer, keep the inserted text visible.
- (set-marker-insertion-type max t)
(widen)
- (goto-char (process-mark proc))
+ (goto-char compilation-filter-start)
;; We used to use `insert-before-markers', so that windows with
;; point at `process-mark' scroll along with the output, but we
;; now use window-point-insertion-type instead.
(unless comint-inhibit-carriage-motion
(comint-carriage-motion (process-mark proc) (point)))
(set-marker (process-mark proc) (point))
+ ;; (set (make-local-variable 'compilation-buffer-modtime)
+ ;; (current-time))
(run-hooks 'compilation-filter-hook))
(goto-char pos)
(narrow-to-region min max)
+ (set-marker pos nil)
(set-marker min nil)
(set-marker max nil))))))
`(let (opt)
(while (,< n 0)
(setq opt pt)
- (or (setq pt (,property-change pt 'message))
+ (or (setq pt (,property-change pt 'compilation-message))
;; Handle the case where where the first error message is
;; at the start of the buffer, and n < 0.
- (if (or (eq (get-text-property ,limit 'message)
- (get-text-property opt 'message))
+ (if (or (eq (get-text-property ,limit 'compilation-message)
+ (get-text-property opt 'compilation-message))
(eq pt opt))
- (error ,error compilation-error)
+ (user-error ,error compilation-error)
(setq pt ,limit)))
- ;; prop 'message usually has 2 changes, on and off, so
+ ;; prop 'compilation-message usually has 2 changes, on and off, so
;; re-search if off
- (or (setq msg (get-text-property pt 'message))
- (if (setq pt (,property-change pt 'message nil ,limit))
- (setq msg (get-text-property pt 'message)))
- (error ,error compilation-error))
- (or (< (cadr msg) compilation-skip-threshold)
+ (or (setq msg (get-text-property pt 'compilation-message))
+ (if (setq pt (,property-change pt 'compilation-message nil ,limit))
+ (setq msg (get-text-property pt 'compilation-message)))
+ (user-error ,error compilation-error))
+ (or (< (compilation--message->type msg) compilation-skip-threshold)
(if different-file
- (eq (prog1 last (setq last (nth 2 (car msg))))
+ (eq (prog1 last
+ (setq last (compilation--loc->file-struct
+ (compilation--message->loc msg))))
last))
(if compilation-skip-visited
- (nthcdr 5 (car msg)))
+ (compilation--loc->visited (compilation--message->loc msg)))
(if compilation-skip-to-next-location
- (eq (car msg) loc))
+ (eq (compilation--message->loc msg) loc))
;; count this message only if none of the above are true
(setq n (,1+ n))))))
+(defun compilation-next-single-property-change (position prop
+ &optional object limit)
+ (let (parsed res)
+ (while (progn
+ ;; We parse the buffer here "on-demand" by chunks of 500 chars.
+ ;; But we could also just parse the whole buffer.
+ (compilation--ensure-parse
+ (setq parsed (max compilation--parsed
+ (min (+ position 500)
+ (or limit (point-max))))))
+ (and (or (not (setq res (next-single-property-change
+ position prop object limit)))
+ (eq res limit))
+ (< position (or limit (point-max)))))
+ (setq position parsed))
+ res))
+
(defun compilation-next-error (n &optional different-file pt)
"Move point to the next error in the compilation buffer.
This function does NOT find the source line like \\[next-error].
(or (compilation-buffer-p (current-buffer))
(error "Not in a compilation buffer"))
(or pt (setq pt (point)))
- (let* ((msg (get-text-property pt 'message))
- ;; `loc' is used by the compilation-loop macro.
- (loc (car msg))
+ (let* ((msg (get-text-property pt 'compilation-message))
+ ;; `loc', `msg', and `last' are used by the compilation-loop macro.
+ (loc (and msg (compilation--message->loc msg)))
last)
(if (zerop n)
(unless (or msg ; find message near here
(setq msg (get-text-property (max (1- pt) (point-min))
- 'message)))
- (setq pt (previous-single-property-change pt 'message nil
+ 'compilation-message)))
+ (setq pt (previous-single-property-change pt 'compilation-message nil
(line-beginning-position)))
- (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'message))
- (setq pt (next-single-property-change pt 'message nil
+ (unless (setq msg (get-text-property (max (1- pt) (point-min))
+ 'compilation-message))
+ (setq pt (next-single-property-change pt 'compilation-message nil
(line-end-position)))
- (or (setq msg (get-text-property pt 'message))
+ (or (setq msg (get-text-property pt 'compilation-message))
(setq pt (point)))))
- (setq last (nth 2 (car msg)))
+ (setq last (compilation--loc->file-struct loc))
(if (>= n 0)
- (compilation-loop > next-single-property-change 1-
+ (compilation-loop > compilation-next-single-property-change 1-
(if (get-buffer-process (current-buffer))
"No more %ss yet"
"Moved past last %s")
(point-max))
+ (compilation--ensure-parse pt)
;; Don't move "back" to message at or before point.
;; Pass an explicit (point-min) to make sure pt is non-nil.
- (setq pt (previous-single-property-change pt 'message nil (point-min)))
+ (setq pt (previous-single-property-change
+ pt 'compilation-message nil (point-min)))
(compilation-loop < previous-single-property-change 1+
"Moved back before first %s" (point-min))))
(goto-char pt)
(if event (posn-set-point (event-end event)))
(or (compilation-buffer-p (current-buffer))
(error "Not in a compilation buffer"))
- (if (get-text-property (point) 'directory)
- (dired-other-window (car (get-text-property (point) 'directory)))
+ (compilation--ensure-parse (point))
+ (if (get-text-property (point) 'compilation-directory)
+ (dired-other-window
+ (car (get-text-property (point) 'compilation-directory)))
(push-mark)
(setq compilation-current-error (point))
(next-error-internal)))
+;; This is mostly unused, but we keep it for the sake of some external
+;; packages which seem to make use of it.
(defun compilation-find-buffer (&optional avoid-current)
"Return a compilation buffer.
If AVOID-CURRENT is nil, and the current buffer is a compilation buffer,
(interactive "p")
(when reset
(setq compilation-current-error nil))
- (let* ((columns compilation-error-screen-columns) ; buffer's local value
- (last 1) timestamp
- (loc (compilation-next-error (or n 1) nil
+ (let* ((screen-columns compilation-error-screen-columns)
+ (first-column compilation-first-column)
+ (last 1)
+ (msg (compilation-next-error (or n 1) nil
(or compilation-current-error
compilation-messages-start
(point-min))))
- (end-loc (nth 2 loc))
+ (loc (compilation--message->loc msg))
+ (end-loc (compilation--message->end-loc msg))
(marker (point-marker)))
(setq compilation-current-error (point-marker)
overlay-arrow-position
(if (bolp)
compilation-current-error
- (copy-marker (line-beginning-position)))
- loc (car loc))
+ (copy-marker (line-beginning-position))))
;; If loc contains no marker, no error in that file has been visited.
;; If the marker is invalid the buffer has been killed.
- ;; If the file is newer than the timestamp, it has been modified
- ;; (`omake -P' polls filesystem for changes and recompiles when needed
- ;; in the same process and buffer).
;; So, recalculate all markers for that file.
- (unless (and (nth 3 loc) (marker-buffer (nth 3 loc))
- ;; There may be no timestamp info if the loc is a `fake-loc'.
- ;; So we skip the time-check here, although we should maybe
- ;; change `compilation-fake-loc' to add timestamp info.
- (or (null (nth 4 loc))
- (equal (nth 4 loc)
- (setq timestamp
- (with-current-buffer
- (marker-buffer (nth 3 loc))
- (visited-file-modtime))))))
- (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
- (cadr (car (nth 2 loc))))
- (save-restriction
- (widen)
- (goto-char (point-min))
- ;; Treat file's found lines in forward order, 1 by 1.
- (dolist (line (reverse (cddr (nth 2 loc))))
- (when (car line) ; else this is a filename w/o a line#
- (beginning-of-line (- (car line) last -1))
- (setq last (car line)))
- ;; Treat line's found columns and store/update a marker for each.
- (dolist (col (cdr line))
- (if (car col)
- (if (eq (car col) -1) ; special case for range end
- (end-of-line)
- (compilation-move-to-column (car col) columns))
- (beginning-of-line)
- (skip-chars-forward " \t"))
- (if (nth 3 col)
- (set-marker (nth 3 col) (point))
- (setcdr (nthcdr 2 col) `(,(point-marker)))))))))
- (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
- (setcdr (nthcdr 3 loc) (list timestamp))
- (setcdr (nthcdr 4 loc) t))) ; Set this one as visited.
+ (unless (and (compilation--loc->marker loc)
+ (marker-buffer (compilation--loc->marker loc))
+ ;; FIXME-omake: For "omake -P", which automatically recompiles
+ ;; when the file is modified, the line numbers of new output
+ ;; may not be related to line numbers from earlier output
+ ;; (earlier markers), so we used to try to detect it here and
+ ;; force a reparse. But that caused more problems elsewhere,
+ ;; so instead we now flush the file-structure when we see
+ ;; omake's message telling it's about to recompile a file.
+ ;; (or (null (compilation--loc->timestamp loc)) ;A fake-loc
+ ;; (equal (compilation--loc->timestamp loc)
+ ;; (setq timestamp compilation-buffer-modtime)))
+ )
+ (with-current-buffer
+ (compilation-find-file
+ marker
+ (caar (compilation--loc->file-struct loc))
+ (cadr (car (compilation--loc->file-struct loc))))
+ (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-restriction
+ (widen)
+ (goto-char (point-min))
+ ;; Treat file's found lines in forward order, 1 by 1.
+ (dolist (line (reverse (cddr (compilation--loc->file-struct loc))))
+ (when (car line) ; else this is a filename w/o a line#
+ (beginning-of-line (- (car line) last -1))
+ (setq last (car line)))
+ ;; Treat line's found columns and store/update a marker for each.
+ (dolist (col (cdr line))
+ (if (compilation--loc->col col)
+ (if (eq (compilation--loc->col col) -1)
+ ;; Special case for range end.
+ (end-of-line)
+ (compilation-move-to-column (compilation--loc->col col)
+ screen-columns))
+ (beginning-of-line)
+ (skip-chars-forward " \t"))
+ (if (compilation--loc->marker col)
+ (set-marker (compilation--loc->marker col) (point))
+ (setf (compilation--loc->marker col) (point-marker)))
+ ;; (setf (compilation--loc->timestamp col) timestamp)
+ ))))))
+ (compilation-goto-locus marker (compilation--loc->marker loc)
+ (compilation--loc->marker end-loc))
+ (setf (compilation--loc->visited loc) t)))
(defvar compilation-gcpro nil
"Internal variable used to keep some values from being GC'd.")
FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
This is useful when you compile temporary files, but want
automatic translation of the messages to the real buffer from
-which the temporary file came. This only works if done before a
-message about FILE appears!
+which the temporary file came. This may also affect previous messages
+about FILE.
Optional args LINE and COL default to 1 and beginning of
indentation respectively. The marker is expected to reflect
call this several times, once each for the last line of one
region and the first line of the next region."
(or (consp file) (setq file (list file)))
- (setq file (compilation-get-file-structure file))
- ;; Between the current call to compilation-fake-loc and the first occurrence
- ;; of an error message referring to `file', the data is only kept in the
- ;; weak hash-table compilation-locs, so we need to prevent this entry
- ;; in compilation-locs from being GC'd away. --Stef
- (push file compilation-gcpro)
- (let ((loc (compilation-assq (or line 1) (cdr file))))
- (setq loc (compilation-assq col loc))
- (if (cdr loc)
- (setcdr (cddr loc) (list marker))
- (setcdr loc (list line file marker)))
- loc))
+ (compilation--flush-file-structure file)
+ (let ((fs (compilation-get-file-structure file)))
+ ;; Between the current call to compilation-fake-loc and the first
+ ;; occurrence of an error message referring to `file', the data is
+ ;; only kept in the weak hash-table compilation-locs, so we need
+ ;; to prevent this entry in compilation-locs from being GC'd
+ ;; away. --Stef
+ (push fs compilation-gcpro)
+ (let ((loc (compilation-assq (or line 1) (cdr fs))))
+ (setq loc (compilation-assq col loc))
+ (assert (null (cdr loc)))
+ (setcdr loc (compilation--make-cdrloc line fs marker))
+ loc)))
(defcustom compilation-context-lines nil
"Display this many lines of leading context before the current message.
pre-existing
(let ((display-buffer-reuse-frames t)
(pop-up-windows t))
- ;; Pop up a window.
+ ;; Pop up a window.
(display-buffer (marker-buffer msg)))))
(highlight-regexp (with-current-buffer (marker-buffer msg)
;; also do this while we change buffer
(compilation-set-window w msg)
compilation-highlight-regexp)))
- ;; Ideally, the window-size should be passed to `display-buffer' (via
- ;; something like special-display-buffer) so it's only used when
- ;; creating a new window.
+ ;; Ideally, the window-size should be passed to `display-buffer'
+ ;; so it's only used when creating a new window.
(unless pre-existing (compilation-set-window-height w))
(if from-compilation-buffer
;; display the source in another window.
(let ((pop-up-windows t))
(pop-to-buffer (marker-buffer mk) 'other-window))
- (if (window-dedicated-p (selected-window))
- (pop-to-buffer (marker-buffer mk))
- (switch-to-buffer (marker-buffer mk))))
+ (switch-to-buffer (marker-buffer mk)))
(unless (eq (goto-char mk) (point))
;; If narrowing gets in the way of going to the right place, widen.
(widen)
In the former case, FILENAME may be relative or absolute.
The file-structure looks like this:
- (list (list FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)"
+ ((FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)"
(or (gethash file compilation-locs)
;; File was not previously encountered, at least not in the form passed.
;; Let's normalize it and look again.
;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html
(or (gethash (cons filename spec-directory) compilation-locs)
(puthash (cons filename spec-directory)
- (list (list filename spec-directory) fmt)
+ (compilation--make-file-struct
+ (list filename spec-directory) fmt)
compilation-locs))
compilation-locs))))
-(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
+(defun compilation--flush-file-structure (file)
+ (or (consp file) (setq file (list file)))
+ (let ((fs (compilation-get-file-structure file)))
+ (assert (eq fs (gethash file compilation-locs)))
+ (assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
+ compilation-locs)))
+ (maphash (lambda (k v)
+ (if (eq v fs) (remhash k compilation-locs)))
+ compilation-locs)))
;;; Compatibility with the old compile.el.
-(defun compile-buffer-substring (n) (if n (match-string n)))
+(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
+(defvar compilation-parsing-end (make-marker))
+(defvar compilation-error-list nil)
+(defvar compilation-old-error-list nil)
-(defun compilation-compat-error-properties (err)
+(defun compilation--compat-error-properties (err)
"Map old-style error ERR to new-style message."
;; Old-style structure is (MARKER (FILE DIR) LINE COL) or
;; (MARKER . MARKER).
(let ((dst (cdr err)))
(if (markerp dst)
- ;; Must start with a face, for font-lock.
- `(face nil
- message ,(list (list nil nil nil dst) 2)
+ `(compilation-message ,(compilation--make-message
+ (cons nil (compilation--make-cdrloc
+ nil nil dst))
+ 2 nil)
help-echo "mouse-2: visit the source location"
keymap compilation-button-map
mouse-face highlight)
(compilation-internal-error-properties
(cons filename dirname) line nil col nil 2 fmt)))))
-(defun compilation-compat-parse-errors (limit)
+(defun compilation--compat-parse-errors (limit)
(when compilation-parse-errors-function
;; FIXME: We should remove the rest of the compilation keywords
;; but we can't do that from here because font-lock is using
- ;; the value right now. --stef
+ ;; the value right now. --Stef
(save-excursion
(setq compilation-error-list nil)
;; Reset compilation-parsing-end each time because font-lock
;; might force us the re-parse many times (typically because
;; some code adds some text-property to the output that we
;; already parsed). You might say "why reparse", well:
- ;; because font-lock has just removed the `message' property so
- ;; have to do it all over again.
+ ;; because font-lock has just removed the `compilation-message' property
+ ;; so have to do it all over again.
(if compilation-parsing-end
(set-marker compilation-parsing-end (point))
(setq compilation-parsing-end (point-marker)))
(dolist (err (if (listp compilation-error-list) compilation-error-list))
(let* ((src (car err))
(dst (cdr err))
- (loc (cond ((markerp dst) (list nil nil nil dst))
+ (loc (cond ((markerp dst)
+ (cons nil
+ (compilation--make-cdrloc nil nil dst)))
((consp dst)
- (list (nth 2 dst) (nth 1 dst)
- (cons (cdar dst) (caar dst)))))))
+ (cons (nth 2 dst)
+ (compilation--make-cdrloc
+ (nth 1 dst)
+ (cons (cdar dst) (caar dst))
+ nil))))))
(when loc
(goto-char src)
- ;; (put-text-property src (line-end-position) 'font-lock-face 'font-lock-warning-face)
+ ;; (put-text-property src (line-end-position)
+ ;; 'font-lock-face 'font-lock-warning-face)
(put-text-property src (line-end-position)
- 'message (list loc 2)))))))
+ 'compilation-message
+ (compilation--make-message loc 2 nil)))))))
(goto-char limit)
nil)
-;; Beware: this is not only compatibility code. New code stil uses it. --Stef
+;; Beware! this is not only compatibility code. New code also uses it. --Stef
(defun compilation-forget-errors ()
;; In case we hit the same file/line specs, we want to recompute a new
;; marker for them, so flush our cache.
- (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
+ (clrhash compilation-locs)
(setq compilation-gcpro nil)
;; FIXME: the old code reset the directory-stack, so maybe we should
;; put a `directory change' marker of some sort, but where? -stef
(or compilation-auto-jump-to-first-error
(eq compilation-scroll-output 'first-error))))
-;;;###autoload
-(add-to-list 'auto-mode-alist (cons (purecopy "\\.gcov\\'") 'compilation-mode))
-
(provide 'compile)
;;; compile.el ends here
HCoop / bpt / emacs.git / blobdiff