[PATCH v4 0/3] Emacs: Address completion implemented in elisp

[PATCH v4 0/3] Emacs: Address completion implemented in elisp

[Michal Sojka]

Hi,

this is another version of my address completion patchset. It
obsoletes id:1407771091-12651-1-git-send-email-sojkam1@fel.cvut.cz.

This version works reasonably well on systems with rotating disk,
which was my main problem with the previous version. It also
incorporates suggestions pointed out by others.

This is not (yet) based on Jani's patch for printing the addresses by
notmuch search (id:1410021689-15901-1-git-send-email-jani@nikula.org).
I'll at this as a next step as it will simplify the elisp code and
make the address completion faster.

Michal Sojka (3):
  Emacs: Display a message when generating address completion candidates
  Emacs: Add address completion mechanism implemented in elisp
  Emacs: Add address completion based on company-mode

 emacs/Makefile.local     |   6 ++-
 emacs/notmuch-address.el | 126 +++++++++++++++++++++++++++++++++++++++++++----
 emacs/notmuch-company.el |  81 ++++++++++++++++++++++++++++++
 emacs/notmuch-lib.el     |   3 ++
 4 files changed, 206 insertions(+), 10 deletions(-)
 create mode 100644 emacs/notmuch-company.el

-- 
2.1.0

[PATCH v4 1/3] Emacs: Display a message when generating address completion candidates

[Michal Sojka]

The TAB-initiated address completion generates completion candidates
synchronously, blocking the UI. Since this can take long time, it is
better to let the use know what's happening.
---
 emacs/notmuch-address.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
index fa65cd5..fde3c1b 100644
--- a/emacs/notmuch-address.el
+++ b/emacs/notmuch-address.el
@@ -70,7 +70,8 @@ to know how address selection is made by default."
 		(point)))
 	 (orig (buffer-substring-no-properties beg end))
 	 (completion-ignore-case t)
