Update 5 drones

[~bandali/configs] / lisp / bandali-gnus.el

;;; bandali-gnus.el --- bandali's Gnus setup         -*- lexical-binding: t; -*-

;; Copyright (C) 2018-2020  Amin Bandali

;; Author: Amin Bandali <bandali@gnu.org>
;; Keywords: mail, news

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; My trusty super awesome Gnus setup.

;;; Code:

(defvar b/maildir (expand-file-name "~/mail/"))
(with-eval-after-load 'recentf
  (add-to-list 'recentf-exclude b/maildir))

(defvar b/gnus-init-file (b/etc "gnus"))

(eval-when-compile
  (progn
    (defvar nndraft-directory)
    (defvar gnus-read-newsrc-file)
    (defvar gnus-save-newsrc-file)
    (defvar gnus-gcc-mark-as-read)
    (defvar nnmail-split-abbrev-alist)))

(declare-function article-make-date-line "gnus-art" (date type))

(setq
 mail-user-agent   'gnus-user-agent
 read-mail-command 'gnus)

(use-package gnus
  :bind (("s-m"     . gnus-plugged)
         ("s-M"     . gnus-unplugged)
         ("C-c a m" . gnus-plugged)
         ("C-c a M" . gnus-unplugged))
  :init
  (setq
   gnus-select-method '(nnnil "")
   gnus-secondary-select-methods
   '((nnimap "shemshak"
             (nnimap-stream plain)
             (nnimap-address "127.0.0.1")
             (nnimap-server-port 143)
             (nnimap-authenticator plain)
             (nnimap-user "bandali@shemshak.local"))
     (nnimap "gnu"
             (nnimap-stream plain)
             (nnimap-address "127.0.0.1")
             (nnimap-server-port 143)
             (nnimap-authenticator plain)
             (nnimap-user "bandali@gnu.local")
             (nnimap-inbox "INBOX")
             (nnimap-split-methods 'nnimap-split-fancy)
             (nnimap-split-fancy (|
                                  ;; (: gnus-registry-split-fancy-with-parent)
                                  ;; (: gnus-group-split-fancy "INBOX" t "INBOX")
                                  ;; keep debbugs emails in INBOX
                                  (list ".*<\\(.*\\)\\.debbugs\\.gnu\\.org>.*" "INBOX")
                                  ;; gnu
                                  (list ".*<\\(.*\\)\\.\\(non\\)?gnu\\.org>.*" "l.\\1")
                                  ;; gnus
                                  (list ".*<\\(.*\\)\\.gnus\\.org>.*" "l.\\1")
                                  ;; libreplanet
                                  (list ".*<\\(.*\\)\\.libreplanet\\.org>.*" "l.\\1")
                                  ;; iana (e.g. tz-announce)
                                  (list ".*<\\(.*\\)\\.iana\\.org>.*" "l.\\1")
                                  ;; *.lists.sr.ht, omitting one dot if present
                                  ;;    add more \\.?\\([^.]*\\) if needed
                                  (list ".*<~\\(.*\\)/\\([^.]*\\)\\.?\\([^.]*\\)\\.lists.sr.ht>.*" "l.~\\1.\\2\\3")
                                  ;; webmasters
                                  (from "webmasters\\(-comment\\)?@gnu\\.org" "webmasters")
                                  ;; other
                                  (list ".*atreus.freelists.org" "l.atreus")
                                  (list ".*deepspec.lists.cs.princeton.edu" "l.deepspec")
                                  ;; (list ".*haskell-art.we.lurk.org" "l.haskell.art") ;d
                                  (list ".*haskell-cafe.haskell.org" "l.haskell-cafe")
                                  ;; (list ".*notmuch.notmuchmail.org" "l.notmuch") ;u
                                  ;; (list ".*dev.lists.parabola.nu" "l.parabola-dev") ;u
                                  ;; ----------------------------------
                                  ;; legend: (u)nsubscribed | (d)ead
                                  ;; ----------------------------------
                                  ;; spam
                                  ("X-Spam_action" "reject" "Junk")
                                  ;; otherwise, leave mail in INBOX
                                  "INBOX")))
     (nnimap "uwaterloo"
             (nnimap-stream plain)
             (nnimap-address "127.0.0.1")
             (nnimap-server-port 143)
             (nnimap-authenticator plain)
             (nnimap-user "abandali@uwaterloo.local")
             (nnimap-inbox "INBOX")
             (nnimap-split-methods 'nnimap-split-fancy)
             (nnimap-split-fancy (|
                                  ;; (: gnus-registry-split-fancy-with-parent)
                                  ;; se212-f19
                                  ("subject" "SE\\s-?212" "course.se212-f19")
                                  (from "SE\\s-?212" "course.se212-f19")
                                  ;; catch-all
                                  "INBOX")))
     (nnimap "csc"
             (nnimap-stream plain)
             (nnimap-address "127.0.0.1")
             (nnimap-server-port 143)
             (nnimap-authenticator plain)
             (nnimap-user "abandali@csclub.uwaterloo.local")
             (nnimap-inbox "INBOX")
             (nnimap-split-methods 'nnimap-split-fancy)
             (nnimap-split-fancy (|
                                  ;; cron reports and other messages from root
                                  (from "root@\\(.*\\.\\)?csclub\\.uwaterloo\\.ca" "INBOX")
                                  ;; spam
                                  ("X-Spam-Flag" "YES" "Junk")
                                  ;; catch-all
                                  "INBOX"))))
   gnus-message-archive-group "nnimap+gnu:INBOX"
   gnus-parameters
   '(("l\\.atreus"
      (to-address . "atreus@freelists.org")
      (to-list    . "atreus@freelists.org"))
     ("l\\.deepspec"
      (to-address . "deepspec@lists.cs.princeton.edu")
      (to-list    . "deepspec@lists.cs.princeton.edu")
      (list-identifier . "\\[deepspec\\]"))
     ("l\\.emacs-devel"
      (to-address . "emacs-devel@gnu.org")
      (to-list    . "emacs-devel@gnu.org"))
     ("l\\.help-gnu-emacs"
      (to-address . "help-gnu-emacs@gnu.org")
      (to-list    . "help-gnu-emacs@gnu.org"))
     ("l\\.info-gnu-emacs"
      (to-address . "info-gnu-emacs@gnu.org")
      (to-list    . "info-gnu-emacs@gnu.org"))
     ("l\\.emacs-orgmode"
      (to-address . "emacs-orgmode@gnu.org")
      (to-list    . "emacs-orgmode@gnu.org")
      (list-identifier . "\\[O\\]"))
     ("l\\.emacs-tangents"
      (to-address . "emacs-tangents@gnu.org")
      (to-list    . "emacs-tangents@gnu.org"))
     ("l\\.emacsconf-committee"
      (to-address . "emacsconf-committee@gnu.org")
      (to-list    . "emacsconf-committee@gnu.org"))
     ("l\\.emacsconf-discuss"
      (to-address . "emacsconf-discuss@gnu.org")
      (to-list    . "emacsconf-discuss@gnu.org"))
     ("l\\.emacsconf-register"
      (to-address . "emacsconf-register@gnu.org")
      (to-list    . "emacsconf-register@gnu.org"))
     ("l\\.emacsconf-submit"
      (to-address . "emacsconf-submit@gnu.org")
      (to-list    . "emacsconf-submit@gnu.org"))
     ("l\\.fencepost-users"
      (to-address . "fencepost-users@gnu.org")
      (to-list    . "fencepost-users@gnu.org")
      (list-identifier . "\\[Fencepost-users\\]"))
     ("l\\.gnewsense-art"
      (to-address . "gnewsense-art@nongnu.org")
      (to-list    . "gnewsense-art@nongnu.org")
      (list-identifier . "\\[gNewSense-art\\]"))
     ("l\\.gnewsense-dev"
      (to-address . "gnewsense-dev@nongnu.org")
      (to-list    . "gnewsense-dev@nongnu.org")
      (list-identifier . "\\[Gnewsense-dev\\]"))
     ("l\\.gnewsense-users"
      (to-address . "gnewsense-users@nongnu.org")
      (to-list    . "gnewsense-users@nongnu.org")
      (list-identifier . "\\[gNewSense-users\\]"))
     ("l\\.gnunet-developers"
      (to-address . "gnunet-developers@gnu.org")
      (to-list    . "gnunet-developers@gnu.org")
      (list-identifier . "\\[GNUnet-developers\\]"))
     ("l\\.help-gnunet"
      (to-address . "help-gnunet@gnu.org")
      (to-list    . "help-gnunet@gnu.org")
      (list-identifier . "\\[Help-gnunet\\]"))
     ("l\\.bug-gnuzilla"
      (to-address . "bug-gnuzilla@gnu.org")
      (to-list    . "bug-gnuzilla@gnu.org")
      (list-identifier . "\\[Bug-gnuzilla\\]"))
     ("l\\.gnuzilla-dev"
      (to-address . "gnuzilla-dev@gnu.org")
      (to-list    . "gnuzilla-dev@gnu.org")
      (list-identifier . "\\[Gnuzilla-dev\\]"))
     ("l\\.guile-devel"
      (to-address . "guile-devel@gnu.org")
      (to-list    . "guile-devel@gnu.org"))
     ("l\\.guile-user"
      (to-address . "guile-user@gnu.org")
      (to-list    . "guile-user@gnu.org"))
     ("l\\.guix-devel"
      (to-address . "guix-devel@gnu.org")
      (to-list    . "guix-devel@gnu.org"))
     ("l\\.help-guix"
      (to-address . "help-guix@gnu.org")
      (to-list    . "help-guix@gnu.org"))
     ("l\\.info-guix"
      (to-address . "info-guix@gnu.org")
      (to-list    . "info-guix@gnu.org"))
     ("l\\.savannah-hackers-public"
      (to-address . "savannah-hackers-public@gnu.org")
      (to-list    . "savannah-hackers-public@gnu.org"))
     ("l\\.savannah-users"
      (to-address . "savannah-users@gnu.org")
      (to-list    . "savannah-users@gnu.org"))
     ("l\\.www-commits"
      (to-address . "www-commits@gnu.org")
      (to-list    . "www-commits@gnu.org"))
     ("l\\.www-discuss"
      (to-address . "www-discuss@gnu.org")
      (to-list    . "www-discuss@gnu.org"))
     ("l\\.haskell-art"
      (to-address . "haskell-art@we.lurk.org")
      (to-list    . "haskell-art@we.lurk.org")
      (list-identifier . "\\[haskell-art\\]"))
     ("l\\.haskell-cafe"
      (to-address . "haskell-cafe@haskell.org")
      (to-list    . "haskell-cafe@haskell.org")
      (list-identifier . "\\[Haskell-cafe\\]"))
     ("l\\.notmuch"
      (to-address . "notmuch@notmuchmail.org")
      (to-list    . "notmuch@notmuchmail.org"))
     ("l\\.parabola-dev"
      (to-address . "dev@lists.parabola.nu")
      (to-list    . "dev@lists.parabola.nu")
      (list-identifier . "\\[Dev\\]"))
     ("l\\.~bandali\\.public-inbox"
      (to-address . "~bandali/public-inbox@lists.sr.ht")
      (to-list    . "~bandali/public-inbox@lists.sr.ht"))
     ("l\\.~sircmpwn\\.free-writers-club"
      (to-address . "~sircmpwn/free-writers-club@lists.sr.ht")
      (to-list    . "~sircmpwn/free-writers-club@lists.sr.ht"))
     ("l\\.~sircmpwn\\.srht-admins"
      (to-address . "~sircmpwn/sr.ht-admins@lists.sr.ht")
      (to-list    . "~sircmpwn/sr.ht-admins@lists.sr.ht"))
     ("l\\.~sircmpwn\\.srht-announce"
      (to-address . "~sircmpwn/sr.ht-announce@lists.sr.ht")
      (to-list    . "~sircmpwn/sr.ht-announce@lists.sr.ht"))
     ("l\\.~sircmpwn\\.srht-dev"
      (to-address . "~sircmpwn/sr.ht-dev@lists.sr.ht")
      (to-list    . "~sircmpwn/sr.ht-dev@lists.sr.ht"))
     ("l\\.~sircmpwn\\.srht-discuss"
      (to-address . "~sircmpwn/sr.ht-discuss@lists.sr.ht")
      (to-list    . "~sircmpwn/sr.ht-discuss@lists.sr.ht"))
     ("webmasters"
      (to-address . "webmasters@gnu.org")
      (to-list    . "webmasters@gnu.org"))
     ("gnu.*"
      (gcc-self . t))
     ("l\\."
      (subscribed . t))
     ("nnimap\\+uwaterloo:.*"
      (gcc-self . t)))
   gnus-large-newsgroup  50
   gnus-home-directory   (b/var "gnus/")
   gnus-directory        (concat gnus-home-directory "news/")
   message-directory     (concat gnus-home-directory "mail/")
   nndraft-directory     (concat gnus-home-directory "drafts/")
   gnus-save-newsrc-file nil
   gnus-read-newsrc-file nil
   gnus-interactive-exit nil
   gnus-gcc-mark-as-read t)
  :config
  (when (version< emacs-version "27")
    (with-eval-after-load 'nnmail
      (add-to-list
       'nnmail-split-abbrev-alist
       '(list . "list-id\\|list-post\\|x-mailing-list\\|x-beenthere\\|x-loop")
       t)))

  ;; (require 'gnus-registry)
  ;; (setq gnus-registry-max-entries 2500)
  ;; (setq gnus-registry-ignored-groups
  ;;       (append gnus-registry-ignored-groups
  ;;               '(("^nnimap:gnu\\.l" t)
  ;;                 ("webmasters$" t))))
  ;; (gnus-registry-initialize)

  (with-eval-after-load 'recentf
    (add-to-list 'recentf-exclude gnus-home-directory)))

(use-package gnus-art
  :config
  (setq
   gnus-buttonized-mime-types '("multipart/\\(signed\\|encrypted\\)")
   gnus-sorted-header-list '("^From:"
                             "^X-RT-Originator"
                             "^Newsgroups:"
                             "^Subject:"
                             "^Date:"
                             "^Envelope-To:"
                             "^Followup-To:"
                             "^Reply-To:"
                             "^Organization:"
                             "^Summary:"
                             "^Abstract:"
                             "^Keywords:"
                             "^To:"
                             "^[BGF]?Cc:"
                             "^Posted-To:"
                             "^Mail-Copies-To:"
                             "^Mail-Followup-To:"
                             "^Apparently-To:"
                             "^Resent-From:"
                             "^User-Agent:"
                             "^X-detected-operating-system:"
                             "^X-Spam_action:"
                             "^X-Spam_bar:"
                             "^Message-ID:"
                             ;; "^References:"
                             "^List-Id:"
                             "^Gnus-Warning:")
   gnus-visible-headers (mapconcat 'identity
                                   gnus-sorted-header-list
                                   "\\|")
  ;; local-lapsed article dates
  ;; from https://www.emacswiki.org/emacs/GnusFormatting#toc11
  gnus-article-date-headers '(user-defined)
  gnus-article-time-format
  (lambda (time)
    (let* ((date (format-time-string "%a, %d %b %Y %T %z" time))
           (local (article-make-date-line date 'local))
           (combined-lapsed (article-make-date-line date
                                                    'combined-lapsed))
           (lapsed (progn
                     (string-match " (.+" combined-lapsed)
                     (match-string 0 combined-lapsed))))
      (concat local lapsed))))
  (bind-keys
   :map gnus-article-mode-map
   ("M-L" . org-store-link)))

(use-package gnus-sum
  :bind (:map gnus-summary-mode-map
              :prefix-map b/gnus-summary-prefix-map
              :prefix "v"
              ("r" . gnus-summary-reply)
              ("w" . gnus-summary-wide-reply)
              ("v" . gnus-summary-show-raw-article))
  :config
  (bind-keys
   :map gnus-summary-mode-map
   ("M-L" . org-store-link))
  :hook (gnus-summary-mode . b/no-mouse-autoselect-window)
  :custom
  (gnus-thread-sort-functions '(gnus-thread-sort-by-number
                                gnus-thread-sort-by-subject
                                gnus-thread-sort-by-date)))

(use-package gnus-msg
  :config
  (defvar b/shemshak-signature "Amin Bandali
https://shemshak.org/~bandali")
  (defvar b/uwaterloo-signature "Amin Bandali, MMath
Cheriton School of Computer Science
University of Waterloo
https://bndl.org")
  (defvar b/csc-signature "Amin Bandali | https://bndl.org
System Administrator, Systems Committee
Computer Science Club, University of Waterloo")
  (setq gnus-message-replysign t
        gnus-posting-styles
        '((".*"
           (address "bandali@gnu.org"))
          ("nnimap\\+gnu:l\\..*"
           (signature nil))
          ("nnimap\\+gnu:.*"
           (organization "GNU"))
          ((header "subject" "ThankCRM")
           (to "webmasters-comment@gnu.org")
           (body "")
           (eval (setq b/message-cite-say-hi nil)))
          ("nnimap\\+shemshak:.*"
           (address "amin@shemshak.org")
           (body "\nBest,\n")
           (signature b/shemshak-signature)
           (gcc "nnimap+shemshak:Sent")
           (eval (setq b/message-cite-say-hi t)))
          ("nnimap\\+uwaterloo:.*"
           (address "bandali@uwaterloo.ca")
           (body "\nBest,\n")
           (signature b/uwaterloo-signature))
          ("nnimap\\+uwaterloo:INBOX"
           (gcc "\"nnimap+uwaterloo:Sent Items\""))
          ("nnimap\\+csc:.*"
           (address "bandali@csclub.uwaterloo.ca")
           (signature b/csc-signature)
           (gcc "nnimap+csc:Sent"))))
  :hook (gnus-message-setup . (lambda ()
                                (unless (mml-secure-is-encrypted-p)
                                  (mml-secure-message-sign)))))

(use-package gnus-topic
  :hook (gnus-group-mode . gnus-topic-mode)
  :config (setq gnus-topic-line-format "%i[ %A: %(%{%n%}%) ]%v\n"))

(use-package gnus-agent
  :config
  (setq gnus-agent-synchronize-flags 'ask)
  :hook (gnus-group-mode . gnus-agent-mode))

(use-package gnus-group
  :config
  (setq gnus-permanently-visible-groups "\\(:INBOX$\\|:gnu$\\)"))

(comment
  ;; problematic with ebdb's popup, *EBDB-Gnus*
  (use-package gnus-win
    :config
    (setq gnus-use-full-window nil)))

(use-package gnus-dired
  :commands gnus-dired-mode
  :init
  (add-hook 'dired-mode-hook 'gnus-dired-mode))

(comment
  (use-package gnus-utils
    :custom
    (gnus-completing-read-function 'gnus-ido-completing-read)))

(use-package mm-decode
  :config
  (setq mm-discouraged-alternatives '("text/html" "text/richtext")
        mm-decrypt-option 'known
        mm-verify-option 'known))

(use-package mm-uu
  :config
  (when (version< "27" emacs-version)
    (set-face-attribute 'mm-uu-extract nil :extend t))
  :custom
  (mm-uu-diff-groups-regexp
   "\\(gmane\\|gnu\\|l\\)\\..*\\(diff\\|commit\\|cvs\\|bug\\|dev\\)"))

(use-package mml)

(use-package mml-sec
  :custom
  (mml-secure-openpgp-encrypt-to-self t)
  (mml-secure-openpgp-sign-with-sender t))

(use-package gnus-article-treat-patch
  :disabled
  :demand
  :load-path "lisp/"
  :config
  ;; note: be sure to customize faces with `:foreground "white"' when
  ;; using a theme with a white/light background :)
  (setq ft/gnus-article-patch-conditions
        '("^@@ -[0-9]+,[0-9]+ \\+[0-9]+,[0-9]+ @@")))

(provide 'bandali-gnus)
;;; bandali-gnus.el ends here