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

[Mark Walters]

On Sat, 24 Oct 2015, David Bremner <david at tethera.net> wrote:
> From: Michal Sojka <sojkam1 at fel.cvut.cz>
>
> With this patch, address completion candidates are shown automatically
> after short typing delay in a nice popup box. This requires company-mode
> to be installed and it works only on Emacs >= 24. 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.
> ---
>  emacs/Makefile.local     |  1 +
>  emacs/notmuch-company.el | 73 ++++++++++++++++++++++++++++++++++++++++++++++++
>  emacs/notmuch-mua.el     | 13 ++++++++-
>  3 files changed, 86 insertions(+), 1 deletion(-)
>  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-company.el b/emacs/notmuch-company.el
> new file mode 100644
> index 0000000..03c492f
> --- /dev/null
> +++ b/emacs/notmuch-company.el
> @@ -0,0 +1,73 @@
> +;; notmuch-company.el --- Mail address completion for notmuch via company-mode  -*- lexical-binding: t -*-
> +
> +
> +;; Authors: Trevor Jim <tjim at mac.com>
> +;; 	    Michal Sojka <sojkam1 at 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/)
> +;; and customize notmuch-message-use-company
> +;;
> +;; NB company-minimum-prefix-length defaults to 3 so you don't get
> +;; completion unless you type 3 characters
> +
> +;;; Code:
> +
> +(require 'notmuch-address)
> +(require 'cl-lib)
> +
> +(defvar-local notmuch-company-last-prefix nil)
> +(declare-function company-begin-backend "company")
> +(declare-function company-grab "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))
> +    (cl-case command
> +      (interactive (company-begin-backend 'notmuch-company))
> +      (prefix (and (derived-mode-p 'message-mode)
> +		   (looking-back "^\\(To\\|Cc\\|Bcc\\):.*"
> +				 (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 (re)start potentially long-running full asynchronous harvesting
> +			       (notmuch-address-harvest-trigger))))))))

I have found a bug in this but I don't know the best way to fix it.

If you start notmuch in emacs, start composing a message, type 3 letters
(say) in the to line and press tab then you get the "quick" address
completion, and it starts the full harvest. However if you don't select
one of the addresses and just type another character and pause then
notmuch-company starts and it sees that you haven't got a full harvest
so it asynchronously gets the quick completions. But this kills the main
harvest (the "; this also kills the process" line in
notmuch-address.el). The sentinel for the full harvest then marks the
full harvest complete.

Since it is marked complete the full harvest won't ever get done (or
not until the completion timeouts in 24 hours). 

The first part of the fix is probably to only mark the harvest complete
if the sentinel returns normally. But it may need more, perhaps to run
the async quick case in a separate buffer from the full harvest.

Best wishes

Mark


> +      (match (if (string-match notmuch-company-last-prefix arg)
> +		 (match-end 0)
> +	       0))
> +      (no-cache t))))
> +
> +
> +(provide 'notmuch-company)
> diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
> index 6cc9656..c90381d 100644
> --- a/emacs/notmuch-mua.el
> +++ b/emacs/notmuch-mua.el
> @@ -25,6 +25,7 @@
>  
>  (require 'notmuch-lib)
>  (require 'notmuch-address)
> +(require 'notmuch-company)
>  
>  (eval-when-compile (require 'cl))
>  
> @@ -268,12 +269,22 @@ Note that these functions use `mail-citation-hook' if that is non-nil."
>    (message-goto-body)
>    (set-buffer-modified-p nil))
>  
> +(defcustom notmuch-message-use-company t
> +  "If available, use company mode for completion in notmuch-message-mode"
> +  :type 'boolean
> +  :group 'notmuch-send)
> +
>  (define-derived-mode notmuch-message-mode message-mode "Message[Notmuch]"
>    "Notmuch message composition mode. Mostly like `message-mode'"
>    (when notmuch-address-command
>      (unless (memq notmuch-address-message-alist-member message-completion-alist)
>        (setq message-completion-alist
> -	    (push notmuch-address-message-alist-member message-completion-alist)))))
> +	    (push notmuch-address-message-alist-member message-completion-alist))))
> +  (when (and notmuch-message-use-company
> +	     (require 'company nil t))
> +    (company-mode)
> +    (make-local-variable 'company-backends)
> +    (setq company-backends '(notmuch-company))))
>  
>  (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.6.1