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 @@ matching `notmuch-address-completion-headers-regexp'." (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 @@ requiring external commands." (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 @@ requiring external commands." (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 @@ supported for \"Customized queries section\" items." ;; 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 @@ diagonal." 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 @@ Complete list of currently available key bindings: ;; 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 @@ fast way to jump to a saved search from anywhere in Notmuch." (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 @@ will be signaled. 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 @@ displays both values separately." (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 @@ This replaces spaces, percents, and double quotes in STR with ;;; 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 @@ This replaces spaces, percents, and double quotes in STR with (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..c6bdd769 100644 --- a/emacs/notmuch-maildir-fcc.el +++ b/emacs/notmuch-maildir-fcc.el @@ -107,16 +107,13 @@ by notmuch-mua-mail." ;; 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 @@ by notmuch-mua-mail." ;; 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 @@ This is taken from the function 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 @@ This is a rearranged version of message mode's 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 @@ normal fcc." (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 @@ quoting each space with an immediately preceding backslash 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 @@ If CREATE is non-nil then create the folder if necessary." (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 @@ if successful, nil if not." (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 @@ return t if successful, and nil otherwise." (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 @@ Typically this is added to `notmuch-mua-send-hook'." (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 @@ instead of `message-mode' and SWITCH-FUNCTION is mandatory." (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 @@ unencrypted. Really send? ")))) ;;; _ (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 @@ is a possibly empty forest of replies." (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 @@ Flatten results to a list. See the function "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 @@ present or a \"-\" to indicate that the tag should be removed 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 @@ messages instead of running (notmuch-call-notmuch-process \"tag\" ..) 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 @@ there will be called at other points of notmuch execution." (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 "") '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 @@ there will be called at other points of notmuch execution." (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 @@ See `notmuch-tag' for information on the format of TAG-CHANGES." "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 @@ the configured default sort order." (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)))