emacs: Don't report CLI signals sent by Emacs as errors

[notmuch] / emacs / notmuch.el

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 428b0117fadcba0a00b0526a685a3ba09e142292..7994d742f7fc702ef77843af4efbefa4a2bd5da3 100644 (file)
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -58,6 +58,7 @@
 (require 'notmuch-hello)
 (require 'notmuch-maildir-fcc)
 (require 'notmuch-message)
 (require 'notmuch-hello)
 (require 'notmuch-maildir-fcc)
 (require 'notmuch-message)

+(require 'notmuch-parser)

 
 (defcustom notmuch-search-result-format
   `(("date" . "%12s ")
 
 (defcustom notmuch-search-result-format
   `(("date" . "%12s ")


@@ -385,17 +386,22 @@ number of matched messages and total messages in the thread,
 participants in the thread, a representative subject line, and
 any tags).
 
 participants in the thread, a representative subject line, and
 any tags).
 

-Pressing \\[notmuch-search-show-thread] on any line displays that thread. The '\\[notmuch-search-add-tag]' and '\\[notmuch-search-remove-tag]'
-keys can be used to add or remove tags from a thread. The '\\[notmuch-search-archive-thread]' key
-is a convenience for archiving a thread (removing the \"inbox\"
-tag). The '\\[notmuch-search-tag-all]' key can be used to add and/or remove tags from all
-messages (as opposed to threads) that match the current query.  Use with caution, as this
-will also tag matching messages that arrived *after* constructing the buffer.
-
-Other useful commands are '\\[notmuch-search-filter]' for filtering the current search
-based on an additional query string, '\\[notmuch-search-filter-by-tag]' for filtering to include
-only messages with a given tag, and '\\[notmuch-search]' to execute a new, global
-search.
+Pressing \\[notmuch-search-show-thread] on any line displays that
+thread. The '\\[notmuch-search-add-tag]' and
+'\\[notmuch-search-remove-tag]' keys can be used to add or remove
+tags from a thread. The '\\[notmuch-search-archive-thread]' key
+is a convenience for archiving a thread (applying changes in
+`notmuch-archive-tags'). The '\\[notmuch-search-tag-all]' key can
+be used to add and/or remove tags from all messages (as opposed
+to threads) that match the current query.  Use with caution, as
+this will also tag matching messages that arrived *after*
+constructing the buffer.
+
+Other useful commands are '\\[notmuch-search-filter]' for
+filtering the current search based on an additional query string,
+'\\[notmuch-search-filter-by-tag]' for filtering to include only
+messages with a given tag, and '\\[notmuch-search]' to execute a
+new, global search.

 
 Complete list of currently available key bindings:
 
 
 Complete list of currently available key bindings:
 


@@ -536,19 +542,13 @@ If BARE is set then do not prefix with \"thread:\""
 (defun notmuch-call-notmuch-process (&rest args)
   "Synchronously invoke \"notmuch\" with the given list of arguments.
 
 (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))
-           ))))))
+If notmuch exits with a non-zero status, output from the process
+will appear in a buffer named \"*Notmuch errors*\" and an error
+will be signaled."
+  (with-temp-buffer
+    (let ((status (apply #'call-process notmuch-command nil t nil args)))
+      (notmuch-check-exit-status status (cons notmuch-command args)
+                                (buffer-string)))))

 
 (defun notmuch-search-set-tags (tags &optional pos)
   (let ((new-result (plist-put (notmuch-search-get-result pos) :tags tags)))
 
 (defun notmuch-search-set-tags (tags &optional pos)
   (let ((new-result (plist-put (notmuch-search-get-result pos) :tags tags)))


@@ -567,7 +567,7 @@ and will also appear in a buffer named \"*Notmuch errors*\"."
 (defun notmuch-search-tag-region (beg end &optional tag-changes)
   "Change tags for threads in the given region."
   (let ((search-string (notmuch-search-find-thread-id-region-search beg end)))
 (defun notmuch-search-tag-region (beg end &optional tag-changes)
   "Change tags for threads in the given region."
   (let ((search-string (notmuch-search-find-thread-id-region-search beg end)))

-    (setq tag-changes (funcall 'notmuch-tag search-string tag-changes))
+    (setq tag-changes (notmuch-tag search-string tag-changes))

     (notmuch-search-foreach-result beg end
       (lambda (pos)
        (notmuch-search-set-tags
     (notmuch-search-foreach-result beg end
       (lambda (pos)
        (notmuch-search-set-tags


@@ -581,7 +581,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
   (interactive)
   (let* ((beg (if (region-active-p) (region-beginning) (point)))
         (end (if (region-active-p) (region-end) (point))))
   (interactive)
   (let* ((beg (if (region-active-p) (region-beginning) (point)))
         (end (if (region-active-p) (region-end) (point))))

-    (funcall 'notmuch-search-tag-region beg end tag-changes)))
+    (notmuch-search-tag-region beg end tag-changes)))

 
 (defun notmuch-search-add-tag ()
   "Same as `notmuch-search-tag' but sets initial input to '+'."
 
 (defun notmuch-search-add-tag ()
   "Same as `notmuch-search-tag' but sets initial input to '+'."


@@ -644,6 +644,7 @@ of the result."
        (exit-status (process-exit-status proc))
        (never-found-target-thread nil))
     (when (memq status '(exit signal))
        (exit-status (process-exit-status proc))
        (never-found-target-thread nil))
     (when (memq status '(exit signal))

+      (catch 'return

        (kill-buffer (process-get proc 'parse-buf))
        (if (buffer-live-p buffer)
            (with-current-buffer buffer
        (kill-buffer (process-get proc 'parse-buf))
        (if (buffer-live-p buffer)
            (with-current-buffer buffer


@@ -654,17 +655,19 @@ of the result."
                  (if (eq status 'signal)
                      (insert "Incomplete search results (search process was killed).\n"))
                  (when (eq status 'exit)
                  (if (eq status 'signal)
                      (insert "Incomplete search results (search process was killed).\n"))
                  (when (eq status 'exit)

-                   (insert "End of search results.")
-                   (unless (= exit-status 0)
-                     (insert (format " (process returned %d)" exit-status)))
-                   (insert "\n")
+                   (insert "End of search results.\n")
+                   ;; For version mismatch, there's no point in
+                   ;; showing the search buffer
+                   (when (or (= exit-status 20) (= exit-status 21))
+                     (kill-buffer)
+                     (throw 'return nil))

                    (if (and atbob
                             (not (string= notmuch-search-target-thread "found")))
                        (set 'never-found-target-thread t)))))
              (when (and never-found-target-thread
                       notmuch-search-target-line)
                  (goto-char (point-min))
                    (if (and atbob
                             (not (string= notmuch-search-target-thread "found")))
                        (set 'never-found-target-thread t)))))
              (when (and never-found-target-thread
                       notmuch-search-target-line)
                  (goto-char (point-min))

-                 (forward-line (1- notmuch-search-target-line))))))))
+                 (forward-line (1- notmuch-search-target-line)))))))))

 
 (defcustom notmuch-search-line-faces '(("unread" :weight bold)
                                       ("flagged" :foreground "blue"))
 
 (defcustom notmuch-search-line-faces '(("unread" :weight bold)
                                       ("flagged" :foreground "blue"))


@@ -793,9 +796,8 @@ non-authors is found, assume that all of the authors match."
     (notmuch-search-insert-authors format-string (plist-get result :authors)))
 
    ((string-equal field "tags")
     (notmuch-search-insert-authors format-string (plist-get result :authors)))
 
    ((string-equal field "tags")

-    (let ((tags-str (mapconcat 'identity (plist-get result :tags) " ")))
-      (insert (propertize (format format-string tags-str)
-                         'face 'notmuch-tag-face))))))
+    (let ((tags (plist-get result :tags)))
+      (insert (format format-string (notmuch-tag-format-tags tags)))))))

 
 (defun notmuch-search-show-result (result &optional pos)
   "Insert RESULT at POS or the end of the buffer if POS is null."
 
 (defun notmuch-search-show-result (result &optional pos)
   "Insert RESULT at POS or the end of the buffer if POS is null."


@@ -813,23 +815,6 @@ non-authors is found, assume that all of the authors match."
        (setq notmuch-search-target-thread "found")
        (goto-char beg)))))
 
        (setq notmuch-search-target-thread "found")
        (goto-char beg)))))
 

-(defun notmuch-search-show-error (string &rest objects)
-  (save-excursion
-    (goto-char (point-max))
-    (insert "Error: Unexpected output from notmuch search:\n")
-    (insert (apply #'format string objects))
-    (insert "\n")))
-
-;; These two variables are internal variables to the parsing
-;; routines. They are always used buffer local but need to be declared
-;; globally to avoid compiler warnings.
-
-(defvar notmuch-json-state nil
-  "Internal incremental JSON parser object: local to the buffer being parsed.")
-
-(defvar notmuch-json-parser nil
-  "State of the internal JSON parser: local to the buffer being parsed.")
-

 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of \"notmuch search\""
   (let ((results-buf (process-buffer proc))
 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of \"notmuch search\""
   (let ((results-buf (process-buffer proc))


@@ -843,63 +828,9 @@ non-authors is found, assume that all of the authors match."
        (save-excursion
          (goto-char (point-max))
          (insert string))
        (save-excursion
          (goto-char (point-max))
          (insert string))

-       (notmuch-json-parse-partial-list 'notmuch-search-show-result
-                                        'notmuch-search-show-error
+       (notmuch-sexp-parse-partial-list 'notmuch-search-show-result

                                         results-buf)))))
 
                                         results-buf)))))
 

-(defun notmuch-json-parse-partial-list (result-function error-function results-buf)
-  "Parse a partial JSON list from current buffer.
-
-This function consumes a JSON list from the current buffer,
-applying RESULT-FUNCTION in buffer RESULT-BUFFER to each complete
-value in the list.  It operates incrementally and should be
-called whenever the buffer has been extended with additional
-data.
-
-If there is a syntax error, this will attempt to resynchronize
-with the input and will apply ERROR-FUNCTION in buffer
-RESULT-BUFFER to any input that was skipped.
-
-It sets up all the needed internal variables: the caller just
-needs to call it with point in the same place that the parser
-left it."
-  (let (done)
-    (unless (local-variable-p 'notmuch-json-parser)
-      (set (make-local-variable 'notmuch-json-parser)
-          (notmuch-json-create-parser (current-buffer)))
-      (set (make-local-variable 'notmuch-json-state) 'begin))
-    (while (not done)
-      (condition-case nil
-         (case notmuch-json-state
-               ((begin)
-                ;; Enter the results list
-                (if (eq (notmuch-json-begin-compound
-                         notmuch-json-parser) 'retry)
-                    (setq done t)
-                  (setq notmuch-json-state 'result)))
-               ((result)
-                ;; Parse a result
-                (let ((result (notmuch-json-read notmuch-json-parser)))
-                  (case result
-                        ((retry) (setq done t))
-                        ((end) (setq notmuch-json-state 'end))
-                        (otherwise (with-current-buffer results-buf
-                                     (funcall result-function result))))))
-               ((end)
-                ;; Any trailing data is unexpected
-                (notmuch-json-eof notmuch-json-parser)
-                (setq done t)))
-       (json-error
-        ;; Do our best to resynchronize and ensure forward
-        ;; progress
-        (let ((bad (buffer-substring (line-beginning-position)
-                                     (line-end-position))))
-          (forward-line)
-          (with-current-buffer results-buf
-            (funcall error-function "%s" bad))))))
-    ;; Clear out what we've parsed
-    (delete-region (point-min) (point))))
-

 (defun notmuch-search-tag-all (&optional tag-changes)
   "Add/remove tags from all messages in current search buffer.
 
 (defun notmuch-search-tag-all (&optional tag-changes)
   "Add/remove tags from all messages in current search buffer.
 


@@ -978,9 +909,8 @@ Other optional parameters are used as follows:
   target-line: The line number to move to if the target thread does not
                appear in the search results."
   (interactive)
   target-line: The line number to move to if the target thread does not
                appear in the search results."
   (interactive)

-  (if (null query)
-      (setq query (notmuch-read-query "Notmuch search: ")))
-  (let ((buffer (get-buffer-create (notmuch-search-buffer-title query))))
+  (let* ((query (or query (notmuch-read-query "Notmuch search: ")))
+        (buffer (get-buffer-create (notmuch-search-buffer-title query))))

     (switch-to-buffer buffer)
     (notmuch-search-mode)
     ;; Don't track undo information for this buffer
     (switch-to-buffer buffer)
     (notmuch-search-mode)
     ;; Don't track undo information for this buffer


@@ -998,10 +928,9 @@ Other optional parameters are used as follows:
       (erase-buffer)
       (goto-char (point-min))
       (save-excursion
       (erase-buffer)
       (goto-char (point-min))
       (save-excursion

-       (let ((proc (start-process
-                    "notmuch-search" buffer
-                    notmuch-command "search"
-                    "--format=json"
+       (let ((proc (notmuch-start-notmuch
+                    "notmuch-search" buffer #'notmuch-search-process-sentinel
+                    "search" "--format=sexp" "--format-version=1"

                     (if oldest-first
                         "--sort=oldest-first"
                       "--sort=newest-first")
                     (if oldest-first
                         "--sort=oldest-first"
                       "--sort=newest-first")


@@ -1011,7 +940,6 @@ Other optional parameters are used as follows:
              ;; should be called no matter how the process dies.
              (parse-buf (generate-new-buffer " *notmuch search parse*")))
          (process-put proc 'parse-buf parse-buf)
              ;; should be called no matter how the process dies.
              (parse-buf (generate-new-buffer " *notmuch search parse*")))
          (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))))
     (run-hooks 'notmuch-search-hook)))
          (set-process-filter proc 'notmuch-search-process-filter)
          (set-process-query-on-exit-flag proc nil))))
     (run-hooks 'notmuch-search-hook)))