emacs: address completion, allow sender/recipient and filters

This commit lets the user customize the address completion. It makes
two changes.

The first change controls whether to build the address completion list
based on messages you have sent or you have received (the latter is
much faster).

The second change add a possible filter query to limit the messages
used -- for example, setting this to date:1y..  would limit the
address completions to addresses used in the last year. This speeds up
the address harvest and may also make the search less cluttered as old
addresses may well no longer be valid.
This commit is contained in:
Mark Walters 2016-05-20 21:13:02 +01:00 committed by David Bremner
parent 7352cadb4f
commit 2cf0ef3998
3 changed files with 98 additions and 42 deletions

View file

@ -28,15 +28,62 @@
;; ;;
(declare-function company-manual-begin "company") (declare-function company-manual-begin "company")
(defvar notmuch-address-last-harvest 0
"Time of last address harvest")
(defvar notmuch-address-completions (make-hash-table :test 'equal)
"Hash of email addresses for completion during email composition.
This variable is set by calling `notmuch-address-harvest'.")
(defvar notmuch-address-full-harvest-finished nil
"t indicates that full completion address harvesting has been
finished")
(defcustom notmuch-address-command 'internal (defcustom notmuch-address-command 'internal
"The command which generates possible addresses. It must take a "Determines how address completion candidates are generated.
single argument and output a list of possible matches, one per
line. The default value of `internal' uses built-in address If it is a string then that string should be an external program
completion." which must take a single argument (searched string) and output a
list of completion candidates, one per line.
Alternatively, it can be the symbol 'internal, in which case
internal completion is used; the variable
`notmuch-address-internal-completion` can be used to customize
this case.
Finally, if this variable is nil then address completion is
disabled."
:type '(radio :type '(radio
(const :tag "Use internal address completion" internal) (const :tag "Use internal address completion" internal)
(const :tag "Disable address completion" nil) (const :tag "Disable address completion" nil)
(string :tag "Use external completion command" "notmuch-addresses")) (string :tag "Use external completion command"))
:group 'notmuch-send
:group 'notmuch-external)
(defcustom notmuch-address-internal-completion '(sent nil)
"Determines how internal address completion generates candidates.
This should be a list of the form '(DIRECTION FILTER), where
DIRECTION is either sent or received and specifies whether the
candidates are searched in messages sent by the user or received
by the user (note received by is much faster), and FILTER is
either nil or a filter-string, such as \"date:1y..\" to append
to the query."
:type '(list :tag "Use internal address completion"
(radio
:tag "Base completion on messages you have"
:value sent
(const :tag "sent (more accurate)" sent)
(const :tag "received (faster)" received))
(radio :tag "Filter messages used for completion"
(const :tag "Use all messages" nil)
(string :tag "Filter query")))
;; We override set so that we can clear the cache when this changes
:set (lambda (symbol value)
(set-default symbol value)
(setq notmuch-address-last-harvest 0)
(setq notmuch-address-completions (clrhash notmuch-address-completions))
(setq notmuch-address-full-harvest-finished nil))
:group 'notmuch-send :group 'notmuch-send
:group 'notmuch-external) :group 'notmuch-external)
@ -51,17 +98,6 @@ to know how address selection is made by default."
:group 'notmuch-send :group 'notmuch-send
:group 'notmuch-external) :group 'notmuch-external)
(defvar notmuch-address-last-harvest 0
"Time of last address harvest")
(defvar notmuch-address-completions (make-hash-table :test 'equal)
"Hash of email addresses for completion during email composition.
This variable is set by calling `notmuch-address-harvest'.")
(defvar notmuch-address-full-harvest-finished nil
"t indicates that full completion address harvesting has been
finished")
(defun notmuch-address-selection-function (prompt collection initial-input) (defun notmuch-address-selection-function (prompt collection initial-input)
"Call (`completing-read' "Call (`completing-read'
PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
@ -86,9 +122,7 @@ finished")
(eq notmuch-address-command 'internal) (eq notmuch-address-command 'internal)
(require 'company nil t))) (require 'company nil t)))
(pair (cons notmuch-address-completion-headers-regexp (pair (cons notmuch-address-completion-headers-regexp
(if use-company #'notmuch-address-expand-name)))
#'company-manual-begin
#'notmuch-address-expand-name))))
(when use-company (when use-company
(notmuch-company-setup)) (notmuch-company-setup))
(unless (memq pair message-completion-alist) (unless (memq pair message-completion-alist)
@ -115,7 +149,7 @@ external commands."
(when (not notmuch-address-full-harvest-finished) (when (not notmuch-address-full-harvest-finished)
;; First, run quick synchronous harvest based on what the user ;; First, run quick synchronous harvest based on what the user
;; entered so far ;; entered so far
(notmuch-address-harvest (format "to:%s*" original) t)) (notmuch-address-harvest original t))
(prog1 (notmuch-address-matching original) (prog1 (notmuch-address-matching original)
;; Then start the (potentially long-running) full asynchronous harvest if necessary ;; Then start the (potentially long-running) full asynchronous harvest if necessary
(notmuch-address-harvest-trigger))) (notmuch-address-harvest-trigger)))
@ -123,7 +157,12 @@ external commands."
(process-lines notmuch-address-command original)))) (process-lines notmuch-address-command original))))
(defun notmuch-address-expand-name () (defun notmuch-address-expand-name ()
(when notmuch-address-command (cond
((and (eq notmuch-address-command 'internal)
notmuch-address-use-company
(bound-and-true-p company-mode))
(company-manual-begin))
(notmuch-address-command
(let* ((end (point)) (let* ((end (point))
(beg (save-excursion (beg (save-excursion
(re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
@ -149,7 +188,8 @@ external commands."
(delete-region beg end) (delete-region beg end)
(insert chosen)) (insert chosen))
(message "No matches.") (message "No matches.")
(ding))))) (ding))))
(t nil)))
;; Copied from `w3m-which-command'. ;; Copied from `w3m-which-command'.
(defun notmuch-address-locate-command (command) (defun notmuch-address-locate-command (command)
@ -191,32 +231,49 @@ external commands."
The car is a partial harvest, and the cdr is a full harvest") The car is a partial harvest, and the cdr is a full harvest")
(defun notmuch-address-harvest (&optional filter-query synchronous callback) (defun notmuch-address-harvest (&optional addr-prefix synchronous callback)
"Collect addresses completion candidates. It queries the "Collect addresses completion candidates.
notmuch database for all messages sent by the user optionally
matching FILTER-QUERY (if not nil). It collects the destination It queries the notmuch database for messages sent/received (as
addresses from those messages and stores them in configured with `notmuch-address-command`) by the user, collects
`notmuch-address-completions'. Address harvesting may take some destination/source addresses from those messages and stores them
time so the address collection runs asynchronously unless in `notmuch-address-completions'.
SYNCHRONOUS is t. In case of asynchronous execution, CALLBACK is
called when harvesting finishes." If ADDR-PREFIX is not nil, only messages with to/from addresses
(let* ((from-me-query (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or ")) matching ADDR-PREFIX*' are queried.
(query (if filter-query
(format "(%s) and (%s)" from-me-query filter-query) Address harvesting may take some time so the address collection runs
from-me-query)) asynchronously unless SYNCHRONOUS is t. In case of asynchronous
execution, CALLBACK is called when harvesting finishes."
(let* ((sent (eq (car notmuch-address-internal-completion) 'sent))
(config-query (cadr notmuch-address-internal-completion))
(prefix-query (when addr-prefix
(format "%s:%s*" (if sent "to" "from") addr-prefix)))
(from-or-to-me-query
(mapconcat (lambda (x)
(concat (if sent "from:" "to:") x))
(notmuch-user-emails) " or "))
(query (if (or prefix-query config-query)
(concat (format "(%s)" from-or-to-me-query)
(when prefix-query
(format " and (%s)" prefix-query))
(when config-query
(format " and (%s)" config-query)))
from-or-to-me-query))
(args `("address" "--format=sexp" "--format-version=2" (args `("address" "--format=sexp" "--format-version=2"
"--output=recipients" ,(if sent "--output=recipients" "--output=sender")
"--deduplicate=address" "--deduplicate=address"
,query))) ,query)))
(if synchronous (if synchronous
(mapc #'notmuch-address-harvest-addr (mapc #'notmuch-address-harvest-addr
(apply 'notmuch-call-notmuch-sexp args)) (apply 'notmuch-call-notmuch-sexp args))
;; Asynchronous ;; Asynchronous
(let* ((current-proc (if filter-query (let* ((current-proc (if addr-prefix
(car notmuch-address-harvest-procs) (car notmuch-address-harvest-procs)
(cdr notmuch-address-harvest-procs))) (cdr notmuch-address-harvest-procs)))
(proc-name (format "notmuch-address-%s-harvest" (proc-name (format "notmuch-address-%s-harvest"
(if filter-query "partial" "full"))) (if addr-prefix "partial" "full")))
(proc-buf (concat " *" proc-name "*"))) (proc-buf (concat " *" proc-name "*")))
;; Kill any existing process ;; Kill any existing process
(when current-proc (when current-proc
@ -228,7 +285,7 @@ called when harvesting finishes."
args)) args))
(set-process-filter current-proc 'notmuch-address-harvest-filter) (set-process-filter current-proc 'notmuch-address-harvest-filter)
(set-process-query-on-exit-flag current-proc nil) (set-process-query-on-exit-flag current-proc nil)
(if filter-query (if addr-prefix
(setcar notmuch-address-harvest-procs current-proc) (setcar notmuch-address-harvest-procs current-proc)
(setcdr notmuch-address-harvest-procs current-proc))))) (setcdr notmuch-address-harvest-procs current-proc)))))
;; return value ;; return value

View file

@ -72,7 +72,7 @@
(lambda (callback) (lambda (callback)
;; First run quick asynchronous harvest based on what the user entered so far ;; First run quick asynchronous harvest based on what the user entered so far
(notmuch-address-harvest (notmuch-address-harvest
(format "to:%s*" arg) nil arg nil
(lambda (_proc _event) (lambda (_proc _event)
(funcall callback (notmuch-address-matching arg)) (funcall callback (notmuch-address-matching arg))
;; Then start the (potentially long-running) full asynchronous harvest if necessary ;; Then start the (potentially long-running) full asynchronous harvest if necessary

View file

@ -276,8 +276,7 @@ mutiple parts get a header."
(define-derived-mode notmuch-message-mode message-mode "Message[Notmuch]" (define-derived-mode notmuch-message-mode message-mode "Message[Notmuch]"
"Notmuch message composition mode. Mostly like `message-mode'" "Notmuch message composition mode. Mostly like `message-mode'"
(when notmuch-address-command (notmuch-address-setup))
(notmuch-address-setup)))
(put 'notmuch-message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) (put 'notmuch-message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)