#+title: email handling (message mode, bbdb, notmuch, et al.) #+property: header-args :tangle no :comments no :results silent :shebang "#!/bin/bash" #+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 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 (message-fetch-field "Gcc") (not (y-or-n-p "Archive? "))) (message-remove-header "Gcc"))))) (defun jao-message-toggle-gcc () "Insert or remove the \"Gcc\" header." (interactive) (save-excursion (save-restriction (message-narrow-to-headers) (if (message-fetch-field "Gcc") (message-remove-header "Gcc") (gnus-inews-insert-gcc))))) ;; (define-key message-mode-map [(f6)] 'jao-message-toggle-gcc) #+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) (eval-after-load "gnus-sum" '(define-key gnus-summary-save-map "-" 'gnus/randomsig-summary-read-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-gmail) (jao-sendmail-local) #+END_SRC * notmuch *** hello page #+begin_src emacs-lisp (defun jao-notmuch--and (frags) (when frags (mapconcat #'identity frags " AND "))) (defun jao-notmuch--q (d0 d1 &optional k qs) (list :name (concat d0 (when d1 "/") d1) :search-type 'tree :key k :query (or (jao-notmuch--and qs) (format "folder:%s/%s and tag:unread" d0 d1)))) (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<))))) (defun jao--refresh-agenda () (save-window-excursion (org-agenda-list))) (with-eval-after-load "notmuch-hello" (add-hook 'notmuch-hello-refresh-hook #'jao--refresh-agenda)) (setq notmuch-saved-searches `(,(jao-notmuch--q "jao" "inbox" "ji") ,(jao-notmuch--q "bigml" "inbox" "bi") ,@(jao-notmuch--mboxes-search "bigml" "inbox" "deploys") ,@(jao-notmuch--mboxes-search "jao" "inbox") ,@(jao-notmuch--mboxes-search "feeds") ,(jao-notmuch--q "toread" nil "r" '("tag:toread")) ,(jao-notmuch--q "bml/today" nil "tb" '("tag:bigml" "date:1d..")) ,(jao-notmuch--q "jao/today" nil "tj" '("tag:jao" "date:1d.."))) notmuch-hello-sections '(notmuch-hello-insert-saved-searches notmuch-hello-insert-alltags notmuch-hello-insert-recent-searches notmuch-hello-insert-header) notmuch-hello-thousands-separator "," notmuch-hello-recent-searches-max 5 notmuch-show-all-tags-list t notmuch-show-logo nil notmuch-show-empty-saved-searches nil) #+end_src *** commands #+begin_src emacs-lisp (defvar-local jao-notmuch--tree-buffer nil) (defun jao-notmuch-goto-message-buffer () (interactive) (when (window-live-p notmuch-tree-message-window) (let ((b (current-buffer))) (select-window notmuch-tree-message-window) (setq-local jao-notmuch--tree-buffer b)))) (defun jao-notmuch-goto-index-buffer () (interactive) (if (buffer-live-p jao-notmuch--tree-buffer) (pop-to-buffer jao-notmuch--tree-buffer) (user-error "No index for this buffer"))) (defun jao-notmuch-jump () (interactive) (let ((resize-mini-windows t)) (notmuch-jump-search))) (defun jao-notmuch-tag-jump (reverse) (interactive "P") (let ((resize-mini-windows t)) (notmuch-tag-jump reverse))) (defun jao-notmuch-tree-tag (&optional new) (interactive "P") (when-let (tag (notmuch-select-tag-with-completion "Forest of tag: ")) (notmuch-tree (concat "tag:" tag) (when new "tag:/unread|new/")))) (defun jao-notmuch-browse-urls () (interactive) (when (or (derived-mode-p 'notmuch-show-mode) (jao-notmuch-goto-message-buffer)) (notmuch-show-browse-urls))) (defun jao-notmuch-follow-link (&optional external) (interactive "P") (with-current-notmuch-show-message (goto-char (point-min)) (if (not (or (search-forward-regexp "\\bVia: " nil t) (search-forward-regexp "\\bURL: " nil t) (and (search-forward-regexp "\\bLink$" nil t) (not (beginning-of-line))))) (user-error "No standard Via/URL/Link") (re-search-forward "https?://" nil t) (if external (jao-browse-with-external-browser) (browse-url (jao-url-around-point)))))) (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) (if add (emms-add-url url) (emms-play-url url) (sit-for 1) (jao-emms-echo))) (error "Found an enclosure, but not a link!"))))) #+end_src *** package #+begin_src emacs-lisp (use-package notmuch :ensure t :init (setq notmuch-fcc-dirs '(("jao@bigml.com" . "bigml/sent") (".*" . "jao/sent")) notmuch-message-headers-visible t jao-notmuch-message-headers '("Subject" "To" "Cc" "Date" "List-Id" "Reply-To" "X-Mailer" "User-Agent" "X-User-Agent") notmuch-message-headers jao-notmuch-message-headers notmuch-show-mark-read-tags '("-new" "-unread" "-toread") notmuch-archive-tags '("+trove" "-new" "-unread" "-inbox") notmuch-tagging-keys '(("a" notmuch-archive-tags "Archive") ("d" notmuch-show-mark-read-tags "Mark read") ("u" ("+new" "+unread") "Mark unred read") ("f" ("+flagged") "Flag") ("r" ("+toread") "Read later") ("x" ("+deleted" "-new" "-flagged" "-unread") "Deleted")) notmuch-show-all-multipart/alternative-parts nil notmuch-show-indent-messages-width 2 notmuch-show-imenu-indent t notmuch-show-part-button-default-action 'notmuch-show-view-part notmuch-show-only-matching-messages t notmuch-tree-result-format '(("date" . "%12s ") ("authors" . "%-35s") ((("subject" . "%.95s")) . " %-95s") ("tags" . " (%s)")) notmuch-search-result-format '(("date" . "%12s ") ("count" . "%-7s ") ("authors" . "%-35s") ("subject" . "%-95s") ("tags" . "(%s)")) notmuch-unthreaded-result-format notmuch-tree-result-format 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 ;; (setq mm-text-html-renderer 'shr) (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)) address))) (funcall fun address))) (advice-add 'notmuch-clean-address :around #'jao-mail-clean-address) :bind (:map notmuch-common-keymap (("T" . jao-notmuch-tree-tag) ("E" . jao-notmuch-open-enclosure) ("B" . jao-notmuch-browse-urls) ("M-g" . jao-notmuch-follow-link) ("k" . jao-notmuch-tag-jump) ("j" . jao-notmuch-jump)) :map notmuch-message-mode-map (("C-c C-d" . notmuch-draft-postpone)) :map notmuch-show-mode-map (("h" . jao-notmuch-goto-index-buffer) ("C-c C-c" . jao-notmuch-goto-message-in-gnus)) :map notmuch-hello-mode-map (("S" . consult-notmuch)) :map notmuch-tree-mode-map (("h" . jao-notmuch-goto-message-buffer) ("k" . jao-notmuch-tag-jump)))) #+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 *** tag shell script #+begin_src bash :tangle ./bin/notmuch-tags.sh :tangle-mode (identity #o755) notmuch new > $HOME/var/log/notmuch.log 2>&1 function tag_deleted { notmuch tag +deleted -- \ "'folder:\"$1\"'" \ AND date:..${2:-3d} AND NOT "tag:/trove|flagged|unread|new/" } function tag_folder { notmuch tag +$1 +$2 -- tag:new AND folder:$1/$2 } function tag_directory { for f in ~/var/mail/$1/*; do tag_folder $1 $(basename $f); done } tag_directory bigml tag_directory jao tag_directory feeds tag_deleted "/bigml.(drivel|lists|deploys|bugs)/" 3d tag_deleted "/bigml.reports/" 1d tag_deleted "/jao.(drivel|lists|books|think)/" 3d tag_deleted "/feeds.+/" 3d tag_deleted "/bigml.inbox$/" 1y #+end_src *** expire shell script #+begin_src bash :tangle ./bin/notmuch-expire.sh :tangle-mode (identity #o755) notmuch search --output=files --format=text0 tag:deleted | xargs -r0 rm notmuch new > $HOME/var/log/notmuch-expire.log 2>&1 notmuch compact >> $HOME/var/log/notmuch-expire.log 2>&1 #+end_src * gnus *** notmuch -> gnus #+begin_src emacs-lisp (defun jao-notmuch-goto-message-in-gnus () "Open a summary buffer containing the current notmuch article." (interactive) (let ((group (jao-maildir-file-to-group (notmuch-show-get-filename))) (message-id (replace-regexp-in-string "^id:" "" (notmuch-show-get-message-id)))) (if (and group message-id) (org-gnus-follow-link group message-id) (message "Couldn't get relevant infos for switching to Gnus.")))) #+end_src *** gnus.el tangling The core of Gnus's configuration is tangled to the usual ~gnus.el~ from [[./gnus.org][gnus.org]]. #+begin_src emacs-lisp (defalias 'jao-open-gnus-frame 'jao-afio--goto-mail) (setq gnus-init-file (jao-maybe-tangle "gnus")) #+end_src *** Directories #+begin_src emacs-lisp (setq gnus-home-directory "~/.emacs.d/gnus" gnus-directory gnus-home-directory) (defun jao-gnus-dir (dir) (expand-file-name dir gnus-home-directory)) (setq smtpmail-queue-dir (jao-gnus-dir "Mail/queued-mail/")) (setq mail-source-directory (jao-gnus-dir "Mail/") message-auto-save-directory (jao-gnus-dir "Mail/drafts/") message-directory (jao-gnus-dir "Mail/")) (setq gnus-default-directory (expand-file-name "~") gnus-startup-file (jao-gnus-dir "newsrc") gnus-agent-directory (jao-gnus-dir "News/agent") gnus-home-score-file (jao-gnus-dir "scores") gnus-article-save-directory (jao-gnus-dir "saved/") nntp-authinfo-file (jao-gnus-dir "authinfo") nnmail-message-id-cache-file (jao-gnus-dir "nnmail-cache") nndraft-directory (jao-gnus-dir "drafts") nnrss-directory (jao-gnus-dir "rss")) #+end_src * mailcap #+BEGIN_SRC emacs-lisp (require 'mailcap) (add-to-list 'mailcap-mime-extensions '(".JPEG" . "image/jpeg")) (add-to-list 'mailcap-mime-extensions '(".JPG" . "image/jpeg")) (let* ((apps (cdr (assoc "application" mailcap-mime-data))) (apps (cl-remove-if (lambda (x) (string= (car x) "pdf")) apps))) (setcdr (assoc "application" mailcap-mime-data) apps) (mailcap-parse-mailcaps nil t)) #+END_SRC * frm #+begin_src emacs-lisp (use-package jao-frm :init (setq jao-frm-mail-command 'jao-open-gnus-frame)) (defun jao-frm--formatter (mbox n) (apply #'format "%s/%s: %s" `(,@(last (split-string mbox "/") 2) ,n))) (defun jao-frm--show () (interactive) (jao-frm-show-mail-numbers #'jao-frm--formatter)) (global-set-key [(f12)] 'jao-frm--show) (global-set-key [(f8)] 'jao-frm) #+end_src * maildirs #+begin_src emacs-lisp (defun jao-list-mailboxes (base) (let ((dir (expand-file-name base "~/var/mail"))) (cl-remove-if (lambda (x) (member x '("." ".." "sent" "inbox" "trash"))) (directory-files dir)))) (defvar jao-maildir-maildirs nil) (defvar jao-maildir-tracked-maildirs nil) (use-package jao-maildir :config (defun jao-maildir--ensure-counts () (when gnus-newsgroup-name (when (string-match "^nnimap.*:\\(.+\\)" gnus-newsgroup-name) (let ((mbox (format "/home/jao/var/mail/%s" (match-string 1 gnus-newsgroup-name)))) (jao-maildir-update-info-string mbox))))) (with-eval-after-load "gnus-sum" (add-hook 'gnus-exit-group-hook #'jao-maildir--ensure-counts))) (jao-maildir-setup jao-maildir-maildirs jao-maildir-tracked-maildirs -20) #+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) (eval-after-load "gnus-sum" '(progn (define-key gnus-summary-mode-map ":" 'bbdb-mua-annotate-sender) (define-key gnus-summary-mode-map ";" 'bbdb-mua-annotate-recipients)))) (require 'bbdb) (bbdb-initialize 'gnus 'message 'pgp 'mail) (bbdb-mua-auto-update-init 'gnus) (setq bbdb-file (expand-file-name "bbdb" gnus-home-directory)) #+end_src