[PATCH v8 0/3] elisp + company completion patches

[PATCH v8 0/3] elisp + company completion patches

[Michal Sojka]

Hi David, Mark and others,

thank you for pushing these patches forward. I gave them some testing
and they work as expected. In this version I addressed the comments to
v7 including Tomi's request for rewording :) The commit message of 2/3
was also updated to reflect changes in the code.

Cheers.
-Michal

David Bremner (1):
  emacs: replace use of notmuch-address-message-insinuate

Michal Sojka (2):
  Emacs: Add address completion mechanism implemented in elisp
  Emacs: Add address completion based on company-mode

 emacs/Makefile.local     |   1 +
 emacs/notmuch-address.el | 213 ++++++++++++++++++++++++++++++++++++++---------
 emacs/notmuch-company.el |  86 +++++++++++++++++++
 emacs/notmuch-lib.el     |   3 +
 emacs/notmuch-mua.el     |   4 +-
 5 files changed, 265 insertions(+), 42 deletions(-)
 create mode 100644 emacs/notmuch-company.el

-- 
2.5.3

[PATCH v8 1/3] emacs: replace use of notmuch-address-message-insinuate

[Michal Sojka]

From: David Bremner <david@tethera.net>

This allows e.g. Gnus users to load this file without changing
message-mode behaviour.

This will disable completion for those that did not customize the
variable but relied on the existence of a file named "notmuch-addresses"
in their path. In the next commit the default behaviour will change to
use a "workalike" internal completion mechanism.
---
 emacs/notmuch-address.el | 19 ++++++++-----------
 emacs/notmuch-mua.el     |  4 +++-
 2 files changed, 11 insertions(+), 12 deletions(-)

diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
index fde3c1b..e2af879 100644
--- a/emacs/notmuch-address.el
+++ b/emacs/notmuch-address.el
@@ -23,11 +23,13 @@
 
 ;;
 
-(defcustom notmuch-address-command "notmuch-addresses"
+(defcustom notmuch-address-command nil
   "The command which generates possible addresses. It must take a
 single argument and output a list of possible matches, one per
-line."
-  :type 'string
+line. The default value of nil disables address completion."
+  :type '(radio
+	  (const :tag "Disable address completion" nil)
+	  (string :tag "Use external completion command" "notmuch-addresses"))
   :group 'notmuch-send
   :group 'notmuch-external)
 
@@ -55,10 +57,12 @@ to know how address selection is made by default."
 (defvar notmuch-address-history nil)
 
 (defun notmuch-address-message-insinuate ()
+  (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))))
-
 (defun notmuch-address-options (original)
   (process-lines notmuch-address-command original))
 
