diff --git a/.emacs.d/lisp/init-message.el b/.emacs.d/lisp/init-message.el index ad2c3c49..b6fe12fd 100644 --- a/.emacs.d/lisp/init-message.el +++ b/.emacs.d/lisp/init-message.el @@ -1,20 +1,26 @@ ;; Message mode ;; This is common to Gnus, mu4e, notmuch, etc. +(require 'init-smtpmail) -(setq mm-default-directory "~/temp" ; Where to save attachments. +(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 - ;; Sending mail: + 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 - message-send-mail-function 'smtpmail-send-it) - -(load "~/personal/mail/smtpmail.el" 'noerror) + 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. +;; 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. @@ -27,25 +33,85 @@ Each recipient is in the format of `mail-extract-address-components'." (mail-extract-address-components header-value t)))) '("To" "Cc" "Bcc"))) -(defun message-all-epg-keys-available-p () - "Return non-nil if the pgp keyring has a public key for each recipient." - (require 'epa) - (let ((context (epg-make-context epa-protocol))) - (catch 'break - (dolist (recipient (message-recipients)) - (let ((recipient-email (cadr recipient))) - (when (and recipient-email (not (epg-list-keys context recipient-email))) - (throw 'break nil)))) - t))) +(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-available () +(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." - (when (message-all-epg-keys-available-p) - (mml-secure-message-sign-encrypt))) + (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 (ambrevar/message-fetch-addresses))) + 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) -;; (add-hook 'message-send-hook #'message-sign-encrypt-if-all-keys-available) (provide 'init-message) diff --git a/.emacs.d/lisp/init-mu4e.el b/.emacs.d/lisp/init-mu4e.el index 2fbb3800..c1b2aad8 100644 --- a/.emacs.d/lisp/init-mu4e.el +++ b/.emacs.d/lisp/init-mu4e.el @@ -7,6 +7,7 @@ ;; We need 'main' to setup pinentry-emacs for GPG. (require 'main) +(require 'init-message) (when (require 'mu4e-maildirs-extension nil t) (mu4e-maildirs-extension)) @@ -32,15 +33,9 @@ Default to unread messages if the header buffer does not already exist." mu4e-headers-auto-update nil ; Don't refresh so that we don't lose the current filter upon, e.g. reading e-mails. mu4e-change-filenames-when-moving t ; Preferred for mbsync according to the man page. - ;; SMTP - message-send-mail-function 'smtpmail-send-it - ;; Don't bother me with context on startup. mu4e-context-policy nil - ;; Don't keep sent e-mail buffer. (See mu4e-conversation-kill-buffer-on-exit.) - message-kill-buffer-on-exit t - ;; For reporting bugs, "C-x m", etc. mail-user-agent 'mu4e-user-agent mu4e-compose-dont-reply-to-self t @@ -69,9 +64,6 @@ Default to unread messages if the header buffer does not already exist." ;; Gmail likes format=flowed(?) ;; mu4e-compose-format-flowed - ;; Also crypt to self so that we can read sent e-mails. - mml-secure-openpgp-encrypt-to-self t - ;; 'sent is good for most providers. Gmail requires 'delete. mu4e-sent-messages-behavior 'sent @@ -97,46 +89,6 @@ Default to unread messages if the header buffer does not already exist." ;;; Since we sort in ascending direction, we default to the end of buffer. ;; (add-hook 'mu4e-headers-found-hook 'end-of-buffer) -(defvar ambrevar/mu4e-compose-fortune-p nil - "Whether or not to include a fortune in the signature.") -(defun ambrevar/mu4e-add-fortune-signature () - (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 'mu4e-compose-pre-hook 'ambrevar/mu4e-add-fortune-signature) - -(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 (ambrevar/message-fetch-addresses))) - 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 'mu4e-compose-pre-hook 'ambrevar/mu4e-select-dictionary) (add-hook 'mu4e-conversation-hook 'ambrevar/mu4e-select-dictionary) ;;; Make some e-mails stand out a bit. @@ -153,28 +105,6 @@ 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))) -(defvar ambrevar/mu4e-compose-signed-p t) -(defvar ambrevar/mu4e-compose-signed-and-crypted-p nil) -(defun ambrevar/mu4e-compose-maybe-signed-and-crypted () - "Maybe sign or encrypt+sign message. -Message is signed or encrypted+signed when replying to a signed or encrypted -message, respectively. - -Alternatively, message is signed or encrypted+signed if -`ambrevar/mu4e-compose-signed-p' or `ambrevar/mu4e-compose-signed-and-crypted-p' is -non-nil, respectively. - -This function is suitable for `mu4e-compose-mode-hook'." - (let ((msg mu4e-compose-parent-message)) - (cond - ((or ambrevar/mu4e-compose-signed-and-crypted-p - (and msg (member 'encrypted (mu4e-message-field msg :flags)))) - (mml-secure-message-sign-encrypt)) - ((or ambrevar/mu4e-compose-signed-p - (and msg (member 'signed (mu4e-message-field msg :flags)))) - (mml-secure-message-sign-pgpmime))))) -(add-hook 'mu4e-compose-mode-hook 'ambrevar/mu4e-compose-maybe-signed-and-crypted) - (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. @@ -210,35 +140,6 @@ Duplicates are removed." (mu4e-message-field msg field))) '(:from :to :cc :bcc))))))))))) -(defun ambrevar/message-send-maybe-crypted () - "Crypt message if all recipients have a trusted key. -This will prompt the user if only some recipients have a suitable public key. -Suitable for `message-send-hook'." - (let ((recipients (mapcar 'cadr (ambrevar/message-fetch-addresses))) - valid-addresses untrusted-recipients) - (dolist (key (epg-list-keys (epg-make-context epa-protocol))) - (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)))) - (setq untrusted-recipients - (seq-difference recipients valid-addresses)) - (when (/= (length untrusted-recipients) - (length recipients)) - ;; Some recipients have valid keys. - (mml-secure-message-sign-encrypt) - (when (and untrusted-recipients - (yes-or-no-p - (format "Some recipients don't have a trusted key %S. -Sending unencrypted? " - untrusted-recipients))) - (mml-secure-message-sign) - (mu4e-message "Sending unencrypted")))) - t) -(add-hook 'message-send-hook 'ambrevar/message-send-maybe-crypted) - -;; Because it's to tempting to send an e-mail riddled with typos... -(add-hook 'mu4e-compose-mode-hook 'flyspell-mode) - ;;; Org capture (when (require 'org-mu4e nil t) (dolist (map (list mu4e-view-mode-map mu4e-headers-mode-map)) @@ -246,58 +147,6 @@ Sending unencrypted? " (define-key map (kbd "C-c C-t") 'org-mu4e-store-and-capture)) (setq org-mu4e-link-query-in-headers-mode nil)) -;; Fix replying to GitHub. -(defun ambrevar/message-github () - "When replying to a github message, clean up all bogus recipients. -This function could be useful in `mu4e-compose-mode-hook'." - (interactive) - (let ((to (message-fetch-field "To"))) - (when (and to - (string-match (rx "@reply.github.com" string-end) (cadr (mail-extract-address-components to)))) - (dolist (hdr '("To" "Cc" "Bcc")) - (let ((addr (message-fetch-field hdr)) - recipients - bogus-recipients - clean-recipients) - (when (stringp addr) - (setq recipients (mail-extract-address-components addr t) - bogus-recipients (message-bogus-recipient-p addr)) - (when bogus-recipients - (setq clean-recipients (seq-difference recipients bogus-recipients - (lambda (addrcomp addr) - (string= (cadr addrcomp) addr)))) - ;; See `message-simplify-recipients'. - (message-replace-header - hdr - (mapconcat - (lambda (addrcomp) - (if (and message-recipients-without-full-name - (string-match - (regexp-opt message-recipients-without-full-name) - (cadr addrcomp))) - (cadr addrcomp) - (if (car addrcomp) - (message-make-from (car addrcomp) (cadr addrcomp)) - (cadr addrcomp)))) - clean-recipients - ", ")))))) - (message-sort-headers) - ;; Delete signature if any. - (delete-region (save-excursion - (message-goto-signature) - (unless (eobp) - (forward-line -1)) - (point)) - (point-max)) - ;; Deleting trailing blank lines. - (save-excursion - (goto-char (point-max)) - (delete-blank-lines) - (delete-blank-lines))))) -(add-hook 'mu4e-compose-mode-hook 'ambrevar/message-github) - - - ;;; Org captures (when (require 'org-mu4e nil t) (require 'init-org) ; For org-agenda-files