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