[PATCH v1 3/3] emacs: Add an address completer in elisp.

diff --git a/29/695c9747ebe8a8ada1c84c8edb001409a605a6 b/29/695c9747ebe8a8ada1c84c8edb001409a605a6
new file mode 100644 (file)
index 0000000..d415563
--- /dev/null
+++ b/29/695c9747ebe8a8ada1c84c8edb001409a605a6
@@ -0,0 +1,131 @@
+Return-Path: <dme@fenchurch.hh.sledj.net>\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 5DFE0431FB6\r
+       for <notmuch@notmuchmail.org>; Fri,  5 Sep 2014 05:59:51 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: 0.379\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=0.379 tagged_above=-999 required=5\r
+       tests=[NO_DNS_FOR_FROM=0.379] 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 Qx8sz6wsARab for <notmuch@notmuchmail.org>;\r
+       Fri,  5 Sep 2014 05:59:47 -0700 (PDT)\r
+Received: from fenchurch.hh.sledj.net (disaster-area.hh.sledj.net\r
+       [81.149.164.25])\r
+       by olra.theworths.org (Postfix) with ESMTP id 0A4AA431FC2\r
+       for <notmuch@notmuchmail.org>; Fri,  5 Sep 2014 05:59:46 -0700 (PDT)\r
+Received: by fenchurch.hh.sledj.net (Postfix, from userid 501)\r
+       id DE3171316559; Fri,  5 Sep 2014 13:59:29 +0100 (BST)\r
+From: David Edmondson <dme@dme.org>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH v1 3/3] emacs: Add an address completer in elisp.\r
+Date: Fri,  5 Sep 2014 13:59:29 +0100\r
+Message-Id: <1409921969-65129-4-git-send-email-dme@dme.org>\r
+X-Mailer: git-send-email 1.8.5.2 (Apple Git-48)\r
+In-Reply-To: <1409921969-65129-1-git-send-email-dme@dme.org>\r
+References: <1409921969-65129-1-git-send-email-dme@dme.org>\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, 05 Sep 2014 12:59:52 -0000\r
+\r
+Rather than relying on an external comment to provide address\r
+completion in composition mode, provide a solution purely in elisp.\r
+\r
+Update `notmuch-address-command' to allow it to specify an external\r
+command or a function, with the default remaining as an external\r
+command called "notmuch-addresses".\r
+---\r
+ emacs/notmuch-address.el | 49 +++++++++++++++++++++++++++++++++++++++++++-----\r
+ 1 file changed, 44 insertions(+), 5 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el\r
+index fa65cd5..449fa54 100644\r
+--- a/emacs/notmuch-address.el\r
++++ b/emacs/notmuch-address.el\r
+@@ -24,10 +24,17 @@\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
++  "Command or function which generates possible addresses.\r
++\r
++A command must take a single argument and output a list of\r
++possible matches, one per line.\r
++\r
++A function must take a single argument and return a list of\r
++possible matches."\r
++  :type '(choice (string :tag "External command")\r
++               (function :tag "Standard function"\r
++                         :value notmuch-address-option-generator)\r
++               (function :tag "Custom function"))\r
+   :group 'notmuch-send\r
+   :group 'notmuch-external)\r
+ \r
+@@ -42,6 +49,32 @@ to know how address selection is made by default."\r
+   :group 'notmuch-send\r
+   :group 'notmuch-external)\r
+ \r
++(defun notmuch-address-extractor (message)\r
++  "Return a list of addresses mentioned in `message'."\r
++  (let* ((headers (plist-get message :headers))\r
++       (from (plist-get headers :From)))\r
++    from))\r
++\r
++(defun notmuch-address-option-generator (initial)\r
++  "Generate a set of possible address completions for `initial'."\r
++  (let* ((my-addresses (notmuch-user-all-email))\r
++       (query (list (format "(%s) AND from:%s*"\r
++                            (mapconcat (lambda (a) (concat "to:" a))\r
++                                       my-addresses " OR ")\r
++                            initial)))\r
++       bare-results\r
++       results)\r
++    (dolist (address\r
++           (notmuch-query-map-threads 'notmuch-address-extractor\r
++                                      (notmuch-query-get-threads query t t)))\r
++      (when address\r
++      (let ((bare-address (cadr (std11-extract-address-components address))))\r
++        (unless (or (member bare-address my-addresses)\r
++                    (member bare-address bare-results))\r
++          (push bare-address bare-results)\r
++          (push address results)))))\r
++    results))\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 +93,13 @@ 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
++   ((stringp notmuch-address-command)\r
++    (process-lines notmuch-address-command original))\r
++   ((functionp notmuch-address-command)\r
++    (funcall notmuch-address-command original))\r
++   (t\r
++    (error "No address completion mechanism defined."))))\r
+ \r
+ (defun notmuch-address-expand-name ()\r
+   (let* ((end (point))\r
+-- \r
+1.8.5.2 (Apple Git-48)\r
+\r