From: David Bremner Date: Sat, 24 Oct 2015 17:41:23 +0000 (+2100) Subject: [PATCH 2/3] Emacs: Add address completion mechanism implemented in elisp X-Git-Url: http://git.tremily.us/?a=commitdiff_plain;h=b81c0c53ee3eb19379f2f4f14e3d9142575ca1c7;p=notmuch-archives.git [PATCH 2/3] Emacs: Add address completion mechanism implemented in elisp --- diff --git a/b8/ebefcdcfa4b8bd574debb5ba11d80ba0aba61b b/b8/ebefcdcfa4b8bd574debb5ba11d80ba0aba61b new file mode 100644 index 000000000..9055211bd --- /dev/null +++ b/b8/ebefcdcfa4b8bd574debb5ba11d80ba0aba61b @@ -0,0 +1,247 @@ +Return-Path: +X-Original-To: notmuch@notmuchmail.org +Delivered-To: notmuch@notmuchmail.org +Received: from localhost (localhost [127.0.0.1]) + by arlo.cworth.org (Postfix) with ESMTP id CCC8E6DE1226 + for ; Sat, 24 Oct 2015 10:43:36 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at cworth.org +X-Spam-Flag: NO +X-Spam-Score: 0.098 +X-Spam-Level: +X-Spam-Status: No, score=0.098 tagged_above=-999 required=5 tests=[AWL=0.098] + autolearn=disabled +Received: from arlo.cworth.org ([127.0.0.1]) + by localhost (arlo.cworth.org [127.0.0.1]) (amavisd-new, port 10024) + with ESMTP id F1aEtQap7_tx for ; + Sat, 24 Oct 2015 10:43:34 -0700 (PDT) +Received: from gitolite.debian.net (gitolite.debian.net [87.98.215.224]) + by arlo.cworth.org (Postfix) with ESMTPS id AAB656DE1034 + for ; Sat, 24 Oct 2015 10:43:33 -0700 (PDT) +Received: from remotemail by gitolite.debian.net with local (Exim 4.80) + (envelope-from ) + id 1Zq2pS-0001Hj-Lt; Sat, 24 Oct 2015 17:42:06 +0000 +Received: (nullmailer pid 32263 invoked by uid 1000); Sat, 24 Oct 2015 + 17:41:28 -0000 +From: David Bremner +To: Mark Walters , notmuch@notmuchmail.org +Subject: [PATCH 2/3] Emacs: Add address completion mechanism implemented in + elisp +Date: Sat, 24 Oct 2015 14:41:23 -0300 +Message-Id: <1445708484-32189-3-git-send-email-david@tethera.net> +X-Mailer: git-send-email 2.6.1 +In-Reply-To: <1445708484-32189-1-git-send-email-david@tethera.net> +References: <1445702019-10638-1-git-send-email-markwalters1009@gmail.com> + <1445708484-32189-1-git-send-email-david@tethera.net> +X-BeenThere: notmuch@notmuchmail.org +X-Mailman-Version: 2.1.20 +Precedence: list +List-Id: "Use and development of the notmuch mail system." + +List-Unsubscribe: , + +List-Archive: +List-Post: +List-Help: +List-Subscribe: , + +X-List-Received-Date: Sat, 24 Oct 2015 17:43:36 -0000 + +From: Michal Sojka + +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 | 108 +++++++++++++++++++++++++++++++++++++++++++++-- + emacs/notmuch-lib.el | 3 ++ + 2 files changed, 107 insertions(+), 4 deletions(-) + +diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el +index 39200ef..2a748ec 100644 +--- a/emacs/notmuch-address.el ++++ b/emacs/notmuch-address.el +@@ -20,14 +20,17 @@ + ;; Authors: David Edmondson + + (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,6 +47,17 @@ 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)" +@@ -56,8 +70,32 @@ to know how address selection is made by default." + + (defvar notmuch-address-history nil) + ++(defun notmuch-address-matching (substring) ++ "Returns a list of completion candidates matching SUBSTRING. ++The candidates are taked form `notmuch-address-completions'." ++ (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)) +@@ -106,4 +144,66 @@ 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-proc nil) ; the process of a harvest underway ++ ++(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 ++ (when notmuch-address-harvest-proc ++ (kill-buffer (process-buffer notmuch-address-harvest-proc))) ; this also kills the process ++ (setq notmuch-address-harvest-proc ++ (apply 'notmuch-start-notmuch ++ "notmuch-address-harvest" ; process name ++ " *notmuch-address-harvest*" ; process buffer ++ callback ; process sentinel ++ args)) ++ (set-process-filter notmuch-address-harvest-proc 'notmuch-address-harvest-filter) ++ (set-process-query-on-exit-flag notmuch-address-harvest-proc nil))) ++ ;; 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) ++ (setq notmuch-address-full-harvest-finished t)))))) ++ ++;; ++ + (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 +