[Emacs-diffs] /srv/bzr/emacs/trunk r103053: * lisp/progmodes/compile.el (compilation--flush-directory-cache):

[Stefan Monnier]

------------------------------------------------------------
revno: 103053
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2011-01-31 12:09:42 -0500
message:
  * 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.
modified:
  lisp/ChangeLog
  lisp/progmodes/compile.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-01-31 16:49:44 +0000
+++ b/lisp/ChangeLog    2011-01-31 17:09:42 +0000
@@ -1,3 +1,13 @@
+2011-01-31  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * progmodes/compile.el (compilation-enable-debug-messages):
@@ -5,7 +15,6 @@
        revno:103013 optional.
        (compilation-parse-errors, compilation--flush-parse): Use it.
 
-
 2011-01-31  Deniz Dogan  <address@hidden>
 
        * net/rcirc.el: Clean log filenames (Bug#7933).
@@ -14,8 +23,8 @@
 
 2011-01-30  Jan Djärv  <address@hidden>
 
-       * 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  <address@hidden>
 
-       * 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  <address@hidden>
@@ -205,8 +214,8 @@
 
 2011-01-27  Sam Steingold  <address@hidden>
 
-       * 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  <address@hidden>
 

=== modified file 'lisp/progmodes/compile.el'
--- a/lisp/progmodes/compile.el 2011-01-31 16:49:44 +0000
+++ b/lisp/progmodes/compile.el 2011-01-31 17:09:42 +0000
@@ -732,9 +732,6 @@
   :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 @@
             (: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 @@
 
 (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 @@
     (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 @@
     (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 @@
   "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 @@
 
 (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))))