aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-01-28 16:42:34 -0500
committerStefan Monnier2011-01-28 16:42:34 -0500
commit8fe5238438da2105a0a5d0713f22fe5ebe15b7ab (patch)
tree9dad9844473577dd38818116a115ce8d115b0cd5
parent5e853d01905a1a6c64f11928d5efa086cefb714f (diff)
downloademacs-8fe5238438da2105a0a5d0713f22fe5ebe15b7ab.tar.gz
emacs-8fe5238438da2105a0a5d0713f22fe5ebe15b7ab.zip
* lisp/progmodes/compile.el: Use accessors for clarity and fix omake hack.
(compilation-process-setup-function): Fix docstring's false promises. (compilation-error-regexp-alist-alist): Catch omake's continuous recompilation message and avoid reuse of old markers. (compilation-parse-errors-function): Declare obsolete. (compilation-buffer-modtime): Remove. (compilation--make-cdrloc, compilation--loc->col) (compilation--loc->line, compilation--loc->file-struct) (compilation--loc->marker, compilation--loc->visited) (compilation--make-file-struct, compilation--file-struct->file-spec) (compilation--file-struct->formats) (compilation--file-struct->loc-tree): New macros. Use them. (compilation--message): New defstruct. Use them. (compilation-next-error-function): Don't mess with timestamps to try and guess when to reparse.
-rw-r--r--lisp/ChangeLog24
-rw-r--r--lisp/progmodes/compile.el285
2 files changed, 205 insertions, 104 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 663b74ab521..0c88d7f4911 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,23 @@
12011-01-28 Stefan Monnier <monnier@iro.umontreal.ca> 12011-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * progmodes/compile.el: Use accessors for clarity and fix omake hack.
4 (compilation-process-setup-function): Fix docstring's false promises.
5 (compilation-error-regexp-alist-alist): Catch omake's continuous
6 recompilation message and avoid reuse of old markers.
7 (compilation-parse-errors-function): Declare obsolete.
8 (compilation-buffer-modtime): Remove.
9 (compilation--make-cdrloc, compilation--loc->col)
10 (compilation--loc->line, compilation--loc->file-struct)
11 (compilation--loc->marker, compilation--loc->visited)
12 (compilation--make-file-struct, compilation--file-struct->file-spec)
13 (compilation--file-struct->formats)
14 (compilation--file-struct->loc-tree): New macros. Use them.
15 (compilation--message): New defstruct. Use them.
16 (compilation-next-error-function): Don't mess with timestamps to try
17 and guess when to reparse.
18
192011-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
20
3 * textmodes/tex-mode.el: Get rid of compilation-parse-errors-function 21 * textmodes/tex-mode.el: Get rid of compilation-parse-errors-function
4 (tex-old-error-file-name): New function, 22 (tex-old-error-file-name): New function,
5 extracted from tex-compilation-parse-errors. 23 extracted from tex-compilation-parse-errors.
@@ -28,9 +46,9 @@
28 (compilation--unsetup): New function. 46 (compilation--unsetup): New function.
29 (compilation-shell-minor-mode, compilation-minor-mode): Use it. 47 (compilation-shell-minor-mode, compilation-minor-mode): Use it.
30 (compilation-filter): Minor tweaks. 48 (compilation-filter): Minor tweaks.
31 (compilation-next-error-function): Try and avoid abusing variable names. 49 (compilation-next-error-function): Try and avoid abusing variables.
32 (compilation--flush-file-structure): New fun. 50 (compilation--flush-file-structure): New fun.
33 (compilation-fake-loc): Use it for cleaner behavior when file is reused. 51 (compilation-fake-loc): Use it to improve behavior when file is reused.
34 (debug-ignored-errors): Add "Moved past last ...". 52 (debug-ignored-errors): Add "Moved past last ...".
35 (compilation--compat-error-properties) 53 (compilation--compat-error-properties)
36 (compilation--compat-parse-errors): Rename by doubling the "-". 54 (compilation--compat-parse-errors): Rename by doubling the "-".
@@ -49,7 +67,7 @@
49 (prolog-inferior-self-insert-command): New command. 67 (prolog-inferior-self-insert-command): New command.
50 (prolog-inferior-mode-map): Use it. 68 (prolog-inferior-mode-map): Use it.
51 (prolog-inferior-error-regexp-alist): New var. 69 (prolog-inferior-error-regexp-alist): New var.
52 (prolog-inferior-mode): Use it, along with compilation-shell-minor-mode. 70 (prolog-inferior-mode): Use it, with compilation-shell-minor-mode.
53 (prolog-input-filter): Use derived-mode-p. 71 (prolog-input-filter): Use derived-mode-p.
54 (prolog-inferior-guess-flavor): New function. 72 (prolog-inferior-guess-flavor): New function.
55 (prolog-ensure-process): Use it. Use make-comint-in-buffer rather than 73 (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 4cc319b7858..f1c7c160369 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -28,45 +28,6 @@
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))
@@ -122,9 +83,7 @@ in the compilation output, and should return a transformed file name.")
122 "*Function to call to customize the compilation process. 83 "*Function to call to customize the compilation process.
123This function is called immediately before the compilation process is 84This function is called immediately before the compilation process is
124started. It can be used to set any variables or functions that are used 85started. It can be used to set any variables or functions that are used
125while processing the output of the compilation process. The function 86while processing the output of the compilation process.")
126is called with variables `compilation-buffer' and `compilation-window'
127bound to the compilation buffer and window, respectively.")
128 87
129;;;###autoload 88;;;###autoload
130(defvar compilation-buffer-name-function nil 89(defvar compilation-buffer-name-function nil
@@ -311,7 +270,12 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
311 (omake 270 (omake
312 ;; "omake -P" reports "file foo changed" 271 ;; "omake -P" reports "file foo changed"
313 ;; (useful if you do "cvs up" and want to see what has changed) 272 ;; (useful if you do "cvs up" and want to see what has changed)
314 "omake: file \\(.*\\) changed" 1) 273 "omake: file \\(.*\\) changed" 1 nil nil nil nil
274 ;; FIXME-omake: This tries to prevent reusing pre-existing markers
275 ;; for subsequent messages, since those messages's line numbers
276 ;; are about another version of the file.
277 (0 (progn (compilation--flush-file-structure (match-string 1))
278 nil)))
315 279
316 (oracle 280 (oracle
317 "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ 281 "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
@@ -739,6 +703,8 @@ Faces `compilation-error-face', `compilation-warning-face',
739 703
740;; Used for compatibility with the old compile.el. 704;; Used for compatibility with the old compile.el.
741(defvar compilation-parse-errors-function nil) 705(defvar compilation-parse-errors-function nil)
706(make-obsolete 'compilation-parse-errors-function
707 'compilation-error-regexp-alist "24.1")
742 708
743(defcustom compilation-auto-jump-to-first-error nil 709(defcustom compilation-auto-jump-to-first-error nil
744 "If non-nil, automatically jump to the first error during compilation." 710 "If non-nil, automatically jump to the first error during compilation."
@@ -750,9 +716,9 @@ Faces `compilation-error-face', `compilation-warning-face',
750 "If non-nil, automatically jump to the next error encountered.") 716 "If non-nil, automatically jump to the next error encountered.")
751(make-variable-buffer-local 'compilation-auto-jump-to-next) 717(make-variable-buffer-local 'compilation-auto-jump-to-next)
752 718
753(defvar compilation-buffer-modtime nil 719;; (defvar compilation-buffer-modtime nil
754 "The buffer modification time, for buffers not associated with files.") 720;; "The buffer modification time, for buffers not associated with files.")
755(make-variable-buffer-local 'compilation-buffer-modtime) 721;; (make-variable-buffer-local 'compilation-buffer-modtime)
756 722
757(defvar compilation-skip-to-next-location t 723(defvar compilation-skip-to-next-location t
758 "*If non-nil, skip multiple error messages for the same source location.") 724 "*If non-nil, skip multiple error messages for the same source location.")
@@ -798,9 +764,82 @@ from a different message."
798 (and (cdr type) (match-end (cdr type)) compilation-info-face) 764 (and (cdr type) (match-end (cdr type)) compilation-info-face)
799 compilation-error-face)) 765 compilation-error-face))
800 766
767;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil)
768
769;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe
770;; LINE will be nil for a message that doesn't contain them. Then the
771;; location refers to a indented beginning of line or beginning of file.
772;; Once any location in some file has been jumped to, the list is extended to
773;; (COLUMN LINE FILE-STRUCTURE MARKER TIMESTAMP . VISITED)
774;; for all LOCs pertaining to that file.
775;; MARKER initially points to LINE and COLUMN in a buffer visiting that file.
776;; Being a marker it sticks to some text, when the buffer grows or shrinks
777;; before that point. VISITED is t if we have jumped there, else nil.
778;; FIXME-omake: TIMESTAMP was used to try and handle "incremental compilation":
779;; `omake -P' polls filesystem for changes and recompiles when a file is
780;; modified using the same *compilation* buffer. this necessitates
781;; re-parsing markers.
782
783;; (defstruct (compilation--loc
784;; (:constructor nil)
785;; (:copier nil)
786;; (:constructor compilation--make-loc
787;; (file-struct line col marker))
788;; (:conc-name compilation--loc->))
789;; col line file-struct marker timestamp visited)
790
791;; FIXME: We don't use a defstruct because of compilation-assq which looks up
792;; and creates part of the LOC (only the first cons cell containing the COL).
793
794(defmacro compilation--make-cdrloc (line file-struct marker)
795 `(list ,line ,file-struct ,marker nil))
796(defmacro compilation--loc->col (loc) `(car ,loc))
797(defmacro compilation--loc->line (loc) `(cadr ,loc))
798(defmacro compilation--loc->file-struct (loc) `(nth 2 ,loc))
799(defmacro compilation--loc->marker (loc) `(nth 3 ,loc))
800;; (defmacro compilation--loc->timestamp (loc) `(nth 4 ,loc))
801(defmacro compilation--loc->visited (loc) `(nthcdr 5 ,loc))
802
803;; FILE-STRUCTURE is a list of
804;; ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...)
805
806;; FILENAME is a string parsed from an error message. DIRECTORY is a string
807;; obtained by following directory change messages. DIRECTORY will be nil for
808;; an absolute filename. FORMATS is a list of formats to apply to FILENAME if
809;; a file of that name can't be found.
810;; The rest of the list is an alist of elements with LINE as key. The keys
811;; are either nil or line numbers. If present, nil comes first, followed by
812;; the numbers in decreasing order. The LOCs for each line are again an alist
813;; ordered the same way. Note that the whole file structure is referenced in
814;; every LOC.
815
816(defmacro compilation--make-file-struct (file-spec formats &optional loc-tree)
817 `(cons ,file-spec (cons ,formats ,loc-tree)))
818(defmacro compilation--file-struct->file-spec (fs) `(car ,fs))
819(defmacro compilation--file-struct->formats (fs) `(cadr ,fs))
820;; The FORMATS field plays the role of ANCHOR in the loc-tree.
821(defmacro compilation--file-struct->loc-tree (fs) `(cdr ,fs))
822
823;; MESSAGE is a list of (LOC TYPE END-LOC)
824
825;; TYPE is 0 for info or 1 for warning if the message matcher identified it as
826;; such, 2 otherwise (for a real error). END-LOC is a LOC pointing to the
827;; other end, if the parsed message contained a range. If the end of the
828;; range didn't specify a COLUMN, it defaults to -1, meaning end of line.
829;; These are the value of the `compilation-message' text-properties in the
830;; compilation buffer.
831
832(defstruct (compilation--message
833 (:constructor nil)
834 (:copier nil)
835 ;; (:type list) ;Old representation.
836 (:constructor compilation--make-message (loc type end-loc))
837 (:conc-name compilation--message->))
838 loc type end-loc)
839
801;; Internal function for calculating the text properties of a directory 840;; Internal function for calculating the text properties of a directory
802;; change message. The directory property is important, because it is 841;; change message. The compilation-directory property is important, because it
803;; the stack of nested enter-messages. Relative filenames on the following 842;; is the stack of nested enter-messages. Relative filenames on the following
804;; lines are relative to the top of the stack. 843;; lines are relative to the top of the stack.
805(defun compilation-directory-properties (idx leave) 844(defun compilation-directory-properties (idx leave)
806 (if leave (setq leave (match-end leave))) 845 (if leave (setq leave (match-end leave)))
@@ -936,22 +975,25 @@ FMTS is a list of format specs for transforming the file name.
936 (let* ((file-struct (compilation-get-file-structure file fmts)) 975 (let* ((file-struct (compilation-get-file-structure file fmts))
937 ;; 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).
938 ;; 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.
939 (marker-line (car (cddr file-struct))) ; a line structure 978 (marker-line ; a line structure
940 (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))))
941 (compilation-error-screen-columns compilation-error-screen-columns) 982 (compilation-error-screen-columns compilation-error-screen-columns)
942 end-marker loc end-loc) 983 end-marker loc end-loc)
943 (if (not (and marker (marker-buffer marker))) 984 (if (not (and marker (marker-buffer marker)))
944 (setq marker nil) ; no valid marker for this file 985 (setq marker nil) ; no valid marker for this file
945 (setq loc (or line 1)) ; normalize no linenumber to line 1 986 (setq loc (or line 1)) ; normalize no linenumber to line 1
946 (catch 'marker ; find nearest loc, at least one exists 987 (catch 'marker ; find nearest loc, at least one exists
947 (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.
948 (if (> (car x) loc) ; still bigger 990 (if (> (car x) loc) ; still bigger
949 (setq marker-line x) 991 (setq marker-line x)
950 (if (> (- (or (car marker-line) 1) loc) 992 (if (> (- (or (car marker-line) 1) loc)
951 (- loc (car x))) ; current line is nearer 993 (- loc (car x))) ; current line is nearer
952 (setq marker-line x)) 994 (setq marker-line x))
953 (throw 'marker t)))) 995 (throw 'marker t))))
954 (setq marker (nth 3 (cadr marker-line)) 996 (setq marker (compilation--loc->marker (cadr marker-line))
955 marker-line (or (car marker-line) 1)) 997 marker-line (or (car marker-line) 1))
956 (with-current-buffer (marker-buffer marker) 998 (with-current-buffer (marker-buffer marker)
957 (save-excursion 999 (save-excursion
@@ -964,7 +1006,7 @@ FMTS is a list of format specs for transforming the file name.
964 (end-of-line) 1006 (end-of-line)
965 (compilation-move-to-column 1007 (compilation-move-to-column
966 end-col compilation-error-screen-columns)) 1008 end-col compilation-error-screen-columns))
967 (setq end-marker (list (point-marker)))) 1009 (setq end-marker (point-marker)))
968 (beginning-of-line (if end-line 1010 (beginning-of-line (if end-line
969 (- line end-line -1) 1011 (- line end-line -1)
970 (- loc marker-line -1))) 1012 (- loc marker-line -1)))
@@ -972,24 +1014,40 @@ FMTS is a list of format specs for transforming the file name.
972 (compilation-move-to-column 1014 (compilation-move-to-column
973 col compilation-error-screen-columns) 1015 col compilation-error-screen-columns)
974 (forward-to-indentation 0)) 1016 (forward-to-indentation 0))
975 (setq marker (list (point-marker))))))) 1017 (setq marker (point-marker))))))
976 1018
977 (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
978 (if end-line 1022 (if end-line
979 (setq end-loc (compilation-assq end-line (cdr file-struct)) 1023 (compilation-assq
980 end-loc (compilation-assq end-col end-loc)) 1024 end-col (compilation-assq
1025 end-line (compilation--file-struct->loc-tree
1026 file-struct)))
981 (if end-col ; use same line element 1027 (if end-col ; use same line element
982 (setq end-loc (compilation-assq end-col loc)))) 1028 (compilation-assq end-col loc))))
983 (setq loc (compilation-assq col loc)) 1029 (setq loc (compilation-assq col loc))
984 ;; 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.
985 (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)))
986 (if end-loc 1042 (if end-loc
987 (or (cdr end-loc) 1043 (or (cdr end-loc)
988 (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))))
989 1047
990 ;; Must start with face 1048 ;; Must start with face
991 `(face ,compilation-message-face 1049 `(face ,compilation-message-face
992 compilation-message (,loc ,type ,end-loc) 1050 compilation-message ,(compilation--make-message loc type end-loc)
993 ,@(if compilation-debug 1051 ,@(if compilation-debug
994 `(compilation-debug 1052 `(compilation-debug
995 (,(assoc (with-no-warnings matcher) font-lock-keywords) 1053 (,(assoc (with-no-warnings matcher) font-lock-keywords)
@@ -1616,7 +1674,7 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
1616 mode-name (or name-of-mode "Compilation")) 1674 mode-name (or name-of-mode "Compilation"))
1617 (set (make-local-variable 'page-delimiter) 1675 (set (make-local-variable 'page-delimiter)
1618 compilation-page-delimiter) 1676 compilation-page-delimiter)
1619 (set (make-local-variable 'compilation-buffer-modtime) nil) 1677 ;; (set (make-local-variable 'compilation-buffer-modtime) nil)
1620 (compilation-setup) 1678 (compilation-setup)
1621 (setq buffer-read-only t) 1679 (setq buffer-read-only t)
1622 (run-mode-hooks 'compilation-mode-hook)) 1680 (run-mode-hooks 'compilation-mode-hook))
@@ -1839,7 +1897,8 @@ and runs `compilation-filter-hook'."
1839 (unless comint-inhibit-carriage-motion 1897 (unless comint-inhibit-carriage-motion
1840 (comint-carriage-motion (process-mark proc) (point))) 1898 (comint-carriage-motion (process-mark proc) (point)))
1841 (set-marker (process-mark proc) (point)) 1899 (set-marker (process-mark proc) (point))
1842 (set (make-local-variable 'compilation-buffer-modtime) (current-time)) 1900 ;; (set (make-local-variable 'compilation-buffer-modtime)
1901 ;; (current-time))
1843 (run-hooks 'compilation-filter-hook)) 1902 (run-hooks 'compilation-filter-hook))
1844 (goto-char pos) 1903 (goto-char pos)
1845 (narrow-to-region min max) 1904 (narrow-to-region min max)
@@ -1876,14 +1935,16 @@ and runs `compilation-filter-hook'."
1876 (if (setq pt (,property-change pt 'compilation-message nil ,limit)) 1935 (if (setq pt (,property-change pt 'compilation-message nil ,limit))
1877 (setq msg (get-text-property pt 'compilation-message))) 1936 (setq msg (get-text-property pt 'compilation-message)))
1878 (error ,error compilation-error)) 1937 (error ,error compilation-error))
1879 (or (< (cadr msg) compilation-skip-threshold) 1938 (or (< (compilation--message->type msg) compilation-skip-threshold)
1880 (if different-file 1939 (if different-file
1881 (eq (prog1 last (setq last (nth 2 (car msg)))) 1940 (eq (prog1 last
1941 (setq last (compilation--loc->file-struct
1942 (compilation--message->loc msg))))
1882 last)) 1943 last))
1883 (if compilation-skip-visited 1944 (if compilation-skip-visited
1884 (nthcdr 5 (car msg))) 1945 (compilation--loc->visited (compilation--message->loc msg)))
1885 (if compilation-skip-to-next-location 1946 (if compilation-skip-to-next-location
1886 (eq (car msg) loc)) 1947 (eq (compilation--message->loc msg) loc))
1887 ;; count this message only if none of the above are true 1948 ;; count this message only if none of the above are true
1888 (setq n (,1+ n)))))) 1949 (setq n (,1+ n))))))
1889 1950
@@ -1901,8 +1962,8 @@ looking for the next message."
1901 (error "Not in a compilation buffer")) 1962 (error "Not in a compilation buffer"))
1902 (or pt (setq pt (point))) 1963 (or pt (setq pt (point)))
1903 (let* ((msg (get-text-property pt 'compilation-message)) 1964 (let* ((msg (get-text-property pt 'compilation-message))
1904 ;; `loc' is used by the compilation-loop macro. 1965 ;; `loc', `msg', and `last' are used by the compilation-loop macro.
1905 (loc (car msg)) 1966 (loc (compilation--message->loc msg))
1906 last) 1967 last)
1907 (if (zerop n) 1968 (if (zerop n)
1908 (unless (or msg ; find message near here 1969 (unless (or msg ; find message near here
@@ -1916,7 +1977,8 @@ looking for the next message."
1916 (line-end-position))) 1977 (line-end-position)))
1917 (or (setq msg (get-text-property pt 'compilation-message)) 1978 (or (setq msg (get-text-property pt 'compilation-message))
1918 (setq pt (point))))) 1979 (setq pt (point)))))
1919 (setq last (nth 2 (car msg))) 1980 (setq last (compilation--loc->file-struct
1981 (compilation--message->loc msg)))
1920 (if (>= n 0) 1982 (if (>= n 0)
1921 (compilation-loop > next-single-property-change 1- 1983 (compilation-loop > next-single-property-change 1-
1922 (if (get-buffer-process (current-buffer)) 1984 (if (get-buffer-process (current-buffer))
@@ -2001,8 +2063,8 @@ This is the value of `next-error-function' in Compilation buffers."
2001 (or compilation-current-error 2063 (or compilation-current-error
2002 compilation-messages-start 2064 compilation-messages-start
2003 (point-min)))) 2065 (point-min))))
2004 (loc (car msg)) 2066 (loc (compilation--message->loc msg))
2005 (end-loc (nth 2 msg)) 2067 (end-loc (compilation--message->end-loc msg))
2006 (marker (point-marker))) 2068 (marker (point-marker)))
2007 (setq compilation-current-error (point-marker) 2069 (setq compilation-current-error (point-marker)
2008 overlay-arrow-position 2070 overlay-arrow-position
@@ -2011,39 +2073,51 @@ This is the value of `next-error-function' in Compilation buffers."
2011 (copy-marker (line-beginning-position)))) 2073 (copy-marker (line-beginning-position))))
2012 ;; If loc contains no marker, no error in that file has been visited. 2074 ;; If loc contains no marker, no error in that file has been visited.
2013 ;; If the marker is invalid the buffer has been killed. 2075 ;; If the marker is invalid the buffer has been killed.
2014 ;; If the file is newer than the timestamp, it has been modified
2015 ;; (`omake -P' polls filesystem for changes and recompiles when needed
2016 ;; in the same process and buffer).
2017 ;; So, recalculate all markers for that file. 2076 ;; So, recalculate all markers for that file.
2018 (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)) (nthcdr 4 loc) 2077 (unless (and (compilation--loc->marker loc)
2019 ;; There may be no timestamp info if the loc is a `fake-loc', 2078 (marker-buffer (compilation--loc->marker loc))
2020 ;; but we just checked that the file has been visited before! 2079 ;; FIXME-omake: For "omake -P", which automatically recompiles
2021 (equal (nth 4 loc) 2080 ;; when the file is modified, the line numbers of new output
2022 (setq timestamp compilation-buffer-modtime))) 2081 ;; may not be related to line numbers from earlier output
2023 (with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) 2082 ;; (earlier markers), so we used to try to detect it here and
2024 (cadr (car (nth 2 loc)))) 2083 ;; force a reparse. But that caused more problems elsewhere,
2084 ;; so instead we now flush the file-structure when we see
2085 ;; omake's message telling it's about to recompile a file.
2086 ;; (or (null (compilation--loc->timestamp loc)) ;A fake-loc
2087 ;; (equal (compilation--loc->timestamp loc)
2088 ;; (setq timestamp compilation-buffer-modtime)))
2089 )
2090 (with-current-buffer
2091 (compilation-find-file
2092 marker
2093 (caar (compilation--loc->file-struct loc))
2094 (cadr (car (compilation--loc->file-struct loc))))
2025 (save-restriction 2095 (save-restriction
2026 (widen) 2096 (widen)
2027 (goto-char (point-min)) 2097 (goto-char (point-min))
2028 ;; Treat file's found lines in forward order, 1 by 1. 2098 ;; Treat file's found lines in forward order, 1 by 1.
2029 (dolist (line (reverse (cddr (nth 2 loc)))) 2099 (dolist (line (reverse (cddr (compilation--loc->file-struct loc))))
2030 (when (car line) ; else this is a filename w/o a line# 2100 (when (car line) ; else this is a filename w/o a line#
2031 (beginning-of-line (- (car line) last -1)) 2101 (beginning-of-line (- (car line) last -1))
2032 (setq last (car line))) 2102 (setq last (car line)))
2033 ;; Treat line's found columns and store/update a marker for each. 2103 ;; Treat line's found columns and store/update a marker for each.
2034 (dolist (col (cdr line)) 2104 (dolist (col (cdr line))
2035 (if (car col) 2105 (if (compilation--loc->col col)
2036 (if (eq (car col) -1) ; special case for range end 2106 (if (eq (compilation--loc->col col) -1)
2107 ;; Special case for range end.
2037 (end-of-line) 2108 (end-of-line)
2038 (compilation-move-to-column (car col) columns)) 2109 (compilation-move-to-column (compilation--loc->col col)
2110 columns))
2039 (beginning-of-line) 2111 (beginning-of-line)
2040 (skip-chars-forward " \t")) 2112 (skip-chars-forward " \t"))
2041 (if (nth 3 col) 2113 (if (compilation--loc->marker col)
2042 (set-marker (nth 3 col) (point)) 2114 (set-marker (compilation--loc->marker col) (point))
2043 (setcdr (nthcdr 2 col) `(,(point-marker))))))))) 2115 (setf (compilation--loc->marker col) (point-marker)))
2044 (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc)) 2116 ;; (setf (compilation--loc->timestamp col) timestamp)
2045 (setcdr (nthcdr 3 loc) (list timestamp)) 2117 )))))
2046 (setcdr (nthcdr 4 loc) t))) ; Set this one as visited. 2118 (compilation-goto-locus marker (compilation--loc->marker loc)
2119 (compilation--loc->marker end-loc))
2120 (setf (compilation--loc->visited loc) t)))
2047 2121
2048(defvar compilation-gcpro nil 2122(defvar compilation-gcpro nil
2049 "Internal variable used to keep some values from being GC'd.") 2123 "Internal variable used to keep some values from being GC'd.")
@@ -2077,9 +2151,8 @@ region and the first line of the next region."
2077 (push fs compilation-gcpro) 2151 (push fs compilation-gcpro)
2078 (let ((loc (compilation-assq (or line 1) (cdr fs)))) 2152 (let ((loc (compilation-assq (or line 1) (cdr fs))))
2079 (setq loc (compilation-assq col loc)) 2153 (setq loc (compilation-assq col loc))
2080 (if (cdr loc) 2154 (assert (null (cdr loc)))
2081 (setcdr (cddr loc) (list marker)) 2155 (setcdr loc (compilation--make-cdrloc line fs marker))
2082 (setcdr loc (list line fs marker)))
2083 loc))) 2156 loc)))
2084 2157
2085(defcustom compilation-context-lines nil 2158(defcustom compilation-context-lines nil
@@ -2343,7 +2416,8 @@ The file-structure looks like this:
2343 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html 2416 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html
2344 (or (gethash (cons filename spec-directory) compilation-locs) 2417 (or (gethash (cons filename spec-directory) compilation-locs)
2345 (puthash (cons filename spec-directory) 2418 (puthash (cons filename spec-directory)
2346 (list (list filename spec-directory) fmt) 2419 (compilation--make-file-struct
2420 (list filename spec-directory) fmt)
2347 compilation-locs)) 2421 compilation-locs))
2348 compilation-locs)))) 2422 compilation-locs))))
2349 2423
@@ -2375,7 +2449,10 @@ The file-structure looks like this:
2375 (if (markerp dst) 2449 (if (markerp dst)
2376 ;; Must start with a face, for font-lock. 2450 ;; Must start with a face, for font-lock.
2377 `(face nil 2451 `(face nil
2378 compilation-message ,(list (list nil nil nil dst) 2) 2452 compilation-message ,(compilation--make-message
2453 (cons nil (compilation--make-cdrloc
2454 nil nil dst))
2455 2 nil)
2379 help-echo "mouse-2: visit the source location" 2456 help-echo "mouse-2: visit the source location"
2380 keymap compilation-button-map 2457 keymap compilation-button-map
2381 mouse-face highlight) 2458 mouse-face highlight)
@@ -2413,16 +2490,22 @@ The file-structure looks like this:
2413 (dolist (err (if (listp compilation-error-list) compilation-error-list)) 2490 (dolist (err (if (listp compilation-error-list) compilation-error-list))
2414 (let* ((src (car err)) 2491 (let* ((src (car err))
2415 (dst (cdr err)) 2492 (dst (cdr err))
2416 (loc (cond ((markerp dst) (list nil nil nil dst)) 2493 (loc (cond ((markerp dst)
2494 (cons nil
2495 (compilation--make-cdrloc nil nil dst)))
2417 ((consp dst) 2496 ((consp dst)
2418 (list (nth 2 dst) (nth 1 dst) 2497 (cons (nth 2 dst)
2419 (cons (cdar dst) (caar dst))))))) 2498 (compilation--make-cdrloc
2499 (nth 1 dst)
2500 (cons (cdar dst) (caar dst))
2501 nil))))))
2420 (when loc 2502 (when loc
2421 (goto-char src) 2503 (goto-char src)
2422 ;; (put-text-property src (line-end-position) 2504 ;; (put-text-property src (line-end-position)
2423 ;; 'font-lock-face 'font-lock-warning-face) 2505 ;; 'font-lock-face 'font-lock-warning-face)
2424 (put-text-property src (line-end-position) 2506 (put-text-property src (line-end-position)
2425 'compilation-message (list loc 2))))))) 2507 'compilation-message
2508 (compilation--make-message loc 2 nil)))))))
2426 (goto-char limit) 2509 (goto-char limit)
2427 nil) 2510 nil)
2428 2511