On Sun, 25 Oct 2015, David Bremner <david@tethera.net> wrote: > From: Michal Sojka <sojkam1@fel.cvut.cz> > > Currently, notmuch has an address completion mechanism that requires > external command to provide completion candidates. This patch adds a > completion mechanism inspired by https://github.com/tjim/nevermore, > which is implemented in Emacs lisp only. > > The preexisting address completion mechanism, activated by pressing TAB > on To/Cc lines, is extended to use the new mechanism when no external > command is configured, i.e. when notmuch-address-command to nil, which > is the new default. > > The core of the new mechanism is the function notmuch-address-harvest, > which collects the completion candidates from the notmuch database and > stores them in notmuch-address-completions variable. The address > harvesting can run either synchronously (same as with the previous > mechanism) or asynchronously. When the user presses TAB for the first > time, synchronous harvesting limited to user entered text is performed. > If the entered text is reasonably long, this operation is relatively > fast. Then, asynchronous harvesting over the full database is triggered. > This operation may take long time (minutes on rotating disk). After it > finishes, no harvesting is normally performed again and subsequent > completion requests use the harvested data cached in memory. Completion > cache is updated after 24 hours. > > Note that this commit restores (different) completion functionality for > users when the user used external command named "notmuch-addresses", > i.e. the old default. The result will be that the user will use > the new mechanism instead of this command. I believe that many users may > not even recognize this because the new mechanism works the same as > http://commonmeasure.org/~jkr/git/notmuch_addresses.git and perhaps also > as other commands suggested at > http://notmuchmail.org/emacstips/#address_completion. > --- > emacs/notmuch-address.el | 192 ++++++++++++++++++++++++++++++++++++++--------- > emacs/notmuch-lib.el | 3 + > 2 files changed, 159 insertions(+), 36 deletions(-) > > diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el > index e2af879..aa6228d 100644 > --- a/emacs/notmuch-address.el > +++ b/emacs/notmuch-address.el > @@ -20,14 +20,17 @@ > ;; Authors: David Edmondson <dme@dme.org> > > (require 'message) > - > +(require 'notmuch-parser) > +(require 'notmuch-lib) > ;; > > -(defcustom notmuch-address-command nil > +(defcustom notmuch-address-command 'internal > "The command which generates possible addresses. It must take a > single argument and output a list of possible matches, one per > -line. The default value of nil disables address completion." > +line. The default value of `internal' uses built-in address > +completion." > :type '(radio > + (const :tag "Use internal address completion" internal) > (const :tag "Disable address completion" nil) > (string :tag "Use external completion command" "notmuch-addresses")) > :group 'notmuch-send > @@ -44,15 +47,25 @@ to know how address selection is made by default." > :group 'notmuch-send > :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) > "Call (`completing-read' > PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" > (completing-read > prompt collection nil nil initial-input 'notmuch-address-history)) > > -(defvar notmuch-address-message-alist-member > - '("^\\(Resent-\\)?\\(To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):" > - . notmuch-address-expand-name)) > +(defvar notmuch-address-completion-headers-regexp > + "^\\(Resent-\\)?\\(To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):") > > (defvar notmuch-address-history nil) > > @@ -60,39 +73,67 @@ to know how address selection is made by default." > (message "calling notmuch-address-message-insinuate is no longer needed")) > > (defun notmuch-address-setup () > - (unless (memq notmuch-address-message-alist-member message-completion-alist) > - (setq message-completion-alist > - (push notmuch-address-message-alist-member message-completion-alist)))) > + (let ((pair (cons notmuch-address-completion-headers-regexp > + #'notmuch-address-expand-name))) > + (unless (memq pair message-completion-alist) > + (setq message-completion-alist > + (push pair message-completion-alist))))) > + > +(defun notmuch-address-matching (substring) > + "Returns a list of completion candidates matching SUBSTRING. > +The candidates are taked form `notmuch-address-completions'." Just one minor typo: "taked form" should be "taken from". Best wishes Mark > + (let ((candidates) > + (re (regexp-quote substring))) > + (maphash (lambda (key val) > + (when (string-match re key) > + (push key candidates))) > + notmuch-address-completions) > + candidates)) > + > (defun notmuch-address-options (original) > - (process-lines notmuch-address-command original)) > + "Returns a list of completion candidates. Uses either > +elisp-based implementation or older implementation requiring > +external commands." > + (cond > + ((eq notmuch-address-command 'internal) > + (when (not notmuch-address-full-harvest-finished) > + ;; First, run quick synchronous harvest based on what the user > + ;; entered so far > + (notmuch-address-harvest (format "to:%s*" original) t)) > + (prog1 (notmuch-address-matching original) > + ;; Then (re)start potentially long-running full asynchronous harvesting > + (notmuch-address-harvest-trigger))) > + (t > + (process-lines notmuch-address-command original)))) > > (defun notmuch-address-expand-name () > - (let* ((end (point)) > - (beg (save-excursion > - (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") > - (goto-char (match-end 0)) > - (point))) > - (orig (buffer-substring-no-properties beg end)) > - (completion-ignore-case t) > - (options (with-temp-message "Looking for completion candidates..." > - (notmuch-address-options orig))) > - (num-options (length options)) > - (chosen (cond > - ((eq num-options 0) > - nil) > - ((eq num-options 1) > - (car options)) > - (t > - (funcall notmuch-address-selection-function > - (format "Address (%s matches): " num-options) > - (cdr options) (car options)))))) > - (if chosen > - (progn > - (push chosen notmuch-address-history) > - (delete-region beg end) > - (insert chosen)) > - (message "No matches.") > - (ding)))) > + (when notmuch-address-command > + (let* ((end (point)) > + (beg (save-excursion > + (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") > + (goto-char (match-end 0)) > + (point))) > + (orig (buffer-substring-no-properties beg end)) > + (completion-ignore-case t) > + (options (with-temp-message "Looking for completion candidates..." > + (notmuch-address-options orig))) > + (num-options (length options)) > + (chosen (cond > + ((eq num-options 0) > + nil) > + ((eq num-options 1) > + (car options)) > + (t > + (funcall notmuch-address-selection-function > + (format "Address (%s matches): " num-options) > + (cdr options) (car options)))))) > + (if chosen > + (progn > + (push chosen notmuch-address-history) > + (delete-region beg end) > + (insert chosen)) > + (message "No matches.") > + (ding))))) > > ;; Copied from `w3m-which-command'. > (defun notmuch-address-locate-command (command) > @@ -113,4 +154,83 @@ to know how address selection is made by default." > (not (file-directory-p bin)))) > (throw 'found-command bin)))))))) > > +(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) > + (save-excursion > + (goto-char (point-max)) > + (insert string)) > + (notmuch-sexp-parse-partial-list > + 'notmuch-address-harvest-handle-result (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") > + > +(defun notmuch-address-harvest (&optional filter-query synchronous callback) > + "Collect addresses completion candidates. It queries the > +notmuch database for all messages sent by the user optionally > +matching FILTER-QUERY (if not nil). It collects the destination > +addresses from those messages and stores them in > +`notmuch-address-completions'. 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* ((from-me-query (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or ")) > + (query (if filter-query > + (format "(%s) and (%s)" from-me-query filter-query) > + from-me-query)) > + (args `("address" "--format=sexp" "--format-version=2" > + "--output=recipients" > + "--deduplicate=address" > + ,query))) > + (if synchronous > + (mapc #'notmuch-address-harvest-addr > + (apply 'notmuch-call-notmuch-sexp args)) > + ;; Asynchronous > + (let* ((current-proc (if filter-query > + (car notmuch-address-harvest-procs) > + (cdr notmuch-address-harvest-procs))) > + (proc-name (format "notmuch-address-%s-harvest" > + (if filter-query "partial" "full"))) > + (proc-buf (concat " *" proc-name "*"))) > + ;; 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 > + args)) > + (set-process-filter current-proc 'notmuch-address-harvest-filter) > + (set-process-query-on-exit-flag current-proc nil) > + (if filter-query > + (setcar notmuch-address-harvest-procs current-proc) > + (setcdr notmuch-address-harvest-procs current-proc))))) > + ;; return value > + nil) > + > +(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))))))) > + > +;; > + > (provide 'notmuch-address) > diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el > index 201d7ec..1c3a9fe 100644 > --- a/emacs/notmuch-lib.el > +++ b/emacs/notmuch-lib.el > @@ -232,6 +232,9 @@ on the command line, and then retry your notmuch command"))) > "Return the user.other_email value (as a list) from the notmuch configuration." > (split-string (notmuch-config-get "user.other_email") "\n" t)) > > +(defun notmuch-user-emails () > + (cons (notmuch-user-primary-email) (notmuch-user-other-email))) > + > (defun notmuch-poll () > "Run \"notmuch new\" or an external script to import mail. > > -- > 2.6.1 > > _______________________________________________ > notmuch mailing list > notmuch@notmuchmail.org > https://notmuchmail.org/mailman/listinfo/notmuch