Date: Fri, 17 Feb 2012 15:00:17 -0500
From: Austin Clements <amdragon@MIT.EDU>
To: Adam Wolfe Gordon <awg+notmuch@xvx.ca>
Subject: Re: [PATCH v5.2 7/7] emacs: Use the new JSON reply format and
	message-cite-original
Message-ID: <20120217200017.GG5991@mit.edu>
References: <1329361957-28493-1-git-send-email-awg+notmuch@xvx.ca>
	<1329361957-28493-8-git-send-email-awg+notmuch@xvx.ca>
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
In-Reply-To: <1329361957-28493-8-git-send-email-awg+notmuch@xvx.ca>
User-Agent: Mutt/1.5.21 (2010-09-15)
Cc: notmuch@notmuchmail.org
Precedence: list

Quoth Adam Wolfe Gordon on Feb 15 at  8:12 pm:
> 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.

One general comment that affects a lot of things in this patch: I
think you should use the same JSON parsing settings that
notmuch-query-get-threads uses.  Besides consistency and more
opportunities for code reuse, using lists instead of vectors for JSON
arrays will simplify a lot of this code without any drawbacks.

> ---
>  emacs/notmuch-lib.el |    6 ++
>  emacs/notmuch-mua.el |  127 +++++++++++++++++++++++++++++++++++---------------
>  test/emacs           |    8 ++--
>  3 files changed, 100 insertions(+), 41 deletions(-)
> 
> diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
> index 7e3f110..3fc7aff 100644
> --- a/emacs/notmuch-lib.el
> +++ b/emacs/notmuch-lib.el
> @@ -206,6 +206,12 @@ 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 vector of message parts, return a vector containing the ones matching the given type."

Wrap at 72.

> +  (loop for part across parts
> +	if (notmuch-match-content-type (cdr (assq 'content-type part)) type)
> +	vconcat (list part)))

With lists, (and since we've decided it's okay to use cl):

  (remove-if-not
   (lambda (part) (notmuch-match-content-type (cdr (assq 'content-type part)) type))
   parts)

> +
>  ;; 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..7d43821 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,105 @@ list."
>  	    (push header message-hidden-headers)))
>  	notmuch-mua-hidden-headers))
>  
> +(defun notmuch-mua-get-displayed-part (part query-string)
> +  (with-temp-buffer
> +    (if (assq 'content part)
> +	(insert (cdr (assq 'content part)))
> +      (call-process notmuch-command nil t nil "show" "--format=raw"
> +		    (format "--part=%s" (cdr (assq 'id part)))
> +		    query-string))
> +
> +    (let ((handle (mm-make-handle (current-buffer) (list (cdr (assq 'content-type part)))))
> +	  (end-of-orig (point-max)))
> +      (mm-display-part handle)
> +      (delete-region (point-min) end-of-orig)
> +      (buffer-substring (point-min) (point-max)))))

One of the biggest wins of using consistent JSON parsing settings is
that this can be replaced with notmuch-show-mm-display-part-inline,
which, as far as I can tell, accomplishes the same thing, but handles
a lot of corner-cases that this doesn't (like crypto and charset
conversion).

> +
> +(defun notmuch-mua-multipart/*-to-list (parts)

This name isn't particularly informative to me (though, for reasons
below, I don't think this even needs to be a function).

> +  (loop for part across parts
> +	collect (cdr (assq 'content-type part))))

With lists,
  (map (lambda (part) (cdr (assq 'content-type part))) parts)

Actually, with lists and plists,
  (map (lambda (part) (plist-get part 'content-type)) parts)
which I think is short enough and self-explanatory enough that it
doesn't even need to go in a function.

> +
> +(defun notmuch-mua-get-quotable-parts (parts)
> +  (loop for part across parts
> +	if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/alternative")
> +	  append (let* ((subparts (cdr (assq 'content part)))
> +			(types (notmuch-mua-multipart/*-to-list subparts))
> +			(chosen-type (car (notmuch-multipart/alternative-choose types))))
> +		   (notmuch-mua-get-quotable-parts (notmuch-parts-filter-by-type subparts chosen-type)))

This seems roundabout.  The point of multipart/alternative is that the
subparts are equivalent representations provided in order of
preference by the sender and that the client is supposed to choose
*one* of the alternates.  Even if multiple subparts have the same
content-type, they're still alternates, so we should insert only one
of them (and, since content-type is our only criteria for choosing
between alternates, we should use the last one of acceptable type,
since it was considered more preferential by the sender).

> +	else if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/*")
> +	  append (notmuch-mua-get-quotable-parts (cdr (assq 'content part)))
> +	else if (notmuch-match-content-type (cdr (assq 'content-type part)) "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"))
> +	reply
> +	original)
> +    (when notmuch-show-process-crypto
> +      (setq args (append args '("--decrypt"))))

No need to change the last two lines above (though there's obviously
no harm in doing so).

> +
>      (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 (cdr (assq 'original reply)))
> +
> +    ;; Extract the headers of both the reply and the original message.
> +    (let* ((original-headers (cdr (assq 'headers original)))
> +	   (reply-headers (cdr (assq 'reply-headers reply))))

This is the one place where using the JSON parsing settings from
notmuch-query-get-threads is slightly annoying, since the mail-*
functions expect alists.  

OTOH, the mail-* functions seem kind of pointless here; plist-set
could replace mail-header-set and plist-get could replace mail-header.
The only non-trivial function that expects an alist is
message-headers-to-generate (and, by extension, notmuch-mua-mail).

> +
> +      ;; If sender is non-nil, set the From: header to its value.
> +      (when sender
> +	(mail-header-set 'From sender reply-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 reply-headers)
> +			  (mail-header 'Subject reply-headers)
> +			  (message-headers-to-generate reply-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)))
> +
> +      (let ((from (cdr (assq 'From original-headers)))
> +	    (date (cdr (assq 'Date original-headers)))
> +	    (start (point)))
> +
> +	(insert "From: " from "\n")
> +	(insert "Date: " date "\n\n")

Sorry; I'm having trouble following the diff.  What are the inserts
for?

> +
> +	;; 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 (cdr (assq 'body original)))))
> +	  (mapc (lambda (part)
> +		  (insert (notmuch-mua-get-displayed-part part query-string)))
> +		quotable-parts))

Alternatively, notmuch-mua-get-quotable-parts could be
notmuch-mua-insert-quotable-parts, which would probably simplify
things a bit.  Your call.

> +
> +	(push-mark)

It's unfortunate that message-cite-original depends on the mark.
Since you're about to push the mark for the user anyway, maybe this
should be a set-mark so that only one mark gets pushed?

> +	(goto-char start)
> +	;; Quote the original message according to the user's configured style.
> +	(message-cite-original))))

message-cite-original-without-signature?

>  
> +  (push-mark)

Is message-cite-original guaranteed to leave point in a reasonable
place for this or should we create our own marker above (probably
after the if re-search-backward..) and use it here to get point to the
right place?

>    (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)))
> +  (mml-quote-region (point) (mark))
> +  (set-buffer-modified-p nil))
>  
>  (defun notmuch-mua-forward-message ()
>    (message-forward)
> @@ -147,7 +200,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 +263,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