Notmuch/mu4e/message: Universal capture with Org-contacts and completing-read

master
Pierre Neidhardt 2019-03-18 13:05:33 +01:00
parent 36c805fb6e
commit 3645d66093
3 changed files with 68 additions and 78 deletions

View File

@ -109,9 +109,61 @@ A fortune is appended if `ambrevar/mu4e-compose-fortune-p' is non-nil."
(ispell-change-dictionary (cdr (assoc (car addresses) address-lang-map)))
(setq addresses nil)))))
(add-hook 'message-setup-hook 'ambrevar/mu4e-select-dictionary)
;; Because it's to tempting to send an e-mail riddled with typos...
(add-hook 'message-setup-hook 'flyspell-mode)
;; Org capture for emails in org-contacts
;; TODO: Don't duplicate contacts.
(defun ambrevar/message-complete-address ()
(require 'subr-x)
;; Need to get last message buffer since Org capture happens in a different
;; buffer.
(let ((last-buffer
(cl-loop for buffer in (buffer-list)
when (with-current-buffer buffer
(or (derived-mode-p 'notmuch-show-mode)
(derived-mode-p 'message-mode)))
return buffer)))
(save-window-excursion
(with-current-buffer last-buffer
(let* ((recipients (message-recipients 'include-from))
(addresses-names (mapcar
(lambda (s)
(concat (cadr s) " " (car s)))
recipients))
(email-at-point (let ((email (thing-at-point 'email)))
(when email
(string-trim email "<" ">"))))
(default (when email-at-point (seq-find (lambda (addr)
(string-prefix-p email-at-point
addr))
addresses-names)))
(address-name (completing-read "Address: " addresses-names
nil nil nil nil default))
(idx (string-match " " address-name))
(address (substring address-name 0 idx))
(name (substring address-name idx)))
(list address name))))))
(defun ambrevar/org-capture-contact-format (address name)
(format "%s
:PROPERTIES:
:EMAIL: %s
:END:" name address))
(add-to-list 'org-capture-templates
`("C" "Add e-mail address to contacts" entry (file+headline ,(car org-contacts-files) "Contacts")
"* %(apply 'ambrevar/org-capture-contact-format (ambrevar/message-complete-address))"))
;; The following is an alternative using the template format string. It has some missing features though:
;; - Can't use (thing-at-point 'email) as a default.
;; - Need to manually match Name and Address.
;; (add-to-list 'org-capture-templates
;; `("c" "Add e-mail address to contacts" entry (file+headline ,(car org-contacts-files) "Contacts")
;; "* %^{Name|%:fromname|%:to-names|%:cc-names}
;; :PROPERTIES:
;; :EMAIL: %^{Address|%:fromaddress|%:to-addresses|%:cc-addresses}
;; :END:"))
(provide 'init-message)

View File

@ -105,93 +105,20 @@ Default to unread messages if the header buffer does not already exist."
(dolist (map (list mu4e-headers-mode-map mu4e-main-mode-map mu4e-view-mode-map))
(define-key map "s" 'helm-mu)))
(defun ambrevar/message-fetch-addresses ()
"Return a list of (NAME EMAIL) from the message header.
The \"From\", \"To\", \"Cc\" and \"Bcc\" fields are looked up.
Addresses in `mu4e-user-mail-address-list' are filtered out.
Duplicates are removed."
(require 'cl)
;; TODO: Replace by cl-loop.
(cl-delete-duplicates
(seq-remove
(lambda (contact) (member (cadr contact) mu4e-user-mail-address-list))
(seq-map (lambda (contact) (list (car contact) (and (cadr contact) (downcase (cadr contact)))))
(apply 'append
(if (eq major-mode 'mu4e-compose-mode)
(save-restriction
(message-narrow-to-headers)
(mapcar
(lambda (addr) (mail-extract-address-components
(message-fetch-field addr) t))
(seq-filter 'message-fetch-field
'("From" "To" "Cc" "Bcc"))))
(unless (buffer-live-p (mu4e-get-headers-buffer))
(mu4e-error "no headers buffer connected"))
(let ((msg (or (mu4e-message-at-point 'noerror)
(with-current-buffer (mu4e-get-headers-buffer)
;; When loading messages, point might
;; not be over a message yet.
(mu4e-message-at-point 'noerror)))))
(when msg
(delq nil
(mapcar (lambda (field)
;; `mu4e-message-field' returns a list of (NAME . EMAIL).
(mapcar (lambda (addr) (list (car addr) (cdr addr)))
(mu4e-message-field msg field)))
'(:from :to :cc :bcc)))))))))))
;;; Org capture
;;; Org captures
(when (require 'org-mu4e nil t)
(dolist (map (list mu4e-view-mode-map mu4e-headers-mode-map))
;; Org mode has "C-c C-t" for 'org-todo.
(define-key map (kbd "C-c C-t") 'org-mu4e-store-and-capture))
(setq org-mu4e-link-query-in-headers-mode nil))
(setq org-mu4e-link-query-in-headers-mode nil)
;;; Org captures
(when (require 'org-mu4e nil t)
(require 'init-org) ; For org-agenda-files
(defun ambrevar/org-mail-date (&optional msg)
(with-current-buffer (mu4e-get-headers-buffer)
(mu4e-message-field (or msg (mu4e-message-at-point)) :date)))
(add-to-list 'org-capture-templates
`("t" "Mark e-mail in agenda" entry (file+headline ,(car org-agenda-files) "E-mails")
"* %?\nSCHEDULED: %(org-insert-time-stamp (org-read-date nil t \"++7d\" nil (ambrevar/org-mail-date)))\n%a\n"))
;; TODO: Don't duplicate contacts.
(defun ambrevar/mu4e-contact-dwim ()
"Return a list of (NAME . ADDRESS).
If point has an `email' property, move it to the front of the list.
Addresses in `mu4e-user-mail-address-list' are skipped."
(let ((result (ambrevar/message-fetch-addresses))
(message org-store-link-plist))
;; Move contact at point to front.
(let ((email-at-point (get-text-property (point) 'email))
(contacts result))
(when email-at-point
(while contacts
(if (not (string= (cadr (car contacts)) email-at-point))
(setq contacts (cdr contacts))
(setq result (delete (car contacts) result))
(push (car contacts) result)
(setq contacts nil)))))
result))
(defun ambrevar/org-contacts-template-name (&optional return-value)
"Like `org-contacts-template-name' for mu4e."
(or (car (car (ambrevar/mu4e-contact-dwim)))
return-value
"%^{Name}"))
(defun ambrevar/org-contacts-template-email (&optional return-value)
"Like `org-contacts-template-name' for mu4e."
(or (cadr (car (ambrevar/mu4e-contact-dwim)))
return-value
(concat "%^{" org-contacts-email-property "}p")))
(add-to-list 'org-capture-templates
`("c" "Add e-mail address to contacts" entry (file+headline ,(car org-contacts-files) "Contacts")
"* %(ambrevar/org-contacts-template-name)
:PROPERTIES:
:EMAIL: %(ambrevar/org-contacts-template-email)
:END:")))
"* %?\nSCHEDULED: %(org-insert-time-stamp (org-read-date nil t \"++7d\" nil (ambrevar/org-mail-date)))\n%a\n")))
(defun ambrevar/mu4e-kill-ring-save-message-id (&optional msg)
"Save MSG's \"message-id\" field to the kill-ring.

View File

@ -1,5 +1,11 @@
(require 'notmuch-message)
(defun ambrevar/org-notmuch-get (field &optional name)
"Return list of emails from FIELD ready for Org capture.
With NAME, return name instead."
(when field
(mapconcat (if name #'car #'cadr) (mail-extract-address-components field 'all) "|")))
;; TODO: Report org-notmuch-store-link upstream.
(defun org-notmuch-store-link ()
"Store a link to a notmuch search or message."
@ -8,11 +14,16 @@
(let* ((message-id (notmuch-show-get-message-id t))
(subject (notmuch-show-get-subject))
(to (notmuch-show-get-to))
(cc (notmuch-show-get-cc))
(from (notmuch-show-get-from))
(date (org-trim (notmuch-show-get-date)))
desc link)
(org-store-link-props :type "notmuch" :from from :to to :date date
:subject subject :message-id message-id)
:subject subject :message-id message-id
:to-names (ambrevar/org-notmuch-get to 'name)
:to-addresses (ambrevar/org-notmuch-get to)
:cc-names (ambrevar/org-notmuch-get cc 'name)
:cc-addresses (ambrevar/org-notmuch-get cc))
(setq desc (org-email-link-description))
(setq link (concat "notmuch:id:" message-id))
(org-add-link-props :link link :description desc)