From: Austin Clements Date: Mon, 12 Mar 2012 01:11:56 +0000 (+2000) Subject: Re: [PATCH v6] emacs: Use the new JSON reply format and message-cite-original X-Git-Url: http://git.tremily.us/gitweb.cgi?a=commitdiff_plain;h=0433146913a271be4d5cbd8ee4d0d0a273dec5e1;p=notmuch-archives.git Re: [PATCH v6] emacs: Use the new JSON reply format and message-cite-original --- diff --git a/fb/d26659253350af42266720ebefe280945fe25f b/fb/d26659253350af42266720ebefe280945fe25f new file mode 100644 index 000000000..0ff3b4964 --- /dev/null +++ b/fb/d26659253350af42266720ebefe280945fe25f @@ -0,0 +1,363 @@ +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 57273431FAF + for ; Sun, 11 Mar 2012 18:12:00 -0700 (PDT) +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 VbCijztgG5Wz for ; + Sun, 11 Mar 2012 18:11:59 -0700 (PDT) +Received: from dmz-mailsec-scanner-4.mit.edu (DMZ-MAILSEC-SCANNER-4.MIT.EDU + [18.9.25.15]) + by olra.theworths.org (Postfix) with ESMTP id EF7BB431FAE + for ; Sun, 11 Mar 2012 18:11:58 -0700 (PDT) +X-AuditID: 1209190f-b7f8a6d000000914-df-4f5d4d5e8bf1 +Received: from mailhub-auth-1.mit.edu ( [18.9.21.35]) + by dmz-mailsec-scanner-4.mit.edu (Symantec Messaging Gateway) with SMTP + id 15.C7.02324.E5D4D5F4; Sun, 11 Mar 2012 21:11:58 -0400 (EDT) +Received: from outgoing.mit.edu (OUTGOING-AUTH.MIT.EDU [18.7.22.103]) + by mailhub-auth-1.mit.edu (8.13.8/8.9.2) with ESMTP id q2C1BvRI004516; + Sun, 11 Mar 2012 21:11:58 -0400 +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 q2C1BuIY020606 + (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT); + Sun, 11 Mar 2012 21:11:57 -0400 (EDT) +Received: from amthrax by awakening.csail.mit.edu with local (Exim 4.77) + (envelope-from ) + id 1S6tno-0003VX-Jf; Sun, 11 Mar 2012 21:11:56 -0400 +Date: Sun, 11 Mar 2012 21:11:56 -0400 +From: Austin Clements +To: Adam Wolfe Gordon +Subject: Re: [PATCH v6] emacs: Use the new JSON reply format and + message-cite-original +Message-ID: <20120312011156.GC2754@mit.edu> +References: <1329893199-21630-1-git-send-email-awg+notmuch@xvx.ca> + <1329893199-21630-11-git-send-email-awg+notmuch@xvx.ca> +MIME-Version: 1.0 +Content-Type: text/plain; charset=us-ascii +Content-Disposition: inline +In-Reply-To: <1329893199-21630-11-git-send-email-awg+notmuch@xvx.ca> +User-Agent: Mutt/1.5.21 (2010-09-15) +X-Brightmail-Tracker: + H4sIAAAAAAAAA+NgFmpmleLIzCtJLcpLzFFi42IR4hRV1o3zjfU3OLJe1eLInlnsFtdvzmR2 + YPJ4tuoWs0fTj8WsAUxRXDYpqTmZZalF+nYJXBn35z1gLbgTU9H/8SVrA+N7zy5GTg4JAROJ + vnf9TBC2mMSFe+vZuhi5OIQE9jFKHGubAOVsYJRY8nYeM4Rzkkni8+YZLBDOEkaJK1cmsIL0 + swioSrxcOpEFxGYT0JDYtn85I4gtIqAl8WP9V7AaZgFpiW+/m8H2CQtESPxcsx1oBQcHr4C2 + xKmvaSBhIYEaibUnr7CD2LwCghInZz5hgWjVkrjx7yUTSDnImOX/OEDCnAIuEiu6/zOD2KIC + KhJTTm5jm8AoNAtJ9ywk3bMQuhcwMq9ilE3JrdLNTczMKU5N1i1OTszLSy3SNdHLzSzRS00p + 3cQIDmtJ/h2M3w4qHWIU4GBU4uHlNIjyF2JNLCuuzD3EKMnBpCTKu9sr1l+ILyk/pTIjsTgj + vqg0J7X4EKMEB7OSCO9DQ6Acb0piZVVqUT5MSpqDRUmcV03rnZ+QQHpiSWp2ampBahFMVoaD + Q0mCd7s3UKNgUWp6akVaZk4JQpqJgxNkOA/QcAkfkOHFBYm5xZnpEPlTjIpS4rzCIAkBkERG + aR5cLyztvGIUB3pFmNcZpIoHmLLgul8BDWYCGvyZKxpkcEkiQkqqgVHs4GJjC/Mn3/62Oa7Q + 28MqEbx5s/+5k5dNk3Oz2zflZF/lrJxt+yPj9iSlvO8JESLzNAT3aypssHp4um7bun2HvQxv + zo5LUlv892dc8muZpoQZTsdn1E9JrYoPWK5TynQkylR/jeNTk+8/fAUlX06eWvAzOV/40iz3 + o22ii6pmTt32ckF91gElluKMREMt5qLiRACgl9flFgMAAA== +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: Mon, 12 Mar 2012 01:12:00 -0000 + +Quoth Adam Wolfe Gordon on Feb 21 at 11:46 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. +> --- +> emacs/notmuch-lib.el | 11 ++++ +> emacs/notmuch-mua.el | 136 ++++++++++++++++++++++++++++++++++--------------- +> test/emacs | 8 ++-- +> 3 files changed, 109 insertions(+), 46 deletions(-) +> +> diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el +> index 7e3f110..8bac596 100644 +> --- a/emacs/notmuch-lib.el +> +++ b/emacs/notmuch-lib.el +> @@ -206,6 +206,17 @@ 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 list of message parts, return a list containing the ones matching +> +the given type." +> + (remove-if-not +> + (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type)) +> + parts)) +> + +> +(defun notmuch-plist-to-alist (plist) +> + (loop for (key value . rest) on plist by #'cddr +> + collect (cons (substring (symbol-name key) 1) value))) +> + +> ;; 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..5adf4d8 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,104 @@ list." +> (push header message-hidden-headers))) +> notmuch-mua-hidden-headers)) +> +> +(defun notmuch-mua-get-displayed-part (part query-string) +> + (with-temp-buffer +> + (if (plist-get part :content) +> + (insert (plist-get part :content)) +> + (call-process notmuch-command nil t nil "show" "--format=raw" +> + (format "--part=%s" (plist-get part :id)) +> + query-string)) +> + +> + (let ((handle (mm-make-handle (current-buffer) (list (plist-get part :content-type)))) +> + (end-of-orig (point-max))) +> + (mm-display-part handle) +> + (delete-region (point-min) end-of-orig) +> + (buffer-substring (point-min) (point-max))))) + +Even if it's not possible to completely reuse the show mechanisms +here, it would be nice to reuse the easy ones. In particular, +notmuch-show-get-bodypart-content looks like it could easily be lifted +to the lib with the addition of a process-crypto argument. It would +be slightly less efficient, but even now there's some important logic +in notmuch-show-get-bodypart-content that's missing here regarding +encoding handling. + +> + +> +(defun notmuch-mua-get-quotable-parts (parts) +> + (loop for part in parts +> + if (notmuch-match-content-type (plist-get part :content-type) "multipart/alternative") +> + collect (let* ((subparts (plist-get part :content)) +> + (types (mapcar (lambda (part) (plist-get part :content-type)) subparts)) +> + (chosen-type (car (notmuch-multipart/alternative-choose types)))) +> + (loop for part in (reverse subparts) +> + if (notmuch-match-content-type (plist-get part :content-type) chosen-type) +> + return part)) +> + else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*") +> + append (notmuch-mua-get-quotable-parts (plist-get part :content)) +> + else if (notmuch-match-content-type (plist-get part :content-type) "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")) +> + (json-object-type 'plist) +> + (json-array-type 'list) +> + (json-false 'nil) + +These should be bound just around the setq reply below since they're +global controls (I highly doubt anything else this function calls +would invoke the JSON parser, but we shouldn't tempt dynamic scoping). + +> + reply +> + original) +> + (when notmuch-show-process-crypto +> + (setq args (append args '("--decrypt")))) +> + +> (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 (plist-get reply :original)) +> + +> + ;; Extract the headers of both the reply and the original message. +> + (let* ((original-headers (plist-get original :headers)) +> + (reply-headers (plist-get reply :reply-headers))) +> + +> + ;; If sender is non-nil, set the From: header to its value. +> + (when sender +> + (plist-put reply-headers :From sender)) +> + (let +> + ;; Overlay the composition window on that being used to read +> + ;; the original message. +> + ((same-window-regexps '("\\*mail .*"))) +> + (notmuch-mua-mail (plist-get reply-headers :To) +> + (plist-get reply-headers :Subject) +> + (notmuch-plist-to-alist reply-headers))) +> + ;; 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 (plist-get original-headers :From)) +> + (date (plist-get original-headers :Date)) +> + (start (point))) +> + +> + ;; message-cite-original constructs a citation line based on the From and Date +> + ;; headers of the original message, which are assumed to be in the buffer. +> + (insert "From: " from "\n") +> + (insert "Date: " date "\n\n") +> + +> + ;; 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 (plist-get original :body)))) +> + (mapc (lambda (part) +> + (insert (notmuch-mua-get-displayed-part part query-string))) +> + quotable-parts)) +> + +> + (set-mark (point)) +> + (goto-char start) +> + ;; Quote the original message according to the user's configured style. +> + (message-cite-original) +> + (goto-char (point-max))))) + +Since the goto-char is really about setting up point for the push-mark +below, it probably makes sense to lift it out of the let and put it +immediately before the push-mark. I spent a while trying to figure +out what it had to do with the message-cite-original before realizing +that it really had to do with what followed the let. + +> + +> + (push-mark) +> (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))) +> + (set-buffer-modified-p nil)) +> +> (defun notmuch-mua-forward-message () +> (message-forward) +> @@ -147,7 +199,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 +262,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