Using the new JSON reply format allows emacs to quote HTML
parts nicely by using mm-display-part to turn them into displayable
text, then quoting them. This is very useful for users who
regularly receive HTML-only email.
The behavior for messages that contain plain text parts should be
unchanged.
---
emacs/notmuch-lib.el | 8 ++++
emacs/notmuch-mua.el | 95 +++++++++++++++++++++++++++++++++-----------------
2 files changed, 71 insertions(+), 32 deletions(-)
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 9242537..9863d69 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -21,6 +21,8 @@
;; This is an part of an emacs-based interface to the notmuch mail system.
+(eval-when-compile (require 'cl))
+
(defvar notmuch-command "notmuch"
"Command to run the notmuch binary.")
@@ -160,6 +162,12 @@ the user hasn't set this variable with the old or new
value."
(list 'when (< emacs-major-version 23)
form))
+(defun notmuch-parts-filter-by-type (parts type)
+ "Return a list of message parts with the given type"
+ (loop for part across parts
+ if (string= (cdr (assq 'content-type part)) type)
+ collect (cdr (assq 'content part))))
+
;; 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 023645e..5ae0ccf 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -19,6 +19,7 @@
;;
;; Authors: David Edmondson <d...@dme.org>
+(require 'json)
(require 'message)
(require 'notmuch-lib)
@@ -72,49 +73,79 @@ list."
(push header message-hidden-headers)))
notmuch-mua-hidden-headers))
+(defun notmuch-mua-insert-part-quoted (part)
+ (let ((start (point))
+ limit)
+ (insert part)
+ (setq limit (point-marker))
+ (goto-char start)
+ (while (re-search-forward "\\(^\\)[^$]" (marker-position limit) 0)
+ (replace-match "> " nil nil nil 1))
+ (set-buffer-modified-p nil)))
+
+(defun notmuch-mua-parse-html-part (part)
+ (with-temp-buffer
+ (insert part)
+ (let ((handle (mm-make-handle (current-buffer) (list "text/html")))
+ (end-of-orig (point-max)))
+ (mm-display-part handle)
+ (delete-region (point-min) end-of-orig)
+ (fill-region (point-min) (point-max))
+ (buffer-substring (point-min) (point-max)))))
+
(defun notmuch-mua-reply (query-string &optional sender reply-all)
- (let (headers
- body
- (args '("reply")))
+ (let ((args '("reply" "--format=json"))
+ reply
+ body)
(if 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 (aref (json-read) 0)))
+
+ ;; Start with the prelude, based on the headers of the original message.
+ (let* ((original (cdr (assq 'original reply)))
+ (headers (cdr (assq 'headers (assq 'reply reply))))
+ (original-headers (cdr (assq 'headers original)))
+ (body-parts (cdr (assq 'body original)))
+ (plain-parts (notmuch-parts-filter-by-type body-parts "text/plain"))
+ (html-parts (notmuch-parts-filter-by-type body-parts "text/html")))
+
+ ;; 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)
(forward-line -1)
- (goto-char (point-max)))
- (insert body)
- (push-mark))
- (set-buffer-modified-p nil)
+ (goto-char (point-max)))
+
+ (insert (format "On %s, %s wrote:\n"
+ (cdr (assq 'date original-headers))
+ (cdr (assq 'from original-headers))))
+
+ (if plain-parts
+ (mapc (lambda (part) (notmuch-mua-insert-part-quoted part))
plain-parts)
+ (mapc (lambda (part)
+ (notmuch-mua-insert-part-quoted (notmuch-mua-parse-html-part
part)))
+ html-parts))
+
+ (push-mark))
+ (set-buffer-modified-p nil))
(message-goto-body))
--
1.7.5.4
_______________________________________________
notmuch mailing list
notmuch@notmuchmail.org
http://notmuchmail.org/mailman/listinfo/notmuch
