On Tue, 21 Feb 2012 23:46:39 -0700, Adam Wolfe Gordon <awg+notmuch@xvx.ca> wrote: > 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, 109 insertions(+), 46 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 4be7c13..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,56 +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) > - (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) > - > + (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) > - ;; Original message may contain (malicious) MML tags. We must > - ;; properly quote them in the reply. Note that using `point-max' > - ;; instead of `mark' here is wrong. The buffer may include user's > - ;; signature which should not be MML-quoted. > - (mml-quote-region (point) (mark))) Is it okay to drop mml quoting? Why? BR, Jani. > + (set-buffer-modified-p nil)) > > (defun notmuch-mua-forward-message () > (message-forward) > @@ -147,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)) > > @@ -210,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 c3a75e9..a6786d4 100755 > --- a/test/emacs > +++ b/test/emacs > @@ -268,13 +268,13 @@ Subject: Re: Testing message sent via SMTP > In-Reply-To: <XXX> > Fcc: $(pwd)/mail/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 > > _______________________________________________ > notmuch mailing list > notmuch@notmuchmail.org > http://notmuchmail.org/mailman/listinfo/notmuch