Re: [PATCH v4 10/16] Add n_d_add_message_with_indexopts (extension of n_d_add_message)
[notmuch-archives.git] / 49 / 13b46f0112bcb8803133608910837c7581b385
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 1255C431FB6\r
6         for <notmuch@notmuchmail.org>; Fri, 17 Feb 2012 12:02:19 -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 1f0Jx+z65bdS for <notmuch@notmuchmail.org>;\r
16         Fri, 17 Feb 2012 12:02:15 -0800 (PST)\r
17 Received: from dmz-mailsec-scanner-5.mit.edu (DMZ-MAILSEC-SCANNER-5.MIT.EDU\r
18         [18.7.68.34])\r
19         by olra.theworths.org (Postfix) with ESMTP id 3C69B429E45\r
20         for <notmuch@notmuchmail.org>; Fri, 17 Feb 2012 12:02:15 -0800 (PST)\r
21 X-AuditID: 12074422-b7fd66d0000008f9-c3-4f3eb246d60e\r
22 Received: from mailhub-auth-2.mit.edu ( [18.7.62.36])\r
23         by dmz-mailsec-scanner-5.mit.edu (Symantec Messaging Gateway) with SMTP\r
24         id 31.09.02297.642BE3F4; Fri, 17 Feb 2012 15:02:14 -0500 (EST)\r
25 Received: from outgoing.mit.edu (OUTGOING-AUTH.MIT.EDU [18.7.22.103])\r
26         by mailhub-auth-2.mit.edu (8.13.8/8.9.2) with ESMTP id q1HK2Dr4004188; \r
27         Fri, 17 Feb 2012 15:02:14 -0500\r
28 Received: from awakening.csail.mit.edu (awakening.csail.mit.edu [18.26.4.91])\r
29         (authenticated bits=0)\r
30         (User authenticated as amdragon@ATHENA.MIT.EDU)\r
31         by outgoing.mit.edu (8.13.6/8.12.4) with ESMTP id q1HK2Cgt027955\r
32         (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);\r
33         Fri, 17 Feb 2012 15:02:13 -0500 (EST)\r
34 Received: from amthrax by awakening.csail.mit.edu with local (Exim 4.77)\r
35         (envelope-from <amdragon@mit.edu>)\r
36         id 1RyTyl-0003hq-NU; Fri, 17 Feb 2012 15:00:27 -0500\r
37 Date: Fri, 17 Feb 2012 15:00:17 -0500\r
38 From: Austin Clements <amdragon@MIT.EDU>\r
39 To: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
40 Subject: Re: [PATCH v5.2 7/7] emacs: Use the new JSON reply format and\r
41         message-cite-original\r
42 Message-ID: <20120217200017.GG5991@mit.edu>\r
43 References: <1329361957-28493-1-git-send-email-awg+notmuch@xvx.ca>\r
44         <1329361957-28493-8-git-send-email-awg+notmuch@xvx.ca>\r
45 MIME-Version: 1.0\r
46 Content-Type: text/plain; charset=us-ascii\r
47 Content-Disposition: inline\r
48 In-Reply-To: <1329361957-28493-8-git-send-email-awg+notmuch@xvx.ca>\r
49 User-Agent: Mutt/1.5.21 (2010-09-15)\r
50 X-Brightmail-Tracker:\r
51  H4sIAAAAAAAAA+NgFmpmleLIzCtJLcpLzFFi42IRYrdT0XXbZOdvsGS6rMWRPbPYLa7fnMns\r
52         wOTxbNUtZo+mH4tZA5iiuGxSUnMyy1KL9O0SuDJ+vN3AWNCTVfH74ALGBsYHIV2MnBwSAiYS\r
53         x95cZoewxSQu3FvP1sXIxSEksI9R4s+cTkYIZwOjxPvNi1ggnJNMEp3H90NlljBKbHl4kgmk\r
54         n0VAVWL3m61gs9gENCS27V/OCGKLCGhJ/Fj/lRXEZhaQlvj2uxmsXlggTuLb9ytA9RwcvALa\r
55         Elt35YOEhQSqJSb3n2EGsXkFBCVOznzCAtGqJXHj30smkHKQMcv/cYCEOQWcJZpe/AbbJCqg\r
56         IjHl5Da2CYxCs5B0z0LSPQuhewEj8ypG2ZTcKt3cxMyc4tRk3eLkxLy81CJdU73czBK91JTS\r
57         TYzgsHZR2sH486DSIUYBDkYlHt5XnXb+QqyJZcWVuYcYJTmYlER5v6wCCvEl5adUZiQWZ8QX\r
58         leakFh9ilOBgVhLh/ZYLlONNSaysSi3Kh0lJc7AoifOqa73zExJITyxJzU5NLUgtgsnKcHAo\r
59         SfBO3AjUKFiUmp5akZaZU4KQZuLgBBnOAzRcBKSGt7ggMbc4Mx0if4pRUUqctwMkIQCSyCjN\r
60         g+uFpZ1XjOJArwjzNoBU8QBTFlz3K6DBTECDeYXABpckIqSkGhjtIncbee+2P/GgyPXhxsfR\r
61         s6cIX3FhiD76Ovvu0uWKfjMEOb8eWSn2o+2599PK53OfuKm8W674Ilzbb4cQT8D9Lu98neUM\r
62         2n0Ha1fWp+ZOUp18K/h3+vUFfhurp9XPmNmRe8tixc5oSQ7T+YWJ2duP56+ct/yC/aqpk2u0\r
63         ZQr93vQ6bsvq6K9WYinOSDTUYi4qTgQAFINQJRYDAAA=\r
64 Cc: notmuch@notmuchmail.org\r
65 X-BeenThere: notmuch@notmuchmail.org\r
66 X-Mailman-Version: 2.1.13\r
67 Precedence: list\r
68 List-Id: "Use and development of the notmuch mail system."\r
69         <notmuch.notmuchmail.org>\r
70 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
71         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
72 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
73 List-Post: <mailto:notmuch@notmuchmail.org>\r
74 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
75 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
76         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
77 X-List-Received-Date: Fri, 17 Feb 2012 20:02:19 -0000\r
78 \r
79 Quoth Adam Wolfe Gordon on Feb 15 at  8:12 pm:\r
80 > Use the new JSON reply format to create replies in emacs. Quote HTML\r
81 > parts nicely by using mm-display-part to turn them into displayable\r
82 > text, then quoting them with message-cite-original. This is very\r
83 > useful for users who regularly receive HTML-only email.\r
84\r
85 > Use message-mode's message-cite-original function to create the\r
86 > quoted body for reply messages. In order to make this act like the\r
87 > existing notmuch defaults, you will need to set the following in\r
88 > your emacs configuration:\r
89\r
90 > message-citation-line-format "On %a, %d %b %Y, %f wrote:"\r
91 > message-citation-line-function 'message-insert-formatted-citation-line\r
92\r
93 > The tests have been updated to reflect the (ugly) emacs default.\r
94 \r
95 One general comment that affects a lot of things in this patch: I\r
96 think you should use the same JSON parsing settings that\r
97 notmuch-query-get-threads uses.  Besides consistency and more\r
98 opportunities for code reuse, using lists instead of vectors for JSON\r
99 arrays will simplify a lot of this code without any drawbacks.\r
100 \r
101 > ---\r
102 >  emacs/notmuch-lib.el |    6 ++\r
103 >  emacs/notmuch-mua.el |  127 +++++++++++++++++++++++++++++++++++---------------\r
104 >  test/emacs           |    8 ++--\r
105 >  3 files changed, 100 insertions(+), 41 deletions(-)\r
106\r
107 > diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
108 > index 7e3f110..3fc7aff 100644\r
109 > --- a/emacs/notmuch-lib.el\r
110 > +++ b/emacs/notmuch-lib.el\r
111 > @@ -206,6 +206,12 @@ the user hasn't set this variable with the old or new value."\r
112 >         (setq seq (nconc (delete elem seq) (list elem))))))\r
113 >      seq))\r
114 >  \r
115 > +(defun notmuch-parts-filter-by-type (parts type)\r
116 > +  "Given a vector of message parts, return a vector containing the ones matching the given type."\r
117 \r
118 Wrap at 72.\r
119 \r
120 > +  (loop for part across parts\r
121 > +     if (notmuch-match-content-type (cdr (assq 'content-type part)) type)\r
122 > +     vconcat (list part)))\r
123 \r
124 With lists, (and since we've decided it's okay to use cl):\r
125 \r
126   (remove-if-not\r
127    (lambda (part) (notmuch-match-content-type (cdr (assq 'content-type part)) type))\r
128    parts)\r
129 \r
130 > +\r
131 >  ;; Compatibility functions for versions of emacs before emacs 23.\r
132 >  ;;\r
133 >  ;; Both functions here were copied from emacs 23 with the following copyright:\r
134 > diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
135 > index 4be7c13..7d43821 100644\r
136 > --- a/emacs/notmuch-mua.el\r
137 > +++ b/emacs/notmuch-mua.el\r
138 > @@ -19,11 +19,15 @@\r
139 >  ;;\r
140 >  ;; Authors: David Edmondson <dme@dme.org>\r
141 >  \r
142 > +(require 'json)\r
143 >  (require 'message)\r
144 > +(require 'format-spec)\r
145 >  \r
146 >  (require 'notmuch-lib)\r
147 >  (require 'notmuch-address)\r
148 >  \r
149 > +(eval-when-compile (require 'cl))\r
150 > +\r
151 >  ;;\r
152 >  \r
153 >  (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)\r
154 > @@ -72,56 +76,105 @@ list."\r
155 >           (push header message-hidden-headers)))\r
156 >       notmuch-mua-hidden-headers))\r
157 >  \r
158 > +(defun notmuch-mua-get-displayed-part (part query-string)\r
159 > +  (with-temp-buffer\r
160 > +    (if (assq 'content part)\r
161 > +     (insert (cdr (assq 'content part)))\r
162 > +      (call-process notmuch-command nil t nil "show" "--format=raw"\r
163 > +                 (format "--part=%s" (cdr (assq 'id part)))\r
164 > +                 query-string))\r
165 > +\r
166 > +    (let ((handle (mm-make-handle (current-buffer) (list (cdr (assq 'content-type part)))))\r
167 > +       (end-of-orig (point-max)))\r
168 > +      (mm-display-part handle)\r
169 > +      (delete-region (point-min) end-of-orig)\r
170 > +      (buffer-substring (point-min) (point-max)))))\r
171 \r
172 One of the biggest wins of using consistent JSON parsing settings is\r
173 that this can be replaced with notmuch-show-mm-display-part-inline,\r
174 which, as far as I can tell, accomplishes the same thing, but handles\r
175 a lot of corner-cases that this doesn't (like crypto and charset\r
176 conversion).\r
177 \r
178 > +\r
179 > +(defun notmuch-mua-multipart/*-to-list (parts)\r
180 \r
181 This name isn't particularly informative to me (though, for reasons\r
182 below, I don't think this even needs to be a function).\r
183 \r
184 > +  (loop for part across parts\r
185 > +     collect (cdr (assq 'content-type part))))\r
186 \r
187 With lists,\r
188   (map (lambda (part) (cdr (assq 'content-type part))) parts)\r
189 \r
190 Actually, with lists and plists,\r
191   (map (lambda (part) (plist-get part 'content-type)) parts)\r
192 which I think is short enough and self-explanatory enough that it\r
193 doesn't even need to go in a function.\r
194 \r
195 > +\r
196 > +(defun notmuch-mua-get-quotable-parts (parts)\r
197 > +  (loop for part across parts\r
198 > +     if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/alternative")\r
199 > +       append (let* ((subparts (cdr (assq 'content part)))\r
200 > +                     (types (notmuch-mua-multipart/*-to-list subparts))\r
201 > +                     (chosen-type (car (notmuch-multipart/alternative-choose types))))\r
202 > +                (notmuch-mua-get-quotable-parts (notmuch-parts-filter-by-type subparts chosen-type)))\r
203 \r
204 This seems roundabout.  The point of multipart/alternative is that the\r
205 subparts are equivalent representations provided in order of\r
206 preference by the sender and that the client is supposed to choose\r
207 *one* of the alternates.  Even if multiple subparts have the same\r
208 content-type, they're still alternates, so we should insert only one\r
209 of them (and, since content-type is our only criteria for choosing\r
210 between alternates, we should use the last one of acceptable type,\r
211 since it was considered more preferential by the sender).\r
212 \r
213 > +     else if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/*")\r
214 > +       append (notmuch-mua-get-quotable-parts (cdr (assq 'content part)))\r
215 > +     else if (notmuch-match-content-type (cdr (assq 'content-type part)) "text/*")\r
216 > +       collect part))\r
217 > +\r
218 >  (defun notmuch-mua-reply (query-string &optional sender reply-all)\r
219 > -  (let (headers\r
220 > -     body\r
221 > -     (args '("reply")))\r
222 > -    (if notmuch-show-process-crypto\r
223 > -     (setq args (append args '("--decrypt"))))\r
224 > +  (let ((args '("reply" "--format=json"))\r
225 > +     reply\r
226 > +     original)\r
227 > +    (when notmuch-show-process-crypto\r
228 > +      (setq args (append args '("--decrypt"))))\r
229 \r
230 No need to change the last two lines above (though there's obviously\r
231 no harm in doing so).\r
232 \r
233 > +\r
234 >      (if reply-all\r
235 >       (setq args (append args '("--reply-to=all")))\r
236 >        (setq args (append args '("--reply-to=sender"))))\r
237 >      (setq args (append args (list query-string)))\r
238 > -    ;; This make assumptions about the output of `notmuch reply', but\r
239 > -    ;; really only that the headers come first followed by a blank\r
240 > -    ;; line and then the body.\r
241 > +\r
242 > +    ;; Get the reply object as JSON, and parse it into an elisp object.\r
243 >      (with-temp-buffer\r
244 >        (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
245 >        (goto-char (point-min))\r
246 > -      (if (re-search-forward "^$" nil t)\r
247 > -       (save-excursion\r
248 > -         (save-restriction\r
249 > -           (narrow-to-region (point-min) (point))\r
250 > -           (goto-char (point-min))\r
251 > -           (setq headers (mail-header-extract)))))\r
252 > -      (forward-line 1)\r
253 > -      (setq body (buffer-substring (point) (point-max))))\r
254 > -    ;; If sender is non-nil, set the From: header to its value.\r
255 > -    (when sender\r
256 > -      (mail-header-set 'from sender headers))\r
257 > -    (let\r
258 > -     ;; Overlay the composition window on that being used to read\r
259 > -     ;; the original message.\r
260 > -     ((same-window-regexps '("\\*mail .*")))\r
261 > -      (notmuch-mua-mail (mail-header 'to headers)\r
262 > -                     (mail-header 'subject headers)\r
263 > -                     (message-headers-to-generate headers t '(to subject))))\r
264 > -    ;; insert the message body - but put it in front of the signature\r
265 > -    ;; if one is present\r
266 > -    (goto-char (point-max))\r
267 > -    (if (re-search-backward message-signature-separator nil t)\r
268 > +      (setq reply (json-read)))\r
269 > +\r
270 > +    ;; Extract the original message to simplify the following code.\r
271 > +    (setq original (cdr (assq 'original reply)))\r
272 > +\r
273 > +    ;; Extract the headers of both the reply and the original message.\r
274 > +    (let* ((original-headers (cdr (assq 'headers original)))\r
275 > +        (reply-headers (cdr (assq 'reply-headers reply))))\r
276 \r
277 This is the one place where using the JSON parsing settings from\r
278 notmuch-query-get-threads is slightly annoying, since the mail-*\r
279 functions expect alists.  \r
280 \r
281 OTOH, the mail-* functions seem kind of pointless here; plist-set\r
282 could replace mail-header-set and plist-get could replace mail-header.\r
283 The only non-trivial function that expects an alist is\r
284 message-headers-to-generate (and, by extension, notmuch-mua-mail).\r
285 \r
286 > +\r
287 > +      ;; If sender is non-nil, set the From: header to its value.\r
288 > +      (when sender\r
289 > +     (mail-header-set 'From sender reply-headers))\r
290 > +      (let\r
291 > +       ;; Overlay the composition window on that being used to read\r
292 > +       ;; the original message.\r
293 > +       ((same-window-regexps '("\\*mail .*")))\r
294 > +     (notmuch-mua-mail (mail-header 'To reply-headers)\r
295 > +                       (mail-header 'Subject reply-headers)\r
296 > +                       (message-headers-to-generate reply-headers t '(To Subject))))\r
297 > +      ;; Insert the message body - but put it in front of the signature\r
298 > +      ;; if one is present\r
299 > +      (goto-char (point-max))\r
300 > +      (if (re-search-backward message-signature-separator nil t)\r
301 >         (forward-line -1)\r
302 > -      (goto-char (point-max)))\r
303 > -    (insert body)\r
304 > -    (push-mark))\r
305 > -  (set-buffer-modified-p nil)\r
306 > +     (goto-char (point-max)))\r
307 > +\r
308 > +      (let ((from (cdr (assq 'From original-headers)))\r
309 > +         (date (cdr (assq 'Date original-headers)))\r
310 > +         (start (point)))\r
311 > +\r
312 > +     (insert "From: " from "\n")\r
313 > +     (insert "Date: " date "\n\n")\r
314 \r
315 Sorry; I'm having trouble following the diff.  What are the inserts\r
316 for?\r
317 \r
318 > +\r
319 > +     ;; Get the parts of the original message that should be quoted; this includes\r
320 > +     ;; all the text parts, except the non-preferred ones in a multipart/alternative.\r
321 > +     (let ((quotable-parts (notmuch-mua-get-quotable-parts (cdr (assq 'body original)))))\r
322 > +       (mapc (lambda (part)\r
323 > +               (insert (notmuch-mua-get-displayed-part part query-string)))\r
324 > +             quotable-parts))\r
325 \r
326 Alternatively, notmuch-mua-get-quotable-parts could be\r
327 notmuch-mua-insert-quotable-parts, which would probably simplify\r
328 things a bit.  Your call.\r
329 \r
330 > +\r
331 > +     (push-mark)\r
332 \r
333 It's unfortunate that message-cite-original depends on the mark.\r
334 Since you're about to push the mark for the user anyway, maybe this\r
335 should be a set-mark so that only one mark gets pushed?\r
336 \r
337 > +     (goto-char start)\r
338 > +     ;; Quote the original message according to the user's configured style.\r
339 > +     (message-cite-original))))\r
340 \r
341 message-cite-original-without-signature?\r
342 \r
343 >  \r
344 > +  (push-mark)\r
345 \r
346 Is message-cite-original guaranteed to leave point in a reasonable\r
347 place for this or should we create our own marker above (probably\r
348 after the if re-search-backward..) and use it here to get point to the\r
349 right place?\r
350 \r
351 >    (message-goto-body)\r
352 >    ;; Original message may contain (malicious) MML tags.  We must\r
353 >    ;; properly quote them in the reply.  Note that using `point-max'\r
354 >    ;; instead of `mark' here is wrong.  The buffer may include user's\r
355 >    ;; signature which should not be MML-quoted.\r
356 > -  (mml-quote-region (point) (mark)))\r
357 > +  (mml-quote-region (point) (mark))\r
358 > +  (set-buffer-modified-p nil))\r
359 >  \r
360 >  (defun notmuch-mua-forward-message ()\r
361 >    (message-forward)\r
362 > @@ -147,7 +200,7 @@ OTHER-ARGS are passed through to `message-mail'."\r
363 >        (when (not (string= "" user-agent))\r
364 >       (push (cons "User-Agent" user-agent) other-headers))))\r
365 >  \r
366 > -  (unless (mail-header 'from other-headers)\r
367 > +  (unless (mail-header 'From other-headers)\r
368 >      (push (cons "From" (concat\r
369 >                       (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers))\r
370 >  \r
371 > @@ -210,7 +263,7 @@ the From: address first."\r
372 >    (interactive "P")\r
373 >    (let ((other-headers\r
374 >        (when (or prompt-for-sender notmuch-always-prompt-for-sender)\r
375 > -        (list (cons 'from (notmuch-mua-prompt-for-sender))))))\r
376 > +        (list (cons 'From (notmuch-mua-prompt-for-sender))))))\r
377 >      (notmuch-mua-mail nil nil other-headers)))\r
378 >  \r
379 >  (defun notmuch-mua-new-forward-message (&optional prompt-for-sender)\r
380 > diff --git a/test/emacs b/test/emacs\r
381 > index c3a75e9..a6786d4 100755\r
382 > --- a/test/emacs\r
383 > +++ b/test/emacs\r
384 > @@ -268,13 +268,13 @@ Subject: Re: Testing message sent via SMTP\r
385 >  In-Reply-To: <XXX>\r
386 >  Fcc: $(pwd)/mail/sent\r
387 >  --text follows this line--\r
388 > -On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
389 > +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
390 > +\r
391 >  > This is a test that messages are sent via SMTP\r
392 >  EOF\r
393 >  test_expect_equal_file OUTPUT EXPECTED\r
394 >  \r
395 >  test_begin_subtest "Reply within emacs to a multipart/mixed message"\r
396 > -test_subtest_known_broken\r
397 >  test_emacs '(notmuch-show "id:20091118002059.067214ed@hikari")\r
398 >               (notmuch-show-reply)\r
399 >               (test-output)'\r
400 > @@ -334,7 +334,6 @@ EOF\r
401 >  test_expect_equal_file OUTPUT EXPECTED\r
402 >  \r
403 >  test_begin_subtest "Reply within emacs to a multipart/alternative message"\r
404 > -test_subtest_known_broken\r
405 >  test_emacs '(notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com")\r
406 >               (notmuch-show-reply)\r
407 >               (test-output)'\r
408 > @@ -385,7 +384,8 @@ Subject: Re: Quote MML tags in reply\r
409 >  In-Reply-To: <test-emacs-mml-quoting@message.id>\r
410 >  Fcc: ${MAIL_DIR}/sent\r
411 >  --text follows this line--\r
412 > -On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
413 > +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
414 > +\r
415 >  > <#!part disposition=inline>\r
416 >  EOF\r
417 >  test_expect_equal_file OUTPUT EXPECTED\r