ec/737f295592ef6096c99f3f3f0abce06cfeae8a

   1 Return-Path: <bremner@tethera.net>\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 arlo.cworth.org (Postfix) with ESMTP id 462606DE1329\r
   6  for <notmuch@notmuchmail.org>; Fri, 23 Oct 2015 17:22:17 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at cworth.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: 0.104\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=0.104 tagged_above=-999 required=5 tests=[AWL=0.094, \r
  12  T_FILL_THIS_FORM_SHORT=0.01] autolearn=disabled\r
  13 Received: from arlo.cworth.org ([127.0.0.1])\r
  14  by localhost (arlo.cworth.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15  with ESMTP id mej0Oh08C7Gx for <notmuch@notmuchmail.org>;\r
  16  Fri, 23 Oct 2015 17:22:12 -0700 (PDT)\r
  17 Received: from gitolite.debian.net (gitolite.debian.net [87.98.215.224])\r
  18  by arlo.cworth.org (Postfix) with ESMTPS id 888BA6DE1403\r
  19  for <notmuch@notmuchmail.org>; Fri, 23 Oct 2015 17:22:12 -0700 (PDT)\r
  20 Received: from remotemail by gitolite.debian.net with local (Exim 4.80)\r
  21  (envelope-from <bremner@tethera.net>)\r
  22  id 1Zpmaa-0006nC-Je; Sat, 24 Oct 2015 00:21:40 +0000\r
  23 Received: (nullmailer pid 26051 invoked by uid 1000); Sat, 24 Oct 2015\r
  24  00:20:41 -0000\r
  25 From: David Bremner <david@tethera.net>\r
  26 To: notmuch@notmuchmail.org\r
  27 Subject: [Patch v5 1/3] Emacs: Add address completion mechanism implemented\r
  28  in elisp\r
  29 Date: Fri, 23 Oct 2015 21:20:35 -0300\r
  30 Message-Id: <1445646037-25994-2-git-send-email-david@tethera.net>\r
  31 X-Mailer: git-send-email 2.6.1\r
  32 In-Reply-To: <1445646037-25994-1-git-send-email-david@tethera.net>\r
  33 References: <1445646037-25994-1-git-send-email-david@tethera.net>\r
  34 X-BeenThere: notmuch@notmuchmail.org\r
  35 X-Mailman-Version: 2.1.20\r
  36 Precedence: list\r
  37 List-Id: "Use and development of the notmuch mail system."\r
  38  <notmuch.notmuchmail.org>\r
  39 List-Unsubscribe: <https://notmuchmail.org/mailman/options/notmuch>,\r
  40  <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  41 List-Archive: <http://notmuchmail.org/pipermail/notmuch/>\r
  42 List-Post: <mailto:notmuch@notmuchmail.org>\r
  43 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  44 List-Subscribe: <https://notmuchmail.org/mailman/listinfo/notmuch>,\r
  45  <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  46 X-List-Received-Date: Sat, 24 Oct 2015 00:22:17 -0000\r
  47 \r
  48 From: Michal Sojka <sojkam1@fel.cvut.cz>\r
  49 \r
  50 Currently, notmuch has an address completion mechanism that requires\r
  51 external command to provide completion candidates. This patch adds a\r
  52 completion mechanism inspired by https://github.com/tjim/nevermore,\r
  53 which is implemented in Emacs lisp only.\r
  54 \r
  55 The preexisting address completion mechanism, activated by pressing TAB\r
  56 on To/Cc lines, is extended to use the new mechanism when no external\r
  57 command is configured, i.e. when notmuch-address-command to nil, which\r
  58 is the new default.\r
  59 \r
  60 The core of the new mechanism is the function notmuch-address-harvest,\r
  61 which collects the completion candidates from the notmuch database and\r
  62 stores them in notmuch-address-completions variable. The address\r
  63 harvesting can run either synchronously (same as with the previous\r
  64 mechanism) or asynchronously. When the user presses TAB for the first\r
  65 time, synchronous harvesting limited to user entered text is performed.\r
  66 If the entered text is reasonably long, this operation is relatively\r
  67 fast. Then, asynchronous harvesting over the full database is triggered.\r
  68 This operation may take long time (minutes on rotating disk). After it\r
  69 finishes, no harvesting is normally performed again and subsequent\r
  70 completion requests use the harvested data cached in memory. Completion\r
  71 cache is updated after 24 hours.\r
  72 \r
  73 Note that the change of the notmuch-address-command default value\r
  74 may *BREAK EXISTING SETUPS* when the user used external command named\r
  75 "notmuch-addresses", i.e. the previous default. The result will be that\r
  76 the user will use the new mechanism instead of the his command. I\r
  77 believe that many users may not even recognize this because the new\r
  78 mechanism works the same as\r
  79 http://commonmeasure.org/~jkr/git/notmuch_addresses.git and perhaps also\r
  80 as other commands suggested at\r
  81 http://notmuchmail.org/emacstips/#address_completion.\r
  82 ---\r
  83  emacs/notmuch-address.el | 123 ++++++++++++++++++++++++++++++++++++++++++++---\r
  84  emacs/notmuch-lib.el     |   3 ++\r
  85  2 files changed, 118 insertions(+), 8 deletions(-)\r
  86 \r
  87 diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el\r
  88 index fde3c1b..9f6711b 100644\r
  89 --- a/emacs/notmuch-address.el\r
  90 +++ b/emacs/notmuch-address.el\r
  91 @@ -20,14 +20,18 @@\r
  92  ;; Authors: David Edmondson <dme@dme.org>\r
  93  \r
  94  (require 'message)\r
  95 +(require 'notmuch-query)\r
  96 +(require 'notmuch-parser)\r
  97  \r
  98  ;;\r
  99  \r
 100 -(defcustom notmuch-address-command "notmuch-addresses"\r
 101 -  "The command which generates possible addresses. It must take a\r
 102 -single argument and output a list of possible matches, one per\r
 103 -line."\r
 104 -  :type 'string\r
 105 +(defcustom notmuch-address-command nil\r
 106 +  "The command which generates possible addresses for completion.\r
 107 +It must take a single argument and output a list of possible\r
 108 +matches, one per line. If set to nil, addresses are generated by\r
 109 +a built-in completion mechanism."\r
 110 +  :type '(radio (const :tag "No command: Use built-in completion" nil)\r
 111 +                (string :tag "Custom command" :value "notmuch-addresses"))\r
 112    :group 'notmuch-send\r
 113    :group 'notmuch-external)\r
 114  \r
 115 @@ -42,6 +46,17 @@ to know how address selection is made by default."\r
 116    :group 'notmuch-send\r
 117    :group 'notmuch-external)\r
 118  \r
 119 +(defvar notmuch-address-last-harvest 0\r
 120 +  "Time of last address harvest")\r
 121 +\r
 122 +(defvar notmuch-address-completions (make-hash-table :test 'equal)\r
 123 +  "Hash of email addresses for completion during email composition.\r
 124 +  This variable is set by calling `notmuch-address-harvest'.")\r
 125 +\r
 126 +(defvar notmuch-address-full-harvest-finished nil\r
 127 +  "t indicates that full completion address harvesting has been\r
 128 +finished")\r
 129 +\r
 130  (defun notmuch-address-selection-function (prompt collection initial-input)\r
 131    "Call (`completing-read'\r
 132        PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"\r
 133 @@ -59,8 +74,32 @@ to know how address selection is made by default."\r
 134      (setq message-completion-alist\r
 135           (push notmuch-address-message-alist-member message-completion-alist))))\r
 136  \r
 137 +(defun notmuch-address-matching (substring)\r
 138 +  "Returns a list of completion candidates matching SUBSTRING.\r
 139 +The candidates are taked form `notmuch-address-completions'."\r
 140 +  (let ((candidates)\r
 141 +       (re (regexp-quote substring)))\r
 142 +    (maphash (lambda (key val)\r
 143 +              (when (string-match re key)\r
 144 +                (push key candidates)))\r
 145 +            notmuch-address-completions)\r
 146 +    candidates))\r
 147 +\r
 148  (defun notmuch-address-options (original)\r
 149 -  (process-lines notmuch-address-command original))\r
 150 +  "Returns a list of completion candidates. Uses either\r
 151 +elisp-based implementation or older implementation requiring\r
 152 +external commands."\r
 153 +  (cond\r
 154 +   ((null notmuch-address-command)\r
 155 +    (when (not notmuch-address-full-harvest-finished)\r
 156 +      ;; First, run quick synchronous harvest based on what the user\r
 157 +      ;; entered so far\r
 158 +      (notmuch-address-harvest (format "to:%s*" original) t))\r
 159 +    (prog1 (notmuch-address-matching original)\r
 160 +      ;; Then (re)start potentially long-running full asynchronous harvesting\r
 161 +      (notmuch-address-harvest-trigger)))\r
 162 +   (t\r
 163 +    (process-lines notmuch-address-command original))))\r
 164  \r
 165  (defun notmuch-address-expand-name ()\r
 166    (let* ((end (point))\r
 167 @@ -109,11 +148,79 @@ to know how address selection is made by default."\r
 168                            (not (file-directory-p bin))))\r
 169               (throw 'found-command bin))))))))\r
 170  \r
 171 +(defun notmuch-address-harvest-msg (msg)\r
 172 +  (let* ((headers (plist-get msg :headers))\r
 173 +        (to (ignore-errors (mail-extract-address-components (plist-get headers :To) t)))\r
 174 +        (cc (ignore-errors (mail-extract-address-components (plist-get headers :Cc) t)))\r
 175 +        (bcc (ignore-errors (mail-extract-address-components (plist-get headers :Bcc) t))))\r
 176 +    (mapc (lambda (parts)\r
 177 +           (let* ((name (car parts))\r
 178 +                  (email (cadr parts))\r
 179 +                  (entry (if name (format "%s <%s>" name email) email)))\r
 180 +             (puthash entry t notmuch-address-completions)))\r
 181 +         (append to cc bcc))\r
 182 +    nil))\r
 183 +\r
 184 +(defun notmuch-address-harvest-handle-result (obj)\r
 185 +  (notmuch-query-map-threads 'notmuch-address-harvest-msg (list obj)))\r
 186 +\r
 187 +(defun notmuch-address-harvest-filter (proc string)\r
 188 +  (when (buffer-live-p (process-buffer proc))\r
 189 +    (with-current-buffer (process-buffer proc)\r
 190 +      (save-excursion\r
 191 +       (goto-char (point-max))\r
 192 +       (insert string))\r
 193 +      (notmuch-sexp-parse-partial-list\r
 194 +       'notmuch-address-harvest-handle-result (process-buffer proc)))))\r
 195 +\r
 196 +(defvar notmuch-address-harvest-proc nil)   ; the process of a harvest underway\r
 197 +\r
 198 +(defun notmuch-address-harvest (&optional filter-query synchronous callback)\r
 199 +  "Collect addresses completion candidates. It queries the\r
 200 +notmuch database for all messages sent by the user optionally\r
 201 +matching FILTER-QUERY (if not nil). It collects the destination\r
 202 +addresses from those messages and stores them in\r
 203 +`notmuch-address-completions'. Address harvesting may take some\r
 204 +time so the address collection runs asynchronously unless\r
 205 +SYNCHRONOUS is t. In case of asynchronous execution, CALLBACK is\r
 206 +called when harvesting finishes."\r
 207 +  (let* ((from-me-query (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or "))\r
 208 +        (query (if filter-query\r
 209 +                   (format "(%s) and (%s)" from-me-query filter-query)\r
 210 +                 from-me-query))\r
 211 +        (args `("show" "--format=sexp" "--format-version=2"\r
 212 +                "--body=false" "--entire-thread=false" ,query)))\r
 213 +    (if synchronous\r
 214 +       (notmuch-query-map-threads 'notmuch-address-harvest-msg\r
 215 +                                  (apply 'notmuch-call-notmuch-sexp args))\r
 216 +      ;; Asynchronous\r
 217 +      (when notmuch-address-harvest-proc\r
 218 +       (kill-buffer (process-buffer notmuch-address-harvest-proc))) ; this also kills the process\r
 219 +      (setq notmuch-address-harvest-proc\r
 220 +           (apply 'notmuch-start-notmuch\r
 221 +            "notmuch-address-harvest"          ; process name\r
 222 +            " *notmuch-address-harvest*"       ; process buffer\r
 223 +            callback                           ; process sentinel\r
 224 +            args))\r
 225 +      (set-process-filter notmuch-address-harvest-proc 'notmuch-address-harvest-filter)\r
 226 +      (set-process-query-on-exit-flag notmuch-address-harvest-proc nil)))\r
 227 +  ;; return value\r
 228 +  nil)\r
 229 +\r
 230  ;; If we can find the program specified by `notmuch-address-command',\r
 231 -;; insinuate ourselves into `message-mode'.\r
 232 -(when (notmuch-address-locate-command notmuch-address-command)\r
 233 +;; or if it is nil, insinuate ourselves into `message-mode'.\r
 234 +(when (or (null notmuch-address-command)\r
 235 +         (notmuch-address-locate-command notmuch-address-command))\r
 236    (notmuch-address-message-insinuate))\r
 237  \r
 238 +(defun notmuch-address-harvest-trigger ()\r
 239 +  (let ((now (float-time)))\r
 240 +    (when (> (- now notmuch-address-last-harvest) 86400)\r
 241 +      (setq notmuch-address-last-harvest now)\r
 242 +      (notmuch-address-harvest nil nil\r
 243 +                              (lambda (proc event)\r
 244 +                                (setq notmuch-address-full-harvest-finished t))))))\r
 245 +\r
 246  ;;\r
 247  \r
 248  (provide 'notmuch-address)\r
 249 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
 250 index 201d7ec..1c3a9fe 100644\r
 251 --- a/emacs/notmuch-lib.el\r
 252 +++ b/emacs/notmuch-lib.el\r
 253 @@ -232,6 +232,9 @@ on the command line, and then retry your notmuch command")))\r
 254    "Return the user.other_email value (as a list) from the notmuch configuration."\r
 255    (split-string (notmuch-config-get "user.other_email") "\n" t))\r
 256  \r
 257 +(defun notmuch-user-emails ()\r
 258 +  (cons (notmuch-user-primary-email) (notmuch-user-other-email)))\r
 259 +\r
 260  (defun notmuch-poll ()\r
 261    "Run \"notmuch new\" or an external script to import mail.\r
 262  \r
 263 -- \r
 264 2.6.1\r
 265 \r