[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r103013: * progmodes/compile.el: Don'
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r103013: * progmodes/compile.el: Don't use font-lock any more. |
|
Date: |
Fri, 28 Jan 2011 17:12:05 -0500 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 103013 [merge]
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Fri 2011-01-28 17:12:05 -0500
message:
* progmodes/compile.el: Don't use font-lock any more.
modified:
etc/NEWS
lisp/ChangeLog
lisp/progmodes/compile.el
lisp/progmodes/grep.el
lisp/textmodes/tex-mode.el
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2011-01-27 21:41:47 +0000
+++ b/etc/NEWS 2011-01-28 22:12:05 +0000
@@ -321,6 +321,9 @@
* Changes in Specialized Modes and Packages in Emacs 24.1
+** The compile.el mode can be used without font-lock-mode.
+`compilation-parse-errors-function' is now obsolete.
+
** The Landmark game is now invoked with `landmark', not `lm'.
** Prolog mode has been completely revamped, with lots of additional
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-01-28 21:42:11 +0000
+++ b/lisp/ChangeLog 2011-01-28 22:12:05 +0000
@@ -13,6 +13,89 @@
2011-01-28 Stefan Monnier <address@hidden>
+ * progmodes/compile.el: Don't use font-lock any more.
+ (compilation-error-regexp-alist-alist): Change handling of makepp
+ so it preserves the warning/error distinction on subsequent files.
+ Simplify various rules.
+ (compilation-directory-properties): Use font-lock-face.
+ Add a compilation-message property.
+ (compilation-internal-error-properties): Use font-lock-face.
+ Don't set the compilation-debug property here.
+ (compilation--put-prop, compilation--remove-properties)
+ (compilation--parse-region, compilation--ensure-parse)
+ (compilation--ensure-parse): New functions.
+ (compilation-parse-errors): New function, largely inspired of
+ compilation-mode-font-lock-keywords. Set compilation-debug here.
+ (compilation--parsed): New var.
+ (compilation--flush-parse): Use compilation--ensure-parse.
+ (compilation-start): Don't call font-lock.
+ (compilation-turn-on-font-lock): Remove.
+ (compilation-setup): Don't set font-lock-extra-managed-props not change
+ other font-lock settings, other than keywords.
+ Don't activate font-lock-mode.
+ Set change-major-mode-hook and before-change-functions.
+ (compilation--unsetup): Remove properties and hooks.
+ (compilation-next-single-property-change): New function.
+ (compilation-next-error): Use it to parse when needed.
+ (compile-goto-error): Parse buffer as needed.
+ (compilation--compat-error-properties): Don't need a dummy `face'
+ property any more.
+
+2011-01-28 Stefan Monnier <address@hidden>
+
+ * progmodes/compile.el: Use accessors for clarity and fix omake hack.
+ (compilation-process-setup-function): Fix docstring's false promises.
+ (compilation-error-regexp-alist-alist): Catch omake's continuous
+ recompilation message and avoid reuse of old markers.
+ (compilation-parse-errors-function): Declare obsolete.
+ (compilation-buffer-modtime): Remove.
+ (compilation--make-cdrloc, compilation--loc->col)
+ (compilation--loc->line, compilation--loc->file-struct)
+ (compilation--loc->marker, compilation--loc->visited)
+ (compilation--make-file-struct, compilation--file-struct->file-spec)
+ (compilation--file-struct->formats)
+ (compilation--file-struct->loc-tree): New macros. Use them.
+ (compilation--message): New defstruct. Use them.
+ (compilation-next-error-function): Don't mess with timestamps to try
+ and guess when to reparse.
+
+2011-01-28 Stefan Monnier <address@hidden>
+
+ * textmodes/tex-mode.el: Get rid of compilation-parse-errors-function
+ (tex-old-error-file-name): New function,
+ extracted from tex-compilation-parse-errors.
+ (tex-compilation-parse-errors): Remove.
+ (tex-error-regexp-alist): New var.
+ (tex-shell): Use it to avoid compilation-parse-errors-function.
+
+ * progmodes/grep.el (grep-regexp-alist): Tighten regexp.
+ (grep-mode-font-lock-keywords): Remove regexp that seems like
+ a left-over from before we used compile.el.
+ (grep-mode-font-lock-keywords): Call syntax-ppss-flush-cache when
+ modifying the buffer within with-silent-modifications.
+
+ * progmodes/compile.el: Cleanup text-properties namespace by using
+ `compilation-message' instead of `message', `compilation-directory'
+ instead of `directory', and `compilation-debug' instead of `debug'.
+ (compilation-last-buffer, compilation-parsing-end)
+ (compilation-error-list, compilation-old-error-list): Move to the
+ compatibility part of the code.
+ (compilation-error-properties): If `file' is a function, let it return
+ a file name.
+ (compilation-mode-font-lock-keywords): Be more conservative with the
+ omake "^ *" pattern prefix, to try and minimize the risk of
+ pathologically slow regexp matching.
+ (compilation-start): Use inhibit-read-only.
+ (compilation--unsetup): New function.
+ (compilation-shell-minor-mode, compilation-minor-mode): Use it.
+ (compilation-filter): Minor tweaks.
+ (compilation-next-error-function): Try and avoid abusing variables.
+ (compilation--flush-file-structure): New fun.
+ (compilation-fake-loc): Use it to improve behavior when file is reused.
+ (debug-ignored-errors): Add "Moved past last ...".
+ (compilation--compat-error-properties)
+ (compilation--compat-parse-errors): Rename by doubling the "-".
+
Port features from the previous prolog.el to the new one.
* progmodes/prolog.el (prolog-system): Add GNU and ECLiPSe options.
(prolog-program-name, prolog-program-switches, prolog-consult-string)
@@ -27,7 +110,7 @@
(prolog-inferior-self-insert-command): New command.
(prolog-inferior-mode-map): Use it.
(prolog-inferior-error-regexp-alist): New var.
- (prolog-inferior-mode): Use it, along with compilation-shell-minor-mode.
+ (prolog-inferior-mode): Use it, with compilation-shell-minor-mode.
(prolog-input-filter): Use derived-mode-p.
(prolog-inferior-guess-flavor): New function.
(prolog-ensure-process): Use it. Use make-comint-in-buffer rather than
=== modified file 'lisp/progmodes/compile.el'
--- a/lisp/progmodes/compile.el 2011-01-25 04:08:28 +0000
+++ b/lisp/progmodes/compile.el 2011-01-28 22:06:20 +0000
@@ -28,57 +28,12 @@
;; 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
@@ -122,9 +77,7 @@
"*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
@@ -284,11 +237,15 @@
"^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)))
+ (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)))
;; This regexp is pathologically slow on long lines (Bug#3441).
;; (maven
@@ -311,7 +268,12 @@
(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]+\\)\
@@ -368,12 +330,10 @@
(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
@@ -382,18 +342,18 @@
(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.
@@ -505,8 +465,9 @@
`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"
@@ -544,10 +505,10 @@
(1 font-lock-function-name-face) (3 compilation-line-face nil t))
(" -\\(?:o[= ]?\\|-\\(?:outfile\\|output\\)[= ]\\)\\(\\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.
@@ -738,11 +699,9 @@
;; 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."
@@ -754,9 +713,9 @@
"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-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.")
@@ -802,23 +761,99 @@
(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)
+
;; 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 (previous-single-property-change (point) 'compilation-directory)))
+ (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")))
@@ -857,28 +892,29 @@
;; 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 (previous-single-property-change
+ (point) 'compilation-directory)))
+ (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)))
+ (or (get-text-property (1- prev-pos) 'compilation-message)
+ (get-text-property prev-pos 'compilation-message)))
(prev-struct
(car (nth 2 (car prev)))))
;; Construct FILE . DIR from that.
@@ -917,7 +953,8 @@
(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.
@@ -938,22 +975,25 @@
(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
+ (marker-line ; a line structure
+ (cadr (compilation--file-struct->loc-tree file-struct)))
+ (marker
+ (if marker-line (compilation--loc->marker (cadr marker-line))))
(compilation-error-screen-columns compilation-error-screen-columns)
end-marker loc end-loc)
(if (not (and marker (marker-buffer marker)))
(setq marker nil) ; no valid marker for this file
(setq loc (or line 1)) ; normalize no linenumber to line 1
(catch 'marker ; find nearest loc, at least one exists
- (dolist (x (nthcdr 3 file-struct)) ; loop over remaining lines
+ (dolist (x (cddr (compilation--file-struct->loc-tree
+ file-struct))) ; Loop over remaining lines.
(if (> (car x) loc) ; still bigger
(setq marker-line x)
(if (> (- (or (car marker-line) 1) loc)
(- loc (car x))) ; current line is nearer
(setq marker-line x))
(throw 'marker t))))
- (setq marker (nth 3 (cadr marker-line))
+ (setq marker (compilation--loc->marker (cadr marker-line))
marker-line (or (car marker-line) 1))
(with-current-buffer (marker-buffer marker)
(save-excursion
@@ -966,7 +1006,7 @@
(end-of-line)
(compilation-move-to-column
end-col compilation-error-screen-columns))
- (setq end-marker (list (point-marker))))
+ (setq end-marker (point-marker)))
(beginning-of-line (if end-line
(- line end-line -1)
(- loc marker-line -1)))
@@ -974,120 +1014,260 @@
(compilation-move-to-column
col compilation-error-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)))
+ (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)
+ (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."
+ (message "compilation-parse-errors: %S %S" start end)
+ (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."
+ (message "compilation--flush-parse: %S %S" start end)
+ (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
@@ -1383,7 +1563,7 @@
;; 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
(status (call-process shell-file-name nil outbuf nil "-c"
command)))
(cond ((numberp status)
@@ -1397,10 +1577,6 @@
(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/...
@@ -1611,7 +1787,7 @@
mode-name (or name-of-mode "Compilation"))
(set (make-local-variable 'page-delimiter)
compilation-page-delimiter)
- (set (make-local-variable 'compilation-buffer-modtime) nil)
+ ;; (set (make-local-variable 'compilation-buffer-modtime) nil)
(compilation-setup)
(setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
@@ -1632,6 +1808,7 @@
(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))))
@@ -1669,9 +1846,6 @@
"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
@@ -1690,26 +1864,29 @@
(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
@@ -1723,8 +1900,7 @@
: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
@@ -1737,8 +1913,7 @@
: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'."
@@ -1766,7 +1941,8 @@
(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)
@@ -1811,13 +1987,13 @@
(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)))
(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))
;; We used to use `insert-before-markers', so that windows with
@@ -1827,10 +2003,12 @@
(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))
+ ;; (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))))))
@@ -1849,31 +2027,50 @@
`(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)
(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)))
+ (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)))
(error ,error compilation-error))
- (or (< (cadr msg) compilation-skip-threshold)
+ (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].
@@ -1887,31 +2084,35 @@
(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 (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
+ (compilation--message->loc msg)))
(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)
@@ -1955,12 +2156,16 @@
(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,
@@ -1979,53 +2184,65 @@
(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
+ (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)) (nthcdr 4 loc)
- ;; There may be no timestamp info if the loc is a `fake-loc',
- ;; but we just checked that the file has been visited before!
- (equal (nth 4 loc)
- (setq timestamp compilation-buffer-modtime)))
- (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
- (cadr (car (nth 2 loc))))
+ (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))))
(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))))
+ (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 (car col)
- (if (eq (car col) -1) ; special case for range end
+ (if (compilation--loc->col col)
+ (if (eq (compilation--loc->col col) -1)
+ ;; Special case for range end.
(end-of-line)
- (compilation-move-to-column (car col) columns))
+ (compilation-move-to-column (compilation--loc->col 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.
+ (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.")
@@ -2036,8 +2253,8 @@
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
@@ -2049,18 +2266,19 @@
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.
@@ -2278,7 +2496,7 @@
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.
@@ -2323,25 +2541,41 @@
;;
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)))
+
+(add-to-list 'debug-ignored-errors "\\`No more [-a-z ]+s yet\\'")
+(add-to-list 'debug-ignored-errors "\\`Moved past last .*")
;;; 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)
@@ -2355,19 +2589,19 @@
(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)))
@@ -2379,19 +2613,26 @@
(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.
=== modified file 'lisp/progmodes/grep.el'
--- a/lisp/progmodes/grep.el 2011-01-25 04:08:28 +0000
+++ b/lisp/progmodes/grep.el 2011-01-28 21:11:19 +0000
@@ -341,7 +341,7 @@
;;;###autoload
(defconst grep-regexp-alist
- '(("^\\(.+?\\)\\(:[ \t]*\\)\\([0-9]+\\)\\2"
+ '(("^\\(.+?\\)\\(:[ \t]*\\)\\([1-9][0-9]*\\)\\2"
1 3)
;; Rule to match column numbers is commented out since no known grep
;; produces them
@@ -384,7 +384,6 @@
(defvar grep-mode-font-lock-keywords
'(;; Command output lines.
- ("^\\([A-Za-z_0-9/\.+-]+\\)[ \t]*:" 1 font-lock-function-name-face)
(": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or
directory\\|device or address\\)\\)$"
1 grep-error-face)
;; remove match from grep-regexp-alist before fontifying
@@ -399,7 +398,8 @@
(1 grep-error-face)
(2 grep-error-face nil t))
("^.+?-[0-9]+-.*\n" (0 grep-context-face))
- ;; Highlight grep matches and delete markers
+ ;; Highlight grep matches and delete markers.
+ ;; FIXME: Modifying the buffer text from font-lock is a bad idea!
("\\(\033\\[01;31m\\)\\(.*?\\)\\(\033\\[[0-9]*m\\)"
;; Refontification does not work after the markers have been
;; deleted. So we use the font-lock-face property here as Font
@@ -409,12 +409,14 @@
(progn
;; Delete markers with `replace-match' because it updates
;; the match-data, whereas `delete-region' would render it obsolete.
+ (syntax-ppss-flush-cache (match-beginning 0))
(replace-match "" t t nil 3)
(replace-match "" t t nil 1))))
- ("\\(\033\\[[0-9;]*[mK]\\)"
+ ("\033\\[[0-9;]*[mK]"
;; Delete all remaining escape sequences
((lambda (bound))
- (replace-match "" t t nil 1))))
+ (syntax-ppss-flush-cache (match-beginning 0))
+ (replace-match "" t t))))
"Additional things to highlight in grep output.
This gets tacked on the end of the generated expressions.")
=== modified file 'lisp/textmodes/tex-mode.el'
--- a/lisp/textmodes/tex-mode.el 2011-01-25 04:08:28 +0000
+++ b/lisp/textmodes/tex-mode.el 2011-01-28 21:16:04 +0000
@@ -1812,11 +1812,70 @@
;; Why use a shell instead of running TeX directly? Because if TeX
;; gets stuck, the user can switch to the shell window and type at it.
+(defvar tex-error-parse-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?\( "()" st)
+ (modify-syntax-entry ?\) ")(" st)
+ (modify-syntax-entry ?\\ "\\" st)
+ (modify-syntax-entry ?\{ "_" st)
+ (modify-syntax-entry ?\} "_" st)
+ (modify-syntax-entry ?\[ "_" st)
+ (modify-syntax-entry ?\] "_" st)
+ ;; Single quotations may appear in errors
+ (modify-syntax-entry ?\" "_" st)
+ st)
+ "Syntax-table used while parsing TeX error messages.")
+
+(defun tex-old-error-file-name ()
+ ;; This is unreliable, partly because we don't try very hard, and
+ ;; partly because TeX's output format is eminently ambiguous and unfriendly
+ ;; to automation.
+ (save-excursion
+ (save-match-data
+ (with-syntax-table tex-error-parse-syntax-table
+ (beginning-of-line)
+ (backward-up-list 1)
+ (skip-syntax-forward "(_")
+ (while (not (let ((try-filename (thing-at-point 'filename)))
+ (and try-filename
+ (not (string= "" try-filename))
+ (file-readable-p try-filename))))
+ (skip-syntax-backward "(_")
+ (backward-up-list 1)
+ (skip-syntax-forward "(_"))
+ (thing-at-point 'filename)))))
+
+(defconst tex-error-regexp-alist
+ ;; First alternative handles the newer --file-line-error style:
+ ;; ./test2.tex:14: Too many }'s.
+ '(gnu
+ ;; Second handles the old-style, which spans two lines but doesn't include
+ ;; any file info:
+ ;; ! Too many }'s.
+ ;; l.396 toto}
+ ("^l\\.\\([1-9][0-9]*\\) \\(?:\\.\\.\\.\\)?\\(.*\\)$"
+ tex-old-error-file-name 1 nil nil nil
+ ;; Since there's no filename to highlight, let's highlight the message.
+ (2 compilation-error-face))
+ ;; A few common warning messages.
+ ("^\\(?:Und\\|Ov\\)erfull \\\\[hv]box .* at lines?
\\(\\([1-9][0-9]*\\)\\(?:--\\([1-9][0-9]*\\)\\)?\\)$"
+ tex-old-error-file-name (2 . 3) nil 1 nil
+ (1 compilation-warning-face))
+ ("^(Font) *\\([^ \n].* on input line \\([1-9][0-9]*\\)\\)\\.$"
+ tex-old-error-file-name 2 nil 1 1
+ (2 compilation-warning-face))
+ ;; Included files get output as (<file> ...).
+ ;; FIXME: there tend to be a crapload of them at the beginning of the
+ ;; output which aren't that interesting. Maybe we should filter out
+ ;; all the file name that start with /usr/share?
+ ;; ("(\\.?/\\([^() \n]+\\)" 1 nil nil 0)
+ ))
+
;; The utility functions:
(define-derived-mode tex-shell shell-mode "TeX-Shell"
- (set (make-local-variable 'compilation-parse-errors-function)
- 'tex-compilation-parse-errors)
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ tex-error-regexp-alist)
(compilation-shell-minor-mode t))
;;;###autoload
@@ -2314,113 +2373,6 @@
(tex-display-shell)
(setq tex-last-buffer-texed (current-buffer)))
-(defvar tex-error-parse-syntax-table
- (let ((st (make-syntax-table)))
- (modify-syntax-entry ?\( "()" st)
- (modify-syntax-entry ?\) ")(" st)
- (modify-syntax-entry ?\\ "\\" st)
- (modify-syntax-entry ?\{ "_" st)
- (modify-syntax-entry ?\} "_" st)
- (modify-syntax-entry ?\[ "_" st)
- (modify-syntax-entry ?\] "_" st)
- ;; Single quotations may appear in errors
- (modify-syntax-entry ?\" "_" st)
- st)
- "Syntax-table used while parsing TeX error messages.")
-
-(defun tex-compilation-parse-errors (limit-search find-at-least)
- "Parse the current buffer as TeX error messages.
-See the variable `compilation-parse-errors-function' for the interface it uses.
-
-This function parses only the last TeX compilation.
-It works on TeX compilations only. It is necessary for that purpose,
-since TeX does not put file names and line numbers on the same line as
-for the error messages."
- (require 'thingatpt)
- (setq compilation-error-list nil)
- (let ((default-directory ; Perhaps dir has changed meanwhile.
- (file-name-directory (buffer-file-name tex-last-buffer-texed)))
- found-desired (num-errors-found 0)
- last-filename last-linenum last-position
- begin-of-error end-of-error errfilename)
- ;; Don't reparse messages already seen at last parse.
- (goto-char compilation-parsing-end)
- ;; Parse messages.
- (while (and (not (or found-desired (eobp)))
- ;; First alternative handles the newer --file-line-error style:
- ;; ./test2.tex:14: Too many }'s.
- ;; Second handles the old-style:
- ;; ! Too many }'s.
- (prog1 (re-search-forward
- "^\\(?:\\([^:\n]+\\):[[:digit:]]+:\\|!\\) " nil 'move)
- (setq begin-of-error (match-beginning 0)
- end-of-error (match-end 0)
- errfilename (match-string 1)))
- (re-search-forward
- "^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\)?\\(.*\\)$" nil 'move))
- (let* ((this-error (copy-marker begin-of-error))
- (linenum (string-to-number (match-string 1)))
- (error-text (regexp-quote (match-string 3)))
- try-filename
- (filename
- ;; Prefer --file-liner-error filename if we have it.
- (or errfilename
- (save-excursion
- (with-syntax-table tex-error-parse-syntax-table
- (backward-up-list 1)
- (skip-syntax-forward "(_")
- (while (not
- (and (setq try-filename (thing-at-point
- 'filename))
- (not (string= "" try-filename))
- (file-readable-p try-filename)))
- (skip-syntax-backward "(_")
- (backward-up-list 1)
- (skip-syntax-forward "(_"))
- (thing-at-point 'filename)))))
- (new-file
- (or (null last-filename)
- (not (string-equal last-filename filename))))
- (error-location
- (with-current-buffer
- (if (equal filename (concat tex-zap-file ".tex"))
- tex-last-buffer-texed
- (find-file-noselect filename))
- (save-excursion
- (if new-file
- (progn
- (goto-char (point-min))
- (forward-line (1- linenum))
- (setq last-position nil))
- (goto-char last-position)
- (forward-line (- linenum last-linenum)))
- ;; first try a forward search for the error text,
- ;; then a backward search limited by the last error.
- (let ((starting-point (point)))
- (or (re-search-forward error-text nil t)
- (re-search-backward error-text last-position t)
- (goto-char starting-point)))
- (point-marker)))))
- (goto-char this-error)
- (if (and compilation-error-list
- (or (and find-at-least
- (>= num-errors-found
- find-at-least))
- (and limit-search
- (>= end-of-error limit-search)))
- new-file)
- (setq found-desired t)
- (setq num-errors-found (1+ num-errors-found)
- last-filename filename
- last-linenum linenum
- last-position error-location
- compilation-error-list ; Add the new error
- (cons (cons this-error error-location)
- compilation-error-list))
- (goto-char end-of-error)))))
- (set-marker compilation-parsing-end (point))
- (setq compilation-error-list (nreverse compilation-error-list)))
-
;;; The commands:
(defun tex-region (beg end)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r103013: * progmodes/compile.el: Don't use font-lock any more.,
Stefan Monnier <=