emacs: notmuch-poll: Let the user know we are polling

[notmuch] / emacs / notmuch-lib.el

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 9339f9d012e86cf34bd310752906ad1b5b0076fb..6ff351d71bb1a0e7b4658b0a62dbd3e20233c54c 100644 (file)
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -211,7 +211,7 @@ Otherwise the output will be returned."
   (unless (notmuch-cli-sane-p)
     (notmuch-logged-error
      "notmuch cli seems misconfigured or unconfigured."
   (unless (notmuch-cli-sane-p)
     (notmuch-logged-error
      "notmuch cli seems misconfigured or unconfigured."

-"Perhaps you haven't run \"notmuch setup\" yet? Try running this
+     "Perhaps you haven't run \"notmuch setup\" yet? Try running this

 on the command line, and then retry your notmuch command")))
 
 (defun notmuch-cli-version ()
 on the command line, and then retry your notmuch command")))
 
 (defun notmuch-cli-version ()


@@ -259,11 +259,13 @@ on the command line, and then retry your notmuch command")))
 Invokes `notmuch-poll-script', \"notmuch new\", or does nothing
 depending on the value of `notmuch-poll-script'."
   (interactive)
 Invokes `notmuch-poll-script', \"notmuch new\", or does nothing
 depending on the value of `notmuch-poll-script'."
   (interactive)

+  (message "Polling mail...")

   (if (stringp notmuch-poll-script)
       (unless (string= notmuch-poll-script "")
        (unless (equal (call-process notmuch-poll-script nil nil) 0)
          (error "Notmuch: poll script `%s' failed!" notmuch-poll-script)))
   (if (stringp notmuch-poll-script)
       (unless (string= notmuch-poll-script "")
        (unless (equal (call-process notmuch-poll-script nil nil) 0)
          (error "Notmuch: poll script `%s' failed!" notmuch-poll-script)))

-    (notmuch-call-notmuch-process "new")))
+    (notmuch-call-notmuch-process "new"))
+  (message "Polling mail...done"))

 
 (defun notmuch-bury-or-kill-this-buffer ()
   "Undisplay the current buffer.
 
 (defun notmuch-bury-or-kill-this-buffer ()
   "Undisplay the current buffer.


@@ -321,7 +323,7 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL."
                      (and (functionp binding)
                           (notmuch-documentation-first-line binding))))
            tail)))
                      (and (functionp binding)
                           (notmuch-documentation-first-line binding))))
            tail)))

