[PATCH v2 4/4] emacs: Use the new JSON reply format.

[Adam Wolfe Gordon <awg+notmuch@xvx.ca>]

Using the new JSON reply format allows emacs to quote HTML
parts nicely by using mm-display-part to turn them into displayable
text, then quoting them. This is very useful for users who
regularly receive HTML-only email.

The behavior for messages that contain plain text parts should be
unchanged, except that an additional quoted line is added to the end
of the reply message.  The test has been updated to reflect this.
---
 emacs/notmuch-lib.el |    8 ++++
 emacs/notmuch-mua.el |   95 ++++++++++++++++++++++++++++++++-----------------
 test/emacs           |    1 +
 3 files changed, 71 insertions(+), 33 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 0f856bf..d4dd011 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -127,6 +127,14 @@ the user hasn't set this variable with the old or new value."
   (list 'when (< emacs-major-version 23)
 	form))
 
+(defun find-parts (parts type)
+  "Return a list of message parts with the given type"
+  (delq nil (mapcar (lambda (part)
+		      (if (string= (cdr (assq 'content-type part)) type)
+			  (cdr (assq 'content part))))
+		    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 d8ab822..b03c62c 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -19,6 +19,7 @@
 ;;
 ;; Authors: David Edmondson <dme@dme.org>
 
+(require 'json)
 (require 'message)
 
 (require 'notmuch-lib)
@@ -71,50 +72,78 @@ list."
 	    (push header message-hidden-headers)))
 	notmuch-mua-hidden-headers))
 
+(defun notmuch-mua-insert-part-quoted (part)
+  (save-restriction
+    (narrow-to-region (point) (point))
+    (insert part)
+    (goto-char (point-min))
+    (perform-replace "^" "> " nil t nil)
+    (insert "\n")
+    (set-buffer-modified-p nil)))
+
+(defun notmuch-mua-parse-html-part (part)
+  (with-temp-buffer
+    (insert part)
+    (let ((handle (mm-make-handle (current-buffer) (list "text/html")))
+	  (end-of-orig (point-max)))
+      (mm-display-part handle)
+      (kill-region (point-min) end-of-orig)
+      (fill-region (point-min) (point-max))
+      (buffer-substring (point-min) (point-max)))))
+
 (defun notmuch-mua-reply (query-string &optional sender reply-all)
-  (let (headers
-	body
-	(args '("reply")))
+  (let ((args '("reply" "--format=json"))
+	reply
+	body)
     (if 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 (aref (json-read) 0)))
+
+    ;; Start with the prelude, based on the headers of the original message.
+    (let* ((original (cdr (assq 'original reply)))
+	   (headers (cdr (assq 'headers (assq 'reply reply))))
+	   (original-headers (cdr (assq 'headers original)))
+	   (body-parts (cdr (assq 'body original)))
+	   (plain-parts (find-parts body-parts "text/plain"))
+	   (html-parts (find-parts body-parts "text/html")))
+
+      ;; 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)
 	  (forward-line -1)
-      (goto-char (point-max)))
-    (insert body)
-    (push-mark))
-  (set-buffer-modified-p nil)
-
+	(goto-char (point-max)))
+
+      (insert (format "On %s, %s wrote:\n"
+		      (cdr (assq 'date original-headers))
+		      (cdr (assq 'from original-headers))))
+	   
+
+      (if (null plain-parts)
+	  (mapc (lambda (part) (notmuch-mua-insert-part-quoted (notmuch-mua-parse-html-part part))) html-parts)
+	(mapc (lambda (part) (notmuch-mua-insert-part-quoted part)) plain-parts))
+      
+      (push-mark))
+    (set-buffer-modified-p nil))
+  
   (message-goto-body))
 
 (defun notmuch-mua-forward-message ()
diff --git a/test/emacs b/test/emacs
index ac47b16..4219917 100755
--- a/test/emacs
+++ b/test/emacs
@@ -270,6 +270,7 @@ Fcc: $(pwd)/mail/sent
 --text follows this line--
 On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:
 > This is a test that messages are sent via SMTP
+> 
 EOF
 test_expect_equal_file OUTPUT EXPECTED
 
-- 
1.7.5.4