From d6fbf7d96fd3b1139dbcad3fb6cda81fea002d4c Mon Sep 17 00:00:00 2001 From: David Bremner Date: Sat, 24 Oct 2015 21:20:35 +2100 Subject: [PATCH] [Patch v5 1/3] Emacs: Add address completion mechanism implemented in elisp --- ec/737f295592ef6096c99f3f3f0abce06cfeae8a | 265 ++++++++++++++++++++++ 1 file changed, 265 insertions(+) create mode 100644 ec/737f295592ef6096c99f3f3f0abce06cfeae8a diff --git a/ec/737f295592ef6096c99f3f3f0abce06cfeae8a b/ec/737f295592ef6096c99f3f3f0abce06cfeae8a new file mode 100644 index 000000000..c48f9ac11 --- /dev/null +++ b/ec/737f295592ef6096c99f3f3f0abce06cfeae8a @@ -0,0 +1,265 @@ +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 462606DE1329 + for ; Fri, 23 Oct 2015 17:22:17 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at cworth.org +X-Spam-Flag: NO +X-Spam-Score: 0.104 +X-Spam-Level: +X-Spam-Status: No, score=0.104 tagged_above=-999 required=5 tests=[AWL=0.094, + T_FILL_THIS_FORM_SHORT=0.01] 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 mej0Oh08C7Gx for ; + Fri, 23 Oct 2015 17:22:12 -0700 (PDT) +Received: from gitolite.debian.net (gitolite.debian.net [87.98.215.224]) + by arlo.cworth.org (Postfix) with ESMTPS id 888BA6DE1403 + for ; Fri, 23 Oct 2015 17:22:12 -0700 (PDT) +Received: from remotemail by gitolite.debian.net with local (Exim 4.80) + (envelope-from ) + id 1Zpmaa-0006nC-Je; Sat, 24 Oct 2015 00:21:40 +0000 +Received: (nullmailer pid 26051 invoked by uid 1000); Sat, 24 Oct 2015 + 00:20:41 -0000 +From: David Bremner +To: notmuch@notmuchmail.org +Subject: [Patch v5 1/3] Emacs: Add address completion mechanism implemented + in elisp +Date: Fri, 23 Oct 2015 21:20:35 -0300 +Message-Id: <1445646037-25994-2-git-send-email-david@tethera.net> +X-Mailer: git-send-email 2.6.1 +In-Reply-To: <1445646037-25994-1-git-send-email-david@tethera.net> +References: <1445646037-25994-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 00:22:17 -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 the change of the notmuch-address-command default value +may *BREAK EXISTING SETUPS* when the user used external command named +"notmuch-addresses", i.e. the previous default. The result will be that +the user will use the new mechanism instead of the his 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 | 123 ++++++++++++++++++++++++++++++++++++++++++++--- + emacs/notmuch-lib.el | 3 ++ + 2 files changed, 118 insertions(+), 8 deletions(-) + +diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el +index fde3c1b..9f6711b 100644 +--- a/emacs/notmuch-address.el ++++ b/emacs/notmuch-address.el +@@ -20,14 +20,18 @@ + ;; Authors: David Edmondson + + (require 'message) ++(require 'notmuch-query) ++(require 'notmuch-parser) + + ;; + +-(defcustom notmuch-address-command "notmuch-addresses" +- "The command which generates possible addresses. It must take a +-single argument and output a list of possible matches, one per +-line." +- :type 'string ++(defcustom notmuch-address-command nil ++ "The command which generates possible addresses for completion. ++It must take a single argument and output a list of possible ++matches, one per line. If set to nil, addresses are generated by ++a built-in completion mechanism." ++ :type '(radio (const :tag "No command: Use built-in completion" nil) ++ (string :tag "Custom command" :value "notmuch-addresses")) + :group 'notmuch-send + :group 'notmuch-external) + +@@ -42,6 +46,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)" +@@ -59,8 +74,32 @@ to know how address selection is made by default." + (setq message-completion-alist + (push notmuch-address-message-alist-member message-completion-alist)))) + ++(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 ++ ((null notmuch-address-command) ++ (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)) +@@ -109,11 +148,79 @@ to know how address selection is made by default." + (not (file-directory-p bin)))) + (throw 'found-command bin)))))))) + ++(defun notmuch-address-harvest-msg (msg) ++ (let* ((headers (plist-get msg :headers)) ++ (to (ignore-errors (mail-extract-address-components (plist-get headers :To) t))) ++ (cc (ignore-errors (mail-extract-address-components (plist-get headers :Cc) t))) ++ (bcc (ignore-errors (mail-extract-address-components (plist-get headers :Bcc) t)))) ++ (mapc (lambda (parts) ++ (let* ((name (car parts)) ++ (email (cadr parts)) ++ (entry (if name (format "%s <%s>" name email) email))) ++ (puthash entry t notmuch-address-completions))) ++ (append to cc bcc)) ++ nil)) ++ ++(defun notmuch-address-harvest-handle-result (obj) ++ (notmuch-query-map-threads 'notmuch-address-harvest-msg (list 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 `("show" "--format=sexp" "--format-version=2" ++ "--body=false" "--entire-thread=false" ,query))) ++ (if synchronous ++ (notmuch-query-map-threads 'notmuch-address-harvest-msg ++ (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) ++ + ;; If we can find the program specified by `notmuch-address-command', +-;; insinuate ourselves into `message-mode'. +-(when (notmuch-address-locate-command notmuch-address-command) ++;; or if it is nil, insinuate ourselves into `message-mode'. ++(when (or (null notmuch-address-command) ++ (notmuch-address-locate-command notmuch-address-command)) + (notmuch-address-message-insinuate)) + ++(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 + -- 2.26.2