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 v7 10/10] emacs: Use the new JSON reply format and message-cite-original
Date: Sun, 11 Mar 2012 22:05:42 -0600	[thread overview]
Message-ID: <1331525142-30539-11-git-send-email-awg+notmuch@xvx.ca> (raw)
In-Reply-To: <1331525142-30539-1-git-send-email-awg+notmuch@xvx.ca>

Use the new JSON reply format to create replies in emacs. Quote HTML
parts nicely by using mm-display-part to turn them into displayable
text, then quoting them with message-cite-original. This is very
useful for users who regularly receive HTML-only email.

Use message-mode's message-cite-original function to create the
quoted body for reply messages. In order to make this act like the
existing notmuch defaults, you will need to set the following in
your emacs configuration:

message-citation-line-format "On %a, %d %b %Y, %f wrote:"
message-citation-line-function 'message-insert-formatted-citation-line

The tests have been updated to reflect the (ugly) emacs default.
---
 emacs/notmuch-lib.el |   11 ++++
 emacs/notmuch-mua.el |  136 +++++++++++++++++++++++++++++++++++---------------
 test/emacs           |    8 ++--
 3 files changed, 110 insertions(+), 45 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 7e3f110..8bac596 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -206,6 +206,17 @@ the user hasn't set this variable with the old or new value."
 	  (setq seq (nconc (delete elem seq) (list elem))))))
     seq))
 
