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