From: Michal Sojka <sojkam1@fel.cvut.cz>
To: notmuch@notmuchmail.org
Subject: [PATCH RFC] Emacs: Add address completion mechanism implemented in
	elisp
Date: Tue, 29 Jul 2014 18:57:50 +0200
Message-Id: <1406653070-13174-1-git-send-email-sojkam1@fel.cvut.cz>
In-Reply-To: <87bns8f6hi.fsf@steelpick.2x.cz>
References: <87bns8f6hi.fsf@steelpick.2x.cz>
Cc: tjim@mac.com
Precedence: list

Notmuch currently has an address completion mechanism that requires
external script to provide completion candidates. This patch adds a
completion mechanism found in https://github.com/tjim/nevermore, which
is implemented in elisp only.

notmuch-lib.el is extended with function notmuch-async-harvest that
collects the completion candidates from notmuch database and stores
them in notmuch-completion-addresses.

notmuch-company.el hooks itself into message-mode and uses
company-mode to offer the completion to the user. The file is put into
the contrib directory which means that the use has to install it
himself. This is because company-mode is not a part of Emacs and
bytecompiling notmuch-company.el fails due to used --quick option that
causes user installed packages to be ignored. Moreover, Debian
bytecompiles elisp files during installation which would require
having company-mode packaged for Debian. This would be possible but
company-mode requires emacs24 which would complicate notmuch Debian
maintainer scripts.

It would probably make sense to implement another completion frontend
based only on Emacs built-in functionality and integrate it with
notmuch-addresses.el.

The original  nevermore code was modified in the following ways:
1) Prefix was changes from nm- to notmuch-.
2) A few docstrings and comments were added.
3) notmuch-flatten-* functions were renamed to match match
   devel/schemata.
---
 debian/notmuch-emacs.examples    |  1 +
 emacs/contrib/notmuch-company.el | 62 ++++++++++++++++++++++++++++
 emacs/notmuch-lib.el             | 87 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 150 insertions(+)
 create mode 100644 debian/notmuch-emacs.examples
 create mode 100644 emacs/contrib/notmuch-company.el

diff --git a/debian/notmuch-emacs.examples b/debian/notmuch-emacs.examples
new file mode 100644
index 0000000..4a42a47
--- /dev/null
+++ b/debian/notmuch-emacs.examples
@@ -0,0 +1 @@
+emacs/contrib/notmuch-company.el
diff --git a/emacs/contrib/notmuch-company.el b/emacs/contrib/notmuch-company.el
new file mode 100644
index 0000000..228de94
--- /dev/null
+++ b/emacs/contrib/notmuch-company.el
@@ -0,0 +1,62 @@
+;; notmuch-company.el --- Mail address completion for notmuch via company-mode
+
+;; Author: Trevor Jim <tjim@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
+
+
+;;; Code:
+
+(require 'company)
+(require 'message)
+(require 'notmuch-lib)
+
+(defvar-local notmuch-company-last-prefix nil)
+;;;###autoload
+(defun notmuch-company (command &optional arg &rest ignore)
+  "`company-mode' completion back-end for `nevermore (nm)'."
+  (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-completion-addresses 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))
+				(when (not notmuch-completion-addresses) (notmuch-async-harvest))))
+(provide 'notmuch-company)
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 2941da3..c0f4ba0 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -216,6 +216,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.
 
@@ -845,6 +848,90 @@ status."
 (defvar notmuch-show-process-crypto nil)
 (make-variable-buffer-local 'notmuch-show-process-crypto)
 
+(defun notmuch-flatten-thread-set (thread-set)
+  "Convert the result of 'notmuch show' to the plain list of messages."
+;;  (display-message-or-buffer (format "Before: %S" thread-set))
+  (let ((result
+         (apply 'append
+                (mapcar 'notmuch-flatten-thread thread-set))))
+;;    (display-message-or-buffer (format "After: %S" result))
+    result))
+
+(defun notmuch-flatten-thread (thread)
+  (apply 'append
+         (mapcar 'notmuch-flatten-thread-node thread)))
+
+(defun notmuch-flatten-thread-node (thread-node)
+  (let ((msg (car thread-node))
+	(replies (cadr thread-node)))
+    (if msg
+        (cons msg (notmuch-flatten-thread replies))
+      (notmuch-flatten-thread replies))))
+
+;;; async address harvesting
+(defvar notmuch-completion-addresses nil
+  "Hash of email addresses for completion during email composition.
+  This variable is set by `notmuch-async-harvest'.")
+
+(defvar notmuch-async-harvest-pending-proc nil)   ; the process of a harvest underway
+(defvar notmuch-async-harvest-pending-output nil) ; holds the not-yet-processed part of the output of the harvest process
+(defun notmuch-async-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-completion-addresses'. This takes some time so the
+address collection runs asynchronously."
+  (when notmuch-async-harvest-pending-proc
+      (ignore-errors (kill-process notmuch-async-harvest-pending-proc))
+      ; kill-process sends signal, actual process death is asynchronous, so indicate that we want the process dead
+      (setq notmuch-async-harvest-pending-proc nil))
+  (setq notmuch-completion-addresses (make-hash-table :test 'equal))
+  (setq notmuch-async-harvest-pending-output nil) ; indicate that we have not gotten any output yet
+  (setq notmuch-async-harvest-pending-proc
+        (notmuch-start-notmuch
+         "notmuch-async-harvest" ; process name
+         nil                ; 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-async-harvest-pending-proc
+   (lambda (proc string)
+     (when (and notmuch-async-harvest-pending-proc (equal (process-id proc) (process-id notmuch-async-harvest-pending-proc)))
+       (if notmuch-async-harvest-pending-output
+                                        ; This is not the first time we have seen output, add it to anything remaining from last time
+           (setq notmuch-async-harvest-pending-output (concat notmuch-async-harvest-pending-output string))
+                                        ; This is the first time we have seen output.  Skip the initial open paren
+         (setq notmuch-async-harvest-pending-output (substring string 1)))
+       (while
+           (let ((result (ignore-errors (read-from-string notmuch-async-harvest-pending-output))))
+             (and result
+                  (let ((obj (car result))
+                        (offset (cdr result)))
+                    (setq notmuch-async-harvest-pending-output (substring notmuch-async-harvest-pending-output offset))
+                    (let ((msgs (notmuch-flatten-thread-set (list obj))))
+                      (mapc
+                       (lambda (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-completion-addresses)))
+                                 (append to cc bcc))))
+                       msgs)
+                      t))))))))
+  ; return value
+  nil)
+
 (provide 'notmuch-lib)
 
 ;; Local Variables:
-- 
2.0.1