;;; 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