[Patch v4 2/8] Make keys of notmuch-tag-formats regexps and use caching
Mark Walters
markwalters1009 at gmail.com
Sat Mar 22 04:51:06 PDT 2014
From: Austin Clements <amdragon at MIT.EDU>
This modifies `notmuch-tag-format-tag' to treat the keys of
`notmuch-tag-formats' as (anchored) regexps, rather than literal
strings. This is clearly more flexible, as it allows for prefix
matching, defining a fallback format, etc. This may cause compatibility
problems if people have customized `notmuch-tag-formats' to match tags
that contain regexp specials, but this seems unlikely.
Regular expression matching has quite a performance hit over string
lookup, so this also introduces a simple cache from exact tags to
formatted strings. The number of unique tags is likely to be quite
small, so this cache should have a high hit rate. In addition to
eliminating the regexp lookup in the common case, this cache stores
fully formatted tags, eliminating the repeated evaluation of potentially
expensive, user-specified formatting code. This makes regexp lookup at
least as fast as assoc for unformatted tags (e.g., inbox) and *faster*
than the current code for formatted tags (e.g., unread):
inbox (usec) unread (usec)
assoc: 0.4 2.8
regexp: 3.2 7.2
regexp+caching: 0.4 0.4
(Though even at 7.2 usec, tag formatting is not our top bottleneck.)
This cache must be explicitly cleared to keep it coherent, so this adds
the appropriate clearing calls.
---
emacs/notmuch-show.el | 1 +
emacs/notmuch-tag.el | 76 ++++++++++++++++++++++++++++++++++---------------
emacs/notmuch-tree.el | 1 +
emacs/notmuch.el | 1 +
4 files changed, 56 insertions(+), 23 deletions(-)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index b8782dd..019f51d 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -1145,6 +1145,7 @@ (defun notmuch-show-build-buffer ()
;; Don't track undo information for this buffer
(set 'buffer-undo-list t)
+ (notmuch-tag-clear-cache)
(erase-buffer)
(goto-char (point-min))
(save-excursion
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 41b1687..42c425e 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -34,17 +34,21 @@ (defcustom notmuch-tag-formats
(notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))
"Custom formats for individual tags.
-This gives a list that maps from tag names to lists of formatting
-expressions. The car of each element gives a tag name and the
-cdr gives a list of Elisp expressions that modify the tag. If
-the list is empty, the tag will simply be hidden. Otherwise,
-each expression will be evaluated in order: for the first
-expression, the variable `tag' will be bound to the tag name; for
-each later expression, the variable `tag' will be bound to the
-result of the previous expression. In this way, each expression
-can build on the formatting performed by the previous expression.
-The result of the last expression will displayed in place of the
-tag.
+This is an association list that maps from tag name regexps to
+lists of formatting expressions. The first entry whose car
+regexp-matches a tag will be used to format that tag. The regexp
+is implicitly anchored, so to match a literal tag name, just use
+that tag name (if it contains special regexp characters like
+\".\" or \"*\", these have to be escaped). The cdr of the
+matching entry gives a list of Elisp expressions that modify the
+tag. If the list is empty, the tag will simply be hidden.
+Otherwise, each expression will be evaluated in order: for the
+first expression, the variable `tag' will be bound to the tag
+name; for each later expression, the variable `tag' will be bound
+to the result of the previous expression. In this way, each
+expression can build on the formatting performed by the previous
+expression. The result of the last expression will displayed in
+place of the tag.
For example, to replace a tag with another string, simply use
that string as a formatting expression. To change the foreground
@@ -56,7 +60,7 @@ (defcustom notmuch-tag-formats
:group 'notmuch-search
:group 'notmuch-show
- :type '(alist :key-type (string :tag "Tag")
+ :type '(alist :key-type (regexp :tag "Tag")
:extra-offset -3
:value-type
(radio :format "%v"
@@ -135,18 +139,44 @@ (defun notmuch-tag-tag-icon ()
</g>
</svg>")
+(defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
+ "Cache of tag format lookup. Internal to `notmuch-tag-format-tag'.")
+
+(defun notmuch-tag-clear-cache ()
+ "Clear the internal cache of tag formats."
+ (clrhash notmuch-tag--format-cache))
+
(defun notmuch-tag-format-tag (tag)
- "Format TAG by looking into `notmuch-tag-formats'."
- (let ((formats (assoc tag notmuch-tag-formats)))
- (cond
- ((null formats) ;; - Tag not in `notmuch-tag-formats',
- tag) ;; the format is the tag itself.
- ((null (cdr formats)) ;; - Tag was deliberately hidden,
- nil) ;; no format must be returned
- (t ;; - Tag was found and has formats,
- (let ((tag tag)) ;; we must apply all the formats.
- (dolist (format (cdr formats) tag)
- (setq tag (eval format))))))))
+ "Format TAG by according to `notmuch-tag-formats'.
+
+Callers must ensure that the tag format cache has been recently cleared
+via `notmuch-tag-clear-cache' before using this function. For example,
+it would be appropriate to clear the cache just prior to filling a
+buffer that uses formatted tags."
+
+ (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))
+ (when (eq formatted 'missing)
+ (let* ((formats
+ (save-match-data
+ ;; Don't use assoc-default since there's no way to
+ ;; distinguish a missing key from a present key with a
+ ;; null cdr:.
+ (assoc* tag notmuch-tag-formats
+ :test (lambda (tag key)
+ (and (eq (string-match key tag) 0)
+ (= (match-end 0) (length tag))))))))
+ (setq formatted
+ (cond
+ ((null formats) ;; - Tag not in `notmuch-tag-formats',
+ tag) ;; the format is the tag itself.
+ ((null (cdr formats)) ;; - Tag was deliberately hidden,
+ nil) ;; no format must be returned
+ (t ;; - Tag was found and has formats,
+ (let ((tag tag)) ;; we must apply all the formats.
+ (dolist (format (cdr formats) tag)
+ (setq tag (eval format)))))))
+ (puthash tag formatted notmuch-tag--format-cache)))
+ formatted))
(defun notmuch-tag-format-tags (tags &optional face)
"Return a string representing formatted TAGS."
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index e3aa2cd..c78d9de 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -881,6 +881,7 @@ (defun notmuch-tree-worker (basic-query &optional query-context target open-targ
(message-arg "--entire-thread"))
(if (equal (car (process-lines notmuch-command "count" search-args)) "0")
(setq search-args basic-query))
+ (notmuch-tag-clear-cache)
(let ((proc (notmuch-start-notmuch
"notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
"show" "--body=false" "--format=sexp"
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 5cddaac..93a6d8b 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -888,6 +888,7 @@ (defun notmuch-search (&optional query oldest-first target-thread target-line)
(set 'notmuch-search-oldest-first oldest-first)
(set 'notmuch-search-target-thread target-thread)
(set 'notmuch-search-target-line target-line)
+ (notmuch-tag-clear-cache)
(let ((proc (get-buffer-process (current-buffer)))
(inhibit-read-only t))
(if proc
--
1.7.10.4
More information about the notmuch
mailing list