64/e053ffce23531f0976138325984393a9b80374

   1 Return-Path: <sojkam1@fel.cvut.cz>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id 20998431FAF\r
   6         for <notmuch@notmuchmail.org>; Mon, 11 Aug 2014 07:33:02 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -2.3\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-2.3 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_MED=-2.3] autolearn=disabled\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id mKBJEQZGWwdJ for <notmuch@notmuchmail.org>;\r
  16         Mon, 11 Aug 2014 07:32:53 -0700 (PDT)\r
  17 Received: from max.feld.cvut.cz (max.feld.cvut.cz [147.32.192.36])\r
  18         by olra.theworths.org (Postfix) with ESMTP id 732A7431FAE\r
  19         for <notmuch@notmuchmail.org>; Mon, 11 Aug 2014 07:32:53 -0700 (PDT)\r
  20 Received: from localhost (unknown [192.168.200.7])\r
  21         by max.feld.cvut.cz (Postfix) with ESMTP id A30463CFE89;\r
  22         Mon, 11 Aug 2014 16:32:52 +0200 (CEST)\r
  23 X-Virus-Scanned: IMAP STYX AMAVIS\r
  24 Received: from max.feld.cvut.cz ([192.168.200.1])\r
  25         by localhost (styx.feld.cvut.cz [192.168.200.7]) (amavisd-new,\r
  26         port 10044)\r
  27         with ESMTP id 0HLdNElejqOz; Mon, 11 Aug 2014 16:32:49 +0200 (CEST)\r
  28 Received: from imap.feld.cvut.cz (imap.feld.cvut.cz [147.32.192.34])\r
  29         by max.feld.cvut.cz (Postfix) with ESMTP id 1CB483CFEA0;\r
  30         Mon, 11 Aug 2014 16:32:48 +0200 (CEST)\r
  31 Received: from wsh by steelpick.2x.cz with local (Exim 4.82_1-5b7a7c0-XX)\r
  32         (envelope-from <sojkam1@fel.cvut.cz>)\r
  33         id 1XGqeW-00082N-LM; Mon, 11 Aug 2014 16:32:48 +0200\r
  34 From: Michal Sojka <sojkam1@fel.cvut.cz>\r
  35 To: notmuch@notmuchmail.org\r
  36 Subject: [PATCH v2] Emacs: Add address completion mechanism implemented in\r
  37         elisp\r
  38 Date: Mon, 11 Aug 2014 16:32:29 +0200\r
  39 Message-Id: <1407767549-30861-1-git-send-email-sojkam1@fel.cvut.cz>\r
  40 X-Mailer: git-send-email 2.0.1\r
  41 X-BeenThere: notmuch@notmuchmail.org\r
  42 X-Mailman-Version: 2.1.13\r
  43 Precedence: list\r
  44 List-Id: "Use and development of the notmuch mail system."\r
  45         <notmuch.notmuchmail.org>\r
  46 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  47         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  48 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  49 List-Post: <mailto:notmuch@notmuchmail.org>\r
  50 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  51 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  52         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  53 X-List-Received-Date: Mon, 11 Aug 2014 14:33:02 -0000\r
  54 \r
  55 Currently, notmuch has an address completion mechanism that requires\r
  56 external command to provide completion candidates. This patch adds a\r
  57 completion mechanism inspired by https://github.com/tjim/nevermore,\r
  58 which is implemented in Emacs lisp only.\r
  59 \r
  60 The core of the new mechanism is the function notmuch-address-harvest\r
  61 that collects the completion candidates from the notmuch database and\r
  62 stores them in notmuch-address-completions variable.\r
  63 notmuch-address-harvest is called on the first entry to message-mode\r
  64 and runs asychnornously so that the user doesn't have to wait for it\r
  65 to complete while composing the message. The\r
  66 notmuch-address-completions variable is used in message-mode as a\r
  67 source of completion candidates. Currently, there are two ways how the\r
  68 notmuch-address-completions variable is used.\r
  69 \r
  70 First, preexisting address completion mechanism is extended to use\r
  71 notmuch-address-completions in addition to the external command. This\r
  72 new behavior is configured by setting notmuch-address-command to nil,\r
  73 which is the new default. Note that this may *BREAK EXISTING SETUPS*\r
  74 when the user used external command named "notmuch-addresses", i.e.\r
  75 the previous default. The result will be that the user will use the\r
  76 new mechanism instead of the his command. I believe that many users\r
  77 may not even recognize this because the new mechanism works the same\r
  78 as http://commonmeasure.org/~jkr/git/notmuch_addresses.git and perhaps\r
  79 also as other commands suggested at\r
  80 http://notmuchmail.org/emacstips/#address_completion.\r
  81 \r
  82 Second way of using notmuch-address-completions is notmuch-company.el.\r
  83 This presents the possible completions in a nice popup box after a\r
  84 short typing delay but requires company-mode to be installed.\r
  85 \r
  86 Changes from v1:\r
  87 - Use of notmuch-parser.el instead of the custom parser in the\r
  88   original code. The notmuch parser is slightly faster.\r
  89 - Use of functions in notmuch-query.el instead of functions in the\r
  90   original code with almost the same functionality.\r
  91 - Integrated with existing completion mechanism in notmuch.\r
  92 - notmuch-company.el was moved from emacs/contrib to emacs and\r
  93   no-byte-compile directive was added to it.\r
  94 - Aligned with notmuch naming conventions.\r
  95 - Documented bugs found in notmuch-company.el\r
  96 ---\r
  97  emacs/Makefile.local     |  6 ++-\r
  98  emacs/notmuch-address.el | 95 +++++++++++++++++++++++++++++++++++++++++++-----\r
  99  emacs/notmuch-company.el | 69 +++++++++++++++++++++++++++++++++++\r
 100  emacs/notmuch-lib.el     |  3 ++\r
 101  4 files changed, 163 insertions(+), 10 deletions(-)\r
 102  create mode 100644 emacs/notmuch-company.el\r
 103 \r
 104 diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
 105 index c0d6b19..9214d6e 100644\r
 106 --- a/emacs/Makefile.local\r
 107 +++ b/emacs/Makefile.local\r
 108 @@ -18,6 +18,7 @@ emacs_sources := \\r
 109         $(dir)/notmuch-tag.el \\r
 110         $(dir)/coolj.el \\r
 111         $(dir)/notmuch-print.el \\r
 112 +       $(dir)/notmuch-company.el \\r
 113         $(dir)/notmuch-version.el\r
 114  \r
 115  $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp\r
 116 @@ -29,7 +30,10 @@ $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl\r
 117  emacs_images := \\r
 118         $(srcdir)/$(dir)/notmuch-logo.png\r
 119  \r
 120 -emacs_bytecode = $(emacs_sources:.el=.elc)\r
 121 +# Do not try to install files that are not byte-compiled.\r
 122 +emacs_no_byte_compile := $(dir)/notmuch-company.el\r
 123 +\r
 124 +emacs_bytecode = $(patsubst %.el,%.elc,$(filter-out $(emacs_no_byte_compile),$(emacs_sources)))\r
 125  \r
 126  # Because of defmacro's and defsubst's, we have to account for load\r
 127  # dependencies between Elisp files when byte compiling.  Otherwise,\r
 128 diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el\r
 129 index fa65cd5..a50f4f4 100644\r
 130 --- a/emacs/notmuch-address.el\r
 131 +++ b/emacs/notmuch-address.el\r
 132 @@ -20,14 +20,18 @@\r
 133  ;; Authors: David Edmondson <dme@dme.org>\r
 134  \r
 135  (require 'message)\r
 136 +(require 'notmuch-query)\r
 137 +(require 'notmuch-parser)\r
 138  \r
 139  ;;\r
 140  \r
 141 -(defcustom notmuch-address-command "notmuch-addresses"\r
 142 -  "The command which generates possible addresses. It must take a\r
 143 -single argument and output a list of possible matches, one per\r
 144 -line."\r
 145 -  :type 'string\r
 146 +(defcustom notmuch-address-command nil\r
 147 +  "The command which generates possible addresses for completion.\r
 148 +It must take a single argument and output a list of possible\r
 149 +matches, one per line. If set to nil, addresses are generated by\r
 150 +a built-in completion mechanism."\r
 151 +  :type '(radio (const :tag "No command: Use built-in completion" nil)\r
 152 +                (string :tag "Custom command" :value "notmuch-addresses"))\r
 153    :group 'notmuch-send\r
 154    :group 'notmuch-external)\r
 155  \r
 156 @@ -42,6 +46,10 @@ to know how address selection is made by default."\r
 157    :group 'notmuch-send\r
 158    :group 'notmuch-external)\r
 159  \r
 160 +(defvar notmuch-address-completions nil\r
 161 +  "Hash of email addresses for completion during email composition.\r
 162 +  This variable is set by calling `notmuch-address-harvest'.")\r
 163 +\r
 164  (defun notmuch-address-selection-function (prompt collection initial-input)\r
 165    "Call (`completing-read'\r
 166        PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"\r
 167 @@ -60,7 +68,16 @@ to know how address selection is made by default."\r
 168           (push notmuch-address-message-alist-member message-completion-alist))))\r
 169  \r
 170  (defun notmuch-address-options (original)\r
 171 -  (process-lines notmuch-address-command original))\r
 172 +  (cond\r
 173 +   ((eq notmuch-address-command nil)\r
 174 +    (let ((candidates))\r
 175 +      (maphash (lambda (key val)\r
 176 +                (let ((re (concat "\\<" (regexp-quote original))))\r
 177 +                  (when (string-match re key)\r
 178 +                    (push key candidates))))\r
 179 +              notmuch-address-completions)\r
 180 +      candidates))\r
 181 +   (t (process-lines notmuch-address-command original))))\r
 182  \r
 183  (defun notmuch-address-expand-name ()\r
 184    (let* ((end (point))\r
 185 @@ -108,11 +125,71 @@ to know how address selection is made by default."\r
 186                            (not (file-directory-p bin))))\r
 187               (throw 'found-command bin))))))))\r
 188  \r
 189 -;; If we can find the program specified by `notmuch-address-command',\r
 190 -;; insinuate ourselves into `message-mode'.\r
 191 -(when (notmuch-address-locate-command notmuch-address-command)\r
 192 +(defun notmuch-address-harvest-msg (msg)\r
 193 +  (let* ((headers (plist-get msg :headers))\r
 194 +        (to (ignore-errors (mail-extract-address-components (plist-get headers :To) t)))\r
 195 +        (cc (ignore-errors (mail-extract-address-components (plist-get headers :Cc) t)))\r
 196 +        (bcc (ignore-errors (mail-extract-address-components (plist-get headers :Bcc) t))))\r
 197 +    (mapc (lambda (parts)\r
 198 +           (let* ((name (car parts))\r
 199 +                  (email (cadr parts))\r
 200 +                  (entry (if name (format "%s <%s>" name email) email)))\r
 201 +             (puthash entry t notmuch-address-completions)))\r
 202 +         (append to cc bcc))\r
 203 +    nil))\r
 204 +\r
 205 +(defun notmuch-address-harvest-handle-result (obj)\r
 206 +  (notmuch-query-map-threads 'notmuch-address-harvest-msg (list obj)))\r
 207 +\r
 208 +(defun notmuch-address-harvest-filter (proc string)\r
 209 +  (when (buffer-live-p (process-buffer proc))\r
 210 +    (with-current-buffer (process-buffer proc)\r
 211 +      (save-excursion\r
 212 +       (goto-char (point-max))\r
 213 +       (insert string))\r
 214 +      (notmuch-sexp-parse-partial-list\r
 215 +       'notmuch-address-harvest-handle-result (process-buffer proc)))))\r
 216 +\r
 217 +(defvar notmuch-address-harvest-proc nil)   ; the process of a harvest underway\r
 218 +\r
 219 +(defun notmuch-address-harvest ()\r
 220 +  "Collect possible addresses for completion. It queries the\r
 221 +notmuch database for all emails sent by the user and collects the\r
 222 +destination addresses from them in\r
 223 +`notmuch-address-completions'. This takes some time so the\r
 224 +address collection runs asynchronously."\r
 225 +  (when notmuch-address-harvest-proc\r
 226 +    (kill-buffer (process-buffer notmuch-address-harvest-proc)) ; this also kills the process\r
 227 +    (setq notmuch-address-harvest-proc nil))\r
 228 +  (setq notmuch-address-completions (make-hash-table :test 'equal))\r
 229 +  (setq notmuch-address-harvest-proc\r
 230 +        (notmuch-start-notmuch\r
 231 +         "notmuch-address-harvest"     ; process name\r
 232 +         " *notmuch-address-harvest*"  ; process buffer\r
 233 +         nil                           ; process sentinel\r
 234 +         "show"                                ; notmuch command\r
 235 +         "--format=sexp"\r
 236 +         "--format-version=2"\r
 237 +         "--body=false"\r
 238 +         "--entire-thread=false"\r
 239 +        (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or ")))\r
 240 +  (set-process-filter notmuch-address-harvest-proc 'notmuch-address-harvest-filter)\r
 241 +  (set-process-query-on-exit-flag notmuch-address-harvest-proc nil)\r
 242 +  ;; return value\r
 243 +  nil)\r
 244 +\r
 245 +;; If we can find the program specified by `notmuch-address-command'\r
 246 +;; or if it is nil, insinuate ourselves into `message-mode'.\r
 247 +(when (or (eq notmuch-address-command nil)\r
 248 +         (notmuch-address-locate-command notmuch-address-command))\r
 249    (notmuch-address-message-insinuate))\r
 250  \r
 251 +(defun notmuch-address-harvest-start ()\r
 252 +  (when (not notmuch-address-completions) (notmuch-address-harvest)))\r
 253 +\r
 254 +(when (eq notmuch-address-command nil)\r
 255 +  (add-hook 'message-mode-hook 'notmuch-address-harvest-start))\r
 256 +\r
 257  ;;\r
 258  \r
 259  (provide 'notmuch-address)\r
 260 diff --git a/emacs/notmuch-company.el b/emacs/notmuch-company.el\r
 261 new file mode 100644\r
 262 index 0000000..748fcee\r
 263 --- /dev/null\r
 264 +++ b/emacs/notmuch-company.el\r
 265 @@ -0,0 +1,69 @@\r
 266 +;; -*-no-byte-compile: t; -*-\r
 267 +\r
 268 +;; notmuch-company.el --- Mail address completion for notmuch via company-mode\r
 269 +\r
 270 +;; Author: Trevor Jim <tjim@mac.com>\r
 271 +;; Keywords: mail, completion\r
 272 +\r
 273 +;; This program is free software; you can redistribute it and/or modify\r
 274 +;; it under the terms of the GNU General Public License as published by\r
 275 +;; the Free Software Foundation, either version 3 of the License, or\r
 276 +;; (at your option) any later version.\r
 277 +\r
 278 +;; This program is distributed in the hope that it will be useful,\r
 279 +;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
 280 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
 281 +;; GNU General Public License for more details.\r
 282 +\r
 283 +;; You should have received a copy of the GNU General Public License\r
 284 +;; along with this program.  If not, see <http://www.gnu.org/licenses/>.\r
 285 +\r
 286 +;;; Commentary:\r
 287 +\r
 288 +;; To enable this, install company mode (https://company-mode.github.io/)\r
 289 +;; and add\r
 290 +;;\r
 291 +;;     (require 'notmuch-company)\r
 292 +;;\r
 293 +;; to your .emacs.\r
 294 +;;\r
 295 +;; NB company-minimum-prefix-length defaults to 3 so you don't get\r
 296 +;; completion unless you type 3 characters\r
 297 +\r
 298 +;;; Bugs:\r
 299 +;;\r
 300 +;; - matching is case sensitive\r
 301 +;; - matching of non-ascii characters doesn't work well\r
 302 +\r
 303 +;;; Code:\r
 304 +\r
 305 +(require 'company)\r
 306 +(require 'message)\r
 307 +(require 'notmuch-address)\r
 308 +\r
 309 +(defvar-local notmuch-company-last-prefix nil)\r
 310 +;;;###autoload\r
 311 +(defun notmuch-company (command &optional arg &rest ignore)\r
 312 +  "`company-mode' completion back-end for `notmuch'."\r
 313 +  (interactive (list 'interactive))\r
 314 +  (let ((case-fold-search t))\r
 315 +    (pcase command\r
 316 +      (`interactive (company-begin-backend 'notmuch-company))\r
 317 +      (`prefix (and (eq major-mode 'message-mode)\r
 318 +                    (looking-back "^\\(To\\|Cc\\|Bcc\\):.*"\r
 319 +                                  (line-beginning-position))\r
 320 +                    (setq notmuch-company-last-prefix (company-grab-symbol))))\r
 321 +      (`candidates (let ((results (completion-substring--all-completions arg notmuch-address-completions nil 0)))\r
 322 +                     (when results (car results))))\r
 323 +      (`match (if (string-match notmuch-company-last-prefix arg)\r
 324 +                  (match-end 0)\r
 325 +                0))\r
 326 +      (`no-cache t))))\r
 327 +\r
 328 +(add-hook 'message-mode-hook '(lambda ()\r
 329 +                                (company-mode)\r
 330 +                                (make-local-variable 'company-backends)\r
 331 +                                (setq company-backends '(notmuch-company))\r
 332 +                               (notmuch-address-harvest-start)))\r
 333 +\r
 334 +(provide 'notmuch-company)\r
 335 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
 336 index c06baac..e36c4cf 100644\r
 337 --- a/emacs/notmuch-lib.el\r
 338 +++ b/emacs/notmuch-lib.el\r
 339 @@ -224,6 +224,9 @@ on the command line, and then retry your notmuch command")))\r
 340    "Return the user.other_email value (as a list) from the notmuch configuration."\r
 341    (split-string (notmuch-config-get "user.other_email") "\n" t))\r
 342  \r
 343 +(defun notmuch-user-emails ()\r
 344 +  (cons (notmuch-user-primary-email) (notmuch-user-other-email)))\r
 345 +\r
 346  (defun notmuch-poll ()\r
 347    "Run \"notmuch new\" or an external script to import mail.\r
 348  \r
 349 -- \r
 350 2.0.1\r
 351 \r