From 4cccf23a4f89985f7b69a62e988efa1b083cdf31 Mon Sep 17 00:00:00 2001 From: David Bremner Date: Mon, 26 Oct 2015 12:23:57 +2100 Subject: [PATCH] [Patch v7 2/3] Emacs: Add address completion mechanism implemented in elisp --- 07/6ee68624b4c76001be9eb5ce85ca3687ef0a98 | 338 ++++++++++++++++++++++ 1 file changed, 338 insertions(+) create mode 100644 07/6ee68624b4c76001be9eb5ce85ca3687ef0a98 diff --git a/07/6ee68624b4c76001be9eb5ce85ca3687ef0a98 b/07/6ee68624b4c76001be9eb5ce85ca3687ef0a98 new file mode 100644 index 000000000..54639142a --- /dev/null +++ b/07/6ee68624b4c76001be9eb5ce85ca3687ef0a98 @@ -0,0 +1,338 @@ +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 A70F66DE1405 + for ; Sun, 25 Oct 2015 08:25:57 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at cworth.org +X-Spam-Flag: NO +X-Spam-Score: 0.098 +X-Spam-Level: +X-Spam-Status: No, score=0.098 tagged_above=-999 required=5 tests=[AWL=0.098] + 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 xuBhfAOxOrG9 for ; + Sun, 25 Oct 2015 08:25:55 -0700 (PDT) +Received: from gitolite.debian.net (gitolite.debian.net [87.98.215.224]) + by arlo.cworth.org (Postfix) with ESMTPS id 6E82D6DE14F2 + for ; Sun, 25 Oct 2015 08:25:53 -0700 (PDT) +Received: from remotemail by gitolite.debian.net with local (Exim 4.80) + (envelope-from ) + id 1ZqNAf-00050I-Ps; Sun, 25 Oct 2015 15:25:21 +0000 +Received: (nullmailer pid 13827 invoked by uid 1000); Sun, 25 Oct 2015 + 15:24:09 -0000 +From: David Bremner +To: notmuch@notmuchmail.org +Subject: [Patch v7 2/3] Emacs: Add address completion mechanism implemented + in elisp +Date: Sun, 25 Oct 2015 12:23:57 -0300 +Message-Id: <1445786638-13763-3-git-send-email-david@tethera.net> +X-Mailer: git-send-email 2.6.1 +In-Reply-To: <1445786638-13763-1-git-send-email-david@tethera.net> +References: <1445786638-13763-1-git-send-email-david@tethera.net> +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 15:25:57 -0000 + +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'." ++ (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 + -- 2.26.2