* lisp/progmodes/compile.el (compilation--previous-directory): Fix up

various nil/dead-marker mismatches.
(compilation-directory-properties, compilation-error-properties):
Don't call it at a position past the one we're about to change.

Fixes: debbugs:8014

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 087c5b0acbba29f351964389ef5d570a1d9c4472..8415861e2922aa5785c204af102e77f32a51de5f 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
 2011-03-12  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * progmodes/compile.el (compilation--previous-directory): Fix up
+       various nil/dead-marker mismatches (bug#8014).
+       (compilation-directory-properties, compilation-error-properties):
+       Don't call it at a position past the one we're about to change.
+
        * emacs-lisp/bytecomp.el (byte-compile-make-obsolete-variable):
        Disable obsolescence warnings in the file that declares it.
 

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 88f418f934a42a3ee9d06b28c8ab8958aa49111b..40383c6bc31def148a482c0d4a65df0f66c8306d 100644 (file)
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -860,27 +860,29 @@ POS and RES.")
                        (car compilation--previous-directory-cache)))
            (prev
             (previous-single-property-change
-             pos 'compilation-directory nil cache)))
-      (cond
-       ((null cache)
-        (setq compilation--previous-directory-cache
-              (cons (copy-marker pos) (copy-marker prev)))
-        prev)
-       ((eq prev cache)
-        (if cache
-            (set-marker (car compilation--previous-directory-cache) pos)
-          (setq compilation--previous-directory-cache
-                (cons (copy-marker pos) nil)))
-        (cdr compilation--previous-directory-cache))
-       (t
-        (if cache
-            (progn
-              (set-marker (car compilation--previous-directory-cache) pos)
-              (setcdr compilation--previous-directory-cache
-                      (copy-marker prev)))
-          (setq compilation--previous-directory-cache
-                (cons (copy-marker pos) (copy-marker prev))))
-        prev)))))
+             pos 'compilation-directory nil cache))
+           (res
+            (cond
+             ((null cache)
+              (setq compilation--previous-directory-cache
+                    (cons (copy-marker pos) (if prev (copy-marker prev))))
+              prev)
+             ((and prev (= prev cache))
+              (if cache
+                  (set-marker (car compilation--previous-directory-cache) pos)
+                (setq compilation--previous-directory-cache
+                      (cons (copy-marker pos) nil)))
+              (cdr compilation--previous-directory-cache))
+             (t
+              (if cache
+                  (progn
+                    (set-marker cache pos)
+                    (setcdr compilation--previous-directory-cache
+                            (copy-marker prev)))
+                (setq compilation--previous-directory-cache
+                      (cons (copy-marker pos) (if prev (copy-marker prev)))))
+              prev))))
+      (if (markerp res) (marker-position res) res))))
 
 ;; Internal function for calculating the text properties of a directory
 ;; change message.  The compilation-directory property is important, because it
@@ -889,7 +891,7 @@ POS and RES.")
 (defun compilation-directory-properties (idx leave)
   (if leave (setq leave (match-end leave)))
   ;; find previous stack, and push onto it, or if `leave' pop it
-  (let ((dir (compilation--previous-directory (point))))
+  (let ((dir (compilation--previous-directory (match-beginning 0))))
     (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory)
                          (get-text-property dir 'compilation-directory))))
     `(font-lock-face ,(if leave
@@ -948,7 +950,8 @@ POS and RES.")
                             (match-string-no-properties file))))
          (let ((dir
            (unless (file-name-absolute-p file)
-                   (let ((pos (compilation--previous-directory (point))))
+                   (let ((pos (compilation--previous-directory
+                               (match-beginning 0))))
                      (when pos
                        (or (get-text-property (1- pos) 'compilation-directory)
                            (get-text-property pos 'compilation-directory)))))))