(compilation-error-properties): Fix for adding messages when there are already

markers for their file.
(compilation-fake-loc): New function.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c4fd4341c896241c216f0f5ca539a961984e954d..8e5aca3d06113445dd3adb1d6869552d6e46223e 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2004-04-17  Daniel Pfeiffer  <occitan@esperanto.org>
+
+       * progmodes/compile.el (compilation-error-properties): Fix for
+       adding messages when there are already markers for their file.
+       (compilation-fake-loc): New function.
+
 2004-04-16  Andre Spiegel  <spiegel@gnu.org>
 
        * vc-hooks.el (vc-default-workfile-unchanged-p): Quote signal.

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index ff4256192c4e6f27923e9875db5f47581a8825c0..93921fcbbe72f42227fcd5ad45df5ed0d84b8f75 100644 (file)
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -564,7 +564,7 @@ Faces `compilation-error-face', `compilation-warning-face',
            file (or (if file
                         (nth 2 (car (or (get-text-property (1- file) 'message)
                                         (get-text-property file 'message)))))
-                    ;; no previous either -- let font-lock continue
+                    ;; no previous either -- but don't let font-lock fail
                     (gethash (setq file '("*unknown*")) compilation-locs)
                     (puthash file (list file fmt) compilation-locs))))
     ;; All of these fields are optional, get them only if we have an index, and
@@ -581,15 +581,54 @@ Faces `compilation-error-face', `compilation-warning-face',
     (if (and end-col (setq end-col (match-string-no-properties end-col)))
        (setq end-col (- (string-to-number end-col) compilation-first-column))
       (if end-line (setq end-col -1)))
-    (if (consp type)                   ; not a preset type, check what it is.
+    (if (consp type)                   ; not a static type, check what it is.
        (setq type (or (and (car type) (match-end (car type)) 1)
                       (and (cdr type) (match-end (cdr type)) 0)
                       2)))
-    ;; Get any (first) already existing marker (if any has one, all have one).
-    ;; Do this first, as the next assq`s may create new nodes.
-    (let ((marker (nth 3 (car (cdar (cddr file)))))
-         (loc (compilation-assq line (cdr file)))
-         end-loc)
+    ;; Get first already existing marker (if any has one, all have one).
+    ;; Do this first, as the compilation-assq`s may create new nodes.
+    (let* ((marker-line (car (cddr file)))     ; a line structure
+          (marker (nth 3 (cadr marker-line)))  ; its marker
+          (compilation-error-screen-columns compilation-error-screen-columns)
+          end-marker loc end-loc)
+      (if (not (and marker (marker-buffer marker)))
+         (setq marker)                 ; no valid marker for this file
+       (setq loc (or line 1)           ; normalize no linenumber to line 1
+             marker-line)
+       (catch 'marker                  ; find nearest loc, at least one exists
+         (dolist (x (cddr file))       ; loop over lines
+           (if (> (or (car x) 1) loc)  ; still bigger
+               (setq marker-line x)
+             (if (or (not marker-line) ; first in list
+                     (> (- (or (car marker-line) 1) loc)
+                        (- loc (or (car x) 1)))) ; current line is nearer
+                 (setq marker-line x))
+             (throw 'marker t))))
+       (setq marker (nth 3 (cadr marker-line))
+             marker-line (car marker-line))
+       (with-current-buffer (marker-buffer marker)
+         (save-restriction
+           (widen)
+           (goto-char (marker-position marker))
+           (when (or end-col end-line)
+             (beginning-of-line (- (or end-line line) marker-line -1))
+             (if (< end-col 0)
+                 (end-of-line)
+               (if compilation-error-screen-columns
+                   (move-to-column end-col)
+                 (forward-char end-col)))
+             (setq end-marker (list (point-marker))))
+           (beginning-of-line (if end-line
+                                  (- end-line line -1)
+                                (- loc marker-line -1)))
+           (if col
+               (if compilation-error-screen-columns
+                   (move-to-column col)
+                 (forward-char col))
+             (forward-to-indentation 0))
+           (setq marker (list (point-marker))))))
+
+      (setq loc (compilation-assq line (cdr file)))
       (if end-line
          (setq end-loc (compilation-assq end-line (cdr file))
                end-loc (compilation-assq end-col end-loc))
@@ -597,44 +636,10 @@ Faces `compilation-error-face', `compilation-warning-face',
            (setq end-loc (compilation-assq end-col loc))))
       (setq loc (compilation-assq col loc))
       ;; If they are new, make the loc(s) reference the file they point to.
-      (or (cdr loc) (setcdr loc (list line file)))
+      (or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
       (if end-loc
-         (or (cdr end-loc) (setcdr end-loc (list (or end-line line) file))))
-      ;; If we'd found a marker, ensure that the new locs also get markers
-      (when (and marker
-                (not (or (cddr loc) (cddr end-loc))) ; maybe new node w/o marker
-                (marker-buffer marker)) ; other marker still valid
-       (or line (setq line 1))          ; normalize no linenumber to line 1
-       (catch 'marker                 ; find nearest loc, at least one exists
-         (dolist (x (cddr file))
-           (if (> (or (car x) 1) line)
-               (setq marker x)
-             (if (eq (or (car x) 1) line)
-                 (if (cdr (cddr x))    ; at least one other column
-                     (throw 'marker (setq marker x))
-                   (if marker (throw 'marker t)))
-               (throw 'marker (or marker (setq marker x)))))))
-       (setq marker (if (eq (car (cddr marker)) col)
-                        (nthcdr 3 marker)
-                      (cddr marker))
-             file compilation-error-screen-columns)
-       (with-current-buffer (marker-buffer (cddr marker))
-         (save-restriction
-           (widen)
-           (goto-char (marker-position (cddr marker)))
-           (beginning-of-line (- line (car (cadr marker)) -1))
-           (if file                    ; original c.-error-screen-columns
-               (move-to-column (car loc))
-             (forward-char (car loc)))
-           (setcdr (cdr loc) (point-marker))
-           (when end-loc
-             (beginning-of-line (- end-line line -1))
-             (if (< end-col 0)
-                 (end-of-line)
-               (if file                ; original c.-error-screen-columns
-                   (move-to-column (car end-loc))
-                 (forward-char (car end-loc))))
-             (setcdr (cdr end-loc) (point-marker))))))
+         (or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
+
       ;; Must start with face
       `(face ,compilation-message-face
             message (,loc ,type ,end-loc)
@@ -1449,7 +1454,7 @@ See variable `compilation-error-regexp-alist' for customization ideas."
     ;; If loc contains no marker, no error in that file has been visited.  If
     ;; the marker is invalid the buffer has been killed.  So, recalculate all
     ;; markers for that file.
-    (unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc)))
+    (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)))
       (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
                                                  (or (cdar (nth 2 loc))
                                                      default-directory))
@@ -1472,7 +1477,7 @@ See variable `compilation-error-regexp-alist' for customization ideas."
                      (forward-char (car col))))
                (beginning-of-line)
                (skip-chars-forward " \t"))
-             (if (nthcdr 3 col)
+             (if (nth 3 col)
                  (set-marker (nth 3 col) (point))
                (setcdr (nthcdr 2 col) `(,(point-marker)))))))))
     (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
@@ -1499,6 +1504,32 @@ This operates on the output from the \\[compile] command."
   (setq compilation-current-error nil)
   (next-error n))
 
+(defun compilation-fake-loc (marker file &optional line col)
+  "Preassociate MARKER with FILE.
+This is useful when you compile temporary files, but want
+automatic translation of the messages to the real buffer from
+which the temporary file came.  This only works if done before a
+message about FILE appears!
+
+Optional args LINE and COL default to 1 and beginning of
+indentation respectively.  The marker is expected to reflect
+this.  In the simplest case the marker points to the first line
+of the region that was saved to the temp file.
+
+If you concatenate several regions into the temp file (e.g. a
+header with variable assignments and a code region), you must
+call this several times, once each for the last line of one
+region and the first line of the next region."
+  (or (consp file) (setq file (list file)))
+  (setq        file (or (gethash file compilation-locs)
+                (puthash file (list file nil) compilation-locs)))
+  (let ((loc (compilation-assq (or line 1) (cdr file))))
+    (setq loc (compilation-assq col loc))
+    (if (cdr loc)
+       (setcdr (cddr loc) (list marker))
+      (setcdr loc (list (or line 1) file marker)))
+    loc))
+
 (defcustom compilation-context-lines next-screen-context-lines
   "*Display this many lines of leading context before message."
   :type 'integer