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-2021  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 (csetq
  44  mail-user-agent 'gnus-user-agent
  45  read-mail-command 'gnus
  46
  47  gnus-select-method '(nnnil "")
  48  gnus-secondary-select-methods
  49  '((nnimap "shemshak"
  50            (nnimap-stream plain)
  51            (nnimap-address "127.0.0.1")
  52            (nnimap-server-port 143)
  53            (nnimap-authenticator plain)
  54            (nnimap-user "bandali@shemshak.local"))
  55    (nnimap "gnu"
  56            (nnimap-stream plain)
  57            (nnimap-address "127.0.0.1")
  58            (nnimap-server-port 143)
  59            (nnimap-authenticator plain)
  60            (nnimap-user "bandali@gnu.local")
  61            (nnimap-inbox "INBOX")
  62            (nnimap-split-methods 'nnimap-split-fancy)
  63            (nnimap-split-fancy (|
  64                                 ;; (: gnus-registry-split-fancy-with-parent)
  65                                 ;; (: gnus-group-split-fancy "INBOX" t "INBOX")
  66                                 ;; keep debbugs emails in INBOX
  67                                 (list ".*<\\(.*\\)\\.debbugs\\.gnu\\.org>.*" "INBOX")
  68                                 ;; list moderation emails
  69                                 (from ".+-\\(owner\\|bounces\\)@\\(non\\)?gnu\\.org" "listmod")
  70                                 ;; gnu
  71                                 (list ".*<\\(.*\\)\\.\\(non\\)?gnu\\.org>.*" "l.\\1")
  72                                 ;; gnus
  73                                 (list ".*<\\(.*\\)\\.gnus\\.org>.*" "l.\\1")
  74                                 ;; libreplanet
  75                                 (list ".*<\\(.*\\)\\.libreplanet\\.org>.*" "l.\\1")
  76                                 ;; iana (e.g. tz-announce)
  77                                 (list ".*<\\(.*\\)\\.iana\\.org>.*" "l.\\1")
  78                                 ;; haskell
  79                                 (list ".*<\\(.*\\)\\.haskell\\.org>.*" "l.\\1")
  80                                 ;; *.lists.sr.ht, omitting one dot if present
  81                                 ;;    add more \\.?\\([^.]*\\) if needed
  82                                 (list ".*<~\\(.*\\)/\\([^.]*\\)\\.?\\([^.]*\\)\\.lists\\.sr\\.ht>.*" "l.~\\1.\\2\\3")
  83                                 ;; webmasters
  84                                 (from "webmasters\\(-comment\\)?@gnu\\.org" "webmasters")
  85                                 ;; other
  86                                 ("subject" "nagios-fsf:.*" "nagios-fsf")
  87                                 (list ".*atreus.freelists.org" "l.atreus")
  88                                 (list ".*deepspec.lists.cs.princeton.edu" "l.deepspec")
  89                                 ;; (list ".*haskell-art.we.lurk.org" "l.haskell.art") ;d
  90                                 ;; (list ".*notmuch.notmuchmail.org" "l.notmuch") ;u
  91                                 (list ".*dev.lists.parabola.nu" "l.parabola-dev")
  92                                 ;; ----------------------------------
  93                                 ;; legend: (u)nsubscribed | (d)ead
  94                                 ;; ----------------------------------
  95                                 ;; spam
  96                                 ("X-Spam_action" "reject" "Junk")
  97                                 ;; otherwise, leave mail in INBOX
  98                                 "INBOX")))
  99    (nnimap "uwaterloo"
 100            (nnimap-stream plain)
 101            (nnimap-address "127.0.0.1")
 102            (nnimap-server-port 143)
 103            (nnimap-authenticator plain)
 104            (nnimap-user "abandali@uwaterloo.local")
 105            (nnimap-inbox "INBOX")
 106            (nnimap-split-methods 'nnimap-split-fancy)
 107            (nnimap-split-fancy (|
 108                                 ;; (: gnus-registry-split-fancy-with-parent)
 109                                 ;; se212-f19
 110                                 ("subject" "SE\\s-?212" "course.se212-f19")
 111                                 (from "SE\\s-?212" "course.se212-f19")
 112                                 ;; catch-all
 113                                 "INBOX")))
 114    (nnimap "csc"
 115            (nnimap-stream plain)
 116            (nnimap-address "127.0.0.1")
 117            (nnimap-server-port 143)
 118            (nnimap-authenticator plain)
 119            (nnimap-user "abandali@csclub.uwaterloo.local")
 120            (nnimap-inbox "INBOX")
 121            (nnimap-split-methods 'nnimap-split-fancy)
 122            (nnimap-split-fancy (|
 123                                 ;; cron reports and other messages from root
 124                                 (from "root@\\(.*\\.\\)?csclub\\.uwaterloo\\.ca" "INBOX")
 125                                 ;; spam
 126                                 ("X-Spam-Flag" "YES" "Junk")
 127                                 ;; catch-all
 128                                 "INBOX")))
 129    (nnimap "sfl"
 130            (nnimap-stream plain)
 131            (nnimap-address "127.0.0.1")
 132            (nnimap-server-port 143)
 133            (nnimap-authenticator plain)
 134            (nnimap-user "amin.bandali@savoirfairelinux.local")))
 135  gnus-message-archive-group "nnimap+gnu:INBOX"
 136  gnus-parameters
 137  '(("l\\.deepspec"
 138     (to-address . "deepspec@lists.cs.princeton.edu")
 139     (to-list    . "deepspec@lists.cs.princeton.edu")
 140     (list-identifier . "\\[deepspec\\]"))
 141    ("l\\.fencepost-users"
 142     (to-address . "fencepost-users@gnu.org")
 143     (to-list    . "fencepost-users@gnu.org")
 144     (list-identifier . "\\[Fencepost-users\\]"))
 145    ("l\\.haskell-cafe"
 146     (to-address . "haskell-cafe@haskell.org")
 147     (to-list    . "haskell-cafe@haskell.org")
 148     (list-identifier . "\\[Haskell-cafe\\]"))
 149    ("gnu.*"
 150     (gcc-self . t))
 151    ;; ("l\\."
 152    ;;  (subscribed . t))
 153    ("nnimap\\+uwaterloo:.*"
 154     (gcc-self . t)))
 155  ;; nnimap-record-commands t
 156  ;; gnus-large-newsgroup  50
 157  gnus-home-directory   (b/var "gnus/")
 158  gnus-directory        (concat gnus-home-directory "news/")
 159  message-directory     (concat gnus-home-directory "mail/")
 160  nndraft-directory     (concat gnus-home-directory "drafts/")
 161  gnus-save-newsrc-file nil
 162  gnus-read-newsrc-file nil
 163  gnus-search-use-parsed-queries t
 164  gnus-interactive-exit nil
 165  gnus-gcc-mark-as-read t)
 166
 167 (with-eval-after-load 'gnus
 168   (when (version< emacs-version "27")
 169     (with-eval-after-load 'nnmail
 170       (add-to-list
 171        'nnmail-split-abbrev-alist
 172        '(list . "list-id\\|list-post\\|x-mailing-list\\|x-beenthere\\|x-loop")
 173        t)))
 174
 175   ;; (require 'gnus-registry)
 176   ;; (setq gnus-registry-max-entries 2500)
 177   ;; (setq gnus-registry-ignored-groups
 178   ;;       (append gnus-registry-ignored-groups
 179   ;;               '(("^nnimap:gnu\\.l" t)
 180   ;;                 ("webmasters$" t))))
 181   ;; (gnus-registry-initialize)
 182
 183   (with-eval-after-load 'recentf
 184     (add-to-list 'recentf-exclude gnus-home-directory))
 185
 186   ;; hooks
 187   (add-hook 'gnus-group-mode-hook #'gnus-topic-mode)
 188   (add-hook 'gnus-group-mode-hook #'gnus-agent-mode))
 189 ;; global key bindings
 190 (global-set-key (kbd "C-c m") #'gnus-plugged)
 191 (global-set-key (kbd "C-c M") #'gnus-unplugged)
 192
 193 (with-eval-after-load 'gnus-art
 194   (csetq
 195    gnus-buttonized-mime-types '("multipart/\\(signed\\|encrypted\\)")
 196    gnus-sorted-header-list '("^From:"
 197                              "^X-RT-Originator"
 198                              "^Newsgroups:"
 199                              "^Subject:"
 200                              "^Date:"
 201                              "^Envelope-To:"
 202                              "^Followup-To:"
 203                              "^Reply-To:"
 204                              "^Organization:"
 205                              "^Summary:"
 206                              "^Abstract:"
 207                              "^Keywords:"
 208                              "^To:"
 209                              "^[BGF]?Cc:"
 210                              "^Posted-To:"
 211                              "^Mail-Copies-To:"
 212                              "^Mail-Followup-To:"
 213                              "^Apparently-To:"
 214                              "^Resent-From:"
 215                              "^User-Agent:"
 216                              "^X-detected-operating-system:"
 217                              "^X-Spam_action:"
 218                              "^X-Spam_bar:"
 219                              "^Message-ID:"
 220                              ;; "^References:"
 221                              "^List-Id:"
 222                              "^Gnus-Warning:")
 223    gnus-visible-headers (mapconcat 'identity
 224                                    gnus-sorted-header-list
 225                                    "\\|")
 226   ;; local-lapsed article dates
 227   ;; from https://www.emacswiki.org/emacs/GnusFormatting#toc11
 228   gnus-article-date-headers '(user-defined)
 229   gnus-article-time-format
 230   (lambda (time)
 231     (let* ((date (format-time-string "%a, %d %b %Y %T %z" time))
 232            (local (article-make-date-line date 'local))
 233            (combined-lapsed (article-make-date-line date
 234                                                     'combined-lapsed))
 235            (lapsed (progn
 236                      (string-match " (.+" combined-lapsed)
 237                      (match-string 0 combined-lapsed))))
 238       (concat local lapsed))))
 239   ;; local key bindings
 240   (declare-function org-store-link "ol" (arg &optional interactive?))
 241   (define-key gnus-article-mode-map (kbd "M-L") #'org-store-link))
 242
 243 (with-eval-after-load 'gnus-sum
 244   (csetq gnus-thread-sort-functions '(gnus-thread-sort-by-number
 245                                       gnus-thread-sort-by-subject
 246                                       gnus-thread-sort-by-date))
 247   ;; local key bindings
 248   (define-key gnus-summary-mode-map (kbd "M-L") #'org-store-link)
 249   (define-key gnus-summary-mode-map (kbd "r")
 250     #'gnus-summary-reply-with-original)
 251   (define-key gnus-summary-mode-map (kbd "R")
 252     #'gnus-summary-wide-reply-with-original)
 253   (defvar b/gnus-summary-prefix-map)
 254   (define-prefix-command 'b/gnus-summary-prefix-map)
 255   (define-key gnus-summary-mode-map (kbd "v")
 256     'b/gnus-summary-prefix-map)
 257   (define-key b/gnus-summary-prefix-map (kbd "r")
 258     #'gnus-summary-reply)
 259   (define-key b/gnus-summary-prefix-map (kbd "w")
 260     #'gnus-summary-wide-reply)
 261   (define-key b/gnus-summary-prefix-map (kbd "v")
 262     #'gnus-summary-show-raw-article))
 263 ;; hooks
 264 (add-hook 'gnus-summary-mode-hook #'b/no-mouse-autoselect-window)
 265
 266 (defvar b/sfl-p nil)
 267 (with-eval-after-load 'gnus-msg
 268   (defvar b/shemshak-signature "Amin Bandali
 269 https://shemshak.org/~bandali")
 270   (defvar b/uwaterloo-signature "Amin Bandali, MMath
 271 https://shemshak.org/~bandali")
 272   (defvar b/csc-signature "Amin Bandali (https://shemshak.org/~bandali)
 273 Systems Committee <syscom@csclub.uwaterloo.ca>
 274 Computer Science Club of the University of Waterloo")
 275   (defvar b/sfl-signature "Amin Bandali
 276 Free Software Consultant
 277 Savoir-faire Linux
 278 jami:bandali")
 279   (csetq
 280    gnus-message-replysign t
 281    gnus-posting-styles
 282    '((".*"
 283       (address "bandali@gnu.org")
 284       ("X-Message-SMTP-Method" "smtp fencepost.gnu.org 587"))
 285      ("nnimap\\+gnu:l\\..*"
 286       (signature nil))
 287      ((header "subject" "ThankCRM")
 288       (to "webmasters-comment@gnu.org")
 289       (body "")
 290       (eval (setq b/message-cite-say-hi nil)))
 291      ("nnimap\\+shemshak:.*"
 292       (address "amin@shemshak.org")
 293       ("X-Message-SMTP-Method" "smtp mail.shemshak.org 587")
 294       (body "\nBest,\n")
 295       (signature b/shemshak-signature)
 296       (gcc "nnimap+shemshak:Sent")
 297       (eval (setq b/message-cite-say-hi t)))
 298      ("nnimap\\+uwaterloo:.*"
 299       (address "bandali@uwaterloo.ca")
 300       ("X-Message-SMTP-Method" "smtp connect.uwaterloo.ca 587")
 301       (body "\nBest,\n")
 302       (signature b/uwaterloo-signature))
 303      ("nnimap\\+uwaterloo:INBOX"
 304       (gcc "\"nnimap+uwaterloo:Sent Items\""))
 305      ("nnimap\\+csc:.*"
 306       (address "bandali@csclub.uwaterloo.ca")
 307       ("X-Message-SMTP-Method" "smtp mail.csclub.uwaterloo.ca 587")
 308       (signature b/csc-signature)
 309       (gcc "nnimap+csc:Sent"))
 310      ("nnimap\\+sfl:.*"
 311       (address "amin.bandali@savoirfairelinux.com")
 312       (signature b/sfl-signature)
 313       ("X-Message-SMTP-Method" "smtp mail.savoirfairelinux.com 587")
 314       (gcc "nnimap+sfl:Sent")
 315       (eval (setq-local b/sfl-p t))))))
 316 ;; hooks
 317 ;; (with-eval-after-load 'gnus
 318 ;;   (add-hook 'gnus-message-setup-hook
 319 ;;             (lambda ()
 320 ;;               (unless (or (mml-secure-is-encrypted-p)
 321 ;;                           b/sfl-p)
 322 ;;                 (mml-secure-message-sign)))))
 323
 324 (with-eval-after-load 'gnus-topic
 325   (csetq
 326    gnus-topic-line-format "%i[ %A: %(%{%n%}%) ]%v\n"
 327    gnus-topic-topology '(("Gnus" visible nil nil)
 328                          (("misc" visible nil nil))
 329                          (("sfl" visible nil nil))
 330                          (("csc" visible nil nil))
 331                          (("uwaterloo" visible nil nil))
 332                          (("shemshak" visible nil nil))
 333                          (("gnu" visible nil nil))
 334                          (("old-gnu" visible nil nil)))))
 335
 336 (with-eval-after-load 'gnus-agent
 337   (csetq gnus-agent-synchronize-flags 'ask))
 338
 339 (with-eval-after-load 'gnus-group
 340   (csetq gnus-permanently-visible-groups "\\(:INBOX$\\|:gnu$\\)"))
 341
 342 (with-eval-after-load 'gnus-win
 343   (csetq gnus-use-full-window nil))
 344
 345 (with-eval-after-load 'gnus-dired
 346   (add-hook 'dired-mode-hook 'gnus-dired-mode))
 347
 348 (with-eval-after-load 'mm-decode
 349   (csetq mm-discouraged-alternatives '("text/html" "text/richtext")
 350          mm-decrypt-option 'known
 351          mm-verify-option 'known))
 352
 353 (with-eval-after-load 'mm-uu
 354   (when (version< "27" emacs-version)
 355     (set-face-attribute 'mm-uu-extract nil :extend t))
 356   (when (version< emacs-version "27")
 357     (csetq mm-uu-diff-groups-regexp ".")))
 358
 359 (with-eval-after-load 'mml-sec
 360   (csetq mml-secure-openpgp-encrypt-to-self t
 361          mml-secure-openpgp-sign-with-sender t))
 362
 363 (provide 'bandali-gnus)
 364 ;;; bandali-gnus.el ends here