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.
This commit is contained in:
Austin Clements 2014-03-22 11:51:06 +00:00 committed by David Bremner
parent dfab8e5e49
commit 7023466ece
4 changed files with 56 additions and 23 deletions

View file

@ -1145,6 +1145,7 @@ function is used."
;; Don't track undo information for this buffer ;; Don't track undo information for this buffer
(set 'buffer-undo-list t) (set 'buffer-undo-list t)
(notmuch-tag-clear-cache)
(erase-buffer) (erase-buffer)
(goto-char (point-min)) (goto-char (point-min))
(save-excursion (save-excursion

View file

@ -34,17 +34,21 @@
(notmuch-tag-format-image-data tag (notmuch-tag-star-icon)))) (notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))
"Custom formats for individual tags. "Custom formats for individual tags.
This gives a list that maps from tag names to lists of formatting This is an association list that maps from tag name regexps to
expressions. The car of each element gives a tag name and the lists of formatting expressions. The first entry whose car
cdr gives a list of Elisp expressions that modify the tag. If regexp-matches a tag will be used to format that tag. The regexp
the list is empty, the tag will simply be hidden. Otherwise, is implicitly anchored, so to match a literal tag name, just use
each expression will be evaluated in order: for the first that tag name (if it contains special regexp characters like
expression, the variable `tag' will be bound to the tag name; for \".\" or \"*\", these have to be escaped). The cdr of the
each later expression, the variable `tag' will be bound to the matching entry gives a list of Elisp expressions that modify the
result of the previous expression. In this way, each expression tag. If the list is empty, the tag will simply be hidden.
can build on the formatting performed by the previous expression. Otherwise, each expression will be evaluated in order: for the
The result of the last expression will displayed in place of the first expression, the variable `tag' will be bound to the tag
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 For example, to replace a tag with another string, simply use
that string as a formatting expression. To change the foreground that string as a formatting expression. To change the foreground
@ -56,7 +60,7 @@ with images."
:group 'notmuch-search :group 'notmuch-search
:group 'notmuch-show :group 'notmuch-show
:type '(alist :key-type (string :tag "Tag") :type '(alist :key-type (regexp :tag "Tag")
:extra-offset -3 :extra-offset -3
:value-type :value-type
(radio :format "%v" (radio :format "%v"
@ -135,9 +139,33 @@ This can be used with `notmuch-tag-format-image-data'."
</g> </g>
</svg>") </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) (defun notmuch-tag-format-tag (tag)
"Format TAG by looking into `notmuch-tag-formats'." "Format TAG by according to `notmuch-tag-formats'.
(let ((formats (assoc tag 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 (cond
((null formats) ;; - Tag not in `notmuch-tag-formats', ((null formats) ;; - Tag not in `notmuch-tag-formats',
tag) ;; the format is the tag itself. tag) ;; the format is the tag itself.
@ -146,7 +174,9 @@ This can be used with `notmuch-tag-format-image-data'."
(t ;; - Tag was found and has formats, (t ;; - Tag was found and has formats,
(let ((tag tag)) ;; we must apply all the formats. (let ((tag tag)) ;; we must apply all the formats.
(dolist (format (cdr formats) tag) (dolist (format (cdr formats) tag)
(setq tag (eval format)))))))) (setq tag (eval format)))))))
(puthash tag formatted notmuch-tag--format-cache)))
formatted))
(defun notmuch-tag-format-tags (tags &optional face) (defun notmuch-tag-format-tags (tags &optional face)
"Return a string representing formatted TAGS." "Return a string representing formatted TAGS."

View file

@ -881,6 +881,7 @@ the same as for the function notmuch-tree."
(message-arg "--entire-thread")) (message-arg "--entire-thread"))
(if (equal (car (process-lines notmuch-command "count" search-args)) "0") (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
(setq search-args basic-query)) (setq search-args basic-query))
(notmuch-tag-clear-cache)
(let ((proc (notmuch-start-notmuch (let ((proc (notmuch-start-notmuch
"notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel "notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
"show" "--body=false" "--format=sexp" "show" "--body=false" "--format=sexp"

View file

@ -888,6 +888,7 @@ the configured default sort order."
(set 'notmuch-search-oldest-first oldest-first) (set 'notmuch-search-oldest-first oldest-first)
(set 'notmuch-search-target-thread target-thread) (set 'notmuch-search-target-thread target-thread)
(set 'notmuch-search-target-line target-line) (set 'notmuch-search-target-line target-line)
(notmuch-tag-clear-cache)
(let ((proc (get-buffer-process (current-buffer))) (let ((proc (get-buffer-process (current-buffer)))
(inhibit-read-only t)) (inhibit-read-only t))
(if proc (if proc