-	 (options (notmuch-address-options orig))
+	 (options (with-temp-message "Looking for completion candidates..."
+		    (notmuch-address-options orig)))
 	 (num-options (length options))
 	 (chosen (cond
 		  ((eq num-options 0)
-- 
2.1.0

[PATCH v4 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 patch 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 no external
command is configured, i.e. when notmuch-address-command to nil, 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 the change of the notmuch-address-command default value
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.

---
Changes from v3:
- Implemented both synchronous and asynchronous harvesting. The
  synchronous implementation that uses faster "filtered" query is used
  until the full asynchronous harvesting finishes.
- Added automatic refresh of completion cache every 24 hours.

Changes from v2:
- Updated Makefile.local to not conflict with current master

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
---
 emacs/notmuch-address.el | 123 ++++++++++++++++++++++++++++++++++++++++++++---
 emacs/notmuch-lib.el     |   3 ++
 2 files changed, 118 insertions(+), 8 deletions(-)

diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
index fde3c1b..9f6711b 100644
--- a/emacs/notmuch-address.el
+++ b/emacs/notmuch-address.el
@@ -20,14 +20,18 @@
 ;; Authors: David Edmondson <dme@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,17 @@ 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)"
@@ -59,8 +74,32 @@ to know how address selection is made by default."
     (setq message-completion-alist
 	  (push notmuch-address-message-alist-member message-completion-alist))))
 
+(defun notmuch-address-matching (substring)
+  "Returns a list of completion candidates matching SUBSTRING.
+The candidates are taked form `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
+   ((null notmuch-address-command)
+    (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 (re)start potentially long-running full asynchronous harvesting
+      (notmuch-address-harvest-trigger)))
+   (t
+    (process-lines notmuch-address-command original))))
 
 (defun notmuch-address-expand-name ()
   (let* ((end (point))
@@ -109,11 +148,79 @@ to know how address selection is made by default."
 			   (not (file-directory-p bin))))
 	      (throw 'found-command bin))))))))
 
+(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 (&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 `("show" "--format=sexp" "--format-version=2"
+		 "--body=false" "--entire-thread=false" ,query)))
+    (if synchronous
+	(notmuch-query-map-threads 'notmuch-address-harvest-msg
+				   (apply 'notmuch-call-notmuch-sexp args))
+      ;; Asynchronous
+      (when notmuch-address-harvest-proc
+	(kill-buffer (process-buffer notmuch-address-harvest-proc))) ; this also kills the process
+      (setq notmuch-address-harvest-proc
+	    (apply 'notmuch-start-notmuch
+	     "notmuch-address-harvest"		; process name
+	     " *notmuch-address-harvest*"	; process buffer
+	     callback				; process sentinel
+	     args))
+      (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',
-;; insinuate ourselves into `message-mode'.
-(when (notmuch-address-locate-command notmuch-address-command)
+;; or if it is nil, insinuate ourselves into `message-mode'.
+(when (or (null notmuch-address-command)
+	  (notmuch-address-locate-command notmuch-address-command))
   (notmuch-address-message-insinuate))
 
+(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)
+				 (setq notmuch-address-full-harvest-finished t))))))
+
 ;;
 
 (provide 'notmuch-address)
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.1.0

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

[Michal Sojka]

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.

The notmuch-company.el is excluded from byte-compilation, because it
would require every person who want to compile notmuch to have
company-mode installed.
---
 emacs/Makefile.local     |  6 +++-
 emacs/notmuch-company.el | 81 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 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..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-company.el b/emacs/notmuch-company.el
new file mode 100644
index 0000000..0d4fe49
--- /dev/null
+++ b/emacs/notmuch-company.el
@@ -0,0 +1,81 @@
+;; notmuch-company.el --- Mail address completion for notmuch via company-mode  -*- no-byte-compile: t; 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/)
+;; 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
+
+;;; Code:
+
+(require 'company)
+(require 'message)
+(require 'notmuch-address)
+(require 'cl-lib)
+
+(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)
+	(completion-ignore-case t))
+    (cl-case 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 "[:,][ \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))))))))
+      (match (if (string-match notmuch-company-last-prefix arg)
+		 (match-end 0)
+	       0))
+      (no-cache t))))
+
+;;;###autoload
+(add-hook 'message-mode-hook '(lambda ()
+                                (company-mode)
+                                (make-local-variable 'company-backends)
+                                (setq company-backends '(notmuch-company))))
+
+(provide 'notmuch-company)
-- 
2.1.0

[PATCH] emacs: convert notmuch-address-harvester to use notmuch-address

[David Bremner]

No attempt is made to optimize anything here, just drop in the
new command.
---
In a few subjective tests, this seems quite a bit faster than
the version based on notmuch-show

emacs/notmuch-address.el | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
index 9f6711b..de0b991 100644
--- a/emacs/notmuch-address.el
+++ b/emacs/notmuch-address.el
@@ -188,8 +188,8 @@ called when harvesting finishes."
 	 (query (if filter-query
 		    (format "(%s) and (%s)" from-me-query filter-query)
 		  from-me-query))
-	 (args `("show" "--format=sexp" "--format-version=2"
-		 "--body=false" "--entire-thread=false" ,query)))
+	 (args `("address" "--format=sexp" "--format-version=2"
+		 ,query)))
     (if synchronous
 	(notmuch-query-map-threads 'notmuch-address-harvest-msg
 				   (apply 'notmuch-call-notmuch-sexp args))
-- 
2.1.4

[PATCH] emacs: convert notmuch-address-harvester to use notmuch-address

[David Bremner]

No attempt is made to optimize anything here, just drop in the new
command. In particular the use of --output=recipients is known to be
slower than --output=senders, but it fit the existing logic better.
---
Let us never speak of the parent message again.
 emacs/notmuch-address.el | 25 ++++++++-----------------
 1 file changed, 8 insertions(+), 17 deletions(-)

diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
index 9f6711b..d54a8bb 100644
--- a/emacs/notmuch-address.el
+++ b/emacs/notmuch-address.el
@@ -20,7 +20,6 @@
 ;; Authors: David Edmondson <dme@dme.org>
 
 (require 'message)
-(require 'notmuch-query)
 (require 'notmuch-parser)
 
 ;;
@@ -148,21 +147,12 @@ external commands."
 			   (not (file-directory-p bin))))
 	      (throw 'found-command bin))))))))
 
-(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-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-query-map-threads 'notmuch-address-harvest-msg (list obj)))
+  (notmuch-address-harvest-addr obj))
 
 (defun notmuch-address-harvest-filter (proc string)
   (when (buffer-live-p (process-buffer proc))
@@ -188,10 +178,11 @@ called when harvesting finishes."
 	 (query (if filter-query
 		    (format "(%s) and (%s)" from-me-query filter-query)
 		  from-me-query))
-	 (args `("show" "--format=sexp" "--format-version=2"
-		 "--body=false" "--entire-thread=false" ,query)))
+	 (args `("address" "--format=sexp" "--format-version=2"
+		 "--output=recipients"
+		 ,query)))
     (if synchronous
-	(notmuch-query-map-threads 'notmuch-address-harvest-msg
+	(mapc #'notmuch-address-harvest-addr
 				   (apply 'notmuch-call-notmuch-sexp args))
       ;; Asynchronous
       (when notmuch-address-harvest-proc
-- 
2.1.4

Re: [PATCH v4 1/3] Emacs: Display a message when generating address completion candidates

[David Bremner]

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

> The TAB-initiated address completion generates completion candidates
> synchronously, blocking the UI. Since this can take long time, it is
> better to let the use know what's happening.
> ---

Pushed this one patch.

d

Re: [PATCH] emacs: convert notmuch-address-harvester to use notmuch-address

[David Edmondson]

On Sat, Jan 17 2015, David Bremner wrote:
> No attempt is made to optimize anything here, just drop in the
> new command.
> ---
> In a few subjective tests, this seems quite a bit faster than
> the version based on notmuch-show

The changes look fine to me.

> emacs/notmuch-address.el | 4 ++--
>  1 file changed, 2 insertions(+), 2 deletions(-)
>
> diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
> index 9f6711b..de0b991 100644
> --- a/emacs/notmuch-address.el
> +++ b/emacs/notmuch-address.el
> @@ -188,8 +188,8 @@ called when harvesting finishes."
>  	 (query (if filter-query
>  		    (format "(%s) and (%s)" from-me-query filter-query)
>  		  from-me-query))
> -	 (args `("show" "--format=sexp" "--format-version=2"
> -		 "--body=false" "--entire-thread=false" ,query)))
> +	 (args `("address" "--format=sexp" "--format-version=2"
> +		 ,query)))
>      (if synchronous
>  	(notmuch-query-map-threads 'notmuch-address-harvest-msg
>  				   (apply 'notmuch-call-notmuch-sexp args))
> -- 
> 2.1.4