From d67f6704de291d5e52f910956c941fd519cb0b2c Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Mon, 19 Mar 2012 10:32:42 +1800 Subject: [PATCH] [PATCH v8 10/11] emacs: Use the new JSON reply format and message-cite-original --- c5/b1b65bb9e7114f89ecff980b0880f35bf77635 | 410 ++++++++++++++++++++++ 1 file changed, 410 insertions(+) create mode 100644 c5/b1b65bb9e7114f89ecff980b0880f35bf77635 diff --git a/c5/b1b65bb9e7114f89ecff980b0880f35bf77635 b/c5/b1b65bb9e7114f89ecff980b0880f35bf77635 new file mode 100644 index 000000000..00b4d6ca8 --- /dev/null +++ b/c5/b1b65bb9e7114f89ecff980b0880f35bf77635 @@ -0,0 +1,410 @@ +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 5D1BB431FAE + for ; Sun, 18 Mar 2012 09:33:07 -0700 (PDT) +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 sr8Myo2+-dzo for ; + Sun, 18 Mar 2012 09:33:03 -0700 (PDT) +Received: from idcmail-mo2no.shaw.ca (idcmail-mo2no.shaw.ca [64.59.134.9]) + by olra.theworths.org (Postfix) with ESMTP id 1B83F431FD5 + for ; Sun, 18 Mar 2012 09:33:01 -0700 (PDT) +Received: from lb7f8hsrpno-svcs.dcs.int.inet (HELO pd6ml2no-ssvc.prod.shaw.ca) + ([10.0.144.222]) + by pd6mo1no-svcs.prod.shaw.ca with ESMTP; 18 Mar 2012 10:33:00 -0600 +X-Cloudmark-SP-Filtered: true +X-Cloudmark-SP-Result: v=1.1 cv=oQE6vNJ3d7oTBHj4PDKYH99BAdyPlqTp0xAtaaBYR4E= + c=1 sm=1 + a=4vT4Kfs2-XgA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17 + a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=pGLkceISAAAA:8 + a=pkj2EqAftlighcz09hEA:9 + a=GfdN2rCGAuq2ylZorScA:7 a=0BPXsuqt4rsA:10 a=Kw4u8EAyA4wA:10 + a=0c-eHkXYtrgA:10 a=Ka2vHfUGn-E_Sbxc:21 a=xsk0_cFsgf0rMD6X:21 + a=HpAAvcLHHh0Zw7uRqdWCyQ==:117 +Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56]) + by pd6ml2no-dmz.prod.shaw.ca with ESMTP; 18 Mar 2012 10:33:00 -0600 +Received: by lagos.xvx.ca (Postfix, from userid 1000) + id 99F7B8004204; Sun, 18 Mar 2012 10:33:00 -0600 (MDT) +From: Adam Wolfe Gordon +To: notmuch@notmuchmail.org +Subject: [PATCH v8 10/11] emacs: Use the new JSON reply format and + message-cite-original +Date: Sun, 18 Mar 2012 10:32:42 -0600 +Message-Id: <1332088363-22476-11-git-send-email-awg+notmuch@xvx.ca> +X-Mailer: git-send-email 1.7.5.4 +In-Reply-To: <1332088363-22476-1-git-send-email-awg+notmuch@xvx.ca> +References: <87fwd6kqtv.fsf@zancas.localnet> + <1332088363-22476-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, 18 Mar 2012 16:33:07 -0000 + +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 | 30 ++++++++++++ + emacs/notmuch-mua.el | 124 +++++++++++++++++++++++++++++++++---------------- + emacs/notmuch-show.el | 31 ++---------- + test/emacs | 8 ++-- + 4 files changed, 123 insertions(+), 70 deletions(-) + +diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el +index 7e3f110..c146748 100644 +--- a/emacs/notmuch-lib.el ++++ b/emacs/notmuch-lib.el +@@ -206,6 +206,36 @@ 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)) ++ ++;; Helper for parts which are generally not included in the default ++;; JSON output. ++(defun notmuch-get-bodypart-internal (message-id part-number process-crypto) ++ (let ((args '("show" "--format=raw")) ++ (part-arg (format "--part=%s" part-number))) ++ (setq args (append args (list part-arg))) ++ (if process-crypto ++ (setq args (append args '("--decrypt")))) ++ (setq args (append args (list message-id))) ++ (with-temp-buffer ++ (let ((coding-system-for-read 'no-conversion)) ++ (progn ++ (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args)) ++ (buffer-string)))))) ++ ++(defun notmuch-get-bodypart-content (msg part nth process-crypto) ++ (or (plist-get part :content) ++ (notmuch-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth process-crypto))) ++ ++(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 13244eb..6aae3a0 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,54 +76,92 @@ list." + (push header message-hidden-headers))) + notmuch-mua-hidden-headers)) + ++(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")) ++ 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)) +- (setq headers (mail-header-extract))))) +- (forward-line 1) +- ;; Original message may contain (malicious) MML tags. We must +- ;; properly quote them in the reply. +- (mml-quote-region (point) (point-max)) +- (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) ++ (let ((json-object-type 'plist) ++ (json-array-type 'list) ++ (json-false 'nil)) ++ (setq reply (json-read)))) ++ ++ ;; Extract the original message to simplify the following code. ++ (setq original (plist-get reply :original)) ++ ++ ;; Extract the headers of both the reply and the original message. ++ (let* ((original-headers (plist-get original :headers)) ++ (reply-headers (plist-get reply :reply-headers))) ++ ++ ;; If sender is non-nil, set the From: header to its value. ++ (when sender ++ (plist-put reply-headers :From sender)) ++ (let ++ ;; Overlay the composition window on that being used to read ++ ;; the original message. ++ ((same-window-regexps '("\\*mail .*"))) ++ (notmuch-mua-mail (plist-get reply-headers :To) ++ (plist-get reply-headers :Subject) ++ (notmuch-plist-to-alist reply-headers))) ++ ;; 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) +- +- (message-goto-body)) ++ (goto-char (point-max))) ++ ++ (let ((from (plist-get original-headers :From)) ++ (date (plist-get original-headers :Date)) ++ (start (point))) ++ ++ ;; message-cite-original constructs a citation line based on the From and Date ++ ;; headers of the original message, which are assumed to be in the buffer. ++ (insert "From: " from "\n") ++ (insert "Date: " date "\n\n") ++ ++ ;; Get the parts of the original message that should be quoted; this includes ++ ;; all the text parts, except the non-preferred ones in a multipart/alternative. ++ (let ((quotable-parts (notmuch-mua-get-quotable-parts (plist-get original :body)))) ++ (mapc (lambda (part) ++ (insert (notmuch-get-bodypart-content original part ++ (plist-get part :id) ++ notmuch-show-process-crypto))) ++ quotable-parts)) ++ ++ (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) ++ (set-buffer-modified-p nil)) + + (defun notmuch-mua-forward-message () + (message-forward) +@@ -145,7 +187,7 @@ OTHER-ARGS are passed through to `message-mail'." + (when (not (string= "" user-agent)) + (push (cons "User-Agent" user-agent) other-headers)))) + +- (unless (mail-header 'from other-headers) ++ (unless (mail-header 'From other-headers) + (push (cons "From" (concat + (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers)) + +@@ -208,7 +250,7 @@ the From: address first." + (interactive "P") + (let ((other-headers + (when (or prompt-for-sender notmuch-always-prompt-for-sender) +- (list (cons 'from (notmuch-mua-prompt-for-sender)))))) ++ (list (cons 'From (notmuch-mua-prompt-for-sender)))))) + (notmuch-mua-mail nil nil other-headers))) + + (defun notmuch-mua-new-forward-message (&optional prompt-for-sender) +diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el +index ed938bf..0cd7d82 100644 +--- a/emacs/notmuch-show.el ++++ b/emacs/notmuch-show.el +@@ -488,7 +488,7 @@ message at DEPTH in the current thread." + (setq notmuch-show-process-crypto ,process-crypto) + ;; Always acquires the part via `notmuch part', even if it is + ;; available in the JSON output. +- (insert (notmuch-show-get-bodypart-internal ,message-id ,nth)) ++ (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto)) + ,@body)))) + + (defun notmuch-show-save-part (message-id nth &optional filename content-type) +@@ -536,7 +536,7 @@ current buffer, if possible." + ;; test whether we are able to inline it (which includes both + ;; capability and suitability tests). + (when (mm-inlined-p handle) +- (insert (notmuch-show-get-bodypart-content msg part nth)) ++ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto)) + (when (mm-inlinable-p handle) + (set-buffer display-buffer) + (mm-display-part handle) +@@ -613,8 +613,8 @@ current buffer, if possible." + ;; times (hundreds!), which results in many calls to + ;; `notmuch part'. + (unless content +- (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id) +- part-number)) ++ (setq content (notmuch-get-bodypart-internal (concat "id:" message-id) ++ part-number notmuch-show-process-crypto)) + (with-current-buffer w3m-current-buffer + (notmuch-show-w3m-cid-store-internal url + message-id +@@ -734,7 +734,7 @@ current buffer, if possible." + ;; insert a header to make this clear. + (if (> nth 1) + (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))) +- (insert (notmuch-show-get-bodypart-content msg part nth)) ++ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto)) + (save-excursion + (save-restriction + (narrow-to-region start (point-max)) +@@ -744,7 +744,7 @@ current buffer, if possible." + (defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type) + (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)) + (insert (with-temp-buffer +- (insert (notmuch-show-get-bodypart-content msg part nth)) ++ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto)) + (goto-char (point-min)) + (let ((file (make-temp-file "notmuch-ical")) + result) +@@ -806,25 +806,6 @@ current buffer, if possible." + (intern (concat "notmuch-show-insert-part-" content-type)))) + result)) + +-;; Helper for parts which are generally not included in the default +-;; JSON output. +-(defun notmuch-show-get-bodypart-internal (message-id part-number) +- (let ((args '("show" "--format=raw")) +- (part-arg (format "--part=%s" part-number))) +- (setq args (append args (list part-arg))) +- (if notmuch-show-process-crypto +- (setq args (append args '("--decrypt")))) +- (setq args (append args (list message-id))) +- (with-temp-buffer +- (let ((coding-system-for-read 'no-conversion)) +- (progn +- (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args)) +- (buffer-string)))))) +- +-(defun notmuch-show-get-bodypart-content (msg part nth) +- (or (plist-get part :content) +- (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth))) +- + ;; + + + (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type) +diff --git a/test/emacs b/test/emacs +index 01afdb6..8a28705 100755 +--- a/test/emacs ++++ b/test/emacs +@@ -268,13 +268,13 @@ Subject: Re: Testing message sent via SMTP + In-Reply-To: + Fcc: ${MAIL_DIR}/sent + --text follows this line-- +-On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite wrote: ++Notmuch Test Suite writes: ++ + > This is a test that messages are sent via SMTP + EOF + test_expect_equal_file OUTPUT EXPECTED + + test_begin_subtest "Reply within emacs to a multipart/mixed message" +-test_subtest_known_broken + test_emacs '(notmuch-show "id:20091118002059.067214ed@hikari") + (notmuch-show-reply) + (test-output)' +@@ -334,7 +334,6 @@ EOF + test_expect_equal_file OUTPUT EXPECTED + + test_begin_subtest "Reply within emacs to a multipart/alternative message" +-test_subtest_known_broken + test_emacs '(notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com") + (notmuch-show-reply) + (test-output)' +@@ -385,7 +384,8 @@ Subject: Re: Quote MML tags in reply + In-Reply-To: + Fcc: ${MAIL_DIR}/sent + --text follows this line-- +-On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite wrote: ++Notmuch Test Suite writes: ++ + > <#!part disposition=inline> + EOF + test_expect_equal_file OUTPUT EXPECTED +-- +1.7.5.4 + -- 2.26.2