d6/9b33f5bf8b80edb60c84d1b62fa30d4ac14e2f

   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 2F497431FAF\r
   6         for <notmuch@notmuchmail.org>; Mon, 11 Aug 2014 08:31:48 -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 TmqENcTcLv58 for <notmuch@notmuchmail.org>;\r
  16         Mon, 11 Aug 2014 08:31:41 -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 82BCE431FAE\r
  19         for <notmuch@notmuchmail.org>; Mon, 11 Aug 2014 08:31:41 -0700 (PDT)\r
  20 Received: from localhost (unknown [192.168.200.7])\r
  21         by max.feld.cvut.cz (Postfix) with ESMTP id DD1BA3CFE93;\r
  22         Mon, 11 Aug 2014 17:31:40 +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 YoSbTYG2T0E4; Mon, 11 Aug 2014 17:31:37 +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 55A5019F3435;\r
  30         Mon, 11 Aug 2014 17:31:37 +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 1XGrZR-0003Id-0C; Mon, 11 Aug 2014 17:31:37 +0200\r
  34 From: Michal Sojka <sojkam1@fel.cvut.cz>\r
  35 To: notmuch@notmuchmail.org\r
  36 Subject: [PATCH v3] Emacs: Add address completion mechanism implemented in\r
  37         elisp\r
  38 Date: Mon, 11 Aug 2014 17:31:31 +0200\r
  39 Message-Id: <1407771091-12651-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 15:31:48 -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 ---\r
  87 Changes from v1:\r
  88 - Use of notmuch-parser.el instead of the custom parser in the\r
  89   original code. The notmuch parser is slightly faster.\r
  90 - Use of functions in notmuch-query.el instead of functions in the\r
  91   original code with almost the same functionality.\r
  92 - Integrated with existing completion mechanism in notmuch.\r
  93 - notmuch-company.el was moved from emacs/contrib to emacs and\r
  94   no-byte-compile directive was added to it.\r
  95 - Aligned with notmuch naming conventions.\r
  96 - Documented bugs found in notmuch-company.el\r
  97 \r
  98 Changes from v2:\r
  99 - Updated Makefile.local to not conflict with current master\r
 100 ---\r
 101  emacs/Makefile.local     |  6 ++-\r
 102  emacs/notmuch-address.el | 95 +++++++++++++++++++++++++++++++++++++++++++-----\r
 103  emacs/notmuch-company.el | 69 +++++++++++++++++++++++++++++++++++\r
 104  emacs/notmuch-lib.el     |  3 ++\r
 105  4 files changed, 163 insertions(+), 10 deletions(-)\r
 106  create mode 100644 emacs/notmuch-company.el\r
 107 \r
 108 diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
 109 index 1109cfa..6c93e73 100644\r
 110 --- a/emacs/Makefile.local\r
 111 +++ b/emacs/Makefile.local\r
 112 @@ -20,6 +20,7 @@ emacs_sources := \\r
 113         $(dir)/notmuch-print.el \\r
 114         $(dir)/notmuch-version.el \\r
 115         $(dir)/notmuch-jump.el \\r
 116 +       $(dir)/notmuch-company.el\r
 117  \r
 118  $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp\r
 119  $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl\r
 120 @@ -30,7 +31,10 @@ $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl\r
 121  emacs_images := \\r
 122         $(srcdir)/$(dir)/notmuch-logo.png\r
 123  \r
 124 -emacs_bytecode = $(emacs_sources:.el=.elc)\r
 125 +# Do not try to install files that are not byte-compiled.\r
 126 +emacs_no_byte_compile := $(dir)/notmuch-company.el\r
 127 +\r
 128 +emacs_bytecode = $(patsubst %.el,%.elc,$(filter-out $(emacs_no_byte_compile),$(emacs_sources)))\r
 129  \r
 130  # Because of defmacro's and defsubst's, we have to account for load\r
 131  # dependencies between Elisp files when byte compiling.  Otherwise,\r
 132 diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el\r
 133 index fa65cd5..a50f4f4 100644\r
 134 --- a/emacs/notmuch-address.el\r
 135 +++ b/emacs/notmuch-address.el\r
 136 @@ -20,14 +20,18 @@\r
 137  ;; Authors: David Edmondson <dme@dme.org>\r
 138  \r
 139  (require 'message)\r
 140 +(require 'notmuch-query)\r
 141 +(require 'notmuch-parser)\r
 142  \r
 143  ;;\r
 144  \r
 145 -(defcustom notmuch-address-command "notmuch-addresses"\r
 146 -  "The command which generates possible addresses. It must take a\r
 147 -single argument and output a list of possible matches, one per\r
 148 -line."\r
 149 -  :type 'string\r
 150 +(defcustom notmuch-address-command nil\r
 151 +  "The command which generates possible addresses for completion.\r
 152 +It must take a single argument and output a list of possible\r
 153 +matches, one per line. If set to nil, addresses are generated by\r
 154 +a built-in completion mechanism."\r
 155 +  :type '(radio (const :tag "No command: Use built-in completion" nil)\r
 156 +                (string :tag "Custom command" :value "notmuch-addresses"))\r
 157    :group 'notmuch-send\r
 158    :group 'notmuch-external)\r
 159  \r
 160 @@ -42,6 +46,10 @@ to know how address selection is made by default."\r
 161    :group 'notmuch-send\r
 162    :group 'notmuch-external)\r
 163  \r
 164 +(defvar notmuch-address-completions nil\r
 165 +  "Hash of email addresses for completion during email composition.\r
 166 +  This variable is set by calling `notmuch-address-harvest'.")\r
 167 +\r
 168  (defun notmuch-address-selection-function (prompt collection initial-input)\r
 169    "Call (`completing-read'\r
 170        PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"\r
 171 @@ -60,7 +68,16 @@ to know how address selection is made by default."\r
 172           (push notmuch-address-message-alist-member message-completion-alist))))\r
 173  \r
 174  (defun notmuch-address-options (original)\r
 175 -  (process-lines notmuch-address-command original))\r
 176 +  (cond\r
 177 +   ((eq notmuch-address-command nil)\r
 178 +    (let ((candidates))\r
 179 +      (maphash (lambda (key val)\r
 180 +                (let ((re (concat "\\<" (regexp-quote original))))\r
 181 +                  (when (string-match re key)\r
 182 +                    (push key candidates))))\r
 183 +              notmuch-address-completions)\r
 184 +      candidates))\r
 185 +   (t (process-lines notmuch-address-command original))))\r
 186  \r
 187  (defun notmuch-address-expand-name ()\r
 188    (let* ((end (point))\r
 189 @@ -108,11 +125,71 @@ to know how address selection is made by default."\r
 190                            (not (file-directory-p bin))))\r
 191               (throw 'found-command bin))))))))\r
 192  \r
 193 -;; If we can find the program specified by `notmuch-address-command',\r
 194 -;; insinuate ourselves into `message-mode'.\r
 195 -(when (notmuch-address-locate-command notmuch-address-command)\r
 196 +(defun notmuch-address-harvest-msg (msg)\r
 197 +  (let* ((headers (plist-get msg :headers))\r
 198 +        (to (ignore-errors (mail-extract-address-components (plist-get headers :To) t)))\r
 199 +        (cc (ignore-errors (mail-extract-address-components (plist-get headers :Cc) t)))\r
 200 +        (bcc (ignore-errors (mail-extract-address-components (plist-get headers :Bcc) t))))\r
 201 +    (mapc (lambda (parts)\r
 202 +           (let* ((name (car parts))\r
 203 +                  (email (cadr parts))\r
 204 +                  (entry (if name (format "%s <%s>" name email) email)))\r
 205 +             (puthash entry t notmuch-address-completions)))\r
 206 +         (append to cc bcc))\r
 207 +    nil))\r
 208 +\r
 209 +(defun notmuch-address-harvest-handle-result (obj)\r
 210 +  (notmuch-query-map-threads 'notmuch-address-harvest-msg (list obj)))\r
 211 +\r
 212 +(defun notmuch-address-harvest-filter (proc string)\r
 213 +  (when (buffer-live-p (process-buffer proc))\r
 214 +    (with-current-buffer (process-buffer proc)\r
 215 +      (save-excursion\r
 216 +       (goto-char (point-max))\r
 217 +       (insert string))\r
 218 +      (notmuch-sexp-parse-partial-list\r
 219 +       'notmuch-address-harvest-handle-result (process-buffer proc)))))\r
 220 +\r
 221 +(defvar notmuch-address-harvest-proc nil)   ; the process of a harvest underway\r
 222 +\r
 223 +(defun notmuch-address-harvest ()\r
 224 +  "Collect possible addresses for completion. It queries the\r
 225 +notmuch database for all emails sent by the user and collects the\r
 226 +destination addresses from them in\r
 227 +`notmuch-address-completions'. This takes some time so the\r
 228 +address collection runs asynchronously."\r
 229 +  (when notmuch-address-harvest-proc\r
 230 +    (kill-buffer (process-buffer notmuch-address-harvest-proc)) ; this also kills the process\r
 231 +    (setq notmuch-address-harvest-proc nil))\r
 232 +  (setq notmuch-address-completions (make-hash-table :test 'equal))\r
 233 +  (setq notmuch-address-harvest-proc\r
 234 +        (notmuch-start-notmuch\r
 235 +         "notmuch-address-harvest"     ; process name\r
 236 +         " *notmuch-address-harvest*"  ; process buffer\r
 237 +         nil                           ; process sentinel\r
 238 +         "show"                                ; notmuch command\r
 239 +         "--format=sexp"\r
 240 +         "--format-version=2"\r
 241 +         "--body=false"\r
 242 +         "--entire-thread=false"\r
 243 +        (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or ")))\r
 244 +  (set-process-filter notmuch-address-harvest-proc 'notmuch-address-harvest-filter)\r
 245 +  (set-process-query-on-exit-flag notmuch-address-harvest-proc nil)\r
 246 +  ;; return value\r
 247 +  nil)\r
 248 +\r
 249 +;; If we can find the program specified by `notmuch-address-command'\r
 250 +;; or if it is nil, insinuate ourselves into `message-mode'.\r
 251 +(when (or (eq notmuch-address-command nil)\r
 252 +         (notmuch-address-locate-command notmuch-address-command))\r
 253    (notmuch-address-message-insinuate))\r
 254  \r
 255 +(defun notmuch-address-harvest-start ()\r
 256 +  (when (not notmuch-address-completions) (notmuch-address-harvest)))\r
 257 +\r
 258 +(when (eq notmuch-address-command nil)\r
 259 +  (add-hook 'message-mode-hook 'notmuch-address-harvest-start))\r
 260 +\r
 261  ;;\r
 262  \r
 263  (provide 'notmuch-address)\r
 264 diff --git a/emacs/notmuch-company.el b/emacs/notmuch-company.el\r
 265 new file mode 100644\r
 266 index 0000000..748fcee\r
 267 --- /dev/null\r
 268 +++ b/emacs/notmuch-company.el\r
 269 @@ -0,0 +1,69 @@\r
 270 +;; -*-no-byte-compile: t; -*-\r
 271 +\r
 272 +;; notmuch-company.el --- Mail address completion for notmuch via company-mode\r
 273 +\r
 274 +;; Author: Trevor Jim <tjim@mac.com>\r
 275 +;; Keywords: mail, completion\r
 276 +\r
 277 +;; This program is free software; you can redistribute it and/or modify\r
 278 +;; it under the terms of the GNU General Public License as published by\r
 279 +;; the Free Software Foundation, either version 3 of the License, or\r
 280 +;; (at your option) any later version.\r
 281 +\r
 282 +;; This program is distributed in the hope that it will be useful,\r
 283 +;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
 284 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
 285 +;; GNU General Public License for more details.\r
 286 +\r
 287 +;; You should have received a copy of the GNU General Public License\r
 288 +;; along with this program.  If not, see <http://www.gnu.org/licenses/>.\r
 289 +\r
 290 +;;; Commentary:\r
 291 +\r
 292 +;; To enable this, install company mode (https://company-mode.github.io/)\r
 293 +;; and add\r
 294 +;;\r
 295 +;;     (require 'notmuch-company)\r
 296 +;;\r
 297 +;; to your .emacs.\r
 298 +;;\r
 299 +;; NB company-minimum-prefix-length defaults to 3 so you don't get\r
 300 +;; completion unless you type 3 characters\r
 301 +\r
 302 +;;; Bugs:\r
 303 +;;\r
 304 +;; - matching is case sensitive\r
 305 +;; - matching of non-ascii characters doesn't work well\r
 306 +\r
 307 +;;; Code:\r
 308 +\r
 309 +(require 'company)\r
 310 +(require 'message)\r
 311 +(require 'notmuch-address)\r
 312 +\r
 313 +(defvar-local notmuch-company-last-prefix nil)\r
 314 +;;;###autoload\r
 315 +(defun notmuch-company (command &optional arg &rest ignore)\r
 316 +  "`company-mode' completion back-end for `notmuch'."\r
 317 +  (interactive (list 'interactive))\r
 318 +  (let ((case-fold-search t))\r
 319 +    (pcase command\r
 320 +      (`interactive (company-begin-backend 'notmuch-company))\r
 321 +      (`prefix (and (eq major-mode 'message-mode)\r
 322 +                    (looking-back "^\\(To\\|Cc\\|Bcc\\):.*"\r
 323 +                                  (line-beginning-position))\r
 324 +                    (setq notmuch-company-last-prefix (company-grab-symbol))))\r
 325 +      (`candidates (let ((results (completion-substring--all-completions arg notmuch-address-completions nil 0)))\r
 326 +                     (when results (car results))))\r
 327 +      (`match (if (string-match notmuch-company-last-prefix arg)\r
 328 +                  (match-end 0)\r
 329 +                0))\r
 330 +      (`no-cache t))))\r
 331 +\r
 332 +(add-hook 'message-mode-hook '(lambda ()\r
 333 +                                (company-mode)\r
 334 +                                (make-local-variable 'company-backends)\r
 335 +                                (setq company-backends '(notmuch-company))\r
 336 +                               (notmuch-address-harvest-start)))\r
 337 +\r
 338 +(provide 'notmuch-company)\r
 339 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
 340 index 19269e3..00e8554 100644\r
 341 --- a/emacs/notmuch-lib.el\r
 342 +++ b/emacs/notmuch-lib.el\r
 343 @@ -228,6 +228,9 @@ on the command line, and then retry your notmuch command")))\r
 344    "Return the user.other_email value (as a list) from the notmuch configuration."\r
 345    (split-string (notmuch-config-get "user.other_email") "\n" t))\r
 346  \r
 347 +(defun notmuch-user-emails ()\r
 348 +  (cons (notmuch-user-primary-email) (notmuch-user-other-email)))\r
 349 +\r
 350  (defun notmuch-poll ()\r
 351    "Run \"notmuch new\" or an external script to import mail.\r
 352  \r
 353 -- \r
 354 2.0.1\r
 355 \r