X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-address.el;h=aafbe5fb8328a4ce1b92a9aa482ffa36dbd7fd6e;hp=8eba7a0b77681f1f03c597840ef2276eda554adc;hb=0cf457b73b4b666314d1a09ac3e31bd0fa2346a6;hpb=0fc424a1f00f49599c231e8dcbdb2fe156f237e3

diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el
index 8eba7a0b..aafbe5fb 100644
--- a/emacs/notmuch-address.el
+++ b/emacs/notmuch-address.el
@@ -1,4 +1,4 @@
-;; notmuch-address.el --- address completion with notmuch
+;;; notmuch-address.el --- address completion with notmuch
 ;;
 ;; Copyright © David Edmondson
 ;;
@@ -19,57 +19,137 @@
 ;;
 ;; Authors: David Edmondson <dme@dme.org>
 
-(require 'message)
+;;; Code:
 
+(require 'message)
+(require 'notmuch-parser)
+(require 'notmuch-lib)
+(require 'notmuch-company)
 ;;
+(declare-function company-manual-begin "company")
 
-(defcustom notmuch-address-command "notmuch-addresses"
+(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."
-  :type 'string
-  :group 'notmuch)
+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
+  :group 'notmuch-external)
+
+(defcustom notmuch-address-selection-function 'notmuch-address-selection-function
+  "The function to select address from given list. The function is
+called with PROMPT, COLLECTION, and INITIAL-INPUT as arguments
+(subset of what `completing-read' can be called with).
+While executed the value of `completion-ignore-case' is t.
+See documentation of function `notmuch-address-selection-function'
+to know how address selection is made by default."
+  :type 'function
+  :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-message-alist-member
-  '("^\\(Resent-\\)?\\(To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
-	      . notmuch-address-expand-name))
+(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-completion-headers-regexp
+  "^\\(Resent-\\)?\\(To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):")
 
 (defvar notmuch-address-history nil)
 
 (defun notmuch-address-message-insinuate ()
-  (if (not (memq notmuch-address-message-alist-member message-completion-alist))
-      (setq message-completion-alist
-	    (push notmuch-address-message-alist-member message-completion-alist))))
+  (message "calling notmuch-address-message-insinuate is no longer needed"))
+
+(defcustom notmuch-address-use-company t
+  "If available, use company mode for address completion"
+  :type 'boolean
+  :group 'notmuch-send)
+
+(defun notmuch-address-setup ()
+  (let* ((use-company (and notmuch-address-use-company
+			   (eq notmuch-address-command 'internal)
+			   (require 'company nil t)))
+	 (pair (cons notmuch-address-completion-headers-regexp
+		     (if use-company
+			 #'company-manual-begin
+		       #'notmuch-address-expand-name))))
+      (when use-company
+	(notmuch-company-setup))
+      (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 taken from `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 start the (potentially long-running) full asynchronous harvest if necessary
+      (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 (notmuch-address-options orig))
-	 (num-options (length options))
-	 (chosen (cond
-		  ((eq num-options 0)
-		   nil)
-		  ((eq num-options 1)
-		   (car options))
-		  (t
-		   (completing-read (format "Address (%s matches): " num-options)
-				    (cdr options) nil nil (car options)
-				    'notmuch-address-history)))))
-    (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)
@@ -90,11 +170,85 @@ line."
 			   (not (file-directory-p bin))))
 	      (throw 'found-command bin))))))))
 
-;; If we can find the program specified by `notmuch-address-command',
-;; insinuate ourselves into `message-mode'.
-(when (notmuch-address-locate-command notmuch-address-command)
-  (notmuch-address-message-insinuate))
+(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)
+
+;;; notmuch-address.el ends here