From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>
To: notmuch@notmuchmail.org
Subject: [PATCH v3 4/5] emacs: Use the new JSON reply format.
Date: Thu, 19 Jan 2012 10:46:56 -0700
Message-Id: <1326995217-27423-5-git-send-email-awg+notmuch@xvx.ca>
In-Reply-To: <1326995217-27423-1-git-send-email-awg+notmuch@xvx.ca>
References: <1326995217-27423-1-git-send-email-awg+notmuch@xvx.ca>
Precedence: list

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.
---
 emacs/notmuch-lib.el |    8 ++++
 emacs/notmuch-mua.el |   95 +++++++++++++++++++++++++++++++++-----------------
 2 files changed, 71 insertions(+), 32 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 9242537..9863d69 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -21,6 +21,8 @@
 
 ;; This is an part of an emacs-based interface to the notmuch mail system.
 
+(eval-when-compile (require 'cl))
+
 (defvar notmuch-command "notmuch"
   "Command to run the notmuch binary.")
 
@@ -160,6 +162,12 @@ the user hasn't set this variable with the old or new value."
   (list 'when (< emacs-major-version 23)
 	form))
 
+(defun notmuch-parts-filter-by-type (parts type)
+  "Return a list of message parts with the given type"
+  (loop for part across parts
+	if (string= (cdr (assq 'content-type part)) type)
+	collect (cdr (assq 'content part))))
+
 ;; 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 023645e..5ae0ccf 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)
@@ -72,49 +73,79 @@ list."
 	    (push header message-hidden-headers)))
 	notmuch-mua-hidden-headers))
 
+(defun notmuch-mua-insert-part-quoted (part)
+  (let ((start (point))
+	limit)
+    (insert part)
+    (setq limit (point-marker))
+    (goto-char start)
+    (while (re-search-forward "\\(^\\)[^$]" (marker-position limit) 0)
+      (replace-match "> " nil nil nil 1))
+    (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)
+      (delete-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 (notmuch-parts-filter-by-type body-parts "text/plain"))
+	   (html-parts (notmuch-parts-filter-by-type 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 plain-parts
+	  (mapc (lambda (part) (notmuch-mua-insert-part-quoted part)) plain-parts)
+	(mapc (lambda (part)
+		(notmuch-mua-insert-part-quoted (notmuch-mua-parse-html-part part)))
+	      html-parts))
+
+      (push-mark))
+    (set-buffer-modified-p nil))
 
   (message-goto-body))
 
-- 
1.7.5.4