;;
;; Authors: Carl Worth <cworth@cworth.org>
-;; This is an part of an emacs-based interface to the notmuch mail system.
-
;;; Code:
(require 'cl-lib)
(defconst notmuch-emacs-version "unknown"
"Placeholder variable when notmuch-version.el[c] is not available."))
-(autoload 'notmuch-jump-search "notmuch-jump"
- "Jump to a saved search by shortcut key." t)
-
(defgroup notmuch nil
"Notmuch mail reader for Emacs."
:group 'mail)
(defgroup notmuch-send nil
"Sending messages from Notmuch."
- :group 'notmuch)
-
-(custom-add-to-group 'notmuch-send 'message 'custom-group)
+ :group 'notmuch
+ :group 'message)
(defgroup notmuch-tag nil
"Tags and tagging in Notmuch."
(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 ()
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)))
- (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.
(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
"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)))
-
(let* ((subkeymap (key-binding prefix))
(ua-keys (where-is-internal 'universal-argument nil t))
(prefix-string (notmuch-prefix-key-description prefix))
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
(let (out)
(while list
(when (funcall predicate (car list))
- (push (car list) out))
+ (push (car list) out))
(setq list (cdr list)))
(nreverse out)))
(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.
- "multipart/related"
- ))
+ "multipart/related"))
(defun notmuch-multipart/alternative-determine-discouraged (msg)
"Return the discouraged alternatives for the specified message."
(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
- (if binaryp 'no-conversion
+ (if binaryp
+ 'no-conversion
(let ((coding-system
(mm-charset-to-coding-system
(plist-get part :content-charset))))
;; Workaround: The call to `mm-display-part' below triggers a bug in
;; Emacs 24 if it attempts to use the shr renderer to display an HTML
;; part with images in it (demonstrated in 24.1 and 24.2 on Debian and
-;; Fedora 17, though unreproducable in other configurations).
+;; Fedora 17, though unreproducible in other configurations).
;; `mm-shr' references the variable `gnus-inhibit-images' without
;; 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
;; `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)))))
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
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)
(insert extra)
(unless (bolp)
(newline)))))
- (error "%s" (concat msg (when extra
- " (see *Notmuch errors* for more details)"))))
+ (error "%s%s" msg (if 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.
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)
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.
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)
- (: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)
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
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
- ;; 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*"))
: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))
-
;; 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
"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)
(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
;; 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
(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)