(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.
tail)))
;; Documentation for command
(push (cons key-string
- (or (and (symbolp binding) (get binding 'notmuch-doc))
- (and (functionp binding) (notmuch-documentation-first-line binding))))
+ (or (and (symbolp binding)
+ (get binding 'notmuch-doc))
+ (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
;; binding whose "key" is 'remap, and whose "binding" is itself a
;; keymap that maps not from keys to commands, but from old (remapped)
;; functions to the commands to use in their stead.
- (map-keymap
- (lambda (command binding)
- (mapc
- (lambda (actual-key)
- (setq tail (notmuch-describe-key actual-key binding prefix ua-keys tail)))
- (where-is-internal command base-keymap)))
- remap-keymap)
+ (map-keymap (lambda (command binding)
+ (mapc (lambda (actual-key)
+ (setq tail
+ (notmuch-describe-key actual-key binding
+ prefix ua-keys tail)))
+ (where-is-internal command base-keymap)))
+ remap-keymap)
tail)
(defun notmuch-describe-keymap (keymap ua-keys base-keymap &optional prefix tail)
(notmuch-describe-remaps
binding ua-keys base-keymap prefix tail)
(notmuch-describe-keymap
- binding ua-keys base-keymap (notmuch-prefix-key-description key) tail))))
+ binding ua-keys base-keymap
+ (notmuch-prefix-key-description key)
+ tail))))
(binding
- (setq tail (notmuch-describe-key (vector key) binding prefix ua-keys tail)))))
+ (setq tail
+ (notmuch-describe-key (vector key)
+ binding prefix ua-keys tail)))))
keymap)
tail)
(while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
(let ((desc
(save-match-data
- (let* ((keymap-name (substring doc (match-beginning 1) (match-end 1)))
+ (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-alist (notmuch-describe-keymap keymap ua-keys keymap))
- (desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg))) desc-alist)))
+ (desc-list (mapcar (lambda (arg)
+ (concat (car arg) "\t" (cdr arg)))
+ desc-alist)))
(mapconcat #'identity desc-list "\n")))))
(setq doc (replace-match desc 1 1 doc)))
(setq beg (match-end 0)))
of its command symbol."
(interactive)
(let* ((mode major-mode)
- (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t)))))
+ (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))
"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))
- (desc-alist (notmuch-describe-keymap subkeymap ua-keys subkeymap prefix-string))
- (desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg))) desc-alist))
+ (desc-alist (notmuch-describe-keymap
+ subkeymap ua-keys subkeymap prefix-string))
+ (desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg)))
+ desc-alist))
(desc (mapconcat #'identity desc-list "\n")))
(with-help-window (help-buffer)
(with-current-buffer standard-output
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 usually contain a text/html part and some
+ ;; associated graphics.
+ "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
- (let ((coding-system (mm-charset-to-coding-system
- (plist-get part :content-charset))))
+ (if binaryp
+ 'no-conversion
+ (let ((coding-system
+ (mm-charset-to-coding-system
+ (plist-get part :content-charset))))
;; Sadly,
;; `mm-charset-to-coding-system' seems
;; to return things that are not
;; charset is US-ASCII. RFC6657
;; complicates this somewhat.
'us-ascii)))))
- (apply #'call-process notmuch-command nil '(t nil) nil args)
+ (apply #'call-process
+ notmuch-command nil '(t nil) nil args)
(buffer-string))))))
(when (and cache data)
(plist-put part plist-elem data))
;; 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)))))
+ (handle (mm-make-handle (current-buffer)
+ `(,content-type (charset . ,charset)))))
;; If the user wants the part inlined, insert the content and
;; test whether we are able to inline it (which includes both
;; capability and suitability tests).
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"
+ (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.
((exit) (process-exit-status proc))
((signal) msg))))
(when exit-status
- (notmuch-check-exit-status exit-status (or command (process-command proc))
+ (notmuch-check-exit-status exit-status
+ (or command (process-command proc))
nil err))))
(defun notmuch-check-exit-status (exit-status command &optional output err)
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)
projects / notmuch / blobdiff