--- /dev/null
+Return-Path: <awg@lagos.xvx.ca>\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 84B4C429E32\r
+ for <notmuch@notmuchmail.org>; Tue, 13 Mar 2012 21:30:40 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: 0\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=0 tagged_above=-999 required=5\r
+ tests=[RCVD_IN_DNSWL_NONE=-0.0001] 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 DxBYo+MnhJRn for <notmuch@notmuchmail.org>;\r
+ Tue, 13 Mar 2012 21:30:35 -0700 (PDT)\r
+Received: from idcmail-mo2no.shaw.ca (idcmail-mo2no.shaw.ca [64.59.134.9])\r
+ by olra.theworths.org (Postfix) with ESMTP id 1B37C431E82\r
+ for <notmuch@notmuchmail.org>; Tue, 13 Mar 2012 21:30:24 -0700 (PDT)\r
+Received: from lb7f8hsrpno-svcs.dcs.int.inet (HELO pd7ml2no-ssvc.prod.shaw.ca)\r
+ ([10.0.144.222])\r
+ by pd6mo1no-svcs.prod.shaw.ca with ESMTP; 13 Mar 2012 22:30:21 -0600\r
+X-Cloudmark-SP-Filtered: true\r
+X-Cloudmark-SP-Result: v=1.1 cv=GZn8e3lTBEeJrlGK3+GUWyR5aYe1SJcDn5uEERMe9yQ=\r
+ c=1 sm=1\r
+ a=K8zbXChgVAkA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17\r
+ a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=pGLkceISAAAA:8\r
+ a=pkj2EqAftlighcz09hEA:9\r
+ a=GfdN2rCGAuq2ylZorScA:7 a=0BPXsuqt4rsA:10 a=Kw4u8EAyA4wA:10\r
+ a=0c-eHkXYtrgA:10 a=Ka2vHfUGn-E_Sbxc:21 a=xsk0_cFsgf0rMD6X:21\r
+ a=HpAAvcLHHh0Zw7uRqdWCyQ==:117\r
+Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56])\r
+ by pd7ml2no-dmz.prod.shaw.ca with ESMTP; 13 Mar 2012 22:30:21 -0600\r
+Received: by lagos.xvx.ca (Postfix, from userid 1000)\r
+ id 1D1E9800034B; Tue, 13 Mar 2012 22:30:21 -0600 (MDT)\r
+From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH v7.1 10/11] emacs: Use the new JSON reply format and\r
+ message-cite-original\r
+Date: Tue, 13 Mar 2012 22:30:15 -0600\r
+Message-Id: <1331699416-30775-11-git-send-email-awg+notmuch@xvx.ca>\r
+X-Mailer: git-send-email 1.7.5.4\r
+In-Reply-To: <1331699416-30775-1-git-send-email-awg+notmuch@xvx.ca>\r
+References: <1331525142-30539-1-git-send-email-awg+notmuch@xvx.ca>\r
+ <1331699416-30775-1-git-send-email-awg+notmuch@xvx.ca>\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: Wed, 14 Mar 2012 04:30:41 -0000\r
+\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 | 30 ++++++++++++\r
+ emacs/notmuch-mua.el | 124 +++++++++++++++++++++++++++++++++----------------\r
+ emacs/notmuch-show.el | 31 ++----------\r
+ test/emacs | 8 ++--\r
+ 4 files changed, 123 insertions(+), 70 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+index 7e3f110..c146748 100644\r
+--- a/emacs/notmuch-lib.el\r
++++ b/emacs/notmuch-lib.el\r
+@@ -206,6 +206,36 @@ 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
++;; Helper for parts which are generally not included in the default\r
++;; JSON output.\r
++(defun notmuch-get-bodypart-internal (message-id part-number process-crypto)\r
++ (let ((args '("show" "--format=raw"))\r
++ (part-arg (format "--part=%s" part-number)))\r
++ (setq args (append args (list part-arg)))\r
++ (if process-crypto\r
++ (setq args (append args '("--decrypt"))))\r
++ (setq args (append args (list message-id)))\r
++ (with-temp-buffer\r
++ (let ((coding-system-for-read 'no-conversion))\r
++ (progn\r
++ (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))\r
++ (buffer-string))))))\r
++\r
++(defun notmuch-get-bodypart-content (msg part nth process-crypto)\r
++ (or (plist-get part :content)\r
++ (notmuch-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth process-crypto)))\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 13244eb..6aae3a0 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,54 +76,92 @@ list."\r
+ (push header message-hidden-headers)))\r
+ notmuch-mua-hidden-headers))\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
++ 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
+- ;; Original message may contain (malicious) MML tags. We must\r
+- ;; properly quote them in the reply.\r
+- (mml-quote-region (point) (point-max))\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
++ (let ((json-object-type 'plist)\r
++ (json-array-type 'list)\r
++ (json-false 'nil))\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
+- (message-goto-body))\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-get-bodypart-content original part\r
++ (plist-get part :id)\r
++ notmuch-show-process-crypto)))\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
++\r
++ (goto-char (point-max))\r
++ (push-mark)\r
++ (message-goto-body)\r
++ (set-buffer-modified-p nil))\r
+ \r
+ (defun notmuch-mua-forward-message ()\r
+ (message-forward)\r
+@@ -145,7 +187,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
+@@ -208,7 +250,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/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+index ed938bf..0cd7d82 100644\r
+--- a/emacs/notmuch-show.el\r
++++ b/emacs/notmuch-show.el\r
+@@ -488,7 +488,7 @@ message at DEPTH in the current thread."\r
+ (setq notmuch-show-process-crypto ,process-crypto)\r
+ ;; Always acquires the part via `notmuch part', even if it is\r
+ ;; available in the JSON output.\r
+- (insert (notmuch-show-get-bodypart-internal ,message-id ,nth))\r
++ (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))\r
+ ,@body))))\r
+ \r
+ (defun notmuch-show-save-part (message-id nth &optional filename content-type)\r
+@@ -536,7 +536,7 @@ current buffer, if possible."\r
+ ;; test whether we are able to inline it (which includes both\r
+ ;; capability and suitability tests).\r
+ (when (mm-inlined-p handle)\r
+- (insert (notmuch-show-get-bodypart-content msg part nth))\r
++ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))\r
+ (when (mm-inlinable-p handle)\r
+ (set-buffer display-buffer)\r
+ (mm-display-part handle)\r
+@@ -613,8 +613,8 @@ current buffer, if possible."\r
+ ;; times (hundreds!), which results in many calls to\r
+ ;; `notmuch part'.\r
+ (unless content\r
+- (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)\r
+- part-number))\r
++ (setq content (notmuch-get-bodypart-internal (concat "id:" message-id)\r
++ part-number notmuch-show-process-crypto))\r
+ (with-current-buffer w3m-current-buffer\r
+ (notmuch-show-w3m-cid-store-internal url\r
+ message-id\r
+@@ -734,7 +734,7 @@ current buffer, if possible."\r
+ ;; insert a header to make this clear.\r
+ (if (> nth 1)\r
+ (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))\r
+- (insert (notmuch-show-get-bodypart-content msg part nth))\r
++ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))\r
+ (save-excursion\r
+ (save-restriction\r
+ (narrow-to-region start (point-max))\r
+@@ -744,7 +744,7 @@ current buffer, if possible."\r
+ (defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)\r
+ (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))\r
+ (insert (with-temp-buffer\r
+- (insert (notmuch-show-get-bodypart-content msg part nth))\r
++ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))\r
+ (goto-char (point-min))\r
+ (let ((file (make-temp-file "notmuch-ical"))\r
+ result)\r
+@@ -806,25 +806,6 @@ current buffer, if possible."\r
+ (intern (concat "notmuch-show-insert-part-" content-type))))\r
+ result))\r
+ \r
+-;; Helper for parts which are generally not included in the default\r
+-;; JSON output.\r
+-(defun notmuch-show-get-bodypart-internal (message-id part-number)\r
+- (let ((args '("show" "--format=raw"))\r
+- (part-arg (format "--part=%s" part-number)))\r
+- (setq args (append args (list part-arg)))\r
+- (if notmuch-show-process-crypto\r
+- (setq args (append args '("--decrypt"))))\r
+- (setq args (append args (list message-id)))\r
+- (with-temp-buffer\r
+- (let ((coding-system-for-read 'no-conversion))\r
+- (progn\r
+- (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))\r
+- (buffer-string))))))\r
+-\r
+-(defun notmuch-show-get-bodypart-content (msg part nth)\r
+- (or (plist-get part :content)\r
+- (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))\r
+-\r
+ ;; \f\r
+\r
+ \r
+ (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)\r
+diff --git a/test/emacs b/test/emacs\r
+index 01afdb6..8a28705 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: ${MAIL_DIR}/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
+-- \r
+1.7.5.4\r
+\r
projects / notmuch-archives.git / commitdiff