[PATCH v5 4/4] emacs: Use the new JSON reply format and message-cite-original
Adam Wolfe Gordon
awg+notmuch at xvx.ca
Tue Feb 14 21:00:27 PST 2012
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 <dme at dme.org>
+(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: <XXX>
Fcc: $(pwd)/mail/sent
--text follows this line--
-On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite at notmuchmail.org> wrote:
+Notmuch Test Suite <test_suite at notmuchmail.org> 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 at hikari")
+ (notmuch-show-reply)
+ (test-output)'
+cat <<EOF >EXPECTED
+From: Notmuch Test Suite <test_suite at notmuchmail.org>
+To: Adrian Perez de Castro <aperez at igalia.com>, notmuch at notmuchmail.org
+Subject: Re: [notmuch] Introducing myself
+In-Reply-To: <20091118002059.067214ed at hikari>
+Fcc: ${MAIL_DIR}/sent
+--text follows this line--
+Adrian Perez de Castro <aperez at igalia.com> 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 <aperez at igalia.com>
+> Igalia - Free Software Engineering
+> _______________________________________________
+> notmuch mailing list
+> notmuch at 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 at mail.gmail.com")
+ (notmuch-show-reply)
+ (test-output)'
+cat <<EOF >EXPECTED
+From: Notmuch Test Suite <test_suite at notmuchmail.org>
+To: Alex Botero-Lowry <alex.boterolowry at gmail.com>, notmuch at notmuchmail.org
+Subject: Re: [notmuch] preliminary FreeBSD support
+In-Reply-To: <cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a at mail.gmail.com>
+Fcc: ${MAIL_DIR}/sent
+--text follows this line--
+Alex Botero-Lowry <alex.boterolowry at gmail.com> 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 at 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 at message.id'
add_message [id]="$message_id" \
@@ -288,7 +384,8 @@ Subject: Re: Quote MML tags in reply
In-Reply-To: <test-emacs-mml-quoting at message.id>
Fcc: ${MAIL_DIR}/sent
--text follows this line--
-On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite <test_suite at notmuchmail.org> wrote:
+Notmuch Test Suite <test_suite at notmuchmail.org> writes:
+
> <#!part disposition=inline>
EOF
test_expect_equal_file OUTPUT EXPECTED
--
1.7.5.4
More information about the notmuch
mailing list