From da9f39216555934327a91ebc6b3b726b0a989dcf Mon Sep 17 00:00:00 2001 From: Tomi Ollila Date: Wed, 11 Jan 2012 18:53:59 +0200 Subject: test: whitespace-cleanup for most test/* files Used emacs (whitespace-cleanup) function to "cleanup blank problems" in test files where that could be done without breaking tests; test/emacs was partially, and test/multipart was fully reverted. --- test/emacs | 50 +++++++++++++++++++++++++------------------------- 1 file changed, 25 insertions(+), 25 deletions(-) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index ac47b16..f150d95 100755 --- a/test/emacs +++ b/test/emacs @@ -225,7 +225,7 @@ test_expect_equal_file OUTPUT EXPECTED mkdir -p mail/sent-list-catch-all/cur mkdir -p mail/sent-list-catch-all/new mkdir -p mail/sent-list-catch-all/tmp - + test_begin_subtest "notmuch-fcc-dirs set to a list (catch-all)" test_emacs "(let ((notmuch-fcc-dirs '((\"example.com\" . \"failure\") @@ -373,22 +373,22 @@ add_message '[date]="Sat, 01 Jan 2000 12:00:00 -0000"' \ '[body]="Unable to stash body. Where did you get it in the first place?!?"' notmuch tag +stashtest id:${gen_msg_id} test_emacs '(notmuch-show "id:\"bought\"") - (notmuch-show-stash-date) - (notmuch-show-stash-from) - (notmuch-show-stash-to) - (notmuch-show-stash-cc) - (notmuch-show-stash-subject) - (notmuch-show-stash-message-id) - (notmuch-show-stash-message-id-stripped) - (notmuch-show-stash-tags) - (notmuch-show-stash-filename) - (switch-to-buffer - (generate-new-buffer "*test-stashing*")) - (dotimes (i 9) - (yank) - (insert "\n") - (rotate-yank-pointer 1)) - (reverse-region (point-min) (point-max)) + (notmuch-show-stash-date) + (notmuch-show-stash-from) + (notmuch-show-stash-to) + (notmuch-show-stash-cc) + (notmuch-show-stash-subject) + (notmuch-show-stash-message-id) + (notmuch-show-stash-message-id-stripped) + (notmuch-show-stash-tags) + (notmuch-show-stash-filename) + (switch-to-buffer + (generate-new-buffer "*test-stashing*")) + (dotimes (i 9) + (yank) + (insert "\n") + (rotate-yank-pointer 1)) + (reverse-region (point-min) (point-max)) (test-output)' cat <EXPECTED Sat, 01 Jan 2000 12:00:00 -0000 @@ -405,11 +405,11 @@ test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Stashing in notmuch-search" test_emacs '(notmuch-search "id:\"bought\"") - (notmuch-test-wait) - (notmuch-search-stash-thread-id) - (switch-to-buffer - (generate-new-buffer "*test-stashing*")) - (yank) + (notmuch-test-wait) + (notmuch-search-stash-thread-id) + (switch-to-buffer + (generate-new-buffer "*test-stashing*")) + (yank) (test-output)' sed -i -e 's/^thread:.*$/thread:XXX/' OUTPUT test_expect_equal "$(cat OUTPUT)" "thread:XXX" @@ -438,9 +438,9 @@ test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Refresh modified show buffer" test_subtest_known_broken test_emacs '(notmuch-show "id:f35dbb950911171438k5df6eb56k77b6c0944e2e79ae@mail.gmail.com") - (notmuch-show-toggle-message) - (notmuch-show-next-message) - (notmuch-show-toggle-message) + (notmuch-show-toggle-message) + (notmuch-show-next-message) + (notmuch-show-toggle-message) (test-visible-output "EXPECTED") (notmuch-show-refresh-view) (test-visible-output)' -- cgit v1.2.3 From 50d65de394cd78bd215918e251646c32eb0c0e52 Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Wed, 25 Jan 2012 13:53:59 +0000 Subject: test: Updated expected output for new `notmuch-show-clean-address'. --- test/emacs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index f150d95..8ca4c8a 100755 --- a/test/emacs +++ b/test/emacs @@ -78,7 +78,7 @@ thread=$(notmuch search --output=threads subject:message-with-invalid-from) test_emacs "(notmuch-show \"$thread\") (test-output)" cat <EXPECTED -"Invalid " From" (2001-01-05) (inbox) +Invalid " From (2001-01-05) (inbox) Subject: message-with-invalid-from To: Notmuch Test Suite Date: Fri, 05 Jan 2001 15:43:57 +0000 -- cgit v1.2.3 From 3f2050ac221a4c940c12442f156f12fff11600c6 Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Fri, 3 Feb 2012 11:24:07 +0100 Subject: test: add tests for quoting of MML tags in replies The test is broken at this time; the next commit will introduce a fix. Edited-by: Pieter Praet : Rebased to release branch, moved expected output into the actual test, and fixed "Fcc:" line. --- test/emacs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index f36718e..db8e4ad 100755 --- a/test/emacs +++ b/test/emacs @@ -273,6 +273,27 @@ On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite w EOF test_expect_equal_file OUTPUT EXPECTED +test_begin_subtest "Quote MML tags in reply" +test_subtest_known_broken +message_id='test-emacs-mml-quoting@message.id' +add_message [id]="$message_id" \ + "[subject]='$test_subtest_name'" \ + '[body]="<#part disposition=inline>"' +test_emacs "(notmuch-show \"id:$message_id\") + (notmuch-show-reply) + (test-output)" +cat <EXPECTED +From: Notmuch Test Suite +To: +Subject: Re: Quote MML tags in reply +In-Reply-To: +Fcc: ${MAIL_DIR}/sent +--text follows this line-- +On Tue, 05 Jan 2001 15:43:57 -0000, Notmuch Test Suite wrote: +> <#!part disposition=inline> +EOF +test_expect_equal_file OUTPUT EXPECTED + test_begin_subtest "Save attachment from within emacs using notmuch-show-save-attachments" # save as archive to test that Emacs does not re-compress .gz test_emacs '(let ((standard-input "\"attachment1.gz\"")) -- cgit v1.2.3 From ae438ccd8c77831158c7c30f19710d798ee4a6b4 Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Fri, 3 Feb 2012 11:24:08 +0100 Subject: emacs: quote MML tags in replies MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Emacs message-mode uses certain text strings to indicate how to attach files to outgoing mail. If these are present in the text of an email, and a user is tricked into replying to the message, the user’s files could be exposed. Edited-by: Pieter Praet : Rebased to release branch. --- NEWS | 11 +++++++++++ emacs/notmuch-mua.el | 7 ++++++- test/emacs | 1 - 3 files changed, 17 insertions(+), 2 deletions(-) (limited to 'test/emacs') diff --git a/NEWS b/NEWS index 3d2c2a8..a089e67 100644 --- a/NEWS +++ b/NEWS @@ -11,6 +11,17 @@ Fix error handling in python bindings. exceptions to indicate the error condition. Any subsequent calls into libnotmuch caused segmentation faults. +Quote MML tags in replies + + MML tags are text codes that Emacs uses to indicate attachments + (among other things) in messages being composed. The Emacs + interface did not quote MML tags in the quoted text of a reply. + User could be tricked into replying to a maliciously formatted + message and not editing out the MML tags from the quoted text. This + could lead to files from the user's machine being attached to the + outgoing message. The Emacs interface now quotes these tags in + reply text, so that they do not effect outgoing messages. + Notmuch 0.11 (2012-01-13) ========================= diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 7114e48..3e93d7c 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -111,7 +111,12 @@ list." (insert body)) (set-buffer-modified-p nil) - (message-goto-body)) + (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) (point-max))) (defun notmuch-mua-forward-message () (message-forward) diff --git a/test/emacs b/test/emacs index db8e4ad..2d066ed 100755 --- a/test/emacs +++ b/test/emacs @@ -274,7 +274,6 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Quote MML tags in reply" -test_subtest_known_broken message_id='test-emacs-mml-quoting@message.id' add_message [id]="$message_id" \ "[subject]='$test_subtest_name'" \ -- cgit v1.2.3 From 57702cc43017cfd5c5ad65a986ef962f5e40cd59 Mon Sep 17 00:00:00 2001 From: David Bremner Date: Sat, 4 Feb 2012 13:37:33 -0500 Subject: test: Fix up date in MML quoting tests. based on id:"1328264649-27346-3-git-send-email-pieter@praet.org" Commit 66ecd9063 made dates "real", but it hasn't hit release yet. --- test/emacs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index f4a5c81..256a738 100755 --- a/test/emacs +++ b/test/emacs @@ -288,7 +288,7 @@ Subject: Re: Quote MML tags in reply In-Reply-To: Fcc: ${MAIL_DIR}/sent --text follows this line-- -On Tue, 05 Jan 2001 15:43:57 -0000, Notmuch Test Suite wrote: +On Fri, 05 Jan 2001 15:43:57 +0000, Notmuch Test Suite wrote: > <#!part disposition=inline> EOF test_expect_equal_file OUTPUT EXPECTED -- cgit v1.2.3 From 148a96c43d372333060d2bd0eef73a74659f8aa3 Mon Sep 17 00:00:00 2001 From: Dmitry Kurochkin Date: Sun, 5 Feb 2012 11:13:46 +0400 Subject: test: fix emacs tests after tagging operations changes After the recent tagging operations changes, functions bound to "+" and "-" in notmuch-search and notmuch-show views always read input from the minibuffer. Use kbd macros instead of calling them directly. --- test/emacs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index 256a738..b74cfa9 100755 --- a/test/emacs +++ b/test/emacs @@ -101,26 +101,26 @@ test_begin_subtest "Add tag from search view" os_x_darwin_thread=$(notmuch search --output=threads id:ddd65cda0911171950o4eea4389v86de9525e46052d3@mail.gmail.com) test_emacs "(notmuch-search \"$os_x_darwin_thread\") (notmuch-test-wait) - (notmuch-search-add-tag \"tag-from-search-view\")" + (execute-kbd-macro \"+tag-from-search-view\")" output=$(notmuch search $os_x_darwin_thread | notmuch_search_sanitize) test_expect_equal "$output" "thread:XXX 2009-11-18 [4/4] Jjgod Jiang, Alexander Botero-Lowry; [notmuch] Mac OS X/Darwin compatibility issues (inbox tag-from-search-view unread)" test_begin_subtest "Remove tag from search view" test_emacs "(notmuch-search \"$os_x_darwin_thread\") (notmuch-test-wait) - (notmuch-search-remove-tag \"tag-from-search-view\")" + (execute-kbd-macro \"-tag-from-search-view\")" output=$(notmuch search $os_x_darwin_thread | notmuch_search_sanitize) test_expect_equal "$output" "thread:XXX 2009-11-18 [4/4] Jjgod Jiang, Alexander Botero-Lowry; [notmuch] Mac OS X/Darwin compatibility issues (inbox unread)" test_begin_subtest "Add tag from notmuch-show view" test_emacs "(notmuch-show \"$os_x_darwin_thread\") - (notmuch-show-add-tag \"tag-from-show-view\")" + (execute-kbd-macro \"+tag-from-show-view\")" output=$(notmuch search $os_x_darwin_thread | notmuch_search_sanitize) test_expect_equal "$output" "thread:XXX 2009-11-18 [4/4] Jjgod Jiang, Alexander Botero-Lowry; [notmuch] Mac OS X/Darwin compatibility issues (inbox tag-from-show-view unread)" test_begin_subtest "Remove tag from notmuch-show view" test_emacs "(notmuch-show \"$os_x_darwin_thread\") - (notmuch-show-remove-tag \"tag-from-show-view\")" + (execute-kbd-macro \"-tag-from-show-view\")" output=$(notmuch search $os_x_darwin_thread | notmuch_search_sanitize) test_expect_equal "$output" "thread:XXX 2009-11-18 [4/4] Jjgod Jiang, Alexander Botero-Lowry; [notmuch] Mac OS X/Darwin compatibility issues (inbox unread)" @@ -128,14 +128,14 @@ test_begin_subtest "Message with .. in Message-Id:" add_message [id]=123..456@example '[subject]="Message with .. in Message-Id"' test_emacs '(notmuch-search "id:\"123..456@example\"") (notmuch-test-wait) - (notmuch-search-add-tag "search-add") - (notmuch-search-add-tag "search-remove") - (notmuch-search-remove-tag "search-remove") + (execute-kbd-macro "+search-add") + (execute-kbd-macro "+search-remove") + (execute-kbd-macro "-search-remove") (notmuch-show "id:\"123..456@example\"") (notmuch-test-wait) - (notmuch-show-add-tag "show-add") - (notmuch-show-add-tag "show-remove") - (notmuch-show-remove-tag "show-remove")' + (execute-kbd-macro "+show-add") + (execute-kbd-macro "+show-remove") + (execute-kbd-macro "-show-remove")' output=$(notmuch search 'id:"123..456@example"' | notmuch_search_sanitize) test_expect_equal "$output" "thread:XXX 2001-01-05 [1/1] Notmuch Test Suite; Message with .. in Message-Id (inbox search-add show-add)" -- cgit v1.2.3 From b32831e5b8e494da802f7c616c986fcd1e1e7b5f Mon Sep 17 00:00:00 2001 From: Pieter Praet Date: Wed, 1 Feb 2012 21:37:21 +0100 Subject: test: replace occurrences of $PWD with vars that are more stable Thanks to Dmitry Kurochkin for pointing this out: id:"87d39ymyb4.fsf@gmail.com" --- test/emacs | 2 +- test/new | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index b74cfa9..13b0471 100755 --- a/test/emacs +++ b/test/emacs @@ -266,7 +266,7 @@ From: Notmuch Test Suite To: user@example.com Subject: Re: Testing message sent via SMTP In-Reply-To: -Fcc: $(pwd)/mail/sent +Fcc: ${MAIL_DIR}/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 diff --git a/test/new b/test/new index 79a6c97..99f9913 100755 --- a/test/new +++ b/test/new @@ -117,10 +117,10 @@ test_expect_equal "$output" "No new mail. Removed 3 messages." test_begin_subtest "New symlink to directory" rm -rf "${MAIL_DIR}"/.notmuch -mv "${MAIL_DIR}" "$PWD"/actual_maildir +mv "${MAIL_DIR}" "${TMP_DIRECTORY}"/actual_maildir mkdir "${MAIL_DIR}" -ln -s "$PWD"/actual_maildir "${MAIL_DIR}"/symlink +ln -s "${TMP_DIRECTORY}"/actual_maildir "${MAIL_DIR}"/symlink output=$(NOTMUCH_NEW) test_expect_equal "$output" "Added 1 new message to the database." @@ -128,7 +128,7 @@ test_expect_equal "$output" "Added 1 new message to the database." test_begin_subtest "New symlink to a file" generate_message -external_msg_filename="$PWD"/external/"$(basename "$gen_msg_filename")" +external_msg_filename="${TMP_DIRECTORY}"/external/"$(basename "$gen_msg_filename")" mkdir -p "$(dirname "$external_msg_filename")" mv "$gen_msg_filename" "$external_msg_filename" ln -s "$external_msg_filename" "$gen_msg_filename" -- cgit v1.2.3 From e2a68f9941fb903f5db7e7978ec7c6b2ad8158c1 Mon Sep 17 00:00:00 2001 From: Pieter Praet Date: Sun, 19 Feb 2012 21:50:26 +0100 Subject: test: emacs: expand subtest "Stashing in notmuch-show" wrt stashing Mailing List Archive URIs `notmuch-show-stash-mlarchive-link' stashes a URI pointing to the current message at one of the MLAs configured in `notmuch-show-stash-mlarchive-link-alist'. Marked as "broken": fixed in next commit. --- test/emacs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index 13b0471..e8e23dc 100755 --- a/test/emacs +++ b/test/emacs @@ -384,6 +384,7 @@ test_emacs '(notmuch-show "id:f35dbb950911171438k5df6eb56k77b6c0944e2e79ae@mail. test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-with-hidden-messages test_begin_subtest "Stashing in notmuch-show" +test_subtest_known_broken add_message '[date]="Sat, 01 Jan 2000 12:00:00 -0000"' \ '[from]="Some One "' \ '[to]="Some One Else "' \ @@ -402,9 +403,12 @@ test_emacs '(notmuch-show "id:\"bought\"") (notmuch-show-stash-message-id-stripped) (notmuch-show-stash-tags) (notmuch-show-stash-filename) + (notmuch-show-stash-mlarchive-link "Gmane") + (notmuch-show-stash-mlarchive-link "MARC") + (notmuch-show-stash-mlarchive-link "Mail Archive, The") (switch-to-buffer (generate-new-buffer "*test-stashing*")) - (dotimes (i 9) + (dotimes (i 12) (yank) (insert "\n") (rotate-yank-pointer 1)) @@ -420,6 +424,9 @@ id:"bought" bought inbox,stashtest ${gen_msg_filename} +http://mid.gmane.org/bought +http://marc.info/?i=bought +http://mail-archive.com/search?l=mid&q=bought EOF test_expect_equal_file OUTPUT EXPECTED -- cgit v1.2.3 From 2f86290aaf6e4b0de54ea75ca17ce129bfbf3730 Mon Sep 17 00:00:00 2001 From: Pieter Praet Date: Sun, 19 Feb 2012 21:50:27 +0100 Subject: emacs: add `notmuch-show-stash-mlarchive-link{, -and-go}' * emacs/notmuch-show.el (notmuch-show-stash-mlarchive-link-alist): New defcustom of type `alist' (key = name, value = URI), containing Mailing List Archive URI's for searching by Message-Id. (notmuch-show-stash-mlarchive-link-default): New defcustom, default MLA to use when `notmuch-show-stash-mlarchive-link' received no user input whatsoever. Available choices are generated using the contents of `notmuch-show-stash-mlarchive-link-alist'. (notmuch-show-stash-map): Added keybinds "l" and "L" for `notmuch-show-stash-mlarchive-link' respectively `notmuch-show-stash-mlarchive-link-and-go'. (notmuch-show-stash-mlarchive-link): New function, stashes a URI pointing to the current message at one of the MLAs configured in `notmuch-show-stash-mlarchive-link-alist'. Prompts user with `completing-read' if not provided with an MLA key. (notmuch-show-stash-mlarchive-link-and-go): New function, uses `notmuch-show-stash-mlarchive-link' to stash a URI, and then visits it using the browser configured in `browse-url-browser-function'. Based on original work [1] by David Edmondson . [1] id:"1327397873-20596-1-git-send-email-dme@dme.org" --- emacs/notmuch-show.el | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++ test/emacs | 1 - 2 files changed, 61 insertions(+), 1 deletion(-) (limited to 'test/emacs') diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 529b674..aa98eff 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -155,6 +155,35 @@ indentation." (make-variable-buffer-local 'notmuch-show-indent-content) (put 'notmuch-show-indent-content 'permanent-local t) +(defcustom notmuch-show-stash-mlarchive-link-alist + '(("Gmane" . "http://mid.gmane.org/") + ("MARC" . "http://marc.info/?i=") + ("Mail Archive, The" . "http://mail-archive.com/search?l=mid&q=") + ;; FIXME: can these services be searched by `Message-Id' ? + ;; ("MarkMail" . "http://markmail.org/") + ;; ("Nabble" . "http://nabble.com/") + ;; ("opensubscriber" . "http://opensubscriber.com/") + ) + "List of Mailing List Archives to use when stashing links. + +These URIs are concatenated with the current message's +Message-Id in `notmuch-show-stash-mlarchive-link'." + :type '(alist :key-type (string :tag "Name") + :value-type (string :tag "URL")) + :group 'notmuch-show) + +(defcustom notmuch-show-stash-mlarchive-link-default "Gmane" + "Default Mailing List Archive to use when stashing links. + +This is used when `notmuch-show-stash-mlarchive-link' isn't +provided with an MLA argument nor `completing-read' input." + :type `(choice + ,@(mapcar + (lambda (mla) + (list 'const :tag (car mla) :value (car mla))) + notmuch-show-stash-mlarchive-link-alist)) + :group 'notmuch-show) + (defmacro with-current-notmuch-show-message (&rest body) "Evaluate body with current buffer set to the text of current message" `(save-excursion @@ -1149,6 +1178,8 @@ buffer is stored and re-applied after the refresh." (define-key map "s" 'notmuch-show-stash-subject) (define-key map "T" 'notmuch-show-stash-tags) (define-key map "t" 'notmuch-show-stash-to) + (define-key map "l" 'notmuch-show-stash-mlarchive-link) + (define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go) map) "Submap for stash commands") (fset 'notmuch-show-stash-map notmuch-show-stash-map) @@ -1815,6 +1846,36 @@ thread from search." (interactive) (notmuch-common-do-stash (notmuch-show-get-to))) +(defun notmuch-show-stash-mlarchive-link (&optional mla) + "Copy an ML Archive URI for the current message to the kill-ring. + +This presumes that the message is available at the selected Mailing List Archive. + +If optional argument MLA is non-nil, use the provided key instead of prompting +the user (see `notmuch-show-stash-mlarchive-link-alist')." + (interactive) + (notmuch-common-do-stash + (concat (cdr (assoc + (or mla + (let ((completion-ignore-case t)) + (completing-read + "Mailing List Archive: " + notmuch-show-stash-mlarchive-link-alist + nil t nil nil notmuch-show-stash-mlarchive-link-default))) + notmuch-show-stash-mlarchive-link-alist)) + (notmuch-show-get-message-id t)))) + +(defun notmuch-show-stash-mlarchive-link-and-go (&optional mla) + "Copy an ML Archive URI for the current message to the kill-ring and visit it. + +This presumes that the message is available at the selected Mailing List Archive. + +If optional argument MLA is non-nil, use the provided key instead of prompting +the user (see `notmuch-show-stash-mlarchive-link-alist')." + (interactive) + (notmuch-show-stash-mlarchive-link mla) + (browse-url (current-kill 0 t))) + ;; Commands typically bound to buttons. (defun notmuch-show-part-button-default (&optional button) diff --git a/test/emacs b/test/emacs index e8e23dc..dcfc675 100755 --- a/test/emacs +++ b/test/emacs @@ -384,7 +384,6 @@ test_emacs '(notmuch-show "id:f35dbb950911171438k5df6eb56k77b6c0944e2e79ae@mail. test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-with-hidden-messages test_begin_subtest "Stashing in notmuch-show" -test_subtest_known_broken add_message '[date]="Sat, 01 Jan 2000 12:00:00 -0000"' \ '[from]="Some One "' \ '[to]="Some One Else "' \ -- cgit v1.2.3 From 17a06ab990217fe3f8d71d9fd2520bcfbb79d9ed Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Tue, 21 Feb 2012 10:42:32 -0500 Subject: emacs: Reverse the meaning of notmuch-show-refresh-view's argument Consensus seems to be that people prefer that refreshing show buffers retains state by default, rather than resetting it by default. This turns out to be the case in the code, as well. In fact, there's even a test for this that's been marked broken for several months, which this patch finally gets to mark as fixed. --- emacs/notmuch-crypto.el | 4 ++-- emacs/notmuch-show.el | 18 +++++++++--------- test/emacs | 1 - 3 files changed, 11 insertions(+), 12 deletions(-) (limited to 'test/emacs') diff --git a/emacs/notmuch-crypto.el b/emacs/notmuch-crypto.el index 972f26e..94da325 100644 --- a/emacs/notmuch-crypto.el +++ b/emacs/notmuch-crypto.el @@ -120,7 +120,7 @@ mode." :notmuch-from from) (insert "\n"))) -(declare-function notmuch-show-refresh-view "notmuch-show" (&optional retain-state)) +(declare-function notmuch-show-refresh-view "notmuch-show" (&optional reset-state)) (defun notmuch-crypto-sigstatus-good-callback (button) (let* ((sigstatus (button-get button :notmuch-sigstatus)) @@ -145,7 +145,7 @@ mode." (insert "\n") (call-process "gpg" nil t t "--list-keys" keyid)) (recenter -1)) - (notmuch-show-refresh-view))) + (notmuch-show-refresh-view t))) (defun notmuch-crypto-insert-encstatus-button (encstatus) (let* ((status (plist-get encstatus :status)) diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 6d24ed0..dd1fb83 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -990,7 +990,7 @@ current buffer, if possible." (message (if notmuch-show-process-crypto "Processing cryptographic MIME parts." "Not processing cryptographic MIME parts.")) - (notmuch-show-refresh-view t)) + (notmuch-show-refresh-view)) (defun notmuch-show-toggle-elide-non-matching () "Toggle the display of non-matching messages." @@ -999,7 +999,7 @@ current buffer, if possible." (message (if notmuch-show-elide-non-matching-messages "Showing matching messages only." "Showing all messages.")) - (notmuch-show-refresh-view t)) + (notmuch-show-refresh-view)) (defun notmuch-show-toggle-thread-indentation () "Toggle the indentation of threads." @@ -1008,7 +1008,7 @@ current buffer, if possible." (message (if notmuch-show-indent-content "Content is indented." "Content is not indented.")) - (notmuch-show-refresh-view t)) + (notmuch-show-refresh-view)) (defun notmuch-show-insert-tree (tree depth) "Insert the message tree TREE at depth DEPTH in the current thread." @@ -1150,17 +1150,17 @@ This includes: (message "Previously current message not found.")) (notmuch-show-message-adjust))) -(defun notmuch-show-refresh-view (&optional retain-state) +(defun notmuch-show-refresh-view (&optional reset-state) "Refresh the current view. Refreshes the current view, observing changes in display -preferences. If RETAIN-STATE is non-nil then the state of the -buffer is stored and re-applied after the refresh." +preferences. If invoked with a prefix argument (or RESET-STATE is +non-nil) then the state of the buffer (open/closed messages) is +reset based on the original query." (interactive "P") (let ((inhibit-read-only t) - state) - (if retain-state - (setq state (notmuch-show-capture-state))) + (state (unless reset-state + (notmuch-show-capture-state)))) (erase-buffer) (notmuch-show-build-buffer) (if state diff --git a/test/emacs b/test/emacs index dcfc675..7549892 100755 --- a/test/emacs +++ b/test/emacs @@ -462,7 +462,6 @@ test_emacs '(notmuch-show "id:f35dbb950911171438k5df6eb56k77b6c0944e2e79ae@mail. test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Refresh modified show buffer" -test_subtest_known_broken test_emacs '(notmuch-show "id:f35dbb950911171438k5df6eb56k77b6c0944e2e79ae@mail.gmail.com") (notmuch-show-toggle-message) (notmuch-show-next-message) -- cgit v1.2.3 From 86f89385c3bc34cd91002cc057f6a615b6ab76a9 Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Sun, 19 Feb 2012 19:26:26 -0500 Subject: show: Unify JSON header output for messages and message parts This has three ramifications: - Blank To and Cc headers are no longer output for messages. - Dates are now canonicalized for messages, which means they always have a day of the week and GMT is printed +0000 (never -0000) - Invalid From message headers are handled slightly differently, since they get parsed by GMime now instead of notmuch. --- notmuch-show.c | 35 +++-------------------------------- test/crypto | 35 ++++++++++++++--------------------- test/emacs | 4 ++-- test/json | 6 +++--- test/maildir-sync | 2 -- test/multipart | 2 +- 6 files changed, 23 insertions(+), 61 deletions(-) (limited to 'test/emacs') diff --git a/notmuch-show.c b/notmuch-show.c index 9ca9882..209ff45 100644 --- a/notmuch-show.c +++ b/notmuch-show.c @@ -291,36 +291,7 @@ format_headers_message_part_text (GMimeMessage *message) } static void -format_headers_json (const void *ctx, notmuch_message_t *message) -{ - const char *headers[] = { - "Subject", "From", "To", "Cc", "Bcc", "Date" - }; - const char *name, *value; - unsigned int i; - int first_header = 1; - void *ctx_quote = talloc_new (ctx); - - for (i = 0; i < ARRAY_SIZE (headers); i++) { - name = headers[i]; - value = notmuch_message_get_header (message, name); - if (value) - { - if (!first_header) - fputs (", ", stdout); - first_header = 0; - - printf ("%s: %s", - json_quote_str (ctx_quote, name), - json_quote_str (ctx_quote, value)); - } - } - - talloc_free (ctx_quote); -} - -static void -format_headers_message_part_json (GMimeMessage *message) +format_headers_json (GMimeMessage *message) { void *ctx = talloc_new (NULL); void *ctx_quote = talloc_new (ctx); @@ -690,7 +661,7 @@ format_part_json (const void *ctx, mime_node_t *node, notmuch_bool_t first) format_message_json (ctx, node->envelope_file); printf ("\"headers\": {"); - format_headers_json (ctx, node->envelope_file); + format_headers_json (GMIME_MESSAGE (node->part)); printf ("}"); printf (", \"body\": ["); @@ -778,7 +749,7 @@ format_part_json (const void *ctx, mime_node_t *node, notmuch_bool_t first) if (GMIME_IS_MESSAGE (node->part)) { printf ("\"headers\": {"); - format_headers_message_part_json (GMIME_MESSAGE (node->part)); + format_headers_json (GMIME_MESSAGE (node->part)); printf ("}"); printf (", \"body\": ["); diff --git a/test/crypto b/test/crypto index 1dbb60a..7e774c8 100755 --- a/test/crypto +++ b/test/crypto @@ -50,9 +50,8 @@ expected='[[[{"id": "XXXXX", "headers": {"Subject": "test signed message 001", "From": "Notmuch Test Suite ", "To": "test_suite@notmuchmail.org", - "Cc": "", - "Bcc": "", - "Date": "01 Jan 2000 12:00:00 -0000"}, + "Date": "Sat, + 01 Jan 2000 12:00:00 +0000"}, "body": [{"id": 1, "sigstatus": [{"status": "good", "fingerprint": "'$FINGERPRINT'", @@ -84,9 +83,8 @@ expected='[[[{"id": "XXXXX", "headers": {"Subject": "test signed message 001", "From": "Notmuch Test Suite ", "To": "test_suite@notmuchmail.org", - "Cc": "", - "Bcc": "", - "Date": "01 Jan 2000 12:00:00 -0000"}, + "Date": "Sat, + 01 Jan 2000 12:00:00 +0000"}, "body": [{"id": 1, "sigstatus": [{"status": "good", "fingerprint": "'$FINGERPRINT'", @@ -120,9 +118,8 @@ expected='[[[{"id": "XXXXX", "headers": {"Subject": "test signed message 001", "From": "Notmuch Test Suite ", "To": "test_suite@notmuchmail.org", - "Cc": "", - "Bcc": "", - "Date": "01 Jan 2000 12:00:00 -0000"}, + "Date": "Sat, + 01 Jan 2000 12:00:00 +0000"}, "body": [{"id": 1, "sigstatus": [{"status": "error", "keyid": "'$(echo $FINGERPRINT | cut -c 25-)'", @@ -194,9 +191,8 @@ expected='[[[{"id": "XXXXX", "headers": {"Subject": "test encrypted message 001", "From": "Notmuch Test Suite ", "To": "test_suite@notmuchmail.org", - "Cc": "", - "Bcc": "", - "Date": "01 Jan 2000 12:00:00 -0000"}, + "Date": "Sat, + 01 Jan 2000 12:00:00 +0000"}, "body": [{"id": 1, "encstatus": [{"status": "good"}], "sigstatus": [], @@ -249,9 +245,8 @@ expected='[[[{"id": "XXXXX", "headers": {"Subject": "test encrypted message 001", "From": "Notmuch Test Suite ", "To": "test_suite@notmuchmail.org", - "Cc": "", - "Bcc": "", - "Date": "01 Jan 2000 12:00:00 -0000"}, + "Date": "Sat, + 01 Jan 2000 12:00:00 +0000"}, "body": [{"id": 1, "encstatus": [{"status": "bad"}], "content-type": "multipart/encrypted", @@ -284,9 +279,8 @@ expected='[[[{"id": "XXXXX", "headers": {"Subject": "test encrypted message 002", "From": "Notmuch Test Suite ", "To": "test_suite@notmuchmail.org", - "Cc": "", - "Bcc": "", - "Date": "01 Jan 2000 12:00:00 -0000"}, + "Date": "Sat, + 01 Jan 2000 12:00:00 +0000"}, "body": [{"id": 1, "encstatus": [{"status": "good"}], "sigstatus": [{"status": "good", @@ -339,9 +333,8 @@ expected='[[[{"id": "XXXXX", "headers": {"Subject": "test signed message 001", "From": "Notmuch Test Suite ", "To": "test_suite@notmuchmail.org", - "Cc": "", - "Bcc": "", - "Date": "01 Jan 2000 12:00:00 -0000"}, + "Date": "Sat, + 01 Jan 2000 12:00:00 +0000"}, "body": [{"id": 1, "sigstatus": [{"status": "error", "keyid": "6D92612D94E46381", diff --git a/test/emacs b/test/emacs index 7549892..29a489c 100755 --- a/test/emacs +++ b/test/emacs @@ -78,7 +78,7 @@ thread=$(notmuch search --output=threads subject:message-with-invalid-from) test_emacs "(notmuch-show \"$thread\") (test-output)" cat <EXPECTED -Invalid " From (2001-01-05) (inbox) +"Invalid " (2001-01-05) (inbox) Subject: message-with-invalid-from To: Notmuch Test Suite Date: Fri, 05 Jan 2001 15:43:57 +0000 @@ -414,7 +414,7 @@ test_emacs '(notmuch-show "id:\"bought\"") (reverse-region (point-min) (point-max)) (test-output)' cat <EXPECTED -Sat, 01 Jan 2000 12:00:00 -0000 +Sat, 01 Jan 2000 12:00:00 +0000 Some One Some One Else Notmuch diff --git a/test/json b/test/json index 7df4380..1bdffd2 100755 --- a/test/json +++ b/test/json @@ -5,7 +5,7 @@ test_description="--format=json output" test_begin_subtest "Show message: json" add_message "[subject]=\"json-show-subject\"" "[date]=\"Sat, 01 Jan 2000 12:00:00 -0000\"" "[body]=\"json-show-message\"" output=$(notmuch show --format=json "json-show-message") -test_expect_equal "$output" "[[[{\"id\": \"${gen_msg_id}\", \"match\": true, \"filename\": \"${gen_msg_filename}\", \"timestamp\": 946728000, \"date_relative\": \"2000-01-01\", \"tags\": [\"inbox\",\"unread\"], \"headers\": {\"Subject\": \"json-show-subject\", \"From\": \"Notmuch Test Suite \", \"To\": \"Notmuch Test Suite \", \"Cc\": \"\", \"Bcc\": \"\", \"Date\": \"Sat, 01 Jan 2000 12:00:00 -0000\"}, \"body\": [{\"id\": 1, \"content-type\": \"text/plain\", \"content\": \"json-show-message\n\"}]}, []]]]" +test_expect_equal "$output" "[[[{\"id\": \"${gen_msg_id}\", \"match\": true, \"filename\": \"${gen_msg_filename}\", \"timestamp\": 946728000, \"date_relative\": \"2000-01-01\", \"tags\": [\"inbox\",\"unread\"], \"headers\": {\"Subject\": \"json-show-subject\", \"From\": \"Notmuch Test Suite \", \"To\": \"Notmuch Test Suite \", \"Date\": \"Sat, 01 Jan 2000 12:00:00 +0000\"}, \"body\": [{\"id\": 1, \"content-type\": \"text/plain\", \"content\": \"json-show-message\n\"}]}, []]]]" test_begin_subtest "Search message: json" add_message "[subject]=\"json-search-subject\"" "[date]=\"Sat, 01 Jan 2000 12:00:00 -0000\"" "[body]=\"json-search-message\"" @@ -22,7 +22,7 @@ test_expect_equal "$output" "[{\"thread\": \"XXX\", test_begin_subtest "Show message: json, utf-8" add_message "[subject]=\"json-show-utf8-body-sübjéct\"" "[date]=\"Sat, 01 Jan 2000 12:00:00 -0000\"" "[body]=\"jsön-show-méssage\"" output=$(notmuch show --format=json "jsön-show-méssage") -test_expect_equal "$output" "[[[{\"id\": \"${gen_msg_id}\", \"match\": true, \"filename\": \"${gen_msg_filename}\", \"timestamp\": 946728000, \"date_relative\": \"2000-01-01\", \"tags\": [\"inbox\",\"unread\"], \"headers\": {\"Subject\": \"json-show-utf8-body-sübjéct\", \"From\": \"Notmuch Test Suite \", \"To\": \"Notmuch Test Suite \", \"Cc\": \"\", \"Bcc\": \"\", \"Date\": \"Sat, 01 Jan 2000 12:00:00 -0000\"}, \"body\": [{\"id\": 1, \"content-type\": \"text/plain\", \"content\": \"jsön-show-méssage\n\"}]}, []]]]" +test_expect_equal "$output" "[[[{\"id\": \"${gen_msg_id}\", \"match\": true, \"filename\": \"${gen_msg_filename}\", \"timestamp\": 946728000, \"date_relative\": \"2000-01-01\", \"tags\": [\"inbox\",\"unread\"], \"headers\": {\"Subject\": \"json-show-utf8-body-sübjéct\", \"From\": \"Notmuch Test Suite \", \"To\": \"Notmuch Test Suite \", \"Date\": \"Sat, 01 Jan 2000 12:00:00 +0000\"}, \"body\": [{\"id\": 1, \"content-type\": \"text/plain\", \"content\": \"jsön-show-méssage\n\"}]}, []]]]" test_begin_subtest "Show message: json, inline attachment filename" subject='json-show-inline-attachment-filename' @@ -35,7 +35,7 @@ emacs_deliver_message \ (insert \"Message-ID: <$id>\n\")" output=$(notmuch show --format=json "id:$id") filename=$(notmuch search --output=files "id:$id") -test_expect_equal "$output" "[[[{\"id\": \"$id\", \"match\": true, \"filename\": \"$filename\", \"timestamp\": 946728000, \"date_relative\": \"2000-01-01\", \"tags\": [\"inbox\"], \"headers\": {\"Subject\": \"$subject\", \"From\": \"Notmuch Test Suite \", \"To\": \"test_suite@notmuchmail.org\", \"Cc\": \"\", \"Bcc\": \"\", \"Date\": \"01 Jan 2000 12:00:00 -0000\"}, \"body\": [{\"id\": 1, \"content-type\": \"multipart/mixed\", \"content\": [{\"id\": 2, \"content-type\": \"text/plain\", \"content\": \"This is a test message with inline attachment with a filename\"}, {\"id\": 3, \"content-type\": \"application/octet-stream\", \"filename\": \"README\"}]}]}, []]]]" +test_expect_equal "$output" "[[[{\"id\": \"$id\", \"match\": true, \"filename\": \"$filename\", \"timestamp\": 946728000, \"date_relative\": \"2000-01-01\", \"tags\": [\"inbox\"], \"headers\": {\"Subject\": \"$subject\", \"From\": \"Notmuch Test Suite \", \"To\": \"test_suite@notmuchmail.org\", \"Date\": \"Sat, 01 Jan 2000 12:00:00 +0000\"}, \"body\": [{\"id\": 1, \"content-type\": \"multipart/mixed\", \"content\": [{\"id\": 2, \"content-type\": \"text/plain\", \"content\": \"This is a test message with inline attachment with a filename\"}, {\"id\": 3, \"content-type\": \"application/octet-stream\", \"filename\": \"README\"}]}]}, []]]]" test_begin_subtest "Search message: json, utf-8" add_message "[subject]=\"json-search-utf8-body-sübjéct\"" "[date]=\"Sat, 01 Jan 2000 12:00:00 -0000\"" "[body]=\"jsön-search-méssage\"" diff --git a/test/maildir-sync b/test/maildir-sync index d5872a5..1ee2db0 100755 --- a/test/maildir-sync +++ b/test/maildir-sync @@ -53,8 +53,6 @@ test_expect_equal "$output" '[[[{"id": "adding-replied-tag@notmuch-test-suite", "headers": {"Subject": "Adding replied tag", "From": "Notmuch Test Suite ", "To": "Notmuch Test Suite ", -"Cc": "", -"Bcc": "", "Date": "Fri, 05 Jan 2001 15:43:57 +0000"}, "body": [{"id": 1, diff --git a/test/multipart b/test/multipart index 4d14804..a3036b4 100755 --- a/test/multipart +++ b/test/multipart @@ -322,7 +322,7 @@ notmuch show --format=json --part=0 'id:87liy5ap00.fsf@yoom.home.cworth.org' | s echo >>OUTPUT # expect *no* newline at end of output cat <EXPECTED -{"id": "87liy5ap00.fsf@yoom.home.cworth.org", "match": true, "filename": "${MAIL_DIR}/multipart", "timestamp": 978709437, "date_relative": "2001-01-05", "tags": ["attachment","inbox","signed","unread"], "headers": {"Subject": "Multipart message", "From": "Carl Worth ", "To": "cworth@cworth.org", "Cc": "", "Bcc": "", "Date": "Fri, 05 Jan 2001 15:43:57 +0000"}, "body": [ +{"id": "87liy5ap00.fsf@yoom.home.cworth.org", "match": true, "filename": "${MAIL_DIR}/multipart", "timestamp": 978709437, "date_relative": "2001-01-05", "tags": ["attachment","inbox","signed","unread"], "headers": {"Subject": "Multipart message", "From": "Carl Worth ", "To": "cworth@cworth.org", "Date": "Fri, 05 Jan 2001 15:43:57 +0000"}, "body": [ {"id": 1, "content-type": "multipart/signed", "content": [ {"id": 2, "content-type": "multipart/mixed", "content": [ {"id": 3, "content-type": "message/rfc822", "content": [{"headers": {"Subject": "html message", "From": "Carl Worth ", "To": "cworth@cworth.org", "Date": "Fri, 05 Jan 2001 15:42:57 +0000"}, "body": [ -- cgit v1.2.3 From 8420ba10358dcc1d0d306dd1298f07fae2150e11 Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Sun, 18 Mar 2012 10:32:41 -0600 Subject: test: Add broken tests for new emacs reply functionality Add tests for creating nice replies to multipart messages, including those with HTML parts. These tests are expected to fail for now. --- test/emacs | 97 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 97 insertions(+) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index 29a489c..01afdb6 100755 --- a/test/emacs +++ b/test/emacs @@ -273,6 +273,103 @@ On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite w 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)' +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_subtest_known_broken +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" \ -- cgit v1.2.3 From 650123510cfa64caf6b20f5239f43433fa6f2941 Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Sun, 18 Mar 2012 10:32:42 -0600 Subject: emacs: Use the new JSON reply format and message-cite-original 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(-) (limited to 'test/emacs') 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 -- cgit v1.2.3 From 5ae960fc192ca1a13469986b567abf98901103de Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Mon, 26 Mar 2012 21:37:15 -0400 Subject: test: Add Emacs test for messages with quotes in their message ID Currently this is broken because Emacs doesn't properly escape double quotes in message IDs. --- test/emacs | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index 8a28705..62eaedb 100755 --- a/test/emacs +++ b/test/emacs @@ -139,6 +139,18 @@ test_emacs '(notmuch-search "id:\"123..456@example\"") output=$(notmuch search 'id:"123..456@example"' | notmuch_search_sanitize) test_expect_equal "$output" "thread:XXX 2001-01-05 [1/1] Notmuch Test Suite; Message with .. in Message-Id (inbox search-add show-add)" +test_begin_subtest "Message with quote in Message-Id:" +test_subtest_known_broken +add_message '[id]="\"quote\"@example"' '[subject]="Message with quote in Message-Id"' +test_emacs '(notmuch-search "subject:\"Message with quote\"") + (notmuch-test-wait) + (execute-kbd-macro "+search-add") + (notmuch-search-show-thread) + (notmuch-test-wait) + (execute-kbd-macro "+show-add")' +output=$(notmuch search 'id:"""quote""@example"' | notmuch_search_sanitize) +test_expect_equal "$output" "thread:XXX 2001-01-05 [1/1] Notmuch Test Suite; Message with quote in Message-Id (inbox search-add show-add)" + test_begin_subtest "Sending a message via (fake) SMTP" emacs_deliver_message \ 'Testing message sent via SMTP' \ -- cgit v1.2.3 From ee1180018ee3c772d7ac769222ff9c6940f3c838 Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Mon, 26 Mar 2012 21:37:16 -0400 Subject: emacs: Escape all message ID queries This adds a lib function to turn a message ID into a properly escaped message ID query and uses this function wherever we previously hand-constructed ID queries. Wherever this new function is used, documentation has been clarified to refer to "id: queries" instead of "message IDs". This fixes the broken test introduced by the previous patch. --- emacs/notmuch-lib.el | 6 +++++- emacs/notmuch-message.el | 2 +- emacs/notmuch-show.el | 14 +++++++------- test/emacs | 1 - 4 files changed, 13 insertions(+), 10 deletions(-) (limited to 'test/emacs') diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index a754de7..2492b80 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -144,6 +144,10 @@ the user hasn't set this variable with the old or new value." "[No Subject]" subject))) +(defun notmuch-id-to-query (id) + "Return a query that matches the message with id ID." + (concat "id:\"" (replace-regexp-in-string "\"" "\"\"" id t t) "\"")) + ;; (defun notmuch-common-do-stash (text) @@ -231,7 +235,7 @@ the given type." (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))) + (notmuch-get-bodypart-internal (notmuch-id-to-query (plist-get msg :id)) nth process-crypto))) (defun notmuch-plist-to-alist (plist) (loop for (key value . rest) on plist by #'cddr diff --git a/emacs/notmuch-message.el b/emacs/notmuch-message.el index 264a5b9..3010281 100644 --- a/emacs/notmuch-message.el +++ b/emacs/notmuch-message.el @@ -44,7 +44,7 @@ the \"inbox\" and \"todo\", you would set (concat "+" str) str)) notmuch-message-replied-tags))) - (apply 'notmuch-tag (concat "id:" (car (car rep))) tags))))) + (apply 'notmuch-tag (notmuch-id-to-query (car (car rep))) tags))))) (add-hook 'message-send-hook 'notmuch-message-mark-replied) diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 0cd7d82..6d3fe62 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -613,7 +613,7 @@ current buffer, if possible." ;; times (hundreds!), which results in many calls to ;; `notmuch part'. (unless content - (setq content (notmuch-get-bodypart-internal (concat "id:" message-id) + (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id) part-number notmuch-show-process-crypto)) (with-current-buffer w3m-current-buffer (notmuch-show-w3m-cid-store-internal url @@ -1325,16 +1325,16 @@ Some useful entries are: (plist-get props prop))) (defun notmuch-show-get-message-id (&optional bare) - "Return the Message-Id of the current message. + "Return an id: query for the Message-Id of the current message. If optional argument BARE is non-nil, return -the Message-Id without prefix and quotes." +the Message-Id without id: prefix and escaping." (if bare (notmuch-show-get-prop :id) - (concat "id:\"" (notmuch-show-get-prop :id) "\""))) + (notmuch-id-to-query (notmuch-show-get-prop :id)))) (defun notmuch-show-get-messages-ids () - "Return all message ids of messages in the current thread." + "Return all id: queries of messages in the current thread." (let ((message-ids)) (notmuch-show-mapc (lambda () (push (notmuch-show-get-message-id) message-ids))) @@ -1401,7 +1401,7 @@ current thread." ;; thread. (defun notmuch-show-get-message-ids-for-open-messages () - "Return a list of all message IDs for open messages in the current thread." + "Return a list of all id: queries for open messages in the current thread." (save-excursion (let (message-ids done) (goto-char (point-min)) @@ -1805,7 +1805,7 @@ thread from search." (notmuch-common-do-stash (notmuch-show-get-from))) (defun notmuch-show-stash-message-id () - "Copy message ID of current message to kill-ring." + "Copy id: query matching the current message to kill-ring." (interactive) (notmuch-common-do-stash (notmuch-show-get-message-id))) diff --git a/test/emacs b/test/emacs index 62eaedb..8b92d0a 100755 --- a/test/emacs +++ b/test/emacs @@ -140,7 +140,6 @@ output=$(notmuch search 'id:"123..456@example"' | notmuch_search_sanitize) test_expect_equal "$output" "thread:XXX 2001-01-05 [1/1] Notmuch Test Suite; Message with .. in Message-Id (inbox search-add show-add)" test_begin_subtest "Message with quote in Message-Id:" -test_subtest_known_broken add_message '[id]="\"quote\"@example"' '[subject]="Message with quote in Message-Id"' test_emacs '(notmuch-search "subject:\"Message with quote\"") (notmuch-test-wait) -- cgit v1.2.3 From b45b72aa14394ba346a958da7a74303951b41ed4 Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Sun, 1 Apr 2012 09:24:20 -0600 Subject: test: Tests for reply from alternate addresses in emacs Since the recent reply changes were pushed, there has been a bug that causes emacs to always reply from the primary address, even if the JSON or default CLI reply output uses an alternate address. This adds two tests to the emacs test library based on the two "Reply form..." tests in the reply test library. One is currently marked broken. --- test/emacs | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index 8b92d0a..576bc1f 100755 --- a/test/emacs +++ b/test/emacs @@ -285,6 +285,50 @@ Notmuch Test Suite writes: EOF test_expect_equal_file OUTPUT EXPECTED +test_begin_subtest "Reply from alternate address within emacs" +test_subtest_known_broken +add_message '[from]="Sender "' \ + [to]=test_suite_other@notmuchmail.org + +test_emacs "(notmuch-search \"id:\\\"${gen_msg_id}\\\"\") + (notmuch-test-wait) + (notmuch-search-reply-to-thread) + (test-output)" +cat <EXPECTED +From: Notmuch Test Suite +To: Sender +Subject: Re: ${test_subtest_name} +In-Reply-To: <${gen_msg_id}> +Fcc: ${MAIL_DIR}/sent +--text follows this line-- +Sender writes: + +> This is just a test message (#${gen_msg_cnt}) +EOF +test_expect_equal_file OUTPUT EXPECTED + +test_begin_subtest "Reply from address in named group list within emacs" +add_message '[from]="Sender "' \ + '[to]=group:test_suite@notmuchmail.org,someone@example.com\;' \ + [cc]=test_suite_other@notmuchmail.org + +test_emacs "(notmuch-search \"id:\\\"${gen_msg_id}\\\"\") + (notmuch-test-wait) + (notmuch-search-reply-to-thread) + (test-output)" +cat <EXPECTED +From: Notmuch Test Suite +To: Sender , someone@example.com +Subject: Re: ${test_subtest_name} +In-Reply-To: <${gen_msg_id}> +Fcc: ${MAIL_DIR}/sent +--text follows this line-- +Sender writes: + +> This is just a test message (#${gen_msg_cnt}) +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) -- cgit v1.2.3 From 3737ca6e268e6f45353bfbcc4ac4b1d548c5908d Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Sun, 1 Apr 2012 09:24:21 -0600 Subject: emacs: Fix two bugs in reply Bug 1: Replying from alternate addresses ---------------------------------------- The reply code was inconsistent in its use of symbols and strings for header names being passed to message.el functions. This caused the From header to be lookup up incorrectly, causing an additional From header to be added with the user's primary address instead of the correct alternate address. This is fixed by using symbols everywhere, i.e. never using strings for header names when interacting with message.el. This change also removes our use of `mail-header`, since we don't use it anywhere else, and using assq makes it clear how the header lists are expected to work. Bug 2: Duplicate headers in emacs 23.2 -------------------------------------- The message.el code in emacs 23.2 assumes that header names will always be passed as symbols, so our use of strings caused problems. The symptom was that on 23.2 (and presumably on earlier versions) the reply message would end up with two of some headers. Converting everything to symbols also fixes this issue. --- emacs/notmuch-lib.el | 7 +++++-- emacs/notmuch-mua.el | 10 +++++----- test/emacs | 1 - 3 files changed, 10 insertions(+), 8 deletions(-) (limited to 'test/emacs') diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index c159dda..6907a5f 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -237,9 +237,12 @@ the given type." (or (plist-get part :content) (notmuch-get-bodypart-internal (notmuch-id-to-query (plist-get msg :id)) nth process-crypto))) -(defun notmuch-plist-to-alist (plist) +;; Converts a plist of headers to an alist of headers. The input plist should +;; have symbols of the form :Header as keys, and the resulting alist will have +;; symbols of the form 'Header as keys. +(defun notmuch-headers-plist-to-alist (plist) (loop for (key value . rest) on plist by #'cddr - collect (cons (substring (symbol-name key) 1) value))) + collect (cons (intern (substring (symbol-name key) 1)) value))) ;; Compatibility functions for versions of emacs before emacs 23. ;; diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 6aae3a0..cfa3d61 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -127,7 +127,7 @@ list." ((same-window-regexps '("\\*mail .*"))) (notmuch-mua-mail (plist-get reply-headers :To) (plist-get reply-headers :Subject) - (notmuch-plist-to-alist reply-headers))) + (notmuch-headers-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)) @@ -185,11 +185,11 @@ OTHER-ARGS are passed through to `message-mail'." (when notmuch-mua-user-agent-function (let ((user-agent (funcall notmuch-mua-user-agent-function))) (when (not (string= "" user-agent)) - (push (cons "User-Agent" user-agent) other-headers)))) + (push (cons 'User-Agent user-agent) other-headers)))) - (unless (mail-header 'From other-headers) - (push (cons "From" (concat - (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers)) + (unless (assq 'From other-headers) + (push (cons 'From (concat + (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) other-headers)) (apply #'message-mail to subject other-headers other-args) (message-sort-headers) diff --git a/test/emacs b/test/emacs index 576bc1f..30654bb 100755 --- a/test/emacs +++ b/test/emacs @@ -286,7 +286,6 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply from alternate address within emacs" -test_subtest_known_broken add_message '[from]="Sender "' \ [to]=test_suite_other@notmuchmail.org -- cgit v1.2.3 From bc531924e0463719d7572ed324edb002cfc1c70f Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Sun, 1 Apr 2012 09:24:22 -0600 Subject: test: Show all headers in emacs reply tests By default, emacs hides the User-Agent and References headers when composing mail. This is a good thing for users, but a bad thing for testing, since we can create ugly or invalid headers and not have it show up in the tests. By setting message-hidden-headers to an empty list, we force emacs to show all the headers, so we can check that they're correct. Users won't see this, but it will let us catch future bugs. As a side-effect, this breaks all the reply tests, since there is a bug with the References and User-Agent headers, fixed in the next commit. --- test/emacs | 55 +++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 43 insertions(+), 12 deletions(-) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index 30654bb..15cc778 100755 --- a/test/emacs +++ b/test/emacs @@ -267,17 +267,23 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply within emacs" -test_emacs '(notmuch-search "subject:\"testing message sent via SMTP\"") +test_subtest_known_broken +test_emacs '(let ((message-hidden-headers ''())) + (notmuch-search "subject:\"testing message sent via SMTP\"") (notmuch-test-wait) (notmuch-search-reply-to-thread) - (test-output)' + (test-output))' sed -i -e 's/^In-Reply-To: <.*>$/In-Reply-To: /' OUTPUT +sed -i -e 's/^References: <.*>$/References: /' OUTPUT +sed -i -e 's,^User-Agent: Notmuch/.* Emacs/.*,User-Agent: Notmuch/XXX Emacs/XXX,' OUTPUT cat <EXPECTED From: Notmuch Test Suite To: user@example.com Subject: Re: Testing message sent via SMTP In-Reply-To: Fcc: ${MAIL_DIR}/sent +References: +User-Agent: Notmuch/XXX Emacs/XXX --text follows this line-- Notmuch Test Suite writes: @@ -286,19 +292,24 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply from alternate address within emacs" +test_subtest_known_broken add_message '[from]="Sender "' \ [to]=test_suite_other@notmuchmail.org -test_emacs "(notmuch-search \"id:\\\"${gen_msg_id}\\\"\") +test_emacs "(let ((message-hidden-headers '())) + (notmuch-search \"id:\\\"${gen_msg_id}\\\"\") (notmuch-test-wait) (notmuch-search-reply-to-thread) - (test-output)" + (test-output))" +sed -i -e 's,^User-Agent: Notmuch/.* Emacs/.*,User-Agent: Notmuch/XXX Emacs/XXX,' OUTPUT cat <EXPECTED From: Notmuch Test Suite To: Sender Subject: Re: ${test_subtest_name} In-Reply-To: <${gen_msg_id}> Fcc: ${MAIL_DIR}/sent +References: <${gen_msg_id}> +User-Agent: Notmuch/XXX Emacs/XXX --text follows this line-- Sender writes: @@ -307,20 +318,25 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply from address in named group list within emacs" +test_subtest_known_broken add_message '[from]="Sender "' \ '[to]=group:test_suite@notmuchmail.org,someone@example.com\;' \ [cc]=test_suite_other@notmuchmail.org -test_emacs "(notmuch-search \"id:\\\"${gen_msg_id}\\\"\") +test_emacs "(let ((message-hidden-headers '())) + (notmuch-search \"id:\\\"${gen_msg_id}\\\"\") (notmuch-test-wait) (notmuch-search-reply-to-thread) - (test-output)" + (test-output))" +sed -i -e 's,^User-Agent: Notmuch/.* Emacs/.*,User-Agent: Notmuch/XXX Emacs/XXX,' OUTPUT cat <EXPECTED From: Notmuch Test Suite To: Sender , someone@example.com Subject: Re: ${test_subtest_name} In-Reply-To: <${gen_msg_id}> Fcc: ${MAIL_DIR}/sent +References: <${gen_msg_id}> +User-Agent: Notmuch/XXX Emacs/XXX --text follows this line-- Sender writes: @@ -329,15 +345,20 @@ 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") +test_subtest_known_broken +test_emacs '(let ((message-hidden-headers ''())) + (notmuch-show "id:20091118002059.067214ed@hikari") (notmuch-show-reply) - (test-output)' + (test-output))' +sed -i -e 's,^User-Agent: Notmuch/.* Emacs/.*,User-Agent: Notmuch/XXX Emacs/XXX,' 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 +References: <20091118002059.067214ed@hikari> +User-Agent: Notmuch/XXX Emacs/XXX --text follows this line-- Adrian Perez de Castro writes: @@ -388,15 +409,20 @@ 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") +test_subtest_known_broken +test_emacs '(let ((message-hidden-headers ''())) + (notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com") (notmuch-show-reply) - (test-output)' + (test-output))' +sed -i -e 's,^User-Agent: Notmuch/.* Emacs/.*,User-Agent: Notmuch/XXX Emacs/XXX,' 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 +References: +User-Agent: Notmuch/XXX Emacs/XXX --text follows this line-- Alex Botero-Lowry writes: @@ -424,19 +450,24 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Quote MML tags in reply" +test_subtest_known_broken message_id='test-emacs-mml-quoting@message.id' add_message [id]="$message_id" \ "[subject]='$test_subtest_name'" \ '[body]="<#part disposition=inline>"' -test_emacs "(notmuch-show \"id:$message_id\") +test_emacs "(let ((message-hidden-headers '())) + (notmuch-show \"id:$message_id\") (notmuch-show-reply) - (test-output)" + (test-output))" +sed -i -e 's,^User-Agent: Notmuch/.* Emacs/.*,User-Agent: Notmuch/XXX Emacs/XXX,' OUTPUT cat <EXPECTED From: Notmuch Test Suite To: Subject: Re: Quote MML tags in reply In-Reply-To: Fcc: ${MAIL_DIR}/sent +References: +User-Agent: Notmuch/XXX Emacs/XXX --text follows this line-- Notmuch Test Suite writes: -- cgit v1.2.3 From e4844fafec0dd789fe304b412c76f594850b833e Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Sun, 1 Apr 2012 09:24:23 -0600 Subject: emacs: Fix the References header in reply In the new reply code, the References header gets inserted by message.el using a function called message-shorten-references. Unlike all the other header-inserting functions, it doesn't put a newline after the header, causing the next header to end up on the same line. In our case, this header happened to be User-Agent, so it's hard to notice. This is probably a bug in message.el, but we need to work around it. This fixes the problem by wrapping message-shorten-references in a function that inserts a newline after if necessary. This should protect against the message.el bug being fixed in the future. --- emacs/notmuch-mua.el | 28 +++++++++++++++++++++++++--- test/emacs | 6 ------ 2 files changed, 25 insertions(+), 9 deletions(-) (limited to 'test/emacs') diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index cfa3d61..87bd88d 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -90,6 +90,15 @@ list." else if (notmuch-match-content-type (plist-get part :content-type) "text/*") collect part)) +;; There is a bug in emacs 23's message.el that results in a newline +;; not being inserted after the References header, so the next header +;; is concatenated to the end of it. This function fixes the problem, +;; while guarding against the possibility that some current or future +;; version of emacs has the bug fixed. +(defun notmuch-mua-insert-references (original-func header references) + (funcall original-func header references) + (unless (bolp) (insert "\n"))) + (defun notmuch-mua-reply (query-string &optional sender reply-all) (let ((args '("reply" "--format=json")) reply @@ -125,9 +134,22 @@ list." ;; 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-headers-plist-to-alist reply-headers))) + + ;; We modify message-header-format-alist to get around a bug in message.el. + ;; See the comment above on notmuch-mua-insert-references. + (let ((message-header-format-alist + (loop for pair in message-header-format-alist + if (eq (car pair) 'References) + collect (cons 'References + (apply-partially + 'notmuch-mua-insert-references + (cdr pair))) + else + collect pair))) + (notmuch-mua-mail (plist-get reply-headers :To) + (plist-get reply-headers :Subject) + (notmuch-headers-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)) diff --git a/test/emacs b/test/emacs index 15cc778..c7510e9 100755 --- a/test/emacs +++ b/test/emacs @@ -267,7 +267,6 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply within emacs" -test_subtest_known_broken test_emacs '(let ((message-hidden-headers ''())) (notmuch-search "subject:\"testing message sent via SMTP\"") (notmuch-test-wait) @@ -292,7 +291,6 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply from alternate address within emacs" -test_subtest_known_broken add_message '[from]="Sender "' \ [to]=test_suite_other@notmuchmail.org @@ -318,7 +316,6 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply from address in named group list within emacs" -test_subtest_known_broken add_message '[from]="Sender "' \ '[to]=group:test_suite@notmuchmail.org,someone@example.com\;' \ [cc]=test_suite_other@notmuchmail.org @@ -345,7 +342,6 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply within emacs to a multipart/mixed message" -test_subtest_known_broken test_emacs '(let ((message-hidden-headers ''())) (notmuch-show "id:20091118002059.067214ed@hikari") (notmuch-show-reply) @@ -409,7 +405,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 '(let ((message-hidden-headers ''())) (notmuch-show "id:cf0c4d610911171136h1713aa59w9cf9aa31f052ad0a@mail.gmail.com") (notmuch-show-reply) @@ -450,7 +445,6 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Quote MML tags in reply" -test_subtest_known_broken message_id='test-emacs-mml-quoting@message.id' add_message [id]="$message_id" \ "[subject]='$test_subtest_name'" \ -- cgit v1.2.3 From 6409a27b2c835223806e4b14cc219c927856c256 Mon Sep 17 00:00:00 2001 From: Dmitry Kurochkin Date: Sat, 10 Mar 2012 07:54:15 +0400 Subject: emacs: get rid of trailing spaces in notmuch-hello view This patch removes trailing spaces in notmuch-hello view. A side effect of this change is that tag/query buttons no longer include a space at the end. This means that pressing RET when the point is at the first character after the tag/query button no longer works (note that this is the standard behavior for buttons). We may change this behavior in the future (without adding trailing spaces back) if people would find this change inconvenient. --- emacs/notmuch-hello.el | 30 +++++++++------------- test/emacs | 2 +- test/emacs.expected-output/notmuch-hello | 2 +- .../emacs.expected-output/notmuch-hello-long-names | 6 ++--- .../notmuch-hello-new-section | 2 +- .../notmuch-hello-section-counts | 4 +-- .../notmuch-hello-section-hidden-tag | 2 +- .../notmuch-hello-section-with-empty | 2 +- .../emacs.expected-output/notmuch-hello-with-empty | 2 +- 9 files changed, 23 insertions(+), 29 deletions(-) (limited to 'test/emacs') diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el index 6b4b2c1..71d37b8 100644 --- a/emacs/notmuch-hello.el +++ b/emacs/notmuch-hello.el @@ -429,7 +429,8 @@ Such a list can be computed with `notmuch-hello-query-counts'." (let* ((widest (notmuch-hello-longest-label searches)) (tags-and-width (notmuch-hello-tags-per-line widest)) (tags-per-line (car tags-and-width)) - (widest (cdr tags-and-width)) + (column-width (cdr tags-and-width)) + (column-indent 0) (count 0) (reordered-list (notmuch-hello-reflect searches tags-per-line)) ;; Hack the display of the buttons used. @@ -441,32 +442,25 @@ Such a list can be computed with `notmuch-hello-query-counts'." (mapc (lambda (elem) ;; (not elem) indicates an empty slot in the matrix. (when elem + (if (> column-indent 0) + (widget-insert (make-string column-indent ? ))) (let* ((name (first elem)) (query (second elem)) - (msg-count (third elem)) - (formatted-name (format "%s " name))) + (msg-count (third elem))) (widget-insert (format "%8s " (notmuch-hello-nice-number msg-count))) - (if (string= formatted-name notmuch-hello-target) + (if (string= name notmuch-hello-target) (setq found-target-pos (point-marker))) (widget-create 'push-button :notify #'notmuch-hello-widget-search :notmuch-search-terms query - formatted-name) - (unless (eq (% count tags-per-line) (1- tags-per-line)) - ;; If this is not the last tag on the line, insert - ;; enough space to consume the rest of the column. - ;; Because the button for the name is `(1+ (length - ;; name))' long (due to the trailing space) we can - ;; just insert `(- widest (length name))' spaces - the - ;; column separator is included in the button if - ;; `(equal widest (length name)'. - (widget-insert (make-string (max 0 - (- widest (length name))) - ? ))))) + name) + (setq column-indent + (1+ (max 0 (- column-width (length name))))))) (setq count (1+ count)) - (if (eq (% count tags-per-line) 0) - (widget-insert "\n"))) + (when (eq (% count tags-per-line) 0) + (setq column-indent 0) + (widget-insert "\n"))) reordered-list) ;; If the last line was not full (and hence did not include a diff --git a/test/emacs b/test/emacs index c7510e9..38decd0 100755 --- a/test/emacs +++ b/test/emacs @@ -39,7 +39,7 @@ test_begin_subtest "Navigation of notmuch-hello to search results" test_emacs '(notmuch-hello) (goto-char (point-min)) (re-search-forward "inbox") - (widget-button-press (point)) + (widget-button-press (1- (point))) (notmuch-test-wait) (test-output)' test_expect_equal_file OUTPUT $EXPECTED/notmuch-hello-view-inbox diff --git a/test/emacs.expected-output/notmuch-hello b/test/emacs.expected-output/notmuch-hello index 1470790..2d69891 100644 --- a/test/emacs.expected-output/notmuch-hello +++ b/test/emacs.expected-output/notmuch-hello @@ -2,7 +2,7 @@ Saved searches: [edit] - 52 inbox 52 unread + 52 inbox 52 unread Search: . diff --git a/test/emacs.expected-output/notmuch-hello-long-names b/test/emacs.expected-output/notmuch-hello-long-names index be6d2c5..486d0d9 100644 --- a/test/emacs.expected-output/notmuch-hello-long-names +++ b/test/emacs.expected-output/notmuch-hello-long-names @@ -2,14 +2,14 @@ Saved searches: [edit] - 52 inbox 52 unread + 52 inbox 52 unread Search: . All tags: [hide] - 52 a-very-long-tag 52 inbox 52 unread - 4 attachment 7 signed + 52 a-very-long-tag 52 inbox 52 unread + 4 attachment 7 signed Type a search query and hit RET to view matching threads. Edit saved searches with the `edit' button. diff --git a/test/emacs.expected-output/notmuch-hello-new-section b/test/emacs.expected-output/notmuch-hello-new-section index 6a339aa..67fdef2 100644 --- a/test/emacs.expected-output/notmuch-hello-new-section +++ b/test/emacs.expected-output/notmuch-hello-new-section @@ -1,4 +1,4 @@ Test: [hide] - 52 inbox + 52 inbox diff --git a/test/emacs.expected-output/notmuch-hello-section-counts b/test/emacs.expected-output/notmuch-hello-section-counts index 9d79659..7a9827c 100644 --- a/test/emacs.expected-output/notmuch-hello-section-counts +++ b/test/emacs.expected-output/notmuch-hello-section-counts @@ -1,5 +1,5 @@ Test-with-counts: [hide] - 2 attachment 7 signed - 7 inbox 7 unread + 2 attachment 7 signed + 7 inbox 7 unread diff --git a/test/emacs.expected-output/notmuch-hello-section-hidden-tag b/test/emacs.expected-output/notmuch-hello-section-hidden-tag index 3688e7c..809a114 100644 --- a/test/emacs.expected-output/notmuch-hello-section-hidden-tag +++ b/test/emacs.expected-output/notmuch-hello-section-hidden-tag @@ -1,4 +1,4 @@ Test-with-filtered: [hide] - 4 attachment 52 inbox 7 signed + 4 attachment 52 inbox 7 signed diff --git a/test/emacs.expected-output/notmuch-hello-section-with-empty b/test/emacs.expected-output/notmuch-hello-section-with-empty index dc2568d..5c67317 100644 --- a/test/emacs.expected-output/notmuch-hello-section-with-empty +++ b/test/emacs.expected-output/notmuch-hello-section-with-empty @@ -1,4 +1,4 @@ Test-with-empty: [hide] - 52 inbox + 52 inbox diff --git a/test/emacs.expected-output/notmuch-hello-with-empty b/test/emacs.expected-output/notmuch-hello-with-empty index 5e53222..854e0c2 100644 --- a/test/emacs.expected-output/notmuch-hello-with-empty +++ b/test/emacs.expected-output/notmuch-hello-with-empty @@ -2,7 +2,7 @@ Saved searches: [edit] - 52 inbox 52 unread 0 empty + 52 inbox 52 unread 0 empty Search: . -- cgit v1.2.3 From 7fb8ab9f0b470dc236c92686ed33f8e0fa1d5727 Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Sat, 5 May 2012 13:24:28 -0600 Subject: test: Replying to an HTML-only message in emacs With the latest reply infrastructure, we should be able to nicely quote HTML-only emails. But currently emacs quotes the raw HTML instead of parsing it first. This commit adds a test for this case. This test currently marked as broken. --- test/emacs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index 38decd0..5f238d9 100755 --- a/test/emacs +++ b/test/emacs @@ -444,6 +444,33 @@ Alex Botero-Lowry writes: EOF test_expect_equal_file OUTPUT EXPECTED +test_begin_subtest "Reply within emacs to an html-only message" +test_subtest_known_broken +add_message '[content-type]="text/html"' \ + '[body]="Hi,
This is an HTML test message.

OK?"' +test_emacs "(let ((message-hidden-headers '())) + (notmuch-show \"id:${gen_msg_id}\") + (notmuch-show-reply) + (test-output))" +sed -i -e 's,^User-Agent: Notmuch/.* Emacs/.*,User-Agent: Notmuch/XXX Emacs/XXX,' OUTPUT +cat <EXPECTED +From: Notmuch Test Suite +To: +Subject: Re: Reply within emacs to an html-only message +In-Reply-To: <${gen_msg_id}> +Fcc: ${MAIL_DIR}/sent +References: <${gen_msg_id}> +User-Agent: Notmuch/XXX Emacs/XXX +--text follows this line-- +Notmuch Test Suite writes: + +> Hi, +> This is an HTML test message. +> +> OK? +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" \ -- cgit v1.2.3 From f6c170fabca8f39e74705e3813504137811bf162 Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Sat, 5 May 2012 13:30:37 -0600 Subject: emacs: Correctly quote non-text/plain parts in reply Quote non-text parts nicely by displaying them with mm-display-part before calling message-cite-original to quote them. HTML-only emails can now be quoted correctly. We re-use some code from notmuch-show (notmuch-show-mm-display-part-inline), which has been moved to notmuch-lib.el. Mark the test for this feature as not broken. --- emacs/notmuch-lib.el | 19 +++++++++++++++++++ emacs/notmuch-mua.el | 15 ++++++++++----- emacs/notmuch-show.el | 19 +------------------ test/emacs | 1 - 4 files changed, 30 insertions(+), 24 deletions(-) (limited to 'test/emacs') diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 6907a5f..7fa441a 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. +(require 'mm-view) +(require 'mm-decode) (eval-when-compile (require 'cl)) (defvar notmuch-command "notmuch" @@ -237,6 +239,23 @@ the given type." (or (plist-get part :content) (notmuch-get-bodypart-internal (notmuch-id-to-query (plist-get msg :id)) nth process-crypto))) +(defun notmuch-mm-display-part-inline (msg part nth content-type process-crypto) + "Use the mm-decode/mm-view functions to display a part in the +current buffer, if possible." + (let ((display-buffer (current-buffer))) + (with-temp-buffer + (let* ((charset (plist-get part :content-charset)) + (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset))))) + ;; If the user wants the part inlined, insert the content and + ;; test whether we are able to inline it (which includes both + ;; capability and suitability tests). + (when (mm-inlined-p handle) + (insert (notmuch-get-bodypart-content msg part nth process-crypto)) + (when (mm-inlinable-p handle) + (set-buffer display-buffer) + (mm-display-part handle) + t)))))) + ;; Converts a plist of headers to an alist of headers. The input plist should ;; have symbols of the form :Header as keys, and the resulting alist will have ;; symbols of the form 'Header as keys. diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 87bd88d..fc7ae07 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -21,6 +21,7 @@ (require 'json) (require 'message) +(require 'mm-view) (require 'format-spec) (require 'notmuch-lib) @@ -90,6 +91,14 @@ list." else if (notmuch-match-content-type (plist-get part :content-type) "text/*") collect part)) +(defun notmuch-mua-insert-quotable-part (message part) + (save-restriction + (narrow-to-region (point) (point)) + (notmuch-mm-display-part-inline message part (plist-get part :id) + (plist-get part :content-type) + notmuch-show-process-crypto) + (goto-char (point-max)))) + ;; There is a bug in emacs 23's message.el that results in a newline ;; not being inserted after the References header, so the next header ;; is concatenated to the end of it. This function fixes the problem, @@ -169,11 +178,7 @@ list." ;; 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)) + (mapc (apply-partially 'notmuch-mua-insert-quotable-part original) quotable-parts)) (set-mark (point)) (goto-char start) diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 37f0ebb..d318430 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -524,23 +524,6 @@ message at DEPTH in the current thread." (let ((handle (mm-make-handle (current-buffer) (list content-type)))) (mm-interactively-view-part handle)))) -(defun notmuch-show-mm-display-part-inline (msg part nth content-type) - "Use the mm-decode/mm-view functions to display a part in the -current buffer, if possible." - (let ((display-buffer (current-buffer))) - (with-temp-buffer - (let* ((charset (plist-get part :content-charset)) - (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset))))) - ;; If the user wants the part inlined, insert the content and - ;; test whether we are able to inline it (which includes both - ;; capability and suitability tests). - (when (mm-inlined-p handle) - (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) - t)))))) - (defun notmuch-show-multipart/*-to-list (part) (mapcar (lambda (inner-part) (plist-get inner-part :content-type)) (plist-get part :content))) @@ -785,7 +768,7 @@ current buffer, if possible." (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type) ;; This handler _must_ succeed - it is the handler of last resort. (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename)) - (notmuch-show-mm-display-part-inline msg part nth content-type) + (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto) t) ;; Functions for determining how to handle MIME parts. diff --git a/test/emacs b/test/emacs index 5f238d9..a615b39 100755 --- a/test/emacs +++ b/test/emacs @@ -445,7 +445,6 @@ EOF test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply within emacs to an html-only message" -test_subtest_known_broken add_message '[content-type]="text/html"' \ '[body]="Hi,
This is an HTML test message.

OK?"' test_emacs "(let ((message-hidden-headers '())) -- cgit v1.2.3 From 97efed0f0854c2231625057738c1c2db7b37c139 Mon Sep 17 00:00:00 2001 From: Adam Wolfe Gordon Date: Sun, 6 May 2012 08:56:15 -0600 Subject: test: Force reply to use html2text for consistency The output of the HTML reply test in the emacs suite can vary depending on which HTML renderers are installed on the machine running the tests. The renderer that is always available is emacs's builtin html2text function. In order to get consistency, force the test to use html2text even if other renderers are available. --- test/emacs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index a615b39..e9f954c 100755 --- a/test/emacs +++ b/test/emacs @@ -447,7 +447,7 @@ test_expect_equal_file OUTPUT EXPECTED test_begin_subtest "Reply within emacs to an html-only message" add_message '[content-type]="text/html"' \ '[body]="Hi,
This is an HTML test message.

OK?"' -test_emacs "(let ((message-hidden-headers '())) +test_emacs "(let ((message-hidden-headers '()) (mm-text-html-renderer 'html2text)) (notmuch-show \"id:${gen_msg_id}\") (notmuch-show-reply) (test-output))" @@ -463,10 +463,7 @@ User-Agent: Notmuch/XXX Emacs/XXX --text follows this line-- Notmuch Test Suite writes: -> Hi, -> This is an HTML test message. -> -> OK? +> Hi,This is an HTML test message.OK? EOF test_expect_equal_file OUTPUT EXPECTED -- cgit v1.2.3 From f94a50d80af8c2a5513e58db954dd0b1910eb4a8 Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Mon, 9 Jul 2012 17:42:39 -0400 Subject: test: New test for incremental search output parsing This advises the search process filter to make it process one character at a time in order to test the pessimal case for incremental search output parsing. The text parser fails this test because it gets tricked into thinking a parenthetical remark in a subject is the tag list. --- test/emacs | 11 +++++++++++ test/test-lib.el | 8 ++++++++ 2 files changed, 19 insertions(+) (limited to 'test/emacs') diff --git a/test/emacs b/test/emacs index e9f954c..293b12a 100755 --- a/test/emacs +++ b/test/emacs @@ -35,6 +35,17 @@ test_emacs '(notmuch-search "tag:inbox") (test-output)' test_expect_equal_file OUTPUT $EXPECTED/notmuch-search-tag-inbox +test_begin_subtest "Incremental parsing of search results" +test_subtest_known_broken +test_emacs "(ad-enable-advice 'notmuch-search-process-filter 'around 'pessimal) + (ad-activate 'notmuch-search-process-filter) + (notmuch-search \"tag:inbox\") + (notmuch-test-wait) + (ad-disable-advice 'notmuch-search-process-filter 'around 'pessimal) + (ad-activate 'notmuch-search-process-filter) + (test-output)" +test_expect_equal_file OUTPUT $EXPECTED/notmuch-search-tag-inbox + test_begin_subtest "Navigation of notmuch-hello to search results" test_emacs '(notmuch-hello) (goto-char (point-min)) diff --git a/test/test-lib.el b/test/test-lib.el index 6271da2..5dd6271 100644 --- a/test/test-lib.el +++ b/test/test-lib.el @@ -89,6 +89,14 @@ nothing." (add-hook-counter 'notmuch-hello-mode-hook) (add-hook-counter 'notmuch-hello-refresh-hook) +(defadvice notmuch-search-process-filter (around pessimal activate disable) + "Feed notmuch-search-process-filter one character at a time." + (let ((string (ad-get-arg 1))) + (loop for char across string + do (progn + (ad-set-arg 1 (char-to-string char)) + ad-do-it)))) + (defmacro notmuch-test-run (&rest body) "Evaluate a BODY of test expressions and output the result." `(with-temp-buffer -- cgit v1.2.3 From 9c5ea07cc66a00132d20db0c8b2094d25ce564ba Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Mon, 9 Jul 2012 17:42:41 -0400 Subject: emacs: Switch from text to JSON format for search results The JSON format eliminates the complex escaping issues that have plagued the text search format. This uses the incremental JSON parser so that, like the text parser, it can output search results incrementally. This slows down the parser by about ~4X, but puts us in a good position to optimize either by improving the JSON parser (evidence suggests this can reduce the overhead to ~40% over the text format) or by switching to S-expressions (evidence suggests this will more than double performance over the text parser). [1] This also fixes the incremental search parsing test. This has one minor side-effect on search result formatting. Previously, the date field was always padded to a fixed width of 12 characters because of how the text parser's regexp was written. The JSON format doesn't do this. We could pad it out in Emacs before formatting it, but, since all of the other fields are variable width, we instead fix notmuch-search-result-format to take the variable-width field and pad it out. For users who have customized this variable, we'll mention in the NEWS how to fix this slight format change. [1] id:"20110720205007.GB21316@mit.edu" --- emacs/notmuch.el | 110 ++++++++++++++++++++++++++++++++----------------------- test/emacs | 1 - 2 files changed, 64 insertions(+), 47 deletions(-) (limited to 'test/emacs') diff --git a/emacs/notmuch.el b/emacs/notmuch.el index dfeaf35..fabb7c0 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -60,7 +60,7 @@ (require 'notmuch-message) (defcustom notmuch-search-result-format - `(("date" . "%s ") + `(("date" . "%12s ") ("count" . "%-7s ") ("authors" . "%-20s ") ("subject" . "%s ") @@ -557,17 +557,14 @@ This function advances the next thread when finished." (notmuch-search-tag '("-inbox")) (notmuch-search-next-thread)) -(defvar notmuch-search-process-filter-data nil - "Data that has not yet been processed.") -(make-variable-buffer-local 'notmuch-search-process-filter-data) - (defun notmuch-search-process-sentinel (proc msg) "Add a message to let user know when \"notmuch search\" exits" (let ((buffer (process-buffer proc)) (status (process-status proc)) (exit-status (process-exit-status proc)) (never-found-target-thread nil)) - (if (memq status '(exit signal)) + (when (memq status '(exit signal)) + (kill-buffer (process-get proc 'parse-buf)) (if (buffer-live-p buffer) (with-current-buffer buffer (save-excursion @@ -577,8 +574,6 @@ This function advances the next thread when finished." (if (eq status 'signal) (insert "Incomplete search results (search process was killed).\n")) (when (eq status 'exit) - (if notmuch-search-process-filter-data - (insert (concat "Error: Unexpected output from notmuch search:\n" notmuch-search-process-filter-data))) (insert "End of search results.") (unless (= exit-status 0) (insert (format " (process returned %d)" exit-status))) @@ -758,45 +753,59 @@ non-authors is found, assume that all of the authors match." (insert (apply #'format string objects)) (insert "\n"))) +(defvar notmuch-search-process-state nil + "Parsing state of the search process filter.") + +(defvar notmuch-search-json-parser nil + "Incremental JSON parser for the search process filter.") + (defun notmuch-search-process-filter (proc string) "Process and filter the output of \"notmuch search\"" - (let ((buffer (process-buffer proc))) - (if (buffer-live-p buffer) - (with-current-buffer buffer - (let ((line 0) - (more t) - (inhibit-read-only t) - (string (concat notmuch-search-process-filter-data string))) - (setq notmuch-search-process-filter-data nil) - (while more - (while (and (< line (length string)) (= (elt string line) ?\n)) - (setq line (1+ line))) - (if (string-match "^thread:\\([0-9A-Fa-f]*\\) \\([^][]*\\) \\[\\([0-9]*\\)/\\([0-9]*\\)\\] \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line) - (let* ((thread-id (match-string 1 string)) - (tags-str (match-string 7 string)) - (result (list :thread thread-id - :date_relative (match-string 2 string) - :matched (string-to-number - (match-string 3 string)) - :total (string-to-number - (match-string 4 string)) - :authors (match-string 5 string) - :subject (match-string 6 string) - :tags (if tags-str - (save-match-data - (split-string tags-str)))))) - (if (/= (match-beginning 0) line) - (notmuch-search-show-error - (substring string line (match-beginning 0)))) - (notmuch-search-show-result result) - (set 'line (match-end 0))) - (set 'more nil) - (while (and (< line (length string)) (= (elt string line) ?\n)) - (setq line (1+ line))) - (if (< line (length string)) - (setq notmuch-search-process-filter-data (substring string line))) - )))) - (delete-process proc)))) + (let ((results-buf (process-buffer proc)) + (parse-buf (process-get proc 'parse-buf)) + (inhibit-read-only t) + done) + (if (not (buffer-live-p results-buf)) + (delete-process proc) + (with-current-buffer parse-buf + ;; Insert new data + (save-excursion + (goto-char (point-max)) + (insert string))) + (with-current-buffer results-buf + (while (not done) + (condition-case nil + (case notmuch-search-process-state + ((begin) + ;; Enter the results list + (if (eq (notmuch-json-begin-compound + notmuch-search-json-parser) 'retry) + (setq done t) + (setq notmuch-search-process-state 'result))) + ((result) + ;; Parse a result + (let ((result (notmuch-json-read notmuch-search-json-parser))) + (case result + ((retry) (setq done t)) + ((end) (setq notmuch-search-process-state 'end)) + (otherwise (notmuch-search-show-result result))))) + ((end) + ;; Any trailing data is unexpected + (notmuch-json-eof notmuch-search-json-parser) + (setq done t))) + (json-error + ;; Do our best to resynchronize and ensure forward + ;; progress + (notmuch-search-show-error + "%s" + (with-current-buffer parse-buf + (let ((bad (buffer-substring (line-beginning-position) + (line-end-position)))) + (forward-line) + bad)))))) + ;; Clear out what we've parsed + (with-current-buffer parse-buf + (delete-region (point-min) (point))))))) (defun notmuch-search-tag-all (&optional tag-changes) "Add/remove tags from all messages in current search buffer. @@ -899,10 +908,19 @@ Other optional parameters are used as follows: (let ((proc (start-process "notmuch-search" buffer notmuch-command "search" + "--format=json" (if oldest-first "--sort=oldest-first" "--sort=newest-first") - query))) + query)) + ;; Use a scratch buffer to accumulate partial output. + ;; This buffer will be killed by the sentinel, which + ;; should be called no matter how the process dies. + (parse-buf (generate-new-buffer " *notmuch search parse*"))) + (set (make-local-variable 'notmuch-search-process-state) 'begin) + (set (make-local-variable 'notmuch-search-json-parser) + (notmuch-json-create-parser parse-buf)) + (process-put proc 'parse-buf parse-buf) (set-process-sentinel proc 'notmuch-search-process-sentinel) (set-process-filter proc 'notmuch-search-process-filter) (set-process-query-on-exit-flag proc nil)))) diff --git a/test/emacs b/test/emacs index 293b12a..afe35ba 100755 --- a/test/emacs +++ b/test/emacs @@ -36,7 +36,6 @@ test_emacs '(notmuch-search "tag:inbox") test_expect_equal_file OUTPUT $EXPECTED/notmuch-search-tag-inbox test_begin_subtest "Incremental parsing of search results" -test_subtest_known_broken test_emacs "(ad-enable-advice 'notmuch-search-process-filter 'around 'pessimal) (ad-activate 'notmuch-search-process-filter) (notmuch-search \"tag:inbox\") -- cgit v1.2.3