aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-01-28 17:12:05 -0500
committerStefan Monnier2011-01-28 17:12:05 -0500
commit9ffae6d024cb3d9c95f456d7f9b8a6be97b63fde (patch)
tree819b97536e7daff4ee2e493c785080260426dafa
parentb1ea593c8121821485fdc758a30efdf03bb63168 (diff)
parent55fb901352fd4cd8c2a604378004b678fa60a461 (diff)
downloademacs-9ffae6d024cb3d9c95f456d7f9b8a6be97b63fde.tar.gz
emacs-9ffae6d024cb3d9c95f456d7f9b8a6be97b63fde.zip
* progmodes/compile.el: Don't use font-lock any more.
-rw-r--r--etc/NEWS3
-rw-r--r--lisp/ChangeLog85
-rw-r--r--lisp/progmodes/compile.el885
-rw-r--r--lisp/progmodes/grep.el12
-rw-r--r--lisp/textmodes/tex-mode.el170
5 files changed, 718 insertions, 437 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 07cb55dc09a..bb916628010 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -321,6 +321,9 @@ prompts for a number to count from and for a format string.
321 321
322* Changes in Specialized Modes and Packages in Emacs 24.1 322* Changes in Specialized Modes and Packages in Emacs 24.1
323 323
324** The compile.el mode can be used without font-lock-mode.
325`compilation-parse-errors-function' is now obsolete.
326
324** The Landmark game is now invoked with `landmark', not `lm'. 327** The Landmark game is now invoked with `landmark', not `lm'.
325 328
326** Prolog mode has been completely revamped, with lots of additional 329** Prolog mode has been completely revamped, with lots of additional
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ff99d22303f..59a346bdd95 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -13,6 +13,89 @@
13 13
142011-01-28 Stefan Monnier <monnier@iro.umontreal.ca> 142011-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
15 15
16 * progmodes/compile.el: Don't use font-lock any more.
17 (compilation-error-regexp-alist-alist): Change handling of makepp
18 so it preserves the warning/error distinction on subsequent files.
19 Simplify various rules.
20 (compilation-directory-properties): Use font-lock-face.
21 Add a compilation-message property.
22 (compilation-internal-error-properties): Use font-lock-face.
23 Don't set the compilation-debug property here.
24 (compilation--put-prop, compilation--remove-properties)
25 (compilation--parse-region, compilation--ensure-parse)
26 (compilation--ensure-parse): New functions.
27 (compilation-parse-errors): New function, largely inspired of
28 compilation-mode-font-lock-keywords. Set compilation-debug here.
29 (compilation--parsed): New var.
30 (compilation--flush-parse): Use compilation--ensure-parse.
31 (compilation-start): Don't call font-lock.
32 (compilation-turn-on-font-lock): Remove.
33 (compilation-setup): Don't set font-lock-extra-managed-props not change
34 other font-lock settings, other than keywords.
35 Don't activate font-lock-mode.
36 Set change-major-mode-hook and before-change-functions.
37 (compilation--unsetup): Remove properties and hooks.
38 (compilation-next-single-property-change): New function.
39 (compilation-next-error): Use it to parse when needed.
40 (compile-goto-error): Parse buffer as needed.
41 (compilation--compat-error-properties): Don't need a dummy `face'
42 property any more.
43
442011-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
45
46 * progmodes/compile.el: Use accessors for clarity and fix omake hack.
47 (compilation-process-setup-function): Fix docstring's false promises.
48 (compilation-error-regexp-alist-alist): Catch omake's continuous
49 recompilation message and avoid reuse of old markers.
50 (compilation-parse-errors-function): Declare obsolete.
51 (compilation-buffer-modtime): Remove.
52 (compilation--make-cdrloc, compilation--loc->col)
53 (compilation--loc->line, compilation--loc->file-struct)
54 (compilation--loc->marker, compilation--loc->visited)
55 (compilation--make-file-struct, compilation--file-struct->file-spec)
56 (compilation--file-struct->formats)
57 (compilation--file-struct->loc-tree): New macros. Use them.
58 (compilation--message): New defstruct. Use them.
59 (compilation-next-error-function): Don't mess with timestamps to try
60 and guess when to reparse.
61
622011-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
63
64 * textmodes/tex-mode.el: Get rid of compilation-parse-errors-function
65 (tex-old-error-file-name): New function,
66 extracted from tex-compilation-parse-errors.
67 (tex-compilation-parse-errors): Remove.
68 (tex-error-regexp-alist): New var.
69 (tex-shell): Use it to avoid compilation-parse-errors-function.
70
71 * progmodes/grep.el (grep-regexp-alist): Tighten regexp.
72 (grep-mode-font-lock-keywords): Remove regexp that seems like
73 a left-over from before we used compile.el.
74 (grep-mode-font-lock-keywords): Call syntax-ppss-flush-cache when
75 modifying the buffer within with-silent-modifications.
76
77 * progmodes/compile.el: Cleanup text-properties namespace by using
78 `compilation-message' instead of `message', `compilation-directory'
79 instead of `directory', and `compilation-debug' instead of `debug'.
80 (compilation-last-buffer, compilation-parsing-end)
81 (compilation-error-list, compilation-old-error-list): Move to the
82 compatibility part of the code.
83 (compilation-error-properties): If `file' is a function, let it return
84 a file name.
85 (compilation-mode-font-lock-keywords): Be more conservative with the
86 omake "^ *" pattern prefix, to try and minimize the risk of
87 pathologically slow regexp matching.
88 (compilation-start): Use inhibit-read-only.
89 (compilation--unsetup): New function.
90 (compilation-shell-minor-mode, compilation-minor-mode): Use it.
91 (compilation-filter): Minor tweaks.
92 (compilation-next-error-function): Try and avoid abusing variables.
93 (compilation--flush-file-structure): New fun.
94 (compilation-fake-loc): Use it to improve behavior when file is reused.
95 (debug-ignored-errors): Add "Moved past last ...".
96 (compilation--compat-error-properties)
97 (compilation--compat-parse-errors): Rename by doubling the "-".
98
16 Port features from the previous prolog.el to the new one. 99 Port features from the previous prolog.el to the new one.
17 * progmodes/prolog.el (prolog-system): Add GNU and ECLiPSe options. 100 * progmodes/prolog.el (prolog-system): Add GNU and ECLiPSe options.
18 (prolog-program-name, prolog-program-switches, prolog-consult-string) 101 (prolog-program-name, prolog-program-switches, prolog-consult-string)
@@ -27,7 +110,7 @@
27 (prolog-inferior-self-insert-command): New command. 110 (prolog-inferior-self-insert-command): New command.
28 (prolog-inferior-mode-map): Use it. 111 (prolog-inferior-mode-map): Use it.
29 (prolog-inferior-error-regexp-alist): New var. 112 (prolog-inferior-error-regexp-alist): New var.
30 (prolog-inferior-mode): Use it, along with compilation-shell-minor-mode. 113 (prolog-inferior-mode): Use it, with compilation-shell-minor-mode.
31 (prolog-input-filter): Use derived-mode-p. 114 (prolog-input-filter): Use derived-mode-p.
32 (prolog-inferior-guess-flavor): New function. 115 (prolog-inferior-guess-flavor): New function.
33 (prolog-ensure-process): Use it. Use make-comint-in-buffer rather than 116 (prolog-ensure-process): Use it. Use make-comint-in-buffer rather than
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 588275c6513..cbbaa4dc68a 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -28,57 +28,12 @@
28;; This package provides the compile facilities documented in the Emacs user's 28;; This package provides the compile facilities documented in the Emacs user's
29;; manual. 29;; manual.
30 30
31;; This mode uses some complex data-structures:
32
33;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE)
34
35;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe
36;; LINE will be nil for a message that doesn't contain them. Then the
37;; location refers to a indented beginning of line or beginning of file.
38;; Once any location in some file has been jumped to, the list is extended to
39;; (COLUMN LINE FILE-STRUCTURE MARKER TIMESTAMP . VISITED)
40;; for all LOCs pertaining to that file.
41;; MARKER initially points to LINE and COLUMN in a buffer visiting that file.
42;; Being a marker it sticks to some text, when the buffer grows or shrinks
43;; before that point. VISITED is t if we have jumped there, else nil.
44;; TIMESTAMP is necessary because of "incremental compilation": `omake -P'
45;; polls filesystem for changes and recompiles when a file is modified
46;; using the same *compilation* buffer. this necessitates re-parsing markers.
47
48;; FILE-STRUCTURE is a list of
49;; ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...)
50
51;; FILENAME is a string parsed from an error message. DIRECTORY is a string
52;; obtained by following directory change messages. DIRECTORY will be nil for
53;; an absolute filename. FORMATS is a list of formats to apply to FILENAME if
54;; a file of that name can't be found.
55;; The rest of the list is an alist of elements with LINE as key. The keys
56;; are either nil or line numbers. If present, nil comes first, followed by
57;; the numbers in decreasing order. The LOCs for each line are again an alist
58;; ordered the same way. Note that the whole file structure is referenced in
59;; every LOC.
60
61;; MESSAGE is a list of (LOC TYPE END-LOC)
62
63;; TYPE is 0 for info or 1 for warning if the message matcher identified it as
64;; such, 2 otherwise (for a real error). END-LOC is a LOC pointing to the
65;; other end, if the parsed message contained a range. If the end of the
66;; range didn't specify a COLUMN, it defaults to -1, meaning end of line.
67;; These are the value of the `message' text-properties in the compilation
68;; buffer.
69
70;;; Code: 31;;; Code:
71 32
72(eval-when-compile (require 'cl)) 33(eval-when-compile (require 'cl))
73(require 'tool-bar) 34(require 'tool-bar)
74(require 'comint) 35(require 'comint)
75 36
76(defvar font-lock-extra-managed-props)
77(defvar font-lock-keywords)
78(defvar font-lock-maximum-size)
79(defvar font-lock-support-mode)
80
81
82(defgroup compilation nil 37(defgroup compilation nil
83 "Run compiler as inferior of Emacs, parse error messages." 38 "Run compiler as inferior of Emacs, parse error messages."
84 :group 'tools 39 :group 'tools
@@ -122,9 +77,7 @@ in the compilation output, and should return a transformed file name.")
122 "*Function to call to customize the compilation process. 77 "*Function to call to customize the compilation process.
123This function is called immediately before the compilation process is 78This function is called immediately before the compilation process is
124started. It can be used to set any variables or functions that are used 79started. It can be used to set any variables or functions that are used
125while processing the output of the compilation process. The function 80while processing the output of the compilation process.")
126is called with variables `compilation-buffer' and `compilation-window'
127bound to the compilation buffer and window, respectively.")
128 81
129;;;###autoload 82;;;###autoload
130(defvar compilation-buffer-name-function nil 83(defvar compilation-buffer-name-function nil
@@ -284,11 +237,15 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
284 "^makepp\\(?:\\(?:: warning\\(:\\).*?\\|\\(: Scanning\\|: [LR]e?l?oading makefile\\|: Imported\\|log:.*?\\) \\|: .*?\\)\ 237 "^makepp\\(?:\\(?:: warning\\(:\\).*?\\|\\(: Scanning\\|: [LR]e?l?oading makefile\\|: Imported\\|log:.*?\\) \\|: .*?\\)\
285`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)" 238`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)"
286 4 5 nil (1 . 2) 3 239 4 5 nil (1 . 2) 3
287 ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]" nil nil 240 (0 (progn (save-match-data
288 (2 compilation-info-face) 241 (compilation-parse-errors
289 (3 compilation-line-face nil t) 242 (match-end 0) (line-end-position)
290 (1 (compilation-error-properties 2 3 nil nil nil 0 nil) 243 `("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]"
291 append))) 244 2 3 nil
245 ,(cond ((match-end 1) 1) ((match-end 2) 0) (t 2))
246 1)))
247 (end-of-line)
248 nil)))
292 249
293 ;; This regexp is pathologically slow on long lines (Bug#3441). 250 ;; This regexp is pathologically slow on long lines (Bug#3441).
294 ;; (maven 251 ;; (maven
@@ -311,7 +268,12 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
311 (omake 268 (omake
312 ;; "omake -P" reports "file foo changed" 269 ;; "omake -P" reports "file foo changed"
313 ;; (useful if you do "cvs up" and want to see what has changed) 270 ;; (useful if you do "cvs up" and want to see what has changed)
314 "omake: file \\(.*\\) changed" 1) 271 "omake: file \\(.*\\) changed" 1 nil nil nil nil
272 ;; FIXME-omake: This tries to prevent reusing pre-existing markers
273 ;; for subsequent messages, since those messages's line numbers
274 ;; are about another version of the file.
275 (0 (progn (compilation--flush-file-structure (match-string 1))
276 nil)))
315 277
316 (oracle 278 (oracle
317 "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ 279 "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
@@ -368,12 +330,10 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
368 330
369 (gcov-file 331 (gcov-file
370 "^ *-: *\\(0\\):Source:\\(.+\\)$" 332 "^ *-: *\\(0\\):Source:\\(.+\\)$"
371 2 1 nil 0 nil 333 2 1 nil 0 nil)
372 (1 compilation-line-face prepend) (2 compilation-info-face prepend))
373 (gcov-header 334 (gcov-header
374 "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$" 335 "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$"
375 nil 1 nil 0 nil 336 nil 1 nil 0 nil)
376 (1 compilation-line-face prepend))
377 ;; Underlines over all lines of gcov output are too uncomfortable to read. 337 ;; Underlines over all lines of gcov output are too uncomfortable to read.
378 ;; However, hyperlinks embedded in the lines are useful. 338 ;; However, hyperlinks embedded in the lines are useful.
379 ;; So I put default face on the lines; and then put 339 ;; So I put default face on the lines; and then put
@@ -382,18 +342,18 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
382 (gcov-nomark 342 (gcov-nomark
383 "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$" 343 "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$"
384 nil 1 nil 0 nil 344 nil 1 nil 0 nil
385 (0 'default t) 345 (0 'default)
386 (1 compilation-line-face prepend)) 346 (1 compilation-line-face))
387 (gcov-called-line 347 (gcov-called-line
388 "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$" 348 "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$"
389 nil 2 nil 0 nil 349 nil 2 nil 0 nil
390 (0 'default t) 350 (0 'default)
391 (1 compilation-info-face prepend) (2 compilation-line-face prepend)) 351 (1 compilation-info-face) (2 compilation-line-face))
392 (gcov-never-called 352 (gcov-never-called
393 "^ *\\(#####\\): *\\([0-9]+\\):.*$" 353 "^ *\\(#####\\): *\\([0-9]+\\):.*$"
394 nil 2 nil 2 nil 354 nil 2 nil 2 nil
395 (0 'default t) 355 (0 'default)
396 (1 compilation-error-face prepend) (2 compilation-line-face prepend)) 356 (1 compilation-error-face) (2 compilation-line-face))
397 357
398 (perl--Pod::Checker 358 (perl--Pod::Checker
399 ;; podchecker error messages, per Pod::Checker. 359 ;; podchecker error messages, per Pod::Checker.
@@ -505,8 +465,9 @@ What matched the HYPERLINK'th subexpression has `mouse-face' and
505`compilation-message-face' applied. If this is nil, the text 465`compilation-message-face' applied. If this is nil, the text
506matched by the whole REGEXP becomes the hyperlink. 466matched by the whole REGEXP becomes the hyperlink.
507 467
508Additional HIGHLIGHTs as described under `font-lock-keywords' can 468Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where SUBMATCH is
509be added." 469the number of a submatch that should be highlighted when it matches,
470and FACE is an expression returning the face to use for that submatch.."
510 :type '(repeat (choice (symbol :tag "Predefined symbol") 471 :type '(repeat (choice (symbol :tag "Predefined symbol")
511 (sexp :tag "Error specification"))) 472 (sexp :tag "Error specification")))
512 :link `(file-link :tag "example file" 473 :link `(file-link :tag "example file"
@@ -544,10 +505,10 @@ you may also want to change `compilation-page-delimiter'.")
544 (1 font-lock-function-name-face) (3 compilation-line-face nil t)) 505 (1 font-lock-function-name-face) (3 compilation-line-face nil t))
545 (" -\\(?:o[= ]?\\|-\\(?:outfile\\|output\\)[= ]\\)\\(\\S +\\)" . 1) 506 (" -\\(?:o[= ]?\\|-\\(?:outfile\\|output\\)[= ]\\)\\(\\S +\\)" . 1)
546 ("^Compilation \\(finished\\).*" 507 ("^Compilation \\(finished\\).*"
547 (0 '(face nil message nil help-echo nil mouse-face nil) t) 508 (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
548 (1 compilation-info-face)) 509 (1 compilation-info-face))
549 ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*" 510 ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
550 (0 '(face nil message nil help-echo nil mouse-face nil) t) 511 (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
551 (1 compilation-error-face) 512 (1 compilation-error-face)
552 (2 compilation-error-face nil t))) 513 (2 compilation-error-face nil t)))
553 "Additional things to highlight in Compilation mode. 514 "Additional things to highlight in Compilation mode.
@@ -738,11 +699,9 @@ Faces `compilation-error-face', `compilation-warning-face',
738 699
739 700
740;; Used for compatibility with the old compile.el. 701;; Used for compatibility with the old compile.el.
741(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
742(defvar compilation-parsing-end (make-marker))
743(defvar compilation-parse-errors-function nil) 702(defvar compilation-parse-errors-function nil)
744(defvar compilation-error-list nil) 703(make-obsolete 'compilation-parse-errors-function
745(defvar compilation-old-error-list nil) 704 'compilation-error-regexp-alist "24.1")
746 705
747(defcustom compilation-auto-jump-to-first-error nil 706(defcustom compilation-auto-jump-to-first-error nil
748 "If non-nil, automatically jump to the first error during compilation." 707 "If non-nil, automatically jump to the first error during compilation."
@@ -754,9 +713,9 @@ Faces `compilation-error-face', `compilation-warning-face',
754 "If non-nil, automatically jump to the next error encountered.") 713 "If non-nil, automatically jump to the next error encountered.")
755(make-variable-buffer-local 'compilation-auto-jump-to-next) 714(make-variable-buffer-local 'compilation-auto-jump-to-next)
756 715
757(defvar compilation-buffer-modtime nil 716;; (defvar compilation-buffer-modtime nil
758 "The buffer modification time, for buffers not associated with files.") 717;; "The buffer modification time, for buffers not associated with files.")
759(make-variable-buffer-local 'compilation-buffer-modtime) 718;; (make-variable-buffer-local 'compilation-buffer-modtime)
760 719
761(defvar compilation-skip-to-next-location t 720(defvar compilation-skip-to-next-location t
762 "*If non-nil, skip multiple error messages for the same source location.") 721 "*If non-nil, skip multiple error messages for the same source location.")
@@ -802,23 +761,99 @@ from a different message."
802 (and (cdr type) (match-end (cdr type)) compilation-info-face) 761 (and (cdr type) (match-end (cdr type)) compilation-info-face)
803 compilation-error-face)) 762 compilation-error-face))
804 763
764;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil)
765
766;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe
767;; LINE will be nil for a message that doesn't contain them. Then the
768;; location refers to a indented beginning of line or beginning of file.
769;; Once any location in some file has been jumped to, the list is extended to
770;; (COLUMN LINE FILE-STRUCTURE MARKER TIMESTAMP . VISITED)
771;; for all LOCs pertaining to that file.
772;; MARKER initially points to LINE and COLUMN in a buffer visiting that file.
773;; Being a marker it sticks to some text, when the buffer grows or shrinks
774;; before that point. VISITED is t if we have jumped there, else nil.
775;; FIXME-omake: TIMESTAMP was used to try and handle "incremental compilation":
776;; `omake -P' polls filesystem for changes and recompiles when a file is
777;; modified using the same *compilation* buffer. this necessitates
778;; re-parsing markers.
779
780;; (defstruct (compilation--loc
781;; (:constructor nil)
782;; (:copier nil)
783;; (:constructor compilation--make-loc
784;; (file-struct line col marker))
785;; (:conc-name compilation--loc->))
786;; col line file-struct marker timestamp visited)
787
788;; FIXME: We don't use a defstruct because of compilation-assq which looks up
789;; and creates part of the LOC (only the first cons cell containing the COL).
790
791(defmacro compilation--make-cdrloc (line file-struct marker)
792 `(list ,line ,file-struct ,marker nil))
793(defmacro compilation--loc->col (loc) `(car ,loc))
794(defmacro compilation--loc->line (loc) `(cadr ,loc))
795(defmacro compilation--loc->file-struct (loc) `(nth 2 ,loc))
796(defmacro compilation--loc->marker (loc) `(nth 3 ,loc))
797;; (defmacro compilation--loc->timestamp (loc) `(nth 4 ,loc))
798(defmacro compilation--loc->visited (loc) `(nthcdr 5 ,loc))
799
800;; FILE-STRUCTURE is a list of
801;; ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...)
802
803;; FILENAME is a string parsed from an error message. DIRECTORY is a string
804;; obtained by following directory change messages. DIRECTORY will be nil for
805;; an absolute filename. FORMATS is a list of formats to apply to FILENAME if
806;; a file of that name can't be found.
807;; The rest of the list is an alist of elements with LINE as key. The keys
808;; are either nil or line numbers. If present, nil comes first, followed by
809;; the numbers in decreasing order. The LOCs for each line are again an alist
810;; ordered the same way. Note that the whole file structure is referenced in
811;; every LOC.
812
813(defmacro compilation--make-file-struct (file-spec formats &optional loc-tree)
814 `(cons ,file-spec (cons ,formats ,loc-tree)))
815(defmacro compilation--file-struct->file-spec (fs) `(car ,fs))
816(defmacro compilation--file-struct->formats (fs) `(cadr ,fs))
817;; The FORMATS field plays the role of ANCHOR in the loc-tree.
818(defmacro compilation--file-struct->loc-tree (fs) `(cdr ,fs))
819
820;; MESSAGE is a list of (LOC TYPE END-LOC)
821
822;; TYPE is 0 for info or 1 for warning if the message matcher identified it as
823;; such, 2 otherwise (for a real error). END-LOC is a LOC pointing to the
824;; other end, if the parsed message contained a range. If the end of the
825;; range didn't specify a COLUMN, it defaults to -1, meaning end of line.
826;; These are the value of the `compilation-message' text-properties in the
827;; compilation buffer.
828
829(defstruct (compilation--message
830 (:constructor nil)
831 (:copier nil)
832 ;; (:type list) ;Old representation.
833 (:constructor compilation--make-message (loc type end-loc))
834 (:conc-name compilation--message->))
835 loc type end-loc)
836
805;; Internal function for calculating the text properties of a directory 837;; Internal function for calculating the text properties of a directory
806;; change message. The directory property is important, because it is 838;; change message. The compilation-directory property is important, because it
807;; the stack of nested enter-messages. Relative filenames on the following 839;; is the stack of nested enter-messages. Relative filenames on the following
808;; lines are relative to the top of the stack. 840;; lines are relative to the top of the stack.
809(defun compilation-directory-properties (idx leave) 841(defun compilation-directory-properties (idx leave)
810 (if leave (setq leave (match-end leave))) 842 (if leave (setq leave (match-end leave)))
811 ;; find previous stack, and push onto it, or if `leave' pop it 843 ;; find previous stack, and push onto it, or if `leave' pop it
812 (let ((dir (previous-single-property-change (point) 'directory))) 844 (let ((dir (previous-single-property-change (point) 'compilation-directory)))
813 (setq dir (if dir (or (get-text-property (1- dir) 'directory) 845 (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory)
814 (get-text-property dir 'directory)))) 846 (get-text-property dir 'compilation-directory))))
815 `(face ,(if leave 847 `(font-lock-face ,(if leave
816 compilation-leave-directory-face 848 compilation-leave-directory-face
817 compilation-enter-directory-face) 849 compilation-enter-directory-face)
818 directory ,(if leave 850 compilation-directory ,(if leave
819 (or (cdr dir) 851 (or (cdr dir)
820 '(nil)) ; nil only isn't a property-change 852 '(nil)) ; nil only isn't a property-change
821 (cons (match-string-no-properties idx) dir)) 853 (cons (match-string-no-properties idx) dir))
854 ;; Place a `compilation-message' everywhere we change text-properties
855 ;; so compilation--remove-properties can know what to remove.
856 compilation-message ,(compilation--make-message nil 0 nil)
822 mouse-face highlight 857 mouse-face highlight
823 keymap compilation-button-map 858 keymap compilation-button-map
824 help-echo "mouse-2: visit destination directory"))) 859 help-echo "mouse-2: visit destination directory")))
@@ -857,28 +892,29 @@ from a different message."
857;; Return a property list with all meta information on this error location. 892;; Return a property list with all meta information on this error location.
858 893
859(defun compilation-error-properties (file line end-line col end-col type fmt) 894(defun compilation-error-properties (file line end-line col end-col type fmt)
860 (unless (< (next-single-property-change (match-beginning 0) 895 (unless (text-property-not-all (match-beginning 0) (point)
861 'directory nil (point)) 896 'compilation-message nil)
862 (point))
863 (if file 897 (if file
864 (if (functionp file) 898 (when (stringp
865 (setq file (funcall file)) 899 (setq file (if (functionp file) (funcall file)
866 (let (dir) 900 (match-string-no-properties file))))
867 (setq file (match-string-no-properties file)) 901 (let ((dir
868 (unless (file-name-absolute-p file) 902 (unless (file-name-absolute-p file)
869 (setq dir (previous-single-property-change (point) 'directory) 903 (let ((pos (previous-single-property-change
870 dir (if dir (or (get-text-property (1- dir) 'directory) 904 (point) 'compilation-directory)))
871 (get-text-property dir 'directory))))) 905 (when pos
906 (or (get-text-property (1- pos) 'compilation-directory)
907 (get-text-property pos 'compilation-directory)))))))
872 (setq file (cons file (car dir))))) 908 (setq file (cons file (car dir)))))
873 ;; This message didn't mention one, get it from previous 909 ;; This message didn't mention one, get it from previous
874 (let ((prev-pos 910 (let ((prev-pos
875 ;; Find the previous message. 911 ;; Find the previous message.
876 (previous-single-property-change (point) 'message))) 912 (previous-single-property-change (point) 'compilation-message)))
877 (if prev-pos 913 (if prev-pos
878 ;; Get the file structure that belongs to it. 914 ;; Get the file structure that belongs to it.
879 (let* ((prev 915 (let* ((prev
880 (or (get-text-property (1- prev-pos) 'message) 916 (or (get-text-property (1- prev-pos) 'compilation-message)
881 (get-text-property prev-pos 'message))) 917 (get-text-property prev-pos 'compilation-message)))
882 (prev-struct 918 (prev-struct
883 (car (nth 2 (car prev))))) 919 (car (nth 2 (car prev)))))
884 ;; Construct FILE . DIR from that. 920 ;; Construct FILE . DIR from that.
@@ -917,7 +953,8 @@ from a different message."
917 (run-with-timer 0 nil 'compilation-auto-jump 953 (run-with-timer 0 nil 'compilation-auto-jump
918 (current-buffer) (match-beginning 0))) 954 (current-buffer) (match-beginning 0)))
919 955
920 (compilation-internal-error-properties file line end-line col end-col type fmt))) 956 (compilation-internal-error-properties
957 file line end-line col end-col type fmt)))
921 958
922(defun compilation-move-to-column (col screen) 959(defun compilation-move-to-column (col screen)
923 "Go to column COL on the current line. 960 "Go to column COL on the current line.
@@ -938,22 +975,25 @@ FMTS is a list of format specs for transforming the file name.
938 (let* ((file-struct (compilation-get-file-structure file fmts)) 975 (let* ((file-struct (compilation-get-file-structure file fmts))
939 ;; Get first already existing marker (if any has one, all have one). 976 ;; Get first already existing marker (if any has one, all have one).
940 ;; Do this first, as the compilation-assq`s may create new nodes. 977 ;; Do this first, as the compilation-assq`s may create new nodes.
941 (marker-line (car (cddr file-struct))) ; a line structure 978 (marker-line ; a line structure
942 (marker (nth 3 (cadr marker-line))) ; its marker 979 (cadr (compilation--file-struct->loc-tree file-struct)))
980 (marker
981 (if marker-line (compilation--loc->marker (cadr marker-line))))
943 (compilation-error-screen-columns compilation-error-screen-columns) 982 (compilation-error-screen-columns compilation-error-screen-columns)
944 end-marker loc end-loc) 983 end-marker loc end-loc)
945 (if (not (and marker (marker-buffer marker))) 984 (if (not (and marker (marker-buffer marker)))
946 (setq marker nil) ; no valid marker for this file 985 (setq marker nil) ; no valid marker for this file
947 (setq loc (or line 1)) ; normalize no linenumber to line 1 986 (setq loc (or line 1)) ; normalize no linenumber to line 1
948 (catch 'marker ; find nearest loc, at least one exists 987 (catch 'marker ; find nearest loc, at least one exists
949 (dolist (x (nthcdr 3 file-struct)) ; loop over remaining lines 988 (dolist (x (cddr (compilation--file-struct->loc-tree
989 file-struct))) ; Loop over remaining lines.
950 (if (> (car x) loc) ; still bigger 990 (if (> (car x) loc) ; still bigger
951 (setq marker-line x) 991 (setq marker-line x)
952 (if (> (- (or (car marker-line) 1) loc) 992 (if (> (- (or (car marker-line) 1) loc)
953 (- loc (car x))) ; current line is nearer 993 (- loc (car x))) ; current line is nearer
954 (setq marker-line x)) 994 (setq marker-line x))
955 (throw 'marker t)))) 995 (throw 'marker t))))
956 (setq marker (nth 3 (cadr marker-line)) 996 (setq marker (compilation--loc->marker (cadr marker-line))
957 marker-line (or (car marker-line) 1)) 997 marker-line (or (car marker-line) 1))
958 (with-current-buffer (marker-buffer marker) 998 (with-current-buffer (marker-buffer marker)
959 (save-excursion 999 (save-excursion
@@ -966,7 +1006,7 @@ FMTS is a list of format specs for transforming the file name.
966 (end-of-line) 1006 (end-of-line)
967 (compilation-move-to-column 1007 (compilation-move-to-column
968 end-col compilation-error-screen-columns)) 1008 end-col compilation-error-screen-columns))
969 (setq end-marker (list (point-marker)))) 1009 (setq end-marker (point-marker)))
970 (beginning-of-line (if end-line 1010 (beginning-of-line (if end-line
971 (- line end-line -1) 1011 (- line end-line -1)
972 (- loc marker-line -1))) 1012 (- loc marker-line -1)))
@@ -974,120 +1014,260 @@ FMTS is a list of format specs for transforming the file name.
974 (compilation-move-to-column 1014 (compilation-move-to-column
975 col compilation-error-screen-columns) 1015 col compilation-error-screen-columns)
976 (forward-to-indentation 0)) 1016 (forward-to-indentation 0))
977 (setq marker (list (point-marker))))))) 1017 (setq marker (point-marker))))))
978 1018
979 (setq loc (compilation-assq line (cdr file-struct))) 1019 (setq loc (compilation-assq line (compilation--file-struct->loc-tree
1020 file-struct)))
1021 (setq end-loc
980 (if end-line 1022 (if end-line
981 (setq end-loc (compilation-assq end-line (cdr file-struct)) 1023 (compilation-assq
982 end-loc (compilation-assq end-col end-loc)) 1024 end-col (compilation-assq
1025 end-line (compilation--file-struct->loc-tree
1026 file-struct)))
983 (if end-col ; use same line element 1027 (if end-col ; use same line element
984 (setq end-loc (compilation-assq end-col loc)))) 1028 (compilation-assq end-col loc))))
985 (setq loc (compilation-assq col loc)) 1029 (setq loc (compilation-assq col loc))
986 ;; If they are new, make the loc(s) reference the file they point to. 1030 ;; If they are new, make the loc(s) reference the file they point to.
987 (or (cdr loc) (setcdr loc `(,line ,file-struct ,@marker))) 1031 ;; FIXME-omake: there's a problem with timestamps here: the markers
1032 ;; relative to which we computed the current `marker' have a timestamp
1033 ;; almost guaranteed to be different from compilation-buffer-modtime, so if
1034 ;; we use their timestamp, we'll never use `loc' since the timestamp won't
1035 ;; match compilation-buffer-modtime, and if we use
1036 ;; compilation-buffer-modtime then we have different timestamps for
1037 ;; locations that were computed together, which doesn't make sense either.
1038 ;; I think this points to a fundamental problem in our approach to the
1039 ;; "omake -P" problem. --Stef
1040 (or (cdr loc)
1041 (setcdr loc (compilation--make-cdrloc line file-struct marker)))
988 (if end-loc 1042 (if end-loc
989 (or (cdr end-loc) 1043 (or (cdr end-loc)
990 (setcdr end-loc `(,(or end-line line) ,file-struct ,@end-marker)))) 1044 (setcdr end-loc
1045 (compilation--make-cdrloc (or end-line line) file-struct
1046 end-marker))))
991 1047
992 ;; Must start with face 1048 ;; Must start with face
993 `(face ,compilation-message-face 1049 `(font-lock-face ,compilation-message-face
994 message (,loc ,type ,end-loc) 1050 compilation-message ,(compilation--make-message loc type end-loc)
995 ,@(if compilation-debug 1051 help-echo ,(if col
996 `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords) 1052 "mouse-2: visit this file, line and column"
997 ,@(match-data)))) 1053 (if line
998 help-echo ,(if col 1054 "mouse-2: visit this file and line"
999 "mouse-2: visit this file, line and column" 1055 "mouse-2: visit this file"))
1000 (if line 1056 keymap compilation-button-map
1001 "mouse-2: visit this file and line" 1057 mouse-face highlight)))
1002 "mouse-2: visit this file")) 1058
1003 keymap compilation-button-map 1059(defun compilation--put-prop (matchnum prop val)
1004 mouse-face highlight))) 1060 (when (and (integerp matchnum) (match-beginning matchnum))
1061 (put-text-property
1062 (match-beginning matchnum) (match-end matchnum)
1063 prop val)))
1064
1065(defun compilation--remove-properties (&optional start end)
1066 (with-silent-modifications
1067 ;; When compile.el used font-lock directly, we could just remove all
1068 ;; our text-properties in one go, but now that we manually place
1069 ;; font-lock-face, we have to be careful to only remove the font-lock-face
1070 ;; we placed.
1071 ;; (remove-list-of-text-properties
1072 ;; (or start (point-min)) (or end (point-max))
1073 ;; '(compilation-debug compilation-directory compilation-message
1074 ;; font-lock-face help-echo mouse-face))
1075 (let (next)
1076 (unless start (setq start (point-min)))
1077 (unless end (setq end (point-max)))
1078 (while
1079 (progn
1080 (setq next (or (next-single-property-change
1081 start 'compilation-message nil end)
1082 end))
1083 (when (get-text-property start 'compilation-message)
1084 (remove-list-of-text-properties
1085 start next
1086 '(compilation-debug compilation-directory compilation-message
1087 font-lock-face help-echo mouse-face)))
1088 (< next end))
1089 (setq start next)))))
1090
1091(defun compilation--parse-region (start end)
1092 (goto-char end)
1093 (unless (bolp)
1094 ;; We generally don't like to parse partial lines.
1095 (assert (eobp))
1096 (when (let ((proc (get-buffer-process (current-buffer))))
1097 (and proc (memq (process-status proc) '(run open))))
1098 (setq end (line-beginning-position))))
1099 (compilation--remove-properties start end)
1100 (if compilation-parse-errors-function
1101 ;; An old package! Try the compatibility code.
1102 (progn
1103 (goto-char start)
1104 (compilation--compat-parse-errors end))
1105
1106 ;; compilation-directory-matcher is the only part that really needs to be
1107 ;; parsed sequentially. So we could split it out, handle directories
1108 ;; like syntax-propertize, and the rest as font-lock-keywords. But since
1109 ;; we want to have it work even when font-lock is off, we'd then need to
1110 ;; use our own compilation-parsed text-property to keep track of the parts
1111 ;; that have already been parsed.
1112 (goto-char start)
1113 (while (re-search-forward (car compilation-directory-matcher)
1114 end t)
1115 (when compilation-debug
1116 (font-lock-append-text-property
1117 (match-beginning 0) (match-end 0)
1118 'compilation-debug
1119 (vector 'directory compilation-directory-matcher)))
1120 (dolist (elt (cdr compilation-directory-matcher))
1121 (add-text-properties (match-beginning (car elt))
1122 (match-end (car elt))
1123 (compilation-directory-properties
1124 (car elt) (cdr elt)))))
1125
1126 (compilation-parse-errors start end)))
1127
1128(defun compilation-parse-errors (start end &rest rules)
1129 "Parse errors between START and END.
1130The errors recognized are the ones specified in RULES which default
1131to `compilation-error-regexp-alist' if RULES is nil."
1132 (message "compilation-parse-errors: %S %S" start end)
1133 (dolist (item (or rules compilation-error-regexp-alist))
1134 (if (symbolp item)
1135 (setq item (cdr (assq item
1136 compilation-error-regexp-alist-alist))))
1137 (let ((file (nth 1 item))
1138 (line (nth 2 item))
1139 (col (nth 3 item))
1140 (type (nth 4 item))
1141 (pat (car item))
1142 end-line end-col fmt
1143 props)
1144
1145 ;; omake reports some error indented, so skip the indentation.
1146 ;; another solution is to modify (some?) regexps in
1147 ;; `compilation-error-regexp-alist'.
1148 ;; note that omake usage is not limited to ocaml and C (for stubs).
1149 ;; FIXME-omake: Doing it here seems wrong, at least it should depend on
1150 ;; whether or not omake's own error messages are recognized.
1151 (cond
1152 ((not (memq 'omake compilation-error-regexp-alist)) nil)
1153 ((string-match "\\`\\([^^]\\|^\\( \\*\\|\\[\\)\\)" pat)
1154 nil) ;; Not anchored or anchored but already allows empty spaces.
1155 (t (setq pat (concat "^ *" (substring pat 1)))))
1156
1157 (if (consp file) (setq fmt (cdr file) file (car file)))
1158 (if (consp line) (setq end-line (cdr line) line (car line)))
1159 (if (consp col) (setq end-col (cdr col) col (car col)))
1160
1161 (if (functionp line)
1162 ;; The old compile.el had here an undocumented hook that
1163 ;; allowed `line' to be a function that computed the actual
1164 ;; error location. Let's do our best.
1165 (progn
1166 (goto-char start)
1167 (while (re-search-forward pat end t)
1168 (save-match-data
1169 (when compilation-debug
1170 (font-lock-append-text-property
1171 (match-beginning 0) (match-end 0)
1172 'compilation-debug (vector 'functionp item)))
1173 (add-text-properties
1174 (match-beginning 0) (match-end 0)
1175 (compilation--compat-error-properties
1176 (funcall line (cons (match-string file)
1177 (cons default-directory
1178 (nthcdr 4 item)))
1179 (if col (match-string col))))))
1180 (compilation--put-prop
1181 file 'font-lock-face compilation-error-face)))
1182
1183 (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
1184 (error "HYPERLINK should be an integer: %s" (nth 5 item)))
1185
1186 (goto-char start)
1187 (while (re-search-forward pat end t)
1188
1189 (when (setq props (compilation-error-properties
1190 file line end-line col end-col (or type 2) fmt))
1191
1192 (when (integerp file)
1193 (compilation--put-prop
1194 file 'font-lock-face
1195 (if (consp type)
1196 (compilation-face type)
1197 (symbol-value (aref [compilation-info-face
1198 compilation-warning-face
1199 compilation-error-face]
1200 (or type 2))))))
1201
1202 (compilation--put-prop
1203 line 'font-lock-face compilation-line-face)
1204 (compilation--put-prop
1205 end-line 'font-lock-face compilation-line-face)
1206
1207 (compilation--put-prop
1208 col 'font-lock-face compilation-column-face)
1209 (compilation--put-prop
1210 end-col 'font-lock-face compilation-column-face)
1211
1212 (dolist (extra-item (nthcdr 6 item))
1213 (let ((mn (pop extra-item)))
1214 (when (match-beginning mn)
1215 (let ((face (eval (car extra-item))))
1216 (cond
1217 ((null face))
1218 ((symbolp face)
1219 (put-text-property
1220 (match-beginning mn) (match-end mn)
1221 'font-lock-face face))
1222 (t
1223 (error "Don't know how to handle face %S"
1224 face)))))))
1225 (let ((mn (or (nth 5 item) 0)))
1226 (when compilation-debug
1227 (font-lock-append-text-property
1228 (match-beginning 0) (match-end 0)
1229 'compilation-debug (vector 'std item props)))
1230 (add-text-properties
1231 (match-beginning mn) (match-end mn)
1232 (cddr props))
1233 (font-lock-append-text-property
1234 (match-beginning mn) (match-end mn)
1235 'font-lock-face (cadr props)))))))))
1236
1237(defvar compilation--parsed -1)
1238(make-variable-buffer-local 'compilation--parsed)
1239
1240(defun compilation--ensure-parse (limit)
1241 "Make sure the text has been parsed up to LIMIT."
1242 (save-excursion
1243 (goto-char limit)
1244 (setq limit (line-beginning-position 2))
1245 (unless (markerp compilation--parsed)
1246 ;; We use a marker for compilation--parsed so that users (such as
1247 ;; grep.el) don't need to flush-parse when they modify the buffer
1248 ;; in a way that impacts buffer positions but does not require
1249 ;; re-parsing.
1250 (setq compilation--parsed (point-min-marker)))
1251 (when (< compilation--parsed limit)
1252 (let ((start (max compilation--parsed (point-min))))
1253 (move-marker compilation--parsed limit)
1254 (goto-char start)
1255 (forward-line 0) ;Not line-beginning-position: ignore (comint) fields.
1256 (with-silent-modifications
1257 (compilation--parse-region (point) compilation--parsed)))))
1258 nil)
1259
1260(defun compilation--flush-parse (start end)
1261 "Mark the region between START and END for re-parsing."
1262 (message "compilation--flush-parse: %S %S" start end)
1263 (if (markerp compilation--parsed)
1264 (move-marker compilation--parsed (min start compilation--parsed))))
1005 1265
1006(defun compilation-mode-font-lock-keywords () 1266(defun compilation-mode-font-lock-keywords ()
1007 "Return expressions to highlight in Compilation mode." 1267 "Return expressions to highlight in Compilation mode."
1008 (if compilation-parse-errors-function 1268 (append
1009 ;; An old package! Try the compatibility code. 1269 '((compilation--ensure-parse))
1010 '((compilation-compat-parse-errors)) 1270 compilation-mode-font-lock-keywords))
1011 (append
1012 ;; make directory tracking
1013 (if compilation-directory-matcher
1014 `((,(car compilation-directory-matcher)
1015 ,@(mapcar (lambda (elt)
1016 `(,(car elt)
1017 (compilation-directory-properties
1018 ,(car elt) ,(cdr elt))
1019 t t))
1020 (cdr compilation-directory-matcher)))))
1021
1022 ;; Compiler warning/error lines.
1023 (mapcar
1024 (lambda (item)
1025 (if (symbolp item)
1026 (setq item (cdr (assq item
1027 compilation-error-regexp-alist-alist))))
1028 (let ((file (nth 1 item))
1029 (line (nth 2 item))
1030 (col (nth 3 item))
1031 (type (nth 4 item))
1032 (pat (car item))
1033 end-line end-col fmt)
1034 ;; omake reports some error indented, so skip the indentation.
1035 ;; another solution is to modify (some?) regexps in
1036 ;; `compilation-error-regexp-alist'.
1037 ;; note that omake usage is not limited to ocaml and C (for stubs).
1038 (when (and (= ?^ (aref pat 0)) ; anchored: starts with "^"
1039 ;; but does not allow an arbitrary number of leading spaces
1040 (not (and (= ? (aref pat 1)) (= ?* (aref pat 2)))))
1041 (setq pat (concat "^ *" (substring pat 1))))
1042 (if (consp file) (setq fmt (cdr file) file (car file)))
1043 (if (consp line) (setq end-line (cdr line) line (car line)))
1044 (if (consp col) (setq end-col (cdr col) col (car col)))
1045
1046 (if (functionp line)
1047 ;; The old compile.el had here an undocumented hook that
1048 ;; allowed `line' to be a function that computed the actual
1049 ;; error location. Let's do our best.
1050 `(,pat
1051 (0 (save-match-data
1052 (compilation-compat-error-properties
1053 (funcall ',line (cons (match-string ,file)
1054 (cons default-directory
1055 ',(nthcdr 4 item)))
1056 ,(if col `(match-string ,col))))))
1057 (,file compilation-error-face t))
1058
1059 (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
1060 (error "HYPERLINK should be an integer: %s" (nth 5 item)))
1061
1062 `(,pat
1063
1064 ,@(when (integerp file)
1065 `((,file ,(if (consp type)
1066 `(compilation-face ',type)
1067 (aref [compilation-info-face
1068 compilation-warning-face
1069 compilation-error-face]
1070 (or type 2))))))
1071
1072 ,@(when line
1073 `((,line compilation-line-face nil t)))
1074 ,@(when end-line
1075 `((,end-line compilation-line-face nil t)))
1076
1077 ,@(when (integerp col)
1078 `((,col compilation-column-face nil t)))
1079 ,@(when (integerp end-col)
1080 `((,end-col compilation-column-face nil t)))
1081
1082 ,@(nthcdr 6 item)
1083 (,(or (nth 5 item) 0)
1084 (compilation-error-properties ',file ,line ,end-line
1085 ,col ,end-col ',(or type 2)
1086 ',fmt)
1087 append))))) ; for compilation-message-face
1088 compilation-error-regexp-alist)
1089
1090 compilation-mode-font-lock-keywords)))
1091 1271
1092(defun compilation-read-command (command) 1272(defun compilation-read-command (command)
1093 (read-shell-command "Compile command: " command 1273 (read-shell-command "Compile command: " command
@@ -1383,7 +1563,7 @@ Returns the compilation buffer created."
1383 ;; Insert the output at the end, after the initial text, 1563 ;; Insert the output at the end, after the initial text,
1384 ;; regardless of where the user sees point. 1564 ;; regardless of where the user sees point.
1385 (goto-char (point-max)) 1565 (goto-char (point-max))
1386 (let* ((buffer-read-only nil) ; call-process needs to modify outbuf 1566 (let* ((inhibit-read-only t) ; call-process needs to modify outbuf
1387 (status (call-process shell-file-name nil outbuf nil "-c" 1567 (status (call-process shell-file-name nil outbuf nil "-c"
1388 command))) 1568 command)))
1389 (cond ((numberp status) 1569 (cond ((numberp status)
@@ -1397,10 +1577,6 @@ Returns the compilation buffer created."
1397 (concat status "\n"))) 1577 (concat status "\n")))
1398 (t 1578 (t
1399 (compilation-handle-exit 'bizarre status status))))) 1579 (compilation-handle-exit 'bizarre status status)))))
1400 ;; Without async subprocesses, the buffer is not yet
1401 ;; fontified, so fontify it now.
1402 (let ((font-lock-verbose nil)) ; shut up font-lock messages
1403 (font-lock-fontify-buffer))
1404 (set-buffer-modified-p nil) 1580 (set-buffer-modified-p nil)
1405 (message "Executing `%s'...done" command))) 1581 (message "Executing `%s'...done" command)))
1406 ;; Now finally cd to where the shell started make/grep/... 1582 ;; Now finally cd to where the shell started make/grep/...
@@ -1611,7 +1787,7 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
1611 mode-name (or name-of-mode "Compilation")) 1787 mode-name (or name-of-mode "Compilation"))
1612 (set (make-local-variable 'page-delimiter) 1788 (set (make-local-variable 'page-delimiter)
1613 compilation-page-delimiter) 1789 compilation-page-delimiter)
1614 (set (make-local-variable 'compilation-buffer-modtime) nil) 1790 ;; (set (make-local-variable 'compilation-buffer-modtime) nil)
1615 (compilation-setup) 1791 (compilation-setup)
1616 (setq buffer-read-only t) 1792 (setq buffer-read-only t)
1617 (run-mode-hooks 'compilation-mode-hook)) 1793 (run-mode-hooks 'compilation-mode-hook))
@@ -1632,6 +1808,7 @@ by replacing the first word, e.g `compilation-scroll-output' from
1632 (symbol-name v))))) 1808 (symbol-name v)))))
1633 (and (cdr v) 1809 (and (cdr v)
1634 (or (boundp (cdr v)) 1810 (or (boundp (cdr v))
1811 ;; FIXME: This is hackish, using undocumented info.
1635 (if (boundp 'byte-compile-bound-variables) 1812 (if (boundp 'byte-compile-bound-variables)
1636 (memq (cdr v) byte-compile-bound-variables))) 1813 (memq (cdr v) byte-compile-bound-variables)))
1637 `(set (make-local-variable ',(car v)) ,(cdr v)))) 1814 `(set (make-local-variable ',(car v)) ,(cdr v))))
@@ -1669,9 +1846,6 @@ The global commands next/previous/first-error/goto-error use this.")
1669 "Buffer position of the beginning of the compilation messages. 1846 "Buffer position of the beginning of the compilation messages.
1670If nil, use the beginning of buffer.") 1847If nil, use the beginning of buffer.")
1671 1848
1672;; A function name can't be a hook, must be something with a value.
1673(defconst compilation-turn-on-font-lock 'turn-on-font-lock)
1674
1675(defun compilation-setup (&optional minor) 1849(defun compilation-setup (&optional minor)
1676 "Prepare the buffer for the compilation parsing commands to work. 1850 "Prepare the buffer for the compilation parsing commands to work.
1677Optional argument MINOR indicates this is called from 1851Optional argument MINOR indicates this is called from
@@ -1690,26 +1864,29 @@ Optional argument MINOR indicates this is called from
1690 (setq next-error-function 'compilation-next-error-function) 1864 (setq next-error-function 'compilation-next-error-function)
1691 (set (make-local-variable 'comint-file-name-prefix) 1865 (set (make-local-variable 'comint-file-name-prefix)
1692 (or (file-remote-p default-directory) "")) 1866 (or (file-remote-p default-directory) ""))
1693 (set (make-local-variable 'font-lock-extra-managed-props)
1694 '(directory message help-echo mouse-face debug))
1695 (set (make-local-variable 'compilation-locs) 1867 (set (make-local-variable 'compilation-locs)
1696 (make-hash-table :test 'equal :weakness 'value)) 1868 (make-hash-table :test 'equal :weakness 'value))
1697 ;; lazy-lock would never find the message unless it's scrolled to. 1869 ;; It's generally preferable to use after-change-functions since they
1698 ;; jit-lock might fontify some things too late. 1870 ;; can be subject to combine-after-change-calls, but if we do that, we risk
1699 (set (make-local-variable 'font-lock-support-mode) nil) 1871 ;; running our hook after font-lock, resulting in incorrect refontification.
1700 (set (make-local-variable 'font-lock-maximum-size) nil) 1872 (add-hook 'before-change-functions 'compilation--flush-parse nil t)
1873 ;; Also for minor mode, since it's not permanent-local.
1874 (add-hook 'change-major-mode-hook #'compilation--remove-properties nil t)
1701 (if minor 1875 (if minor
1702 (let ((fld font-lock-defaults)) 1876 (progn
1703 (font-lock-add-keywords nil (compilation-mode-font-lock-keywords)) 1877 (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
1704 (if font-lock-mode 1878 (if font-lock-mode
1705 (if fld 1879 (font-lock-fontify-buffer)))
1706 (font-lock-fontify-buffer) 1880 (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))))
1707 (font-lock-change-mode) 1881
1708 (turn-on-font-lock)) 1882(defun compilation--unsetup ()
1709 (turn-on-font-lock))) 1883 ;; Only for minor mode.
1710 (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)) 1884 (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
1711 ;; maybe defer font-lock till after derived mode is set up 1885 (remove-hook 'before-change-functions 'compilation--flush-parse t)
1712 (run-mode-hooks 'compilation-turn-on-font-lock))) 1886 (kill-local-variable 'compilation--parsed)
1887 (compilation--remove-properties)
1888 (if font-lock-mode
1889 (font-lock-fontify-buffer)))
1713 1890
1714;;;###autoload 1891;;;###autoload
1715(define-minor-mode compilation-shell-minor-mode 1892(define-minor-mode compilation-shell-minor-mode
@@ -1723,8 +1900,7 @@ Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'."
1723 :group 'compilation 1900 :group 'compilation
1724 (if compilation-shell-minor-mode 1901 (if compilation-shell-minor-mode
1725 (compilation-setup t) 1902 (compilation-setup t)
1726 (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords)) 1903 (compilation--unsetup)))
1727 (font-lock-fontify-buffer)))
1728 1904
1729;;;###autoload 1905;;;###autoload
1730(define-minor-mode compilation-minor-mode 1906(define-minor-mode compilation-minor-mode
@@ -1737,8 +1913,7 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
1737 :group 'compilation 1913 :group 'compilation
1738 (if compilation-minor-mode 1914 (if compilation-minor-mode
1739 (compilation-setup t) 1915 (compilation-setup t)
1740 (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords)) 1916 (compilation--unsetup)))
1741 (font-lock-fontify-buffer)))
1742 1917
1743(defun compilation-handle-exit (process-status exit-status msg) 1918(defun compilation-handle-exit (process-status exit-status msg)
1744 "Write MSG in the current buffer and hack its `mode-line-process'." 1919 "Write MSG in the current buffer and hack its `mode-line-process'."
@@ -1766,7 +1941,8 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
1766 (setq mode-line-process 1941 (setq mode-line-process
1767 (let ((out-string (format ":%s [%s]" process-status (cdr status))) 1942 (let ((out-string (format ":%s [%s]" process-status (cdr status)))
1768 (msg (format "%s %s" mode-name 1943 (msg (format "%s %s" mode-name
1769 (replace-regexp-in-string "\n?$" "" (car status))))) 1944 (replace-regexp-in-string "\n?$" ""
1945 (car status)))))
1770 (message "%s" msg) 1946 (message "%s" msg)
1771 (propertize out-string 1947 (propertize out-string
1772 'help-echo msg 'face (if (> exit-status 0) 1948 'help-echo msg 'face (if (> exit-status 0)
@@ -1811,13 +1987,13 @@ and runs `compilation-filter-hook'."
1811 (let ((inhibit-read-only t) 1987 (let ((inhibit-read-only t)
1812 ;; `save-excursion' doesn't use the right insertion-type for us. 1988 ;; `save-excursion' doesn't use the right insertion-type for us.
1813 (pos (copy-marker (point) t)) 1989 (pos (copy-marker (point) t))
1990 ;; `save-restriction' doesn't use the right insertion type either:
1991 ;; If we are inserting at the end of the accessible part of the
1992 ;; buffer, keep the inserted text visible.
1814 (min (point-min-marker)) 1993 (min (point-min-marker))
1815 (max (point-max-marker))) 1994 (max (copy-marker (point-max) t)))
1816 (unwind-protect 1995 (unwind-protect
1817 (progn 1996 (progn
1818 ;; If we are inserting at the end of the accessible part
1819 ;; of the buffer, keep the inserted text visible.
1820 (set-marker-insertion-type max t)
1821 (widen) 1997 (widen)
1822 (goto-char (process-mark proc)) 1998 (goto-char (process-mark proc))
1823 ;; We used to use `insert-before-markers', so that windows with 1999 ;; We used to use `insert-before-markers', so that windows with
@@ -1827,10 +2003,12 @@ and runs `compilation-filter-hook'."
1827 (unless comint-inhibit-carriage-motion 2003 (unless comint-inhibit-carriage-motion
1828 (comint-carriage-motion (process-mark proc) (point))) 2004 (comint-carriage-motion (process-mark proc) (point)))
1829 (set-marker (process-mark proc) (point)) 2005 (set-marker (process-mark proc) (point))
1830 (set (make-local-variable 'compilation-buffer-modtime) (current-time)) 2006 ;; (set (make-local-variable 'compilation-buffer-modtime)
2007 ;; (current-time))
1831 (run-hooks 'compilation-filter-hook)) 2008 (run-hooks 'compilation-filter-hook))
1832 (goto-char pos) 2009 (goto-char pos)
1833 (narrow-to-region min max) 2010 (narrow-to-region min max)
2011 (set-marker pos nil)
1834 (set-marker min nil) 2012 (set-marker min nil)
1835 (set-marker max nil)))))) 2013 (set-marker max nil))))))
1836 2014
@@ -1849,31 +2027,50 @@ and runs `compilation-filter-hook'."
1849 `(let (opt) 2027 `(let (opt)
1850 (while (,< n 0) 2028 (while (,< n 0)
1851 (setq opt pt) 2029 (setq opt pt)
1852 (or (setq pt (,property-change pt 'message)) 2030 (or (setq pt (,property-change pt 'compilation-message))
1853 ;; Handle the case where where the first error message is 2031 ;; Handle the case where where the first error message is
1854 ;; at the start of the buffer, and n < 0. 2032 ;; at the start of the buffer, and n < 0.
1855 (if (or (eq (get-text-property ,limit 'message) 2033 (if (or (eq (get-text-property ,limit 'compilation-message)
1856 (get-text-property opt 'message)) 2034 (get-text-property opt 'compilation-message))
1857 (eq pt opt)) 2035 (eq pt opt))
1858 (error ,error compilation-error) 2036 (error ,error compilation-error)
1859 (setq pt ,limit))) 2037 (setq pt ,limit)))
1860 ;; prop 'message usually has 2 changes, on and off, so 2038 ;; prop 'compilation-message usually has 2 changes, on and off, so
1861 ;; re-search if off 2039 ;; re-search if off
1862 (or (setq msg (get-text-property pt 'message)) 2040 (or (setq msg (get-text-property pt 'compilation-message))
1863 (if (setq pt (,property-change pt 'message nil ,limit)) 2041 (if (setq pt (,property-change pt 'compilation-message nil ,limit))
1864 (setq msg (get-text-property pt 'message))) 2042 (setq msg (get-text-property pt 'compilation-message)))
1865 (error ,error compilation-error)) 2043 (error ,error compilation-error))
1866 (or (< (cadr msg) compilation-skip-threshold) 2044 (or (< (compilation--message->type msg) compilation-skip-threshold)
1867 (if different-file 2045 (if different-file
1868 (eq (prog1 last (setq last (nth 2 (car msg)))) 2046 (eq (prog1 last
2047 (setq last (compilation--loc->file-struct
2048 (compilation--message->loc msg))))
1869 last)) 2049 last))
1870 (if compilation-skip-visited 2050 (if compilation-skip-visited
1871 (nthcdr 5 (car msg))) 2051 (compilation--loc->visited (compilation--message->loc msg)))
1872 (if compilation-skip-to-next-location 2052 (if compilation-skip-to-next-location
1873 (eq (car msg) loc)) 2053 (eq (compilation--message->loc msg) loc))
1874 ;; count this message only if none of the above are true 2054 ;; count this message only if none of the above are true
1875 (setq n (,1+ n)))))) 2055 (setq n (,1+ n))))))
1876 2056
2057(defun compilation-next-single-property-change (position prop
2058 &optional object limit)
2059 (let (parsed res)
2060 (while (progn
2061 ;; We parse the buffer here "on-demand" by chunks of 500 chars.
2062 ;; But we could also just parse the whole buffer.
2063 (compilation--ensure-parse
2064 (setq parsed (max compilation--parsed
2065 (min (+ position 500)
2066 (or limit (point-max))))))
2067 (and (or (not (setq res (next-single-property-change
2068 position prop object limit)))
2069 (eq res limit))
2070 (< position (or limit (point-max)))))
2071 (setq position parsed))
2072 res))
2073
1877(defun compilation-next-error (n &optional different-file pt) 2074(defun compilation-next-error (n &optional different-file pt)
1878 "Move point to the next error in the compilation buffer. 2075 "Move point to the next error in the compilation buffer.
1879This function does NOT find the source line like \\[next-error]. 2076This function does NOT find the source line like \\[next-error].
@@ -1887,31 +2084,35 @@ looking for the next message."
1887 (or (compilation-buffer-p (current-buffer)) 2084 (or (compilation-buffer-p (current-buffer))
1888 (error "Not in a compilation buffer")) 2085 (error "Not in a compilation buffer"))
1889 (or pt (setq pt (point))) 2086 (or pt (setq pt (point)))
1890 (let* ((msg (get-text-property pt 'message)) 2087 (let* ((msg (get-text-property pt 'compilation-message))
1891 ;; `loc' is used by the compilation-loop macro. 2088 ;; `loc', `msg', and `last' are used by the compilation-loop macro.
1892 (loc (car msg)) 2089 (loc (compilation--message->loc msg))
1893 last) 2090 last)
1894 (if (zerop n) 2091 (if (zerop n)
1895 (unless (or msg ; find message near here 2092 (unless (or msg ; find message near here
1896 (setq msg (get-text-property (max (1- pt) (point-min)) 2093 (setq msg (get-text-property (max (1- pt) (point-min))
1897 'message))) 2094 'compilation-message)))
1898 (setq pt (previous-single-property-change pt 'message nil 2095 (setq pt (previous-single-property-change pt 'compilation-message nil
1899 (line-beginning-position))) 2096 (line-beginning-position)))
1900 (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'message)) 2097 (unless (setq msg (get-text-property (max (1- pt) (point-min))
1901 (setq pt (next-single-property-change pt 'message nil 2098 'compilation-message))
2099 (setq pt (next-single-property-change pt 'compilation-message nil
1902 (line-end-position))) 2100 (line-end-position)))
1903 (or (setq msg (get-text-property pt 'message)) 2101 (or (setq msg (get-text-property pt 'compilation-message))
1904 (setq pt (point))))) 2102 (setq pt (point)))))
1905 (setq last (nth 2 (car msg))) 2103 (setq last (compilation--loc->file-struct
2104 (compilation--message->loc msg)))
1906 (if (>= n 0) 2105 (if (>= n 0)
1907 (compilation-loop > next-single-property-change 1- 2106 (compilation-loop > compilation-next-single-property-change 1-
1908 (if (get-buffer-process (current-buffer)) 2107 (if (get-buffer-process (current-buffer))
1909 "No more %ss yet" 2108 "No more %ss yet"
1910 "Moved past last %s") 2109 "Moved past last %s")
1911 (point-max)) 2110 (point-max))
2111 (compilation--ensure-parse pt)
1912 ;; Don't move "back" to message at or before point. 2112 ;; Don't move "back" to message at or before point.
1913 ;; Pass an explicit (point-min) to make sure pt is non-nil. 2113 ;; Pass an explicit (point-min) to make sure pt is non-nil.
1914 (setq pt (previous-single-property-change pt 'message nil (point-min))) 2114 (setq pt (previous-single-property-change
2115 pt 'compilation-message nil (point-min)))
1915 (compilation-loop < previous-single-property-change 1+ 2116 (compilation-loop < previous-single-property-change 1+
1916 "Moved back before first %s" (point-min)))) 2117 "Moved back before first %s" (point-min))))
1917 (goto-char pt) 2118 (goto-char pt)
@@ -1955,12 +2156,16 @@ Use this command in a compilation log buffer. Sets the mark at point there."
1955 (if event (posn-set-point (event-end event))) 2156 (if event (posn-set-point (event-end event)))
1956 (or (compilation-buffer-p (current-buffer)) 2157 (or (compilation-buffer-p (current-buffer))
1957 (error "Not in a compilation buffer")) 2158 (error "Not in a compilation buffer"))
1958 (if (get-text-property (point) 'directory) 2159 (compilation--ensure-parse (point))
1959 (dired-other-window (car (get-text-property (point) 'directory))) 2160 (if (get-text-property (point) 'compilation-directory)
2161 (dired-other-window
2162 (car (get-text-property (point) 'compilation-directory)))
1960 (push-mark) 2163 (push-mark)
1961 (setq compilation-current-error (point)) 2164 (setq compilation-current-error (point))
1962 (next-error-internal))) 2165 (next-error-internal)))
1963 2166
2167;; This is mostly unused, but we keep it for the sake of some external
2168;; packages which seem to make use of it.
1964(defun compilation-find-buffer (&optional avoid-current) 2169(defun compilation-find-buffer (&optional avoid-current)
1965 "Return a compilation buffer. 2170 "Return a compilation buffer.
1966If AVOID-CURRENT is nil, and the current buffer is a compilation buffer, 2171If AVOID-CURRENT is nil, and the current buffer is a compilation buffer,
@@ -1979,53 +2184,65 @@ This is the value of `next-error-function' in Compilation buffers."
1979 (setq compilation-current-error nil)) 2184 (setq compilation-current-error nil))
1980 (let* ((columns compilation-error-screen-columns) ; buffer's local value 2185 (let* ((columns compilation-error-screen-columns) ; buffer's local value
1981 (last 1) timestamp 2186 (last 1) timestamp
1982 (loc (compilation-next-error (or n 1) nil 2187 (msg (compilation-next-error (or n 1) nil
1983 (or compilation-current-error 2188 (or compilation-current-error
1984 compilation-messages-start 2189 compilation-messages-start
1985 (point-min)))) 2190 (point-min))))
1986 (end-loc (nth 2 loc)) 2191 (loc (compilation--message->loc msg))
2192 (end-loc (compilation--message->end-loc msg))
1987 (marker (point-marker))) 2193 (marker (point-marker)))
1988 (setq compilation-current-error (point-marker) 2194 (setq compilation-current-error (point-marker)
1989 overlay-arrow-position 2195 overlay-arrow-position
1990 (if (bolp) 2196 (if (bolp)
1991 compilation-current-error 2197 compilation-current-error
1992 (copy-marker (line-beginning-position))) 2198 (copy-marker (line-beginning-position))))
1993 loc (car loc))
1994 ;; If loc contains no marker, no error in that file has been visited. 2199 ;; If loc contains no marker, no error in that file has been visited.
1995 ;; If the marker is invalid the buffer has been killed. 2200 ;; If the marker is invalid the buffer has been killed.
1996 ;; If the file is newer than the timestamp, it has been modified
1997 ;; (`omake -P' polls filesystem for changes and recompiles when needed
1998 ;; in the same process and buffer).
1999 ;; So, recalculate all markers for that file. 2201 ;; So, recalculate all markers for that file.
2000 (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)) (nthcdr 4 loc) 2202 (unless (and (compilation--loc->marker loc)
2001 ;; There may be no timestamp info if the loc is a `fake-loc', 2203 (marker-buffer (compilation--loc->marker loc))
2002 ;; but we just checked that the file has been visited before! 2204 ;; FIXME-omake: For "omake -P", which automatically recompiles
2003 (equal (nth 4 loc) 2205 ;; when the file is modified, the line numbers of new output
2004 (setq timestamp compilation-buffer-modtime))) 2206 ;; may not be related to line numbers from earlier output
2005 (with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) 2207 ;; (earlier markers), so we used to try to detect it here and
2006 (cadr (car (nth 2 loc)))) 2208 ;; force a reparse. But that caused more problems elsewhere,
2209 ;; so instead we now flush the file-structure when we see
2210 ;; omake's message telling it's about to recompile a file.
2211 ;; (or (null (compilation--loc->timestamp loc)) ;A fake-loc
2212 ;; (equal (compilation--loc->timestamp loc)
2213 ;; (setq timestamp compilation-buffer-modtime)))
2214 )
2215 (with-current-buffer
2216 (compilation-find-file
2217 marker
2218 (caar (compilation--loc->file-struct loc))
2219 (cadr (car (compilation--loc->file-struct loc))))
2007 (save-restriction 2220 (save-restriction
2008 (widen) 2221 (widen)
2009 (goto-char (point-min)) 2222 (goto-char (point-min))
2010 ;; Treat file's found lines in forward order, 1 by 1. 2223 ;; Treat file's found lines in forward order, 1 by 1.
2011 (dolist (line (reverse (cddr (nth 2 loc)))) 2224 (dolist (line (reverse (cddr (compilation--loc->file-struct loc))))
2012 (when (car line) ; else this is a filename w/o a line# 2225 (when (car line) ; else this is a filename w/o a line#
2013 (beginning-of-line (- (car line) last -1)) 2226 (beginning-of-line (- (car line) last -1))
2014 (setq last (car line))) 2227 (setq last (car line)))
2015 ;; Treat line's found columns and store/update a marker for each. 2228 ;; Treat line's found columns and store/update a marker for each.
2016 (dolist (col (cdr line)) 2229 (dolist (col (cdr line))
2017 (if (car col) 2230 (if (compilation--loc->col col)
2018 (if (eq (car col) -1) ; special case for range end 2231 (if (eq (compilation--loc->col col) -1)
2232 ;; Special case for range end.
2019 (end-of-line) 2233 (end-of-line)
2020 (compilation-move-to-column (car col) columns)) 2234 (compilation-move-to-column (compilation--loc->col col)
2235 columns))
2021 (beginning-of-line) 2236 (beginning-of-line)
2022 (skip-chars-forward " \t")) 2237 (skip-chars-forward " \t"))
2023 (if (nth 3 col) 2238 (if (compilation--loc->marker col)
2024 (set-marker (nth 3 col) (point)) 2239 (set-marker (compilation--loc->marker col) (point))
2025 (setcdr (nthcdr 2 col) `(,(point-marker))))))))) 2240 (setf (compilation--loc->marker col) (point-marker)))
2026 (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc)) 2241 ;; (setf (compilation--loc->timestamp col) timestamp)
2027 (setcdr (nthcdr 3 loc) (list timestamp)) 2242 )))))
2028 (setcdr (nthcdr 4 loc) t))) ; Set this one as visited. 2243 (compilation-goto-locus marker (compilation--loc->marker loc)
2244 (compilation--loc->marker end-loc))
2245 (setf (compilation--loc->visited loc) t)))
2029 2246
2030(defvar compilation-gcpro nil 2247(defvar compilation-gcpro nil
2031 "Internal variable used to keep some values from being GC'd.") 2248 "Internal variable used to keep some values from being GC'd.")
@@ -2036,8 +2253,8 @@ This is the value of `next-error-function' in Compilation buffers."
2036FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME). 2253FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
2037This is useful when you compile temporary files, but want 2254This is useful when you compile temporary files, but want
2038automatic translation of the messages to the real buffer from 2255automatic translation of the messages to the real buffer from
2039which the temporary file came. This only works if done before a 2256which the temporary file came. This may also affect previous messages
2040message about FILE appears! 2257about FILE.
2041 2258
2042Optional args LINE and COL default to 1 and beginning of 2259Optional args LINE and COL default to 1 and beginning of
2043indentation respectively. The marker is expected to reflect 2260indentation respectively. The marker is expected to reflect
@@ -2049,18 +2266,19 @@ header with variable assignments and a code region), you must
2049call this several times, once each for the last line of one 2266call this several times, once each for the last line of one
2050region and the first line of the next region." 2267region and the first line of the next region."
2051 (or (consp file) (setq file (list file))) 2268 (or (consp file) (setq file (list file)))
2052 (setq file (compilation-get-file-structure file)) 2269 (compilation--flush-file-structure file)
2053 ;; Between the current call to compilation-fake-loc and the first occurrence 2270 (let ((fs (compilation-get-file-structure file)))
2054 ;; of an error message referring to `file', the data is only kept in the 2271 ;; Between the current call to compilation-fake-loc and the first
2055 ;; weak hash-table compilation-locs, so we need to prevent this entry 2272 ;; occurrence of an error message referring to `file', the data is
2056 ;; in compilation-locs from being GC'd away. --Stef 2273 ;; only kept in the weak hash-table compilation-locs, so we need
2057 (push file compilation-gcpro) 2274 ;; to prevent this entry in compilation-locs from being GC'd
2058 (let ((loc (compilation-assq (or line 1) (cdr file)))) 2275 ;; away. --Stef
2059 (setq loc (compilation-assq col loc)) 2276 (push fs compilation-gcpro)
2060 (if (cdr loc) 2277 (let ((loc (compilation-assq (or line 1) (cdr fs))))
2061 (setcdr (cddr loc) (list marker)) 2278 (setq loc (compilation-assq col loc))
2062 (setcdr loc (list line file marker))) 2279 (assert (null (cdr loc)))
2063 loc)) 2280 (setcdr loc (compilation--make-cdrloc line fs marker))
2281 loc)))
2064 2282
2065(defcustom compilation-context-lines nil 2283(defcustom compilation-context-lines nil
2066 "Display this many lines of leading context before the current message. 2284 "Display this many lines of leading context before the current message.
@@ -2278,7 +2496,7 @@ FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
2278In the former case, FILENAME may be relative or absolute. 2496In the former case, FILENAME may be relative or absolute.
2279 2497
2280The file-structure looks like this: 2498The file-structure looks like this:
2281 (list (list FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)" 2499 ((FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)"
2282 (or (gethash file compilation-locs) 2500 (or (gethash file compilation-locs)
2283 ;; File was not previously encountered, at least not in the form passed. 2501 ;; File was not previously encountered, at least not in the form passed.
2284 ;; Let's normalize it and look again. 2502 ;; Let's normalize it and look again.
@@ -2323,25 +2541,41 @@ The file-structure looks like this:
2323 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html 2541 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html
2324 (or (gethash (cons filename spec-directory) compilation-locs) 2542 (or (gethash (cons filename spec-directory) compilation-locs)
2325 (puthash (cons filename spec-directory) 2543 (puthash (cons filename spec-directory)
2326 (list (list filename spec-directory) fmt) 2544 (compilation--make-file-struct
2545 (list filename spec-directory) fmt)
2327 compilation-locs)) 2546 compilation-locs))
2328 compilation-locs)))) 2547 compilation-locs))))
2329 2548
2330(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$") 2549(defun compilation--flush-file-structure (file)
2550 (or (consp file) (setq file (list file)))
2551 (let ((fs (compilation-get-file-structure file)))
2552 (assert (eq fs (gethash file compilation-locs)))
2553 (assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
2554 compilation-locs)))
2555 (maphash (lambda (k v)
2556 (if (eq v fs) (remhash k compilation-locs)))
2557 compilation-locs)))
2558
2559(add-to-list 'debug-ignored-errors "\\`No more [-a-z ]+s yet\\'")
2560(add-to-list 'debug-ignored-errors "\\`Moved past last .*")
2331 2561
2332;;; Compatibility with the old compile.el. 2562;;; Compatibility with the old compile.el.
2333 2563
2334(defun compile-buffer-substring (n) (if n (match-string n))) 2564(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
2565(defvar compilation-parsing-end (make-marker))
2566(defvar compilation-error-list nil)
2567(defvar compilation-old-error-list nil)
2335 2568
2336(defun compilation-compat-error-properties (err) 2569(defun compilation--compat-error-properties (err)
2337 "Map old-style error ERR to new-style message." 2570 "Map old-style error ERR to new-style message."
2338 ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or 2571 ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or
2339 ;; (MARKER . MARKER). 2572 ;; (MARKER . MARKER).
2340 (let ((dst (cdr err))) 2573 (let ((dst (cdr err)))
2341 (if (markerp dst) 2574 (if (markerp dst)
2342 ;; Must start with a face, for font-lock. 2575 `(compilation-message ,(compilation--make-message
2343 `(face nil 2576 (cons nil (compilation--make-cdrloc
2344 message ,(list (list nil nil nil dst) 2) 2577 nil nil dst))
2578 2 nil)
2345 help-echo "mouse-2: visit the source location" 2579 help-echo "mouse-2: visit the source location"
2346 keymap compilation-button-map 2580 keymap compilation-button-map
2347 mouse-face highlight) 2581 mouse-face highlight)
@@ -2355,19 +2589,19 @@ The file-structure looks like this:
2355 (compilation-internal-error-properties 2589 (compilation-internal-error-properties
2356 (cons filename dirname) line nil col nil 2 fmt))))) 2590 (cons filename dirname) line nil col nil 2 fmt)))))
2357 2591
2358(defun compilation-compat-parse-errors (limit) 2592(defun compilation--compat-parse-errors (limit)
2359 (when compilation-parse-errors-function 2593 (when compilation-parse-errors-function
2360 ;; FIXME: We should remove the rest of the compilation keywords 2594 ;; FIXME: We should remove the rest of the compilation keywords
2361 ;; but we can't do that from here because font-lock is using 2595 ;; but we can't do that from here because font-lock is using
2362 ;; the value right now. --stef 2596 ;; the value right now. --Stef
2363 (save-excursion 2597 (save-excursion
2364 (setq compilation-error-list nil) 2598 (setq compilation-error-list nil)
2365 ;; Reset compilation-parsing-end each time because font-lock 2599 ;; Reset compilation-parsing-end each time because font-lock
2366 ;; might force us the re-parse many times (typically because 2600 ;; might force us the re-parse many times (typically because
2367 ;; some code adds some text-property to the output that we 2601 ;; some code adds some text-property to the output that we
2368 ;; already parsed). You might say "why reparse", well: 2602 ;; already parsed). You might say "why reparse", well:
2369 ;; because font-lock has just removed the `message' property so 2603 ;; because font-lock has just removed the `compilation-message' property
2370 ;; have to do it all over again. 2604 ;; so have to do it all over again.
2371 (if compilation-parsing-end 2605 (if compilation-parsing-end
2372 (set-marker compilation-parsing-end (point)) 2606 (set-marker compilation-parsing-end (point))
2373 (setq compilation-parsing-end (point-marker))) 2607 (setq compilation-parsing-end (point-marker)))
@@ -2379,19 +2613,26 @@ The file-structure looks like this:
2379 (dolist (err (if (listp compilation-error-list) compilation-error-list)) 2613 (dolist (err (if (listp compilation-error-list) compilation-error-list))
2380 (let* ((src (car err)) 2614 (let* ((src (car err))
2381 (dst (cdr err)) 2615 (dst (cdr err))
2382 (loc (cond ((markerp dst) (list nil nil nil dst)) 2616 (loc (cond ((markerp dst)
2617 (cons nil
2618 (compilation--make-cdrloc nil nil dst)))
2383 ((consp dst) 2619 ((consp dst)
2384 (list (nth 2 dst) (nth 1 dst) 2620 (cons (nth 2 dst)
2385 (cons (cdar dst) (caar dst))))))) 2621 (compilation--make-cdrloc
2622 (nth 1 dst)
2623 (cons (cdar dst) (caar dst))
2624 nil))))))
2386 (when loc 2625 (when loc
2387 (goto-char src) 2626 (goto-char src)
2388 ;; (put-text-property src (line-end-position) 'font-lock-face 'font-lock-warning-face) 2627 ;; (put-text-property src (line-end-position)
2628 ;; 'font-lock-face 'font-lock-warning-face)
2389 (put-text-property src (line-end-position) 2629 (put-text-property src (line-end-position)
2390 'message (list loc 2))))))) 2630 'compilation-message
2631 (compilation--make-message loc 2 nil)))))))
2391 (goto-char limit) 2632 (goto-char limit)
2392 nil) 2633 nil)
2393 2634
2394;; Beware: this is not only compatibility code. New code stil uses it. --Stef 2635;; Beware! this is not only compatibility code. New code also uses it. --Stef
2395(defun compilation-forget-errors () 2636(defun compilation-forget-errors ()
2396 ;; In case we hit the same file/line specs, we want to recompute a new 2637 ;; In case we hit the same file/line specs, we want to recompute a new
2397 ;; marker for them, so flush our cache. 2638 ;; marker for them, so flush our cache.
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index ff943e654ab..4bab8a18dee 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -341,7 +341,7 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
341 341
342;;;###autoload 342;;;###autoload
343(defconst grep-regexp-alist 343(defconst grep-regexp-alist
344 '(("^\\(.+?\\)\\(:[ \t]*\\)\\([0-9]+\\)\\2" 344 '(("^\\(.+?\\)\\(:[ \t]*\\)\\([1-9][0-9]*\\)\\2"
345 1 3) 345 1 3)
346 ;; Rule to match column numbers is commented out since no known grep 346 ;; Rule to match column numbers is commented out since no known grep
347 ;; produces them 347 ;; produces them
@@ -384,7 +384,6 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
384 384
385(defvar grep-mode-font-lock-keywords 385(defvar grep-mode-font-lock-keywords
386 '(;; Command output lines. 386 '(;; Command output lines.
387 ("^\\([A-Za-z_0-9/\.+-]+\\)[ \t]*:" 1 font-lock-function-name-face)
388 (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$" 387 (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$"
389 1 grep-error-face) 388 1 grep-error-face)
390 ;; remove match from grep-regexp-alist before fontifying 389 ;; remove match from grep-regexp-alist before fontifying
@@ -399,7 +398,8 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
399 (1 grep-error-face) 398 (1 grep-error-face)
400 (2 grep-error-face nil t)) 399 (2 grep-error-face nil t))
401 ("^.+?-[0-9]+-.*\n" (0 grep-context-face)) 400 ("^.+?-[0-9]+-.*\n" (0 grep-context-face))
402 ;; Highlight grep matches and delete markers 401 ;; Highlight grep matches and delete markers.
402 ;; FIXME: Modifying the buffer text from font-lock is a bad idea!
403 ("\\(\033\\[01;31m\\)\\(.*?\\)\\(\033\\[[0-9]*m\\)" 403 ("\\(\033\\[01;31m\\)\\(.*?\\)\\(\033\\[[0-9]*m\\)"
404 ;; Refontification does not work after the markers have been 404 ;; Refontification does not work after the markers have been
405 ;; deleted. So we use the font-lock-face property here as Font 405 ;; deleted. So we use the font-lock-face property here as Font
@@ -409,12 +409,14 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
409 (progn 409 (progn
410 ;; Delete markers with `replace-match' because it updates 410 ;; Delete markers with `replace-match' because it updates
411 ;; the match-data, whereas `delete-region' would render it obsolete. 411 ;; the match-data, whereas `delete-region' would render it obsolete.
412 (syntax-ppss-flush-cache (match-beginning 0))
412 (replace-match "" t t nil 3) 413 (replace-match "" t t nil 3)
413 (replace-match "" t t nil 1)))) 414 (replace-match "" t t nil 1))))
414 ("\\(\033\\[[0-9;]*[mK]\\)" 415 ("\033\\[[0-9;]*[mK]"
415 ;; Delete all remaining escape sequences 416 ;; Delete all remaining escape sequences
416 ((lambda (bound)) 417 ((lambda (bound))
417 (replace-match "" t t nil 1)))) 418 (syntax-ppss-flush-cache (match-beginning 0))
419 (replace-match "" t t))))
418 "Additional things to highlight in grep output. 420 "Additional things to highlight in grep output.
419This gets tacked on the end of the generated expressions.") 421This gets tacked on the end of the generated expressions.")
420 422
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 8a9aa03bf69..428fc1db3a9 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1812,11 +1812,70 @@ Mark is left at original location."
1812;; Why use a shell instead of running TeX directly? Because if TeX 1812;; Why use a shell instead of running TeX directly? Because if TeX
1813;; gets stuck, the user can switch to the shell window and type at it. 1813;; gets stuck, the user can switch to the shell window and type at it.
1814 1814
1815(defvar tex-error-parse-syntax-table
1816 (let ((st (make-syntax-table)))
1817 (modify-syntax-entry ?\( "()" st)
1818 (modify-syntax-entry ?\) ")(" st)
1819 (modify-syntax-entry ?\\ "\\" st)
1820 (modify-syntax-entry ?\{ "_" st)
1821 (modify-syntax-entry ?\} "_" st)
1822 (modify-syntax-entry ?\[ "_" st)
1823 (modify-syntax-entry ?\] "_" st)
1824 ;; Single quotations may appear in errors
1825 (modify-syntax-entry ?\" "_" st)
1826 st)
1827 "Syntax-table used while parsing TeX error messages.")
1828
1829(defun tex-old-error-file-name ()
1830 ;; This is unreliable, partly because we don't try very hard, and
1831 ;; partly because TeX's output format is eminently ambiguous and unfriendly
1832 ;; to automation.
1833 (save-excursion
1834 (save-match-data
1835 (with-syntax-table tex-error-parse-syntax-table
1836 (beginning-of-line)
1837 (backward-up-list 1)
1838 (skip-syntax-forward "(_")
1839 (while (not (let ((try-filename (thing-at-point 'filename)))
1840 (and try-filename
1841 (not (string= "" try-filename))
1842 (file-readable-p try-filename))))
1843 (skip-syntax-backward "(_")
1844 (backward-up-list 1)
1845 (skip-syntax-forward "(_"))
1846 (thing-at-point 'filename)))))
1847
1848(defconst tex-error-regexp-alist
1849 ;; First alternative handles the newer --file-line-error style:
1850 ;; ./test2.tex:14: Too many }'s.
1851 '(gnu
1852 ;; Second handles the old-style, which spans two lines but doesn't include
1853 ;; any file info:
1854 ;; ! Too many }'s.
1855 ;; l.396 toto}
1856 ("^l\\.\\([1-9][0-9]*\\) \\(?:\\.\\.\\.\\)?\\(.*\\)$"
1857 tex-old-error-file-name 1 nil nil nil
1858 ;; Since there's no filename to highlight, let's highlight the message.
1859 (2 compilation-error-face))
1860 ;; A few common warning messages.
1861 ("^\\(?:Und\\|Ov\\)erfull \\\\[hv]box .* at lines? \\(\\([1-9][0-9]*\\)\\(?:--\\([1-9][0-9]*\\)\\)?\\)$"
1862 tex-old-error-file-name (2 . 3) nil 1 nil
1863 (1 compilation-warning-face))
1864 ("^(Font) *\\([^ \n].* on input line \\([1-9][0-9]*\\)\\)\\.$"
1865 tex-old-error-file-name 2 nil 1 1
1866 (2 compilation-warning-face))
1867 ;; Included files get output as (<file> ...).
1868 ;; FIXME: there tend to be a crapload of them at the beginning of the
1869 ;; output which aren't that interesting. Maybe we should filter out
1870 ;; all the file name that start with /usr/share?
1871 ;; ("(\\.?/\\([^() \n]+\\)" 1 nil nil 0)
1872 ))
1873
1815;; The utility functions: 1874;; The utility functions:
1816 1875
1817(define-derived-mode tex-shell shell-mode "TeX-Shell" 1876(define-derived-mode tex-shell shell-mode "TeX-Shell"
1818 (set (make-local-variable 'compilation-parse-errors-function) 1877 (set (make-local-variable 'compilation-error-regexp-alist)
1819 'tex-compilation-parse-errors) 1878 tex-error-regexp-alist)
1820 (compilation-shell-minor-mode t)) 1879 (compilation-shell-minor-mode t))
1821 1880
1822;;;###autoload 1881;;;###autoload
@@ -2314,113 +2373,6 @@ Only applies the FSPEC to the args part of FORMAT."
2314 (tex-display-shell) 2373 (tex-display-shell)
2315 (setq tex-last-buffer-texed (current-buffer))) 2374 (setq tex-last-buffer-texed (current-buffer)))
2316 2375
2317(defvar tex-error-parse-syntax-table
2318 (let ((st (make-syntax-table)))
2319 (modify-syntax-entry ?\( "()" st)
2320 (modify-syntax-entry ?\) ")(" st)
2321 (modify-syntax-entry ?\\ "\\" st)
2322 (modify-syntax-entry ?\{ "_" st)
2323 (modify-syntax-entry ?\} "_" st)
2324 (modify-syntax-entry ?\[ "_" st)
2325 (modify-syntax-entry ?\] "_" st)
2326 ;; Single quotations may appear in errors
2327 (modify-syntax-entry ?\" "_" st)
2328 st)
2329 "Syntax-table used while parsing TeX error messages.")
2330
2331(defun tex-compilation-parse-errors (limit-search find-at-least)
2332 "Parse the current buffer as TeX error messages.
2333See the variable `compilation-parse-errors-function' for the interface it uses.
2334
2335This function parses only the last TeX compilation.
2336It works on TeX compilations only. It is necessary for that purpose,
2337since TeX does not put file names and line numbers on the same line as
2338for the error messages."
2339 (require 'thingatpt)
2340 (setq compilation-error-list nil)
2341 (let ((default-directory ; Perhaps dir has changed meanwhile.
2342 (file-name-directory (buffer-file-name tex-last-buffer-texed)))
2343 found-desired (num-errors-found 0)
2344 last-filename last-linenum last-position
2345 begin-of-error end-of-error errfilename)
2346 ;; Don't reparse messages already seen at last parse.
2347 (goto-char compilation-parsing-end)
2348 ;; Parse messages.
2349 (while (and (not (or found-desired (eobp)))
2350 ;; First alternative handles the newer --file-line-error style:
2351 ;; ./test2.tex:14: Too many }'s.
2352 ;; Second handles the old-style:
2353 ;; ! Too many }'s.
2354 (prog1 (re-search-forward
2355 "^\\(?:\\([^:\n]+\\):[[:digit:]]+:\\|!\\) " nil 'move)
2356 (setq begin-of-error (match-beginning 0)
2357 end-of-error (match-end 0)
2358 errfilename (match-string 1)))
2359 (re-search-forward
2360 "^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\)?\\(.*\\)$" nil 'move))
2361 (let* ((this-error (copy-marker begin-of-error))
2362 (linenum (string-to-number (match-string 1)))
2363 (error-text (regexp-quote (match-string 3)))
2364 try-filename
2365 (filename
2366 ;; Prefer --file-liner-error filename if we have it.
2367 (or errfilename
2368 (save-excursion
2369 (with-syntax-table tex-error-parse-syntax-table
2370 (backward-up-list 1)
2371 (skip-syntax-forward "(_")
2372 (while (not
2373 (and (setq try-filename (thing-at-point
2374 'filename))
2375 (not (string= "" try-filename))
2376 (file-readable-p try-filename)))
2377 (skip-syntax-backward "(_")
2378 (backward-up-list 1)
2379 (skip-syntax-forward "(_"))
2380 (thing-at-point 'filename)))))
2381 (new-file
2382 (or (null last-filename)
2383 (not (string-equal last-filename filename))))
2384 (error-location
2385 (with-current-buffer
2386 (if (equal filename (concat tex-zap-file ".tex"))
2387 tex-last-buffer-texed
2388 (find-file-noselect filename))
2389 (save-excursion
2390 (if new-file
2391 (progn
2392 (goto-char (point-min))
2393 (forward-line (1- linenum))
2394 (setq last-position nil))
2395 (goto-char last-position)
2396 (forward-line (- linenum last-linenum)))
2397 ;; first try a forward search for the error text,
2398 ;; then a backward search limited by the last error.
2399 (let ((starting-point (point)))
2400 (or (re-search-forward error-text nil t)
2401 (re-search-backward error-text last-position t)
2402 (goto-char starting-point)))
2403 (point-marker)))))
2404 (goto-char this-error)
2405 (if (and compilation-error-list
2406 (or (and find-at-least
2407 (>= num-errors-found
2408 find-at-least))
2409 (and limit-search
2410 (>= end-of-error limit-search)))
2411 new-file)
2412 (setq found-desired t)
2413 (setq num-errors-found (1+ num-errors-found)
2414 last-filename filename
2415 last-linenum linenum
2416 last-position error-location
2417 compilation-error-list ; Add the new error
2418 (cons (cons this-error error-location)
2419 compilation-error-list))
2420 (goto-char end-of-error)))))
2421 (set-marker compilation-parsing-end (point))
2422 (setq compilation-error-list (nreverse compilation-error-list)))
2423
2424;;; The commands: 2376;;; The commands:
2425 2377
2426(defun tex-region (beg end) 2378(defun tex-region (beg end)