[PATCH v2] emacs: bad regexp @ `notmuch-search-process-filter'
Pieter Praet
pieter at praet.org
Mon Jul 11 13:43:13 PDT 2011
TL;DR: I can haz regex pl0x?
I've updated the regex a bit to prevent it from choking on the whole
"parens in subject vs. parens around tags vs. parens around matching
Message-Id's" deal, but it still causes errors in the search buffer due
to the list of Message-Id's being cut off at a seemingly arbitrary point,
and this for *different* results on pretty much every refresh.
All tests pass, except for the ones I've mentioned before [1] (which
don't test anything tagging-related, just `notmuch-show'), though even
those fail to fail consistently :<. This variability can't be related to
residual files, as I always run the test suite like this:
rm -rf /dev/shm/notmuch/* && make test OPTIONS="--root=/dev/shm/notmuch"
So, to keep this on track for 0.7 whilst keeping myself from having to
send spammerific amounts of patches, I've squashed the whole deal in
this single patch. Don't worry though, it's all quite grokkable:
notmuch-search.c
- Make `notmuch search' *only* append results with their Message-Id's
when supplied with the "--output=summary-ids" option, to prevent a
slew of failing tests obscuring the relevant ones.
emacs/notmuch.el
- Make `notmuch-search' run the notmuch binary with the "--output=summary-ids"
option, to receive search results appended with their lists of Message-Id's.
- Update the regex @ `notmuch-search-process-filter' to include a new atom,
which matches the list of Message-Id's at the end of every search result
returned by the notmuch binary.
To each individual result in the search buffer, this matched string is
added as a text property called `notmuch-search-msgids'.
- Add 2 functions to return the `notmuch-search-msgids' property of search
results: `notmuch-search-find-msgids', `notmuch-search-find-msgids-region'.
- Add a function to stash the Message-Id's of (a region of) search results:
`notmuch-search-stash-msgids', bound to "m" in `notmuch-search-stash-map'.
Mainly for testing purposes.
- Merge `notmuch-call-notmuch-process' into `notmuch-tag':
`notmuch-tag' was the only thing making use of `notmuch-call-notmuch-process',
and the extra layer of abstraction would complicate making `notmuch-tag' send
arguments on stdin (see next point).
- Make `notmuch-tag' send its query string on stdin:
Instead of providing the query string as a (potentially very long) command
line argument, `notmuch-tag' now dumps it into a temporary buffer, which
`call-process-region' sends to `notmuch-command' on stdin.
This is needed to circumvent "$command: arg list too long" errors due
to command line argument length limitations imposed by the kernel (ARG_MAX).
- Fix the actual bug(s) this patch series is intended to address by making
the tagging functions procure their targets from the `notmuch-search-msgids'
property with `notmuch-search-find-msgids-region', instead of using x:
- `notmuch-search-add-tag-region' (x = `notmuch-search-find-thread-id-region')
- `notmuch-search-remove-tag-region' (x = `notmuch-search-find-thread-id-region')
- `notmuch-search-remove-tag' (x = `notmuch-search-find-thread-id-region')
- `notmuch-search-operate-all' (x = `notmuch-search-query-string')
test/emacs, test/emacs-search-operate-all, test/notmuch-test
- Expand the test suite to also cover:
- Tagging messages with `notmuch-search-operate-all'.
- Tagging messages to which a reply is sent. For this I also needed to
correct the title of an existing test, and add a test for sending
replies from within Emacs.
Side note:
After playing around with Austin's new patch for a bit, I've come to the
conclusion that making a clear distinction between matched and unmatched
messages in the binary's output *is* the way to go, but in the case of
`notmuch-search-operate-all', this capability shouldn't be leveraged.
The way `notmuch-search-operate-all' currently works, i.e. operate on
matched *messages* instead of matched *threads*, is not only counter-
intuitive (same as it would be for `notmuch-search-add-tag' and
`notmuch-search-remove-tag' [2]), but semantically incorrect as well:
Its name implies operating on *all* that is visible in the current
buffer, instead of only a subset.
Peace
[1] id:"1310307099-25197-1-git-send-email-pieter at praet.org"
[2] id:"e8c5fbf4-4dfa-461a-8f5c-6c696291a270 at email.android.com"
Signed-off-by: Pieter Praet <pieter at praet.org>
---
emacs/notmuch.el | 93 ++++++++++++++++++++++++++++-------------
notmuch-search.c | 6 ++-
test/emacs | 49 +++++++++++++++++++++-
test/emacs-search-operate-all | 29 +++++++++++++
test/notmuch-test | 1 +
5 files changed, 147 insertions(+), 31 deletions(-)
create mode 100755 test/emacs-search-operate-all
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index f11ec24..400adcc 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -226,6 +226,7 @@ For a mouse binding, return nil."
(defvar notmuch-search-stash-map
(let ((map (make-sparse-keymap)))
(define-key map "i" 'notmuch-search-stash-thread-id)
+ (define-key map "m" 'notmuch-search-stash-msgids)
map)
"Submap for stash commands")
(fset 'notmuch-search-stash-map notmuch-search-stash-map)
@@ -235,6 +236,19 @@ For a mouse binding, return nil."
(interactive)
(notmuch-common-do-stash (notmuch-search-find-thread-id)))
+(defun notmuch-search-stash-msgids ()
+ "Copy all Message-ID's in currently selected thread(s) to kill-ring."
+ (interactive)
+ (save-excursion
+ (if (region-active-p)
+ (let* ((beg (region-beginning))
+ (end (region-end)))
+ (notmuch-common-do-stash
+ (mapconcat 'identity
+ (notmuch-search-find-msgids-region beg end)
+ " or ")))
+ (notmuch-common-do-stash (notmuch-search-find-msgids)))))
+
(defvar notmuch-search-query-string)
(defvar notmuch-search-target-thread)
(defvar notmuch-search-target-line)
@@ -402,6 +416,14 @@ Complete list of currently available key bindings:
"Return a list of threads for the current region"
(notmuch-search-properties-in-region 'notmuch-search-thread-id beg end))
+(defun notmuch-search-find-msgids ()
+ "Return all Message-Id's for the current thread"
+ (get-text-property (point) 'notmuch-search-msgids))
+
+(defun notmuch-search-find-msgids-region (beg end)
+ "Return a list of all Message-Id's for the threads in the current region"
+ (notmuch-search-properties-in-region 'notmuch-search-msgids beg end))
+
(defun notmuch-search-find-authors ()
"Return the authors for the current thread"
(get-text-property (point) 'notmuch-search-authors))
@@ -448,23 +470,6 @@ Complete list of currently available key bindings:
(let ((message-id (notmuch-search-find-thread-id)))
(notmuch-mua-new-reply message-id prompt-for-sender)))
-(defun notmuch-call-notmuch-process (&rest args)
- "Synchronously invoke \"notmuch\" with the given list of arguments.
-
-Output from the process will be presented to the user as an error
-and will also appear in a buffer named \"*Notmuch errors*\"."
- (let ((error-buffer (get-buffer-create "*Notmuch errors*")))
- (with-current-buffer error-buffer
- (erase-buffer))
- (if (eq (apply 'call-process notmuch-command nil error-buffer nil args) 0)
- (point)
- (progn
- (with-current-buffer error-buffer
- (let ((beg (point-min))
- (end (- (point-max) 1)))
- (error (buffer-substring beg end))
- ))))))
-
(defun notmuch-tag (query &rest tags)
"Add/remove tags in TAGS to messages matching QUERY.
@@ -476,8 +481,32 @@ messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
directly, so that hooks specified in notmuch-before-tag-hook and
notmuch-after-tag-hook will be run."
(run-hooks 'notmuch-before-tag-hook)
- (apply 'notmuch-call-notmuch-process
- (append (list "tag") tags (list "--" query)))
+
+ (let ((query-buffer (get-buffer-create "*Notmuch query*"))
+ (error-buffer (get-buffer-create "*Notmuch errors*")))
+ (with-current-buffer error-buffer
+ (erase-buffer))
+
+ (with-current-buffer query-buffer
+ (erase-buffer)
+ (insert query)
+
+ (if (eq
+ (apply 'call-process-region
+ (append
+ (list (point-min) (point-max) notmuch-command nil error-buffer nil)
+ (list "tag" "--stdin") tags))
+ 0)
+ (point)
+ (progn
+ (with-current-buffer error-buffer
+ (let ((beg (point-min))
+ (end (- (point-max) 1)))
+ (error (buffer-substring beg end))
+ )))))
+
+ (kill-buffer query-buffer))
+
(run-hooks 'notmuch-after-tag-hook))
(defcustom notmuch-before-tag-hook nil
@@ -541,7 +570,7 @@ the messages that were tagged"
(notmuch-search-add-tag-region tag (point) (point)))
(defun notmuch-search-add-tag-region (tag beg end)
- (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
+ (let ((search-id-string (mapconcat 'identity (notmuch-search-find-msgids-region beg end) " or ")))
(notmuch-tag search-id-string (concat "+" tag))
(save-excursion
(let ((last-line (line-number-at-pos end))
@@ -555,7 +584,7 @@ the messages that were tagged"
(notmuch-search-remove-tag-region tag (point) (point)))
(defun notmuch-search-remove-tag-region (tag beg end)
- (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
+ (let ((search-id-string (mapconcat 'identity (notmuch-search-find-msgids-region beg end) " or ")))
(notmuch-tag search-id-string (concat "-" tag))
(save-excursion
(let ((last-line (line-number-at-pos end))
@@ -589,9 +618,9 @@ thread or threads in the current region."
"Tag to remove: "
(if (region-active-p)
(mapconcat 'identity
- (notmuch-search-find-thread-id-region (region-beginning) (region-end))
+ (notmuch-search-find-msgids-region (region-beginning) (region-end))
" ")
- (notmuch-search-find-thread-id)))))
+ (notmuch-search-find-msgids)))))
(save-excursion
(if (region-active-p)
(let* ((beg (region-beginning))
@@ -801,13 +830,14 @@ non-authors is found, assume that all of the authors match."
(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/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
+ (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\([^][]*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\)) \\((.*\\(or.*\\)*\\)$" string line)
(let* ((thread-id (match-string 1 string))
(date (match-string 2 string))
(count (match-string 3 string))
(authors (match-string 4 string))
(subject (match-string 5 string))
(tags (match-string 6 string))
+ (msgids (match-string 7 string))
(tag-list (if tags (save-match-data (split-string tags)))))
(goto-char (point-max))
(if (/= (match-beginning 1) line)
@@ -816,6 +846,7 @@ non-authors is found, assume that all of the authors match."
(notmuch-search-show-result date count authors subject tags)
(notmuch-search-color-line beg (point-marker) tag-list)
(put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id)
+ (put-text-property beg (point-marker) 'notmuch-search-msgids msgids)
(put-text-property beg (point-marker) 'notmuch-search-authors authors)
(put-text-property beg (point-marker) 'notmuch-search-subject subject)
(if (string= thread-id notmuch-search-target-thread)
@@ -834,10 +865,10 @@ non-authors is found, assume that all of the authors match."
(delete-process proc))))
(defun notmuch-search-operate-all (action)
- "Add/remove tags from all matching messages.
+ "Add/remove tags to/from all threads in current search buffer.
-This command adds or removes tags from all messages matching the
-current search terms. When called interactively, this command
+This command adds or removes tags from all threads displayed in
+the current search buffer. When called interactively, this command
will prompt for tags to be added or removed. Tags prefixed with
'+' will be added and tags prefixed with '-' will be removed.
@@ -845,7 +876,10 @@ Each character of the tag name may consist of alphanumeric
characters as well as `_.+-'.
"
(interactive "sOperation (+add -drop): notmuch tag ")
- (let ((action-split (split-string action " +")))
+ (let ((action-split (split-string action " +"))
+ (msgids (mapconcat 'identity
+ (notmuch-search-find-msgids-region (point-min) (- (point-max) 2))
+ " or ")))
;; Perform some validation
(let ((words action-split))
(when (null words) (error "No operation given"))
@@ -853,7 +887,7 @@ characters as well as `_.+-'.
(unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))
(error "Action must be of the form `+thistag -that_tag'"))
(setq words (cdr words))))
- (apply 'notmuch-tag notmuch-search-query-string action-split)))
+ (apply 'notmuch-tag msgids action-split)))
(defun notmuch-search-buffer-title (query)
"Returns the title for a buffer with notmuch search results."
@@ -913,6 +947,7 @@ The optional parameters are used as follows:
(let ((proc (start-process
"notmuch-search" buffer
notmuch-command "search"
+ "--output=summary-ids"
(if oldest-first
"--sort=oldest-first"
"--sort=newest-first")
diff --git a/notmuch-search.c b/notmuch-search.c
index 2288eb7..b3af88b 100644
--- a/notmuch-search.c
+++ b/notmuch-search.c
@@ -22,6 +22,7 @@
typedef enum {
OUTPUT_SUMMARY,
+ OUTPUT_SUMMARY_IDS,
OUTPUT_THREADS,
OUTPUT_MESSAGES,
OUTPUT_FILES,
@@ -274,7 +275,7 @@ do_search_threads (const search_format_t *format,
fputs (format->tag_end, stdout);
- if (format == &format_text) {
+ if (format == &format_text && output == OUTPUT_SUMMARY_IDS) {
notmuch_messages_t *toplevel;
const char *first;
@@ -462,6 +463,8 @@ notmuch_search_command (void *ctx, int argc, char *argv[])
opt = argv[i] + sizeof ("--output=") - 1;
if (strcmp (opt, "summary") == 0) {
output = OUTPUT_SUMMARY;
+ } else if (strcmp (opt, "summary-ids") == 0) {
+ output = OUTPUT_SUMMARY_IDS;
} else if (strcmp (opt, "threads") == 0) {
output = OUTPUT_THREADS;
} else if (strcmp (opt, "messages") == 0) {
@@ -513,6 +516,7 @@ notmuch_search_command (void *ctx, int argc, char *argv[])
switch (output) {
default:
case OUTPUT_SUMMARY:
+ case OUTPUT_SUMMARY_IDS:
case OUTPUT_THREADS:
ret = do_search_threads (format, query, sort, output);
break;
diff --git a/test/emacs b/test/emacs
index 53f455a..6479c4e 100755
--- a/test/emacs
+++ b/test/emacs
@@ -239,7 +239,7 @@ Subject:
EOF
test_expect_equal_file OUTPUT EXPECTED
-test_begin_subtest "Reply within emacs"
+test_begin_subtest "Compose reply in emacs"
test_emacs '(notmuch-search "subject:\"testing message sent via SMTP\"")
(notmuch-test-wait)
(notmuch-search-reply-to-thread)
@@ -257,6 +257,53 @@ On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite at notmuchmail.org> w
EOF
test_expect_equal_file OUTPUT EXPECTED
+test_begin_subtest "Send reply from within Emacs"
+$TEST_DIRECTORY/smtp-dummy sent_message &
+smtp_dummy_pid=$!
+test_emacs \
+'(let ((message-send-mail-function '\''message-smtpmail-send-it)
+ (smtpmail-smtp-server "localhost")
+ (smtpmail-smtp-service "25025"))
+ (notmuch-search "subject:\"testing message sent via SMTP\"")
+ (notmuch-test-wait)
+ (notmuch-search-reply-to-thread)
+ (message-goto-to)
+ (message-goto-body)
+ (end-of-buffer)
+ (newline)
+ (insert "Reply to a message via Emacs with fake SMTP")
+ (message-send-and-exit))' >/dev/null 2>&1
+wait ${smtp_dummy_pid}
+notmuch new >/dev/null
+sed \
+ -e s',^User-Agent: Notmuch/.* Emacs/.*,User-Agent: Notmuch/XXX Emacs/XXX,' \
+ -e s',^Message-ID: <.*>$,Message-ID: <XXX>,' \
+ -e s',^In-Reply-To: <.*>$,In-Reply-To: <XXX>,' \
+ -e s',^References: <.*>$,References: <XXX>,' \
+ -e s',^Date: .*$,Date: Fri\, 29 Mar 1974 10:05:00 -0000,' < sent_message >OUTPUT
+cat <<EOF >EXPECTED
+From: Notmuch Test Suite <test_suite at notmuchmail.org>
+To: user at example.com
+Subject: Re: Testing message sent via SMTP
+In-Reply-To: <XXX>
+References: <XXX>
+User-Agent: Notmuch/XXX Emacs/XXX
+Date: Fri, 29 Mar 1974 10:05:00 -0000
+Message-ID: <XXX>
+MIME-Version: 1.0
+Content-Type: text/plain; charset=us-ascii
+
+On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite at notmuchmail.org> wrote:
+> This is a test that messages are sent via SMTP
+
+Reply to a message via Emacs with fake SMTP
+EOF
+test_expect_equal_file OUTPUT EXPECTED
+
+test_begin_subtest "Verify that 'replied' tag is added to reply's parent message."
+output=$(notmuch search 'tag:replied' | notmuch_search_sanitize)
+test_expect_equal "$output" "thread:XXX 2000-01-01 [1/2] Notmuch Test Suite; Testing message sent via SMTP (inbox replied)"
+
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\""))
diff --git a/test/emacs-search-operate-all b/test/emacs-search-operate-all
new file mode 100755
index 0000000..48326c8
--- /dev/null
+++ b/test/emacs-search-operate-all
@@ -0,0 +1,29 @@
+#!/usr/bin/env bash
+
+test_description="emacs interface"
+. test-lib.sh
+
+EXPECTED=$TEST_DIRECTORY/emacs.expected-output
+
+add_email_corpus
+
+test_begin_subtest "Add/remove tags to/from all matching threads."
+test_emacs '(notmuch-search "tag:inbox AND tags")
+ (notmuch-test-wait)
+ (notmuch-search-operate-all "+matching -inbox")
+ (notmuch-search "tag:matching AND NOT tag:inbox")
+ (notmuch-test-wait)
+ (test-output)'
+cat <<EOF >EXPECTED
+ 2009-11-18 [2/2] Ingmar Vanhassel, Carl Worth [notmuch] [PATCH] Typsos (matching unread)
+ 2009-11-18 [3/3] Adrian Perez de Castro, Keith Packard, Carl Worth [notmuch] Introducing myself (matching signed unread)
+ 2009-11-18 [3/3] Israel Herraiz, Keith Packard, Carl Worth [notmuch] New to the list (matching unread)
+ 2009-11-18 [2/2] Keith Packard, Carl Worth [notmuch] [PATCH] Make notmuch-show 'X' (and 'x') commands remove inbox (and unread) tags (matching unread)
+ 2009-11-18 [2/2] Keith Packard, Alexander Botero-Lowry [notmuch] [PATCH] Create a default notmuch-show-hook that highlights URLs and uses word-wrap (matching unread)
+ 2009-11-18 [1/1] Jan Janak [notmuch] [PATCH] notmuch new: Support for conversion of spool subdirectories into tags (matching unread)
+ 2009-11-18 [1/1] Stewart Smith [notmuch] [PATCH] Fix linking with gcc to use g++ to link in C++ libs. (matching unread)
+End of search results.
+EOF
+test_expect_equal_file OUTPUT EXPECTED
+
+test_done
diff --git a/test/notmuch-test b/test/notmuch-test
index 79e6267..bafbcb1 100755
--- a/test/notmuch-test
+++ b/test/notmuch-test
@@ -38,6 +38,7 @@ TESTS="
encoding
emacs
emacs-large-search-buffer
+ emacs-search-operate-all
maildir-sync
crypto
symbol-hiding
--
1.7.5.4
More information about the notmuch
mailing list