X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-address.el;h=64887a43fe652b04332e0e3ed9b15577656cc9f8;hp=2eaca7958bb2736de3e21abe0e04a5946f95ab96;hb=HEAD;hpb=df9736f20be0aa4db96e3ceaccb4f614ecbd4a9b diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el index 2eaca795..f756254c 100644 --- a/emacs/notmuch-address.el +++ b/emacs/notmuch-address.el @@ -1,4 +1,4 @@ -;;; notmuch-address.el --- address completion with notmuch +;;; notmuch-address.el --- address completion with notmuch -*- lexical-binding: t -*- ;; ;; Copyright © David Edmondson ;; @@ -25,54 +25,70 @@ (require 'notmuch-parser) (require 'notmuch-lib) (require 'notmuch-company) -;; + (declare-function company-manual-begin "company") +;;; Cache internals + (defvar notmuch-address-last-harvest 0 - "Time of last address harvest") + "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'.") +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. Use notmuch-address--harvest-ready to access.") + "Whether full completion address harvesting has finished. +Use `notmuch-address--harvest-ready' to access as that will load +a saved hash if necessary (and available).") (defun notmuch-address--harvest-ready () - "Return t if there is a full address hash available." - notmuch-address-full-harvest-finished) + "Return t if there is a full address hash available. + +If the hash is not present it attempts to load a saved hash." + (or notmuch-address-full-harvest-finished + (notmuch-address--load-address-hash))) + +;;; Options (defcustom notmuch-address-command 'internal "Determines how address completion candidates are generated. -If it is a string then that string should be an external program -which must take a single argument (searched string) and output a -list of completion candidates, one per line. +If this is a string, then that string should be an external +program, which must take a single argument (searched string) +and output a list of completion candidates, one per line. + +If this is the symbol `internal', then an implementation is used +that relies on the \"notmuch address\" command, but does not use +any third-party (i.e. \"external\") programs. -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. +If this is the symbol `as-is', then Notmuch does not modify the +value of `message-completion-alist'. This option has to be set to +this value before `notmuch' is loaded, otherwise the modification +to `message-completion-alist' may already have taken place. This +setting obviously does not prevent `message-completion-alist' +from being modified at all; the user or some third-party package +may still modify it. -Finally, if this variable is nil then address completion is -disabled." +Finally, if this is nil, then address completion is disabled." :type '(radio - (const :tag "Use internal address completion" internal) - (const :tag "Disable address completion" nil) - (string :tag "Use external completion command")) + (const :tag "Use internal address completion" internal) + (string :tag "Use external completion command") + (const :tag "Disable address completion" nil) + (const :tag "Use default or third-party mechanism" as-is)) :group 'notmuch-send + :group 'notmuch-address :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." +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" @@ -89,17 +105,33 @@ This should be a list of the form '(DIRECTION FILTER), where (setq notmuch-address-completions (clrhash notmuch-address-completions)) (setq notmuch-address-full-harvest-finished nil)) :group 'notmuch-send + :group 'notmuch-address + :group 'notmuch-external) + +(defcustom notmuch-address-save-filename nil + "Filename to save the cached completion addresses. + +All the addresses notmuch uses for address completion will be +cached in this file. This has obvious privacy implications so +you should make sure it is not somewhere publicly readable." + :type '(choice (const :tag "Off" nil) + (file :tag "Filename")) + :group 'notmuch-send + :group 'notmuch-address :group 'notmuch-external) (defcustom notmuch-address-selection-function 'notmuch-address-selection-function - "The function to select address from given list. The function is -called with PROMPT, COLLECTION, and INITIAL-INPUT as arguments -(subset of what `completing-read' can be called with). -While executed the value of `completion-ignore-case' is t. -See documentation of function `notmuch-address-selection-function' -to know how address selection is made by default." + "The function to select address from given list. + +The function is called with PROMPT, COLLECTION, and INITIAL-INPUT +as arguments (subset of what `completing-read' can be called +with). While executed the value of `completion-ignore-case' +is t. See documentation of function +`notmuch-address-selection-function' to know how address +selection is made by default." :type 'function :group 'notmuch-send + :group 'notmuch-address :group 'notmuch-external) (defcustom notmuch-address-post-completion-functions nil @@ -107,15 +139,21 @@ to know how address selection is made by default." The completed address is passed as an argument to each function. Note that this hook will be invoked for completion in headers -matching `notmuch-address-completion-headers-regexp'. -" +matching `notmuch-address-completion-headers-regexp'." :type 'hook :group 'notmuch-address :group 'notmuch-hooks) +(defcustom notmuch-address-use-company t + "If available, use company mode for address completion." + :type 'boolean + :group 'notmuch-send + :group 'notmuch-address) + +;;; Setup + (defun notmuch-address-selection-function (prompt collection initial-input) - "Call (`completing-read' - PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" + "Default address selection function: delegate to completing read." (completing-read prompt collection nil nil initial-input 'notmuch-address-history)) @@ -127,21 +165,14 @@ matching `notmuch-address-completion-headers-regexp'. (defun notmuch-address-message-insinuate () (message "calling notmuch-address-message-insinuate is no longer needed")) -(defcustom notmuch-address-use-company t - "If available, use company mode for address completion" - :type 'boolean - :group 'notmuch-send) - (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 (memq pair message-completion-alist) - (setq message-completion-alist - (push pair message-completion-alist))))) + (unless (eq notmuch-address-command 'as-is) + (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. @@ -151,38 +182,41 @@ toggles the setting in this buffer." (interactive) (if (local-variable-p 'notmuch-address-command) (kill-local-variable 'notmuch-address-command) - (notmuch-setq-local notmuch-address-command 'internal)) - (if (boundp 'company-idle-delay) - (if (local-variable-p 'company-idle-delay) - (kill-local-variable 'company-idle-delay) - (notmuch-setq-local company-idle-delay nil)))) + (setq-local notmuch-address-command 'internal)) + (when (boundp 'company-idle-delay) + (if (local-variable-p 'company-idle-delay) + (kill-local-variable 'company-idle-delay) + (setq-local company-idle-delay nil)))) + +;;; Completion (defun notmuch-address-matching (substring) "Returns a list of completion candidates matching SUBSTRING. The candidates are taken from `notmuch-address-completions'." (let ((candidates) (re (regexp-quote substring))) - (maphash (lambda (key val) + (maphash (lambda (key _val) (when (string-match re key) (push key candidates))) notmuch-address-completions) candidates)) (defun notmuch-address-options (original) - "Returns a list of completion candidates. Uses either -elisp-based implementation or older implementation requiring -external commands." + "Return a list of completion candidates. +Use either elisp-based implementation or older implementation +requiring external commands." (cond ((eq notmuch-address-command 'internal) (unless (notmuch-address--harvest-ready) ;; First, run quick synchronous harvest based on what the user - ;; entered so far + ;; entered so far. (notmuch-address-harvest original t)) (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))) (t - (process-lines notmuch-address-command original)))) + (notmuch--process-lines notmuch-address-command original)))) (defun notmuch-address-expand-name () (cond @@ -209,49 +243,24 @@ external commands." (t (funcall notmuch-address-selection-function (format "Address (%s matches): " num-options) - ;; We put the first match as the initial - ;; input; we put all the matches as - ;; possible completions, moving the - ;; first match to the end of the list - ;; makes cursor up/down in the list work - ;; better. - (append (cdr options) (list (car options))) - (car options)))))) + options + orig))))) (if chosen (progn (push chosen notmuch-address-history) (delete-region beg end) (insert chosen) - (run-hook-with-args 'notmuch-address-post-completion-functions chosen)) + (run-hook-with-args 'notmuch-address-post-completion-functions + chosen)) (message "No matches.") (ding)))) (t nil))) -;; Copied from `w3m-which-command'. -(defun notmuch-address-locate-command (command) - "Return non-nil if `command' is an executable either on -`exec-path' or an absolute pathname." - (when (stringp command) - (if (and (file-name-absolute-p command) - (file-executable-p command)) - command - (setq command (file-name-nondirectory command)) - (catch 'found-command - (let (bin) - (dolist (dir exec-path) - (setq bin (expand-file-name command dir)) - (when (or (and (file-executable-p bin) - (not (file-directory-p bin))) - (and (file-executable-p (setq bin (concat bin ".exe"))) - (not (file-directory-p bin)))) - (throw 'found-command bin)))))))) +;;; Harvest (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)) + (puthash (plist-get result :name-addr) + t notmuch-address-completions)) (defun notmuch-address-harvest-filter (proc string) (when (buffer-live-p (process-buffer proc)) @@ -260,18 +269,18 @@ 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. -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 addr-prefix synchronous callback) "Collect addresses completion candidates. It queries the notmuch database for messages sent/received (as -configured with `notmuch-address-command`) by the user, collects +configured with `notmuch-address-command') by the user, collects destination/source addresses from those messages and stores them in `notmuch-address-completions'. @@ -281,29 +290,30 @@ matching ADDR-PREFIX*' are queried. Address harvesting may take some time so the address collection runs 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))) + (prefix-query (and 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))) + (and prefix-query + (format " and (%s)" prefix-query)) + (and 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=5" ,(if sent "--output=recipients" "--output=sender") "--deduplicate=address" ,query))) (if synchronous (mapc #'notmuch-address-harvest-addr - (apply 'notmuch-call-notmuch-sexp args)) + (apply 'notmuch-call-notmuch-sexp args)) ;; Asynchronous (let* ((current-proc (if addr-prefix (car notmuch-address-harvest-procs) @@ -314,7 +324,6 @@ execution, CALLBACK is called when harvesting finishes." ;; Kill any existing process (when current-proc (kill-buffer (process-buffer current-proc))) ; this also kills the process - (setq current-proc (apply 'notmuch-start-notmuch proc-name proc-buf callback ; process sentinel @@ -327,20 +336,81 @@ execution, CALLBACK is called when harvesting finishes." ;; return value nil) +(defvar notmuch-address--save-hash-version 1 + "Version format of the save hash.") + +(defun notmuch-address--get-address-hash () + "Return the saved address hash as a plist. + +Returns nil if the save file does not exist, or it does not seem +to be a saved address hash." + (and notmuch-address-save-filename + (condition-case nil + (with-temp-buffer + (insert-file-contents notmuch-address-save-filename) + (let ((name (read (current-buffer))) + (plist (read (current-buffer)))) + ;; We do two simple sanity checks on the loaded file. + ;; We just check a version is specified, not that + ;; it is the current version, as we are allowed to + ;; over-write and a save-file with an older version. + (and (string= name "notmuch-address-hash") + (plist-get plist :version) + plist))) + ;; The error case catches any of the reads failing. + (error nil)))) + +(defun notmuch-address--load-address-hash () + "Read the saved address hash and set the corresponding variables." + (let ((load-plist (notmuch-address--get-address-hash))) + (when (and load-plist + ;; If the user's setting have changed, or the version + ;; has changed, return nil to make sure the new settings + ;; take effect. + (equal (plist-get load-plist :completion-settings) + notmuch-address-internal-completion) + (equal (plist-get load-plist :version) + notmuch-address--save-hash-version)) + (setq notmuch-address-last-harvest (plist-get load-plist :last-harvest)) + (setq notmuch-address-completions (plist-get load-plist :completions)) + (setq notmuch-address-full-harvest-finished t) + ;; Return t to say load was successful. + t))) + +(defun notmuch-address--save-address-hash () + (when notmuch-address-save-filename + (if (or (not (file-exists-p notmuch-address-save-filename)) + ;; The file exists, check it is a file we saved. + (notmuch-address--get-address-hash)) + (with-temp-file notmuch-address-save-filename + (let ((save-plist + (list :version notmuch-address--save-hash-version + :completion-settings notmuch-address-internal-completion + :last-harvest notmuch-address-last-harvest + :completions notmuch-address-completions))) + (print "notmuch-address-hash" (current-buffer)) + (print save-plist (current-buffer)))) + (message "\ +Warning: notmuch-address-save-filename %s exists but doesn't +appear to be an address savefile. Not overwriting." + notmuch-address-save-filename)))) + (defun notmuch-address-harvest-trigger () (let ((now (float-time))) (when (> (- now notmuch-address-last-harvest) 86400) (setq notmuch-address-last-harvest now) - (notmuch-address-harvest nil nil - (lambda (proc event) - ;; If harvest fails, we want to try - ;; again when the trigger is next - ;; called - (if (string= event "finished\n") - (setq notmuch-address-full-harvest-finished t) - (setq notmuch-address-last-harvest 0))))))) - -;; + (notmuch-address-harvest + nil nil + (lambda (_proc event) + ;; If harvest fails, we want to try + ;; again when the trigger is next called. + (if (string= event "finished\n") + (progn + (notmuch-address--save-address-hash) + (setq notmuch-address-full-harvest-finished t)) + (setq notmuch-address-last-harvest 0))))))) + +;;; Standalone completion (defun notmuch-address-from-minibuffer (prompt) (if (not notmuch-address-command) @@ -359,7 +429,7 @@ execution, CALLBACK is called when harvesting finishes." (let ((minibuffer-local-map rmap)) (read-string prompt))))) -;; +;;; _ (provide 'notmuch-address)