#+property: header-args:emacs-lisp :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t; -*-" #+title: email handling (message mode, bbdb, notmuch) #+auto_tangle: t * message mode *** Customization #+begin_src emacs-lisp (defvar jao-mails "") (defvar jao-mails-regexp) (setq jao-mails-regexp (regexp-opt jao-mails)) (require 'message) (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 jao-mails-regexp) (setq message-dont-reply-to-names (format "%s\\|%s" jao-mails-regexp (regexp-opt '("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 *** Encryption #+BEGIN_SRC emacs-lisp (require 'gnutls) ;; 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"/home/jao/.emacs.d/gnus/Mail/certs/") ;; Tells Gnus to inline the part (eval-after-load "mm-decode" '(add-to-list 'mm-inlined-types "application/pgp$")) ;; Tells Gnus how to display the part when it is requested (eval-after-load "mm-decode" '(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. (eval-after-load "mm-decode" '(add-to-list 'mm-automatic-display "application/pgp$")) ;; But don't display the signatures, please. (eval-after-load "mm-decode" (quote (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))) ;; (define-key message-mode-map [f7] 'mml-secure-message-sign-pgp) (define-key message-mode-map [f8] 'mml-secure-message-encrypt-pgp) #+END_SRC *** Attach image to message Use ~C-c C-p~ in message-mode. *** 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 "Gcc") (message-remove-header "Fcc"))))) #+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 (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-attachment jao-message-check-recipient jao-message-maybe-sign)) (add-hook 'message-send-hook h)) #+end_src * sendmail/smtp #+begin_src emacs-lisp (require 'smtpmail) (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 smtpmail-auth-supported nil) ;; (cram-md5 plain login) (setq smtpmail-smtp-server "127.0.0.1") (setq smtpmail-smtp-service 25)) (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")) (icalendar-import-buffer diary-file)) (kill-buffer)) :custom ((mailcap-user-mime-data '((doc-view-mode "application/pdf" jao-browse-doc-use-emacs-p) (jao-icalendar-import-buffer "application/ics") ("zathura %s" "application/pdf"))))) #+end_src * bbdb #+begin_src emacs-lisp (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)) (require 'bbdb) (setq bbdb-file (expand-file-name "~/.emacs.d/bbdb")) (bbdb-initialize 'message 'pgp 'mail) #+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)))) (defun jao-mailbox-folders (&rest excl) (seq-mapcat (lambda (base) (mapcar `(lambda (d) (format "%s/%s" ,base d)) (apply #'jao-list-mailboxes base excl))) '("jao" "bigml" "feeds" "trove"))) (defvar jao-mailbox-folders (jao-mailbox-folders "trash" "spam")) (defvar jao-mailbox-folders-rx (regexp-opt jao-mailbox-folders)) #+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 * gnus *** Directories #+begin_src emacs-lisp (setq gnus-init-file "~/.emacs.d/gnus.el" gnus-home-directory "~/.emacs.d/gnus" gnus-directory gnus-home-directory) #+end_src *** Notifications #+begin_src emacs-lisp (defun jao-gnus-notify () (interactive) (when (fboundp 'jao-gnus--notify) (unless (derived-mode-p 'gnus-summary-mode 'gnus-article-mode 'gnus-group-mode) (let ((inhibit-message t)) (gnus-demon-scan-news))))) #+end_src * notmuch *** minibuffer notifications #+begin_src emacs-lisp (defvar jao-notmuch-minibuffer-string "") (defvar jao-notmuch-minibuffer-queries '((:name "" :query "tag:new" :face jao-themes-f00) (:name "B" :query "tag:new and tag:bigml and tag:inbox") (:name "b" :query "tag:new and tag:bigml and tag:bugs" :face jao-themes-error) (:name "S" :query "tag:new and tag:bigml and tag:support") (:name "W" :query "tag:new and tag:bigml" :face jao-themes-dimm) (:name "I" :query "tag:new and tag:jao and tag:inbox") (:name "J" :query "tag:new and tag:jao" :face jao-themes-dimm) (:name "E" :query "tag:new and tag:emacs" :face jao-themes-dimm) (:name "N" :query "tag:new and tag:gmane and not tag:emacs" :face jao-themes-dimm) (:name "F" :query "tag:new and tag:feeds and not tag:emacs" :face jao-themes-dimm))) (defun jao-notmuch-notify () (let ((cnts (notmuch-hello-query-counts jao-notmuch-minibuffer-queries))) (setq jao-notmuch-minibuffer-string (mapconcat (lambda (c) (propertize (format "%s%s" (plist-get c :name) (plist-get c :count)) 'face (plist-get c :face))) cnts " ")) (jao-minibuffer-refresh))) (when (eq jao-afio-mail-function 'notmuch) (jao-minibuffer-add-variable 'jao-notmuch-minibuffer-string -20)) #+end_src *** searches #+begin_src emacs-lisp (setq notmuch-tree-result-format '(("date" . "%12s ") ("authors" . "%-35s") ((("tree" . "%s ")("subject" . "%s")) . " %-100s") ("tags" . " (%s)")) notmuch-search-result-format '(("date" . "%12s ") ("count" . "%-7s ") ("authors" . "%-35s") ("subject" . "%-100s") ("tags" . "(%s)")) notmuch-unthreaded-result-format notmuch-tree-result-format) (defun jao-notmuch--q (d0 d1 &optional k qs st) (let ((q (or (when qs (mapconcat #'identity qs " AND ")) (concat "tag:\"/^(unread|new)$/\" AND " (mapconcat (lambda (d) (when d (concat "tag:" d))) (list d0 d1) " AND "))))) (list :name (concat d0 (when d1 "/") d1) :key k :query q :search-type (or st 'tree) :sort-order 'oldest-first))) (defun jao-notmuch--mboxes-search (box &rest excluded) (let ((ms (seq-difference (jao-list-mailboxes box) excluded)) (bp (substring box 0 1))) (mapcar (lambda (m) (jao-notmuch--q box (car m) (concat bp (cdr m)))) (shorten-strings (sort ms #'string<))))) (setq notmuch-saved-searches `(,(jao-notmuch--q "bigml" "inbox" "bi") ,(jao-notmuch--q "bigml" "support" "bs") ,(jao-notmuch--q "bigml" "bug" "bb") ,@(jao-notmuch--mboxes-search "bigml" "inbox" "support") ,@(jao-notmuch--mboxes-search "jao") ,@(jao-notmuch--mboxes-search "feeds") ,(jao-notmuch--q "gmane" "emacs" "e") ,(jao-notmuch--q "gmane" nil "g" '("tag:gmane" "tag:new" "not tag:emacs")) ,(jao-notmuch--q "bml/today" nil "tb" '("tag:bigml" "date:1d..") t) ,(jao-notmuch--q "jao/today" nil "tj" '("tag:jao" "date:1d..") t) ,(jao-notmuch--q "flagged" nil "r" '("tag:flagged") t) ,(jao-notmuch--q "new" nil "n" '("tag:new")) ,(jao-notmuch--q "draft" nil "d" '("tag:draft")))) #+end_src *** package #+begin_src emacs-lisp (if (< emacs-major-version 28) (jao-load-path "notmuch") (add-to-list 'load-path "/usr/local/share/emacs/site-lisp/")) (use-package notmuch ;; :ensure t :init (setq notmuch-draft-folder "trove/drafts" notmuch-draft-quoted-tags '("part") notmuch-hello-sections '(notmuch-hello-insert-saved-searches notmuch-hello-insert-alltags notmuch-hello-insert-header) notmuch-hello-thousands-separator "," notmuch-hello-auto-refresh t notmuch-show-all-tags-list t notmuch-show-logo nil notmuch-show-empty-saved-searches nil notmuch-show-part-button-default-action 'notmuch-show-view-part notmuch-show-mark-read-tags '("-new" "-unread") notmuch-archive-tags '("+trove" "-new") notmuch-fcc-dirs '((".*@bigml.com" . "bigml/sent +bigml +sent -new") (".*" . "jao/sent +jao +sent -new")) notmuch-maildir-use-notmuch-insert t notmuch-message-headers '("Subject" "To" "Cc" "Date" "List-Id") notmuch-wash-signature-lines-max 0 notmuch-wash-wrap-lines-length 80 notmuch-wash-citation-lines-prefix 10 notmuch-wash-citation-lines-suffix 20) :config (when (eq 'notmuch jao-afio-mail-function) (setq mm-text-html-renderer 'shr message-directory "~/var/mail/" message-auto-save-directory "/tmp") (with-eval-after-load "notmuch-message" (define-key message-mode-map (kbd "C-c C-d") #'notmuch-draft-postpone))) (defun jao-mail-clean-address (fun address) (let ((address (if (string-match ".+ updates on arXiv.org: \\(.+\\)" address) (with-temp-buffer (insert (match-string 1 address)) (let ((shr-width 1000)) (shr-render-region (point-min) (point-max))) (buffer-string)) (string-replace "ElDiario.es - ElDiario.es" "D.es" address)))) (funcall fun address))) (advice-add 'notmuch-clean-address :around #'jao-mail-clean-address) (defun jao-notmuch-refresh-agenda () (interactive) (save-window-excursion (org-agenda-list))) (defun jao-notmuch-hello-first () (interactive) (let ((inhibit-message t)) (beginning-of-buffer) (widget-forward 2))) (defun jao-notmuch-refresh-hello () (interactive) (ignore-errors (when (and (string= "Mail" (jao-afio-current-frame)) (derived-mode-p 'notmuch-hello-mode)) (when (not (string-blank-p jao-notmuch-minibuffer-string)) (let ((notmuch-hello-auto-refresh nil)) (notmuch-hello))) (jao-notmuch-hello-first)))) (defun jao-notmuch-open-enclosure (add) (interactive "P") (with-current-notmuch-show-message (goto-char (point-min)) (if (not (search-forward "Enclosure:" nil t)) (user-error "No enclosure in message body") (re-search-forward "https?://" nil t) (if-let (url (thing-at-point-url-at-point)) (progn (message "%s %s ..." (if add "Adding" "Playing") url) (unless add (jao-mpc-clear)) (jao-mpc-add-url url) (unless add (jao-mpc-play))) (error "Found an enclosure, but not a link!"))))) :hook ((notmuch-hello-refresh . jao-notmuch-notify) (jao-afio-switch . jao-notmuch-refresh-hello)) :bind (:map notmuch-hello-mode-map (("a" . jao-notmuch-refresh-agenda) ("S" . consult-notmuch) ("g" . jao-notmuch-refresh-hello) ("." . jao-notmuch-hello-first) ("SPC" . widget-button-press)) :map notmuch-common-keymap (("E" . jao-notmuch-open-enclosure)))) #+end_src *** tree view #+begin_src emacs-lisp (use-package jao-notmuch :demand t :config (setq jao-notmuch-mailboxes (jao-mailbox-folders))) (use-package notmuch-tree :config (dolist (f '(notmuch-tree-match-tree-face notmuch-tree-no-match-tree-face)) (set-face-attribute f nil :family "Fira Code" :foreground "grey60")) (defun jao-notmuch--format-field (fun field &rest args) (let ((rs (apply fun field args))) (cond ((and (stringp field) (string= field "tree")) (replace-regexp-in-string "►" "→" rs)) ((not (stringp field)) (truncate-string-to-width rs 100)) (t rs)))) (advice-add 'notmuch-tree-format-field :around #'jao-notmuch--format-field) :bind (:map notmuch-tree-mode-map (("." . jao-notmuch-toggle-mime-parts) ("C" . jao-notmuch-echo-count) ("d" . jao-notmuch-tree-delete-message) ("D" . jao-notmuch-tree-delete-thread) ("h" . jao-notmuch-goto-message-buffer) ("H" . jao-notmuch-click-message-buffer) ("i" . jao-notmuch-toggle-images) ("K" . jao-notmuch-tag-jump-and-next) ("k" . jao-notmuch-tree-read-thread) ("M" . jao-notmuch-move-message) ("n" . jao-notmuch-tree-next) ("s" . jao-notmuch-tree-spam) ("RET" . jao-notmuch-tree-show-or-scroll) ("SPC" . jao-notmuch-tree-scroll-or-next)) :map notmuch-show-mode-map (("h" . jao-notmuch-goto-tree-buffer)) :map notmuch-common-keymap (("B" . jao-notmuch-browse-urls)))) #+end_src *** hydras #+begin_src emacs-lisp (major-mode-hydra-define notmuch-search-mode nil ("Tagging" (("*" notmuch-search-tag-all "tag all") ("+" notmuch-search-add-tag "add tag") ("-" notmuch-search-remove-tag "add tag") ("k" notmuch-tag-jump "jump to tag")) "Search" (("l" notmuch-search-filter "filter with additional query") ("t" notmuch-search-filter-by-tag "filter by tag") ("y" notmuch-stash-query "stash current query")) "Moving around" (("b" notmuch-search-scroll-down "scroll down") ("<" notmuch-search-first-thread "first thread") (">" notmuch-search-last-thread "last thread")))) (major-mode-hydra-define notmuch-tree-mode nil ("View" (("." jao-notmuch-toggle-mime-parts "toggle mime parts") ("i" jao-notmuch-toggle-images "toggle images") ("a" notmuch-tree-archive-thread-then-next "archive thread") ("C" jao-notmuch-echo-count "echo unread count")) "Mark" (("d" jao-notmuch-tree-delete-message "delete message") ("D" jao-notmuch-tree-delete-thread "delete thread") ("u" (jao-notmuch-tree-delete-message t) "undelete message") ("k" jao-notmuch-tree-read-thread "kill thread")) "Edit/send" (("r" notmuch-tree-reply-sender "reply sender") ("R" notmuch-tree-reply "reply all") ("f" notmuch-tree-forward-message "forward") ("e" notmuch-tree-resume-message "edit draft")))) #+end_src *** consult #+begin_src emacs-lisp (jao-load-path "consult-notmuch") (setq consult-notmuch-authors-width 30) (require 'consult-notmuch) (consult-customize consult-notmuch :preview-key 'any) (defvar jao-consult-notmuch-history nil) (defun jao-consult-notmuch-folder (&optional tree folder) (interactive "P") (let* ((root "~/var/mail/") (folder (if folder (file-name-as-directory folder) (completing-read "Folder: " jao-mailbox-folders nil nil nil jao-consult-notmuch-history "."))) (folder (replace-regexp-in-string "/\\(.\\)" ".\\1" folder)) (init (read-string "Initial query: ")) (init (format "folder:/%s/ %s" folder init))) (if tree (consult-notmuch-tree init) (consult-notmuch init)))) (with-eval-after-load "notmuch-hello" (define-key notmuch-hello-mode-map "f" #'jao-consult-notmuch-folder)) #+end_src *** org mode integration Stolen and adapted from [[https://gist.github.com/fedxa/fac592424473f1b70ea489cc64e08911][Fedor Bezrukov]]. #+begin_src emacs-lisp (with-eval-after-load "org" (with-eval-after-load "notmuch" (org-link-set-parameters "notmuch" :follow 'org-notmuch-open :store 'org-notmuch-store-link) (defun org-notmuch-open (id) "Visit the notmuch message or thread with id ID." (notmuch-show id)) (defun org-notmuch-store-link () "Store a link to a notmuch mail message." (case major-mode ((notmuch-show-mode notmuch-tree-mode) ;; Store link to the current message (let* ((id (notmuch-show-get-message-id)) (link (concat "notmuch:" id)) (description (format "Mail: %s" (notmuch-show-get-subject)))) (org-store-link-props :type "notmuch" :link link :description description))) (notmuch-search-mode ;; Store link to the thread on the current line (let* ((id (notmuch-search-find-thread-id)) (link (concat "notmuch:" id)) (description (format "Mail: %s" (notmuch-search-find-subject)))) (org-store-link-props :type "notmuch" :link link :description description))))))) #+end_src