[PATCH 2/3] Emacs: Add address completion mechanism implemented in elisp
authorDavid Bremner <david@tethera.net>
Sat, 24 Oct 2015 17:41:23 +0000 (14:41 +2100)
committerW. Trevor King <wking@tremily.us>
Sat, 20 Aug 2016 21:49:54 +0000 (14:49 -0700)
b8/ebefcdcfa4b8bd574debb5ba11d80ba0aba61b [new file with mode: 0644]

diff --git a/b8/ebefcdcfa4b8bd574debb5ba11d80ba0aba61b b/b8/ebefcdcfa4b8bd574debb5ba11d80ba0aba61b
new file mode 100644 (file)
index 0000000..9055211
--- /dev/null
@@ -0,0 +1,247 @@
+Return-Path: <bremner@tethera.net>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by arlo.cworth.org (Postfix) with ESMTP id CCC8E6DE1226\r
+ for <notmuch@notmuchmail.org>; Sat, 24 Oct 2015 10:43:36 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at cworth.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: 0.098\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=0.098 tagged_above=-999 required=5 tests=[AWL=0.098]\r
+ autolearn=disabled\r
+Received: from arlo.cworth.org ([127.0.0.1])\r
+ by localhost (arlo.cworth.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id F1aEtQap7_tx for <notmuch@notmuchmail.org>;\r
+ Sat, 24 Oct 2015 10:43:34 -0700 (PDT)\r
+Received: from gitolite.debian.net (gitolite.debian.net [87.98.215.224])\r
+ by arlo.cworth.org (Postfix) with ESMTPS id AAB656DE1034\r
+ for <notmuch@notmuchmail.org>; Sat, 24 Oct 2015 10:43:33 -0700 (PDT)\r
+Received: from remotemail by gitolite.debian.net with local (Exim 4.80)\r
+ (envelope-from <bremner@tethera.net>)\r
+ id 1Zq2pS-0001Hj-Lt; Sat, 24 Oct 2015 17:42:06 +0000\r
+Received: (nullmailer pid 32263 invoked by uid 1000); Sat, 24 Oct 2015\r
+ 17:41:28 -0000\r
+From: David Bremner <david@tethera.net>\r
+To: Mark Walters <markwalters1009@gmail.com>, notmuch@notmuchmail.org\r
+Subject: [PATCH 2/3] Emacs: Add address completion mechanism implemented in\r
+ elisp\r
+Date: Sat, 24 Oct 2015 14:41:23 -0300\r
+Message-Id: <1445708484-32189-3-git-send-email-david@tethera.net>\r
+X-Mailer: git-send-email 2.6.1\r
+In-Reply-To: <1445708484-32189-1-git-send-email-david@tethera.net>\r
+References: <1445702019-10638-1-git-send-email-markwalters1009@gmail.com>\r
+ <1445708484-32189-1-git-send-email-david@tethera.net>\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.20\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <https://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch/>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <https://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Sat, 24 Oct 2015 17:43:36 -0000\r
+\r
+From: Michal Sojka <sojkam1@fel.cvut.cz>\r
+\r
+Currently, notmuch has an address completion mechanism that requires\r
+external command to provide completion candidates. This patch adds a\r
+completion mechanism inspired by https://github.com/tjim/nevermore,\r
+which is implemented in Emacs lisp only.\r
+\r
+The preexisting address completion mechanism, activated by pressing TAB\r
+on To/Cc lines, is extended to use the new mechanism when no external\r
+command is configured, i.e. when notmuch-address-command to nil, which\r
+is the new default.\r
+\r
+The core of the new mechanism is the function notmuch-address-harvest,\r
+which collects the completion candidates from the notmuch database and\r
+stores them in notmuch-address-completions variable. The address\r
+harvesting can run either synchronously (same as with the previous\r
+mechanism) or asynchronously. When the user presses TAB for the first\r
+time, synchronous harvesting limited to user entered text is performed.\r
+If the entered text is reasonably long, this operation is relatively\r
+fast. Then, asynchronous harvesting over the full database is triggered.\r
+This operation may take long time (minutes on rotating disk). After it\r
+finishes, no harvesting is normally performed again and subsequent\r
+completion requests use the harvested data cached in memory. Completion\r
+cache is updated after 24 hours.\r
+\r
+Note that this commit restores (different) completion functionality for\r
+users when the user used external command named "notmuch-addresses",\r
+i.e. the old default.  The result will be that the user will use\r
+the new mechanism instead of this command. I believe that many users may\r
+not even recognize this because the new mechanism works the same as\r
+http://commonmeasure.org/~jkr/git/notmuch_addresses.git and perhaps also\r
+as other commands suggested at\r
+http://notmuchmail.org/emacstips/#address_completion.\r
+---\r
+ emacs/notmuch-address.el | 108 +++++++++++++++++++++++++++++++++++++++++++++--\r
+ emacs/notmuch-lib.el     |   3 ++\r
+ 2 files changed, 107 insertions(+), 4 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el\r
+index 39200ef..2a748ec 100644\r
+--- a/emacs/notmuch-address.el\r
++++ b/emacs/notmuch-address.el\r
+@@ -20,14 +20,17 @@\r
+ ;; Authors: David Edmondson <dme@dme.org>\r
\r
+ (require 'message)\r
+-\r
++(require 'notmuch-parser)\r
++(require 'notmuch-lib)\r
+ ;;\r
\r
+-(defcustom notmuch-address-command nil\r
++(defcustom notmuch-address-command 'internal\r
+   "The command which generates possible addresses. It must take a\r
+ single argument and output a list of possible matches, one per\r
+-line. The default value of nil disables address completion."\r
++line. The default value of `internal' uses built-in address\r
++completion."\r
+   :type '(radio\r
++        (const :tag "Use internal address completion" internal)\r
+         (const :tag "Disable address completion" nil)\r
+         (string :tag "Use external completion command" "notmuch-addresses"))\r
+   :group 'notmuch-send\r
+@@ -44,6 +47,17 @@ to know how address selection is made by default."\r
+   :group 'notmuch-send\r
+   :group 'notmuch-external)\r
\r
++(defvar notmuch-address-last-harvest 0\r
++  "Time of last address harvest")\r
++\r
++(defvar notmuch-address-completions (make-hash-table :test 'equal)\r
++  "Hash of email addresses for completion during email composition.\r
++  This variable is set by calling `notmuch-address-harvest'.")\r
++\r
++(defvar notmuch-address-full-harvest-finished nil\r
++  "t indicates that full completion address harvesting has been\r
++finished")\r
++\r
+ (defun notmuch-address-selection-function (prompt collection initial-input)\r
+   "Call (`completing-read'\r
+       PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"\r
+@@ -56,8 +70,32 @@ to know how address selection is made by default."\r
\r
+ (defvar notmuch-address-history nil)\r
\r
++(defun notmuch-address-matching (substring)\r
++  "Returns a list of completion candidates matching SUBSTRING.\r
++The candidates are taked form `notmuch-address-completions'."\r
++  (let ((candidates)\r
++      (re (regexp-quote substring)))\r
++    (maphash (lambda (key val)\r
++             (when (string-match re key)\r
++               (push key candidates)))\r
++           notmuch-address-completions)\r
++    candidates))\r
++\r
+ (defun notmuch-address-options (original)\r
+-  (process-lines notmuch-address-command original))\r
++  "Returns a list of completion candidates. Uses either\r
++elisp-based implementation or older implementation requiring\r
++external commands."\r
++  (cond\r
++   ((eq notmuch-address-command 'internal)\r
++    (when (not notmuch-address-full-harvest-finished)\r
++      ;; First, run quick synchronous harvest based on what the user\r
++      ;; entered so far\r
++      (notmuch-address-harvest (format "to:%s*" original) t))\r
++    (prog1 (notmuch-address-matching original)\r
++      ;; Then (re)start potentially long-running full asynchronous harvesting\r
++      (notmuch-address-harvest-trigger)))\r
++   (t\r
++    (process-lines notmuch-address-command original))))\r
\r
+ (defun notmuch-address-expand-name ()\r
+   (let* ((end (point))\r
+@@ -106,4 +144,66 @@ to know how address selection is made by default."\r
+                          (not (file-directory-p bin))))\r
+             (throw 'found-command bin))))))))\r
\r
++(defun notmuch-address-harvest-addr (result)\r
++  (let ((name-addr (plist-get result :name-addr)))\r
++    (puthash name-addr t notmuch-address-completions)))\r
++\r
++(defun notmuch-address-harvest-handle-result (obj)\r
++  (notmuch-address-harvest-addr obj))\r
++\r
++(defun notmuch-address-harvest-filter (proc string)\r
++  (when (buffer-live-p (process-buffer proc))\r
++    (with-current-buffer (process-buffer proc)\r
++      (save-excursion\r
++      (goto-char (point-max))\r
++      (insert string))\r
++      (notmuch-sexp-parse-partial-list\r
++       'notmuch-address-harvest-handle-result (process-buffer proc)))))\r
++\r
++(defvar notmuch-address-harvest-proc nil)   ; the process of a harvest underway\r
++\r
++(defun notmuch-address-harvest (&optional filter-query synchronous callback)\r
++  "Collect addresses completion candidates. It queries the\r
++notmuch database for all messages sent by the user optionally\r
++matching FILTER-QUERY (if not nil). It collects the destination\r
++addresses from those messages and stores them in\r
++`notmuch-address-completions'. Address harvesting may take some\r
++time so the address collection runs asynchronously unless\r
++SYNCHRONOUS is t. In case of asynchronous execution, CALLBACK is\r
++called when harvesting finishes."\r
++  (let* ((from-me-query (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or "))\r
++       (query (if filter-query\r
++                  (format "(%s) and (%s)" from-me-query filter-query)\r
++                from-me-query))\r
++       (args `("address" "--format=sexp" "--format-version=2"\r
++               "--output=recipients"\r
++               "--deduplicate=address"\r
++               ,query)))\r
++    (if synchronous\r
++      (mapc #'notmuch-address-harvest-addr\r
++                                 (apply 'notmuch-call-notmuch-sexp args))\r
++      ;; Asynchronous\r
++      (when notmuch-address-harvest-proc\r
++      (kill-buffer (process-buffer notmuch-address-harvest-proc))) ; this also kills the process\r
++      (setq notmuch-address-harvest-proc\r
++          (apply 'notmuch-start-notmuch\r
++           "notmuch-address-harvest"          ; process name\r
++           " *notmuch-address-harvest*"       ; process buffer\r
++           callback                           ; process sentinel\r
++           args))\r
++      (set-process-filter notmuch-address-harvest-proc 'notmuch-address-harvest-filter)\r
++      (set-process-query-on-exit-flag notmuch-address-harvest-proc nil)))\r
++  ;; return value\r
++  nil)\r
++\r
++(defun notmuch-address-harvest-trigger ()\r
++  (let ((now (float-time)))\r
++    (when (> (- now notmuch-address-last-harvest) 86400)\r
++      (setq notmuch-address-last-harvest now)\r
++      (notmuch-address-harvest nil nil\r
++                             (lambda (proc event)\r
++                               (setq notmuch-address-full-harvest-finished t))))))\r
++\r
++;;\r
++\r
+ (provide 'notmuch-address)\r
+diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+index 201d7ec..1c3a9fe 100644\r
+--- a/emacs/notmuch-lib.el\r
++++ b/emacs/notmuch-lib.el\r
+@@ -232,6 +232,9 @@ on the command line, and then retry your notmuch command")))\r
+   "Return the user.other_email value (as a list) from the notmuch configuration."\r
+   (split-string (notmuch-config-get "user.other_email") "\n" t))\r
\r
++(defun notmuch-user-emails ()\r
++  (cons (notmuch-user-primary-email) (notmuch-user-other-email)))\r
++\r
+ (defun notmuch-poll ()\r
+   "Run \"notmuch new\" or an external script to import mail.\r
\r
+-- \r
+2.6.1\r
+\r