unofficial mirror of notmuch@notmuchmail.org
 help / color / mirror / code / Atom feed
From: Adam Wolfe Gordon <awg+notmuch@xvx.ca>
To: notmuch@notmuchmail.org
Subject: [PATCH v2 4/5] emacs: Use the new JSON reply format.
Date: Wed, 18 Jan 2012 09:32:34 -0700	[thread overview]
Message-ID: <1326904354-22419-1-git-send-email-awg+notmuch@xvx.ca> (raw)
In-Reply-To: <cunty3to5zp.fsf@hotblack-desiato.hh.sledj.net>

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 0f856bf..c5c6f91 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.")
 
@@ -127,6 +129,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 d8ab822..b5c5493 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,49 +72,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

  parent reply	other threads:[~2012-01-18 16:32 UTC|newest]

Thread overview: 20+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2012-01-16 18:13 [PATCH v2 0/4] Quoting HTML Emails in Reply Adam Wolfe Gordon
2012-01-16 18:13 ` [PATCH v2 1/4] test: Add broken test for the new JSON reply format Adam Wolfe Gordon
2012-01-16 18:13 ` [PATCH v2 2/4] reply: Add a " Adam Wolfe Gordon
2012-01-18 23:07   ` Jani Nikula
2012-01-18 23:29     ` Adam Wolfe Gordon
2012-01-16 18:13 ` [PATCH v2 3/4] man: Update notmuch-reply man page for JSON format Adam Wolfe Gordon
2012-01-16 18:13 ` [PATCH v2 4/4] emacs: Use the new JSON reply format Adam Wolfe Gordon
2012-01-17  9:04   ` David Edmondson
2012-01-17 16:18     ` Adam Wolfe Gordon
2012-01-17 22:53     ` [PATCH v2 4/5] " Adam Wolfe Gordon
2012-01-17 22:53       ` [PATCH v2 5/5] emacs: Use message-citation-line-format in reply Adam Wolfe Gordon
2012-01-18  6:54       ` [PATCH v2 4/5] emacs: Use the new JSON reply format David Edmondson
2012-01-18 16:29         ` Adam Wolfe Gordon
2012-01-18 16:32         ` Adam Wolfe Gordon [this message]
2012-01-18 16:41           ` David Edmondson
2012-01-18 17:08             ` Adam Wolfe Gordon
2012-01-17  1:18 ` [PATCH v2 5/4] emacs: Add customization for the first line of quotes Adam Wolfe Gordon
2012-01-17  7:17   ` how about message-citation-line-format (was: Re: [PATCH v2 5/4] emacs: Add customization for the first line of quotes.) Gregor Zattler
2012-01-17  9:05     ` David Edmondson
2012-01-17 16:20     ` Adam Wolfe Gordon

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://notmuchmail.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1326904354-22419-1-git-send-email-awg+notmuch@xvx.ca \
    --to=awg+notmuch@xvx.ca \
    --cc=notmuch@notmuchmail.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://yhetil.org/notmuch.git/

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).