-;;; notmuch-lib.el --- common variables, functions and function declarations
+;;; notmuch-lib.el --- common variables, functions and function declarations -*- lexical-binding: t -*-
;;
;; Copyright © Carl Worth
;;
;;; Code:
(require 'cl-lib)
+(require 'pcase)
+(require 'subr-x)
(require 'mm-util)
(require 'mm-view)
(defconst notmuch-emacs-version "unknown"
"Placeholder variable when notmuch-version.el[c] is not available."))
+;;; Groups
+
(defgroup notmuch nil
"Notmuch mail reader for Emacs."
:group 'mail)
"Graphical attributes for displaying text"
:group 'notmuch)
+;;; Options
+
(defcustom notmuch-command "notmuch"
"Name of the notmuch binary.
search."
:type 'boolean
:group 'notmuch-search)
+(make-variable-buffer-local 'notmuch-search-oldest-first)
(defcustom notmuch-poll-script nil
"[Deprecated] Command to run to incorporate new mail into the notmuch database.
(string :tag "Custom script"))
:group 'notmuch-external)
-;;
-
-(defvar notmuch-search-history nil
- "Variable to store notmuch searches history.")
-
(defcustom notmuch-archive-tags '("-inbox")
"List of tag changes to apply to a message or a thread when it is archived.
:group 'notmuch-search
:group 'notmuch-show)
+;;; Variables
+
+(defvar notmuch-search-history nil
+ "Variable to store notmuch searches history.")
+
(defvar notmuch-common-keymap
(let ((map (make-sparse-keymap)))
(define-key map "?" 'notmuch-help)
(select-window (posn-window (event-start last-input-event)))
(button-activate button)))
+;;; CLI Utilities
+
(defun notmuch-command-to-string (&rest args)
"Synchronously invoke \"notmuch\" with the given list of arguments.
Otherwise the output will be returned."
(with-temp-buffer
- (let* ((status (apply #'call-process notmuch-command nil t nil args))
- (output (buffer-string)))
+ (let ((status (apply #'call-process notmuch-command nil t nil args))
+ (output (buffer-string)))
(notmuch-check-exit-status status (cons notmuch-command args) output)
output)))
(concat cli-version
" (emacs mua version " notmuch-emacs-version ")")))))
+;;; Notmuch Configuration
+
(defun notmuch-config-get (item)
"Return a value from the notmuch configuration."
(let* ((val (notmuch-command-to-string "config" "get" item))
(len (length val)))
;; Trim off the trailing newline (if the value is empty or not
- ;; configured, there will be no newline)
- (if (and (> len 0) (= (aref val (- len 1)) ?\n))
+ ;; configured, there will be no newline).
+ (if (and (> len 0)
+ (= (aref val (- len 1)) ?\n))
(substring val 0 -1)
val)))
(defun notmuch-user-emails ()
(cons (notmuch-user-primary-email) (notmuch-user-other-email)))
+;;; Commands
+
(defun notmuch-poll ()
"Run \"notmuch new\" or an external script to import mail.
(interactive)
(message "Polling mail...")
(if (stringp notmuch-poll-script)
- (unless (string= notmuch-poll-script "")
+ (unless (string-empty-p 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"))
(bury-buffer)
(kill-buffer)))
+;;; Describe Key Bindings
+
(defun notmuch-prefix-key-description (key)
"Given a prefix key code, return a human-readable string representation.
"M-"
(concat desc " "))))
-
(defun notmuch-describe-key (actual-key binding prefix ua-keys tail)
"Prepend cons cells describing prefix-arg ACTUAL-KEY and ACTUAL-KEY to TAIL.
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)))))
+ (let ((doc (substitute-command-keys
+ (notmuch-substitute-command-keys
+ (documentation major-mode t)))))
(with-current-buffer (generate-new-buffer "*notmuch-help*")
(insert doc)
(goto-char (point-min))
(insert desc)))
(pop-to-buffer (help-buffer)))))
+;;; Refreshing Buffers
+
(defvar-local notmuch-buffer-refresh-function nil
"Function to call to refresh the current buffer.")
(with-current-buffer buffer
(notmuch-refresh-this-buffer))))))
+;;; String Utilities
+
(defun notmuch-prettify-subject (subject)
- ;; This function is used by `notmuch-search-process-filter' which
- ;; requires that we not disrupt its' matching state.
+ ;; This function is used by `notmuch-search-process-filter',
+ ;; which requires that we not disrupt its matching state.
(save-match-data
(if (and subject
(string-match "^[ \t]*$" subject))
(replace-regexp-in-string
"[ %\"]" (lambda (match) (format "%%%02x" (aref match 0))) str))
-;;
-
(defun notmuch-common-do-stash (text)
"Common function to stash text in kill ring, and display in minibuffer."
(if text
(kill-new "")
(message "Nothing to stash!")))
-;;
+;;; Generic Utilities
(defun notmuch-plist-delete (plist property)
- (let* ((xplist (cons nil plist))
- (pred xplist))
- (while (cdr pred)
- (when (eq (cadr pred) property)
- (setcdr pred (cdddr pred)))
- (setq pred (cddr pred)))
- (cdr xplist)))
+ (let (p)
+ (while plist
+ (unless (eq property (car plist))
+ (setq p (plist-put p (car plist) (cadr plist))))
+ (setq plist (cddr plist)))
+ p))
+
+;;; MML Utilities
(defun notmuch-match-content-type (t1 t2)
- "Return t if t1 and t2 are matching content types, taking wildcards into account."
- (let ((st1 (split-string t1 "/"))
- (st2 (split-string t2 "/")))
- (if (or (string= (cadr st1) "*")
- (string= (cadr st2) "*"))
- ;; Comparison of content types should be case insensitive.
- (string= (downcase (car st1)) (downcase (car st2)))
- (string= (downcase t1) (downcase t2)))))
+ "Return t if t1 and t2 are matching content types.
+Take wildcards into account."
+ (and (stringp t1)
+ (stringp t2)
+ (let ((st1 (split-string t1 "/"))
+ (st2 (split-string t2 "/")))
+ (if (or (string= (cadr st1) "*")
+ (string= (cadr st2) "*"))
+ ;; Comparison of content types should be case insensitive.
+ (string= (downcase (car st1))
+ (downcase (car st2)))
+ (string= (downcase t1)
+ (downcase t2))))))
(defvar notmuch-multipart/alternative-discouraged
'(;; Avoid HTML parts.
(mm-display-part handle)
t))))))
+;;; Generic Utilities
+
;; Converts a plist of headers to an alist of headers. The input plist should
;; have symbols of the form :Header as keys, and the resulting alist will have
;; symbols of the form 'Header as keys.
(put-text-property start next prop (funcall func value) object)
(setq start next))))
+;;; Running Notmuch
+
(defun notmuch-logged-error (msg &optional extra)
"Log MSG and EXTRA to *Notmuch errors* and signal MSG.
Emacs requested a newer output format than supported by the notmuch CLI.
You may need to restart Emacs or upgrade your notmuch package."))
(t
- (let* ((command-string
- (mapconcat (lambda (arg)
- (shell-quote-argument
- (cond ((stringp arg) arg)
- ((symbolp arg) (symbol-name arg))
- (t "*UNKNOWN ARGUMENT*"))))
- 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))
- (and err (concat "stderr:\n" err))
- (and output (concat "stdout:\n" output)))))
+ (pcase-let*
+ ((`(,command . ,args) command)
+ (command (if (equal (file-name-nondirectory command)
+ notmuch-command)
+ notmuch-command
+ command))
+ (command-string
+ (mapconcat (lambda (arg)
+ (shell-quote-argument
+ (cond ((stringp arg) arg)
+ ((symbolp arg) (symbol-name arg))
+ (t "*UNKNOWN ARGUMENT*"))))
+ (cons command args)
+ " "))
+ (extra
+ (concat "command: " command-string "\n"
+ (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
;; 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)
+ command exit-status)
extra))
;; `notmuch-logged-error' does not return.
))))
:connection-type 'pipe
:stderr err-buffer))
(err-proc (get-buffer-process err-buffer)))
- (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 proc 'sub-sentinel sentinel)
- (process-put proc 'real-command (cons notmuch-command args))
(set-process-sentinel proc #'notmuch-start-notmuch-sentinel)
+ (set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel)
proc))
(defun notmuch-start-notmuch-sentinel (proc event)
(err (and (buffer-live-p err-buffer)
(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)))
+ (sub-sentinel (process-get proc 'sub-sentinel)))
(condition-case err
(progn
;; Invoke the sub-sentinel, if any
;; and there's no point in telling the user that (but we
;; still check for and report stderr output below).
(when (buffer-live-p (process-buffer proc))
- (notmuch-check-async-exit-status proc event real-command err))
+ (notmuch-check-async-exit-status proc event nil err))
;; If that didn't signal an error, then any error output was
;; really warning output. Show warnings, if any.
(let ((warnings
;; so turn errors into messages.
(message "%s" (error-message-string err))))))
-(defun notmuch-start-notmuch-error-sentinel (proc event)
- (let ((buffer (process-get proc 'err-buffer)))
- (when (buffer-live-p buffer)
- (kill-buffer buffer))))
+(defun notmuch-start-notmuch-error-sentinel (proc _event)
+ (unless (process-live-p proc)
+ (let ((buffer (process-buffer proc)))
+ (when (buffer-live-p buffer)
+ (kill-buffer buffer)))))
(defvar-local notmuch-show-process-crypto nil)
+;;; Generic Utilities
+
(defun notmuch-interactive-region ()
"Return the bounds of the current interactive region.
'notmuch-interactive-region
"notmuch 0.29")
+;;; _
+
(provide 'notmuch-lib)
;;; notmuch-lib.el ends here