From: Jani Nikula <jani@nikula.org>
To: Adam Wolfe Gordon <awg+notmuch@xvx.ca>, notmuch@notmuchmail.org
Subject: Re: [PATCH v6] emacs: Use the new JSON reply format and message-cite-original
Date: Sat, 10 Mar 2012 01:13:14 +0200 [thread overview]
Message-ID: <87aa3p8j1x.fsf@nikula.org> (raw)
In-Reply-To: <1329893199-21630-11-git-send-email-awg+notmuch@xvx.ca>
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
next prev parent reply other threads:[~2012-03-09 23:13 UTC|newest]
Thread overview: 26+ messages / expand[flat|nested] mbox.gz Atom feed top
2012-02-22 6:46 [PATCH v6 00/10] Reply improvements Adam Wolfe Gordon
2012-02-22 6:46 ` [PATCH v6 01/10] test: Add broken test for the new JSON reply format Adam Wolfe Gordon
2012-02-22 6:46 ` [PATCH v6 02/10] reply: Factor out reply creation Adam Wolfe Gordon
2012-03-08 22:05 ` Jani Nikula
2012-02-22 6:46 ` [PATCH v6 03/10] reply: Require that only one message is returned Adam Wolfe Gordon
2012-03-09 23:00 ` Jani Nikula
2012-03-10 18:29 ` Adam Wolfe Gordon
2012-03-12 0:29 ` Austin Clements
2012-02-22 6:46 ` [PATCH v6 04/10] TODO: Add replying to multiple messages Adam Wolfe Gordon
2012-02-22 6:46 ` [PATCH v6 05/10] reply: Add a JSON reply format Adam Wolfe Gordon
2012-03-09 23:08 ` Jani Nikula
2012-03-10 18:27 ` Adam Wolfe Gordon
2012-02-22 6:46 ` [PATCH v6 06/10] schemata: Add documentation for " Adam Wolfe Gordon
2012-03-12 0:36 ` Austin Clements
2012-03-12 4:09 ` Adam Wolfe Gordon
2012-03-12 20:57 ` Austin Clements
2012-02-22 6:46 ` [PATCH v6 07/10] man: Update notmuch-reply man page for JSON format Adam Wolfe Gordon
2012-02-22 6:46 ` [PATCH v6 08/10] emacs: Factor out useful functions into notmuch-lib Adam Wolfe Gordon
2012-02-22 6:46 ` [PATCH v6 09/10] test: Add broken tests for new emacs reply functionality Adam Wolfe Gordon
2012-02-22 6:46 ` [PATCH v6] emacs: Use the new JSON reply format and message-cite-original Adam Wolfe Gordon
2012-03-09 23:13 ` Jani Nikula [this message]
2012-03-10 18:19 ` Adam Wolfe Gordon
2012-03-12 1:11 ` Austin Clements
2012-02-25 21:29 ` [PATCH v6 00/10] Reply improvements David Bremner
2012-02-25 22:25 ` Adam Wolfe Gordon
2012-02-26 0:23 ` Austin Clements
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=87aa3p8j1x.fsf@nikula.org \
--to=jani@nikula.org \
--cc=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).