Re: [PATCH] emacs: wash: make word-wrap bound message width
[notmuch-archives.git] / 46 / 6d25db88489a0004a41082de06dbf409848a4a
1 Return-Path: <markwalters1009@gmail.com>\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 E94AA431FDD\r
6         for <notmuch@notmuchmail.org>; Tue, 11 Mar 2014 21:10:16 -0700 (PDT)\r
7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
8 X-Spam-Flag: NO\r
9 X-Spam-Score: 0.201\r
10 X-Spam-Level: \r
11 X-Spam-Status: No, score=0.201 tagged_above=-999 required=5\r
12         tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,\r
13         FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001,\r
14         RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
15 Received: from olra.theworths.org ([127.0.0.1])\r
16         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
17         with ESMTP id UpHOvvnA1fFD for <notmuch@notmuchmail.org>;\r
18         Tue, 11 Mar 2014 21:10:11 -0700 (PDT)\r
19 Received: from mail-we0-f170.google.com (mail-we0-f170.google.com\r
20         [74.125.82.170]) (using TLSv1 with cipher RC4-SHA (128/128 bits))\r
21         (No client certificate requested)\r
22         by olra.theworths.org (Postfix) with ESMTPS id 07705431FC0\r
23         for <notmuch@notmuchmail.org>; Tue, 11 Mar 2014 21:10:05 -0700 (PDT)\r
24 Received: by mail-we0-f170.google.com with SMTP id w61so10855963wes.29\r
25         for <notmuch@notmuchmail.org>; Tue, 11 Mar 2014 21:10:04 -0700 (PDT)\r
26 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113;\r
27         h=from:to:cc:subject:date:message-id:in-reply-to:references;\r
28         bh=vOG0Ucutj77Mee29PPwYDdYr0Zwp8o2EvB/M5igfMu4=;\r
29         b=fvWG7TiUt5CeuMWvjDTjPlWALs9uDaxs6nGB7wDGFMrdrGzsG2fKIt9gSUncYFvIpw\r
30         iQeytLRNp+7Wsc40i47YRtnywEnPX55apE0dpYc80joFdoVLi0aVsMnJhjZpnLexac42\r
31         CefY5uaUpJqHIvx3HOlEPYlgjHa/MDTumX8LxnSfrNzqLoHhxk4W1jrvz2MdvF/xjM1o\r
32         HPWa2dFQr8bSPJt5QXQCaTslhKo6oO9yclWi79ozeX4iNksDYLrEBaYIBoO/EjnV41C1\r
33         JcKrmSxEKNAYcTXtn8HwAMDfrP/fZ9XQvsgNbcvInQLuKZ4lWH18FPLjklVjoStu7dSM\r
34         3Wpw==\r
35 X-Received: by 10.180.77.200 with SMTP id u8mr5722144wiw.48.1394597404894;\r
36         Tue, 11 Mar 2014 21:10:04 -0700 (PDT)\r
37 Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31])\r
38         by mx.google.com with ESMTPSA id h9sm66460489wjz.16.2014.03.11.21.10.03\r
39         for <multiple recipients>\r
40         (version=TLSv1.2 cipher=RC4-SHA bits=128/128);\r
41         Tue, 11 Mar 2014 21:10:04 -0700 (PDT)\r
42 From: Mark Walters <markwalters1009@gmail.com>\r
43 To: notmuch@notmuchmail.org,\r
44         amdragon@mit.edu\r
45 Subject: [Patch v3 2/8] Make keys of notmuch-tag-formats regexps and use\r
46         caching\r
47 Date: Wed, 12 Mar 2014 04:09:51 +0000\r
48 Message-Id: <1394597397-8486-3-git-send-email-markwalters1009@gmail.com>\r
49 X-Mailer: git-send-email 1.7.9.1\r
50 In-Reply-To: <1394597397-8486-1-git-send-email-markwalters1009@gmail.com>\r
51 References: <1394597397-8486-1-git-send-email-markwalters1009@gmail.com>\r
52 X-BeenThere: notmuch@notmuchmail.org\r
53 X-Mailman-Version: 2.1.13\r
54 Precedence: list\r
55 List-Id: "Use and development of the notmuch mail system."\r
56         <notmuch.notmuchmail.org>\r
57 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
58         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
59 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
60 List-Post: <mailto:notmuch@notmuchmail.org>\r
61 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
62 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
63         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
64 X-List-Received-Date: Wed, 12 Mar 2014 04:10:17 -0000\r
65 \r
66 From: Austin Clements <amdragon@MIT.EDU>\r
67 \r
68 This modifies `notmuch-tag-format-tag' to treat the keys of\r
69 `notmuch-tag-formats' as (anchored) regexps, rather than literal\r
70 strings.  This is clearly more flexible, as it allows for prefix\r
71 matching, defining a fallback format, etc.  This may cause compatibility\r
72 problems if people have customized `notmuch-tag-formats' to match tags\r
73 that contain regexp specials, but this seems unlikely.\r
74 \r
75 Regular expression matching has quite a performance hit over string\r
76 lookup, so this also introduces a simple cache from exact tags to\r
77 formatted strings.  The number of unique tags is likely to be quite\r
78 small, so this cache should have a high hit rate.  In addition to\r
79 eliminating the regexp lookup in the common case, this cache stores\r
80 fully formatted tags, eliminating the repeated evaluation of potentially\r
81 expensive, user-specified formatting code.  This makes regexp lookup at\r
82 least as fast as assoc for unformatted tags (e.g., inbox) and *faster*\r
83 than the current code for formatted tags (e.g., unread):\r
84 \r
85                     inbox (usec)   unread (usec)\r
86     assoc:              0.4            2.8\r
87     regexp:             3.2            7.2\r
88     regexp+caching:     0.4            0.4\r
89 \r
90 (Though even at 7.2 usec, tag formatting is not our top bottleneck.)\r
91 \r
92 This cache must be explicitly cleared to keep it coherent, so this adds\r
93 the appropriate clearing calls.\r
94 ---\r
95  emacs/notmuch-show.el |    1 +\r
96  emacs/notmuch-tag.el  |   76 ++++++++++++++++++++++++++++++++++---------------\r
97  emacs/notmuch-tree.el |    1 +\r
98  emacs/notmuch.el      |    1 +\r
99  4 files changed, 56 insertions(+), 23 deletions(-)\r
100 \r
101 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
102 index b8782dd..019f51d 100644\r
103 --- a/emacs/notmuch-show.el\r
104 +++ b/emacs/notmuch-show.el\r
105 @@ -1145,6 +1145,7 @@ (defun notmuch-show-build-buffer ()\r
106      ;; Don't track undo information for this buffer\r
107      (set 'buffer-undo-list t)\r
108  \r
109 +    (notmuch-tag-clear-cache)\r
110      (erase-buffer)\r
111      (goto-char (point-min))\r
112      (save-excursion\r
113 diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el\r
114 index 41b1687..42c425e 100644\r
115 --- a/emacs/notmuch-tag.el\r
116 +++ b/emacs/notmuch-tag.el\r
117 @@ -34,17 +34,21 @@ (defcustom notmuch-tag-formats\r
118       (notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))\r
119    "Custom formats for individual tags.\r
120  \r
121 -This gives a list that maps from tag names to lists of formatting\r
122 -expressions.  The car of each element gives a tag name and the\r
123 -cdr gives a list of Elisp expressions that modify the tag.  If\r
124 -the list is empty, the tag will simply be hidden.  Otherwise,\r
125 -each expression will be evaluated in order: for the first\r
126 -expression, the variable `tag' will be bound to the tag name; for\r
127 -each later expression, the variable `tag' will be bound to the\r
128 -result of the previous expression.  In this way, each expression\r
129 -can build on the formatting performed by the previous expression.\r
130 -The result of the last expression will displayed in place of the\r
131 -tag.\r
132 +This is an association list that maps from tag name regexps to\r
133 +lists of formatting expressions.  The first entry whose car\r
134 +regexp-matches a tag will be used to format that tag.  The regexp\r
135 +is implicitly anchored, so to match a literal tag name, just use\r
136 +that tag name (if it contains special regexp characters like\r
137 +\".\" or \"*\", these have to be escaped).  The cdr of the\r
138 +matching entry gives a list of Elisp expressions that modify the\r
139 +tag.  If the list is empty, the tag will simply be hidden.\r
140 +Otherwise, each expression will be evaluated in order: for the\r
141 +first expression, the variable `tag' will be bound to the tag\r
142 +name; for each later expression, the variable `tag' will be bound\r
143 +to the result of the previous expression.  In this way, each\r
144 +expression can build on the formatting performed by the previous\r
145 +expression.  The result of the last expression will displayed in\r
146 +place of the tag.\r
147  \r
148  For example, to replace a tag with another string, simply use\r
149  that string as a formatting expression.  To change the foreground\r
150 @@ -56,7 +60,7 @@ (defcustom notmuch-tag-formats\r
151  \r
152    :group 'notmuch-search\r
153    :group 'notmuch-show\r
154 -  :type '(alist :key-type (string :tag "Tag")\r
155 +  :type '(alist :key-type (regexp :tag "Tag")\r
156                 :extra-offset -3\r
157                 :value-type\r
158                 (radio :format "%v"\r
159 @@ -135,18 +139,44 @@ (defun notmuch-tag-tag-icon ()\r
160    </g>\r
161  </svg>")\r
162  \r
163 +(defvar notmuch-tag--format-cache (make-hash-table :test 'equal)\r
164 +  "Cache of tag format lookup.  Internal to `notmuch-tag-format-tag'.")\r
165 +\r
166 +(defun notmuch-tag-clear-cache ()\r
167 +  "Clear the internal cache of tag formats."\r
168 +  (clrhash notmuch-tag--format-cache))\r
169 +\r
170  (defun notmuch-tag-format-tag (tag)\r
171 -  "Format TAG by looking into `notmuch-tag-formats'."\r
172 -  (let ((formats (assoc tag notmuch-tag-formats)))\r
173 -    (cond\r
174 -     ((null formats)           ;; - Tag not in `notmuch-tag-formats',\r
175 -      tag)                     ;;   the format is the tag itself.\r
176 -     ((null (cdr formats))     ;; - Tag was deliberately hidden,\r
177 -      nil)                     ;;   no format must be returned\r
178 -     (t                                ;; - Tag was found and has formats,\r
179 -      (let ((tag tag))         ;;   we must apply all the formats.\r
180 -       (dolist (format (cdr formats) tag)\r
181 -         (setq tag (eval format))))))))\r
182 +  "Format TAG by according to `notmuch-tag-formats'.\r
183 +\r
184 +Callers must ensure that the tag format cache has been recently cleared\r
185 +via `notmuch-tag-clear-cache' before using this function.  For example,\r
186 +it would be appropriate to clear the cache just prior to filling a\r
187 +buffer that uses formatted tags."\r
188 +\r
189 +  (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))\r
190 +    (when (eq formatted 'missing)\r
191 +      (let* ((formats\r
192 +             (save-match-data\r
193 +               ;; Don't use assoc-default since there's no way to\r
194 +               ;; distinguish a missing key from a present key with a\r
195 +               ;; null cdr:.\r
196 +               (assoc* tag notmuch-tag-formats\r
197 +                       :test (lambda (tag key)\r
198 +                               (and (eq (string-match key tag) 0)\r
199 +                                    (= (match-end 0) (length tag))))))))\r
200 +       (setq formatted\r
201 +             (cond\r
202 +              ((null formats)          ;; - Tag not in `notmuch-tag-formats',\r
203 +               tag)                    ;;   the format is the tag itself.\r
204 +              ((null (cdr formats))    ;; - Tag was deliberately hidden,\r
205 +               nil)                    ;;   no format must be returned\r
206 +              (t                       ;; - Tag was found and has formats,\r
207 +               (let ((tag tag))        ;;   we must apply all the formats.\r
208 +                 (dolist (format (cdr formats) tag)\r
209 +                   (setq tag (eval format)))))))\r
210 +       (puthash tag formatted notmuch-tag--format-cache)))\r
211 +    formatted))\r
212  \r
213  (defun notmuch-tag-format-tags (tags &optional face)\r
214    "Return a string representing formatted TAGS."\r
215 diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el\r
216 index e3aa2cd..c78d9de 100644\r
217 --- a/emacs/notmuch-tree.el\r
218 +++ b/emacs/notmuch-tree.el\r
219 @@ -881,6 +881,7 @@ (defun notmuch-tree-worker (basic-query &optional query-context target open-targ\r
220          (message-arg "--entire-thread"))\r
221      (if (equal (car (process-lines notmuch-command "count" search-args)) "0")\r
222         (setq search-args basic-query))\r
223 +    (notmuch-tag-clear-cache)\r
224      (let ((proc (notmuch-start-notmuch\r
225                  "notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel\r
226                  "show" "--body=false" "--format=sexp"\r
227 diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
228 index 5cddaac..93a6d8b 100644\r
229 --- a/emacs/notmuch.el\r
230 +++ b/emacs/notmuch.el\r
231 @@ -888,6 +888,7 @@ (defun notmuch-search (&optional query oldest-first target-thread target-line)\r
232      (set 'notmuch-search-oldest-first oldest-first)\r
233      (set 'notmuch-search-target-thread target-thread)\r
234      (set 'notmuch-search-target-line target-line)\r
235 +    (notmuch-tag-clear-cache)\r
236      (let ((proc (get-buffer-process (current-buffer)))\r
237           (inhibit-read-only t))\r
238        (if proc\r
239 -- \r
240 1.7.9.1\r
241 \r