From: Austin Clements <amdragon@MIT.EDU>
To: notmuch@notmuchmail.org
Subject: [WIP PATCH] Make keys of notmuch-tag-formats regexps and use caching
Date: Wed, 12 Feb 2014 12:32:31 -0500
Message-Id: <1392226351-31440-1-git-send-email-amdragon@mit.edu>
In-Reply-To: <87r479mf4g.fsf@awakening.csail.mit.edu>
References: <87r479mf4g.fsf@awakening.csail.mit.edu>
Precedence: list

This was a little hack to test the feasibility of switching
notmuch-tag-formats to use regexps with caching for performance.  In
the end it works fine and isn't particularly complex, though there
were a few gotchas:

1) We have to clear the cache somehow on changes to
notmuch-tag-formats.  I opted to use a defcustom :set plus some
documentation telling people what to do if they change it directly
from Elisp.  This is less automatic than I would like, but I doubt
people are changing this very often and I concluded that any machinery
to automatically detect changes to notmuch-tag-formats would probably
outweigh the benefits of caching.  Alternatively, we could require
search/show/tree buffers to "opt in" to caching when they start
building.

2) I spent way too long trying to use assoc-default before realizing
this it just wouldn't work, since there's no way to distinguish a
missing key from a present key with a null cdr.  assoc* from cl works
fine.

Performance-wise, the caching of regexp lookup makes this just as fast
as assoc for unformatted tags (it would probably be faster if someone
had a really big `notmuch-tag-formats') and the caching of eval
results makes this much *faster* than the current code for formatted
tags.

                inbox (usec)   unread (usec)
assoc:              0.4            2.8
regexp:             3.2            7.2
regexp+caching:     0.4            0.4

That said, even at 7.2 usec, tag formatting is still *very* fast
(though regexp matching may get noticeably slower with larger
`notmuch-tag-formats').  Tag formatting is nowhere near our top
bottleneck.
---
 emacs/notmuch-tag.el | 75 +++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 53 insertions(+), 22 deletions(-)

diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index b60f46c..07f5772 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -28,35 +28,56 @@
 (require 'crm)
 (require 'notmuch-lib)
 
+;; (notmuch-tag-clear-cache will be called by the defcustom
+;; notmuch-tag-formats, so it has to be defined first.)
+
+(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.
+
+This must be called after changes to `notmuch-tag-formats'."
+  (clrhash notmuch-tag--format-cache))
+
 (defcustom notmuch-tag-formats
   '(("unread" (propertize tag 'face '(:foreground "red")))
     ("flagged" (propertize tag 'face '(:foreground "blue"))
      (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
 of a tag to red, use the expression
   (propertize tag 'face '(:foreground \"red\"))
 
+After modifying this variable in Elisp, be sure to call
+`notmuch-tag-clear-cache'.  Modifying this via customize does
+this automatically.
+
 See also `notmuch-tag-format-image', which can help replace tags
 with images."
 
   :group 'notmuch-search
   :group 'notmuch-show
-  :type '(alist :key-type (string :tag "Tag")
+  :set (lambda (var val) (set-default var val) (notmuch-tag-clear-cache))
+  :type '(alist :key-type (regexp :tag "Tag")
 		:extra-offset -3
 		:value-type
 		(radio :format "%v"
@@ -137,16 +158,26 @@ This can be used with `notmuch-tag-format-image-data'."
 
 (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))))))))
+  (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))
+    (when (eq formatted 'missing)
+      (let* ((formats
+	      (save-match-data
+		(assoc* tag notmuch-tag-formats
+			:test (lambda (key tag)
+				(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)
   "Return a string representing formatted TAGS."
-- 
1.8.4.rc3