[Emacs-diffs] /srv/bzr/emacs/trunk r103018: * lisp/p rogmodes/compile.el: Avoid an N² behavior in grep.

[Stefan Monnier]

------------------------------------------------------------
revno: 103018
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sat 2011-01-29 01:08:24 -0500
message:
  * lisp/progmodes/compile.el: Avoid an N² behavior in grep.
  (compilation--previous-directory): New fun.
  (compilation--previous-directory-cache): New var.
  (compilation--remove-properties): Flush it.
  (compilation-directory-properties, compilation-error-properties):
  Use the new fun to speed up looking for the current directory.
modified:
  lisp/ChangeLog
  lisp/progmodes/compile.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-01-29 03:12:32 +0000
+++ b/lisp/ChangeLog    2011-01-29 06:08:24 +0000
@@ -1,3 +1,12 @@
+2011-01-29  Stefan Monnier  <address@hidden>
+
+       * progmodes/compile.el: Avoid an N² behavior in grep.
+       (compilation--previous-directory): New fun.
+       (compilation--previous-directory-cache): New var.
+       (compilation--remove-properties): Flush it.
+       (compilation-directory-properties, compilation-error-properties):
+       Use the new fun to speed up looking for the current directory.
+
 2011-01-29  Chong Yidong  <address@hidden>
 
        * vc/vc-hg.el (vc-hg-history): New var.
@@ -18,8 +27,8 @@
        * vc/vc-bzr.el (vc-bzr-async-command): Convert into a wrapper for
        vc-do-async-command.
 
-       * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Callers
-       changed.
+       * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch):
+       Callers changed.
 
 2011-01-28  Leo  <address@hidden>
 

=== modified file 'lisp/progmodes/compile.el'
--- a/lisp/progmodes/compile.el 2011-01-28 22:06:20 +0000
+++ b/lisp/progmodes/compile.el 2011-01-29 06:08:24 +0000
@@ -834,6 +834,39 @@
             (:conc-name compilation--message->))
   loc type end-loc)
 
+(defvar compilation--previous-directory-cache nil)
+(make-variable-buffer-local 'compilation--previous-directory-cache)
+(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)
+        (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
 ;; is the stack of nested enter-messages.  Relative filenames on the following
@@ -841,7 +874,7 @@
 (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 (previous-single-property-change (point) 'compilation-directory)))
+  (let ((dir (compilation--previous-directory (point))))
     (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory)
                          (get-text-property dir 'compilation-directory))))
     `(font-lock-face ,(if leave
@@ -900,8 +933,7 @@
                             (match-string-no-properties file))))
          (let ((dir
            (unless (file-name-absolute-p file)
-                   (let ((pos (previous-single-property-change
-                               (point) 'compilation-directory)))
+                   (let ((pos (compilation--previous-directory (point))))
                      (when pos
                        (or (get-text-property (1- pos) 'compilation-directory)
                            (get-text-property pos 'compilation-directory)))))))
@@ -1064,6 +1096,14 @@
 
 (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