From 35811a07f3f1a2ae18c71c35f63631017b504f93 Mon Sep 17 00:00:00 2001 From: Michal Sojka Date: Fri, 19 Sep 2014 20:16:41 +0200 Subject: [PATCH] [PATCH v4 2/3] Emacs: Add address completion mechanism implemented in elisp --- 22/ac37d8cb089f39586bb11e792e04005aad2a3e | 293 ++++++++++++++++++++++ 1 file changed, 293 insertions(+) create mode 100644 22/ac37d8cb089f39586bb11e792e04005aad2a3e diff --git a/22/ac37d8cb089f39586bb11e792e04005aad2a3e b/22/ac37d8cb089f39586bb11e792e04005aad2a3e new file mode 100644 index 000000000..cf0522e76 --- /dev/null +++ b/22/ac37d8cb089f39586bb11e792e04005aad2a3e @@ -0,0 +1,293 @@ +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 46D65431FD6 + for ; Fri, 19 Sep 2014 11:17:19 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: -2.3 +X-Spam-Level: +X-Spam-Status: No, score=-2.3 tagged_above=-999 required=5 + tests=[RCVD_IN_DNSWL_MED=-2.3] 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 9b5TSnxdFhdf for ; + Fri, 19 Sep 2014 11:17:12 -0700 (PDT) +Received: from max.feld.cvut.cz (max.feld.cvut.cz [147.32.192.36]) + by olra.theworths.org (Postfix) with ESMTP id E1878431FBF + for ; Fri, 19 Sep 2014 11:17:06 -0700 (PDT) +Received: from localhost (unknown [192.168.200.7]) + by max.feld.cvut.cz (Postfix) with ESMTP id EE5F819F33F0; + Fri, 19 Sep 2014 20:17:00 +0200 (CEST) +X-Virus-Scanned: IMAP STYX AMAVIS +Received: from max.feld.cvut.cz ([192.168.200.1]) + by localhost (styx.feld.cvut.cz [192.168.200.7]) (amavisd-new, + port 10044) + with ESMTP id K_8W-9kD6We5; Fri, 19 Sep 2014 20:16:57 +0200 (CEST) +Received: from imap.feld.cvut.cz (imap.feld.cvut.cz [147.32.192.34]) + by max.feld.cvut.cz (Postfix) with ESMTP id C691819F33E7; + Fri, 19 Sep 2014 20:16:56 +0200 (CEST) +Received: from wsh by steelpick.2x.cz with local (Exim 4.84) + (envelope-from ) + id 1XV2jn-0005i8-VW; Fri, 19 Sep 2014 20:16:55 +0200 +From: Michal Sojka +To: notmuch@notmuchmail.org +Subject: [PATCH v4 2/3] Emacs: Add address completion mechanism implemented in + elisp +Date: Fri, 19 Sep 2014 20:16:41 +0200 +Message-Id: <1411150602-21892-3-git-send-email-sojkam1@fel.cvut.cz> +X-Mailer: git-send-email 2.1.0 +In-Reply-To: <1411150602-21892-1-git-send-email-sojkam1@fel.cvut.cz> +References: <1411150602-21892-1-git-send-email-sojkam1@fel.cvut.cz> +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, 19 Sep 2014 18:17:19 -0000 + +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 the change of the notmuch-address-command default value +may *BREAK EXISTING SETUPS* when the user used external command named +"notmuch-addresses", i.e. the previous default. The result will be that +the user will use the new mechanism instead of the his 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. + +--- +Changes from v3: +- Implemented both synchronous and asynchronous harvesting. The + synchronous implementation that uses faster "filtered" query is used + until the full asynchronous harvesting finishes. +- Added automatic refresh of completion cache every 24 hours. + +Changes from v2: +- Updated Makefile.local to not conflict with current master + +Changes from v1: +- Use of notmuch-parser.el instead of the custom parser in the + original code. The notmuch parser is slightly faster. +- Use of functions in notmuch-query.el instead of functions in the + original code with almost the same functionality. +- Integrated with existing completion mechanism in notmuch. +- notmuch-company.el was moved from emacs/contrib to emacs and + no-byte-compile directive was added to it. +- Aligned with notmuch naming conventions. +- Documented bugs found in notmuch-company.el +--- + emacs/notmuch-address.el | 123 ++++++++++++++++++++++++++++++++++++++++++++--- + emacs/notmuch-lib.el | 3 ++ + 2 files changed, 118 insertions(+), 8 deletions(-) + +diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el +index fde3c1b..9f6711b 100644 +--- a/emacs/notmuch-address.el ++++ b/emacs/notmuch-address.el +@@ -20,14 +20,18 @@ + ;; Authors: David Edmondson + + (require 'message) ++(require 'notmuch-query) ++(require 'notmuch-parser) + + ;; + +-(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 ++(defcustom notmuch-address-command nil ++ "The command which generates possible addresses for completion. ++It must take a single argument and output a list of possible ++matches, one per line. If set to nil, addresses are generated by ++a built-in completion mechanism." ++ :type '(radio (const :tag "No command: Use built-in completion" nil) ++ (string :tag "Custom command" :value "notmuch-addresses")) + :group 'notmuch-send + :group 'notmuch-external) + +@@ -42,6 +46,17 @@ 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)" +@@ -59,8 +74,32 @@ to know how address selection is made by default." + (setq message-completion-alist + (push notmuch-address-message-alist-member 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 ++ ((null notmuch-address-command) ++ (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)) +@@ -109,11 +148,79 @@ to know how address selection is made by default." + (not (file-directory-p bin)))) + (throw 'found-command bin)))))))) + ++(defun notmuch-address-harvest-msg (msg) ++ (let* ((headers (plist-get msg :headers)) ++ (to (ignore-errors (mail-extract-address-components (plist-get headers :To) t))) ++ (cc (ignore-errors (mail-extract-address-components (plist-get headers :Cc) t))) ++ (bcc (ignore-errors (mail-extract-address-components (plist-get headers :Bcc) t)))) ++ (mapc (lambda (parts) ++ (let* ((name (car parts)) ++ (email (cadr parts)) ++ (entry (if name (format "%s <%s>" name email) email))) ++ (puthash entry t notmuch-address-completions))) ++ (append to cc bcc)) ++ nil)) ++ ++(defun notmuch-address-harvest-handle-result (obj) ++ (notmuch-query-map-threads 'notmuch-address-harvest-msg (list 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-proc nil) ; the process of a harvest underway ++ ++(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 `("show" "--format=sexp" "--format-version=2" ++ "--body=false" "--entire-thread=false" ,query))) ++ (if synchronous ++ (notmuch-query-map-threads 'notmuch-address-harvest-msg ++ (apply 'notmuch-call-notmuch-sexp args)) ++ ;; Asynchronous ++ (when notmuch-address-harvest-proc ++ (kill-buffer (process-buffer notmuch-address-harvest-proc))) ; this also kills the process ++ (setq notmuch-address-harvest-proc ++ (apply 'notmuch-start-notmuch ++ "notmuch-address-harvest" ; process name ++ " *notmuch-address-harvest*" ; process buffer ++ callback ; process sentinel ++ args)) ++ (set-process-filter notmuch-address-harvest-proc 'notmuch-address-harvest-filter) ++ (set-process-query-on-exit-flag notmuch-address-harvest-proc nil))) ++ ;; return value ++ nil) ++ + ;; If we can find the program specified by `notmuch-address-command', +-;; insinuate ourselves into `message-mode'. +-(when (notmuch-address-locate-command notmuch-address-command) ++;; or if it is nil, insinuate ourselves into `message-mode'. ++(when (or (null notmuch-address-command) ++ (notmuch-address-locate-command notmuch-address-command)) + (notmuch-address-message-insinuate)) + ++(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) ++ (setq notmuch-address-full-harvest-finished t)))))) ++ + ;; + + (provide 'notmuch-address) +diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el +index 19269e3..00e8554 100644 +--- a/emacs/notmuch-lib.el ++++ b/emacs/notmuch-lib.el +@@ -228,6 +228,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.1.0 + -- 2.26.2