lib: catch error from closed db in n_m_get_message_id

[notmuch] / emacs / notmuch-lib.el

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 1f743eff7f1abf5e036a7be5e8c972af6169df16..0bb08eb26ad46d372b5802ecafc9e49d8b1bd94c 100644 (file)
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -23,10 +23,12 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'cl-lib)
+

 (require 'mm-util)
 (require 'mm-view)
 (require 'mm-decode)
 (require 'mm-util)
 (require 'mm-view)
 (require 'mm-decode)

-(require 'cl)
+

 (require 'notmuch-compat)
 
 (unless (require 'notmuch-version nil t)
 (require 'notmuch-compat)
 
 (unless (require 'notmuch-version nil t)


@@ -153,8 +155,11 @@ For example, if you wanted to remove an \"inbox\" tag and add an
     (define-key map "?" 'notmuch-help)
     (define-key map "q" 'notmuch-bury-or-kill-this-buffer)
     (define-key map "s" 'notmuch-search)
     (define-key map "?" 'notmuch-help)
     (define-key map "q" 'notmuch-bury-or-kill-this-buffer)
     (define-key map "s" 'notmuch-search)

+    (define-key map "t" 'notmuch-search-by-tag)

     (define-key map "z" 'notmuch-tree)
     (define-key map "z" 'notmuch-tree)

+    (define-key map "u" 'notmuch-unthreaded)

     (define-key map "m" 'notmuch-mua-new-mail)
     (define-key map "m" 'notmuch-mua-new-mail)

+    (define-key map "g" 'notmuch-refresh-this-buffer)

     (define-key map "=" 'notmuch-refresh-this-buffer)
     (define-key map (kbd "M-=") 'notmuch-refresh-all-buffers)
     (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)
     (define-key map "=" 'notmuch-refresh-this-buffer)
     (define-key map (kbd "M-=") 'notmuch-refresh-all-buffers)
     (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)


@@ -184,7 +189,7 @@ 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.
 
 will appear in a buffer named \"*Notmuch errors*\" and an error
 will be signaled.
 

-Otherwise the output will be returned"
+Otherwise the output will be returned."

   (with-temp-buffer
     (let* ((status (apply #'call-process notmuch-command nil t nil args))
           (output (buffer-string)))
   (with-temp-buffer
     (let* ((status (apply #'call-process notmuch-command nil t nil args))
           (output (buffer-string)))


@@ -294,10 +299,10 @@ This is basically just `format-kbd-macro' but we also convert ESC to M-."
 
 
 (defun notmuch-describe-key (actual-key binding prefix ua-keys tail)
 
 
 (defun notmuch-describe-key (actual-key binding prefix ua-keys tail)

-  "Prepend cons cells describing prefix-arg ACTUAL-KEY and ACTUAL-KEY to TAIL
+  "Prepend cons cells describing prefix-arg ACTUAL-KEY and ACTUAL-KEY to TAIL.

 
 It does not prepend if ACTUAL-KEY is already listed in TAIL."
 
 It does not prepend if ACTUAL-KEY is already listed in TAIL."

-  (let ((key-string (concat prefix (format-kbd-macro actual-key))))
+  (let ((key-string (concat prefix (key-description actual-key))))

     ;; We don't include documentation if the key-binding is
     ;; over-ridden. Note, over-riding a binding automatically hides the
     ;; prefixed version too.
     ;; We don't include documentation if the key-binding is
     ;; over-ridden. Note, over-riding a binding automatically hides the
     ;; prefixed version too.


@@ -312,7 +317,7 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL."
       ;; Documentation for command
       (push (cons key-string
                  (or (and (symbolp binding) (get binding 'notmuch-doc))
       ;; Documentation for command
       (push (cons key-string
                  (or (and (symbolp binding) (get binding 'notmuch-doc))

-                     (notmuch-documentation-first-line binding)))
+                     (and (functionp binding) (notmuch-documentation-first-line binding))))

            tail)))
     tail)
 
            tail)))
     tail)
 


@@ -525,11 +530,11 @@ This replaces spaces, percents, and double quotes in STR with
     (cdr xplist)))
 
 (defun notmuch-split-content-type (content-type)
     (cdr xplist)))
 
 (defun notmuch-split-content-type (content-type)

-  "Split content/type into 'content' and 'type'"
+  "Split content/type into 'content' and 'type'."

   (split-string content-type "/"))
 
 (defun notmuch-match-content-type (t1 t2)
   (split-string content-type "/"))
 
 (defun notmuch-match-content-type (t1 t2)

-  "Return t if t1 and t2 are matching content types, taking wildcards into account"
+  "Return t if t1 and t2 are matching content types, taking wildcards into account."

   (let ((st1 (notmuch-split-content-type t1))
        (st2 (notmuch-split-content-type t2)))
     (if (or (string= (cadr st1) "*")
   (let ((st1 (notmuch-split-content-type t1))
        (st2 (notmuch-split-content-type t2)))
     (if (or (string= (cadr st1) "*")


@@ -571,7 +576,7 @@ for this message, if present."
 (defun notmuch-parts-filter-by-type (parts type)
   "Given a list of message parts, return a list containing the ones matching
 the given type."
 (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
+  (cl-remove-if-not

    (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
    parts))
 
    (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
    parts))
 


@@ -593,7 +598,7 @@ the given type."
                       (set-buffer-multibyte nil))
                     (let ((args `("show" "--format=raw"
                                   ,(format "--part=%s" (plist-get part :id))
                       (set-buffer-multibyte nil))
                     (let ((args `("show" "--format=raw"
                                   ,(format "--part=%s" (plist-get part :id))

-                                  ,@(when process-crypto '("--decrypt"))
+                                  ,@(when process-crypto '("--decrypt=true"))

                                   ,(notmuch-id-to-query (plist-get msg :id))))
                           (coding-system-for-read
                            (if binaryp 'no-conversion
                                   ,(notmuch-id-to-query (plist-get msg :id))))
                           (coding-system-for-read
                            (if binaryp 'no-conversion


@@ -682,8 +687,8 @@ current buffer, if possible."
 ;; 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)
 ;; 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 (intern (substring (symbol-name key) 1)) value)))
+  (cl-loop for (key value . rest) on plist by #'cddr
+          collect (cons (intern (substring (symbol-name key) 1)) value)))

 
 (defun notmuch-face-ensure-list-form (face)
   "Return FACE in face list form.
 
 (defun notmuch-face-ensure-list-form (face)
   "Return FACE in face list form.


@@ -777,7 +782,7 @@ arguments passed to the sentinel.  COMMAND and ERR, if provided,
 are passed to `notmuch-check-exit-status'.  If COMMAND is not
 provided, it is taken from `process-command'."
   (let ((exit-status
 are passed to `notmuch-check-exit-status'.  If COMMAND is not
 provided, it is taken from `process-command'."
   (let ((exit-status

-        (case (process-status proc)
+        (cl-case (process-status proc)

           ((exit) (process-exit-status proc))
           ((signal) msg))))
     (when exit-status
           ((exit) (process-exit-status proc))
           ((signal) msg))))
     (when exit-status


@@ -845,7 +850,7 @@ for `call-process'.  ARGS is as described for
 
   (let (stdin-string)
     (while (keywordp (car args))
 
   (let (stdin-string)
     (while (keywordp (car args))

-      (case (car args)
+      (cl-case (car args)

        (:stdin-string (setq stdin-string (cadr args)
                             args (cddr args)))
        (otherwise
        (:stdin-string (setq stdin-string (cadr args)
                             args (cddr args)))
        (otherwise


@@ -909,21 +914,44 @@ invoke `set-process-sentinel' directly on the returned process,
 as that will interfere with the handling of stderr and the exit
 status."
 
 as that will interfere with the handling of stderr and the exit
 status."
 

-  ;; There is no way (as of Emacs 24.3) to capture stdout and stderr
-  ;; separately for asynchronous processes, or even to redirect stderr
-  ;; to a file, so we use a trivial shell wrapper to send stderr to a
-  ;; temporary file and clean things up in the sentinel.
-  (let* ((err-file (make-temp-file "nmerr"))
-        ;; Use a pipe
-        (process-connection-type nil)
-        ;; Find notmuch using Emacs' `exec-path'
-        (command (or (executable-find notmuch-command)
-                     (error "command not found: %s" notmuch-command)))
-        (proc (apply #'start-process name buffer
-                     "/bin/sh" "-c"
-                     "exec 2>\"$1\"; shift; exec \"$0\" \"$@\""
-                     command err-file args)))
-    (process-put proc 'err-file err-file)
+  (let (err-file err-buffer proc err-proc
+       ;; Find notmuch using Emacs' `exec-path'
+       (command (or (executable-find notmuch-command)
+                    (error "Command not found: %s" notmuch-command))))
+    (if (fboundp 'make-process)
+       (progn
+         (setq err-buffer (generate-new-buffer " *notmuch-stderr*"))
+         ;; Emacs 25 and newer has `make-process', which allows
+         ;; redirecting stderr independently from stdout to a
+         ;; separate buffer. As this allows us to avoid using a
+         ;; temporary file and shell invocation, use it when
+         ;; available.
+         (setq proc (make-process
+                     :name name
+                     :buffer buffer
+                     :command (cons command args)
+                     :connection-type 'pipe
+                     :stderr err-buffer)
+               err-proc (get-buffer-process err-buffer))
+         (process-put proc 'err-buffer err-buffer)
+
+         (process-put err-proc 'err-file err-file)
+         (process-put err-proc 'err-buffer err-buffer)
+         (set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel))
+
+      ;; On Emacs versions before 25, there is no way to capture
+      ;; stdout and stderr separately for asynchronous processes, or
+      ;; even to redirect stderr to a file, so we use a trivial shell
+      ;; wrapper to send stderr to a temporary file and clean things
+      ;; up in the sentinel.
+      (setq err-file (make-temp-file "nmerr"))
+      (let ((process-connection-type nil)) ;; Use a pipe
+       (setq proc (apply #'start-process name buffer
+                         "/bin/sh" "-c"
+                         "exec 2>\"$1\"; shift; exec \"$0\" \"$@\""
+                         command err-file args)))
+      (process-put proc 'err-file err-file))
+

     (process-put proc 'sub-sentinel sentinel)
     (process-put proc 'real-command (cons notmuch-command args))
     (set-process-sentinel proc #'notmuch-start-notmuch-sentinel)
     (process-put proc 'sub-sentinel sentinel)
     (process-put proc 'real-command (cons notmuch-command args))
     (set-process-sentinel proc #'notmuch-start-notmuch-sentinel)


@@ -932,10 +960,10 @@ status."
 (defun notmuch-start-notmuch-sentinel (proc event)
   "Process sentinel function used by `notmuch-start-notmuch'."
   (let* ((err-file (process-get proc 'err-file))
 (defun notmuch-start-notmuch-sentinel (proc event)
   "Process sentinel function used by `notmuch-start-notmuch'."
   (let* ((err-file (process-get proc 'err-file))

-        (err (with-temp-buffer
-               (insert-file-contents err-file)
-               (unless (eobp)
-                 (buffer-string))))
+        (err-buffer (or (process-get proc 'err-buffer)
+                        (find-file-noselect err-file)))
+        (err (when (not (zerop (buffer-size err-buffer)))
+               (with-current-buffer err-buffer (buffer-string))))

         (sub-sentinel (process-get proc 'sub-sentinel))
         (real-command (process-get proc 'real-command)))
     (condition-case err
         (sub-sentinel (process-get proc 'sub-sentinel))
         (real-command (process-get proc 'real-command)))
     (condition-case err


@@ -953,8 +981,8 @@ status."
          ;; If that didn't signal an error, then any error output was
          ;; really warning output.  Show warnings, if any.
          (let ((warnings
          ;; If that didn't signal an error, then any error output was
          ;; really warning output.  Show warnings, if any.
          (let ((warnings

-                (with-temp-buffer
-                  (unless (= (second (insert-file-contents err-file)) 0)
+                (when err
+                  (with-current-buffer err-buffer

                     (goto-char (point-min))
                     (end-of-line)
                     ;; Show first line; stuff remaining lines in the
                     (goto-char (point-min))
                     (end-of-line)
                     ;; Show first line; stuff remaining lines in the


@@ -969,17 +997,35 @@ status."
        ;; Emacs behaves strangely if an error escapes from a sentinel,
        ;; so turn errors into messages.
        (message "%s" (error-message-string err))))
        ;; Emacs behaves strangely if an error escapes from a sentinel,
        ;; so turn errors into messages.
        (message "%s" (error-message-string err))))

-    (ignore-errors (delete-file err-file))))
+    (when err-file (ignore-errors (delete-file err-file)))))
+
+(defun notmuch-start-notmuch-error-sentinel (proc event)
+  (let* ((err-file (process-get proc 'err-file))
+        ;; When `make-process' is available, use the error buffer
+        ;; associated with the process, otherwise the error file.
+        (err-buffer (or (process-get proc 'err-buffer)
+                        (find-file-noselect err-file))))
+    (when err-buffer (kill-buffer err-buffer))))

 
 ;; This variable is used only buffer local, but it needs to be
 ;; declared globally first to avoid compiler warnings.
 (defvar notmuch-show-process-crypto nil)
 (make-variable-buffer-local 'notmuch-show-process-crypto)
 
 
 ;; This variable is used only buffer local, but it needs to be
 ;; declared globally first to avoid compiler warnings.
 (defvar notmuch-show-process-crypto nil)
 (make-variable-buffer-local 'notmuch-show-process-crypto)
 

-(provide 'notmuch-lib)
+(defun notmuch-interactive-region ()
+  "Return the bounds of the current interactive region.
+
+This returns (BEG END), where BEG and END are the bounds of the
+region if the region is active, or both `point' otherwise."
+  (if (region-active-p)
+      (list (region-beginning) (region-end))
+    (list (point) (point))))

 
 

-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
+(define-obsolete-function-alias
+    'notmuch-search-interactive-region
+    'notmuch-interactive-region
+  "notmuch 0.29")
+
+(provide 'notmuch-lib)

 
 ;;; notmuch-lib.el ends here
 
 ;;; notmuch-lib.el ends here