187 lines
6.5 KiB
EmacsLisp
187 lines
6.5 KiB
EmacsLisp
;;; gnus --- Daniel's Gnus Configuration -*- lexical-binding: t -*-
|
||
|
||
;;; Commentary:
|
||
|
||
;; Sources:
|
||
;; - http://page.math.tu-berlin.de/~freundt/.gnus
|
||
;; - Formatting from http://www.emacswiki.org/emacs/GnusFormatting, Version 3
|
||
;; - http://www.emacswiki.org/emacs/GnusDemon
|
||
;; - http://people.irisa.fr/Nicolas.Berthier/file:.gnus.el
|
||
|
||
;;; Code:
|
||
|
||
|
||
;;; General
|
||
|
||
;; Requires
|
||
|
||
(require 'dash)
|
||
(require 'gnus)
|
||
(require 'message)
|
||
(require 'gnus-util)
|
||
(require 'gnus-start)
|
||
(require 'gnus-group)
|
||
(require 'gnus-sum)
|
||
(require 'gnus-art)
|
||
(require 'gnus-score)
|
||
(require 'nntp)
|
||
(require 'gnus-agent)
|
||
(require 'nnml)
|
||
(require 'gnus-async)
|
||
|
||
;; Accounts
|
||
|
||
(setq gnus-select-method '(nnnil "")
|
||
;; XXX: this should be set by the customize interface of
|
||
;; `db/mail-accounts’
|
||
gnus-secondary-select-methods
|
||
(append
|
||
;; immutable account definitions
|
||
`((nntp "etsep"
|
||
(nntp-open-connection-function nntp-open-tls-stream)
|
||
(nntp-port-number 563)
|
||
(nntp-address "news.eternal-september.org"))
|
||
(nntp "gmane"
|
||
(nntp-open-connection-function nntp-open-network-stream)
|
||
(nntp-address "news.gmane.org"))
|
||
(nnimap "algebra20"
|
||
(nnimap-stream shell)
|
||
(nnimap-shell-program "/usr/lib/dovecot/imap -o mail_location=maildir:$HOME/Mail/algebra20")
|
||
(nnimap-split-methods nnimap-split-fancy)
|
||
(nnimap-inbox "INBOX")
|
||
(nnimap-split-fancy ,db/personal-gnus-filter-rules))
|
||
(nnml "local"
|
||
(nnmail-split-methods nnmail-split-fancy)
|
||
(nnmail-split-fancy
|
||
(| ("subject" ".*Tiger Auditing Report for.*" "mail.tiger")
|
||
"mail.misc")))
|
||
(nnmaildir "archive"
|
||
(directory "~/Mail/archive/")
|
||
(directory-files nnheader-directory-files-safe)
|
||
(nnir-search-engine notmuch)
|
||
(nnir-notmuch-remove-prefix ,(expand-file-name "~/Mail/archive/"))))
|
||
|
||
;; automatically add accounts when address is not nil and not the empty string
|
||
;; XXX: this should be abstracted away in some kind of function
|
||
(remove-if #'null
|
||
(mapcar (lambda (account)
|
||
(let ((account-name (nth 1 account))
|
||
(account-address (nth 2 account)))
|
||
(when (and account-address
|
||
(stringp account-address)
|
||
(< 0 (length account-address)))
|
||
`(nnimap ,account-name
|
||
(nnimap-address ,account-address)
|
||
(nnimap-inbox "INBOX")))))
|
||
db/mail-accounts))))
|
||
|
||
|
||
;;; Daemons
|
||
|
||
(defun db/gnus-demon-scan-news-on-level-2 ()
|
||
"Scan for news in Gnus on level 2."
|
||
;; from https://www.emacswiki.org/emacs/GnusDemon
|
||
(let ((win (current-window-configuration))
|
||
(gnus-read-active-file 'some)
|
||
(gnus-check-new-newsgroups nil)
|
||
(level 2))
|
||
(while-no-input
|
||
(unwind-protect
|
||
(save-window-excursion
|
||
(when (gnus-alive-p)
|
||
(with-current-buffer gnus-group-buffer
|
||
(gnus-group-get-new-news level))))
|
||
(set-window-configuration win)))))
|
||
|
||
(gnus-demon-add-handler 'db/gnus-demon-scan-news-on-level-2 5 5)
|
||
|
||
|
||
;;; Mail Formatting
|
||
|
||
;; XXX: This should actually be set by the customize setter of
|
||
;; `db/mail-accounts’
|
||
(setq gnus-posting-styles
|
||
(append
|
||
`((".*"
|
||
(name ,user-full-name)
|
||
(address ,user-mail-address)
|
||
(signature-file "~/.signature")
|
||
("X-Jabber-ID" ,db/jabber-id)))
|
||
;; XXX: this should be abstracted away in some kind of function
|
||
(mapcar (lambda (account)
|
||
(let ((account-name (nth 1 account))
|
||
(account-address (nth 0 account)))
|
||
`(,(concat account-name ":")
|
||
(name ,user-full-name)
|
||
(address ,account-address)
|
||
(signature-file "~/.signature")
|
||
("X-Jabber-ID" ,db/jabber-id))))
|
||
db/mail-accounts)))
|
||
|
||
;; http://mbork.pl/2015-11-28_Fixing_mml-attach-file_using_advice
|
||
(defun db/mml-attach-file--go-to-eob (orig-fun &rest args)
|
||
"Go to the end of buffer before attaching files."
|
||
(save-excursion
|
||
(save-restriction
|
||
(widen)
|
||
(goto-char (point-max))
|
||
(apply orig-fun args))))
|
||
|
||
(advice-add 'mml-attach-file :around #'db/mml-attach-file--go-to-eob)
|
||
|
||
|
||
;;; SMTP configuration
|
||
|
||
(require 'smtpmail)
|
||
(require 'starttls)
|
||
|
||
(defadvice smtpmail-send-it (around display-trace-buffer disable)
|
||
"If an error is signalled, display the process buffer."
|
||
(condition-case signals-data
|
||
ad-do-it
|
||
(error (shrink-window-if-larger-than-buffer
|
||
(display-buffer (get-buffer (format "*trace of SMTP session to %s*"
|
||
smtpmail-smtp-server))))
|
||
(signal (car signals-data) (cdr signals-data)))))
|
||
|
||
(setq send-mail-function 'smtpmail-send-it
|
||
smtpmail-stream-type 'starttls
|
||
smtpmail-smtp-service 587
|
||
starttls-use-gnutls t
|
||
starttls-extra-arguments '("--strict-tofu")
|
||
smtpmail-smtp-server (nth 3 (car db/mail-accounts))
|
||
smtpmail-smtp-user (nth 6 (car db/mail-accounts)))
|
||
|
||
(defun db/set-smtp-server-from-header (orig-fun &rest args)
|
||
"Choose smtp-settings dynamically, based on the From: header
|
||
entry of the current mail."
|
||
(require 'mail-extr)
|
||
(let* ((from (or (save-restriction
|
||
(message-narrow-to-headers)
|
||
(mail-fetch-field "From"))
|
||
user-mail-address))
|
||
(address (cadr (mail-extract-address-components from)))
|
||
(account (assoc address db/mail-accounts)))
|
||
(message "Using address: %s" address)
|
||
(if account
|
||
(progn
|
||
(message "Sending with account for %s" address)
|
||
;; XXX: these calls to `nth’ should be abstracted away
|
||
(let ((smtpmail-smtp-server (nth 3 account))
|
||
(smtpmail-stream-type (nth 4 account))
|
||
(smtpmail-smtp-service (nth 5 account))
|
||
(smtpmail-smtp-user (nth 6 account)))
|
||
(apply orig-fun args)))
|
||
(progn
|
||
(message "Sending with default account settings")
|
||
(apply orig-fun args)))))
|
||
|
||
(advice-add 'smtpmail-via-smtp
|
||
:around #'db/set-smtp-server-from-header)
|
||
|
||
(setq smtpmail-debug-info t)
|
||
|
||
;;;
|
||
|
||
t
|