+(defun notmuch-parts-filter-by-type (parts type)
+  "Given a list of message parts, return a list containing the ones matching
+the given type."
+  (remove-if-not
+   (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
+   parts))
+
+(defun notmuch-plist-to-alist (plist)
+  (loop for (key value . rest) on plist by #'cddr
+	collect (cons (substring (symbol-name key) 1) value)))
+
 ;; 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 13244eb..5adf4d8 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -19,11 +19,15 @@
 ;;
 ;; Authors: David Edmondson <dme@dme.org>
 
+(require 'json)
 (require 'message)
+(require 'format-spec)
 
 (require 'notmuch-lib)
 (require 'notmuch-address)
 
+(eval-when-compile (require 'cl))
+
 ;;
 
 (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)
@@ -72,54 +76,104 @@ list."
 	    (push header message-hidden-headers)))
 	notmuch-mua-hidden-headers))
 
+(defun notmuch-mua-get-displayed-part (part query-string)
+  (with-temp-buffer
+    (if (plist-get part :content)
+	(insert (plist-get part :content))
+      (call-process notmuch-command nil t nil "show" "--format=raw"
+		    (format "--part=%s" (plist-get part :id))
+		    query-string))
+
+    (let ((handle (mm-make-handle (current-buffer) (list (plist-get part :content-type))))
+	  (end-of-orig (point-max)))
+      (mm-display-part handle)
+      (delete-region (point-min) end-of-orig)
+      (buffer-substring (point-min) (point-max)))))
+
+(defun notmuch-mua-get-quotable-parts (parts)
+  (loop for part in parts
+	if (notmuch-match-content-type (plist-get part :content-type) "multipart/alternative")
+	  collect (let* ((subparts (plist-get part :content))
+			(types (mapcar (lambda (part) (plist-get part :content-type)) subparts))
+			(chosen-type (car (notmuch-multipart/alternative-choose types))))
+		   (loop for part in (reverse subparts)
+			 if (notmuch-match-content-type (plist-get part :content-type) chosen-type)
+			 return part))
+	else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*")
+	  append (notmuch-mua-get-quotable-parts (plist-get part :content))
+	else if (notmuch-match-content-type (plist-get part :content-type) "text/*")
+	  collect part))
+
 (defun notmuch-mua-reply (query-string &optional sender reply-all)
-  (let (headers
-	body
-	(args '("reply")))
-    (if notmuch-show-process-crypto
-	(setq args (append args '("--decrypt"))))
+  (let ((args '("reply" "--format=json"))
+	(json-object-type 'plist)
+	(json-array-type 'list)
+	(json-false 'nil)
+	reply
+	original)
+    (when 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)
-      ;; Original message may contain (malicious) MML tags. We must
-      ;; properly quote them in the reply.
-      (mml-quote-region (point) (point-max))
-      (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 (json-read)))
+
+    ;; Extract the original message to simplify the following code.
+    (setq original (plist-get reply :original))
+
+    ;; Extract the headers of both the reply and the original message.
+    (let* ((original-headers (plist-get original :headers))
+	   (reply-headers (plist-get reply :reply-headers)))
+
+      ;; If sender is non-nil, set the From: header to its value.
+      (when sender
+	(plist-put reply-headers :From sender))
+      (let
+	  ;; Overlay the composition window on that being used to read
+	  ;; the original message.
+	  ((same-window-regexps '("\\*mail .*")))
+	(notmuch-mua-mail (plist-get reply-headers :To)
+			  (plist-get reply-headers :Subject)
+			  (notmuch-plist-to-alist reply-headers)))
+      ;; 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)
-
-  (message-goto-body))
+	(goto-char (point-max)))
+
+      (let ((from (plist-get original-headers :From))
+	    (date (plist-get original-headers :Date))
+	    (start (point)))
+
+	;; message-cite-original constructs a citation line based on the From and Date
+	;; headers of the original message, which are assumed to be in the buffer.
+	(insert "From: " from "\n")
+	(insert "Date: " date "\n\n")
+
+	;; Get the parts of the original message that should be quoted; this includes
+	;; all the text parts, except the non-preferred ones in a multipart/alternative.
+	(let ((quotable-parts (notmuch-mua-get-quotable-parts (plist-get original :body))))
+	  (mapc (lambda (part)
+		  (insert (notmuch-mua-get-displayed-part part query-string)))
+		quotable-parts))
+
+	(set-mark (point))
+	(goto-char start)
+	;; Quote the original message according to the user's configured style.
+	(message-cite-original)
+	(goto-char (point-max)))))
+
+  (push-mark)
+  (message-goto-body)
+  (set-buffer-modified-p nil))
 
 (defun notmuch-mua-forward-message ()
   (message-forward)
@@ -145,7 +199,7 @@ OTHER-ARGS are passed through to `message-mail'."
       (when (not (string= "" user-agent))
 	(push (cons "User-Agent" user-agent) other-headers))))
 
-  (unless (mail-header 'from other-headers)
+  (unless (mail-header 'From other-headers)
     (push (cons "From" (concat
 			(notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers))
 
@@ -208,7 +262,7 @@ the From: address first."
   (interactive "P")
   (let ((other-headers
 	 (when (or prompt-for-sender notmuch-always-prompt-for-sender)
-	   (list (cons 'from (notmuch-mua-prompt-for-sender))))))
+	   (list (cons 'From (notmuch-mua-prompt-for-sender))))))
     (notmuch-mua-mail nil nil other-headers)))
 
 (defun notmuch-mua-new-forward-message (&optional prompt-for-sender)
diff --git a/test/emacs b/test/emacs
index 01afdb6..8a28705 100755
--- a/test/emacs
+++ b/test/emacs
@@ -268,13 +268,13 @@ Subject: Re: Testing message sent via SMTP
 In-Reply-To: <XXX>
 Fcc: ${MAIL_DIR}/sent
 --text follows this line--
-On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:
+Notmuch Test Suite <test_suite@notmuchmail.org> writes:
+
 > This is a test that messages are sent via SMTP
 EOF
 test_expect_equal_file OUTPUT EXPECTED
 
 test_begin_subtest "Reply within emacs to a multipart/mixed message"
-test_subtest_known_broken
 test_emacs '(notmuch-show "id:20091118002059.067214ed@hikari")
 		(notmuch-show-reply)
 		(test-output)'
@@ -334,7 +334,6 @@ EOF
 test_expect_equal_file OUTPUT EXPECTED
 
 test_begin_subtest "Reply within emacs to a multipart/alternative message"
-test_subtest_known_broken
 test_emacs '(notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com")
 		(notmuch-show-reply)
 		(test-output)'
@@ -385,7 +384,8 @@ Subject: Re: Quote MML tags in reply
 In-Reply-To: <test-emacs-mml-quoting@message.id>
 Fcc: ${MAIL_DIR}/sent
 --text follows this line--
-On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite <test_suite@notmuchmail.org> wrote:
+Notmuch Test Suite <test_suite@notmuchmail.org> writes:
+
 > <#!part disposition=inline>
 EOF
 test_expect_equal_file OUTPUT EXPECTED
-- 
1.7.5.4

  parent reply	other threads:[~2012-03-12  4:06 UTC|newest]

Thread overview: 45+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2012-03-12  4:05 [PATCH v7 00/10] Reply enhancements Adam Wolfe Gordon
2012-03-12  4:05 ` [PATCH v7 01/10] test: Add broken test for the new JSON reply format Adam Wolfe Gordon
2012-03-13 16:49   ` Austin Clements
2012-03-13 16:51     ` Adam Wolfe Gordon
2012-03-12  4:05 ` [PATCH v7 02/10] reply: Factor out reply creation Adam Wolfe Gordon
2012-03-12  4:05 ` [PATCH v7 03/10] TODO: Add replying to multiple messages Adam Wolfe Gordon
2012-03-12  4:05 ` [PATCH v7 04/10] reply: Add a JSON reply format Adam Wolfe Gordon
2012-03-12  4:05 ` [PATCH v7 05/10] schemata: Add documentation for " Adam Wolfe Gordon
2012-03-12  4:05 ` [PATCH v7 06/10] man: Update notmuch-reply man page for JSON format Adam Wolfe Gordon
2012-03-12  4:05 ` [PATCH v7 07/10] man: Add --decrypt to reply flags Adam Wolfe Gordon
2012-03-12  4:05 ` [PATCH v7 08/10] emacs: Factor out useful functions into notmuch-lib Adam Wolfe Gordon
2012-03-12  4:05 ` [PATCH v7 09/10] test: Add broken tests for new emacs reply functionality Adam Wolfe Gordon
2012-03-12  4:05 ` Adam Wolfe Gordon [this message]
2012-03-13 17:02   ` [PATCH v7 10/10] emacs: Use the new JSON reply format and message-cite-original Austin Clements
2012-03-13 17:47     ` Adam Wolfe Gordon
2012-03-14  4:30 ` [PATCH v7.1 00/11] Reply enhancements, second attempt Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 01/11] test: Add broken test for the new JSON reply format Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 02/11] reply: Factor out reply creation Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 03/11] TODO: Add replying to multiple messages Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 04/11] reply: Add a JSON reply format Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 05/11] schemata: Add documentation for " Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 06/11] man: Update notmuch-reply man page for JSON format Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 07/11] man: Add --decrypt to reply flags Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 08/11] emacs: Factor out useful functions into notmuch-lib Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 09/11] test: Add broken tests for new emacs reply functionality Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 10/11] emacs: Use the new JSON reply format and message-cite-original Adam Wolfe Gordon
2012-03-14  4:30   ` [PATCH v7.1 11/11] NEWS: news for reply enhancements Adam Wolfe Gordon
2012-03-18 13:22     ` David Bremner
2012-03-14 22:26   ` [PATCH v7.1 00/11] Reply enhancements, second attempt Austin Clements
2012-03-18 12:59   ` David Bremner
2012-03-18 16:32     ` [PATCH v8 00/11] Reply enhancements (rebased) Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 01/11] test: Add broken test for the new JSON reply format Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 02/11] reply: Factor out reply creation Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 03/11] TODO: Add replying to multiple messages Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 04/11] reply: Add a JSON reply format Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 05/11] schemata: Add documentation for " Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 06/11] man: Update notmuch-reply man page for JSON format Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 07/11] man: Add --decrypt to reply flags Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 08/11] emacs: Factor out useful functions into notmuch-lib Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 09/11] test: Add broken tests for new emacs reply functionality Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 10/11] emacs: Use the new JSON reply format and message-cite-original Adam Wolfe Gordon
2012-03-18 16:32       ` [PATCH v8 11/11] NEWS: news for reply enhancements Adam Wolfe Gordon
2012-03-20  1:11       ` [PATCH v8 00/11] Reply enhancements (rebased) David Bremner
2012-03-17 19:13 ` [PATCH v7 00/10] Reply enhancements Jameson Graef Rollins
2012-03-17 19:33   ` 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=1331525142-30539-11-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).