@@ -109,11 +113,4 @@ to know how address selection is made by default."
 			   (not (file-directory-p bin))))
 	      (throw 'found-command bin))))))))
 
-;; If we can find the program specified by `notmuch-address-command',
-;; insinuate ourselves into `message-mode'.
-(when (notmuch-address-locate-command notmuch-address-command)
-  (notmuch-address-message-insinuate))
-
-;;
-
 (provide 'notmuch-address)
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index 57465b2..fd98ea4 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -269,7 +269,9 @@ Note that these functions use `mail-citation-hook' if that is non-nil."
   (set-buffer-modified-p nil))
 
 (define-derived-mode notmuch-message-mode message-mode "Message[Notmuch]"
-  "Notmuch message composition mode. Mostly like `message-mode'")
+  "Notmuch message composition mode. Mostly like `message-mode'"
+  (when notmuch-address-command
+    (notmuch-address-setup)))
 
 (define-key notmuch-message-mode-map (kbd "C-c C-c") #'notmuch-mua-send-and-exit)
 (define-key notmuch-message-mode-map (kbd "C-c C-s") #'notmuch-mua-send)
-- 
2.5.3

[PATCH v8 2/3] Emacs: Add address completion mechanism implemented in elisp

[Michal Sojka]

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]
---
 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..498ef8a 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 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 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.5.3

[PATCH v8 3/3] Emacs: Add address completion based on company-mode

[Michal Sojka]

When company-mode is available (Emacs >= 24), address completion
candidates are shown in a nice popup box. This is triggered either by
pressing TAB or by waiting a while during typing an address. The
completion is based entirely on the asynchronous address harvesting
from notmuch-address.el so the GUI is theoretically not blocked for
long time.

The completion works similarly as the TAB-initiated completion from
notmuch-address.el, i.e. quick harvest based on user input is executed
first and only after full harvesting is finished, in-memory cached data
is used.

[Improved by David Bremner]
---
 emacs/Makefile.local     |  1 +
 emacs/notmuch-address.el | 18 ++++++++--
 emacs/notmuch-company.el | 86 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 103 insertions(+), 2 deletions(-)
 create mode 100644 emacs/notmuch-company.el

diff --git a/emacs/Makefile.local b/emacs/Makefile.local
index 1109cfa..4c06c52 100644
--- a/emacs/Makefile.local
+++ b/emacs/Makefile.local
@@ -20,6 +20,7 @@ emacs_sources := \
 	$(dir)/notmuch-print.el \
 	$(dir)/notmuch-version.el \
 	$(dir)/notmuch-jump.el \
+	$(dir)/notmuch-company.el
 
 $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp
 $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl
diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
index 498ef8a..49e2402 100644
--- a/emacs/notmuch-address.el
+++ b/emacs/notmuch-address.el
@@ -22,7 +22,9 @@
 (require 'message)
 (require 'notmuch-parser)
 (require 'notmuch-lib)
+(require 'notmuch-company)
 ;;
+(declare-function company-manual-begin "company")
 
 (defcustom notmuch-address-command 'internal
   "The command which generates possible addresses. It must take a
@@ -72,9 +74,21 @@ finished")
 (defun notmuch-address-message-insinuate ()
   (message "calling notmuch-address-message-insinuate is no longer needed"))
 
+(defcustom notmuch-address-use-company t
+  "If available, use company mode for address completion"
+  :type 'boolean
+  :group 'notmuch-send)
+
 (defun notmuch-address-setup ()
-  (let ((pair (cons notmuch-address-completion-headers-regexp
-		    #'notmuch-address-expand-name)))
+  (let* ((use-company (and notmuch-address-use-company
+			   (eq notmuch-address-command 'internal)
+			   (require 'company nil t)))
+	 (pair (cons notmuch-address-completion-headers-regexp
+		     (if use-company
+			 #'company-manual-begin
+		       #'notmuch-address-expand-name))))
+      (when use-company
+	(notmuch-company-setup))
       (unless (memq pair message-completion-alist)
 	(setq message-completion-alist
 	      (push pair message-completion-alist)))))
diff --git a/emacs/notmuch-company.el b/emacs/notmuch-company.el
new file mode 100644
index 0000000..add3161
--- /dev/null
+++ b/emacs/notmuch-company.el
@@ -0,0 +1,86 @@
+;; notmuch-company.el --- Mail address completion for notmuch via company-mode  -*- lexical-binding: t -*-
+
+;; Authors: Trevor Jim <tjim@mac.com>
+;; 	    Michal Sojka <sojkam1@fel.cvut.cz>
+;;
+;; Keywords: mail, completion
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; To enable this, install company mode (https://company-mode.github.io/)
+;;
+;; NB company-minimum-prefix-length defaults to 3 so you don't get
+;; completion unless you type 3 characters
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defvar notmuch-company-last-prefix nil)
+(make-variable-buffer-local 'notmuch-company-last-prefix)
+(declare-function company-begin-backend "company")
+(declare-function company-grab "company")
+(declare-function company-mode "company")
+(declare-function company-manual-begin "company")
+(defvar company-backends)
+
+(declare-function notmuch-address-harvest "notmuch-address")
+(declare-function notmuch-address-harvest-trigger "notmuch-address")
+(declare-function notmuch-address-matching "notmuch-address")
+(defvar notmuch-address-full-harvest-finished)
+(defvar notmuch-address-completion-headers-regexp)
+
+;;;###autoload
+(defun notmuch-company-setup ()
+  (company-mode)
+  (make-local-variable 'company-backends)
+  (setq company-backends '(notmuch-company)))
+
+;;;###autoload
+(defun notmuch-company (command &optional arg &rest _ignore)
+  "`company-mode' completion back-end for `notmuch'."
+  (interactive (list 'interactive))
+  (require 'company)
+  (let ((case-fold-search t)
+	(completion-ignore-case t))
+    (case command
+      (interactive (company-begin-backend 'notmuch-company))
+      (prefix (and (derived-mode-p 'message-mode)
+		   (looking-back (concat notmuch-address-completion-headers-regexp ".*")
+				 (line-beginning-position))
+		   (setq notmuch-company-last-prefix (company-grab "[:,][ \t]*\\(.*\\)" 1 (point-at-bol)))))
+      (candidates (cond
+		   (notmuch-address-full-harvest-finished
+		    ;; Update harvested addressed from time to time
+		    (notmuch-address-harvest-trigger)
+		    (notmuch-address-matching arg))
+		   (t
+		    (cons :async
+			  (lambda (callback)
+			    ;; First run quick asynchronous harvest based on what the user entered so far
+			    (notmuch-address-harvest
+			     (format "to:%s*" arg) nil
+			     (lambda (_proc _event)
+			       (funcall callback (notmuch-address-matching arg))
+			       ;; Then start the (potentially long-running) full asynchronous harvest if necessary
+			       (notmuch-address-harvest-trigger))))))))
+      (match (if (string-match notmuch-company-last-prefix arg)
+		 (match-end 0)
+	       0))
+      (no-cache t))))
+
+
+(provide 'notmuch-company)
-- 
2.5.3

Re: [PATCH v8 0/3] elisp + company completion patches

[David Bremner]

Michal Sojka <sojkam1@fel.cvut.cz> writes:

> Hi David, Mark and others,
>
> thank you for pushing these patches forward. I gave them some testing
> and they work as expected. In this version I addressed the comments to
> v7 including Tomi's request for rewording :) The commit message of 2/3
> was also updated to reflect changes in the code.
>
> Cheers.
> -Michal

Hi Michal;

Thanks for doing the final polishing. These patches are in master now.

d