118 lines
5.2 KiB
EmacsLisp
118 lines
5.2 KiB
EmacsLisp
;; Message mode
|
|
;; This is common to Gnus, mu4e, notmuch, etc.
|
|
(require 'init-smtpmail)
|
|
|
|
(setq user-full-name "Pierre Neidhardt"
|
|
mm-default-directory "~/temp" ; Where to save attachments.
|
|
;; Don't keep sent e-mail buffer. (Also see mu4e-conversation-kill-buffer-on-exit.)
|
|
message-kill-buffer-on-exit t
|
|
message-send-mail-function 'smtpmail-send-it
|
|
;; The following is only useful for sending mail with msmtp?
|
|
mail-specify-envelope-from t
|
|
mail-envelope-from 'header)
|
|
|
|
;; TODO: Use the following to automatically set the From: field when replying.
|
|
;; Might not be necessary.
|
|
;; message-alternative-emails
|
|
|
|
;; Sign messages by default. TODO: Which method?
|
|
(add-hook 'message-setup-hook 'mml-secure-sign-pgpmime)
|
|
;; (add-hook 'message-setup-hook 'mml-secure-message-sign-pgpmime)
|
|
|
|
;; Also crypt to self so that we can read sent e-mails.
|
|
(setq mml-secure-openpgp-encrypt-to-self t)
|
|
|
|
(defun message-recipients ()
|
|
"Return a list of all recipients in the message, looking at TO, CC and BCC.
|
|
|
|
Each recipient is in the format of `mail-extract-address-components'."
|
|
(mapcan (lambda (header)
|
|
(let ((header-value (message-fetch-field header)))
|
|
(and
|
|
header-value
|
|
(mail-extract-address-components header-value t))))
|
|
'("To" "Cc" "Bcc")))
|
|
|
|
(defvar ambrevar/trust-threshold '(marignal full ultimate))
|
|
(defun ambrevar/trusted-addresses ()
|
|
"Return the list of trusted email addresses in the PGP keyring.
|
|
Trust is defined as per `ambrevar/trust-threshold'."
|
|
(let (valid-addresses)
|
|
(dolist (key (epg-list-keys (epg-make-context epa-protocol)) valid-addresses)
|
|
(dolist (user-id (epg-key-user-id-list key))
|
|
(when (memq (epg-user-id-validity user-id) '(marginal full ultimate))
|
|
(push (cadr (mail-extract-address-components (epg-user-id-string user-id)))
|
|
valid-addresses))))))
|
|
|
|
(defun message-sign-encrypt-if-all-keys-trusted ()
|
|
"Add MML tag to encrypt message when there is a key for each recipient.
|
|
|
|
Consider adding this function to `message-send-hook' to
|
|
systematically send encrypted emails when possible."
|
|
(let* ((recipients (message-recipients))
|
|
(untrusted-recipients (seq-difference recipients (ambrevar/trusted-addresses))))
|
|
(if untrusted-recipients
|
|
(warn "Not encrypting because of untrusted %s" untrusted-recipients)
|
|
(mml-secure-message-sign-encrypt))))
|
|
|
|
;; TODO: Test and report upstream (Emacs + Notmuch).
|
|
(add-hook 'message-send-hook #'message-sign-encrypt-if-all-keys-trusted)
|
|
|
|
;; Fix replying to GitHub. TODO: Test!
|
|
(defun ambrevar/message-alter-bogus-github-recipients (addrcell)
|
|
"Discard @reply.github.com mail addresses.
|
|
ADDRCELL is a cons cell where the car is the mail address and the
|
|
cdr is the complete address (full name and mail address)."
|
|
(unless (string-match (rx "@reply.github.com" string-end)
|
|
(cdr addrcell))
|
|
addrcell))
|
|
(setq message-alter-recipients-function 'ambrevar/message-alter-bogus-github-recipients)
|
|
|
|
(defvar ambrevar/mu4e-compose-fortune-p nil
|
|
"Whether or not to include a fortune in the signature.")
|
|
(defun ambrevar/mu4e-add-signature-and-maybe-fortune ()
|
|
"Insert signature using `user-full-name'.
|
|
A fortune is appended if `ambrevar/mu4e-compose-fortune-p' is non-nil."
|
|
(require 'functions) ; For `call-process-to-string'.
|
|
(setq mu4e-compose-signature
|
|
(concat
|
|
user-full-name "\n"
|
|
"https://ambrevar.xyz/"
|
|
(when (and ambrevar/mu4e-compose-fortune-p
|
|
(executable-find "fortune"))
|
|
(concat "\n\n"
|
|
(ambrevar/call-process-to-string "fortune" "-s"))))))
|
|
(add-hook 'message-setup-hook 'ambrevar/mu4e-add-signature-and-maybe-fortune)
|
|
|
|
(defun ambrevar/mu4e-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)
|
|
|
|
;; Because it's to tempting to send an e-mail riddled with typos...
|
|
(add-hook 'message-setup-hook 'flyspell-mode)
|
|
|
|
|
|
(provide 'init-message)
|