fd/e90025389813ea18d0e20ddcf1f7d8bd203b4d

   1 Return-Path: <amdragon@mit.edu>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id 3004B431FBD\r
   6         for <notmuch@notmuchmail.org>; Wed, 12 Feb 2014 09:32:47 -0800 (PST)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -0.7\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id UNW9tpZ9IQPp for <notmuch@notmuchmail.org>;\r
  16         Wed, 12 Feb 2014 09:32:41 -0800 (PST)\r
  17 Received: from dmz-mailsec-scanner-7.mit.edu (dmz-mailsec-scanner-7.mit.edu\r
  18         [18.7.68.36])\r
  19         (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits))\r
  20         (No client certificate requested)\r
  21         by olra.theworths.org (Postfix) with ESMTPS id AD4A2431FAE\r
  22         for <notmuch@notmuchmail.org>; Wed, 12 Feb 2014 09:32:40 -0800 (PST)\r
  23 X-AuditID: 12074424-f79e26d000000c70-aa-52fbb03632de\r
  24 Received: from mailhub-auth-4.mit.edu ( [18.7.62.39])\r
  25         (using TLS with cipher AES256-SHA (256/256 bits))\r
  26         (Client did not present a certificate)\r
  27         by dmz-mailsec-scanner-7.mit.edu (Symantec Messaging Gateway) with SMTP\r
  28         id 92.71.03184.630BBF25; Wed, 12 Feb 2014 12:32:38 -0500 (EST)\r
  29 Received: from outgoing.mit.edu (outgoing-auth-1.mit.edu [18.9.28.11])\r
  30         by mailhub-auth-4.mit.edu (8.13.8/8.9.2) with ESMTP id s1CHWahp014667; \r
  31         Wed, 12 Feb 2014 12:32:36 -0500\r
  32 Received: from drake.dyndns.org\r
  33         (216-15-114-40.c3-0.arl-ubr1.sbo-arl.ma.cable.rcn.com\r
  34         [216.15.114.40]) (authenticated bits=0)\r
  35         (User authenticated as amdragon@ATHENA.MIT.EDU)\r
  36         by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id s1CHWX4s032107\r
  37         (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);\r
  38         Wed, 12 Feb 2014 12:32:35 -0500\r
  39 Received: from amthrax by drake.dyndns.org with local (Exim 4.77)\r
  40         (envelope-from <amdragon@mit.edu>)\r
  41         id 1WDdfl-0008Bz-O4; Wed, 12 Feb 2014 12:32:33 -0500\r
  42 From: Austin Clements <amdragon@MIT.EDU>\r
  43 To: notmuch@notmuchmail.org\r
  44 Subject: [WIP PATCH] Make keys of notmuch-tag-formats regexps and use caching\r
  45 Date: Wed, 12 Feb 2014 12:32:31 -0500\r
  46 Message-Id: <1392226351-31440-1-git-send-email-amdragon@mit.edu>\r
  47 X-Mailer: git-send-email 1.8.4.rc3\r
  48 In-Reply-To: <87r479mf4g.fsf@awakening.csail.mit.edu>\r
  49 References: <87r479mf4g.fsf@awakening.csail.mit.edu>\r
  50 X-Brightmail-Tracker:\r
  51  H4sIAAAAAAAAA+NgFtrNIsWRmVeSWpSXmKPExsUixG6nrmu24XeQwbNNlhar5/JYXL85k9mB\r
  52         yWPnrLvsHs9W3WIOYIrisklJzcksSy3St0vgyvjweydzwXfjimWXghoYP2t0MXJySAiYSPRd\r
  53         /sAEYYtJXLi3nq2LkYtDSGA2k0T3z8lMEM5GRonvT/ZCZe4wSUxffIMFwpnLKLFgzw02kH42\r
  54         AQ2JbfuXM4LYIgLSEjvvzmYFsZkFHCU+718EVMPBISzgKzHneQFImEVAVaJp4Syw1bwCDhIN\r
  55         J68yQ5yhJLHw1DawVk4BU4lpax+AjRcCOrXp4zKmCYz8CxgZVjHKpuRW6eYmZuYUpybrFicn\r
  56         5uWlFuma6+VmluilppRuYgSHkYvKDsbmQ0qHGAU4GJV4eC9M/R0kxJpYVlyZe4hRkoNJSZT3\r
  57         +hqgEF9SfkplRmJxRnxRaU5q8SFGCQ5mJRFeo2agHG9KYmVValE+TEqag0VJnLfW4leQkEB6\r
  58         YklqdmpqQWoRTFaGg0NJgtdpPVCjYFFqempFWmZOCUKaiYMTZDgP0PAIkBre4oLE3OLMdIj8\r
  59         KUZFKXFeFZCEAEgiozQPrhcW568YxYFeEeZVBqniAaYIuO5XQIOZgAanRoENLklESEk1MCqn\r
  60         dCsG5clazj6ksv702nl9VyVXRk8pmm3B+Xyx+pa52xQOBC591LvtoaoNY/tWqyV/BL+mb5p5\r
  61         85vjrQw971drjsyVy1Vf9q2gzjrU9/R933sTAhkD+hJkd8wyULw6S8Np9wfWg7E3jvoH3g0V\r
  62         kPsUc2axtMxelk/Pjh5jO8aY5M+s7dC2olOJpTgj0VCLuag4EQBa3NsNzgIAAA==\r
  63 X-BeenThere: notmuch@notmuchmail.org\r
  64 X-Mailman-Version: 2.1.13\r
  65 Precedence: list\r
  66 List-Id: "Use and development of the notmuch mail system."\r
  67         <notmuch.notmuchmail.org>\r
  68 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  69         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  70 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  71 List-Post: <mailto:notmuch@notmuchmail.org>\r
  72 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  73 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  74         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  75 X-List-Received-Date: Wed, 12 Feb 2014 17:32:47 -0000\r
  76 \r
  77 This was a little hack to test the feasibility of switching\r
  78 notmuch-tag-formats to use regexps with caching for performance.  In\r
  79 the end it works fine and isn't particularly complex, though there\r
  80 were a few gotchas:\r
  81 \r
  82 1) We have to clear the cache somehow on changes to\r
  83 notmuch-tag-formats.  I opted to use a defcustom :set plus some\r
  84 documentation telling people what to do if they change it directly\r
  85 from Elisp.  This is less automatic than I would like, but I doubt\r
  86 people are changing this very often and I concluded that any machinery\r
  87 to automatically detect changes to notmuch-tag-formats would probably\r
  88 outweigh the benefits of caching.  Alternatively, we could require\r
  89 search/show/tree buffers to "opt in" to caching when they start\r
  90 building.\r
  91 \r
  92 2) I spent way too long trying to use assoc-default before realizing\r
  93 this it just wouldn't work, since there's no way to distinguish a\r
  94 missing key from a present key with a null cdr.  assoc* from cl works\r
  95 fine.\r
  96 \r
  97 Performance-wise, the caching of regexp lookup makes this just as fast\r
  98 as assoc for unformatted tags (it would probably be faster if someone\r
  99 had a really big `notmuch-tag-formats') and the caching of eval\r
 100 results makes this much *faster* than the current code for formatted\r
 101 tags.\r
 102 \r
 103                 inbox (usec)   unread (usec)\r
 104 assoc:              0.4            2.8\r
 105 regexp:             3.2            7.2\r
 106 regexp+caching:     0.4            0.4\r
 107 \r
 108 That said, even at 7.2 usec, tag formatting is still *very* fast\r
 109 (though regexp matching may get noticeably slower with larger\r
 110 `notmuch-tag-formats').  Tag formatting is nowhere near our top\r
 111 bottleneck.\r
 112 ---\r
 113  emacs/notmuch-tag.el | 75 +++++++++++++++++++++++++++++++++++++---------------\r
 114  1 file changed, 53 insertions(+), 22 deletions(-)\r
 115 \r
 116 diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el\r
 117 index b60f46c..07f5772 100644\r
 118 --- a/emacs/notmuch-tag.el\r
 119 +++ b/emacs/notmuch-tag.el\r
 120 @@ -28,35 +28,56 @@\r
 121  (require 'crm)\r
 122  (require 'notmuch-lib)\r
 123  \r
 124 +;; (notmuch-tag-clear-cache will be called by the defcustom\r
 125 +;; notmuch-tag-formats, so it has to be defined first.)\r
 126 +\r
 127 +(defvar notmuch-tag--format-cache (make-hash-table :test 'equal)\r
 128 +  "Cache of tag format lookup.  Internal to `notmuch-tag-format-tag'.")\r
 129 +\r
 130 +(defun notmuch-tag-clear-cache ()\r
 131 +  "Clear the internal cache of tag formats.\r
 132 +\r
 133 +This must be called after changes to `notmuch-tag-formats'."\r
 134 +  (clrhash notmuch-tag--format-cache))\r
 135 +\r
 136  (defcustom notmuch-tag-formats\r
 137    '(("unread" (propertize tag 'face '(:foreground "red")))\r
 138      ("flagged" (propertize tag 'face '(:foreground "blue"))\r
 139       (notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))\r
 140    "Custom formats for individual tags.\r
 141  \r
 142 -This gives a list that maps from tag names to lists of formatting\r
 143 -expressions.  The car of each element gives a tag name and the\r
 144 -cdr gives a list of Elisp expressions that modify the tag.  If\r
 145 -the list is empty, the tag will simply be hidden.  Otherwise,\r
 146 -each expression will be evaluated in order: for the first\r
 147 -expression, the variable `tag' will be bound to the tag name; for\r
 148 -each later expression, the variable `tag' will be bound to the\r
 149 -result of the previous expression.  In this way, each expression\r
 150 -can build on the formatting performed by the previous expression.\r
 151 -The result of the last expression will displayed in place of the\r
 152 -tag.\r
 153 +This is an association list that maps from tag name regexps to\r
 154 +lists of formatting expressions.  The first entry whose car\r
 155 +regexp-matches a tag will be used to format that tag.  The regexp\r
 156 +is implicitly anchored, so to match a literal tag name, just use\r
 157 +that tag name (if it contains special regexp characters like\r
 158 +\".\" or \"*\", these have to be escaped).  The cdr of the\r
 159 +matching entry gives a list of Elisp expressions that modify the\r
 160 +tag.  If the list is empty, the tag will simply be hidden.\r
 161 +Otherwise, each expression will be evaluated in order: for the\r
 162 +first expression, the variable `tag' will be bound to the tag\r
 163 +name; for each later expression, the variable `tag' will be bound\r
 164 +to the result of the previous expression.  In this way, each\r
 165 +expression can build on the formatting performed by the previous\r
 166 +expression.  The result of the last expression will displayed in\r
 167 +place of the tag.\r
 168  \r
 169  For example, to replace a tag with another string, simply use\r
 170  that string as a formatting expression.  To change the foreground\r
 171  of a tag to red, use the expression\r
 172    (propertize tag 'face '(:foreground \"red\"))\r
 173  \r
 174 +After modifying this variable in Elisp, be sure to call\r
 175 +`notmuch-tag-clear-cache'.  Modifying this via customize does\r
 176 +this automatically.\r
 177 +\r
 178  See also `notmuch-tag-format-image', which can help replace tags\r
 179  with images."\r
 180  \r
 181    :group 'notmuch-search\r
 182    :group 'notmuch-show\r
 183 -  :type '(alist :key-type (string :tag "Tag")\r
 184 +  :set (lambda (var val) (set-default var val) (notmuch-tag-clear-cache))\r
 185 +  :type '(alist :key-type (regexp :tag "Tag")\r
 186                 :extra-offset -3\r
 187                 :value-type\r
 188                 (radio :format "%v"\r
 189 @@ -137,16 +158,26 @@ This can be used with `notmuch-tag-format-image-data'."\r
 190  \r
 191  (defun notmuch-tag-format-tag (tag)\r
 192    "Format TAG by looking into `notmuch-tag-formats'."\r
 193 -  (let ((formats (assoc tag notmuch-tag-formats)))\r
 194 -    (cond\r
 195 -     ((null formats)           ;; - Tag not in `notmuch-tag-formats',\r
 196 -      tag)                     ;;   the format is the tag itself.\r
 197 -     ((null (cdr formats))     ;; - Tag was deliberately hidden,\r
 198 -      nil)                     ;;   no format must be returned\r
 199 -     (t                                ;; - Tag was found and has formats,\r
 200 -      (let ((tag tag))         ;;   we must apply all the formats.\r
 201 -       (dolist (format (cdr formats) tag)\r
 202 -         (setq tag (eval format))))))))\r
 203 +  (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))\r
 204 +    (when (eq formatted 'missing)\r
 205 +      (let* ((formats\r
 206 +             (save-match-data\r
 207 +               (assoc* tag notmuch-tag-formats\r
 208 +                       :test (lambda (key tag)\r
 209 +                               (and (eq (string-match key tag) 0)\r
 210 +                                    (= (match-end 0) (length tag))))))))\r
 211 +       (setq formatted\r
 212 +             (cond\r
 213 +              ((null formats)          ;; - Tag not in `notmuch-tag-formats',\r
 214 +               tag)                    ;;   the format is the tag itself.\r
 215 +              ((null (cdr formats))    ;; - Tag was deliberately hidden,\r
 216 +               nil)                    ;;   no format must be returned\r
 217 +              (t                       ;; - Tag was found and has formats,\r
 218 +               (let ((tag tag))        ;;   we must apply all the formats.\r
 219 +                 (dolist (format (cdr formats) tag)\r
 220 +                   (setq tag (eval format)))))))\r
 221 +       (puthash tag formatted notmuch-tag--format-cache)))\r
 222 +    formatted))\r
 223  \r
 224  (defun notmuch-tag-format-tags (tags)\r
 225    "Return a string representing formatted TAGS."\r
 226 -- \r
 227 1.8.4.rc3\r
 228 \r