From c2361767abeef82b4f720f14ebcfdc2f720042d5 Mon Sep 17 00:00:00 2001 From: Mark Walters Date: Sun, 25 Oct 2015 17:28:51 +0000 Subject: [PATCH] Re: [Patch v7 2/3] Emacs: Add address completion mechanism implemented in elisp --- 1c/c61b667b662a3b0d50d1fcb51562116d19e27d | 372 ++++++++++++++++++++++ 1 file changed, 372 insertions(+) create mode 100644 1c/c61b667b662a3b0d50d1fcb51562116d19e27d diff --git a/1c/c61b667b662a3b0d50d1fcb51562116d19e27d b/1c/c61b667b662a3b0d50d1fcb51562116d19e27d new file mode 100644 index 000000000..4e6130ce5 --- /dev/null +++ b/1c/c61b667b662a3b0d50d1fcb51562116d19e27d @@ -0,0 +1,372 @@ +Return-Path: +X-Original-To: notmuch@notmuchmail.org +Delivered-To: notmuch@notmuchmail.org +Received: from localhost (localhost [127.0.0.1]) + by arlo.cworth.org (Postfix) with ESMTP id BF8A76DE1479 + for ; Sun, 25 Oct 2015 10:28:58 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at cworth.org +X-Spam-Flag: NO +X-Spam-Score: 0.25 +X-Spam-Level: +X-Spam-Status: No, score=0.25 tagged_above=-999 required=5 tests=[AWL=0.076, + DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, + FREEMAIL_ENVFROM_END_DIGIT=0.25, FREEMAIL_FROM=0.001, + RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H3=-0.01, + RCVD_IN_MSPIKE_WL=-0.01, SPF_PASS=-0.001, URIBL_SBL=0.644, + URIBL_SBL_A=0.1] autolearn=disabled +Received: from arlo.cworth.org ([127.0.0.1]) + by localhost (arlo.cworth.org [127.0.0.1]) (amavisd-new, port 10024) + with ESMTP id cQJCuIO_PvI6 for ; + Sun, 25 Oct 2015 10:28:56 -0700 (PDT) +Received: from mail-wi0-f181.google.com (mail-wi0-f181.google.com + [209.85.212.181]) + by arlo.cworth.org (Postfix) with ESMTPS id D37CD6DE103A + for ; Sun, 25 Oct 2015 10:28:55 -0700 (PDT) +Received: by wicfx6 with SMTP id fx6so86070720wic.1 + for ; Sun, 25 Oct 2015 10:28:54 -0700 (PDT) +DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; + h=from:to:subject:in-reply-to:references:user-agent:date:message-id + :mime-version:content-type; + bh=RW3haxCKEIU+sZJGWEqrLjHRBKyelkL35i6t2K4o+nw=; + b=KuXhunkumEmms/6/Bs1NE15Jwj0r3Q5ase++ux03zRu89zc41ESFqUDqahQnrVenTW + zsWMvOZ80kVOhNDi0r0HCfcqUGMIdUONjBlZLzXIK7VJT4G9N61IZH+ZBif26WQobS1g + XQ0ncGfQFMiuHpc6nDbak63c8xf9lqNpEqS6t7a+D0/r4YInaniygll6N9g7htuRswoT + xFm1X8OUIp65aEq+cd2BcsRhAGhOcu0Oqrzpz+tomn9p346VX9yI2YEwg6UJhLz/B1cy + wn4BuZ6fqXGrnLTEC92hG8pS/tFZw7pRRBspreFdb4WBIs9TmwofuLsboVzgpeqNk1MG + eEfg== +X-Received: by 10.194.7.97 with SMTP id i1mr39451402wja.87.1445794134012; + Sun, 25 Oct 2015 10:28:54 -0700 (PDT) +Received: from localhost (5751dfa2.skybroadband.com. [87.81.223.162]) + by smtp.gmail.com with ESMTPSA id kr10sm34477258wjc.25.2015.10.25.10.28.52 + (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); + Sun, 25 Oct 2015 10:28:53 -0700 (PDT) +From: Mark Walters +To: David Bremner , notmuch@notmuchmail.org +Subject: Re: [Patch v7 2/3] Emacs: Add address completion mechanism + implemented in elisp +In-Reply-To: <1445786638-13763-3-git-send-email-david@tethera.net> +References: <1445786638-13763-1-git-send-email-david@tethera.net> + <1445786638-13763-3-git-send-email-david@tethera.net> +User-Agent: Notmuch/0.21~rc1+29~g057f24d (http://notmuchmail.org) Emacs/23.4.1 + (x86_64-pc-linux-gnu) +Date: Sun, 25 Oct 2015 17:28:51 +0000 +Message-ID: <878u6qdfho.fsf@qmul.ac.uk> +MIME-Version: 1.0 +Content-Type: text/plain; charset=us-ascii +X-BeenThere: notmuch@notmuchmail.org +X-Mailman-Version: 2.1.20 +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: Sun, 25 Oct 2015 17:28:58 -0000 + +On Sun, 25 Oct 2015, David Bremner wrote: +> From: Michal Sojka +> +> Currently, notmuch has an address completion mechanism that requires +> external command to provide completion candidates. This patch adds a +> completion mechanism inspired by https://github.com/tjim/nevermore, +> which is implemented in Emacs lisp only. +> +> The preexisting address completion mechanism, activated by pressing TAB +> on To/Cc lines, is extended to use the new mechanism when no external +> command is configured, i.e. when notmuch-address-command to nil, which +> is the new default. +> +> The core of the new mechanism is the function notmuch-address-harvest, +> which collects the completion candidates from the notmuch database and +> stores them in notmuch-address-completions variable. The address +> harvesting can run either synchronously (same as with the previous +> mechanism) or asynchronously. When the user presses TAB for the first +> time, synchronous harvesting limited to user entered text is performed. +> If the entered text is reasonably long, this operation is relatively +> fast. Then, asynchronous harvesting over the full database is triggered. +> This operation may take long time (minutes on rotating disk). After it +> finishes, no harvesting is normally performed again and subsequent +> completion requests use the harvested data cached in memory. Completion +> cache is updated after 24 hours. +> +> Note that this commit restores (different) completion functionality for +> users when the user used external command named "notmuch-addresses", +> i.e. the old default. The result will be that the user will use +> the new mechanism instead of this command. I believe that many users may +> not even recognize this because the new mechanism works the same as +> http://commonmeasure.org/~jkr/git/notmuch_addresses.git and perhaps also +> as other commands suggested at +> http://notmuchmail.org/emacstips/#address_completion. +> --- +> emacs/notmuch-address.el | 192 ++++++++++++++++++++++++++++++++++++++--------- +> emacs/notmuch-lib.el | 3 + +> 2 files changed, 159 insertions(+), 36 deletions(-) +> +> diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el +> index e2af879..aa6228d 100644 +> --- a/emacs/notmuch-address.el +> +++ b/emacs/notmuch-address.el +> @@ -20,14 +20,17 @@ +> ;; Authors: David Edmondson +> +> (require 'message) +> - +> +(require 'notmuch-parser) +> +(require 'notmuch-lib) +> ;; +> +> -(defcustom notmuch-address-command nil +> +(defcustom notmuch-address-command 'internal +> "The command which generates possible addresses. It must take a +> single argument and output a list of possible matches, one per +> -line. The default value of nil disables address completion." +> +line. The default value of `internal' uses built-in address +> +completion." +> :type '(radio +> + (const :tag "Use internal address completion" internal) +> (const :tag "Disable address completion" nil) +> (string :tag "Use external completion command" "notmuch-addresses")) +> :group 'notmuch-send +> @@ -44,15 +47,25 @@ to know how address selection is made by default." +> :group 'notmuch-send +> :group 'notmuch-external) +> +> +(defvar notmuch-address-last-harvest 0 +> + "Time of last address harvest") +> + +> +(defvar notmuch-address-completions (make-hash-table :test 'equal) +> + "Hash of email addresses for completion during email composition. +> + This variable is set by calling `notmuch-address-harvest'.") +> + +> +(defvar notmuch-address-full-harvest-finished nil +> + "t indicates that full completion address harvesting has been +> +finished") +> + +> (defun notmuch-address-selection-function (prompt collection initial-input) +> "Call (`completing-read' +> PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" +> (completing-read +> prompt collection nil nil initial-input 'notmuch-address-history)) +> +> -(defvar notmuch-address-message-alist-member +> - '("^\\(Resent-\\)?\\(To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):" +> - . notmuch-address-expand-name)) +> +(defvar notmuch-address-completion-headers-regexp +> + "^\\(Resent-\\)?\\(To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):") +> +> (defvar notmuch-address-history nil) +> +> @@ -60,39 +73,67 @@ to know how address selection is made by default." +> (message "calling notmuch-address-message-insinuate is no longer needed")) +> +> (defun notmuch-address-setup () +> - (unless (memq notmuch-address-message-alist-member message-completion-alist) +> - (setq message-completion-alist +> - (push notmuch-address-message-alist-member message-completion-alist)))) +> + (let ((pair (cons notmuch-address-completion-headers-regexp +> + #'notmuch-address-expand-name))) +> + (unless (memq pair message-completion-alist) +> + (setq message-completion-alist +> + (push pair message-completion-alist))))) +> + +> +(defun notmuch-address-matching (substring) +> + "Returns a list of completion candidates matching SUBSTRING. +> +The candidates are taked form `notmuch-address-completions'." + +Just one minor typo: "taked form" should be "taken from". + +Best wishes + +Mark + +> + (let ((candidates) +> + (re (regexp-quote substring))) +> + (maphash (lambda (key val) +> + (when (string-match re key) +> + (push key candidates))) +> + notmuch-address-completions) +> + candidates)) +> + +> (defun notmuch-address-options (original) +> - (process-lines notmuch-address-command original)) +> + "Returns a list of completion candidates. Uses either +> +elisp-based implementation or older implementation requiring +> +external commands." +> + (cond +> + ((eq notmuch-address-command 'internal) +> + (when (not notmuch-address-full-harvest-finished) +> + ;; First, run quick synchronous harvest based on what the user +> + ;; entered so far +> + (notmuch-address-harvest (format "to:%s*" original) t)) +> + (prog1 (notmuch-address-matching original) +> + ;; Then (re)start potentially long-running full asynchronous harvesting +> + (notmuch-address-harvest-trigger))) +> + (t +> + (process-lines notmuch-address-command original)))) +> +> (defun notmuch-address-expand-name () +> - (let* ((end (point)) +> - (beg (save-excursion +> - (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") +> - (goto-char (match-end 0)) +> - (point))) +> - (orig (buffer-substring-no-properties beg end)) +> - (completion-ignore-case t) +> - (options (with-temp-message "Looking for completion candidates..." +> - (notmuch-address-options orig))) +> - (num-options (length options)) +> - (chosen (cond +> - ((eq num-options 0) +> - nil) +> - ((eq num-options 1) +> - (car options)) +> - (t +> - (funcall notmuch-address-selection-function +> - (format "Address (%s matches): " num-options) +> - (cdr options) (car options)))))) +> - (if chosen +> - (progn +> - (push chosen notmuch-address-history) +> - (delete-region beg end) +> - (insert chosen)) +> - (message "No matches.") +> - (ding)))) +> + (when notmuch-address-command +> + (let* ((end (point)) +> + (beg (save-excursion +> + (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") +> + (goto-char (match-end 0)) +> + (point))) +> + (orig (buffer-substring-no-properties beg end)) +> + (completion-ignore-case t) +> + (options (with-temp-message "Looking for completion candidates..." +> + (notmuch-address-options orig))) +> + (num-options (length options)) +> + (chosen (cond +> + ((eq num-options 0) +> + nil) +> + ((eq num-options 1) +> + (car options)) +> + (t +> + (funcall notmuch-address-selection-function +> + (format "Address (%s matches): " num-options) +> + (cdr options) (car options)))))) +> + (if chosen +> + (progn +> + (push chosen notmuch-address-history) +> + (delete-region beg end) +> + (insert chosen)) +> + (message "No matches.") +> + (ding))))) +> +> ;; Copied from `w3m-which-command'. +> (defun notmuch-address-locate-command (command) +> @@ -113,4 +154,83 @@ to know how address selection is made by default." +> (not (file-directory-p bin)))) +> (throw 'found-command bin)))))))) +> +> +(defun notmuch-address-harvest-addr (result) +> + (let ((name-addr (plist-get result :name-addr))) +> + (puthash name-addr t notmuch-address-completions))) +> + +> +(defun notmuch-address-harvest-handle-result (obj) +> + (notmuch-address-harvest-addr obj)) +> + +> +(defun notmuch-address-harvest-filter (proc string) +> + (when (buffer-live-p (process-buffer proc)) +> + (with-current-buffer (process-buffer proc) +> + (save-excursion +> + (goto-char (point-max)) +> + (insert string)) +> + (notmuch-sexp-parse-partial-list +> + 'notmuch-address-harvest-handle-result (process-buffer proc))))) +> + +> +(defvar notmuch-address-harvest-procs '(nil . nil) +> + "The currently running harvests. +> + +> +The car is a partial harvest, and the cdr is a full harvest") +> + +> +(defun notmuch-address-harvest (&optional filter-query synchronous callback) +> + "Collect addresses completion candidates. It queries the +> +notmuch database for all messages sent by the user optionally +> +matching FILTER-QUERY (if not nil). It collects the destination +> +addresses from those messages and stores them in +> +`notmuch-address-completions'. Address harvesting may take some +> +time so the address collection runs asynchronously unless +> +SYNCHRONOUS is t. In case of asynchronous execution, CALLBACK is +> +called when harvesting finishes." +> + (let* ((from-me-query (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or ")) +> + (query (if filter-query +> + (format "(%s) and (%s)" from-me-query filter-query) +> + from-me-query)) +> + (args `("address" "--format=sexp" "--format-version=2" +> + "--output=recipients" +> + "--deduplicate=address" +> + ,query))) +> + (if synchronous +> + (mapc #'notmuch-address-harvest-addr +> + (apply 'notmuch-call-notmuch-sexp args)) +> + ;; Asynchronous +> + (let* ((current-proc (if filter-query +> + (car notmuch-address-harvest-procs) +> + (cdr notmuch-address-harvest-procs))) +> + (proc-name (format "notmuch-address-%s-harvest" +> + (if filter-query "partial" "full"))) +> + (proc-buf (concat " *" proc-name "*"))) +> + ;; Kill any existing process +> + (when current-proc +> + (kill-buffer (process-buffer current-proc))) ; this also kills the process +> + +> + (setq current-proc +> + (apply 'notmuch-start-notmuch proc-name proc-buf +> + callback ; process sentinel +> + args)) +> + (set-process-filter current-proc 'notmuch-address-harvest-filter) +> + (set-process-query-on-exit-flag current-proc nil) +> + (if filter-query +> + (setcar notmuch-address-harvest-procs current-proc) +> + (setcdr notmuch-address-harvest-procs current-proc))))) +> + ;; return value +> + nil) +> + +> +(defun notmuch-address-harvest-trigger () +> + (let ((now (float-time))) +> + (when (> (- now notmuch-address-last-harvest) 86400) +> + (setq notmuch-address-last-harvest now) +> + (notmuch-address-harvest nil nil +> + (lambda (proc event) +> + ;; If harvest fails, we want to try +> + ;; again when the trigger is next +> + ;; called +> + (if (string= event "finished\n") +> + (setq notmuch-address-full-harvest-finished t) +> + (setq notmuch-address-last-harvest 0))))))) +> + +> +;; +> + +> (provide 'notmuch-address) +> diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el +> index 201d7ec..1c3a9fe 100644 +> --- a/emacs/notmuch-lib.el +> +++ b/emacs/notmuch-lib.el +> @@ -232,6 +232,9 @@ on the command line, and then retry your notmuch command"))) +> "Return the user.other_email value (as a list) from the notmuch configuration." +> (split-string (notmuch-config-get "user.other_email") "\n" t)) +> +> +(defun notmuch-user-emails () +> + (cons (notmuch-user-primary-email) (notmuch-user-other-email))) +> + +> (defun notmuch-poll () +> "Run \"notmuch new\" or an external script to import mail. +> +> -- +> 2.6.1 +> +> _______________________________________________ +> notmuch mailing list +> notmuch@notmuchmail.org +> https://notmuchmail.org/mailman/listinfo/notmuch -- 2.26.2