* lisp/progmodes/compile.el (compilation--flush-directory-cache):

New function, extracted from compilation--remove-properties.
(compilation--remove-properties, compilation--parse-region): Use it.
(compilation--previous-directory): Handle one more case.
(compilation-enable-debug-messages): Remove.
(compilation-parse-errors, compilation--flush-parse): Just remove the
left over debug messages.

2 files changed, 65 insertions, 46 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 462d57745c5..584bf71c744 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2011-01-31  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * progmodes/compile.el (compilation--flush-directory-cache):
+        New function, extracted from compilation--remove-properties.
+        (compilation--remove-properties, compilation--parse-region): Use it.
+        (compilation--previous-directory): Handle one more case.
+        (compilation-enable-debug-messages): Remove.
+        (compilation-parse-errors, compilation--flush-parse): Just remove the
+        left over debug messages.
+
 2011-01-31  Sam Steingold  <sds@gnu.org>
 
         * progmodes/compile.el (compilation-enable-debug-messages):
@@ -5,7 +15,6 @@
         2011-01-28T22:12:05Z!monnier@iro.umontreal.ca optional.
         (compilation-parse-errors, compilation--flush-parse): Use it.
 
-
 2011-01-31  Deniz Dogan  <deniz.a.m.dogan@gmail.com>
 
         * net/rcirc.el: Clean log filenames (Bug#7933).
@@ -14,8 +23,8 @@
 
 2011-01-30  Jan Djärv  <jan.h.d@swipnet.se>
 
-        * mail/emacsbug.el (report-emacs-bug-insert-to-mailer): Check
-        report-emacs-bug-can-use-osx-open and use that if t.
+        * mail/emacsbug.el (report-emacs-bug-insert-to-mailer):
+        Check report-emacs-bug-can-use-osx-open and use that if t.
         (report-emacs-bug-can-use-osx-open): New function.
         (report-emacs-bug): Rename can-xdg-email to can-insert-mail.
         Check report-emacs-bug-can-use-osx-open also for can-insert-mail.
@@ -38,8 +47,8 @@
 
 2011-01-29  Daiki Ueno  <ueno@unixuser.org>
 
-        * epg.el (epg--status-KEYEXPIRED, epg--status-KEYREVOKED): Don't
-        presume KEYEXPIRED and KEYREVOKED to be a fatal error status
+        * epg.el (epg--status-KEYEXPIRED, epg--status-KEYREVOKED):
+        Don't presume KEYEXPIRED and KEYREVOKED to be a fatal error status
         (Bug#7931).
 
 2011-01-29  Stefan Monnier  <monnier@iro.umontreal.ca>
@@ -205,8 +214,8 @@
 
 2011-01-27  Sam Steingold  <sds@gnu.org>
 
-        * midnight.el (clean-buffer-list-kill-never-buffer-names): Remove
-        "*server*" which is never created by emacs server.
+        * midnight.el (clean-buffer-list-kill-never-buffer-names):
+        Remove "*server*" which is never created by emacs server.
 
 2011-01-27  Deniz Dogan  <deniz.a.m.dogan@gmail.com>
 
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 8bc0f221beb..f1a5801ea1a 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -732,9 +732,6 @@ info, are considered errors."
   :group 'compilation
   :version "22.1")
 
-(defvar compilation-enable-debug-messages nil
-  "Enable debug messages while parsing the compilation buffer.")
-
 (defun compilation-set-skip-threshold (level)
   "Switch the `compilation-skip-threshold' level."
   (interactive
@@ -837,38 +834,61 @@ from a different message."
             (:conc-name compilation--message->))
   loc type end-loc)
 
-(defvar compilation--previous-directory-cache nil)
+(defvar compilation--previous-directory-cache nil
+  "A pair (POS . RES) caching the result of previous directory search.
+Basically, this pair says that calling
+   (previous-single-property-change POS 'compilation-directory)
+returned RES, i.e. there is no change of `compilation-directory' between
+POS and RES.")
 (make-variable-buffer-local 'compilation--previous-directory-cache)
+
+(defun compilation--flush-directory-cache (start end)
+  (cond
+   ((or (not compilation--previous-directory-cache)
+        (<= (car compilation--previous-directory-cache) start)))
+   ((or (not (cdr compilation--previous-directory-cache))
+        (<= (cdr compilation--previous-directory-cache) start))
+    (set-marker (car compilation--previous-directory-cache) start))
+   (t (setq compilation--previous-directory-cache nil))))
+
 (defun compilation--previous-directory (pos)
   "Like (previous-single-property-change POS 'compilation-directory), but faster."
   ;; This avoids an N² behavior when there's no/few compilation-directory
   ;; entries, in which case each call to previous-single-property-change
   ;; ends up having to walk very far back to find the last change.
-  (let* ((cache (and compilation--previous-directory-cache
-                     (<= (car compilation--previous-directory-cache) pos)
-                     (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)
+  (if (and compilation--previous-directory-cache
+           (< pos (car compilation--previous-directory-cache))
+           (or (null (cdr compilation--previous-directory-cache)
+                     (< (cdr compilation--previous-directory-cache) pos))))
+      ;; No need to call previous-single-property-change.
+      (cdr compilation--previous-directory-cache)
+   
+    (let* ((cache (and compilation--previous-directory-cache
+                       (<= (car compilation--previous-directory-cache) pos)
+                       (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) nil)))
-      (cdr compilation--previous-directory-cache))
-     (t
-      (if cache
-          (progn
+              (cons (copy-marker pos) (copy-marker prev)))
+        prev)
+       ((eq prev cache)
+        (if cache
             (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))))
+          (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)))))
 
 ;; Internal function for calculating the text properties of a directory
 ;; change message.  The compilation-directory property is important, because it
@@ -1099,14 +1119,6 @@ FMTS is a list of format specs for transforming the file name.
 
 (defun compilation--remove-properties (&optional start end)
   (with-silent-modifications
-    (cond
-     ((or (not compilation--previous-directory-cache)
-          (<= (car compilation--previous-directory-cache) start)))
-     ((or (not (cdr compilation--previous-directory-cache))
-          (<= (cdr compilation--previous-directory-cache) start))
-      (set-marker (car compilation--previous-directory-cache) start))
-     (t (setq compilation--previous-directory-cache nil)))
-
     ;; When compile.el used font-lock directly, we could just remove all
     ;; our text-properties in one go, but now that we manually place
     ;; font-lock-face, we have to be careful to only remove the font-lock-face
@@ -1118,6 +1130,7 @@ FMTS is a list of format specs for transforming the file name.
     (let (next)
       (unless start (setq start (point-min)))
       (unless end (setq end (point-max)))
+      (compilation--flush-directory-cache start end)
       (while
           (progn
             (setq next (or (next-single-property-change
@@ -1155,6 +1168,7 @@ FMTS is a list of format specs for transforming the file name.
     (goto-char start)
     (while (re-search-forward (car compilation-directory-matcher)
                               end t)
+      (compilation--flush-directory-cache (match-beginning 0) (match-end 0))
       (when compilation-debug
         (font-lock-append-text-property
          (match-beginning 0) (match-end 0)
@@ -1172,8 +1186,6 @@ FMTS is a list of format specs for transforming the file name.
   "Parse errors between START and END.
 The errors recognized are the ones specified in RULES which default
 to `compilation-error-regexp-alist' if RULES is nil."
-  (when compilation-enable-debug-messages
-    (message "compilation-parse-errors: %S %S" start end))
   (dolist (item (or rules compilation-error-regexp-alist))
     (if (symbolp item)
         (setq item (cdr (assq item
@@ -1302,8 +1314,6 @@ to `compilation-error-regexp-alist' if RULES is nil."
 
 (defun compilation--flush-parse (start end)
   "Mark the region between START and END for re-parsing."
-  (when compilation-enable-debug-messages
-    (message "compilation--flush-parse: %S %S" start end))
   (if (markerp compilation--parsed)
       (move-marker compilation--parsed (min start compilation--parsed))))