-    tail)
+  tail)

 
 (defun notmuch-describe-remaps (remap-keymap ua-keys base-keymap prefix tail)
   ;; Remappings are represented as a binding whose first "event" is
 
 (defun notmuch-describe-remaps (remap-keymap ua-keys base-keymap prefix tail)
   ;; Remappings are represented as a binding whose first "event" is


@@ -413,12 +415,11 @@ of its command symbol."
   "Show help for a subkeymap."
   (interactive)
   (let* ((key (this-command-keys-vector))
   "Show help for a subkeymap."
   (interactive)
   (let* ((key (this-command-keys-vector))

-       (prefix (make-vector (1- (length key)) nil))
-       (i 0))
+        (prefix (make-vector (1- (length key)) nil))
+        (i 0))

     (while (< i (length prefix))
       (aset prefix i (aref key i))
       (setq i (1+ i)))
     (while (< i (length prefix))
       (aset prefix i (aref key i))
       (setq i (1+ i)))

-

     (let* ((subkeymap (key-binding prefix))
           (ua-keys (where-is-internal 'universal-argument nil t))
           (prefix-string (notmuch-prefix-key-description prefix))
     (let* ((subkeymap (key-binding prefix))
           (ua-keys (where-is-internal 'universal-argument nil t))
           (prefix-string (notmuch-prefix-key-description prefix))


@@ -486,7 +487,6 @@ This includes newlines, tabs, and other funny characters."
 The caller is responsible for prepending the term prefix and a
 colon.  This performs minimal escaping in order to produce
 user-friendly queries."
 The caller is responsible for prepending the term prefix and a
 colon.  This performs minimal escaping in order to produce
 user-friendly queries."

-

   (save-match-data
     (if (or (equal term "")
            ;; To be pessimistic, only pass through terms composed
   (save-match-data
     (if (or (equal term "")
            ;; To be pessimistic, only pass through terms composed


@@ -529,7 +529,7 @@ This replaces spaces, percents, and double quotes in STR with
   (let (out)
     (while list
       (when (funcall predicate (car list))
   (let (out)
     (while list
       (when (funcall predicate (car list))

-        (push (car list) out))
+       (push (car list) out))

       (setq list (cdr list)))
     (nreverse out)))
 
       (setq list (cdr list)))
     (nreverse out)))
 


@@ -557,13 +557,11 @@ This replaces spaces, percents, and double quotes in STR with
       (string= (downcase t1) (downcase t2)))))
 
 (defvar notmuch-multipart/alternative-discouraged
       (string= (downcase t1) (downcase t2)))))
 
 (defvar notmuch-multipart/alternative-discouraged

-  '(
-    ;; Avoid HTML parts.
+  '(;; Avoid HTML parts.

     "text/html"
     ;; multipart/related usually contain a text/html part and some
     ;; associated graphics.
     "text/html"
     ;; multipart/related usually contain a text/html part and some
     ;; associated graphics.

-    "multipart/related"
-    ))
+    "multipart/related"))

 
 (defun notmuch-multipart/alternative-determine-discouraged (msg)
   "Return the discouraged alternatives for the specified message."
 
 (defun notmuch-multipart/alternative-determine-discouraged (msg)
   "Return the discouraged alternatives for the specified message."


@@ -612,10 +610,11 @@ 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=true"))
+                                  ,@(and process-crypto '("--decrypt=true"))

                                   ,(notmuch-id-to-query (plist-get msg :id))))
                           (coding-system-for-read
                                   ,(notmuch-id-to-query (plist-get msg :id))))
                           (coding-system-for-read

-                           (if binaryp 'no-conversion
+                           (if binaryp
+                               'no-conversion

                              (let ((coding-system
                                     (mm-charset-to-coding-system
                                      (plist-get part :content-charset))))
                              (let ((coding-system
                                     (mm-charset-to-coding-system
                                      (plist-get part :content-charset))))


@@ -668,11 +667,11 @@ MSG (if it isn't already)."
 ;; first loading gnus-art, which defines it, resulting in a
 ;; void-variable error.  Hence, we advise `mm-shr' to ensure gnus-art
 ;; is loaded.
 ;; first loading gnus-art, which defines it, resulting in a
 ;; void-variable error.  Hence, we advise `mm-shr' to ensure gnus-art
 ;; is loaded.

-(if (>= emacs-major-version 24)
-    (defadvice mm-shr (before load-gnus-arts activate)
-      (require 'gnus-art nil t)
-      (ad-disable-advice 'mm-shr 'before 'load-gnus-arts)
-      (ad-activate 'mm-shr)))
+(when (>= emacs-major-version 24)
+  (defadvice mm-shr (before load-gnus-arts activate)
+    (require 'gnus-art nil t)
+    (ad-disable-advice 'mm-shr 'before 'load-gnus-arts)
+    (ad-activate 'mm-shr)))

 
 (defun notmuch-mm-display-part-inline (msg part content-type process-crypto)
   "Use the mm-decode/mm-view functions to display a part in the
 
 (defun notmuch-mm-display-part-inline (msg part content-type process-crypto)
   "Use the mm-decode/mm-view functions to display a part in the


@@ -684,7 +683,8 @@ current buffer, if possible."
       ;; `gnus-decoded' charset.  Otherwise, we'll fetch the binary
       ;; part content and let mm-* decode it.
       (let* ((have-content (plist-member part :content))
       ;; `gnus-decoded' charset.  Otherwise, we'll fetch the binary
       ;; part content and let mm-* decode it.
       (let* ((have-content (plist-member part :content))

-            (charset (if have-content 'gnus-decoded
+            (charset (if have-content
+                         'gnus-decoded

                        (plist-get part :content-charset)))
             (handle (mm-make-handle (current-buffer)
                                     `(,content-type (charset . ,charset)))))
                        (plist-get part :content-charset)))
             (handle (mm-make-handle (current-buffer)
                                     `(,content-type (charset . ,charset)))))


@@ -731,7 +731,6 @@ must be a face name (a symbol or string), a property list of face
 attributes, or a list of these.  If START and/or END are omitted,
 they default to the beginning/end of OBJECT.  For convenience
 when applied to strings, this returns OBJECT."
 attributes, or a list of these.  If START and/or END are omitted,
 they default to the beginning/end of OBJECT.  For convenience
 when applied to strings, this returns OBJECT."

-

   ;; A face property can have three forms: a face name (a string or
   ;; symbol), a property list, or a list of these two forms.  In the
   ;; list case, the faces will be combined, with the earlier faces
   ;; A face property can have three forms: a face name (a string or
   ;; symbol), a property list, or a list of these two forms.  In the
   ;; list case, the faces will be combined, with the earlier faces


@@ -774,7 +773,6 @@ This logs MSG and EXTRA to the *Notmuch errors* buffer and
 signals MSG as an error.  If EXTRA is non-nil, text referring the
 user to the *Notmuch errors* buffer will be appended to the
 signaled error.  This function does not return."
 signals MSG as an error.  If EXTRA is non-nil, text referring the
 user to the *Notmuch errors* buffer will be appended to the
 signaled error.  This function does not return."

-

   (with-current-buffer (get-buffer-create "*Notmuch errors*")
     (goto-char (point-max))
     (unless (bobp)
   (with-current-buffer (get-buffer-create "*Notmuch errors*")
     (goto-char (point-max))
     (unless (bobp)


@@ -787,8 +785,8 @@ signaled error.  This function does not return."
        (insert extra)
        (unless (bolp)
          (newline)))))
        (insert extra)
        (unless (bolp)
          (newline)))))

-  (error "%s" (concat msg (when extra
-                           " (see *Notmuch errors* for more details)"))))
+  (error "%s"
+        (concat msg (and extra " (see *Notmuch errors* for more details)"))))

 
 (defun notmuch-check-async-exit-status (proc msg &optional command err)
   "If PROC exited abnormally, pop up an error buffer and signal an error.
 
 (defun notmuch-check-async-exit-status (proc msg &optional command err)
   "If PROC exited abnormally, pop up an error buffer and signal an error.


@@ -819,7 +817,6 @@ command and its arguments.  OUTPUT, if provided, is a string
 giving the output of command.  ERR, if provided, is the error
 output of command.  OUTPUT and ERR will be included in the error
 message."
 giving the output of command.  ERR, if provided, is the error
 output of command.  OUTPUT and ERR will be included in the error
 message."

-

   (cond
    ((eq exit-status 0) t)
    ((eq exit-status 20)
   (cond
    ((eq exit-status 0) t)
    ((eq exit-status 20)


@@ -840,24 +837,22 @@ You may need to restart Emacs or upgrade your notmuch package."))
                       command " "))
           (extra
            (concat "command: " command-string "\n"
                       command " "))
           (extra
            (concat "command: " command-string "\n"

-            (if (integerp exit-status)
-                (format "exit status: %s\n" exit-status)
-              (format "exit signal: %s\n" exit-status))
-            (when err
-              (concat "stderr:\n" err))
-            (when output
-              (concat "stdout:\n" output)))))
-       (if err
-           ;; We have an error message straight from the CLI.
-           (notmuch-logged-error
-            (replace-regexp-in-string "[ \n\r\t\f]*\\'" "" err) extra)
-         ;; We only have combined output from the CLI; don't inundate
-         ;; the user with it.  Mimic `process-lines'.
-         (notmuch-logged-error (format "%s exited with status %s"
-                                       (car command) exit-status)
-                               extra))
-       ;; `notmuch-logged-error' does not return.
-       ))))
+                   (if (integerp exit-status)
+                       (format "exit status: %s\n" exit-status)
+                     (format "exit signal: %s\n" exit-status))
+                   (and err    (concat "stderr:\n" err))
+                   (and output (concat "stdout:\n" output)))))
+      (if err
+         ;; We have an error message straight from the CLI.
+         (notmuch-logged-error
+          (replace-regexp-in-string "[ \n\r\t\f]*\\'" "" err) extra)
+       ;; We only have combined output from the CLI; don't inundate
+       ;; the user with it.  Mimic `process-lines'.
+       (notmuch-logged-error (format "%s exited with status %s"
+                                     (car command) exit-status)
+                             extra))
+      ;; `notmuch-logged-error' does not return.
+      ))))

 
 (defun notmuch-call-notmuch--helper (destination args)
   "Helper for synchronous notmuch invocation commands.
 
 (defun notmuch-call-notmuch--helper (destination args)
   "Helper for synchronous notmuch invocation commands.


@@ -865,12 +860,11 @@ You may need to restart Emacs or upgrade your notmuch package."))
 This wraps `call-process'.  DESTINATION has the same meaning as
 for `call-process'.  ARGS is as described for
 `notmuch-call-notmuch-process'."
 This wraps `call-process'.  DESTINATION has the same meaning as
 for `call-process'.  ARGS is as described for
 `notmuch-call-notmuch-process'."

-

   (let (stdin-string)
     (while (keywordp (car args))
       (cl-case (car args)
   (let (stdin-string)
     (while (keywordp (car args))
       (cl-case (car args)

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

        (otherwise
         (error "Unknown keyword argument: %s" (car args)))))
     (if (null stdin-string)
        (otherwise
         (error "Unknown keyword argument: %s" (car args)))))
     (if (null stdin-string)


@@ -903,7 +897,6 @@ notmuch's output as an S-expression and returns the parsed value.
 Like `notmuch-call-notmuch-process', if notmuch exits with a
 non-zero status, this will report its output and signal an
 error."
 Like `notmuch-call-notmuch-process', if notmuch exits with a
 non-zero status, this will report its output and signal an
 error."

-

   (with-temp-buffer
     (let ((err-file (make-temp-file "nmerr")))
       (unwind-protect
   (with-temp-buffer
     (let ((err-file (make-temp-file "nmerr")))
       (unwind-protect


@@ -931,11 +924,10 @@ when the process exits, or nil for none.  The caller must *not*
 invoke `set-process-sentinel' directly on the returned process,
 as that will interfere with the handling of stderr and the exit
 status."
 invoke `set-process-sentinel' directly on the returned process,
 as that will interfere with the handling of stderr and the exit
 status."

-

   (let (err-file err-buffer proc err-proc
   (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))))
+                ;; 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*"))
     (if (fboundp 'make-process)
        (progn
          (setq err-buffer (generate-new-buffer " *notmuch-stderr*"))


@@ -949,14 +941,13 @@ status."
                      :buffer buffer
                      :command (cons command args)
                      :connection-type 'pipe
                      :buffer buffer
                      :command (cons command args)
                      :connection-type 'pipe

-                     :stderr err-buffer)
-               err-proc (get-buffer-process err-buffer))
+                     :stderr err-buffer))
+         (setq 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))
          (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
       ;; 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


@@ -969,7 +960,6 @@ status."
                          "exec 2>\"$1\"; shift; exec \"$0\" \"$@\""
                          command err-file args)))
       (process-put proc 'err-file err-file))
                          "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)


@@ -980,8 +970,8 @@ status."
   (let* ((err-file (process-get proc 'err-file))
         (err-buffer (or (process-get proc 'err-buffer)
                         (find-file-noselect err-file)))
   (let* ((err-file (process-get proc 'err-file))
         (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))))
+        (err (and (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


@@ -999,16 +989,17 @@ 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

-                (when err
-                  (with-current-buffer err-buffer
-                    (goto-char (point-min))
-                    (end-of-line)
-                    ;; Show first line; stuff remaining lines in the
-                    ;; errors buffer.
-                    (let ((l1 (buffer-substring (point-min) (point))))
-                      (skip-chars-forward "\n")
-                      (cons l1 (unless (eobp)
-                                 (buffer-substring (point) (point-max)))))))))
+                (and err
+                     (with-current-buffer err-buffer
+                       (goto-char (point-min))
+                       (end-of-line)
+                       ;; Show first line; stuff remaining lines in the
+                       ;; errors buffer.
+                       (let ((l1 (buffer-substring (point-min) (point))))
+                         (skip-chars-forward "\n")
+                         (cons l1 (and (not (eobp))
+                                       (buffer-substring (point)
+                                                         (point-max)))))))))

            (when warnings
              (notmuch-logged-error (car warnings) (cdr warnings)))))
       (error
            (when warnings
              (notmuch-logged-error (car warnings) (cdr warnings)))))
       (error


@@ -1040,8 +1031,8 @@ region if the region is active, or both `point' otherwise."
     (list (point) (point))))
 
 (define-obsolete-function-alias
     (list (point) (point))))
 
 (define-obsolete-function-alias

-    'notmuch-search-interactive-region
-    'notmuch-interactive-region
+  'notmuch-search-interactive-region
+  'notmuch-interactive-region

   "notmuch 0.29")
 
 (provide 'notmuch-lib)
   "notmuch 0.29")
 
 (provide 'notmuch-lib)