--- /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 6D7E7429E3B\r
+ for <notmuch@notmuchmail.org>; Mon, 16 Jan 2012 10:14:01 -0800 (PST)\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 MRDtH1MDE+Xz for <notmuch@notmuchmail.org>;\r
+ Mon, 16 Jan 2012 10:13:58 -0800 (PST)\r
+Received: from idcmail-mo2no.shaw.ca (idcmail-mo2no.shaw.ca [64.59.134.9])\r
+ by olra.theworths.org (Postfix) with ESMTP id 2C285429E37\r
+ for <notmuch@notmuchmail.org>; Mon, 16 Jan 2012 10:13:55 -0800 (PST)\r
+Received: from lb7f8hsrpno-svcs.dcs.int.inet (HELO pd7ml2no-ssvc.prod.shaw.ca)\r
+ ([10.0.144.222])\r
+ by pd7mo1no-svcs.prod.shaw.ca with ESMTP; 16 Jan 2012 11:13:54 -0700\r
+X-Cloudmark-SP-Filtered: true\r
+X-Cloudmark-SP-Result: v=1.1 cv=GZn8e3lTBEeJrlGK3+GUWyR5aYe1SJcDn5uEERMe9yQ=\r
+ c=1 sm=1\r
+ a=c49xHdtiGxwA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17\r
+ a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=86icDZwsQ_n_ub3iSkQA:9\r
+ a=y1tSvLtBuvtIwk-oUxMA:7 a=Kw4u8EAyA4wA:10 a=0c-eHkXYtrgA:10\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; 16 Jan 2012 11:13:54 -0700\r
+Received: by lagos.xvx.ca (Postfix, from userid 1000)\r
+ id 661458004208; Mon, 16 Jan 2012 11:13:54 -0700 (MST)\r
+From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH v2 4/4] emacs: Use the new JSON reply format.\r
+Date: Mon, 16 Jan 2012 11:13:23 -0700\r
+Message-Id: <1326737603-21166-5-git-send-email-awg+notmuch@xvx.ca>\r
+X-Mailer: git-send-email 1.7.5.4\r
+In-Reply-To: <1326737603-21166-1-git-send-email-awg+notmuch@xvx.ca>\r
+References: <1326737603-21166-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: Mon, 16 Jan 2012 18:14:02 -0000\r
+\r
+Using the new JSON reply format allows emacs to quote HTML\r
+parts nicely by using mm-display-part to turn them into displayable\r
+text, then quoting them. This is very useful for users who\r
+regularly receive HTML-only email.\r
+\r
+The behavior for messages that contain plain text parts should be\r
+unchanged, except that an additional quoted line is added to the end\r
+of the reply message. The test has been updated to reflect this.\r
+---\r
+ emacs/notmuch-lib.el | 8 ++++\r
+ emacs/notmuch-mua.el | 95 ++++++++++++++++++++++++++++++++-----------------\r
+ test/emacs | 1 +\r
+ 3 files changed, 71 insertions(+), 33 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+index 0f856bf..d4dd011 100644\r
+--- a/emacs/notmuch-lib.el\r
++++ b/emacs/notmuch-lib.el\r
+@@ -127,6 +127,14 @@ the user hasn't set this variable with the old or new value."\r
+ (list 'when (< emacs-major-version 23)\r
+ form))\r
+ \r
++(defun find-parts (parts type)\r
++ "Return a list of message parts with the given type"\r
++ (delq nil (mapcar (lambda (part)\r
++ (if (string= (cdr (assq 'content-type part)) type)\r
++ (cdr (assq 'content part))))\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 d8ab822..b03c62c 100644\r
+--- a/emacs/notmuch-mua.el\r
++++ b/emacs/notmuch-mua.el\r
+@@ -19,6 +19,7 @@\r
+ ;;\r
+ ;; Authors: David Edmondson <dme@dme.org>\r
+ \r
++(require 'json)\r
+ (require 'message)\r
+ \r
+ (require 'notmuch-lib)\r
+@@ -71,50 +72,78 @@ list."\r
+ (push header message-hidden-headers)))\r
+ notmuch-mua-hidden-headers))\r
+ \r
++(defun notmuch-mua-insert-part-quoted (part)\r
++ (save-restriction\r
++ (narrow-to-region (point) (point))\r
++ (insert part)\r
++ (goto-char (point-min))\r
++ (perform-replace "^" "> " nil t nil)\r
++ (insert "\n")\r
++ (set-buffer-modified-p nil)))\r
++\r
++(defun notmuch-mua-parse-html-part (part)\r
++ (with-temp-buffer\r
++ (insert part)\r
++ (let ((handle (mm-make-handle (current-buffer) (list "text/html")))\r
++ (end-of-orig (point-max)))\r
++ (mm-display-part handle)\r
++ (kill-region (point-min) end-of-orig)\r
++ (fill-region (point-min) (point-max))\r
++ (buffer-substring (point-min) (point-max)))))\r
++\r
+ (defun notmuch-mua-reply (query-string &optional sender reply-all)\r
+- (let (headers\r
+- body\r
+- (args '("reply")))\r
++ (let ((args '("reply" "--format=json"))\r
++ reply\r
++ body)\r
+ (if notmuch-show-process-crypto\r
+ (setq args (append args '("--decrypt"))))\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
++ ;; 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 (aref (json-read) 0)))\r
++\r
++ ;; Start with the prelude, based on the headers of the original message.\r
++ (let* ((original (cdr (assq 'original reply)))\r
++ (headers (cdr (assq 'headers (assq 'reply reply))))\r
++ (original-headers (cdr (assq 'headers original)))\r
++ (body-parts (cdr (assq 'body original)))\r
++ (plain-parts (find-parts body-parts "text/plain"))\r
++ (html-parts (find-parts body-parts "text/html")))\r
++\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
+ (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
++ (insert (format "On %s, %s wrote:\n"\r
++ (cdr (assq 'date original-headers))\r
++ (cdr (assq 'from original-headers))))\r
++ \r
++\r
++ (if (null plain-parts)\r
++ (mapc (lambda (part) (notmuch-mua-insert-part-quoted (notmuch-mua-parse-html-part part))) html-parts)\r
++ (mapc (lambda (part) (notmuch-mua-insert-part-quoted part)) plain-parts))\r
++ \r
++ (push-mark))\r
++ (set-buffer-modified-p nil))\r
++ \r
+ (message-goto-body))\r
+ \r
+ (defun notmuch-mua-forward-message ()\r
+diff --git a/test/emacs b/test/emacs\r
+index ac47b16..4219917 100755\r
+--- a/test/emacs\r
++++ b/test/emacs\r
+@@ -270,6 +270,7 @@ 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
+ > This is a test that messages are sent via SMTP\r
++> \r
+ EOF\r
+ test_expect_equal_file OUTPUT EXPECTED\r
+ \r
+-- \r
+1.7.5.4\r
+\r
projects / notmuch-archives.git / commitdiff