[PATCH v6] emacs: Use the new JSON reply format and message-cite-original

2012-03-11 Thread Austin Clements
Quoth Adam Wolfe Gordon on Feb 21 at 11:46 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.
> ---
>  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 
>  
> +(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)

Even if it's not possible to completely reuse the show mechanisms
here, it would be nice to reuse the easy ones.  In particular,
notmuch-show-get-bodypart-content looks like it could easily be lifted
to the lib with the addition of a process-crypto argument.  It would
be slightly less efficient, but even now there's some important logic
in notmuch-show-get-bodypart-content that's missing here regarding
encoding handling.

> +
> +(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  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)

These should be bound just around the setq reply below since they're
global controls (I highly doubt anything else this function calls
would invoke the JSON parser, but we shouldn't tempt dynamic scoping).

> + reply
> +  

Re: [PATCH v6] emacs: Use the new JSON reply format and message-cite-original

2012-03-11 Thread Austin Clements
Quoth Adam Wolfe Gordon on Feb 21 at 11:46 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.
 ---
  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 d...@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)

Even if it's not possible to completely reuse the show mechanisms
here, it would be nice to reuse the easy ones.  In particular,
notmuch-show-get-bodypart-content looks like it could easily be lifted
to the lib with the addition of a process-crypto argument.  It would
be slightly less efficient, but even now there's some important logic
in notmuch-show-get-bodypart-content that's missing here regarding
encoding handling.

 +
 +(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)

These should be bound just around the setq reply below since they're
global controls (I highly doubt anything else this function calls
would invoke the JSON parser, but we shouldn't tempt dynamic scoping).

 + reply
 + original)
 +(when notmuch-show-process-crypto
 +  (setq args (append args '(--decrypt
 +
  (if 

[PATCH v6] emacs: Use the new JSON reply format and message-cite-original

2012-03-10 Thread Adam Wolfe Gordon
On Fri, Mar 9, 2012 at 16:13, Jani Nikula  wrote:
>> + ? ? (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?

As Austin pointed out on an earlier version, message-cite-original
already does the quoting, so doing it ourselves will result in
double-quoting MML tags.


[PATCH v6] emacs: Use the new JSON reply format and message-cite-original

2012-03-10 Thread Jani Nikula
On Tue, 21 Feb 2012 23:46:39 -0700, Adam Wolfe Gordon  
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 
>  
> +(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  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 

Re: [PATCH v6] emacs: Use the new JSON reply format and message-cite-original

2012-03-10 Thread Adam Wolfe Gordon
On Fri, Mar 9, 2012 at 16:13, Jani Nikula j...@nikula.org wrote:
 +     (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?

As Austin pointed out on an earlier version, message-cite-original
already does the quoting, so doing it ourselves will result in
double-quoting MML tags.
___
notmuch mailing list
notmuch@notmuchmail.org
http://notmuchmail.org/mailman/listinfo/notmuch


Re: [PATCH v6] emacs: Use the new JSON reply format and message-cite-original

2012-03-09 Thread Jani Nikula
On Tue, 21 Feb 2012 23:46:39 -0700, Adam Wolfe Gordon awg+notm...@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 d...@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)
 -  

[PATCH v6] emacs: Use the new JSON reply format and message-cite-original

2012-02-21 Thread Adam Wolfe Gordon
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 

+(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  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))
-   

[PATCH v6] emacs: Use the new JSON reply format and message-cite-original

2012-02-21 Thread Adam Wolfe Gordon
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 d...@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))
-