[PATCH v2] emacs: bad regexp @ `notmuch-search-process-filter'

Subject: [PATCH v2] emacs: bad regexp @ `notmuch-search-process-filter'

Date: Mon, 11 Jul 2011 22:43:13 +0200

To: Austin Clements

Cc: Notmuch Mail

From: Pieter Praet

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:


- 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.


- 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.


[1] id:"1310307099-25197-1-git-send-email-pieter@praet.org"
[2] id:"e8c5fbf4-4dfa-461a-8f5c-6c696291a270@email.android.com"

Signed-off-by: Pieter Praet <pieter@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)
   "Submap for stash commands")
 (fset 'notmuch-search-stash-map notmuch-search-stash-map)
@@ -235,6 +236,19 @@ For a mouse binding, return nil."
   (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))
       (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))
       (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)))))
     (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
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 {
@@ -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) {
 	    } 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) {
 	ret = do_search_threads (format, query, sort, output);
diff --git a/test/emacs b/test/emacs
index 53f455a..6479c4e 100755
--- a/test/emacs
+++ b/test/emacs
@@ -239,7 +239,7 @@ Subject:
 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\"")
@@ -257,6 +257,53 @@ On 01 Jan 2000 12:00:00 -0000, Notmuch Test Suite <test_suite@notmuchmail.org> w
 test_expect_equal_file OUTPUT EXPECTED
+test_begin_subtest "Send reply from within Emacs"
+$TEST_DIRECTORY/smtp-dummy sent_message &
+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
+From: Notmuch Test Suite <test_suite@notmuchmail.org>
+To: user@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@notmuchmail.org> wrote:
+> This is a test that messages are sent via SMTP
+Reply to a message via Emacs with fake SMTP
+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
+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)'
+  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.
+test_expect_equal_file OUTPUT EXPECTED
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="
+  emacs-search-operate-all