[PATCH v3] Emacs: Add address completion mechanism implemented in elisp

[Michal Sojka]

On Mon, Sep 08 2014, David Edmondson wrote:
> On Mon, Aug 11 2014, Michal Sojka wrote:
>> 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 core of the new mechanism is the function notmuch-address-harvest
>> that collects the completion candidates from the notmuch database and
>> stores them in notmuch-address-completions variable.
>> notmuch-address-harvest is called on the first entry to message-mode
>> and runs asychnornously so that the user doesn't have to wait for it
>> to complete while composing the message. The
>> notmuch-address-completions variable is used in message-mode as a
>> source of completion candidates. Currently, there are two ways how the
>> notmuch-address-completions variable is used.
>>
>> First, preexisting address completion mechanism is extended to use
>> notmuch-address-completions in addition to the external command. This
>> new behavior is configured by setting notmuch-address-command to nil,
>> which is the new default. Note that this 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.
>>
>> Second way of using notmuch-address-completions is notmuch-company.el.
>> This presents the possible completions in a nice popup box after a
>> short typing delay but requires company-mode to be installed.
>
> This looks great, thanks for doing it. It seems like a better approach
> than id:1409921969-65129-1-git-send-email-dme at dme.org. Some comments:
>
> - Adding the address collection to `message-mode-hook' means that it
>   runs every time I start to compose a message. If the address
>   collection is disk intensive, this might be bad for battery life. 

The actual harvesting starts only when notmuch-address-completions is
nil, i.e. when the message-mode is entered for the first time.

> The set of potential recipients doesn't change _that_ much over time
> for a typical person, I'd wager. Maybe the hook should only run once a
> day? (Tunable, of course.)

The current version of the patch has a drawback that harvesting is never
run again. Adding a tunable option for reharvesting might be a good
idea.

Since initial harvesting is very slow on non-SSD disk, I want to change
the implementation so that initially, only addresses matching the
entered prefix will be harvested, which should be reasonably fast. Then
full harvest will run on background and once it is finished,
prefix-based harvesting won't be used anymore.

Maybe prefix-based harvesting could be then used as a fallback when no
candidates are found in the data from full harvest. This could also be a
solution to the "reharvest" problem.

I've just returned from vacations so I plan to work on that this week.
Jani's --output=address patch also looks like something to play with.

Cheers,
-Michal

>
> - The addition of company mode support (which I haven't tried) should be
>   a separate patch in the series.
>
>> ---
>> Changes from v1:
>> - Use of notmuch-parser.el instead of the custom parser in the
>>   original code. The notmuch parser is slightly faster.
>> - Use of functions in notmuch-query.el instead of functions in the
>>   original code with almost the same functionality.
>> - Integrated with existing completion mechanism in notmuch.
>> - notmuch-company.el was moved from emacs/contrib to emacs and
>>   no-byte-compile directive was added to it.
>> - Aligned with notmuch naming conventions.
>> - Documented bugs found in notmuch-company.el
>>
>> Changes from v2:
>> - Updated Makefile.local to not conflict with current master
>> ---
>>  emacs/Makefile.local     |  6 ++-
>>  emacs/notmuch-address.el | 95 +++++++++++++++++++++++++++++++++++++++++++-----
>>  emacs/notmuch-company.el | 69 +++++++++++++++++++++++++++++++++++
>>  emacs/notmuch-lib.el     |  3 ++
>>  4 files changed, 163 insertions(+), 10 deletions(-)
>>  create mode 100644 emacs/notmuch-company.el
>>
>> diff --git a/emacs/Makefile.local b/emacs/Makefile.local
>> index 1109cfa..6c93e73 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
>> @@ -30,7 +31,10 @@ $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl
>>  emacs_images := \
>>  	$(srcdir)/$(dir)/notmuch-logo.png
>>  
>> -emacs_bytecode = $(emacs_sources:.el=.elc)
>> +# Do not try to install files that are not byte-compiled.
>> +emacs_no_byte_compile := $(dir)/notmuch-company.el
>> +
>> +emacs_bytecode = $(patsubst %.el,%.elc,$(filter-out $(emacs_no_byte_compile),$(emacs_sources)))
>>  
>>  # Because of defmacro's and defsubst's, we have to account for load
>>  # dependencies between Elisp files when byte compiling.  Otherwise,
>> diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
>> index fa65cd5..a50f4f4 100644
>> --- a/emacs/notmuch-address.el
>> +++ b/emacs/notmuch-address.el
>> @@ -20,14 +20,18 @@
>>  ;; Authors: David Edmondson <dme at dme.org>
>>  
>>  (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,10 @@ to know how address selection is made by default."
>>    :group 'notmuch-send
>>    :group 'notmuch-external)
>>  
>> +(defvar notmuch-address-completions nil
>> +  "Hash of email addresses for completion during email composition.
>> +  This variable is set by calling `notmuch-address-harvest'.")
>> +
>>  (defun notmuch-address-selection-function (prompt collection initial-input)
>>    "Call (`completing-read'
>>        PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
>> @@ -60,7 +68,16 @@ to know how address selection is made by default."
>>  	  (push notmuch-address-message-alist-member message-completion-alist))))
>>  
>>  (defun notmuch-address-options (original)
>> -  (process-lines notmuch-address-command original))
>> +  (cond
>> +   ((eq notmuch-address-command nil)
>> +    (let ((candidates))
>> +      (maphash (lambda (key val)
>> +		 (let ((re (concat "\\<" (regexp-quote original))))
>> +		   (when (string-match re key)
>> +		     (push key candidates))))
>> +	       notmuch-address-completions)
>> +      candidates))
>> +   (t (process-lines notmuch-address-command original))))
>>  
>>  (defun notmuch-address-expand-name ()
>>    (let* ((end (point))
>> @@ -108,11 +125,71 @@ 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)
>> +(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 ()
>> +  "Collect possible addresses for completion. It queries the
>> +notmuch database for all emails sent by the user and collects the
>> +destination addresses from them in
>> +`notmuch-address-completions'. This takes some time so the
>> +address collection runs asynchronously."
>> +  (when notmuch-address-harvest-proc
>> +    (kill-buffer (process-buffer notmuch-address-harvest-proc)) ; this also kills the process
>> +    (setq notmuch-address-harvest-proc nil))
>> +  (setq notmuch-address-completions (make-hash-table :test 'equal))
>> +  (setq notmuch-address-harvest-proc
>> +        (notmuch-start-notmuch
>> +         "notmuch-address-harvest"	; process name
>> +         " *notmuch-address-harvest*"	; process buffer
>> +         nil				; process sentinel
>> +         "show"				; notmuch command
>> +         "--format=sexp"
>> +         "--format-version=2"
>> +         "--body=false"
>> +         "--entire-thread=false"
>> +	 (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or ")))
>> +  (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'
>> +;; or if it is nil, insinuate ourselves into `message-mode'.
>> +(when (or (eq notmuch-address-command nil)
>> +	  (notmuch-address-locate-command notmuch-address-command))
>>    (notmuch-address-message-insinuate))
>>  
>> +(defun notmuch-address-harvest-start ()
>> +  (when (not notmuch-address-completions) (notmuch-address-harvest)))
>> +
>> +(when (eq notmuch-address-command nil)
>> +  (add-hook 'message-mode-hook 'notmuch-address-harvest-start))
>> +
>>  ;;
>>  
>>  (provide 'notmuch-address)
>> diff --git a/emacs/notmuch-company.el b/emacs/notmuch-company.el
>> new file mode 100644
>> index 0000000..748fcee
>> --- /dev/null
>> +++ b/emacs/notmuch-company.el
>> @@ -0,0 +1,69 @@
>> +;; -*-no-byte-compile: t; -*-
>> +
>> +;; notmuch-company.el --- Mail address completion for notmuch via company-mode
>> +
>> +;; Author: Trevor Jim <tjim at mac.com>
>> +;; 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 add
>> +;;
>> +;;     (require 'notmuch-company)
>> +;;
>> +;; to your .emacs.
>> +;;
>> +;; NB company-minimum-prefix-length defaults to 3 so you don't get
>> +;; completion unless you type 3 characters
>> +
>> +;;; Bugs:
>> +;;
>> +;; - matching is case sensitive
>> +;; - matching of non-ascii characters doesn't work well
>> +
>> +;;; Code:
>> +
>> +(require 'company)
>> +(require 'message)
>> +(require 'notmuch-address)
>> +
>> +(defvar-local notmuch-company-last-prefix nil)
>> +;;;###autoload
>> +(defun notmuch-company (command &optional arg &rest ignore)
>> +  "`company-mode' completion back-end for `notmuch'."
>> +  (interactive (list 'interactive))
>> +  (let ((case-fold-search t))
>> +    (pcase command
>> +      (`interactive (company-begin-backend 'notmuch-company))
>> +      (`prefix (and (eq major-mode 'message-mode)
>> +                    (looking-back "^\\(To\\|Cc\\|Bcc\\):.*"
>> +                                  (line-beginning-position))
>> +                    (setq notmuch-company-last-prefix (company-grab-symbol))))
>> +      (`candidates (let ((results (completion-substring--all-completions arg notmuch-address-completions nil 0)))
>> +                     (when results (car results))))
>> +      (`match (if (string-match notmuch-company-last-prefix arg)
>> +                  (match-end 0)
>> +                0))
>> +      (`no-cache t))))
>> +
>> +(add-hook 'message-mode-hook '(lambda ()
>> +                                (company-mode)
>> +                                (make-local-variable 'company-backends)
>> +                                (setq company-backends '(notmuch-company))
>> +				(notmuch-address-harvest-start)))
>> +
>> +(provide 'notmuch-company)
>> diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
>> index 19269e3..00e8554 100644
>> --- a/emacs/notmuch-lib.el
>> +++ b/emacs/notmuch-lib.el
>> @@ -228,6 +228,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.0.1