second attempt: JSON based search

second attempt: JSON based search

[David Edmondson]

Here's another attempt that uses the proper JSON output directly -
there is no requirement to either modify that output (as previously)
or add another similar output format (as discussed on IRC).

[PATCH 1/3] notmuch: Add `date_relative' to JSON search output.
[PATCH 2/3] test: Expect `date_relative' in JSON search output.
[PATCH 3/3] emacs: Use JSON output for search.

[PATCH 1/3] notmuch: Add `date_relative' to JSON search output.

[David Edmondson]

Provide consumers of the JSON search output with the standard notmuch
relative date for each thread.
---
 notmuch-search.c |    2 ++
 1 files changed, 2 insertions(+), 0 deletions(-)

diff --git a/notmuch-search.c b/notmuch-search.c
index c628b36..d49556b 100644
--- a/notmuch-search.c
+++ b/notmuch-search.c
@@ -152,12 +152,14 @@ format_thread_json (const void *ctx,
 
     printf ("\"thread\": %s,\n"
 	    "\"timestamp\": %ld,\n"
+	    "\"date_relative\": %s,\n"
 	    "\"matched\": %d,\n"
 	    "\"total\": %d,\n"
 	    "\"authors\": %s,\n"
 	    "\"subject\": %s,\n",
 	    json_quote_str (ctx_quote, thread_id),
 	    date,
+	    json_quote_str (ctx_quote, notmuch_time_relative_date (ctx, date)),
 	    matched,
 	    total,
 	    json_quote_str (ctx_quote, authors),
-- 
1.7.2.3

[PATCH 2/3] test: Expect `date_relative' in JSON search output.

[David Edmondson]

---
 test/json |    2 ++
 1 files changed, 2 insertions(+), 0 deletions(-)

diff --git a/test/json b/test/json
index 7fe2a27..c0ff22d 100755
--- a/test/json
+++ b/test/json
@@ -12,6 +12,7 @@ add_message "[subject]=\"json-search-subject\"" "[date]=\"Sat, 01 Jan 2000 12:00
 output=$(notmuch search --format=json "json-search-message" | notmuch_search_sanitize)
 test_expect_equal "$output" "[{\"thread\": \"XXX\",
 \"timestamp\": 946728000,
+\"date_relative\": \"2000-01-01\",
 \"matched\": 1,
 \"total\": 1,
 \"authors\": \"Notmuch Test Suite\",
@@ -33,6 +34,7 @@ add_message "[subject]=\"json-search-utf8-body-sübjéct\"" "[date]=\"Sat, 01 Ja
 output=$(notmuch search --format=json "jsön-search-méssage" | notmuch_search_sanitize)
 test_expect_equal "$output" "[{\"thread\": \"XXX\",
 \"timestamp\": 946728000,
+\"date_relative\": \"2000-01-01\",
 \"matched\": 1,
 \"total\": 1,
 \"authors\": \"Notmuch Test Suite\",
-- 
1.7.2.3

[PATCH 3/3] emacs: Use JSON output for search.

[David Edmondson]

