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

[Adam Wolfe Gordon]

From: Adam Wolfe Gordon <awg at xvx.ca>

Using the new JSON reply format allows emacs to quote HTML parts
nicely by first parsing them with w3m, 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-mua.el |   62 +++++++++++++++++++++++++++++++++++++++----------
 test/emacs           |    1 +
 2 files changed, 50 insertions(+), 13 deletions(-)

diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index 7114e48..7f894cb 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -19,6 +19,7 @@
 ;;
 ;; Authors: David Edmondson <dme at dme.org>
 
+(require 'json)
 (require 'message)
 
 (require 'notmuch-lib)
@@ -71,27 +72,62 @@ list."
 	    (push header message-hidden-headers)))
 	notmuch-mua-hidden-headers))
 
+(defun w3m-region (start end)) ;; From `w3m.el'.
+(defun notmuch-mua-quote-part (part)
+  (with-temp-buffer
+    (insert part)
+    (message-mode)
+    (fill-region (point-min) (point-max))
+    (goto-char (point-min))
+    (perform-replace "^" "> " nil t nil)
+    (set-buffer-modified-p nil)
+    (buffer-substring (point-min) (point-max))))
+(defun notmuch-mua-parse-html-part (part)
+  (with-temp-buffer
+    (insert part)
+    (w3m-region (point-min) (point-max))
+    (set-buffer-modified-p nil)
+    (buffer-substring (point-min) (point-max))))
 (defun notmuch-mua-reply (query-string &optional sender)
-  (let (headers
+  (let (reply
+	original
+	headers
 	body
-	(args '("reply")))
+	(args '("reply" "--format=json")))
     (if notmuch-show-process-crypto
 	(setq args (append args '("--decrypt"))))
     (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))))
+      (setq reply (aref (json-read) 0)))
+
+    ;; Get the list of headers
+    (setq headers (cdr (assq 'headers (assq 'reply reply))))
+    ;; Construct the body of the reply.
+    (setq original (cdr (assq 'original reply)))
+
+    ;; Start with the prelude, based on the headers of the original message.
+    (let ((original-headers (cdr (assq 'headers original))))
+      (setq body (format "On %s, %s wrote:\n"
+			 (cdr (assq 'date original-headers))
+			 (cdr (assq 'from original-headers)))))
+
+    ;; Extract the body parts and construct a reasonable quoted body.
+    (let* ((body-parts (cdr (assq 'body original)))
+	   (find-parts (lambda (type) (delq nil (mapcar (lambda (part)
+							  (if (string= (cdr (assq 'content-type part)) type)
+							      (cdr (assq 'content part))))
+							body-parts))))
+	   (plain-parts (apply find-parts '("text/plain")))
+	   (html-parts (apply find-parts '("text/html"))))
+      
+      (if (not (null plain-parts))
+	  (mapc (lambda (part) (setq body (concat body (notmuch-mua-quote-part part)))) plain-parts)
+	(mapc (lambda (part) (setq body (concat body (notmuch-mua-quote-part (notmuch-mua-parse-html-part part))))) html-parts)))
+    (setq body (concat body "\n"))
+	
     ;; If sender is non-nil, set the From: header to its value.
     (when sender
       (mail-header-set 'from sender headers))
diff --git a/test/emacs b/test/emacs
index a06c223..fe501da 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 at notmuchmail.org> wrote:
 > This is a test that messages are sent via SMTP
+> 
 EOF
 test_expect_equal_file OUTPUT EXPECTED
 
-- 
1.7.5.4