From: David Bremner Date: Fri, 30 Oct 2015 10:33:48 +0000 (-0300) Subject: Merge tag '0.21' X-Git-Url: http://rtime.felk.cvut.cz/gitweb/notmuch.git/commitdiff_plain/ca076ce2736b5db2ec03afe1b0e09299b24f05ff?hp=bf511cb6979ede33d17d9da6f46f71ea287461d8 Merge tag '0.21' notmuch 0.21 release --- diff --git a/emacs/Makefile.local b/emacs/Makefile.local index 1109cfa6..4c06c52f 100644 --- a/emacs/Makefile.local +++ b/emacs/Makefile.local @@ -20,6 +20,7 @@ emacs_sources := \ $(dir)/notmuch-print.el \ $(dir)/notmuch-version.el \ $(dir)/notmuch-jump.el \ + $(dir)/notmuch-company.el $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl diff --git a/emacs/notmuch-address.el b/emacs/notmuch-address.el index fde3c1b2..49e24023 100644 --- a/emacs/notmuch-address.el +++ b/emacs/notmuch-address.el @@ -20,14 +20,21 @@ ;; Authors: David Edmondson (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 +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) @@ -42,53 +49,105 @@ 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) (defun notmuch-address-message-insinuate () - (unless (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 (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) @@ -109,10 +168,82 @@ to know how address selection is made by default." (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))))))) ;; diff --git a/emacs/notmuch-company.el b/emacs/notmuch-company.el new file mode 100644 index 00000000..add3161b --- /dev/null +++ b/emacs/notmuch-company.el @@ -0,0 +1,86 @@ +;; notmuch-company.el --- Mail address completion for notmuch via company-mode -*- lexical-binding: t -*- + +;; Authors: Trevor Jim +;; Michal Sojka +;; +;; Keywords: mail, completion + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; To enable this, install company mode (https://company-mode.github.io/) +;; +;; NB company-minimum-prefix-length defaults to 3 so you don't get +;; completion unless you type 3 characters + +;;; Code: + +(eval-when-compile (require 'cl)) + +(defvar notmuch-company-last-prefix nil) +(make-variable-buffer-local 'notmuch-company-last-prefix) +(declare-function company-begin-backend "company") +(declare-function company-grab "company") +(declare-function company-mode "company") +(declare-function company-manual-begin "company") +(defvar company-backends) + +(declare-function notmuch-address-harvest "notmuch-address") +(declare-function notmuch-address-harvest-trigger "notmuch-address") +(declare-function notmuch-address-matching "notmuch-address") +(defvar notmuch-address-full-harvest-finished) +(defvar notmuch-address-completion-headers-regexp) + +;;;###autoload +(defun notmuch-company-setup () + (company-mode) + (make-local-variable 'company-backends) + (setq company-backends '(notmuch-company))) + +;;;###autoload +(defun notmuch-company (command &optional arg &rest _ignore) + "`company-mode' completion back-end for `notmuch'." + (interactive (list 'interactive)) + (require 'company) + (let ((case-fold-search t) + (completion-ignore-case t)) + (case command + (interactive (company-begin-backend 'notmuch-company)) + (prefix (and (derived-mode-p 'message-mode) + (looking-back (concat notmuch-address-completion-headers-regexp ".*") + (line-beginning-position)) + (setq notmuch-company-last-prefix (company-grab "[:,][ \t]*\\(.*\\)" 1 (point-at-bol))))) + (candidates (cond + (notmuch-address-full-harvest-finished + ;; Update harvested addressed from time to time + (notmuch-address-harvest-trigger) + (notmuch-address-matching arg)) + (t + (cons :async + (lambda (callback) + ;; First run quick asynchronous harvest based on what the user entered so far + (notmuch-address-harvest + (format "to:%s*" arg) nil + (lambda (_proc _event) + (funcall callback (notmuch-address-matching arg)) + ;; Then start the (potentially long-running) full asynchronous harvest if necessary + (notmuch-address-harvest-trigger)))))))) + (match (if (string-match notmuch-company-last-prefix arg) + (match-end 0) + 0)) + (no-cache t)))) + + +(provide 'notmuch-company) diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 201d7ec8..1c3a9fe1 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. diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 57465b20..fd98ea41 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -269,7 +269,9 @@ Note that these functions use `mail-citation-hook' if that is non-nil." (set-buffer-modified-p nil)) (define-derived-mode notmuch-message-mode message-mode "Message[Notmuch]" - "Notmuch message composition mode. Mostly like `message-mode'") + "Notmuch message composition mode. Mostly like `message-mode'" + (when notmuch-address-command + (notmuch-address-setup))) (define-key notmuch-message-mode-map (kbd "C-c C-c") #'notmuch-mua-send-and-exit) (define-key notmuch-message-mode-map (kbd "C-c C-s") #'notmuch-mua-send) diff --git a/lib/notmuch.h b/lib/notmuch.h index 85b56bf1..310a8b8a 100644 --- a/lib/notmuch.h +++ b/lib/notmuch.h @@ -1752,7 +1752,7 @@ notmuch_filenames_t * notmuch_directory_get_child_files (notmuch_directory_t *directory); /** - * Get a notmuch_filenams_t iterator listing all the filenames of + * Get a notmuch_filenames_t iterator listing all the filenames of * sub-directories in the database within the given directory. * * The returned filenames will be the basename-entries only (not