Emacs: Add address completion mechanism implemented in elisp

Currently, notmuch has an address completion mechanism that requires
external command to provide completion candidates. This commit 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
notmuch-address-command to 'internal, 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.

[This feature was significantly improved by David Bremner and Mark Walters]

diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
index e2af8792c34af6ad95e01ca29f2e8a3eaca33c25..498ef8ae4e9f86400952708ebf89a4eb531a89e6 100644 (file)
--- 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 taken from `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 start the (potentially long-running) full asynchronous harvest if necessary
+      (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 201d7ec8593f376c1ae9f20a3671eff52535e4bc..1c3a9fe1865f13048c23dbc1b00b702cf15f1081 100644 (file)
--- 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.