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