#+property: header-args:emacs-lisp :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t; -*-" :tangle-mode (identity #o644) #+title: email handling (message mode, bbdb, gnus, notmuch) * personal emails and others #+begin_src emacs-lisp (defvar jao-mails) (defvar jao-extra-mails) (defvar jao-mails-regexp (regexp-opt jao-mails)) (defvar jao-notmuch-enabled (eq jao-afio-mail-function 'notmuch)) #+end_src * gnus #+begin_src emacs-lisp (setq gnus-init-file "~/.emacs.d/gnus.el" gnus-home-directory "~/.emacs.d/gnus" gnus-directory gnus-home-directory gnus-cache-directory (expand-file-name "cache" gnus-home-directory) gnus-kill-files-directory (expand-file-name "News" gnus-home-directory) message-directory (expand-file-name "Mail" gnus-home-directory) mail-source-directory (expand-file-name "Mail" gnus-home-directory)) (let ((org-file (expand-file-name "gnus.org" jao-emacs-dir))) (when (file-newer-than-file-p org-file gnus-init-file) (org-babel-tangle-file org-file))) #+end_src * message mode *** Customization #+begin_src emacs-lisp (setq message-send-mail-function 'message-send-mail-with-sendmail message-sendmail-envelope-from 'header message-sendmail-f-is-evil nil) (setq imap-store-password t) (setq password-cache-expiry nil) (setq message-generate-headers-first t) (setq message-forward-before-signature nil) (setq message-alternative-emails (regexp-opt (append jao-mails jao-extra-mails))) (setq message-dont-reply-to-names (regexp-opt (append jao-mails '("noreply@" "@noreply" "no-reply@" "@no-reply" "notifications@github")))) (setq message-citation-line-format "On %a, %b %d %Y, %N wrote:\n") (setq message-citation-line-function 'message-insert-formatted-citation-line) (setq message-user-fqdn "gnus.jao.io") ;; writing messages (setq message-kill-buffer-on-exit t) (setq message-max-buffers 5) (setq message-insert-signature t) (setq message-from-style 'angles user-mail-address (car jao-mails) mail-host-address system-name message-syntax-checks '((sender . disabled)) message-default-headers (concat "X-Attribution: jao\n" "X-Clacks-Overhead: GNU Terry Pratchett\n" "X-URL: \n") message-hidden-headers '("^References:" "^Face:" "^X-Face:" "^X-Draft-From:") message-make-forward-subject-function 'message-forward-subject-fwd) (setq message-expand-name-standard-ui t) #+end_src *** Adjust Bcc #+begin_src emacs-lisp (defvar jao-message--bcc-rx (regexp-opt '("mail.io" "gnu.org"))) (defun jao-message-insert-bcc () (let ((f (or (message-fetch-field "From") ""))) (when (or (string-blank-p f) (string-match-p jao-message--bcc-rx f)) (insert "Bcc: proton@jao.io\n")))) (add-hook 'message-header-setup-hook #'jao-message-insert-bcc) #+end_src *** To->From and Bcc #+begin_src emacs-lisp (defvar jao-message-to-from nil) (defun jao-message-adjust-from () (let ((to (concat (message-fetch-field "To") (message-fetch-field "Cc")))) (when-let* ((tf (seq-find (lambda (tf) (string-match-p (car tf) to)) jao-message-to-from)) (from (message-make-from "Jose A Ortega Ruiz" (cdr tf)))) (save-restriction (widen) (message-replace-header "From" from))))) (when jao-notmuch-enabled (add-hook 'message-header-setup-hook #'jao-message-adjust-from)) #+end_src *** Clean up reply addresses #+begin_src emacs-lisp :tangle no (defun jao-message--dont-reply () (let ((x (message-dont-reply-to-names))) (if (functionp x) x (lambda (mail) (unless (string-match-p x mail) mail))))) (defun jao-message-strip-replies () (dolist (header '("To" "Cc")) (when-let ((v (message-fetch-field header))) (let* ((v (message-tokenize-header v)) (vs (delq nil (mapcar (jao-message--dont-reply) v))) (v (when vs (mapconcat #'string-trim vs ", ")))) (message-replace-header header v))))) (when jao-notmuch-enabled (add-hook 'message-setup-hook #'jao-message-strip-replies)) #+end_src *** Encryption #+begin_src emacs-lisp ;; avoiding bogus warning (setq gnutls-min-prime-bits nil) (setq gnus-buttonized-mime-types '("multipart/encrypted" "multipart/signed" "multipart/alternative")) (setq mm-verify-option 'always) (setq mm-decrypt-option 'always) (setq mm-sign-option 'guided) (setq mm-encrypt-option 'guided) (setq mml-secure-passphrase-cache-expiry (* 3600 24) password-cache-expiry (* 3600 24)) (setq smime-CA-directory "/etc/ssl/certs/" smime-certificate-directory (expand-file-name "certs/" gnus-directory)) (with-eval-after-load "mm-decode" ;; Tells Gnus to inline the part (add-to-list 'mm-inlined-types "application/pgp$") ;; Tells Gnus how to display the part when it is requested (add-to-list 'mm-inline-media-tests '("application/pgp$" mm-inline-text identity)) ;; Tell Gnus not to wait for a request, just display the thing ;; straight away. (add-to-list 'mm-automatic-display "application/pgp$") ;; But don't display the signatures, please. (setq mm-automatic-display (remove "application/pgp-signature" mm-automatic-display))) ;; decide whether to encrypt or just sign outgoing messages (defvar jao-message-try-sign nil) (defun jao-message-maybe-sign () (when (and jao-message-try-sign (y-or-n-p "Sign message? ")) (if (y-or-n-p "Encrypt message? ") (let ((recipient (message-fetch-field "To"))) (if (or (pgg-lookup-key recipient) (and (y-or-n-p (format "Fetch %s's key? " recipient)) (pgg-fetch-key pgg-default-keyserver-address recipient))) (mml-secure-message-encrypt-pgp) (mml-secure-message-sign-pgp))) (mml-secure-message-sign-pgp)))) ;; for ma gnus (eval-after-load "rfc2047" '(add-to-list 'rfc2047-header-encoding-alist '("User-Agent" . address-mime))) #+end_src *** Attach image to message Use ~C-c C-p~ in message-mode, and ~C-c y~. *** Check attachment #+begin_src emacs-lisp (defvar jao-message-attachment-regexp "\\([Ww]e send\\|[Ii] send\\|attach\\)") (defun jao-message-check-attachment () "Check if there is an attachment in the message if I claim it." (save-excursion (message-goto-body) (when (search-forward-regexp jao-message-attachment-regexp nil t nil) (message-goto-body) (unless (or (search-forward "<#part" nil t nil) (message-y-or-n-p "No attachment. Send the message? " nil nil)) (error "No message sent"))))) #+end_src *** Check Fcc/Gcc #+begin_src emacs-lisp (defun jao-message-check-gcc () "Ask whether to keep a copy of message." (save-excursion (save-restriction (message-narrow-to-headers) (when (and (or (message-fetch-field "Gcc") (message-fetch-field "Fcc")) (not (y-or-n-p "Archive? "))) (message-remove-header "\\(?:[BFG]cc\\)"))))) #+end_src *** Check recipient #+begin_src emacs-lisp (defun jao-message-check-recipient () (save-excursion (save-restriction (message-narrow-to-headers) (when-let ((to (message-fetch-field "To"))) (when (string-match-p jao-mails-regexp to) (unless (y-or-n-p "Message is addressed to yourself. Continue?") (error "Message not sent"))))))) #+end_src *** Randomsig #+begin_src emacs-lisp (with-eval-after-load "message" (when (require 'randomsig nil t) (define-key message-mode-map (kbd "C-c s") 'randomsig-replace-sig) (define-key message-mode-map (kbd "C-c S") 'randomsig-select-sig) (setq randomsig-dir (expand-file-name "~/etc/config/emacs")) (setq randomsig-files '("signatures.txt")) ;; or (setq randomsig-files (randomsig-search-sigfiles)) ;; or (setq randomsig-files 'randomsig-search-sigfiles) (setq message-signature 'randomsig-signature) (setq randomsig-delimiter-pattern "^%$" randomsig-delimiter "%"))) #+end_src *** Send mail hooks #+begin_src emacs-lisp (dolist (h '(jao-message-check-gcc jao-message-check-recipient jao-message-maybe-sign)) (add-hook 'message-send-hook h)) (unless jao-notmuch-enabled (add-hook 'message-send-hook #'jao-message-check-attachment)) #+end_src *** Keybindings #+begin_src emacs-lisp (with-eval-after-load "message" ;; (define-key message-mode-map [f7] 'mml-secure-message-sign-pgp) (define-key message-mode-map [f8] 'mml-secure-message-encrypt-pgp) (define-key message-mode-map (kbd "C-c y") #'yank-media)) #+end_src * sendmail/smtp #+begin_src emacs-lisp (defun jao-sendmail-gmail () (setq smtpmail-auth-supported '(login cram-md5 plain)) (setq smtpmail-smtp-server "smtp.gmail.com") (setq smtpmail-smtp-service 587)) (defun jao-sendmail-local () (setq send-mail-function 'sendmail-send-it) (setq smtpmail-auth-supported nil) ;; (cram-md5 plain login) (setq smtpmail-smtp-server "127.0.0.1") (setq smtpmail-smtp-service 25)) (defun jao-sendmail-msmtp () (setq send-mail-function 'sendmail-send-it sendmail-program "/usr/bin/msmtp" mail-specify-envelope-from t message-sendmail-envelope-from 'header mail-envelope-from 'header)) (jao-sendmail-local) #+end_src * mailcap #+begin_src emacs-lisp (use-package mailcap :config (add-to-list 'mailcap-mime-extensions '(".JPEG" . "image/jpeg")) (add-to-list 'mailcap-mime-extensions '(".JPG" . "image/jpeg")) (defun jao-icalendar-import-buffer () (let ((icalendar-import-format "%s%u%l%d")) (icalendar-import-buffer diary-file t nil)) (kill-buffer) (message "Event imported into diary")) :custom ((mailcap-user-mime-data '((jao-icalendar-import-buffer "application/ics") ("viewpdf.sh %s" "application/pdf"))))) #+end_src * multipart html renderer #+begin_src emacs-lisp (defun jao-w3m-html-renderer (handle) (let ((w3m-message-silent t) (mm-w3m-safe-url-regexp nil)) (condition-case nil (mm-inline-text-html-render-with-w3m handle) (error (delete-region (point) (point-max)) (let ((shr-use-fonts nil) (shr-use-colors nil)) (mm-shr handle)))))) (defun jao-shr-html-renderer (handle) (let (;; (shr-use-fonts t) ;; (shr-use-colors t) (shr-width 130)) (mm-shr handle))) ;; (setq mm-text-html-renderer #'jao-w3m-html-renderer) (setq mm-text-html-renderer #'jao-shr-html-renderer) #+end_src * bbdb #+begin_src emacs-lisp :tangle no (use-package bbdb :ensure t :init (setq bbdb-complete-name-allow-cycling t bbdb-completion-display-record nil bbdb-gui t bbdb-message-all-addresses t bbdb-complete-mail-allow-cycling t bbdb-north-american-phone-numbers-p nil bbdb-add-aka t bbdb-add-name 2 bbdb-message-all-addresses t bbdb-mua-pop-up t ;; 'horiz bbdb-mua-pop-up-window-size 0.3 bbdb-layout 'multi-line bbdb-mua-update-interactive-p '(query . create) bbdb-mua-auto-update-p 'bbdb-select-message bbdb-user-mail-address-re jao-mails-regexp bbdb-auto-notes-ignore-headers `(("From" . ,jao-mails-regexp) ("From" . ".*@.*github\.com.*") ("To" . ".*@.*github\.com.*") ("Reply-to" . ".*") ("References" . ".*")) bbdb-auto-notes-ignore-messages `(("To" . ".*@.*github\\.com.*") ("From" . ".*@.*github\\.com.*") ("From" . "info-list") ("From" . "no-?reply\\|deploy") ("X-Mailer" . "MailChimp")) bbdb-accept-message-alist `(("To" . ,jao-mails-regexp) ("Cc" . ,jao-mails-regexp) ("BCc" . ,jao-mails-regexp)) bbdb-ignore-message-alist bbdb-auto-notes-ignore-messages) :config (add-hook 'message-setup-hook 'bbdb-mail-aliases) ;; (add-hook 'bbdb-notice-mail-hook 'bbdb-auto-notes) (add-hook 'bbdb-after-change-hook (lambda (arg) (bbdb-save))) (require 'bbdb-anniv) ;; BBDB 3.x this gets birthdays in org agenda ;; and diary - clever stuff (add-hook 'diary-list-entries-hook 'bbdb-anniv-diary-entries) (setq bbdb-file (expand-file-name "~/.emacs.d/bbdb")) (if jao-notmuch-enabled (bbdb-initialize 'message 'pgp) (bbdb-initialize 'message 'pgp 'gnus))) #+end_src * mailboxes #+begin_src emacs-lisp (defun jao-list-mailboxes (base &rest excl) (let ((dir (expand-file-name base "~/var/mail"))) (seq-difference (directory-files dir) (append '("." "..") excl)))) #+end_src * consult narrowing #+begin_src emacs-lisp (defvar jao-mail-consult-buffer-history nil) (defun jao-mail-buffer-p (b) (or (member (buffer-name b) '("*Calendar*" "inbox.org" "*Org Agenda*" "*Fancy Diary Entries*" "diary")) (with-current-buffer b (derived-mode-p 'notmuch-show-mode 'notmuch-search-mode 'notmuch-tree-mode 'notmuch-hello-mode 'notmuch-message-mode 'gnus-group-mode 'gnus-summary-mode 'gnus-article-mode)))) (defvar jao-mail-consult-source (list :name "mail buffer" :category 'buffer :hidden t :narrow (cons ?n "mail buffer") :history 'jao-mail-consult-buffer-history :action (lambda (b) (when (not (string-blank-p (or b ""))) (jao-afio--goto-mail) (if (get-buffer-window b) (pop-to-buffer b) (pop-to-buffer-same-window b)))) :items (lambda () (mapcar #'buffer-name (seq-filter #'jao-mail-buffer-p (buffer-list)))))) (jao-consult-add-buffer-source 'jao-mail-consult-source "Mail" ?n) #+end_src * notmuch #+begin_src emacs-lisp (jao-load-org "notmuch") #+end_src