emacs/notmuch-address.el

   1 ;; notmuch-address.el --- address completion with notmuch
   2 ;;
   3 ;; Copyright © David Edmondson
   4 ;;
   5 ;; This file is part of Notmuch.
   6 ;;
   7 ;; Notmuch is free software: you can redistribute it and/or modify it
   8 ;; under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11 ;;
  12 ;; Notmuch is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
  19 ;;
  20 ;; Authors: David Edmondson <dme@dme.org>
  21
  22 (require 'message)
  23 (require 'notmuch-query)
  24 (require 'notmuch-parser)
  25
  26 ;;
  27
  28 (defcustom notmuch-address-command nil
  29   "The command which generates possible addresses for completion.
  30 It must take a single argument and output a list of possible
  31 matches, one per line. If set to nil, addresses are generated by
  32 a built-in completion mechanism."
  33   :type '(radio (const :tag "No command: Use built-in completion" nil)
  34                  (string :tag "Custom command" :value "notmuch-addresses"))
  35   :group 'notmuch-send
  36   :group 'notmuch-external)
  37
  38 (defcustom notmuch-address-selection-function 'notmuch-address-selection-function
  39   "The function to select address from given list. The function is
  40 called with PROMPT, COLLECTION, and INITIAL-INPUT as arguments
  41 (subset of what `completing-read' can be called with).
  42 While executed the value of `completion-ignore-case' is t.
  43 See documentation of function `notmuch-address-selection-function'
  44 to know how address selection is made by default."
  45   :type 'function
  46   :group 'notmuch-send
  47   :group 'notmuch-external)
  48
  49 (defvar notmuch-address-last-harvest 0
  50   "Time of last address harvest")
  51
  52 (defvar notmuch-address-completions (make-hash-table :test 'equal)
  53   "Hash of email addresses for completion during email composition.
  54   This variable is set by calling `notmuch-address-harvest'.")
  55
  56 (defvar notmuch-address-full-harvest-finished nil
  57   "t indicates that full completion address harvesting has been
  58 finished")
  59
  60 (defun notmuch-address-selection-function (prompt collection initial-input)
  61   "Call (`completing-read'
  62       PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
  63   (completing-read
  64    prompt collection nil nil initial-input 'notmuch-address-history))
  65
  66 (defvar notmuch-address-message-alist-member
  67   '("^\\(Resent-\\)?\\(To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
  68               . notmuch-address-expand-name))
  69
  70 (defvar notmuch-address-history nil)
  71
  72 (defun notmuch-address-message-insinuate ()
  73   (unless (memq notmuch-address-message-alist-member message-completion-alist)
  74     (setq message-completion-alist
  75           (push notmuch-address-message-alist-member message-completion-alist))))
  76
  77 (defun notmuch-address-matching (substring)
  78   "Returns a list of completion candidates matching SUBSTRING.
  79 The candidates are taked form `notmuch-address-completions'."
  80   (let ((candidates)
  81         (re (regexp-quote substring)))
  82     (maphash (lambda (key val)
  83                (when (string-match re key)
  84                  (push key candidates)))
  85              notmuch-address-completions)
  86     candidates))
  87
  88 (defun notmuch-address-options (original)
  89   "Returns a list of completion candidates. Uses either
  90 elisp-based implementation or older implementation requiring
  91 external commands."
  92   (cond
  93    ((null notmuch-address-command)
  94     (when (not notmuch-address-full-harvest-finished)
  95       ;; First, run quick synchronous harvest based on what the user
  96       ;; entered so far
  97       (notmuch-address-harvest (format "to:%s*" original) t))
  98     (prog1 (notmuch-address-matching original)
  99       ;; Then (re)start potentially long-running full asynchronous harvesting
 100       (notmuch-address-harvest-trigger)))
 101    (t
 102     (process-lines notmuch-address-command original))))
 103
 104 (defun notmuch-address-expand-name ()
 105   (let* ((end (point))
 106          (beg (save-excursion
 107                 (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
 108                 (goto-char (match-end 0))
 109                 (point)))
 110          (orig (buffer-substring-no-properties beg end))
 111          (completion-ignore-case t)
 112          (options (with-temp-message "Looking for completion candidates..."
 113                     (notmuch-address-options orig)))
 114          (num-options (length options))
 115          (chosen (cond
 116                   ((eq num-options 0)
 117                    nil)
 118                   ((eq num-options 1)
 119                    (car options))
 120                   (t
 121                    (funcall notmuch-address-selection-function
 122                             (format "Address (%s matches): " num-options)
 123                             (cdr options) (car options))))))
 124     (if chosen
 125         (progn
 126           (push chosen notmuch-address-history)
 127           (delete-region beg end)
 128           (insert chosen))
 129       (message "No matches.")
 130       (ding))))
 131
 132 ;; Copied from `w3m-which-command'.
 133 (defun notmuch-address-locate-command (command)
 134   "Return non-nil if `command' is an executable either on
 135 `exec-path' or an absolute pathname."
 136   (when (stringp command)
 137     (if (and (file-name-absolute-p command)
 138              (file-executable-p command))
 139         command
 140       (setq command (file-name-nondirectory command))
 141       (catch 'found-command
 142         (let (bin)
 143           (dolist (dir exec-path)
 144             (setq bin (expand-file-name command dir))
 145             (when (or (and (file-executable-p bin)
 146                            (not (file-directory-p bin)))
 147                       (and (file-executable-p (setq bin (concat bin ".exe")))
 148                            (not (file-directory-p bin))))
 149               (throw 'found-command bin))))))))
 150
 151 (defun notmuch-address-harvest-msg (msg)
 152   (let* ((headers (plist-get msg :headers))
 153          (to (ignore-errors (mail-extract-address-components (plist-get headers :To) t)))
 154          (cc (ignore-errors (mail-extract-address-components (plist-get headers :Cc) t)))
 155          (bcc (ignore-errors (mail-extract-address-components (plist-get headers :Bcc) t))))
 156     (mapc (lambda (parts)
 157             (let* ((name (car parts))
 158                    (email (cadr parts))
 159                    (entry (if name (format "%s <%s>" name email) email)))
 160               (puthash entry t notmuch-address-completions)))
 161           (append to cc bcc))
 162     nil))
 163
 164 (defun notmuch-address-harvest-handle-result (obj)
 165   (notmuch-query-map-threads 'notmuch-address-harvest-msg (list obj)))
 166
 167 (defun notmuch-address-harvest-filter (proc string)
 168   (when (buffer-live-p (process-buffer proc))
 169     (with-current-buffer (process-buffer proc)
 170       (save-excursion
 171         (goto-char (point-max))
 172         (insert string))
 173       (notmuch-sexp-parse-partial-list
 174        'notmuch-address-harvest-handle-result (process-buffer proc)))))
 175
 176 (defvar notmuch-address-harvest-proc nil)   ; the process of a harvest underway
 177
 178 (defun notmuch-address-harvest (&optional filter-query synchronous callback)
 179   "Collect addresses completion candidates. It queries the
 180 notmuch database for all messages sent by the user optionally
 181 matching FILTER-QUERY (if not nil). It collects the destination
 182 addresses from those messages and stores them in
 183 `notmuch-address-completions'. Address harvesting may take some
 184 time so the address collection runs asynchronously unless
 185 SYNCHRONOUS is t. In case of asynchronous execution, CALLBACK is
 186 called when harvesting finishes."
 187   (let* ((from-me-query (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or "))
 188          (query (if filter-query
 189                     (format "(%s) and (%s)" from-me-query filter-query)
 190                   from-me-query))
 191          (args `("show" "--format=sexp" "--format-version=2"
 192                  "--body=false" "--entire-thread=false" ,query)))
 193     (if synchronous
 194         (notmuch-query-map-threads 'notmuch-address-harvest-msg
 195                                    (apply 'notmuch-call-notmuch-sexp args))
 196       ;; Asynchronous
 197       (when notmuch-address-harvest-proc
 198         (kill-buffer (process-buffer notmuch-address-harvest-proc))) ; this also kills the process
 199       (setq notmuch-address-harvest-proc
 200             (apply 'notmuch-start-notmuch
 201              "notmuch-address-harvest"          ; process name
 202              " *notmuch-address-harvest*"       ; process buffer
 203              callback                           ; process sentinel
 204              args))
 205       (set-process-filter notmuch-address-harvest-proc 'notmuch-address-harvest-filter)
 206       (set-process-query-on-exit-flag notmuch-address-harvest-proc nil)))
 207   ;; return value
 208   nil)
 209
 210 ;; If we can find the program specified by `notmuch-address-command',
 211 ;; or if it is nil, insinuate ourselves into `message-mode'.
 212 (when (or (null notmuch-address-command)
 213           (notmuch-address-locate-command notmuch-address-command))
 214   (notmuch-address-message-insinuate))
 215
 216 (defun notmuch-address-harvest-trigger ()
 217   (let ((now (float-time)))
 218     (when (> (- now notmuch-address-last-harvest) 86400)
 219       (setq notmuch-address-last-harvest now)
 220       (notmuch-address-harvest nil nil
 221                                (lambda (proc event)
 222                                  (message "Notmuch address harvesting finished in %d seconds"
 223                                           (- (float-time) notmuch-address-last-harvest))
 224                                  (setq notmuch-address-full-harvest-finished t))))))
 225
 226 ;;
 227
 228 (provide 'notmuch-address)