--- /dev/null
+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 46D65431FD6\r
+ for <notmuch@notmuchmail.org>; Fri, 19 Sep 2014 11:17:19 -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 9b5TSnxdFhdf for <notmuch@notmuchmail.org>;\r
+ Fri, 19 Sep 2014 11:17:12 -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 E1878431FBF\r
+ for <notmuch@notmuchmail.org>; Fri, 19 Sep 2014 11:17:06 -0700 (PDT)\r
+Received: from localhost (unknown [192.168.200.7])\r
+ by max.feld.cvut.cz (Postfix) with ESMTP id EE5F819F33F0;\r
+ Fri, 19 Sep 2014 20:17:00 +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 K_8W-9kD6We5; Fri, 19 Sep 2014 20:16:57 +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 C691819F33E7;\r
+ Fri, 19 Sep 2014 20:16:56 +0200 (CEST)\r
+Received: from wsh by steelpick.2x.cz with local (Exim 4.84)\r
+ (envelope-from <sojkam1@fel.cvut.cz>)\r
+ id 1XV2jn-0005i8-VW; Fri, 19 Sep 2014 20:16:55 +0200\r
+From: Michal Sojka <sojkam1@fel.cvut.cz>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH v4 2/3] Emacs: Add address completion mechanism implemented in\r
+ elisp\r
+Date: Fri, 19 Sep 2014 20:16:41 +0200\r
+Message-Id: <1411150602-21892-3-git-send-email-sojkam1@fel.cvut.cz>\r
+X-Mailer: git-send-email 2.1.0\r
+In-Reply-To: <1411150602-21892-1-git-send-email-sojkam1@fel.cvut.cz>\r
+References: <1411150602-21892-1-git-send-email-sojkam1@fel.cvut.cz>\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: Fri, 19 Sep 2014 18:17:19 -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 preexisting address completion mechanism, activated by pressing TAB\r
+on To/Cc lines, is extended to use the new mechanism when no external\r
+command is configured, i.e. when notmuch-address-command to nil, which\r
+is the new default.\r
+\r
+The core of the new mechanism is the function notmuch-address-harvest,\r
+which collects the completion candidates from the notmuch database and\r
+stores them in notmuch-address-completions variable. The address\r
+harvesting can run either synchronously (same as with the previous\r
+mechanism) or asynchronously. When the user presses TAB for the first\r
+time, synchronous harvesting limited to user entered text is performed.\r
+If the entered text is reasonably long, this operation is relatively\r
+fast. Then, asynchronous harvesting over the full database is triggered.\r
+This operation may take long time (minutes on rotating disk). After it\r
+finishes, no harvesting is normally performed again and subsequent\r
+completion requests use the harvested data cached in memory. Completion\r
+cache is updated after 24 hours.\r
+\r
+Note that the change of the notmuch-address-command default value\r
+may *BREAK EXISTING SETUPS* when the user used external command named\r
+"notmuch-addresses", i.e. the previous default. The result will be that\r
+the user will use the new mechanism instead of the his command. I\r
+believe that many users may not even recognize this because the new\r
+mechanism works the same as\r
+http://commonmeasure.org/~jkr/git/notmuch_addresses.git and perhaps also\r
+as other commands suggested at\r
+http://notmuchmail.org/emacstips/#address_completion.\r
+\r
+---\r
+Changes from v3:\r
+- Implemented both synchronous and asynchronous harvesting. The\r
+ synchronous implementation that uses faster "filtered" query is used\r
+ until the full asynchronous harvesting finishes.\r
+- Added automatic refresh of completion cache every 24 hours.\r
+\r
+Changes from v2:\r
+- Updated Makefile.local to not conflict with current master\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/notmuch-address.el | 123 ++++++++++++++++++++++++++++++++++++++++++++---\r
+ emacs/notmuch-lib.el | 3 ++\r
+ 2 files changed, 118 insertions(+), 8 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el\r
+index fde3c1b..9f6711b 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,17 @@ to know how address selection is made by default."\r
+ :group 'notmuch-send\r
+ :group 'notmuch-external)\r
+ \r
++(defvar notmuch-address-last-harvest 0\r
++ "Time of last address harvest")\r
++\r
++(defvar notmuch-address-completions (make-hash-table :test 'equal)\r
++ "Hash of email addresses for completion during email composition.\r
++ This variable is set by calling `notmuch-address-harvest'.")\r
++\r
++(defvar notmuch-address-full-harvest-finished nil\r
++ "t indicates that full completion address harvesting has been\r
++finished")\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
+@@ -59,8 +74,32 @@ to know how address selection is made by default."\r
+ (setq message-completion-alist\r
+ (push notmuch-address-message-alist-member message-completion-alist))))\r
+ \r
++(defun notmuch-address-matching (substring)\r
++ "Returns a list of completion candidates matching SUBSTRING.\r
++The candidates are taked form `notmuch-address-completions'."\r
++ (let ((candidates)\r
++ (re (regexp-quote substring)))\r
++ (maphash (lambda (key val)\r
++ (when (string-match re key)\r
++ (push key candidates)))\r
++ notmuch-address-completions)\r
++ candidates))\r
++\r
+ (defun notmuch-address-options (original)\r
+- (process-lines notmuch-address-command original))\r
++ "Returns a list of completion candidates. Uses either\r
++elisp-based implementation or older implementation requiring\r
++external commands."\r
++ (cond\r
++ ((null notmuch-address-command)\r
++ (when (not notmuch-address-full-harvest-finished)\r
++ ;; First, run quick synchronous harvest based on what the user\r
++ ;; entered so far\r
++ (notmuch-address-harvest (format "to:%s*" original) t))\r
++ (prog1 (notmuch-address-matching original)\r
++ ;; Then (re)start potentially long-running full asynchronous harvesting\r
++ (notmuch-address-harvest-trigger)))\r
++ (t\r
++ (process-lines notmuch-address-command original))))\r
+ \r
+ (defun notmuch-address-expand-name ()\r
+ (let* ((end (point))\r
+@@ -109,11 +148,79 @@ to know how address selection is made by default."\r
+ (not (file-directory-p bin))))\r
+ (throw 'found-command bin))))))))\r
+ \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 (&optional filter-query synchronous callback)\r
++ "Collect addresses completion candidates. It queries the\r
++notmuch database for all messages sent by the user optionally\r
++matching FILTER-QUERY (if not nil). It collects the destination\r
++addresses from those messages and stores them in\r
++`notmuch-address-completions'. Address harvesting may take some\r
++time so the address collection runs asynchronously unless\r
++SYNCHRONOUS is t. In case of asynchronous execution, CALLBACK is\r
++called when harvesting finishes."\r
++ (let* ((from-me-query (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or "))\r
++ (query (if filter-query\r
++ (format "(%s) and (%s)" from-me-query filter-query)\r
++ from-me-query))\r
++ (args `("show" "--format=sexp" "--format-version=2"\r
++ "--body=false" "--entire-thread=false" ,query)))\r
++ (if synchronous\r
++ (notmuch-query-map-threads 'notmuch-address-harvest-msg\r
++ (apply 'notmuch-call-notmuch-sexp args))\r
++ ;; Asynchronous\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\r
++ (apply 'notmuch-start-notmuch\r
++ "notmuch-address-harvest" ; process name\r
++ " *notmuch-address-harvest*" ; process buffer\r
++ callback ; process sentinel\r
++ args))\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
+-;; insinuate ourselves into `message-mode'.\r
+-(when (notmuch-address-locate-command notmuch-address-command)\r
++;; or if it is nil, insinuate ourselves into `message-mode'.\r
++(when (or (null notmuch-address-command)\r
++ (notmuch-address-locate-command notmuch-address-command))\r
+ (notmuch-address-message-insinuate))\r
+ \r
++(defun notmuch-address-harvest-trigger ()\r
++ (let ((now (float-time)))\r
++ (when (> (- now notmuch-address-last-harvest) 86400)\r
++ (setq notmuch-address-last-harvest now)\r
++ (notmuch-address-harvest nil nil\r
++ (lambda (proc event)\r
++ (setq notmuch-address-full-harvest-finished t))))))\r
++\r
+ ;;\r
+ \r
+ (provide 'notmuch-address)\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.1.0\r
+\r
projects / notmuch-archives.git / commitdiff