]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-lib.el
emacs: Support passing input via `notmuch-call-notmuch-*'
[notmuch] / emacs / notmuch-lib.el
index 4796f177c9bc342a05ee34d9c19fa3aa4039db55..17040ed86bd352343c6ce87296ff8ba2bb4c8752 100644 (file)
@@ -76,6 +76,33 @@ search."
   :type 'boolean
   :group 'notmuch-search)
 
+(defcustom notmuch-poll-script nil
+  "An external script to incorporate new mail into the notmuch database.
+
+This variable controls the action invoked by
+`notmuch-search-poll-and-refresh-view' and
+`notmuch-hello-poll-and-update' (each have a default keybinding
+of 'G') to incorporate new mail into the notmuch database.
+
+If set to nil (the default), new mail is processed by invoking
+\"notmuch new\". Otherwise, this should be set to a string that
+gives the name of an external script that processes new mail. If
+set to the empty string, no command will be run.
+
+The external script could do any of the following depending on
+the user's needs:
+
+1. Invoke a program to transfer mail to the local mail store
+2. Invoke \"notmuch new\" to incorporate the new mail
+3. Invoke one or more \"notmuch tag\" commands to classify the mail
+
+Note that the recommended way of achieving the same is using
+\"notmuch new\" hooks."
+  :type '(choice (const :tag "notmuch new" nil)
+                (const :tag "Disabled" "")
+                (string :tag "Custom script"))
+  :group 'notmuch-external)
+
 ;;
 
 (defvar notmuch-search-history nil
@@ -101,6 +128,18 @@ For example, if you wanted to remove an \"inbox\" tag and add an
   :group 'notmuch-search
   :group 'notmuch-show)
 
+(defvar notmuch-common-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map "?" 'notmuch-help)
+    (define-key map "q" 'notmuch-kill-this-buffer)
+    (define-key map "s" 'notmuch-search)
+    (define-key map "z" 'notmuch-tree)
+    (define-key map "m" 'notmuch-mua-new-mail)
+    (define-key map "=" 'notmuch-refresh-this-buffer)
+    (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)
+    map)
+  "Keymap shared by all notmuch modes.")
+
 ;; By default clicking on a button does not select the window
 ;; containing the button (as opposed to clicking on a widget which
 ;; does). This means that the button action is then executed in the
@@ -161,11 +200,128 @@ Otherwise the output will be returned"
   "Return the user.other_email value (as a list) from the notmuch configuration."
   (split-string (notmuch-config-get "user.other_email") "\n"))
 
+(defun notmuch-poll ()
+  "Run \"notmuch new\" or an external script to import mail.
+
+Invokes `notmuch-poll-script', \"notmuch new\", or does nothing
+depending on the value of `notmuch-poll-script'."
+  (interactive)
+  (if (stringp notmuch-poll-script)
+      (unless (string= notmuch-poll-script "")
+       (call-process notmuch-poll-script nil nil))
+    (call-process notmuch-command nil nil nil "new")))
+
 (defun notmuch-kill-this-buffer ()
   "Kill the current buffer."
   (interactive)
   (kill-buffer (current-buffer)))
 
+(defun notmuch-documentation-first-line (symbol)
+  "Return the first line of the documentation string for SYMBOL."
+  (let ((doc (documentation symbol)))
+    (if doc
+       (with-temp-buffer
+         (insert (documentation symbol t))
+         (goto-char (point-min))
+         (let ((beg (point)))
+           (end-of-line)
+           (buffer-substring beg (point))))
+      "")))
+
+(defun notmuch-prefix-key-description (key)
+  "Given a prefix key code, return a human-readable string representation.
+
+This is basically just `format-kbd-macro' but we also convert ESC to M-."
+  (let ((desc (format-kbd-macro (vector key))))
+    (if (string= desc "ESC")
+       "M-"
+      (concat desc " "))))
+
+(defun notmuch-describe-keymap (keymap ua-keys &optional prefix tail)
+  "Return a list of strings, each describing one binding in KEYMAP.
+
+Each string gives a human-readable description of the key and a
+one-line description of the bound function.  See `notmuch-help'
+for an overview of how this documentation is extracted.
+
+UA-KEYS should be a key sequence bound to `universal-argument'.
+It will be used to describe bindings of commands that support a
+prefix argument.  PREFIX and TAIL are used internally."
+  (map-keymap
+   (lambda (key binding)
+     (cond ((mouse-event-p key) nil)
+          ((keymapp binding)
+           (setq tail
+                 (notmuch-describe-keymap
+                  binding ua-keys (notmuch-prefix-key-description key) tail)))
+          (t
+           (when (and ua-keys (symbolp binding)
+                      (get binding 'notmuch-prefix-doc))
+             ;; Documentation for prefixed command
+             (let ((ua-desc (key-description ua-keys)))
+               (push (concat ua-desc " " prefix (format-kbd-macro (vector key))
+                             "\t" (get binding 'notmuch-prefix-doc))
+                     tail)))
+           ;; Documentation for command
+           (push (concat prefix (format-kbd-macro (vector key)) "\t"
+                         (or (and (symbolp binding) (get binding 'notmuch-doc))
+                             (notmuch-documentation-first-line binding)))
+                 tail))))
+   keymap)
+  tail)
+
+(defun notmuch-substitute-command-keys (doc)
+  "Like `substitute-command-keys' but with documentation, not function names."
+  (let ((beg 0))
+    (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
+      (let* ((keymap-name (substring doc (match-beginning 1) (match-end 1)))
+            (keymap (symbol-value (intern keymap-name)))
+            (ua-keys (where-is-internal 'universal-argument keymap t))
+            (desc-list (notmuch-describe-keymap keymap ua-keys))
+            (desc (mapconcat #'identity desc-list "\n")))
+       (setq doc (replace-match desc 1 1 doc)))
+      (setq beg (match-end 0)))
+    doc))
+
+(defun notmuch-help ()
+  "Display help for the current notmuch mode.
+
+This is similar to `describe-function' for the current major
+mode, but bindings tables are shown with documentation strings
+rather than command names.  By default, this uses the first line
+of each command's documentation string.  A command can override
+this by setting the 'notmuch-doc property of its command symbol.
+A command that supports a prefix argument can explicitly document
+its prefixed behavior by setting the 'notmuch-prefix-doc property
+of its command symbol."
+  (interactive)
+  (let* ((mode major-mode)
+        (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t)))))
+    (with-current-buffer (generate-new-buffer "*notmuch-help*")
+      (insert doc)
+      (goto-char (point-min))
+      (set-buffer-modified-p nil)
+      (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
+
+(defvar notmuch-buffer-refresh-function nil
+  "Function to call to refresh the current buffer.")
+(make-variable-buffer-local 'notmuch-buffer-refresh-function)
+
+(defun notmuch-refresh-this-buffer ()
+  "Refresh the current buffer."
+  (interactive)
+  (when notmuch-buffer-refresh-function
+    (if (commandp notmuch-buffer-refresh-function)
+       ;; Pass prefix argument, etc.
+       (call-interactively notmuch-buffer-refresh-function)
+      (funcall notmuch-buffer-refresh-function))))
+
+(defun notmuch-poll-and-refresh-this-buffer ()
+  "Invoke `notmuch-poll' to import mail, then refresh the current buffer."
+  (interactive)
+  (notmuch-poll)
+  (notmuch-refresh-this-buffer))
+
 (defun notmuch-prettify-subject (subject)
   ;; This function is used by `notmuch-search-process-filter' which
   ;; requires that we not disrupt its' matching state.
@@ -175,6 +331,12 @@ Otherwise the output will be returned"
        "[No Subject]"
       subject)))
 
+(defun notmuch-sanitize (str)
+  "Sanitize control character in STR.
+
+This includes newlines, tabs, and other funny characters."
+  (replace-regexp-in-string "[[:cntrl:]\x7f\u2028\u2029]+" " " str))
+
 (defun notmuch-escape-boolean-term (term)
   "Escape a boolean term for use in a query.
 
@@ -466,17 +628,55 @@ You may need to restart Emacs or upgrade your notmuch package."))
        ;; `notmuch-logged-error' does not return.
        ))))
 
+(defun notmuch-call-notmuch--helper (destination args)
+  "Helper for synchronous notmuch invocation commands.
+
+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))
+      (case (car args)
+       (:stdin-string (setq stdin-string (cadr args)
+                            args (cddr args)))
+       (otherwise
+        (error "Unknown keyword argument: %s" (car args)))))
+    (if (null stdin-string)
+       (apply #'call-process notmuch-command nil destination nil args)
+      (insert stdin-string)
+      (apply #'call-process-region (point-min) (point-max)
+            notmuch-command t destination nil args))))
+
+(defun notmuch-call-notmuch-process (&rest args)
+  "Synchronously invoke `notmuch-command' with ARGS.
+
+The caller may provide keyword arguments before ARGS.  Currently
+supported keyword arguments are:
+
+  :stdin-string STRING - Write STRING to stdin
+
+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 (notmuch-call-notmuch--helper t args)))
+      (notmuch-check-exit-status status (cons notmuch-command args)
+                                (buffer-string)))))
+
 (defun notmuch-call-notmuch-sexp (&rest args)
   "Invoke `notmuch-command' with ARGS and return the parsed S-exp output.
 
-If notmuch exits with a non-zero status, this will pop up a
-buffer containing notmuch's output and signal an error."
+This is equivalent to `notmuch-call-notmuch-process', but parses
+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."
 
   (with-temp-buffer
     (let ((err-file (make-temp-file "nmerr")))
       (unwind-protect
-         (let ((status (apply #'call-process
-                              notmuch-command nil (list t err-file) nil args)))
+         (let ((status (notmuch-call-notmuch--helper (list t err-file) args)))
            (notmuch-check-exit-status status (cons notmuch-command args)
                                       (buffer-string) err-file)
            (goto-char (point-min))
@@ -558,7 +758,6 @@ status."
 (defvar notmuch-show-process-crypto nil)
 (make-variable-buffer-local 'notmuch-show-process-crypto)
 
-
 (provide 'notmuch-lib)
 
 ;; Local Variables: