Re: [PATCH v3] Emacs: Add address completion mechanism implemented in elisp
authorDavid Edmondson <dme@dme.org>
Mon, 8 Sep 2014 06:18:44 +0000 (07:18 +0100)
committerW. Trevor King <wking@tremily.us>
Fri, 7 Nov 2014 18:04:30 +0000 (10:04 -0800)
2d/6ded6a05a3181071d7a2d52b8d6b59e6164f77 [new file with mode: 0644]

diff --git a/2d/6ded6a05a3181071d7a2d52b8d6b59e6164f77 b/2d/6ded6a05a3181071d7a2d52b8d6b59e6164f77
new file mode 100644 (file)
index 0000000..89ded5b
--- /dev/null
@@ -0,0 +1,383 @@
+Return-Path: <dme@dme.org>\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 22DCD431FBC\r
+       for <notmuch@notmuchmail.org>; Sun,  7 Sep 2014 23:18:58 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -0.7\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
+       tests=[RCVD_IN_DNSWL_LOW=-0.7] 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 zgPZQMYdpQoy for <notmuch@notmuchmail.org>;\r
+       Sun,  7 Sep 2014 23:18:50 -0700 (PDT)\r
+Received: from mail-wg0-f49.google.com (mail-wg0-f49.google.com\r
+ [74.125.82.49])       (using TLSv1 with cipher RC4-SHA (128/128 bits))        (No client\r
+ certificate requested)        by olra.theworths.org (Postfix) with ESMTPS id\r
+ B3B05431FB6   for <notmuch@notmuchmail.org>; Sun,  7 Sep 2014 23:18:49 -0700\r
+ (PDT)\r
+Received: by mail-wg0-f49.google.com with SMTP id m15so938679wgh.8\r
+       for <notmuch@notmuchmail.org>; Sun, 07 Sep 2014 23:18:47 -0700 (PDT)\r
+X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;\r
+       d=1e100.net; s=20130820;\r
+       h=x-gm-message-state:to:subject:in-reply-to:references:user-agent\r
+       :from:date:message-id:mime-version:content-type;\r
+       bh=ZP17OuvBOlXeHj+LulQwnOsHTGlnJoiRIrwqtzJ0zXQ=;\r
+       b=f8Fh87kx1tDQJVnHXcethpG2/qUeAwdUBFRAFbBIRDxejyVh6JS71PP2FotY1tzRQd\r
+       11iwfdC6i+QRDjd47t6UyFBLPHkj/OD9ZwdMhE7k2d65t2r/ES8Jv1h5AmXNoDoKHJqs\r
+       WJF5tbRauvgr4T6Z72CEs13CKBgN0u6O3y2Ci7IO7tmBpRI/IU4h0t09LnkyJW1AXdo7\r
+       KlKKd2j11s1LezdMjKPXCnKt3SiA5T5uI2+xzc42Ig6PExPtY89ptFzMJJQBKZlXmE3/\r
+       OXQuKnVIJ8CU2Ppj8JFwsynjSlyJbYkV98xzEoZSwKk1vJMz9GHIUraPyU9RsLbGg58W\r
+       0YkA==\r
+X-Gm-Message-State:\r
+ ALoCoQn95YvXG1GlRiQyIunTL9312qKOSXQlHeeCcpCptGzF1LCbFCCHbk3H3c8i7ZV3uSW+e9Yz\r
+X-Received: by 10.194.161.231 with SMTP id xv7mr33031911wjb.78.1410157127164; \r
+       Sun, 07 Sep 2014 23:18:47 -0700 (PDT)\r
+Received: from localhost ([2a01:348:1a2:1:c97f:acf4:c706:7534])\r
+       by mx.google.com with ESMTPSA id wm8sm9895733wjb.40.2014.09.07.23.18.46\r
+       for <multiple recipients>\r
+       (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128);\r
+       Sun, 07 Sep 2014 23:18:46 -0700 (PDT)\r
+To: Michal Sojka <sojkam1@fel.cvut.cz>, notmuch@notmuchmail.org\r
+Subject: Re: [PATCH v3] Emacs: Add address completion mechanism implemented\r
+       in      elisp\r
+In-Reply-To: <1407771091-12651-1-git-send-email-sojkam1@fel.cvut.cz>\r
+References: <1407771091-12651-1-git-send-email-sojkam1@fel.cvut.cz>\r
+User-Agent: Notmuch/0.18.1 (http://notmuchmail.org) Emacs/24.3.1\r
+       (x86_64-apple-darwin)\r
+From: David Edmondson <dme@dme.org>\r
+Date: Mon, 08 Sep 2014 07:18:44 +0100\r
+Message-ID: <m2lhpuzlbv.fsf@fenchurch.hh.sledj.net>\r
+MIME-Version: 1.0\r
+Content-Type: text/plain\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, 08 Sep 2014 06:18:58 -0000\r
+\r
+On Mon, Aug 11 2014, Michal Sojka wrote:\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
+This looks great, thanks for doing it. It seems like a better approach\r
+than id:1409921969-65129-1-git-send-email-dme@dme.org. Some comments:\r
+\r
+- Adding the address collection to `message-mode-hook' means that it\r
+  runs every time I start to compose a message. If the address\r
+  collection is disk intensive, this might be bad for battery life. The\r
+  set of potential recipients doesn't change _that_ much over time for a\r
+  typical person, I'd wager. Maybe the hook should only run once a day?\r
+  (Tunable, of course.)\r
+\r
+- The addition of company mode support (which I haven't tried) should be\r
+  a separate patch in the series.\r
+\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
+> Changes from v2:\r
+> - Updated Makefile.local to not conflict with current master\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 1109cfa..6c93e73 100644\r
+> --- a/emacs/Makefile.local\r
+> +++ b/emacs/Makefile.local\r
+> @@ -20,6 +20,7 @@ emacs_sources := \\r
+>      $(dir)/notmuch-print.el \\r
+>      $(dir)/notmuch-version.el \\r
+>      $(dir)/notmuch-jump.el \\r
+> +    $(dir)/notmuch-company.el\r
+>  \r
+>  $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp\r
+>  $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl\r
+> @@ -30,7 +31,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 19269e3..00e8554 100644\r
+> --- a/emacs/notmuch-lib.el\r
+> +++ b/emacs/notmuch-lib.el\r
+> @@ -228,6 +228,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