diff options
| author | Stefan Monnier | 2011-01-28 17:12:05 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2011-01-28 17:12:05 -0500 |
| commit | 9ffae6d024cb3d9c95f456d7f9b8a6be97b63fde (patch) | |
| tree | 819b97536e7daff4ee2e493c785080260426dafa | |
| parent | b1ea593c8121821485fdc758a30efdf03bb63168 (diff) | |
| parent | 55fb901352fd4cd8c2a604378004b678fa60a461 (diff) | |
| download | emacs-9ffae6d024cb3d9c95f456d7f9b8a6be97b63fde.tar.gz emacs-9ffae6d024cb3d9c95f456d7f9b8a6be97b63fde.zip | |
* progmodes/compile.el: Don't use font-lock any more.
| -rw-r--r-- | etc/NEWS | 3 | ||||
| -rw-r--r-- | lisp/ChangeLog | 85 | ||||
| -rw-r--r-- | lisp/progmodes/compile.el | 885 | ||||
| -rw-r--r-- | lisp/progmodes/grep.el | 12 | ||||
| -rw-r--r-- | lisp/textmodes/tex-mode.el | 170 |
5 files changed, 718 insertions, 437 deletions
| @@ -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 | ||
| 14 | 2011-01-28 Stefan Monnier <monnier@iro.umontreal.ca> | 14 | 2011-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 | |||
| 44 | 2011-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 | |||
| 62 | 2011-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. |
| 123 | This function is called immediately before the compilation process is | 78 | This function is called immediately before the compilation process is |
| 124 | started. It can be used to set any variables or functions that are used | 79 | started. It can be used to set any variables or functions that are used |
| 125 | while processing the output of the compilation process. The function | 80 | while processing the output of the compilation process.") |
| 126 | is called with variables `compilation-buffer' and `compilation-window' | ||
| 127 | bound 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 |
| 506 | matched by the whole REGEXP becomes the hyperlink. | 466 | matched by the whole REGEXP becomes the hyperlink. |
| 507 | 467 | ||
| 508 | Additional HIGHLIGHTs as described under `font-lock-keywords' can | 468 | Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where SUBMATCH is |
| 509 | be added." | 469 | the number of a submatch that should be highlighted when it matches, |
| 470 | and 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. | ||
| 1130 | The errors recognized are the ones specified in RULES which default | ||
| 1131 | to `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. |
| 1670 | If nil, use the beginning of buffer.") | 1847 | If 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. |
| 1677 | Optional argument MINOR indicates this is called from | 1851 | Optional 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. |
| 1879 | This function does NOT find the source line like \\[next-error]. | 2076 | This 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. |
| 1966 | If AVOID-CURRENT is nil, and the current buffer is a compilation buffer, | 2171 | If 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." | |||
| 2036 | FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME). | 2253 | FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME). |
| 2037 | This is useful when you compile temporary files, but want | 2254 | This is useful when you compile temporary files, but want |
| 2038 | automatic translation of the messages to the real buffer from | 2255 | automatic translation of the messages to the real buffer from |
| 2039 | which the temporary file came. This only works if done before a | 2256 | which the temporary file came. This may also affect previous messages |
| 2040 | message about FILE appears! | 2257 | about FILE. |
| 2041 | 2258 | ||
| 2042 | Optional args LINE and COL default to 1 and beginning of | 2259 | Optional args LINE and COL default to 1 and beginning of |
| 2043 | indentation respectively. The marker is expected to reflect | 2260 | indentation respectively. The marker is expected to reflect |
| @@ -2049,18 +2266,19 @@ header with variable assignments and a code region), you must | |||
| 2049 | call this several times, once each for the last line of one | 2266 | call this several times, once each for the last line of one |
| 2050 | region and the first line of the next region." | 2267 | region 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). | |||
| 2278 | In the former case, FILENAME may be relative or absolute. | 2496 | In the former case, FILENAME may be relative or absolute. |
| 2279 | 2497 | ||
| 2280 | The file-structure looks like this: | 2498 | The 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. |
| 419 | This gets tacked on the end of the generated expressions.") | 421 | This 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. | ||
| 2333 | See the variable `compilation-parse-errors-function' for the interface it uses. | ||
| 2334 | |||
| 2335 | This function parses only the last TeX compilation. | ||
| 2336 | It works on TeX compilations only. It is necessary for that purpose, | ||
| 2337 | since TeX does not put file names and line numbers on the same line as | ||
| 2338 | for 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) |