message: Make sure org-contacts is loaded
Pierre Neidhardt
parent
01fcdc89b2
commit
b86f8e419c
|
|
@ -92,77 +92,79 @@ A fortune is appended if `ambrevar/message-compose-fortune-p' is non-nil."
|
|||
(setq message-signature 'ambrevar/message-add-signature-and-maybe-fortune)
|
||||
|
||||
|
||||
(defun ambrevar/mu4e-select-dictionary ()
|
||||
"Set dictionary according to the LANGUAGE property of the first
|
||||
(when (when (require 'org-contacts nil t))
|
||||
(defun ambrevar/message-select-dictionary ()
|
||||
"Set dictionary according to the LANGUAGE property of the first
|
||||
\"To:\" recipient found in the Org contacts file."
|
||||
(interactive)
|
||||
(let ((addresses (mapcar 'cadr (message-recipients)))
|
||||
address-lang-map)
|
||||
(setq address-lang-map
|
||||
(cl-loop for contact in (org-contacts-filter)
|
||||
;; The contact name is always the car of the assoc-list
|
||||
;; returned by `org-contacts-filter'.
|
||||
for language = (cdr (assoc-string "LANGUAGE" (nth 2 contact)))
|
||||
;; Build the list of the user email addresses.
|
||||
for email-list = (org-contacts-split-property
|
||||
(or (cdr (assoc-string org-contacts-email-property
|
||||
(nth 2 contact))) ""))
|
||||
if (and email-list language)
|
||||
;; Build an alist of (EMAIL . LANGUAGE).
|
||||
nconc (cl-loop for email in email-list
|
||||
collect (cons (downcase email) language))))
|
||||
(while addresses
|
||||
(if (not (assoc (car addresses) address-lang-map))
|
||||
(setq addresses (cdr addresses))
|
||||
(ispell-change-dictionary (cdr (assoc (car addresses) address-lang-map)))
|
||||
(setq addresses nil)))))
|
||||
(add-hook 'message-setup-hook 'ambrevar/mu4e-select-dictionary)
|
||||
(interactive)
|
||||
(let ((addresses (mapcar 'cadr (message-recipients)))
|
||||
address-lang-map)
|
||||
(setq address-lang-map
|
||||
(cl-loop for contact in (org-contacts-filter)
|
||||
;; The contact name is always the car of the assoc-list
|
||||
;; returned by `org-contacts-filter'.
|
||||
for language = (cdr (assoc-string "LANGUAGE" (nth 2 contact)))
|
||||
;; Build the list of the user email addresses.
|
||||
for email-list = (org-contacts-split-property
|
||||
(or (cdr (assoc-string org-contacts-email-property
|
||||
(nth 2 contact))) ""))
|
||||
if (and email-list language)
|
||||
;; Build an alist of (EMAIL . LANGUAGE).
|
||||
nconc (cl-loop for email in email-list
|
||||
collect (cons (downcase email) language))))
|
||||
(while addresses
|
||||
(if (not (assoc (car addresses) address-lang-map))
|
||||
(setq addresses (cdr addresses))
|
||||
(ispell-change-dictionary (cdr (assoc (car addresses) address-lang-map)))
|
||||
(setq addresses nil)))))
|
||||
(add-hook 'message-setup-hook 'ambrevar/message-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))))))
|
||||
(when (require 'org-contacts nil 'noerror)
|
||||
;; 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
|
||||
(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))"))
|
||||
(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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue