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