Return-Path: X-Original-To: notmuch@notmuchmail.org Delivered-To: notmuch@notmuchmail.org Received: from localhost (localhost [127.0.0.1]) by olra.theworths.org (Postfix) with ESMTP id 5659040EF31 for ; Sat, 7 Jan 2012 23:53:13 -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 npTN+rd56huI for ; Sat, 7 Jan 2012 23:53:11 -0800 (PST) Received: from idcmail-mo1so.shaw.ca (idcmail-mo1so.shaw.ca [24.71.223.10]) by olra.theworths.org (Postfix) with ESMTP id 5919240A3B4 for ; Sat, 7 Jan 2012 23:53:11 -0800 (PST) Received: from pd2ml1so-ssvc.prod.shaw.ca ([10.0.141.139]) by pd2mo1so-svcs.prod.shaw.ca with ESMTP; 08 Jan 2012 00:53:11 -0700 X-Cloudmark-SP-Filtered: true X-Cloudmark-SP-Result: v=1.1 cv=2TvZ7eE48NdEYeaL5Xf58dNzJU178UzT+2lxUZ5Mhss= c=1 sm=1 a=riRlqzb88rMA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17 a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=S3h8R8xMpjlGWVskdFoA:9 a=OXBJ_bGCH-Qf7lw6QaIA:7 a=Kw4u8EAyA4wA:10 a=0c-eHkXYtrgA:10 a=HpAAvcLHHh0Zw7uRqdWCyQ==:117 Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56]) by pd2ml1so-dmz.prod.shaw.ca with ESMTP; 08 Jan 2012 00:53:11 -0700 Received: by lagos.xvx.ca (Postfix, from userid 1000) id DEC2F8004202; Sun, 8 Jan 2012 00:53:10 -0700 (MST) From: Adam Wolfe Gordon To: notmuch@notmuchmail.org, awg@xvx.ca Subject: [PATCH 4/4] emacs: Use the new JSON reply format. Date: Sun, 8 Jan 2012 00:52:42 -0700 Message-Id: <1326009162-19524-5-git-send-email-awg+notmuch@xvx.ca> X-Mailer: git-send-email 1.7.5.4 In-Reply-To: <1326009162-19524-1-git-send-email-awg+notmuch@xvx.ca> References: <1326009162-19524-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: Sun, 08 Jan 2012 07:53:13 -0000 From: Adam Wolfe Gordon Using the new JSON reply format allows emacs to quote HTML parts nicely by first parsing them with w3m, 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-mua.el | 62 +++++++++++++++++++++++++++++++++++++++---------- test/emacs | 1 + 2 files changed, 50 insertions(+), 13 deletions(-) diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 7114e48..7f894cb 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,27 +72,62 @@ list." (push header message-hidden-headers))) notmuch-mua-hidden-headers)) +(defun w3m-region (start end)) ;; From `w3m.el'. +(defun notmuch-mua-quote-part (part) + (with-temp-buffer + (insert part) + (message-mode) + (fill-region (point-min) (point-max)) + (goto-char (point-min)) + (perform-replace "^" "> " nil t nil) + (set-buffer-modified-p nil) + (buffer-substring (point-min) (point-max)))) +(defun notmuch-mua-parse-html-part (part) + (with-temp-buffer + (insert part) + (w3m-region (point-min) (point-max)) + (set-buffer-modified-p nil) + (buffer-substring (point-min) (point-max)))) (defun notmuch-mua-reply (query-string &optional sender) - (let (headers + (let (reply + original + headers body - (args '("reply"))) + (args '("reply" "--format=json"))) (if notmuch-show-process-crypto (setq args (append args '("--decrypt")))) (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)))) + (setq reply (aref (json-read) 0))) + + ;; Get the list of headers + (setq headers (cdr (assq 'headers (assq 'reply reply)))) + ;; Construct the body of the reply. + (setq original (cdr (assq 'original reply))) + + ;; Start with the prelude, based on the headers of the original message. + (let ((original-headers (cdr (assq 'headers original)))) + (setq body (format "On %s, %s wrote:\n" + (cdr (assq 'date original-headers)) + (cdr (assq 'from original-headers))))) + + ;; Extract the body parts and construct a reasonable quoted body. + (let* ((body-parts (cdr (assq 'body original))) + (find-parts (lambda (type) (delq nil (mapcar (lambda (part) + (if (string= (cdr (assq 'content-type part)) type) + (cdr (assq 'content part)))) + body-parts)))) + (plain-parts (apply find-parts '("text/plain"))) + (html-parts (apply find-parts '("text/html")))) + + (if (not (null plain-parts)) + (mapc (lambda (part) (setq body (concat body (notmuch-mua-quote-part part)))) plain-parts) + (mapc (lambda (part) (setq body (concat body (notmuch-mua-quote-part (notmuch-mua-parse-html-part part))))) html-parts))) + (setq body (concat body "\n")) + ;; If sender is non-nil, set the From: header to its value. (when sender (mail-header-set 'from sender headers)) diff --git a/test/emacs b/test/emacs index a06c223..fe501da 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