From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from localhost (localhost [127.0.0.1]) by olra.theworths.org (Postfix) with ESMTP id 6D7E7429E3B for ; Mon, 16 Jan 2012 10:14:01 -0800 (PST) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: 0 X-Spam-Level: X-Spam-Status: No, score=0 tagged_above=-999 required=5 tests=[RCVD_IN_DNSWL_NONE=-0.0001] autolearn=disabled Received: from olra.theworths.org ([127.0.0.1]) by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id MRDtH1MDE+Xz for ; Mon, 16 Jan 2012 10:13:58 -0800 (PST) Received: from idcmail-mo2no.shaw.ca (idcmail-mo2no.shaw.ca [64.59.134.9]) by olra.theworths.org (Postfix) with ESMTP id 2C285429E37 for ; Mon, 16 Jan 2012 10:13:55 -0800 (PST) Received: from lb7f8hsrpno-svcs.dcs.int.inet (HELO pd7ml2no-ssvc.prod.shaw.ca) ([10.0.144.222]) by pd7mo1no-svcs.prod.shaw.ca with ESMTP; 16 Jan 2012 11:13:54 -0700 X-Cloudmark-SP-Filtered: true X-Cloudmark-SP-Result: v=1.1 cv=GZn8e3lTBEeJrlGK3+GUWyR5aYe1SJcDn5uEERMe9yQ= c=1 sm=1 a=c49xHdtiGxwA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17 a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=86icDZwsQ_n_ub3iSkQA:9 a=y1tSvLtBuvtIwk-oUxMA:7 a=Kw4u8EAyA4wA:10 a=0c-eHkXYtrgA:10 a=HpAAvcLHHh0Zw7uRqdWCyQ==:117 Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56]) by pd7ml2no-dmz.prod.shaw.ca with ESMTP; 16 Jan 2012 11:13:54 -0700 Received: by lagos.xvx.ca (Postfix, from userid 1000) id 661458004208; Mon, 16 Jan 2012 11:13:54 -0700 (MST) From: Adam Wolfe Gordon To: notmuch@notmuchmail.org Subject: [PATCH v2 4/4] emacs: Use the new JSON reply format. Date: Mon, 16 Jan 2012 11:13:23 -0700 Message-Id: <1326737603-21166-5-git-send-email-awg+notmuch@xvx.ca> X-Mailer: git-send-email 1.7.5.4 In-Reply-To: <1326737603-21166-1-git-send-email-awg+notmuch@xvx.ca> References: <1326737603-21166-1-git-send-email-awg+notmuch@xvx.ca> X-BeenThere: notmuch@notmuchmail.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 16 Jan 2012 18:14:02 -0000 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, except that an additional quoted line is added to the end of the reply message. The test has been updated to reflect this. --- emacs/notmuch-lib.el | 8 ++++ emacs/notmuch-mua.el | 95 ++++++++++++++++++++++++++++++++----------------- test/emacs | 1 + 3 files changed, 71 insertions(+), 33 deletions(-) diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 0f856bf..d4dd011 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -127,6 +127,14 @@ the user hasn't set this variable with the old or new value." (list 'when (< emacs-major-version 23) form)) +(defun find-parts (parts type) + "Return a list of message parts with the given type" + (delq nil (mapcar (lambda (part) + (if (string= (cdr (assq 'content-type part)) type) + (cdr (assq 'content part)))) + 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 d8ab822..b03c62c 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -19,6 +19,7 @@ ;; ;; Authors: David Edmondson +(require 'json) (require 'message) (require 'notmuch-lib) @@ -71,50 +72,78 @@ list." (push header message-hidden-headers))) notmuch-mua-hidden-headers)) +(defun notmuch-mua-insert-part-quoted (part) + (save-restriction + (narrow-to-region (point) (point)) + (insert part) + (goto-char (point-min)) + (perform-replace "^" "> " nil t nil) + (insert "\n") + (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) + (kill-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 (find-parts body-parts "text/plain")) + (html-parts (find-parts 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 (null plain-parts) + (mapc (lambda (part) (notmuch-mua-insert-part-quoted (notmuch-mua-parse-html-part part))) html-parts) + (mapc (lambda (part) (notmuch-mua-insert-part-quoted part)) plain-parts)) + + (push-mark)) + (set-buffer-modified-p nil)) + (message-goto-body)) (defun notmuch-mua-forward-message () diff --git a/test/emacs b/test/emacs index ac47b16..4219917 100755 --- a/test/emacs +++ b/test/emacs @@ -270,6 +270,7 @@ Fcc: $(pwd)/mail/sent --text follows this line-- On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite wrote: > This is a test that messages are sent via SMTP +> EOF test_expect_equal_file OUTPUT EXPECTED -- 1.7.5.4