---
emacs/notmuch-address.el | 22 ++++------
emacs/notmuch-hello.el | 24 ++++-------
emacs/notmuch-jump.el | 4 +-
emacs/notmuch-lib.el | 26 +++++------
emacs/notmuch-maildir-fcc.el | 61 +++++++++++---------------
emacs/notmuch-mua.el | 28 ++++++------
emacs/notmuch-query.el | 11 +++--
emacs/notmuch-tag.el | 14 +++---
emacs/notmuch.el | 83 ++++++++++++++++++------------------
9 files changed, 125 insertions(+), 148 deletions(-)
diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
index 1017c3ce..2f0ec9b3 100644
--- a/emacs/notmuch-address.el
+++ b/emacs/notmuch-address.el
@@ -21,6 +21,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(require 'message)
(require 'notmuch-parser)
(require 'notmuch-lib)
@@ -160,15 +162,12 @@ (defun notmuch-address-message-insinuate ()
(message "calling notmuch-address-message-insinuate is no longer needed"))
(defun notmuch-address-setup ()
- (let* ((setup-company (and notmuch-address-use-company
- (require 'company nil t)))
- (pair (cons notmuch-address-completion-headers-regexp
- #'notmuch-address-expand-name)))
- (when setup-company
- (notmuch-company-setup))
- (unless (member pair message-completion-alist)
- (setq message-completion-alist
- (push pair message-completion-alist)))))
+ (when (and notmuch-address-use-company
+ (require 'company nil t))
+ (notmuch-company-setup))
+ (cl-pushnew (cons notmuch-address-completion-headers-regexp
+ #'notmuch-address-expand-name)
+ message-completion-alist :test #'equal))
(defun notmuch-address-toggle-internal-completion ()
"Toggle use of internal completion for current buffer.
@@ -264,9 +263,6 @@ (defun notmuch-address-harvest-addr (result)
(let ((name-addr (plist-get result :name-addr)))
(puthash name-addr t notmuch-address-completions)))
-(defun notmuch-address-harvest-handle-result (obj)
- (notmuch-address-harvest-addr obj))
-
(defun notmuch-address-harvest-filter (proc string)
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
@@ -274,7 +270,7 @@ (defun notmuch-address-harvest-filter (proc string)
(goto-char (point-max))
(insert string))
(notmuch-sexp-parse-partial-list
- 'notmuch-address-harvest-handle-result (process-buffer proc)))))
+ 'notmuch-address-harvest-addr (process-buffer proc)))))
(defvar notmuch-address-harvest-procs '(nil . nil)
"The currently running harvests.
diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index a134eb07..ffd3d799 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -432,8 +432,7 @@ (defun notmuch-hello-add-saved-search (widget &rest _event)
;; If an existing saved search with this name exists, remove it.
(setq notmuch-saved-searches
(cl-loop for elem in notmuch-saved-searches
- if (not (equal name
- (notmuch-saved-search-get elem :name)))
+ unless (equal name (notmuch-saved-search-get elem :name))
collect elem))
;; Add the new one.
(customize-save-variable 'notmuch-saved-searches
@@ -481,18 +480,14 @@ (defun notmuch-hello-reflect (list ncols)
append (notmuch-hello-reflect-generate-row ncols nrows row list))))
(defun notmuch-hello-widget-search (widget &rest _ignore)
- (cond
- ((eq (widget-get widget :notmuch-search-type) 'tree)
- (notmuch-tree (widget-get widget
- :notmuch-search-terms)))
- ((eq (widget-get widget :notmuch-search-type) 'unthreaded)
- (notmuch-unthreaded (widget-get widget
- :notmuch-search-terms)))
+ (cl-case (widget-get widget :notmuch-search-type)
+ (tree
+ (notmuch-tree (widget-get widget :notmuch-search-terms)))
+ (unthreaded
+ (notmuch-unthreaded (widget-get widget :notmuch-search-terms)))
(t
- (notmuch-search (widget-get widget
- :notmuch-search-terms)
- (widget-get widget
- :notmuch-search-oldest-first)))))
+ (notmuch-search (widget-get widget :notmuch-search-terms)
+ (widget-get widget :notmuch-search-oldest-first)))))
(defun notmuch-saved-search-count (search)
(car (process-lines notmuch-command "count" search)))
@@ -823,8 +818,7 @@ (defun notmuch-hello-insert-search ()
;; instead of a space to make `show-trailing-whitespace'
;; happy, i.e. avoid it marking the whole line as trailing
;; spaces.
- (widget-insert ".")
- (put-text-property (1- (point)) (point) 'invisible t)
+ (widget-insert (propertize "." 'invisible t))
(widget-insert "\n"))
(defun notmuch-hello-insert-recent-searches ()
diff --git a/emacs/notmuch-jump.el b/emacs/notmuch-jump.el
index 51bc4e31..34d6c796 100644
--- a/emacs/notmuch-jump.el
+++ b/emacs/notmuch-jump.el
@@ -63,8 +63,8 @@ (defun notmuch-jump-search ()
(setq action-map (nreverse action-map))
(if action-map
(notmuch-jump action-map "Search: ")
- (error "To use notmuch-jump, \
-please customize shortcut keys in notmuch-saved-searches."))))
+ (error "To use notmuch-jump, %s"
+ "please customize shortcut keys in notmuch-saved-searches."))))
(defvar notmuch-jump--action nil)
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 1bdfc2b9..3add992b 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -192,8 +192,8 @@ (defun notmuch-command-to-string (&rest args)
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)))
@@ -248,7 +248,8 @@ (defun notmuch-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))
+ (if (and (> len 0)
+ (= (aref val (- len 1)) ?\n))
(substring val 0 -1)
val)))
@@ -538,13 +539,12 @@ (defun notmuch-common-do-stash (text)
;;; 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
@@ -555,8 +555,10 @@ (defun notmuch-match-content-type (t1 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)))))
+ (string= (downcase (car st1))
+ (downcase (car st2)))
+ (string= (downcase t1)
+ (downcase t2)))))
(defvar notmuch-multipart/alternative-discouraged
'(;; Avoid HTML parts.
diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el
index 9f09129d..b3c2570e 100644
--- a/emacs/notmuch-maildir-fcc.el
+++ b/emacs/notmuch-maildir-fcc.el
@@ -107,16 +107,13 @@ (defun notmuch-fcc-header-setup ()
;; Old style - no longer works.
(error "Invalid `notmuch-fcc-dirs' setting (old style)"))
((listp notmuch-fcc-dirs)
- (let* ((from (message-field-value "From"))
- (match
- (catch 'first-match
- (dolist (re-folder notmuch-fcc-dirs)
- (when (string-match-p (car re-folder) from)
- (throw 'first-match re-folder))))))
- (if match
- (cdr match)
- (message "No Fcc header added.")
- nil)))
+ (or (seq-some (let ((from (message-field-value "From")))
+ (pcase-lambda (`(,regexp ,folder))
+ (and (string-match-p regexp from)
+ folder)))
+ notmuch-fcc-dirs)
+ (progn (message "No Fcc header added.")
+ nil)))
(t
(error "Invalid `notmuch-fcc-dirs' setting (neither string nor
list)")))))
(when subdir
@@ -128,9 +125,9 @@ (defun notmuch-maildir-add-notmuch-insert-style-fcc-header
(subdir)
;; Notmuch insert does not accept absolute paths, so check the user
;; really want this header inserted.
(when (or (not (= (elt subdir 0) ?/))
- (y-or-n-p
- (format "Fcc header %s is an absolute path and notmuch insert is
requested.
-Insert header anyway? " subdir)))
+ (y-or-n-p (format "Fcc header %s is an absolute path %s %s" subdir
+ "and notmuch insert is requested."
+ "Insert header anyway? ")))
(message-add-header (concat "Fcc: " subdir))))
(defun notmuch-maildir-add-file-style-fcc-header (subdir)
@@ -173,7 +170,7 @@ (defun notmuch-maildir-message-do-fcc ()
"Process Fcc headers in the current buffer.
This is a rearranged version of message mode's message-do-fcc."
- (let (list file)
+ (let (files file)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -183,13 +180,11 @@ (defun notmuch-maildir-message-do-fcc ()
(save-restriction
(message-narrow-to-headers)
(while (setq file (message-fetch-field "fcc" t))
- (push file list)
+ (push file files)
(message-remove-header "fcc" nil t)))
(notmuch-maildir-setup-message-for-saving)
;; Process FCC operations.
- (while list
- (setq file (pop list))
- (notmuch-fcc-handler file))
+ (mapc #'notmuch-fcc-handler files)
(kill-buffer (current-buffer)))))))
(defun notmuch-fcc-handler (fcc-header)
@@ -201,7 +196,8 @@ (defun notmuch-fcc-handler (fcc-header)
(message "Doing Fcc...")
(if notmuch-maildir-use-notmuch-insert
(notmuch-maildir-fcc-with-notmuch-insert fcc-header)
- (notmuch-maildir-fcc-file-fcc fcc-header)))
+ (notmuch-maildir-fcc-file-fcc fcc-header))
+ (message "Doing Fcc...done"))
;;; Functions for saving a message using notmuch insert.
@@ -230,9 +226,8 @@ (defun notmuch-maildir-fcc-with-notmuch-insert (fcc-header
&optional create)
or surrounding the entire folder name in double quotes.
If CREATE is non-nil then create the folder if necessary."
- (let* ((args (split-string-and-unquote fcc-header))
- (folder (car args))
- (tags (cdr args)))
+ (pcase-let ((`(,folder . ,tags)
+ (split-string-and-unquote fcc-header)))
(condition-case nil
(notmuch-maildir-notmuch-insert-current-buffer folder create tags)
;; Since there are many reasons notmuch insert could fail, e.g.,
@@ -265,7 +260,7 @@ (defun notmuch-maildir-fcc-make-uniq-maildir-id ()
(let* ((ftime (float-time))
(microseconds (mod (* 1000000 ftime) 1000000))
(hostname (notmuch-maildir-fcc-host-fixer (system-name))))
- (setq notmuch-maildir-fcc-count (+ notmuch-maildir-fcc-count 1))
+ (cl-incf notmuch-maildir-fcc-count)
(format "%d.%d_%d_%d.%s"
ftime
(emacs-pid)
@@ -298,9 +293,7 @@ (defun notmuch-maildir-fcc-save-buffer-to-tmp (destdir)
(write-file (concat destdir "/tmp/" msg-id))
msg-id)
(t
- (error (format "Can't write to %s. Not a maildir."
- destdir))
- nil))))
+ (error "Can't write to %s. Not a maildir." destdir)))))
(defun notmuch-maildir-fcc-move-tmp-to-new (destdir msg-id)
(add-name-to-file
@@ -345,16 +338,12 @@ (defun notmuch-maildir-fcc-write-buffer-to-maildir
(destdir &optional mark-seen)
(catch 'link-error
(let ((msg-id (notmuch-maildir-fcc-save-buffer-to-tmp destdir)))
(when msg-id
- (cond (mark-seen
- (condition-case nil
- (notmuch-maildir-fcc-move-tmp-to-cur destdir msg-id t)
- (file-already-exists
- (throw 'link-error nil))))
- (t
- (condition-case nil
- (notmuch-maildir-fcc-move-tmp-to-new destdir msg-id)
- (file-already-exists
- (throw 'link-error nil))))))
+ (condition-case nil
+ (if mark-seen
+ (notmuch-maildir-fcc-move-tmp-to-cur destdir msg-id t)
+ (notmuch-maildir-fcc-move-tmp-to-new destdir msg-id))
+ (file-already-exists
+ (throw 'link-error nil))))
(delete-file (concat destdir "/tmp/" msg-id))))
t)))
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index 74ffd8f2..4a08e8a7 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -179,13 +179,11 @@ (defun notmuch-mua-attachment-check ()
(defun notmuch-mua-get-switch-function ()
"Get a switch function according to `notmuch-mua-compose-in'."
- (cond ((eq notmuch-mua-compose-in 'current-window)
- 'switch-to-buffer)
- ((eq notmuch-mua-compose-in 'new-window)
- 'switch-to-buffer-other-window)
- ((eq notmuch-mua-compose-in 'new-frame)
- 'switch-to-buffer-other-frame)
- (t (error "Invalid value for `notmuch-mua-compose-in'"))))
+ (pcase notmuch-mua-compose-in
+ ('current-window 'switch-to-buffer)
+ ('new-window 'switch-to-buffer-other-window)
+ ('new-frame 'switch-to-buffer-other-frame)
+ (_ (error "Invalid value for `notmuch-mua-compose-in'"))))
(defun notmuch-mua-maybe-set-window-dedicated ()
"Set the selected window as dedicated according to `notmuch-mua-compose-in'."
@@ -375,12 +373,10 @@ (defun notmuch-mua-pop-to-buffer (name switch-function)
(select-window window))
(funcall switch-function buffer)
(set-buffer buffer))
- (when (and (buffer-modified-p)
- (not (prog1
- (y-or-n-p
- "Message already being composed; erase? ")
- (message nil))))
- (error "Message being composed")))
+ (when (buffer-modified-p)
+ (if (y-or-n-p "Message already being composed; erase? ")
+ (message nil)
+ (error "Message being composed"))))
(funcall switch-function name)
(set-buffer name))
(erase-buffer)
@@ -611,8 +607,10 @@ (defun notmuch-mua-kill-buffer ()
;;; _
(define-mail-user-agent 'notmuch-user-agent
- 'notmuch-mua-mail 'notmuch-mua-send-and-exit
- 'notmuch-mua-kill-buffer 'notmuch-mua-send-hook)
+ 'notmuch-mua-mail
+ 'notmuch-mua-send-and-exit
+ 'notmuch-mua-kill-buffer
+ 'notmuch-mua-send-hook)
;; Add some more headers to the list that `message-mode' hides when
;; composing a message.
diff --git a/emacs/notmuch-query.el b/emacs/notmuch-query.el
index ffce8814..d7349b77 100644
--- a/emacs/notmuch-query.el
+++ b/emacs/notmuch-query.el
@@ -41,11 +41,9 @@ (defun notmuch-query-get-threads (search-terms)
(defun notmuch-query-map-aux (mapper function seq)
"Private function to do the actual mapping and flattening."
- (apply 'append
- (mapcar
- (lambda (tree)
- (funcall mapper function tree))
- seq)))
+ (cl-mapcan (lambda (tree)
+ (funcall mapper function tree))
+ seq))
(defun notmuch-query-map-threads (fn threads)
"Apply function FN to every thread in THREADS.
@@ -63,7 +61,8 @@ (defun notmuch-query-map-tree (fn tree)
"Apply function FN to every message in TREE.
Flatten results to a list. See the function
`notmuch-query-get-threads' for more information."
- (cons (funcall fn (car tree)) (notmuch-query-map-forest fn (cadr tree))))
+ (cons (funcall fn (car tree))
+ (notmuch-query-map-forest fn (cadr tree))))
;;; Predefined queries
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index a553dfd9..0c9a32ac 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -454,8 +454,9 @@ (defun notmuch-update-tags (tags tag-changes)
from TAGS if present."
(let ((result-tags (copy-sequence tags)))
(dolist (tag-change tag-changes)
- (let ((op (string-to-char tag-change))
- (tag (unless (string= tag-change "") (substring tag-change 1))))
+ (let ((op (aref tag-change 0))
+ (tag (and (not (string= tag-change ""))
+ (substring tag-change 1))))
(cl-case op
(?+ (unless (member tag result-tags)
(push tag result-tags)))
@@ -482,13 +483,12 @@ (defun notmuch-tag (query tag-changes)
directly, so that hooks specified in notmuch-before-tag-hook and
notmuch-after-tag-hook will be run."
;; Perform some validation
- (mapc (lambda (tag-change)
- (unless (string-match-p "^[-+]\\S-+$" tag-change)
- (error "Tag must be of the form `+this_tag' or `-that_tag'")))
- tag-changes)
+ (dolist (tag-change tag-changes)
+ (unless (string-match-p "^[-+]\\S-+$" tag-change)
+ (error "Tag must be of the form `+this_tag' or `-that_tag'")))
(unless query
(error "Nothing to tag!"))
- (unless (null tag-changes)
+ (when tag-changes
(run-hooks 'notmuch-before-tag-hook)
(if (<= (length query) notmuch-tag-argument-limit)
(apply 'notmuch-call-notmuch-process "tag"
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 3928cd65..c4ee9e63 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -179,7 +179,7 @@ (defvar notmuch-search-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map notmuch-common-keymap)
(define-key map "x" 'notmuch-bury-or-kill-this-buffer)
- (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
+ (define-key map (kbd "DEL") 'notmuch-search-scroll-down)
(define-key map "b" 'notmuch-search-scroll-down)
(define-key map " " 'notmuch-search-scroll-up)
(define-key map "<" 'notmuch-search-first-thread)
@@ -232,7 +232,7 @@ (defvar notmuch-search-query-string)
(defvar notmuch-search-target-thread)
(defvar notmuch-search-target-line)
-(defvar notmuch-search-disjunctive-regexp "\\<[oO][rR]\\>")
+(defvar notmuch-search-disjunctive-regexp "\\<[oO][rR]\\>")
;;; Movement
@@ -950,40 +950,39 @@ (defun notmuch-read-query (prompt)
"Read a notmuch-query from the minibuffer with completion.
PROMPT is the string to prompt with."
- (let*
- ((all-tags
- (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
- (process-lines notmuch-command "search" "--output=tags" "*")))
- (completions
- (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
- "subject:" "attachment:")
- (mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
- (mapcar (lambda (tag) (concat "is:" tag)) all-tags)
- (mapcar (lambda (mimetype) (concat "mimetype:" mimetype))
- (mailcap-mime-types)))))
- (let ((keymap (copy-keymap minibuffer-local-map))
- (current-query (cl-case major-mode
- (notmuch-search-mode (notmuch-search-get-query))
- (notmuch-show-mode (notmuch-show-get-query))
- (notmuch-tree-mode (notmuch-tree-get-query))))
- (minibuffer-completion-table
- (completion-table-dynamic
- (lambda (string)
- ;; generate a list of possible completions for the current input
- (cond
- ;; this ugly regexp is used to get the last word of the input
- ;; possibly preceded by a '('
- ((string-match "\\(^\\|.* (?\\)\\([^ ]*\\)$" string)
- (mapcar (lambda (compl)
- (concat (match-string-no-properties 1 string) compl))
- (all-completions (match-string-no-properties 2 string)
- completions)))
- (t (list string)))))))
- ;; this was simpler than convincing completing-read to accept spaces:
- (define-key keymap (kbd "TAB") 'minibuffer-complete)
- (let ((history-delete-duplicates t))
- (read-from-minibuffer prompt nil keymap nil
- 'notmuch-search-history current-query nil)))))
+ (let* ((all-tags
+ (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
+ (process-lines notmuch-command "search" "--output=tags" "*")))
+ (completions
+ (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
+ "subject:" "attachment:")
+ (mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
+ (mapcar (lambda (tag) (concat "is:" tag)) all-tags)
+ (mapcar (lambda (mimetype) (concat "mimetype:" mimetype))
+ (mailcap-mime-types))))
+ (keymap (copy-keymap minibuffer-local-map))
+ (current-query (cl-case major-mode
+ (notmuch-search-mode (notmuch-search-get-query))
+ (notmuch-show-mode (notmuch-show-get-query))
+ (notmuch-tree-mode (notmuch-tree-get-query))))
+ (minibuffer-completion-table
+ (completion-table-dynamic
+ (lambda (string)
+ ;; Generate a list of possible completions for the current input.
+ (cond
+ ;; This ugly regexp is used to get the last word of the input
+ ;; possibly preceded by a '('.
+ ((string-match "\\(^\\|.* (?\\)\\([^ ]*\\)$" string)
+ (mapcar (lambda (compl)
+ (concat (match-string-no-properties 1 string) compl))
+ (all-completions (match-string-no-properties 2 string)
+ completions)))
+ (t (list string)))))))
+ ;; This was simpler than convincing completing-read to accept spaces:
+ (define-key keymap (kbd "TAB") 'minibuffer-complete)
+ (let ((history-delete-duplicates t))
+ (read-from-minibuffer prompt nil keymap nil
+ 'notmuch-search-history current-query nil))))
(defun notmuch-search-get-query ()
"Return the current query in this search buffer."
@@ -1042,12 +1041,12 @@ (defun notmuch-search (&optional query oldest-first
target-thread target-line no
(if oldest-first
"--sort=oldest-first"
"--sort=newest-first")
- query))
- ;; Use a scratch buffer to accumulate partial output.
- ;; This buffer will be killed by the sentinel, which
- ;; should be called no matter how the process dies.
- (parse-buf (generate-new-buffer " *notmuch search parse*")))
- (process-put proc 'parse-buf parse-buf)
+ query)))
+ ;; Use a scratch buffer to accumulate partial output.
+ ;; This buffer will be killed by the sentinel, which
+ ;; should be called no matter how the process dies.
+ (process-put proc 'parse-buf
+ (generate-new-buffer " *notmuch search parse*"))
(set-process-filter proc 'notmuch-search-process-filter)
(set-process-query-on-exit-flag proc nil))))
(run-hooks 'notmuch-search-hook)))
--
2.29.1
_______________________________________________
notmuch mailing list -- notmuch@notmuchmail.org
To unsubscribe send an email to notmuch-le...@notmuchmail.org
