Re: [PATCH v5.2 7/7] emacs: Use the new JSON reply format and message-cite-original
authorAustin Clements <amdragon@MIT.EDU>
Fri, 17 Feb 2012 20:00:17 +0000 (15:00 +1900)
committerW. Trevor King <wking@tremily.us>
Fri, 7 Nov 2014 17:44:38 +0000 (09:44 -0800)
49/13b46f0112bcb8803133608910837c7581b385 [new file with mode: 0644]

diff --git a/49/13b46f0112bcb8803133608910837c7581b385 b/49/13b46f0112bcb8803133608910837c7581b385
new file mode 100644 (file)
index 0000000..8779c72
--- /dev/null
@@ -0,0 +1,417 @@
+Return-Path: <amdragon@mit.edu>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+       by olra.theworths.org (Postfix) with ESMTP id 1255C431FB6\r
+       for <notmuch@notmuchmail.org>; Fri, 17 Feb 2012 12:02:19 -0800 (PST)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -0.7\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
+       tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+       by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+       with ESMTP id 1f0Jx+z65bdS for <notmuch@notmuchmail.org>;\r
+       Fri, 17 Feb 2012 12:02:15 -0800 (PST)\r
+Received: from dmz-mailsec-scanner-5.mit.edu (DMZ-MAILSEC-SCANNER-5.MIT.EDU\r
+       [18.7.68.34])\r
+       by olra.theworths.org (Postfix) with ESMTP id 3C69B429E45\r
+       for <notmuch@notmuchmail.org>; Fri, 17 Feb 2012 12:02:15 -0800 (PST)\r
+X-AuditID: 12074422-b7fd66d0000008f9-c3-4f3eb246d60e\r
+Received: from mailhub-auth-2.mit.edu ( [18.7.62.36])\r
+       by dmz-mailsec-scanner-5.mit.edu (Symantec Messaging Gateway) with SMTP\r
+       id 31.09.02297.642BE3F4; Fri, 17 Feb 2012 15:02:14 -0500 (EST)\r
+Received: from outgoing.mit.edu (OUTGOING-AUTH.MIT.EDU [18.7.22.103])\r
+       by mailhub-auth-2.mit.edu (8.13.8/8.9.2) with ESMTP id q1HK2Dr4004188; \r
+       Fri, 17 Feb 2012 15:02:14 -0500\r
+Received: from awakening.csail.mit.edu (awakening.csail.mit.edu [18.26.4.91])\r
+       (authenticated bits=0)\r
+       (User authenticated as amdragon@ATHENA.MIT.EDU)\r
+       by outgoing.mit.edu (8.13.6/8.12.4) with ESMTP id q1HK2Cgt027955\r
+       (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);\r
+       Fri, 17 Feb 2012 15:02:13 -0500 (EST)\r
+Received: from amthrax by awakening.csail.mit.edu with local (Exim 4.77)\r
+       (envelope-from <amdragon@mit.edu>)\r
+       id 1RyTyl-0003hq-NU; Fri, 17 Feb 2012 15:00:27 -0500\r
+Date: Fri, 17 Feb 2012 15:00:17 -0500\r
+From: Austin Clements <amdragon@MIT.EDU>\r
+To: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
+Subject: Re: [PATCH v5.2 7/7] emacs: Use the new JSON reply format and\r
+       message-cite-original\r
+Message-ID: <20120217200017.GG5991@mit.edu>\r
+References: <1329361957-28493-1-git-send-email-awg+notmuch@xvx.ca>\r
+       <1329361957-28493-8-git-send-email-awg+notmuch@xvx.ca>\r
+MIME-Version: 1.0\r
+Content-Type: text/plain; charset=us-ascii\r
+Content-Disposition: inline\r
+In-Reply-To: <1329361957-28493-8-git-send-email-awg+notmuch@xvx.ca>\r
+User-Agent: Mutt/1.5.21 (2010-09-15)\r
+X-Brightmail-Tracker:\r
+ H4sIAAAAAAAAA+NgFmpmleLIzCtJLcpLzFFi42IRYrdT0XXbZOdvsGS6rMWRPbPYLa7fnMns\r
+       wOTxbNUtZo+mH4tZA5iiuGxSUnMyy1KL9O0SuDJ+vN3AWNCTVfH74ALGBsYHIV2MnBwSAiYS\r
+       x95cZoewxSQu3FvP1sXIxSEksI9R4s+cTkYIZwOjxPvNi1ggnJNMEp3H90NlljBKbHl4kgmk\r
+       n0VAVWL3m61gs9gENCS27V/OCGKLCGhJ/Fj/lRXEZhaQlvj2uxmsXlggTuLb9ytA9RwcvALa\r
+       Elt35YOEhQSqJSb3n2EGsXkFBCVOznzCAtGqJXHj30smkHKQMcv/cYCEOQWcJZpe/AbbJCqg\r
+       IjHl5Da2CYxCs5B0z0LSPQuhewEj8ypG2ZTcKt3cxMyc4tRk3eLkxLy81CJdU73czBK91JTS\r
+       TYzgsHZR2sH486DSIUYBDkYlHt5XnXb+QqyJZcWVuYcYJTmYlER5v6wCCvEl5adUZiQWZ8QX\r
+       leakFh9ilOBgVhLh/ZYLlONNSaysSi3Kh0lJc7AoifOqa73zExJITyxJzU5NLUgtgsnKcHAo\r
+       SfBO3AjUKFiUmp5akZaZU4KQZuLgBBnOAzRcBKSGt7ggMbc4Mx0if4pRUUqctwMkIQCSyCjN\r
+       g+uFpZ1XjOJArwjzNoBU8QBTFlz3K6DBTECDeYXABpckIqSkGhjtIncbee+2P/GgyPXhxsfR\r
+       s6cIX3FhiD76Ovvu0uWKfjMEOb8eWSn2o+2599PK53OfuKm8W674Ilzbb4cQT8D9Lu98neUM\r
+       2n0Ha1fWp+ZOUp18K/h3+vUFfhurp9XPmNmRe8tixc5oSQ7T+YWJ2duP56+ct/yC/aqpk2u0\r
+       ZQr93vQ6bsvq6K9WYinOSDTUYi4qTgQAFINQJRYDAAA=\r
+Cc: notmuch@notmuchmail.org\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+       <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+       <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+       <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Fri, 17 Feb 2012 20:02:19 -0000\r
+\r
+Quoth Adam Wolfe Gordon on Feb 15 at  8:12 pm:\r
+> Use the new JSON reply format to create replies in emacs. Quote HTML\r
+> parts nicely by using mm-display-part to turn them into displayable\r
+> text, then quoting them with message-cite-original. This is very\r
+> useful for users who regularly receive HTML-only email.\r
+> \r
+> Use message-mode's message-cite-original function to create the\r
+> quoted body for reply messages. In order to make this act like the\r
+> existing notmuch defaults, you will need to set the following in\r
+> your emacs configuration:\r
+> \r
+> message-citation-line-format "On %a, %d %b %Y, %f wrote:"\r
+> message-citation-line-function 'message-insert-formatted-citation-line\r
+> \r
+> The tests have been updated to reflect the (ugly) emacs default.\r
+\r
+One general comment that affects a lot of things in this patch: I\r
+think you should use the same JSON parsing settings that\r
+notmuch-query-get-threads uses.  Besides consistency and more\r
+opportunities for code reuse, using lists instead of vectors for JSON\r
+arrays will simplify a lot of this code without any drawbacks.\r
+\r
+> ---\r
+>  emacs/notmuch-lib.el |    6 ++\r
+>  emacs/notmuch-mua.el |  127 +++++++++++++++++++++++++++++++++++---------------\r
+>  test/emacs           |    8 ++--\r
+>  3 files changed, 100 insertions(+), 41 deletions(-)\r
+> \r
+> diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+> index 7e3f110..3fc7aff 100644\r
+> --- a/emacs/notmuch-lib.el\r
+> +++ b/emacs/notmuch-lib.el\r
+> @@ -206,6 +206,12 @@ the user hasn't set this variable with the old or new value."\r
+>        (setq seq (nconc (delete elem seq) (list elem))))))\r
+>      seq))\r
+>  \r
+> +(defun notmuch-parts-filter-by-type (parts type)\r
+> +  "Given a vector of message parts, return a vector containing the ones matching the given type."\r
+\r
+Wrap at 72.\r
+\r
+> +  (loop for part across parts\r
+> +    if (notmuch-match-content-type (cdr (assq 'content-type part)) type)\r
+> +    vconcat (list part)))\r
+\r
+With lists, (and since we've decided it's okay to use cl):\r
+\r
+  (remove-if-not\r
+   (lambda (part) (notmuch-match-content-type (cdr (assq 'content-type part)) type))\r
+   parts)\r
+\r
+> +\r
+>  ;; Compatibility functions for versions of emacs before emacs 23.\r
+>  ;;\r
+>  ;; Both functions here were copied from emacs 23 with the following copyright:\r
+> diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
+> index 4be7c13..7d43821 100644\r
+> --- a/emacs/notmuch-mua.el\r
+> +++ b/emacs/notmuch-mua.el\r
+> @@ -19,11 +19,15 @@\r
+>  ;;\r
+>  ;; Authors: David Edmondson <dme@dme.org>\r
+>  \r
+> +(require 'json)\r
+>  (require 'message)\r
+> +(require 'format-spec)\r
+>  \r
+>  (require 'notmuch-lib)\r
+>  (require 'notmuch-address)\r
+>  \r
+> +(eval-when-compile (require 'cl))\r
+> +\r
+>  ;;\r
+>  \r
+>  (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)\r
+> @@ -72,56 +76,105 @@ list."\r
+>          (push header message-hidden-headers)))\r
+>      notmuch-mua-hidden-headers))\r
+>  \r
+> +(defun notmuch-mua-get-displayed-part (part query-string)\r
+> +  (with-temp-buffer\r
+> +    (if (assq 'content part)\r
+> +    (insert (cdr (assq 'content part)))\r
+> +      (call-process notmuch-command nil t nil "show" "--format=raw"\r
+> +                (format "--part=%s" (cdr (assq 'id part)))\r
+> +                query-string))\r
+> +\r
+> +    (let ((handle (mm-make-handle (current-buffer) (list (cdr (assq 'content-type part)))))\r
+> +      (end-of-orig (point-max)))\r
+> +      (mm-display-part handle)\r
+> +      (delete-region (point-min) end-of-orig)\r
+> +      (buffer-substring (point-min) (point-max)))))\r
+\r
+One of the biggest wins of using consistent JSON parsing settings is\r
+that this can be replaced with notmuch-show-mm-display-part-inline,\r
+which, as far as I can tell, accomplishes the same thing, but handles\r
+a lot of corner-cases that this doesn't (like crypto and charset\r
+conversion).\r
+\r
+> +\r
+> +(defun notmuch-mua-multipart/*-to-list (parts)\r
+\r
+This name isn't particularly informative to me (though, for reasons\r
+below, I don't think this even needs to be a function).\r
+\r
+> +  (loop for part across parts\r
+> +    collect (cdr (assq 'content-type part))))\r
+\r
+With lists,\r
+  (map (lambda (part) (cdr (assq 'content-type part))) parts)\r
+\r
+Actually, with lists and plists,\r
+  (map (lambda (part) (plist-get part 'content-type)) parts)\r
+which I think is short enough and self-explanatory enough that it\r
+doesn't even need to go in a function.\r
+\r
+> +\r
+> +(defun notmuch-mua-get-quotable-parts (parts)\r
+> +  (loop for part across parts\r
+> +    if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/alternative")\r
+> +      append (let* ((subparts (cdr (assq 'content part)))\r
+> +                    (types (notmuch-mua-multipart/*-to-list subparts))\r
+> +                    (chosen-type (car (notmuch-multipart/alternative-choose types))))\r
+> +               (notmuch-mua-get-quotable-parts (notmuch-parts-filter-by-type subparts chosen-type)))\r
+\r
+This seems roundabout.  The point of multipart/alternative is that the\r
+subparts are equivalent representations provided in order of\r
+preference by the sender and that the client is supposed to choose\r
+*one* of the alternates.  Even if multiple subparts have the same\r
+content-type, they're still alternates, so we should insert only one\r
+of them (and, since content-type is our only criteria for choosing\r
+between alternates, we should use the last one of acceptable type,\r
+since it was considered more preferential by the sender).\r
+\r
+> +    else if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/*")\r
+> +      append (notmuch-mua-get-quotable-parts (cdr (assq 'content part)))\r
+> +    else if (notmuch-match-content-type (cdr (assq 'content-type part)) "text/*")\r
+> +      collect part))\r
+> +\r
+>  (defun notmuch-mua-reply (query-string &optional sender reply-all)\r
+> -  (let (headers\r
+> -    body\r
+> -    (args '("reply")))\r
+> -    (if notmuch-show-process-crypto\r
+> -    (setq args (append args '("--decrypt"))))\r
+> +  (let ((args '("reply" "--format=json"))\r
+> +    reply\r
+> +    original)\r
+> +    (when notmuch-show-process-crypto\r
+> +      (setq args (append args '("--decrypt"))))\r
+\r
+No need to change the last two lines above (though there's obviously\r
+no harm in doing so).\r
+\r
+> +\r
+>      (if reply-all\r
+>      (setq args (append args '("--reply-to=all")))\r
+>        (setq args (append args '("--reply-to=sender"))))\r
+>      (setq args (append args (list query-string)))\r
+> -    ;; This make assumptions about the output of `notmuch reply', but\r
+> -    ;; really only that the headers come first followed by a blank\r
+> -    ;; line and then the body.\r
+> +\r
+> +    ;; Get the reply object as JSON, and parse it into an elisp object.\r
+>      (with-temp-buffer\r
+>        (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
+>        (goto-char (point-min))\r
+> -      (if (re-search-forward "^$" nil t)\r
+> -      (save-excursion\r
+> -        (save-restriction\r
+> -          (narrow-to-region (point-min) (point))\r
+> -          (goto-char (point-min))\r
+> -          (setq headers (mail-header-extract)))))\r
+> -      (forward-line 1)\r
+> -      (setq body (buffer-substring (point) (point-max))))\r
+> -    ;; If sender is non-nil, set the From: header to its value.\r
+> -    (when sender\r
+> -      (mail-header-set 'from sender headers))\r
+> -    (let\r
+> -    ;; Overlay the composition window on that being used to read\r
+> -    ;; the original message.\r
+> -    ((same-window-regexps '("\\*mail .*")))\r
+> -      (notmuch-mua-mail (mail-header 'to headers)\r
+> -                    (mail-header 'subject headers)\r
+> -                    (message-headers-to-generate headers t '(to subject))))\r
+> -    ;; insert the message body - but put it in front of the signature\r
+> -    ;; if one is present\r
+> -    (goto-char (point-max))\r
+> -    (if (re-search-backward message-signature-separator nil t)\r
+> +      (setq reply (json-read)))\r
+> +\r
+> +    ;; Extract the original message to simplify the following code.\r
+> +    (setq original (cdr (assq 'original reply)))\r
+> +\r
+> +    ;; Extract the headers of both the reply and the original message.\r
+> +    (let* ((original-headers (cdr (assq 'headers original)))\r
+> +       (reply-headers (cdr (assq 'reply-headers reply))))\r
+\r
+This is the one place where using the JSON parsing settings from\r
+notmuch-query-get-threads is slightly annoying, since the mail-*\r
+functions expect alists.  \r
+\r
+OTOH, the mail-* functions seem kind of pointless here; plist-set\r
+could replace mail-header-set and plist-get could replace mail-header.\r
+The only non-trivial function that expects an alist is\r
+message-headers-to-generate (and, by extension, notmuch-mua-mail).\r
+\r
+> +\r
+> +      ;; If sender is non-nil, set the From: header to its value.\r
+> +      (when sender\r
+> +    (mail-header-set 'From sender reply-headers))\r
+> +      (let\r
+> +      ;; Overlay the composition window on that being used to read\r
+> +      ;; the original message.\r
+> +      ((same-window-regexps '("\\*mail .*")))\r
+> +    (notmuch-mua-mail (mail-header 'To reply-headers)\r
+> +                      (mail-header 'Subject reply-headers)\r
+> +                      (message-headers-to-generate reply-headers t '(To Subject))))\r
+> +      ;; Insert the message body - but put it in front of the signature\r
+> +      ;; if one is present\r
+> +      (goto-char (point-max))\r
+> +      (if (re-search-backward message-signature-separator nil t)\r
+>        (forward-line -1)\r
+> -      (goto-char (point-max)))\r
+> -    (insert body)\r
+> -    (push-mark))\r
+> -  (set-buffer-modified-p nil)\r
+> +    (goto-char (point-max)))\r
+> +\r
+> +      (let ((from (cdr (assq 'From original-headers)))\r
+> +        (date (cdr (assq 'Date original-headers)))\r
+> +        (start (point)))\r
+> +\r
+> +    (insert "From: " from "\n")\r
+> +    (insert "Date: " date "\n\n")\r
+\r
+Sorry; I'm having trouble following the diff.  What are the inserts\r
+for?\r
+\r
+> +\r
+> +    ;; Get the parts of the original message that should be quoted; this includes\r
+> +    ;; all the text parts, except the non-preferred ones in a multipart/alternative.\r
+> +    (let ((quotable-parts (notmuch-mua-get-quotable-parts (cdr (assq 'body original)))))\r
+> +      (mapc (lambda (part)\r
+> +              (insert (notmuch-mua-get-displayed-part part query-string)))\r
+> +            quotable-parts))\r
+\r
+Alternatively, notmuch-mua-get-quotable-parts could be\r
+notmuch-mua-insert-quotable-parts, which would probably simplify\r
+things a bit.  Your call.\r
+\r
+> +\r
+> +    (push-mark)\r
+\r
+It's unfortunate that message-cite-original depends on the mark.\r
+Since you're about to push the mark for the user anyway, maybe this\r
+should be a set-mark so that only one mark gets pushed?\r
+\r
+> +    (goto-char start)\r
+> +    ;; Quote the original message according to the user's configured style.\r
+> +    (message-cite-original))))\r
+\r
+message-cite-original-without-signature?\r
+\r
+>  \r
+> +  (push-mark)\r
+\r
+Is message-cite-original guaranteed to leave point in a reasonable\r
+place for this or should we create our own marker above (probably\r
+after the if re-search-backward..) and use it here to get point to the\r
+right place?\r
+\r
+>    (message-goto-body)\r
+>    ;; Original message may contain (malicious) MML tags.  We must\r
+>    ;; properly quote them in the reply.  Note that using `point-max'\r
+>    ;; instead of `mark' here is wrong.  The buffer may include user's\r
+>    ;; signature which should not be MML-quoted.\r
+> -  (mml-quote-region (point) (mark)))\r
+> +  (mml-quote-region (point) (mark))\r
+> +  (set-buffer-modified-p nil))\r
+>  \r
+>  (defun notmuch-mua-forward-message ()\r
+>    (message-forward)\r
+> @@ -147,7 +200,7 @@ OTHER-ARGS are passed through to `message-mail'."\r
+>        (when (not (string= "" user-agent))\r
+>      (push (cons "User-Agent" user-agent) other-headers))))\r
+>  \r
+> -  (unless (mail-header 'from other-headers)\r
+> +  (unless (mail-header 'From other-headers)\r
+>      (push (cons "From" (concat\r
+>                      (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers))\r
+>  \r
+> @@ -210,7 +263,7 @@ the From: address first."\r
+>    (interactive "P")\r
+>    (let ((other-headers\r
+>       (when (or prompt-for-sender notmuch-always-prompt-for-sender)\r
+> -       (list (cons 'from (notmuch-mua-prompt-for-sender))))))\r
+> +       (list (cons 'From (notmuch-mua-prompt-for-sender))))))\r
+>      (notmuch-mua-mail nil nil other-headers)))\r
+>  \r
+>  (defun notmuch-mua-new-forward-message (&optional prompt-for-sender)\r
+> diff --git a/test/emacs b/test/emacs\r
+> index c3a75e9..a6786d4 100755\r
+> --- a/test/emacs\r
+> +++ b/test/emacs\r
+> @@ -268,13 +268,13 @@ Subject: Re: Testing message sent via SMTP\r
+>  In-Reply-To: <XXX>\r
+>  Fcc: $(pwd)/mail/sent\r
+>  --text follows this line--\r
+> -On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
+> +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
+> +\r
+>  > This is a test that messages are sent via SMTP\r
+>  EOF\r
+>  test_expect_equal_file OUTPUT EXPECTED\r
+>  \r
+>  test_begin_subtest "Reply within emacs to a multipart/mixed message"\r
+> -test_subtest_known_broken\r
+>  test_emacs '(notmuch-show "id:20091118002059.067214ed@hikari")\r
+>              (notmuch-show-reply)\r
+>              (test-output)'\r
+> @@ -334,7 +334,6 @@ EOF\r
+>  test_expect_equal_file OUTPUT EXPECTED\r
+>  \r
+>  test_begin_subtest "Reply within emacs to a multipart/alternative message"\r
+> -test_subtest_known_broken\r
+>  test_emacs '(notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com")\r
+>              (notmuch-show-reply)\r
+>              (test-output)'\r
+> @@ -385,7 +384,8 @@ Subject: Re: Quote MML tags in reply\r
+>  In-Reply-To: <test-emacs-mml-quoting@message.id>\r
+>  Fcc: ${MAIL_DIR}/sent\r
+>  --text follows this line--\r
+> -On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:\r
+> +Notmuch Test Suite <test_suite@notmuchmail.org> writes:\r
+> +\r
+>  > <#!part disposition=inline>\r
+>  EOF\r
+>  test_expect_equal_file OUTPUT EXPECTED\r