From e52f87a1c0ac9e6f04c1047d2b4828744e83f7ba Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 29 Jan 2011 01:08:24 -0500 Subject: [PATCH] =?utf8?q?*=20lisp/progmodes/compile.el:=20Avoid=20an=20N?= =?utf8?q?=C2=B2=20behavior=20in=20grep.=20(compilation--previous-director?= =?utf8?q?y):=20New=20fun.=20(compilation--previous-directory-cache):=20Ne?= =?utf8?q?w=20var.=20(compilation--remove-properties):=20Flush=20it.=20(co?= =?utf8?q?mpilation-directory-properties,=20compilation-error-properties):?= =?utf8?q?=20Use=20the=20new=20fun=20to=20speed=20up=20looking=20for=20the?= =?utf8?q?=20current=20directory.?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- lisp/ChangeLog | 13 +++++++++-- lisp/progmodes/compile.el | 46 ++++++++++++++++++++++++++++++++++++--- 2 files changed, 54 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 41242360c60..1b833abe3cf 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2011-01-29 Stefan Monnier + + * 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 * 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 diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index cbbaa4dc68a..5bb3bf227f2 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -834,6 +834,39 @@ from a different message." (: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 @@ from a different message." (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 @@ from a different message." (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 @@ 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 -- 2.39.5