From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id EBBGMD4J+19xdgAA0tVLHw (envelope-from ) for ; Sun, 10 Jan 2021 14:03:42 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id IEsxLD4J+19iXgAA1q6Kng (envelope-from ) for ; Sun, 10 Jan 2021 14:03:42 +0000 Received: from mail.notmuchmail.org (nmbug.tethera.net [144.217.243.247]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) server-signature RSA-PSS (2048 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 18DE1940416 for ; Sun, 10 Jan 2021 14:03:42 +0000 (UTC) Received: from nmbug.tethera.net (localhost [127.0.0.1]) by mail.notmuchmail.org (Postfix) with ESMTP id 79AF52BF4A; Sun, 10 Jan 2021 09:01:58 -0500 (EST) Received: from mail.hostpark.net (mail.hostpark.net [212.243.197.30]) by mail.notmuchmail.org (Postfix) with ESMTPS id 74DD629D85 for ; Sun, 10 Jan 2021 09:01:18 -0500 (EST) Received: from localhost (localhost [127.0.0.1]) by mail.hostpark.net (Postfix) with ESMTP id 70B63166B9 for ; Sun, 10 Jan 2021 15:01:14 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=bernoul.li; h= content-transfer-encoding:mime-version:references:in-reply-to :x-mailer:message-id:date:date:subject:subject:from:from :received:received; s=sel2011a; t=1610287274; bh=Fe3H6aNTi+yQLkM sG45rfXuR73ljHF7dnOXKAd3eMXU=; b=vXb+ys17uTCmIzAZbprN22+lilJ6JhJ xcE30w7aFKSdiGlPagkw0tf8sB8aJG9MrLRu4b/+3fNXr5/69cLhobZwCp2Um85j tOAJyTUBrYNnQT0zvdn4ScRuwa2RT45muJks8iMl6+RIbWltlOI9GOL7jvoHQITt jG02/n1Vrkfg= X-Virus-Scanned: by Hostpark/NetZone Mailprotection at hostpark.net Received: from mail.hostpark.net ([127.0.0.1]) by localhost (mail0.hostpark.net [127.0.0.1]) (amavisd-new, port 10224) with ESMTP id Emx_ywOrs1lV for ; Sun, 10 Jan 2021 15:01:14 +0100 (CET) Received: from customer (localhost [127.0.0.1]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by mail.hostpark.net (Postfix) with ESMTPSA id 16EF6165C3 for ; Sun, 10 Jan 2021 15:01:14 +0100 (CET) From: Jonas Bernoulli To: notmuch@notmuchmail.org Subject: [PATCH v2 23/36] emacs: various cosmetic improvements Date: Sun, 10 Jan 2021 15:00:59 +0100 Message-Id: <20210110140112.25930-24-jonas@bernoul.li> X-Mailer: git-send-email 2.29.1 In-Reply-To: <20210110140112.25930-1-jonas@bernoul.li> References: <20201214162401.19569-1-jonas@bernoul.li> <20210110140112.25930-1-jonas@bernoul.li> MIME-Version: 1.0 Message-ID-Hash: GK4WKGF56PL32VKPQ6OWUOQZPYHSREC2 X-Message-ID-Hash: GK4WKGF56PL32VKPQ6OWUOQZPYHSREC2 X-MailFrom: jonas@bernoul.li X-Mailman-Rule-Misses: dmarc-mitigation; no-senders; approved; emergency; loop; banned-address; member-moderation; header-match-notmuch.notmuchmail.org-0; nonmember-moderation; administrivia; implicit-dest; max-recipients; max-size; news-moderation; no-subject; suspicious-header X-Mailman-Version: 3.2.1 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Help: List-Post: List-Subscribe: List-Unsubscribe: Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit X-Migadu-Flow: FLOW_IN X-Migadu-Spam-Score: -0.09 Authentication-Results: aspmx1.migadu.com; dkim=fail (body hash did not verify) header.d=bernoul.li header.s=sel2011a header.b=vXb+ys17; dmarc=none; spf=pass (aspmx1.migadu.com: domain of notmuch-bounces@notmuchmail.org designates 144.217.243.247 as permitted sender) smtp.mailfrom=notmuch-bounces@notmuchmail.org X-Migadu-Queue-Id: 18DE1940416 X-Spam-Score: -0.09 X-Migadu-Scanner: scn1.migadu.com X-TUID: Iy3Y0yNmfFuj --- 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 "") '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