Switch to using the JSON format output of `notmuch search' to avoid
problems parsing the output text. In particular, a comma in the name
of an author would confuse the previous implementation.
---
 emacs/notmuch.el |  114 +++++++++++++++++++++++++++++++++++++-----------------
 1 files changed, 78 insertions(+), 36 deletions(-)

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 5933747..bde8c47 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -50,6 +50,7 @@
 (eval-when-compile (require 'cl))
 (require 'mm-view)
 (require 'message)
+(require 'json)
 
 (require 'notmuch-lib)
 (require 'notmuch-show)
@@ -698,40 +699,81 @@ foreground and blue background."
 	  do (notmuch-search-insert-field field date count authors subject tags)))
   (insert "\n"))
 
+(defun notmuch-search-process-insert-object (object)
+  (let* ((thread-id (concat "thread:" (cdr (assoc 'thread object))))
+	 (date (format "%12s" (cdr (assoc 'date_relative object))))
+	 (count (format "[%d/%d]"
+			(cdr (assoc 'matched object))
+			(cdr (assoc 'total object))))
+	 (authors (cdr (assoc 'authors object)))
+	 (subject (cdr (assoc 'subject object)))
+	 (tag-list (cdr (assoc 'tags object)))
+	 (tags (mapconcat 'identity tag-list " "))
+	 (beg (point-marker)))
+    (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-authors authors)
+    (put-text-property beg (point-marker) 'notmuch-search-subject subject)))
+
+(defvar notmuch-search-parse-start nil)
+(make-variable-buffer-local 'notmuch-show-parse-start)
+
+(defun notmuch-search-process-insert (proc buffer string)
+  (with-current-buffer buffer
+    (let ((inhibit-read-only t)
+	  (inhibit-redisplay t)
+	  ;; Vectors are not as useful here.
+	  (json-array-type 'list)
+	  object)
+      (save-excursion
+	;; Insert the text, advancing the process marker
+	(goto-char (point-max))
+	(insert string)
+	(set-marker (process-mark proc) (point)))
+
+      (save-excursion
+	(goto-char notmuch-search-parse-start)
+	(condition-case nil
+	    (while
+		(cond
+		 ;; Opening bracket or comma separator between
+		 ;; objects.
+		 ((or (char-equal (json-peek) ?\[)
+		      (char-equal (json-peek) ?\,))
+		  (json-advance)
+		  (delete-region notmuch-search-parse-start (point))
+		  t)
+
+		 ;; Closing array.
+		 ((char-equal (json-peek) ?\])
+		  ;; Consume both the closing bracket and any trailing
+		  ;; whitespace (typically a carriage return).
+		  (json-advance)
+		  (json-skip-whitespace)
+		  (delete-region notmuch-search-parse-start (point))
+		  nil)
+
+		 ;; Single object.
+		 ((setq object (json-read-object))
+		  ;; Delete the object that we consumed.
+		  (delete-region notmuch-search-parse-start (point))
+		  ;; Insert the corresponding results.
+		  (notmuch-search-process-insert-object object)
+		  t))
+	      ;; Consume any white space between terms.
+	      (let ((p (point)))
+		(json-skip-whitespace)
+		(delete-region p (point)))
+	      ;; Remember where we got up to.
+	      (setq notmuch-search-parse-start (point)))
+	  (error nil))))))
+
 (defun notmuch-search-process-filter (proc string)
-  "Process and filter the output of \"notmuch search\""
-  (let ((buffer (process-buffer proc))
-	(found-target nil))
+  "Process and filter the output of `notmuch search'."
+  (let ((buffer (process-buffer proc)))
     (if (buffer-live-p buffer)
-	(with-current-buffer buffer
-	  (save-excursion
-	    (let ((line 0)
-		  (more t)
-		  (inhibit-read-only t))
-	      (while more
-		(if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\([^][]*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" 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))
-			   (tag-list (if tags (save-match-data (split-string tags)))))
-		      (goto-char (point-max))
-		      (let ((beg (point-marker)))
-			(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-authors authors)
-			(put-text-property beg (point-marker) 'notmuch-search-subject subject)
-			(if (string= thread-id notmuch-search-target-thread)
-			    (progn
-			      (set 'found-target beg)
-			      (set 'notmuch-search-target-thread "found"))))
-		      (set 'line (match-end 0)))
-		  (set 'more nil)))))
-	  (if found-target
-	      (goto-char found-target)))
+	(notmuch-search-process-insert proc buffer string)
       (delete-process proc))))
 
 (defun notmuch-search-operate-all (action)
@@ -806,15 +848,15 @@ The optional parameters are used as follows:
     (set 'notmuch-search-continuation continuation)
     (let ((proc (get-buffer-process (current-buffer)))
 	  (inhibit-read-only t))
-      (if proc
-	  (error "notmuch search process already running for query `%s'" query)
-	)
+      (when proc
+	(error "notmuch search process already running for query `%s'" query))
       (erase-buffer)
-      (goto-char (point-min))
+      (setq notmuch-search-parse-start (point-min))
       (save-excursion
 	(let ((proc (start-process
 		     "notmuch-search" buffer
 		     notmuch-command "search"
+		     "--format=json"
 		     (if oldest-first
 			 "--sort=oldest-first"
 		       "--sort=newest-first")
-- 
1.7.2.3

[PATCH 1/4] emacs: JSON based search improvements.

[David Edmondson]

Fix variable name typos.

Attempt to avoid display flashing by removing newlines from the
inserted string.

Ease debugging by moving the `condition-case' closer into the code
that it is really intended to cover (the parsing of the JSON object),
allowing errors in the remaining code to still fire correctly. As a
consequence, test for :json-eof when examining the next character to
be parsed, as that throws an error that was previously covered by the
`condition-case'.
---
 emacs/notmuch.el |   74 ++++++++++++++++++++++++++++++-----------------------
 1 files changed, 42 insertions(+), 32 deletions(-)

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index bde8c47..f4aefc8 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -717,57 +717,67 @@ foreground and blue background."
     (put-text-property beg (point-marker) 'notmuch-search-subject subject)))
 
 (defvar notmuch-search-parse-start nil)
-(make-variable-buffer-local 'notmuch-show-parse-start)
+(make-variable-buffer-local 'notmuch-search-parse-start)
 
 (defun notmuch-search-process-insert (proc buffer string)
   (with-current-buffer buffer
     (let ((inhibit-read-only t)
 	  (inhibit-redisplay t)
 	  ;; Vectors are not as useful here.
-	  (json-array-type 'list)
-	  object)
+	  (json-array-type 'list))
       (save-excursion
 	;; Insert the text, advancing the process marker
 	(goto-char (point-max))
-	(insert string)
+	;; Flatten the string (remove newlines) to reduce the flashing
+	;; that occurs when we insert the multi-line object and then
+	;; replace it with a single line summary. This is safe because
+	;; we know that none of the JSON fields can contain newlines -
+	;; only the whitespace between fields.
+	(insert (replace-regexp-in-string "\n" "" string))
 	(set-marker (process-mark proc) (point)))
 
       (save-excursion
 	(goto-char notmuch-search-parse-start)
-	(condition-case nil
 	    (while
-		(cond
-		 ;; Opening bracket or comma separator between
-		 ;; objects.
-		 ((or (char-equal (json-peek) ?\[)
-		      (char-equal (json-peek) ?\,))
-		  (json-advance)
-		  (delete-region notmuch-search-parse-start (point))
-		  t)
-
-		 ;; Closing array.
-		 ((char-equal (json-peek) ?\])
-		  ;; Consume both the closing bracket and any trailing
-		  ;; whitespace (typically a carriage return).
-		  (json-advance)
-		  (json-skip-whitespace)
-		  (delete-region notmuch-search-parse-start (point))
-		  nil)
-
-		 ;; Single object.
-		 ((setq object (json-read-object))
-		  ;; Delete the object that we consumed.
-		  (delete-region notmuch-search-parse-start (point))
-		  ;; Insert the corresponding results.
-		  (notmuch-search-process-insert-object object)
-		  t))
+		(let ((next-char (json-peek)))
+		  (cond
+		   ;; No more data (yet).
+		   ((eq next-char :json-eof)
+		    nil)
+
+		   ;; Opening bracket or comma separator between
+		   ;; objects.
+		   ((or (char-equal next-char ?\[)
+			(char-equal next-char ?\,))
+		    (json-advance)
+		    (delete-region notmuch-search-parse-start (point))
+		    t)
+
+		   ;; Closing array.
+		   ((char-equal next-char ?\])
+		    ;; Consume both the closing bracket and any trailing
+		    ;; whitespace (typically a carriage return).
+		    (json-advance)
+		    (json-skip-whitespace)
+		    (delete-region notmuch-search-parse-start (point))
+		    nil)
+
+		   ;; Single object.
+		   ((condition-case nil
+			(let ((object (json-read-object)))
+			  ;; Delete the object that we consumed.
+			  (delete-region notmuch-search-parse-start (point))
+			  ;; Insert the corresponding results.
+			  (notmuch-search-process-insert-object object)
+			  t)
+		      (error nil)))))
+
 	      ;; Consume any white space between terms.
 	      (let ((p (point)))
 		(json-skip-whitespace)
 		(delete-region p (point)))
 	      ;; Remember where we got up to.
-	      (setq notmuch-search-parse-start (point)))
-	  (error nil))))))
+	      (setq notmuch-search-parse-start (point)))))))
 
 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of `notmuch search'."
-- 
1.7.2.3

[PATCH 2/4] emacs: Use a plists rather than an assoc list in JSON search.

[David Edmondson]

For commonality with the `notmuch-show' code, prefer plists over
associative lists.
---
 emacs/notmuch.el |   17 +++++++++--------
 1 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index f4aefc8..d561c6e 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -700,14 +700,14 @@ foreground and blue background."
   (insert "\n"))
 
 (defun notmuch-search-process-insert-object (object)
-  (let* ((thread-id (concat "thread:" (cdr (assoc 'thread object))))
-	 (date (format "%12s" (cdr (assoc 'date_relative object))))
+  (let* ((thread-id (concat "thread:" (plist-get object :thread)))
+	 (date (format "%12s" (plist-get object :date_relative)))
 	 (count (format "[%d/%d]"
-			(cdr (assoc 'matched object))
-			(cdr (assoc 'total object))))
-	 (authors (cdr (assoc 'authors object)))
-	 (subject (cdr (assoc 'subject object)))
-	 (tag-list (cdr (assoc 'tags object)))
+			(plist-get object :matched)
+			(plist-get object :total)))
+	 (authors (plist-get object :authors))
+	 (subject (plist-get object :subject))
+	 (tag-list (plist-get object :tags))
 	 (tags (mapconcat 'identity tag-list " "))
 	 (beg (point-marker)))
     (notmuch-search-show-result date count authors subject tags)
@@ -724,7 +724,8 @@ foreground and blue background."
     (let ((inhibit-read-only t)
 	  (inhibit-redisplay t)
 	  ;; Vectors are not as useful here.
-	  (json-array-type 'list))
+	  (json-array-type 'list)
+	  (json-object-type 'plist))
       (save-excursion
 	;; Insert the text, advancing the process marker
 	(goto-char (point-max))
-- 
1.7.2.3

[PATCH 3/4] test: Add tests for JSON parsing of search results.

[David Edmondson]

Two cases:
- simple insertion of a record,
- insertion of a single record in two chunks.
---
 emacs/notmuch-test.el |   70 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 70 insertions(+), 0 deletions(-)

diff --git a/emacs/notmuch-test.el b/emacs/notmuch-test.el
index 8f76164..f08a53c 100644
--- a/emacs/notmuch-test.el
+++ b/emacs/notmuch-test.el
@@ -185,6 +185,76 @@ Presumes that the email corpus is already present."
 
 ;;
 
+(require 'notmuch)
+
+(defvar notmuch-test-json-1
+  "[{\"thread\": \"XXX\",
+\"timestamp\": 946728000,
+\"date_relative\": \"2000-01-01\",
+\"matched\": 1,
+\"total\": 1,
+\"authors\": \"Notmuch Test Suite\",
+\"subject\": \"json-search-subject\",
+\"tags\": [\"inbox\", \"unread\"]}]
+")
+
+(defvar notmuch-test-json-1-result
+  "XXX:2000-01-01:Notmuch Test Suite:json-search-subject:946728000:1:1:inbox:unread\n")
+
+(defun notmuch-test-search-process-insert-object (object)
+  (insert
+   (concat
+    (mapconcat (lambda (field)
+		 (plist-get object field))
+	       '(:thread :date_relative :authors :subject)
+	       ":")
+    ":"
+    (mapconcat (lambda (field)
+		 (format "%d" (plist-get object field)))
+	       '(:timestamp :matched :total)
+	       ":")
+    ":"
+    (mapconcat 'identity
+	       (plist-get object :tags)
+	       ":")
+    "\n")))
+
+(ert-deftest notmuch-search-process-insert ()
+  ;; Fake out a few things that `notmuch-search-process-insert' uses.
+  (flet ((set-marker (proc pos))
+	 (process-mark (proc) nil)
+	 (notmuch-search-process-insert-object (object)
+					       (notmuch-test-search-process-insert-object object)))
+
+    ;; Simplest case - a single record delivered in one chunk.
+    (should
+     (string= notmuch-test-json-1-result
+	      (notmuch-temp-buffer-as-string
+	       (let ((notmuch-search-parse-start (point-min)))
+		 (notmuch-search-process-insert
+		  nil (current-buffer)
+		  notmuch-test-json-1)))))
+
+    ;; A single record delivered in two chunks.
+    (should
+     (string= notmuch-test-json-1-result
+	      (notmuch-temp-buffer-as-string
+	       (let ((notmuch-search-parse-start (point-min))
+		     (half (/ (length notmuch-test-json-1)
+			      2)))
+		 ;; Insert first half.
+		 (notmuch-search-process-insert
+		  nil (current-buffer)
+		  (substring notmuch-test-json-1 0 half))
+		 ;; Insert second half.
+		 (notmuch-search-process-insert
+		  nil (current-buffer)
+		  (substring notmuch-test-json-1 half))))))
+
+    ))
+
+;;
+
 (defun notmuch-test-batch ()
   "Run the notmuch ERT tests in batch mode."
 
-- 
1.7.2.3

[PATCH 4/4] emacs: Fix indentation, add comments.

[David Edmondson]

`inhibit-redisplay' makes debugging hard - note this in a comment.
---
 emacs/notmuch.el |   81 ++++++++++++++++++++++++++++--------------------------
 1 files changed, 42 insertions(+), 39 deletions(-)

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index d561c6e..20d954b 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -722,10 +722,13 @@ foreground and blue background."
 (defun notmuch-search-process-insert (proc buffer string)
   (with-current-buffer buffer
     (let ((inhibit-read-only t)
+	  ;; Comment out this next line to allow useful single-step
+	  ;; during debugging.
 	  (inhibit-redisplay t)
 	  ;; Vectors are not as useful here.
 	  (json-array-type 'list)
 	  (json-object-type 'plist))
+
       (save-excursion
 	;; Insert the text, advancing the process marker
 	(goto-char (point-max))
@@ -739,46 +742,46 @@ foreground and blue background."
 
       (save-excursion
 	(goto-char notmuch-search-parse-start)
-	    (while
-		(let ((next-char (json-peek)))
-		  (cond
-		   ;; No more data (yet).
-		   ((eq next-char :json-eof)
-		    nil)
-
-		   ;; Opening bracket or comma separator between
-		   ;; objects.
-		   ((or (char-equal next-char ?\[)
-			(char-equal next-char ?\,))
-		    (json-advance)
-		    (delete-region notmuch-search-parse-start (point))
-		    t)
-
-		   ;; Closing array.
-		   ((char-equal next-char ?\])
-		    ;; Consume both the closing bracket and any trailing
-		    ;; whitespace (typically a carriage return).
-		    (json-advance)
-		    (json-skip-whitespace)
-		    (delete-region notmuch-search-parse-start (point))
-		    nil)
-
-		   ;; Single object.
-		   ((condition-case nil
-			(let ((object (json-read-object)))
-			  ;; Delete the object that we consumed.
-			  (delete-region notmuch-search-parse-start (point))
-			  ;; Insert the corresponding results.
-			  (notmuch-search-process-insert-object object)
-			  t)
-		      (error nil)))))
-
-	      ;; Consume any white space between terms.
-	      (let ((p (point)))
+	(while
+	    (let ((next-char (json-peek)))
+	      (cond
+	       ;; No more data (yet).
+	       ((eq next-char :json-eof)
+		nil)
+
+	       ;; Opening bracket or comma separator between
+	       ;; objects.
+	       ((or (char-equal next-char ?\[)
+		    (char-equal next-char ?\,))
+		(json-advance)
+		(delete-region notmuch-search-parse-start (point))
+		t)
+
+	       ;; Closing array.
+	       ((char-equal next-char ?\])
+		;; Consume both the closing bracket and any trailing
+		;; whitespace (typically a carriage return).
+		(json-advance)
 		(json-skip-whitespace)
-		(delete-region p (point)))
-	      ;; Remember where we got up to.
-	      (setq notmuch-search-parse-start (point)))))))
+		(delete-region notmuch-search-parse-start (point))
+		nil)
+
+	       ;; Single object.
+	       ((condition-case nil
+		    (let ((object (json-read-object)))
+		      ;; Delete the object that we consumed.
+		      (delete-region notmuch-search-parse-start (point))
+		      ;; Insert the corresponding results.
+		      (notmuch-search-process-insert-object object)
+		      t)
+		  (error nil)))))
+
+	  ;; Consume any white space between terms.
+	  (let ((p (point)))
+	    (json-skip-whitespace)
+	    (delete-region p (point)))
+	  ;; Remember where we got up to.
+	  (setq notmuch-search-parse-start (point)))))))
 
 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of `notmuch search'."
-- 
1.7.2.3