From 7023466ece21b43a62dc0a2502e84bea78b1501c Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Sat, 22 Mar 2014 11:51:06 +0000 Subject: [PATCH] Make keys of notmuch-tag-formats regexps and use caching 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 b8782ddb..019f51d7 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -1145,6 +1145,7 @@ function is used." ;; 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 41b16876..42c425ed 100644 --- a/emacs/notmuch-tag.el +++ b/emacs/notmuch-tag.el @@ -34,17 +34,21 @@ (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 @@ with images." :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 @@ This can be used with `notmuch-tag-format-image-data'." ") +(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 e3aa2cd9..c78d9de5 100644 --- a/emacs/notmuch-tree.el +++ b/emacs/notmuch-tree.el @@ -881,6 +881,7 @@ the same as for the function notmuch-tree." (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 9e39a76b..2e0b20eb 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -888,6 +888,7 @@ the configured default sort order." (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