From f5ad365b12b81dae20caf00ee88384cb9954a047 Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Wed, 15 Feb 2012 22:00:27 +1700 Subject: [PATCH] [PATCH v5 4/4] emacs: Use the new JSON reply format and message-cite-original --- 86/4609c95a328a2fa8f6b8b52f790573807e2627 | 478 ++++++++++++++++++++++ 1 file changed, 478 insertions(+) create mode 100644 86/4609c95a328a2fa8f6b8b52f790573807e2627 diff --git a/86/4609c95a328a2fa8f6b8b52f790573807e2627 b/86/4609c95a328a2fa8f6b8b52f790573807e2627 new file mode 100644 index 000000000..552287b6c --- /dev/null +++ b/86/4609c95a328a2fa8f6b8b52f790573807e2627 @@ -0,0 +1,478 @@ +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 E0882429E3B + for ; Tue, 14 Feb 2012 21:00:57 -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 HPErGd9Z+NR0 for ; + Tue, 14 Feb 2012 21:00:52 -0800 (PST) +Received: from idcmail-mo1so.shaw.ca (idcmail-mo1so.shaw.ca [24.71.223.10]) + by olra.theworths.org (Postfix) with ESMTP id 4743E429E4B + for ; Tue, 14 Feb 2012 21:00:51 -0800 (PST) +Received: from pd3ml3so-ssvc.prod.shaw.ca ([10.0.141.149]) + by pd3mo1so-svcs.prod.shaw.ca with ESMTP; 14 Feb 2012 22:00:50 -0700 +X-Cloudmark-SP-Filtered: true +X-Cloudmark-SP-Result: v=1.1 cv=zk9oM8twhc3i0pWciPL6Xc/pqaeDF/K3qFEQp81fRTo= + c=1 sm=1 + a=B8D34MJQNcEA:10 a=BLceEmwcHowA:10 a=yQp6g8lIsgqumF79BAsFDg==:17 + a=H4IEW4q-AAAA:8 a=7343-z1_AAAA:8 a=V2sgnzSHAAAA:8 a=SuFOw32sAAAA:8 + a=pGLkceISAAAA:8 a=uZvujYp8AAAA:8 a=_ctWjzdLAAAA:8 + a=DT5hYQGO3e35CuGonQwA:9 + a=hvaunJzi6vSKYi9u9WQA:7 a=0BPXsuqt4rsA:10 a=-xelrQF7p3AA:10 + a=Kw4u8EAyA4wA:10 a=0c-eHkXYtrgA:10 a=Gb7Eya4fYr0A:10 a=MSl-tDqOz04A:10 + a=HpAAvcLHHh0Zw7uRqdWCyQ==:117 +Received: from unknown (HELO lagos.xvx.ca) ([96.52.216.56]) + by pd3ml3so-dmz.prod.shaw.ca with ESMTP; 14 Feb 2012 22:00:49 -0700 +Received: by lagos.xvx.ca (Postfix, from userid 1000) + id A22328004EBA; Tue, 14 Feb 2012 22:00:49 -0700 (MST) +From: Adam Wolfe Gordon +To: notmuch@notmuchmail.org +Subject: [PATCH v5 4/4] emacs: Use the new JSON reply format and + message-cite-original +Date: Tue, 14 Feb 2012 22:00:27 -0700 +Message-Id: <1329282027-29457-5-git-send-email-awg+notmuch@xvx.ca> +X-Mailer: git-send-email 1.7.5.4 +In-Reply-To: <1329282027-29457-1-git-send-email-awg+notmuch@xvx.ca> +References: <1329282027-29457-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: Wed, 15 Feb 2012 05:00:58 -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 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 test has been updated to reflect the (ugly) emacs default. +--- + emacs/notmuch-lib.el | 39 +++++++++++++++ + emacs/notmuch-mua.el | 123 +++++++++++++++++++++++++++++++++++-------------- + emacs/notmuch-show.el | 24 +--------- + test/emacs | 101 +++++++++++++++++++++++++++++++++++++++- + 4 files changed, 228 insertions(+), 59 deletions(-) + +diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el +index d315f76..3fc7aff 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.") + +@@ -173,6 +175,43 @@ the user hasn't set this variable with the old or new value." + (list 'when (< emacs-major-version 23) + form)) + ++(defun notmuch-split-content-type (content-type) ++ "Split content/type into 'content' and 'type'" ++ (split-string content-type "/")) ++ ++(defun notmuch-match-content-type (t1 t2) ++ "Return t if t1 and t2 are matching content types, taking wildcards into account" ++ (let ((st1 (notmuch-split-content-type t1)) ++ (st2 (notmuch-split-content-type t2))) ++ (if (or (string= (cadr st1) "*") ++ (string= (cadr st2) "*")) ++ (string= (car st1) (car st2)) ++ (string= t1 t2)))) ++ ++(defvar notmuch-multipart/alternative-discouraged ++ '( ++ ;; Avoid HTML parts. ++ "text/html" ++ ;; multipart/related usually contain a text/html part and some associated graphics. ++ "multipart/related" ++ )) ++ ++(defun notmuch-multipart/alternative-choose (types) ++ "Return a list of preferred types from the given list of types" ++ ;; Based on `mm-preferred-alternative-precedence'. ++ (let ((seq types)) ++ (dolist (pref (reverse notmuch-multipart/alternative-discouraged)) ++ (dolist (elem (copy-sequence seq)) ++ (when (string-match pref elem) ++ (setq seq (nconc (delete elem seq) (list elem)))))) ++ seq)) ++ ++(defun notmuch-parts-filter-by-type (parts type) ++ "Given a vector of message parts, return a vector containing the ones matching the given type." ++ (loop for part across parts ++ if (notmuch-match-content-type (cdr (assq 'content-type part)) type) ++ vconcat (list 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 4be7c13..371993f 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,56 +76,105 @@ list." + (push header message-hidden-headers))) + notmuch-mua-hidden-headers)) + ++(defun notmuch-mua-get-displayed-part (part query-string) ++ (with-temp-buffer ++ (if (assq 'content part) ++ (insert (cdr (assq 'content part))) ++ (call-process notmuch-command nil t nil "show" "--format=raw" ++ (format "--part=%s" (cdr (assq 'id part))) ++ query-string)) ++ ++ (let ((handle (mm-make-handle (current-buffer) (list (cdr (assq 'content-type part))))) ++ (end-of-orig (point-max))) ++ (mm-display-part handle) ++ (delete-region (point-min) end-of-orig) ++ (buffer-substring (point-min) (point-max))))) ++ ++(defun notmuch-mua-multipart/*-to-list (parts) ++ (loop for part across parts ++ collect (cdr (assq 'content-type part)))) ++ ++(defun notmuch-mua-get-quotable-parts (parts) ++ (loop for part across parts ++ if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/alternative") ++ append (let* ((subparts (cdr (assq 'content part))) ++ (types (notmuch-mua-multipart/*-to-list subparts)) ++ (chosen-type (car (notmuch-multipart/alternative-choose types)))) ++ (notmuch-mua-get-quotable-parts (notmuch-parts-filter-by-type subparts chosen-type))) ++ else if (notmuch-match-content-type (cdr (assq 'content-type part)) "multipart/*") ++ append (notmuch-mua-get-quotable-parts (cdr (assq 'content part))) ++ else if (notmuch-match-content-type (cdr (assq 'content-type part)) "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) +- (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 (json-read))) ++ ++ ;; Extract the original message to simplify the following code. ++ (setq original (cdr (assq 'original reply))) ++ ++ ;; Extract the headers of both the reply and the original message. ++ (let* ((original-headers (cdr (assq 'headers original))) ++ (reply-headers (cdr (assq 'reply-headers reply)))) ++ ++ ;; If sender is non-nil, set the From: header to its value. ++ (when sender ++ (mail-header-set 'from sender reply-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 reply-headers) ++ (mail-header 'subject reply-headers) ++ (message-headers-to-generate reply-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))) ++ ++ (let ((from (cdr (assq 'From original-headers))) ++ (date (cdr (assq 'Date original-headers))) ++ (start (point))) ++ ++ (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 (cdr (assq 'body original))))) ++ (mapc (lambda (part) ++ (insert (notmuch-mua-get-displayed-part part query-string))) ++ quotable-parts)) ++ ++ (push-mark) ++ (goto-char start) ++ ;; Quote the original message according to the user's configured style. ++ (message-cite-original)))) + ++ (push-mark) + (message-goto-body) + ;; Original message may contain (malicious) MML tags. We must + ;; properly quote them in the reply. Note that using `point-max' + ;; instead of `mark' here is wrong. The buffer may include user's + ;; signature which should not be MML-quoted. +- (mml-quote-region (point) (mark))) ++ (mml-quote-region (point) (mark)) ++ (set-buffer-modified-p nil)) + + (defun notmuch-mua-forward-message () + (message-forward) +diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el +index 43408d9..90cdd38 100644 +--- a/emacs/notmuch-show.el ++++ b/emacs/notmuch-show.el +@@ -513,30 +513,13 @@ current buffer, if possible." + (mm-display-part handle) + t)))))) + +-(defvar notmuch-show-multipart/alternative-discouraged +- '( +- ;; Avoid HTML parts. +- "text/html" +- ;; multipart/related usually contain a text/html part and some associated graphics. +- "multipart/related" +- )) +- + (defun notmuch-show-multipart/*-to-list (part) + (mapcar (lambda (inner-part) (plist-get inner-part :content-type)) + (plist-get part :content))) + +-(defun notmuch-show-multipart/alternative-choose (types) +- ;; Based on `mm-preferred-alternative-precedence'. +- (let ((seq types)) +- (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged)) +- (dolist (elem (copy-sequence seq)) +- (when (string-match pref elem) +- (setq seq (nconc (delete elem seq) (list elem)))))) +- seq)) +- + (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type) + (notmuch-show-insert-part-header nth declared-type content-type nil) +- (let ((chosen-type (car (notmuch-show-multipart/alternative-choose (notmuch-show-multipart/*-to-list part)))) ++ (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part)))) + (inner-parts (plist-get part :content)) + (start (point))) + ;; This inserts all parts of the chosen type rather than just one, +@@ -775,9 +758,6 @@ current buffer, if possible." + + ;; Functions for determining how to handle MIME parts. + +-(defun notmuch-show-split-content-type (content-type) +- (split-string content-type "/")) +- + (defun notmuch-show-handlers-for (content-type) + "Return a list of content handlers for a part of type CONTENT-TYPE." + (let (result) +@@ -788,7 +768,7 @@ current buffer, if possible." + (list (intern (concat "notmuch-show-insert-part-*/*")) + (intern (concat + "notmuch-show-insert-part-" +- (car (notmuch-show-split-content-type content-type)) ++ (car (notmuch-split-content-type content-type)) + "/*")) + (intern (concat "notmuch-show-insert-part-" content-type)))) + result)) +diff --git a/test/emacs b/test/emacs +index d4a8d30..a6786d4 100755 +--- a/test/emacs ++++ b/test/emacs +@@ -268,11 +268,107 @@ Subject: Re: Testing message sent via SMTP + In-Reply-To: + Fcc: $(pwd)/mail/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_emacs '(notmuch-show "id:20091118002059.067214ed@hikari") ++ (notmuch-show-reply) ++ (test-output)' ++cat <EXPECTED ++From: Notmuch Test Suite ++To: Adrian Perez de Castro , notmuch@notmuchmail.org ++Subject: Re: [notmuch] Introducing myself ++In-Reply-To: <20091118002059.067214ed@hikari> ++Fcc: ${MAIL_DIR}/sent ++--text follows this line-- ++Adrian Perez de Castro writes: ++ ++> Hello to all, ++> ++> I have just heard about Not Much today in some random Linux-related news ++> site (LWN?), my name is Adrian Perez and I work as systems administrator ++> (although I can do some code as well :P). I have always thought that the ++> ideas behind Sup were great, but after some time using it, I got tired of ++> the oddities that it has. I also do not like doing things like having to ++> install Ruby just for reading and sorting mails. Some time ago I thought ++> about doing something like Not Much and in fact I played a bit with the ++> Python+Xapian and the Python+Whoosh combinations, because I find relaxing ++> to code things in Python when I am not working and also it is installed ++> by default on most distribution. I got to have some mailboxes indexed and ++> basic searching working a couple of months ago. Lately I have been very ++> busy and had no time for coding, and them... boom! Not Much appears -- and ++> it is almost exactly what I was trying to do, but faster. I have been ++> playing a bit with Not Much today, and I think it has potential. ++> ++> Also, I would like to share one idea I had in mind, that you might find ++> interesting: One thing I have found very annoying is having to re-tag my ++> mail when the indexes get b0rked (it happened a couple of times to me while ++> using Sup), so I was planning to mails as read/unread and adding the tags ++> not just to the index, but to the mail text itself, e.g. by adding a ++> "X-Tags" header field or by reusing the "Keywords" one. This way, the index ++> could be totally recreated by re-reading the mail directories, and this ++> would also allow to a tools like OfflineIMAP [1] to get the mails into a ++> local maildir, tagging and indexing the mails with the e-mail reader and ++> then syncing back the messages with the "X-Tags" header to the IMAP server. ++> This would allow to use the mail reader from a different computer and still ++> have everything tagged finely. ++> ++> Best regards, ++> ++> ++> --- ++> [1] http://software.complete.org/software/projects/show/offlineimap ++> ++> -- ++> Adrian Perez de Castro ++> Igalia - Free Software Engineering ++> _______________________________________________ ++> notmuch mailing list ++> notmuch@notmuchmail.org ++> http://notmuchmail.org/mailman/listinfo/notmuch ++EOF ++test_expect_equal_file OUTPUT EXPECTED ++ ++test_begin_subtest "Reply within emacs to a multipart/alternative message" ++test_emacs '(notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com") ++ (notmuch-show-reply) ++ (test-output)' ++cat <EXPECTED ++From: Notmuch Test Suite ++To: Alex Botero-Lowry , notmuch@notmuchmail.org ++Subject: Re: [notmuch] preliminary FreeBSD support ++In-Reply-To: ++Fcc: ${MAIL_DIR}/sent ++--text follows this line-- ++Alex Botero-Lowry writes: ++ ++> I saw the announcement this morning, and was very excited, as I had been ++> hoping sup would be turned into a library, ++> since I like the concept more than the UI (I'd rather an emacs interface). ++> ++> I did a preliminary compile which worked out fine, but ++> sysconf(_SC_SC_GETPW_R_SIZE_MAX) returns -1 on ++> FreeBSD, so notmuch_config_open segfaulted. ++> ++> Attached is a patch that supplies a default buffer size of 64 in cases where ++> -1 is returned. ++> ++> http://www.opengroup.org/austin/docs/austin_328.txt - seems to indicate this ++> is acceptable behavior, ++> and http://mail-index.netbsd.org/pkgsrc-bugs/2006/06/07/msg016808.htmlspecifically ++> uses 64 as the ++> buffer size. ++> _______________________________________________ ++> notmuch mailing list ++> notmuch@notmuchmail.org ++> http://notmuchmail.org/mailman/listinfo/notmuch ++EOF ++test_expect_equal_file OUTPUT EXPECTED ++ + test_begin_subtest "Quote MML tags in reply" + message_id='test-emacs-mml-quoting@message.id' + add_message [id]="$message_id" \ +@@ -288,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