git.shemshak.org - ~bandali/configs/blob - .emacs.d/lisp/bandali-gnus.el

   1 ;;; bandali-gnus.el --- bandali's Gnus setup         -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2018-2022  Amin Bandali
   4
   5 ;; Author: Amin Bandali <bandali@gnu.org>
   6 ;; Keywords: mail, news
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; My trusty super awesome Gnus setup.
  24
  25 ;;; Code:
  26
  27 (defvar b/maildir (expand-file-name "~/mail/"))
  28 (with-eval-after-load 'recentf
  29   (add-to-list 'recentf-exclude b/maildir))
  30
  31 (defvar b/gnus-init-file (b/etc "gnus"))
  32
  33 (eval-when-compile
  34   (progn
  35     (defvar nndraft-directory)
  36     (defvar gnus-read-newsrc-file)
  37     (defvar gnus-save-newsrc-file)
  38     (defvar gnus-gcc-mark-as-read)
  39     (defvar nnmail-split-abbrev-alist)))
  40
  41 (declare-function article-make-date-line "gnus-art" (date type))
  42
  43 (setq
  44  mail-user-agent 'gnus-user-agent
  45  read-mail-command 'gnus
  46
  47  gnus-select-method '(nnnil "")
  48  gnus-secondary-select-methods
  49  `(,@(if (string= (system-name) "darya")
  50          '((nnimap
  51             "canonical"
  52             (nnimap-stream plain)
  53             (nnimap-address "127.0.0.1")
  54             (nnimap-server-port 143)
  55             (nnimap-authenticator plain)
  56             (nnimap-user "bandali@canonical.local")))
  57        '((nnimap
  58           "kelar"
  59           (nnimap-stream plain)
  60           (nnimap-address "127.0.0.1")
  61           (nnimap-server-port 143)
  62           (nnimap-authenticator plain)
  63           (nnimap-user "bandali@kelar.local"))
  64          (nnimap
  65           "shemshak"
  66           (nnimap-stream plain)
  67           (nnimap-address "127.0.0.1")
  68           (nnimap-server-port 143)
  69           (nnimap-authenticator plain)
  70           (nnimap-user "bandali@shemshak.local"))
  71          (nnimap
  72           "gnu"
  73           (nnimap-stream plain)
  74           (nnimap-address "127.0.0.1")
  75           (nnimap-server-port 143)
  76           (nnimap-authenticator plain)
  77           (nnimap-user "bandali@gnu.local")
  78           (nnimap-inbox "INBOX")
  79           (nnimap-split-methods 'nnimap-split-fancy)
  80           (nnimap-split-fancy
  81            (|
  82             ;; (: gnus-registry-split-fancy-with-parent)
  83             ;; (: gnus-group-split-fancy "INBOX" t "INBOX")
  84             ;; spam
  85             ("X-Spam_action" "reject" "Junk")
  86             ;; keep debbugs emails in INBOX
  87             (list ".*<\\(.*\\)\\.debbugs\\.gnu\\.org>.*" "INBOX")
  88             ;; list moderation emails
  89             (from ".+-\\(owner\\|bounces\\)@\\(non\\)?gnu\\.org" "listmod")
  90             ;; gnu
  91             (list ".*<\\(.*\\)\\.\\(non\\)?gnu\\.org>.*" "l.\\1")
  92             ;; fsf
  93             (list ".*<\\(.*\\)\\.fsf\\.org>.*" "l.\\1")
  94             ;; debian
  95             (list ".*<\\(.*\\)\\.alioth-lists\\.debian\\.net>.*" "l.\\1")
  96             ;; gnus
  97             (list ".*<\\(.*\\)\\.gnus\\.org>.*" "l.\\1")
  98             ;; libreplanet
  99             (list ".*<\\(.*\\)\\.libreplanet\\.org>.*" "l.\\1")
 100             ;; iana (e.g. tz-announce)
 101             (list ".*<\\(.*\\)\\.iana\\.org>.*" "l.\\1")
 102             ;; mailop
 103             (list ".*<\\(.*\\)\\.mailop\\.org>.*" "l.\\1")
 104             ;; sdlu
 105             (list ".*<\\(.*\\)\\.spammers\\.dontlike\\.us>.*" "l.sdlu")
 106             ;; bitfolk
 107             (from ".*@\\(.+\\)?bitfolk\\.com>.*" "bitfolk")
 108             ;; haskell
 109             (list ".*<\\(.*\\)\\.haskell\\.org>.*" "l.\\1")
 110             ;; *.lists.sr.ht, omitting one dot if present
 111             ;;    add more \\.?\\([^.]*\\) if needed
 112             (list ".*<~\\(.*\\)/\\([^.]*\\)\\.?\\([^.]*\\)\\.lists\\.sr\\.ht>.*" "l.~\\1.\\2\\3")
 113             ;; webmasters
 114             (from "webmasters\\(-comment\\)?@gnu\\.org" "webmasters")
 115             ;; other
 116             ("subject" "nagios-fsf:.*" "nagios-fsf")
 117             (list ".*atreus.freelists.org" "l.atreus")
 118             (list ".*deepspec.lists.cs.princeton.edu" "l.deepspec")
 119             ;; (list ".*haskell-art.we.lurk.org" "l.haskell.art") ;d
 120             ;; (list ".*notmuch.notmuchmail.org" "l.notmuch") ;u
 121             (list ".*dev.lists.parabola.nu" "l.parabola-dev")
 122             ;; ----------------------------------
 123             ;; legend: (u)nsubscribed | (d)ead
 124             ;; ----------------------------------
 125             ;; otherwise, leave mail in INBOX
 126             "INBOX")))
 127          (nnimap
 128           "uwaterloo"
 129           (nnimap-stream plain)
 130           (nnimap-address "127.0.0.1")
 131           (nnimap-server-port 143)
 132           (nnimap-authenticator plain)
 133           (nnimap-user "abandali@uwaterloo.local")
 134           (nnimap-inbox "INBOX")
 135           (nnimap-split-methods 'nnimap-split-fancy)
 136           (nnimap-split-fancy
 137            (|
 138             ;; (: gnus-registry-split-fancy-with-parent)
 139             ;; se212-f19
 140             ("subject" "SE\\s-?212" "course.se212-f19")
 141             (from "SE\\s-?212" "course.se212-f19")
 142             ;; catch-all
 143             "INBOX")))
 144          (nnimap
 145           "csc"
 146           (nnimap-stream plain)
 147           (nnimap-address "127.0.0.1")
 148           (nnimap-server-port 143)
 149           (nnimap-authenticator plain)
 150           (nnimap-user "abandali@csclub.uwaterloo.local")
 151           (nnimap-inbox "INBOX")
 152           (nnimap-split-methods 'nnimap-split-fancy)
 153           (nnimap-split-fancy
 154            (|
 155             ;; cron reports and other messages from root
 156             (from "root@\\(.*\\.\\)?csclub\\.uwaterloo\\.ca" "INBOX")
 157             ;; spam
 158             ("X-Spam-Flag" "YES" "Junk")
 159             ;; catch-all
 160             "INBOX")))
 161          (nnimap
 162           "sfl"
 163           (nnimap-stream plain)
 164           (nnimap-address "127.0.0.1")
 165           (nnimap-server-port 143)
 166           (nnimap-authenticator plain)
 167           (nnimap-user "amin.bandali@savoirfairelinux.local")))))
 168  gnus-message-archive-group "nnimap+gnu:INBOX"
 169  gnus-parameters
 170  '(("l\\.deepspec"
 171     (to-address . "deepspec@lists.cs.princeton.edu")
 172     (to-list    . "deepspec@lists.cs.princeton.edu")
 173     (list-identifier . "\\[deepspec\\]"))
 174    ("l\\.fencepost-users"
 175     (to-address . "fencepost-users@gnu.org")
 176     (to-list    . "fencepost-users@gnu.org")
 177     (list-identifier . "\\[Fencepost-users\\]"))
 178    ("l\\.haskell-cafe"
 179     (to-address . "haskell-cafe@haskell.org")
 180     (to-list    . "haskell-cafe@haskell.org")
 181     (list-identifier . "\\[Haskell-cafe\\]"))
 182    ("gnu.*"
 183     (gcc-self . t)))
 184  ;; nnimap-record-commands t
 185  ;; gnus-large-newsgroup  50
 186  ;; gnus-process-mark-toggle t
 187  gnus-home-directory   (b/var "gnus/")
 188  gnus-directory        (concat gnus-home-directory "news/")
 189  message-directory     (concat gnus-home-directory "mail/")
 190  nndraft-directory     (concat gnus-home-directory "drafts/")
 191  gnus-save-newsrc-file nil
 192  gnus-read-newsrc-file nil
 193  gnus-search-use-parsed-queries t
 194  gnus-interactive-exit nil
 195  gnus-gcc-mark-as-read t)
 196
 197 (with-eval-after-load 'gnus
 198   (when (version< emacs-version "27")
 199     (with-eval-after-load 'nnmail
 200       (add-to-list
 201        'nnmail-split-abbrev-alist
 202        '(list . "list-id\\|list-post\\|x-mailing-list\\|x-beenthere\\|x-loop")
 203        t)))
 204
 205   ;; (require 'gnus-registry)
 206   ;; (setq gnus-registry-max-entries 2500)
 207   ;; (setq gnus-registry-ignored-groups
 208   ;;       (append gnus-registry-ignored-groups
 209   ;;               '(("^nnimap:gnu\\.l" t)
 210   ;;                 ("webmasters$" t))))
 211   ;; (gnus-registry-initialize)
 212
 213   (with-eval-after-load 'recentf
 214     (add-to-list 'recentf-exclude gnus-home-directory))
 215
 216   ;; hooks
 217   (add-hook 'gnus-group-mode-hook #'gnus-topic-mode)
 218   (add-hook 'gnus-group-mode-hook #'gnus-agent-mode))
 219 ;; global key bindings
 220 (global-set-key (kbd "C-c g") #'gnus-plugged)
 221 (global-set-key (kbd "C-c G") #'gnus-unplugged)
 222
 223 (with-eval-after-load 'gnus-art
 224   (setq
 225    gnus-buttonized-mime-types '("multipart/\\(signed\\|encrypted\\)")
 226    gnus-sorted-header-list '("^From:"
 227                              "^X-RT-Originator"
 228                              "^Newsgroups:"
 229                              "^Subject:"
 230                              "^Date:"
 231                              "^Envelope-To:"
 232                              "^Followup-To:"
 233                              "^Reply-To:"
 234                              "^Organization:"
 235                              "^Summary:"
 236                              "^Abstract:"
 237                              "^Keywords:"
 238                              "^To:"
 239                              "^[BGF]?Cc:"
 240                              "^Posted-To:"
 241                              "^Mail-Copies-To:"
 242                              "^Mail-Followup-To:"
 243                              "^Apparently-To:"
 244                              "^Resent-From:"
 245                              "^User-Agent:"
 246                              "^X-detected-operating-system:"
 247                              "^X-Spam_action:"
 248                              "^X-Spam_bar:"
 249                              "^Message-ID:"
 250                              ;; "^References:"
 251                              "^List-Id:"
 252                              "^Gnus-Warning:")
 253    gnus-visible-headers (mapconcat #'identity
 254                                    gnus-sorted-header-list
 255                                    "\\|")
 256   ;; local-lapsed article dates
 257   ;; from https://www.emacswiki.org/emacs/GnusFormatting#toc11
 258   gnus-article-date-headers '(user-defined)
 259   gnus-article-time-format
 260   (lambda (time)
 261     (let* ((date (format-time-string "%a, %d %b %Y %T %z" time))
 262            (local (article-make-date-line date 'local))
 263            (combined-lapsed (article-make-date-line date
 264                                                     'combined-lapsed))
 265            (lapsed (progn
 266                      (string-match " (.+" combined-lapsed)
 267                      (match-string 0 combined-lapsed))))
 268       (concat local lapsed))))
 269   ;; local key bindings
 270   (declare-function org-store-link "ol" (arg &optional interactive?))
 271   (define-key gnus-article-mode-map (kbd "M-L") #'org-store-link))
 272
 273 (with-eval-after-load 'gnus-sum
 274   (setq gnus-thread-sort-functions '(gnus-thread-sort-by-number
 275                                      gnus-thread-sort-by-subject
 276                                      gnus-thread-sort-by-date))
 277   ;; local key bindings
 278   (define-key gnus-summary-mode-map (kbd "M-L") #'org-store-link)
 279   ;; (define-key gnus-summary-mode-map (kbd "r")
 280   ;;   #'gnus-summary-reply-with-original)
 281   ;; (define-key gnus-summary-mode-map (kbd "R")
 282   ;;   #'gnus-summary-wide-reply-with-original)
 283   (defvar b/gnus-summary-prefix-map)
 284   (define-prefix-command 'b/gnus-summary-prefix-map)
 285   (define-key gnus-summary-mode-map (kbd "v")
 286     'b/gnus-summary-prefix-map)
 287   (define-key b/gnus-summary-prefix-map (kbd "r")
 288     #'gnus-summary-reply)
 289   (define-key b/gnus-summary-prefix-map (kbd "w")
 290     #'gnus-summary-wide-reply)
 291   (define-key b/gnus-summary-prefix-map (kbd "v")
 292     #'gnus-summary-show-raw-article))
 293 ;; hooks
 294 (add-hook 'gnus-summary-mode-hook #'b/no-mouse-autoselect-window)
 295
 296 (defvar b/sfl-p nil)
 297 (with-eval-after-load 'gnus-msg
 298   (let ((bandali "Amin Bandali (https://kelar.org/~bandali)"))
 299     (defvar b/canonical-signature
 300       (mapconcat
 301        #'identity
 302        `(,bandali
 303          "Software Engineer (Desktop), Canonical")
 304        "\n"))
 305     (defvar b/csc-signature
 306       (mapconcat
 307        #'identity
 308        `(,bandali
 309          "Systems Committee <syscom@csclub.uwaterloo.ca>"
 310          "Computer Science Club of the University of Waterloo")
 311        "\n"))
 312     (defvar b/sfl-signature
 313       (mapconcat
 314        #'identity
 315        `(,bandali
 316          "Volunteer, Savoir-faire Linux"
 317          "jami:bandali")
 318        "\n")))
 319   (setq
 320    gnus-message-replysign t
 321    gnus-posting-styles
 322    '((".*"
 323       (address "bandali@gnu.org")
 324       ("X-Message-SMTP-Method" "smtp fencepost.gnu.org 587"))
 325      ((header "subject" "ThankCRM")
 326       (to "webmasters-comment@gnu.org")
 327       (body ""))
 328      ("nnimap\\+kelar:.*"
 329       (address "bandali@kelar.org")
 330       ("X-Message-SMTP-Method" "smtp mail.kelar.org 587")
 331       (gcc "nnimap+kelar:Sent"))
 332      ("nnimap\\+shemshak:.*"
 333       (address "amin@shemshak.org")
 334       ("X-Message-SMTP-Method" "smtp mail.shemshak.org 587")
 335       (gcc "nnimap+shemshak:Sent"))
 336      ("nnimap\\+canonical:.*"
 337       (address "amin.bandali@canonical.com")
 338       ("X-Message-SMTP-Method" "smtp smtp.canonical.com 587")
 339       (signature b/canonical-signature)
 340       (gcc "nnimap+canonical:Sent"))
 341      ("nnimap\\+csc:.*"
 342       (address "bandali@csclub.uwaterloo.ca")
 343       ("X-Message-SMTP-Method" "smtp mail.csclub.uwaterloo.ca 587")
 344       (signature b/csc-signature)
 345       (gcc "nnimap+csc:Sent"))
 346      ("nnimap\\+sfl:.*"
 347       (address "amin.bandali@savoirfairelinux.com")
 348       ("X-Message-SMTP-Method" "smtp mail.savoirfairelinux.com 587")
 349       (signature b/sfl-signature)
 350       (eval (setq-local b/sfl-p t))
 351       (gcc "nnimap+sfl:Sent")))))
 352 ;; hooks
 353 ;; (with-eval-after-load 'gnus
 354 ;;   (add-hook 'gnus-message-setup-hook
 355 ;;             (lambda ()
 356 ;;               (unless (or (mml-secure-is-encrypted-p)
 357 ;;                           b/sfl-p)
 358 ;;                 (mml-secure-message-sign)))))
 359
 360 (with-eval-after-load 'gnus-topic
 361   (setq
 362    gnus-topic-line-format "%i[ %A: %(%{%n%}%) ]%v\n"
 363    gnus-topic-topology
 364    `(("Gnus" visible nil nil)
 365      (("misc" visible nil nil))
 366      ,@(if (string= (system-name) "darya")
 367            '((("canonical" visible nil nil)))
 368          '((("csc" visible nil nil))
 369            (("uwaterloo" visible nil nil))
 370            (("kelar" visible nil nil))
 371            (("shemshak" visible nil nil))
 372            (("gnu" visible nil nil))
 373            (("old-gnu" visible nil nil))
 374            (("sfl" visible nil nil)))))))
 375
 376 (with-eval-after-load 'gnus-agent
 377   (setq gnus-agent-synchronize-flags 'ask))
 378
 379 (with-eval-after-load 'gnus-group
 380   (setq gnus-permanently-visible-groups "\\(:INBOX$\\|:gnu$\\)"))
 381
 382 (with-eval-after-load 'gnus-win
 383   (setq gnus-use-full-window nil))
 384
 385 (with-eval-after-load 'gnus-dired
 386   (add-hook 'dired-mode-hook 'gnus-dired-mode))
 387
 388 (with-eval-after-load 'mm-decode
 389   (setq
 390    ;; mm-attachment-override-types `("text/x-diff" "text/x-patch"
 391    ;;                                ,@mm-attachment-override-types)
 392    mm-discouraged-alternatives '("text/html" "text/richtext")
 393    mm-decrypt-option 'known
 394    mm-verify-option 'known))
 395
 396 (with-eval-after-load 'mm-uu
 397   (when (version< "27" emacs-version)
 398     (set-face-attribute 'mm-uu-extract nil :extend t))
 399   (when (version< emacs-version "27")
 400     (setq mm-uu-diff-groups-regexp ".")))
 401
 402 (with-eval-after-load 'mml-sec
 403   (setq mml-secure-openpgp-encrypt-to-self t
 404         mml-secure-openpgp-sign-with-sender t))
 405
 406 (provide 'bandali-gnus)
 407 ;;; bandali-gnus.el ends here