[PATCH v2] Emacs: Add address completion mechanism implemented in elisp
authorMichal Sojka <sojkam1@fel.cvut.cz>
Mon, 11 Aug 2014 14:32:29 +0000 (16:32 +0200)
committerW. Trevor King <wking@tremily.us>
Fri, 7 Nov 2014 18:04:11 +0000 (10:04 -0800)
64/e053ffce23531f0976138325984393a9b80374 [new file with mode: 0644]

diff --git a/64/e053ffce23531f0976138325984393a9b80374 b/64/e053ffce23531f0976138325984393a9b80374
new file mode 100644 (file)
index 0000000..4013c3b
--- /dev/null
@@ -0,0 +1,351 @@
+Return-Path: <sojkam1@fel.cvut.cz>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+       by olra.theworths.org (Postfix) with ESMTP id 20998431FAF\r
+       for <notmuch@notmuchmail.org>; Mon, 11 Aug 2014 07:33:02 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -2.3\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-2.3 tagged_above=-999 required=5\r
+       tests=[RCVD_IN_DNSWL_MED=-2.3] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+       by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+       with ESMTP id mKBJEQZGWwdJ for <notmuch@notmuchmail.org>;\r
+       Mon, 11 Aug 2014 07:32:53 -0700 (PDT)\r
+Received: from max.feld.cvut.cz (max.feld.cvut.cz [147.32.192.36])\r
+       by olra.theworths.org (Postfix) with ESMTP id 732A7431FAE\r
+       for <notmuch@notmuchmail.org>; Mon, 11 Aug 2014 07:32:53 -0700 (PDT)\r
+Received: from localhost (unknown [192.168.200.7])\r
+       by max.feld.cvut.cz (Postfix) with ESMTP id A30463CFE89;\r
+       Mon, 11 Aug 2014 16:32:52 +0200 (CEST)\r
+X-Virus-Scanned: IMAP STYX AMAVIS\r
+Received: from max.feld.cvut.cz ([192.168.200.1])\r
+       by localhost (styx.feld.cvut.cz [192.168.200.7]) (amavisd-new,\r
+       port 10044)\r
+       with ESMTP id 0HLdNElejqOz; Mon, 11 Aug 2014 16:32:49 +0200 (CEST)\r
+Received: from imap.feld.cvut.cz (imap.feld.cvut.cz [147.32.192.34])\r
+       by max.feld.cvut.cz (Postfix) with ESMTP id 1CB483CFEA0;\r
+       Mon, 11 Aug 2014 16:32:48 +0200 (CEST)\r
+Received: from wsh by steelpick.2x.cz with local (Exim 4.82_1-5b7a7c0-XX)\r
+       (envelope-from <sojkam1@fel.cvut.cz>)\r
+       id 1XGqeW-00082N-LM; Mon, 11 Aug 2014 16:32:48 +0200\r
+From: Michal Sojka <sojkam1@fel.cvut.cz>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH v2] Emacs: Add address completion mechanism implemented in\r
+       elisp\r
+Date: Mon, 11 Aug 2014 16:32:29 +0200\r
+Message-Id: <1407767549-30861-1-git-send-email-sojkam1@fel.cvut.cz>\r
+X-Mailer: git-send-email 2.0.1\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+       <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+       <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+       <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Mon, 11 Aug 2014 14:33:02 -0000\r
+\r
+Currently, notmuch has an address completion mechanism that requires\r
+external command to provide completion candidates. This patch adds a\r
+completion mechanism inspired by https://github.com/tjim/nevermore,\r
+which is implemented in Emacs lisp only.\r
+\r
+The core of the new mechanism is the function notmuch-address-harvest\r
+that collects the completion candidates from the notmuch database and\r
+stores them in notmuch-address-completions variable.\r
+notmuch-address-harvest is called on the first entry to message-mode\r
+and runs asychnornously so that the user doesn't have to wait for it\r
+to complete while composing the message. The\r
+notmuch-address-completions variable is used in message-mode as a\r
+source of completion candidates. Currently, there are two ways how the\r
+notmuch-address-completions variable is used.\r
+\r
+First, preexisting address completion mechanism is extended to use\r
+notmuch-address-completions in addition to the external command. This\r
+new behavior is configured by setting notmuch-address-command to nil,\r
+which is the new default. Note that this may *BREAK EXISTING SETUPS*\r
+when the user used external command named "notmuch-addresses", i.e.\r
+the previous default. The result will be that the user will use the\r
+new mechanism instead of the his command. I believe that many users\r
+may not even recognize this because the new mechanism works the same\r
+as http://commonmeasure.org/~jkr/git/notmuch_addresses.git and perhaps\r
+also as other commands suggested at\r
+http://notmuchmail.org/emacstips/#address_completion.\r
+\r
+Second way of using notmuch-address-completions is notmuch-company.el.\r
+This presents the possible completions in a nice popup box after a\r
+short typing delay but requires company-mode to be installed.\r
+\r
+Changes from v1:\r
+- Use of notmuch-parser.el instead of the custom parser in the\r
+  original code. The notmuch parser is slightly faster.\r
+- Use of functions in notmuch-query.el instead of functions in the\r
+  original code with almost the same functionality.\r
+- Integrated with existing completion mechanism in notmuch.\r
+- notmuch-company.el was moved from emacs/contrib to emacs and\r
+  no-byte-compile directive was added to it.\r
+- Aligned with notmuch naming conventions.\r
+- Documented bugs found in notmuch-company.el\r
+---\r
+ emacs/Makefile.local     |  6 ++-\r
+ emacs/notmuch-address.el | 95 +++++++++++++++++++++++++++++++++++++++++++-----\r
+ emacs/notmuch-company.el | 69 +++++++++++++++++++++++++++++++++++\r
+ emacs/notmuch-lib.el     |  3 ++\r
+ 4 files changed, 163 insertions(+), 10 deletions(-)\r
+ create mode 100644 emacs/notmuch-company.el\r
+\r
+diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
+index c0d6b19..9214d6e 100644\r
+--- a/emacs/Makefile.local\r
++++ b/emacs/Makefile.local\r
+@@ -18,6 +18,7 @@ emacs_sources := \\r
+       $(dir)/notmuch-tag.el \\r
+       $(dir)/coolj.el \\r
+       $(dir)/notmuch-print.el \\r
++      $(dir)/notmuch-company.el \\r
+       $(dir)/notmuch-version.el\r
\r
+ $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp\r
+@@ -29,7 +30,10 @@ $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl\r
+ emacs_images := \\r
+       $(srcdir)/$(dir)/notmuch-logo.png\r
\r
+-emacs_bytecode = $(emacs_sources:.el=.elc)\r
++# Do not try to install files that are not byte-compiled.\r
++emacs_no_byte_compile := $(dir)/notmuch-company.el\r
++\r
++emacs_bytecode = $(patsubst %.el,%.elc,$(filter-out $(emacs_no_byte_compile),$(emacs_sources)))\r
\r
+ # Because of defmacro's and defsubst's, we have to account for load\r
+ # dependencies between Elisp files when byte compiling.  Otherwise,\r
+diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el\r
+index fa65cd5..a50f4f4 100644\r
+--- a/emacs/notmuch-address.el\r
++++ b/emacs/notmuch-address.el\r
+@@ -20,14 +20,18 @@\r
+ ;; Authors: David Edmondson <dme@dme.org>\r
\r
+ (require 'message)\r
++(require 'notmuch-query)\r
++(require 'notmuch-parser)\r
\r
+ ;;\r
\r
+-(defcustom notmuch-address-command "notmuch-addresses"\r
+-  "The command which generates possible addresses. It must take a\r
+-single argument and output a list of possible matches, one per\r
+-line."\r
+-  :type 'string\r
++(defcustom notmuch-address-command nil\r
++  "The command which generates possible addresses for completion.\r
++It must take a single argument and output a list of possible\r
++matches, one per line. If set to nil, addresses are generated by\r
++a built-in completion mechanism."\r
++  :type '(radio (const :tag "No command: Use built-in completion" nil)\r
++               (string :tag "Custom command" :value "notmuch-addresses"))\r
+   :group 'notmuch-send\r
+   :group 'notmuch-external)\r
\r
+@@ -42,6 +46,10 @@ to know how address selection is made by default."\r
+   :group 'notmuch-send\r
+   :group 'notmuch-external)\r
\r
++(defvar notmuch-address-completions nil\r
++  "Hash of email addresses for completion during email composition.\r
++  This variable is set by calling `notmuch-address-harvest'.")\r
++\r
+ (defun notmuch-address-selection-function (prompt collection initial-input)\r
+   "Call (`completing-read'\r
+       PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"\r
+@@ -60,7 +68,16 @@ to know how address selection is made by default."\r
+         (push notmuch-address-message-alist-member message-completion-alist))))\r
\r
+ (defun notmuch-address-options (original)\r
+-  (process-lines notmuch-address-command original))\r
++  (cond\r
++   ((eq notmuch-address-command nil)\r
++    (let ((candidates))\r
++      (maphash (lambda (key val)\r
++               (let ((re (concat "\\<" (regexp-quote original))))\r
++                 (when (string-match re key)\r
++                   (push key candidates))))\r
++             notmuch-address-completions)\r
++      candidates))\r
++   (t (process-lines notmuch-address-command original))))\r
\r
+ (defun notmuch-address-expand-name ()\r
+   (let* ((end (point))\r
+@@ -108,11 +125,71 @@ to know how address selection is made by default."\r
+                          (not (file-directory-p bin))))\r
+             (throw 'found-command bin))))))))\r
\r
+-;; If we can find the program specified by `notmuch-address-command',\r
+-;; insinuate ourselves into `message-mode'.\r
+-(when (notmuch-address-locate-command notmuch-address-command)\r
++(defun notmuch-address-harvest-msg (msg)\r
++  (let* ((headers (plist-get msg :headers))\r
++       (to (ignore-errors (mail-extract-address-components (plist-get headers :To) t)))\r
++       (cc (ignore-errors (mail-extract-address-components (plist-get headers :Cc) t)))\r
++       (bcc (ignore-errors (mail-extract-address-components (plist-get headers :Bcc) t))))\r
++    (mapc (lambda (parts)\r
++          (let* ((name (car parts))\r
++                 (email (cadr parts))\r
++                 (entry (if name (format "%s <%s>" name email) email)))\r
++            (puthash entry t notmuch-address-completions)))\r
++        (append to cc bcc))\r
++    nil))\r
++\r
++(defun notmuch-address-harvest-handle-result (obj)\r
++  (notmuch-query-map-threads 'notmuch-address-harvest-msg (list obj)))\r
++\r
++(defun notmuch-address-harvest-filter (proc string)\r
++  (when (buffer-live-p (process-buffer proc))\r
++    (with-current-buffer (process-buffer proc)\r
++      (save-excursion\r
++      (goto-char (point-max))\r
++      (insert string))\r
++      (notmuch-sexp-parse-partial-list\r
++       'notmuch-address-harvest-handle-result (process-buffer proc)))))\r
++\r
++(defvar notmuch-address-harvest-proc nil)   ; the process of a harvest underway\r
++\r
++(defun notmuch-address-harvest ()\r
++  "Collect possible addresses for completion. It queries the\r
++notmuch database for all emails sent by the user and collects the\r
++destination addresses from them in\r
++`notmuch-address-completions'. This takes some time so the\r
++address collection runs asynchronously."\r
++  (when notmuch-address-harvest-proc\r
++    (kill-buffer (process-buffer notmuch-address-harvest-proc)) ; this also kills the process\r
++    (setq notmuch-address-harvest-proc nil))\r
++  (setq notmuch-address-completions (make-hash-table :test 'equal))\r
++  (setq notmuch-address-harvest-proc\r
++        (notmuch-start-notmuch\r
++         "notmuch-address-harvest"    ; process name\r
++         " *notmuch-address-harvest*" ; process buffer\r
++         nil                          ; process sentinel\r
++         "show"                               ; notmuch command\r
++         "--format=sexp"\r
++         "--format-version=2"\r
++         "--body=false"\r
++         "--entire-thread=false"\r
++       (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or ")))\r
++  (set-process-filter notmuch-address-harvest-proc 'notmuch-address-harvest-filter)\r
++  (set-process-query-on-exit-flag notmuch-address-harvest-proc nil)\r
++  ;; return value\r
++  nil)\r
++\r
++;; If we can find the program specified by `notmuch-address-command'\r
++;; or if it is nil, insinuate ourselves into `message-mode'.\r
++(when (or (eq notmuch-address-command nil)\r
++        (notmuch-address-locate-command notmuch-address-command))\r
+   (notmuch-address-message-insinuate))\r
\r
++(defun notmuch-address-harvest-start ()\r
++  (when (not notmuch-address-completions) (notmuch-address-harvest)))\r
++\r
++(when (eq notmuch-address-command nil)\r
++  (add-hook 'message-mode-hook 'notmuch-address-harvest-start))\r
++\r
+ ;;\r
\r
+ (provide 'notmuch-address)\r
+diff --git a/emacs/notmuch-company.el b/emacs/notmuch-company.el\r
+new file mode 100644\r
+index 0000000..748fcee\r
+--- /dev/null\r
++++ b/emacs/notmuch-company.el\r
+@@ -0,0 +1,69 @@\r
++;; -*-no-byte-compile: t; -*-\r
++\r
++;; notmuch-company.el --- Mail address completion for notmuch via company-mode\r
++\r
++;; Author: Trevor Jim <tjim@mac.com>\r
++;; Keywords: mail, completion\r
++\r
++;; This program is free software; you can redistribute it and/or modify\r
++;; it under the terms of the GNU General Public License as published by\r
++;; the Free Software Foundation, either version 3 of the License, or\r
++;; (at your option) any later version.\r
++\r
++;; This program is distributed in the hope that it will be useful,\r
++;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
++;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
++;; GNU General Public License for more details.\r
++\r
++;; You should have received a copy of the GNU General Public License\r
++;; along with this program.  If not, see <http://www.gnu.org/licenses/>.\r
++\r
++;;; Commentary:\r
++\r
++;; To enable this, install company mode (https://company-mode.github.io/)\r
++;; and add\r
++;;\r
++;;     (require 'notmuch-company)\r
++;;\r
++;; to your .emacs.\r
++;;\r
++;; NB company-minimum-prefix-length defaults to 3 so you don't get\r
++;; completion unless you type 3 characters\r
++\r
++;;; Bugs:\r
++;;\r
++;; - matching is case sensitive\r
++;; - matching of non-ascii characters doesn't work well\r
++\r
++;;; Code:\r
++\r
++(require 'company)\r
++(require 'message)\r
++(require 'notmuch-address)\r
++\r
++(defvar-local notmuch-company-last-prefix nil)\r
++;;;###autoload\r
++(defun notmuch-company (command &optional arg &rest ignore)\r
++  "`company-mode' completion back-end for `notmuch'."\r
++  (interactive (list 'interactive))\r
++  (let ((case-fold-search t))\r
++    (pcase command\r
++      (`interactive (company-begin-backend 'notmuch-company))\r
++      (`prefix (and (eq major-mode 'message-mode)\r
++                    (looking-back "^\\(To\\|Cc\\|Bcc\\):.*"\r
++                                  (line-beginning-position))\r
++                    (setq notmuch-company-last-prefix (company-grab-symbol))))\r
++      (`candidates (let ((results (completion-substring--all-completions arg notmuch-address-completions nil 0)))\r
++                     (when results (car results))))\r
++      (`match (if (string-match notmuch-company-last-prefix arg)\r
++                  (match-end 0)\r
++                0))\r
++      (`no-cache t))))\r
++\r
++(add-hook 'message-mode-hook '(lambda ()\r
++                                (company-mode)\r
++                                (make-local-variable 'company-backends)\r
++                                (setq company-backends '(notmuch-company))\r
++                              (notmuch-address-harvest-start)))\r
++\r
++(provide 'notmuch-company)\r
+diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+index c06baac..e36c4cf 100644\r
+--- a/emacs/notmuch-lib.el\r
++++ b/emacs/notmuch-lib.el\r
+@@ -224,6 +224,9 @@ on the command line, and then retry your notmuch command")))\r
+   "Return the user.other_email value (as a list) from the notmuch configuration."\r
+   (split-string (notmuch-config-get "user.other_email") "\n" t))\r
\r
++(defun notmuch-user-emails ()\r
++  (cons (notmuch-user-primary-email) (notmuch-user-other-email)))\r
++\r
+ (defun notmuch-poll ()\r
+   "Run \"notmuch new\" or an external script to import mail.\r
\r
+-- \r
+2.0.1\r
+\r