diff options
author | Austin Clements <amdragon@MIT.EDU> | 2014-03-22 11:51:06 +0000 |
---|---|---|
committer | David Bremner <david@tethera.net> | 2014-03-24 19:43:00 -0300 |
commit | 7023466ece21b43a62dc0a2502e84bea78b1501c (patch) | |
tree | e83eeed749e3694bdd2712a9dbe3a1c258b98c75 /emacs | |
parent | dfab8e5e49d90c415f9585a02a2b0d6f72b4083a (diff) |
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.
Diffstat (limited to 'emacs')
-rw-r--r-- | emacs/notmuch-show.el | 1 | ||||
-rw-r--r-- | emacs/notmuch-tag.el | 76 | ||||
-rw-r--r-- | emacs/notmuch-tree.el | 1 | ||||
-rw-r--r-- | 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'." </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 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 |