jao-custom-gnus.el 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801
  1. ;; gnus configuration -*- lexical-binding: t -*-
  2. ;;; features
  3. (defvar jao-gnus-use-local-imap nil)
  4. (defvar jao-gnus-use-leafnode nil)
  5. (defvar jao-gnus-use-gandi-imap nil)
  6. (defvar jao-gnus-use-pm-imap nil)
  7. (defvar jao-gnus-use-gmane nil)
  8. (defvar jao-gnus-use-nnml nil)
  9. (defvar jao-gnus-use-maildirs nil)
  10. (defvar jao-notmuch-enabled nil)
  11. (defvar jao-gnus-nnml-group-params nil)
  12. ;;; directories
  13. (defun jao-gnus-dir (dir)
  14. (expand-file-name dir gnus-home-directory))
  15. (setq smtpmail-queue-dir (jao-gnus-dir "Mail/queued-mail/"))
  16. (setq mail-source-directory (jao-gnus-dir "Mail/")
  17. message-directory (jao-gnus-dir "Mail/"))
  18. (setq gnus-default-directory (expand-file-name "~")
  19. gnus-startup-file (jao-gnus-dir "newsrc")
  20. gnus-agent-directory (jao-gnus-dir "News/agent")
  21. gnus-home-score-file (jao-gnus-dir "scores")
  22. gnus-article-save-directory (jao-gnus-dir "saved/")
  23. nntp-authinfo-file (jao-gnus-dir "authinfo")
  24. nnmail-message-id-cache-file (jao-gnus-dir "nnmail-cache")
  25. nndraft-directory (jao-gnus-dir "drafts")
  26. nnrss-directory (jao-gnus-dir "rss"))
  27. ;;; looks
  28. ;;;; verbosity
  29. (setq gnus-verbose 4)
  30. ;;;; geometry
  31. (defvar jao-gnus-use-three-panes t)
  32. (defvar jao-gnus-groups-width 50)
  33. (defvar jao-gnus-wide-width 190)
  34. (setq gnus-use-trees nil
  35. gnus-generate-tree-function 'gnus-generate-horizontal-tree
  36. gnus-tree-minimize-window nil)
  37. (when jao-gnus-use-three-panes
  38. ;; (dolist (m '(calendar-mode org-agenda-mode gnus-group-mode))
  39. ;; (add-to-list 'display-buffer-alist `((major-mode . ,m) (dedicated t))))
  40. (setq calendar-left-margin 6)
  41. (let ((side-bar '(vertical 1.0
  42. ("inbox.org" 0.4)
  43. ("*Org Agenda*" 1.0)
  44. ("*Calendar*" 8)))
  45. (wide-len jao-gnus-wide-width)
  46. (groups-len jao-gnus-groups-width)
  47. (summary-len (- jao-gnus-wide-width jao-gnus-groups-width)))
  48. (gnus-add-configuration
  49. `(article
  50. (horizontal 1.0
  51. (vertical ,groups-len (group 1.0))
  52. (vertical ,summary-len
  53. (summary 0.25 point)
  54. (article 1.0))
  55. ,side-bar)))
  56. (gnus-add-configuration
  57. `(group (horizontal 1.0 (group ,wide-len point) ,side-bar)))
  58. (gnus-add-configuration
  59. `(message (horizontal 1.0 (message ,wide-len point) ,side-bar)))
  60. (gnus-add-configuration
  61. `(reply-yank (horizontal 1.0 (message ,wide-len point) ,side-bar)))
  62. (gnus-add-configuration
  63. `(summary
  64. (horizontal 1.0
  65. (vertical ,groups-len (group 1.0))
  66. (vertical ,summary-len (summary 1.0 point))
  67. ,side-bar)))
  68. (gnus-add-configuration
  69. `(reply
  70. (horizontal 1.0
  71. (message ,(- wide-len 100) point)
  72. (article 100)
  73. ,side-bar)))))
  74. ;;;; no blue icon
  75. (advice-add 'gnus-mode-line-buffer-identification :override #'identity)
  76. (setq gnus-mode-line-image-cache nil)
  77. ;;; search
  78. (setq gnus-search-use-parsed-queries nil
  79. gnus-search-notmuch-raw-queries-p nil
  80. gnus-permanently-visible-groups "^nnselect:.*"
  81. gnus-search-ignored-newsgroups "nndraft.*\\|nnselect.*")
  82. (with-eval-after-load "gnus-search"
  83. (defclass gnus-search-recoll (gnus-search-indexed)
  84. ((separator :type string :initform ".")
  85. (program :initform "recoll")
  86. (raw-queries-p :initform t)))
  87. (cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-recoll))
  88. (prog1 (and (looking-at "^file://\\(.+\\)$") (list (match-string 1) 100))
  89. (forward-line 1)))
  90. (cl-defmethod gnus-search-transform-expression ((_engine gnus-search-recoll)
  91. expr)
  92. expr)
  93. (cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-recoll)
  94. (qstring string)
  95. query
  96. &optional groups)
  97. (let* ((subdir (slot-value engine 'remove-prefix))
  98. (sep (slot-value engine 'separator))
  99. (gdirs (mapcar (lambda (g)
  100. (let ((g (gnus-group-short-name g)))
  101. (replace-regexp-in-string "\\." sep g)))
  102. (or groups
  103. (and (not (string= "" subdir)) (list subdir)))))
  104. (dirsq (and gdirs
  105. (concat "("
  106. (mapconcat (lambda (d) (format "dir:%s" d))
  107. gdirs " OR ")
  108. ")")))
  109. (qstring (if (string-prefix-p "id:" qstring)
  110. (replace-regexp-in-string "<\\|>" "\"" qstring)
  111. qstring))
  112. (qstring (if (cdr (assoc 'thread query))
  113. (concat qstring " OR "
  114. (replace-regexp-in-string "id:\"" "ref:\""
  115. qstring))
  116. qstring))
  117. (qstring (replace-regexp-in-string " or " " OR " qstring))
  118. (qstring (replace-regexp-in-string " and " " AND " qstring))
  119. (q (format "mime:message %s (%s)" dirsq qstring)))
  120. ;; (message "query is: %s -- %S" q query)
  121. `("-b" "-t" "-q" ,q))))
  122. ;; (add-to-list 'gnus-parameters '("^nnselect:.*" (nnselect-rescan . t)))
  123. ;;; news
  124. (defvar jao-gnus-leafnode-spool "/var/spool/news/")
  125. (setq gnus-select-method
  126. (cond
  127. (jao-gnus-use-leafnode
  128. `(nntp "localhost"
  129. (gnus-search-engine gnus-search-recoll
  130. (remove-prefix ,jao-gnus-leafnode-spool)
  131. (separator "/"))))
  132. (jao-gnus-use-gmane '(nntp "news.gmane.io"))
  133. (t '(nnnil ""))))
  134. (setq gnus-secondary-select-methods '())
  135. (setq nnheader-read-timeout 0.02
  136. gnus-save-newsrc-file nil) ; .newsrc only needed by other newsreaders
  137. ;; leafnode articles group parameters
  138. (defvar jao-gnus-image-groups '("xkcd"))
  139. (defvar jao-gnus-leafnode-group-params
  140. `((,(format "gwene\\..*%s.*" (regexp-opt jao-gnus-image-groups))
  141. (mm-html-inhibit-images nil)
  142. (mm-html-blocked-images nil))
  143. ("\\(gmane\\|gwene\\)\\..*"
  144. (jao-gnus--archiving-group "nnml:feeds.trove")
  145. (posting-style (address "jao@gnu.org")))))
  146. (when jao-gnus-use-leafnode
  147. (dolist (p jao-gnus-leafnode-group-params)
  148. (add-to-list 'gnus-parameters p t)))
  149. ;;; mail
  150. ;;;; nnmail
  151. (setq nnmail-treat-duplicates 'delete
  152. nnmail-scan-directory-mail-source-once nil
  153. nnmail-cache-accepted-message-ids t
  154. nnmail-message-id-cache-length 100000
  155. nnmail-split-fancy-with-parent-ignore-groups nil
  156. nnmail-use-long-file-names t
  157. nnmail-crosspost t
  158. nnmail-resplit-incoming t
  159. nnmail-mail-splitting-decodes t
  160. nnmail-split-methods 'nnmail-split-fancy)
  161. ;;;; nnml
  162. (setq gnus-message-archive-group nil
  163. nnml-get-new-mail t
  164. nnml-directory message-directory)
  165. (setq mail-sources
  166. (let* ((pwd (auth-source-pick-first-password :host "proton-bridge"))
  167. (mds (mapcar (lambda (f)
  168. `(maildir :path ,(expand-file-name f "~/var/mail/")))
  169. '("local/" "feeds/")))
  170. (ims (mapcar (lambda (b)
  171. `(imap :server "127.0.0.1" :port 1143
  172. :user "mail@jao.io" :password ,pwd
  173. :stream starttls :predicate "1:*"
  174. :fetchflag "\\Deleted \\Seen"
  175. :mailbox ,(concat "Labels/#" b)))
  176. '("inbox" "drivel" "hacking" "bills"
  177. "bigml" "prog" "words"))))
  178. (append mds ims)))
  179. (when jao-gnus-use-nnml
  180. (add-to-list
  181. 'gnus-secondary-select-methods
  182. ;; `(nnml "" (gnus-search-engine gnus-search-recoll
  183. ;; (remove-prefix ,(jao-gnus-dir "Mail/"))))
  184. `(nnml "" (gnus-search-engine gnus-search-notmuch
  185. (remove-prefix "/home/jao/var/mail/gnus")))))
  186. (when jao-gnus-use-nnml
  187. (dolist (p jao-gnus-nnml-group-params)
  188. (add-to-list 'gnus-parameters p t)))
  189. ;;;; imap
  190. (setq nnimap-quirks nil)
  191. (when jao-gnus-use-local-imap
  192. (add-to-list 'gnus-secondary-select-methods
  193. `(nnimap "" (nnimap-address "localhost"))))
  194. (when jao-gnus-use-pm-imap
  195. (add-to-list 'gnus-secondary-select-methods
  196. '(nnimap "pm"
  197. (nnimap-address "127.0.0.1")
  198. (nnimap-stream network)
  199. (nnimap-server-port 1143))))
  200. (when jao-gnus-use-gandi-imap
  201. (add-to-list 'gnus-secondary-select-methods
  202. '(nnimap "gandi" (nnimap-address "mail.gandi.net"))))
  203. ;;; groups
  204. (setq gnus-group-line-format
  205. " %m%S%p%3y%P%* %~(pad-right 30)G %B\n"
  206. ;; " %m%S%p%P:%~(pad-right 35)c %3y %B\n"
  207. ;; " %m%S%p%3y%P%* %~(pad-right 30)C %B\n"
  208. gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
  209. gnus-group-uncollapsed-levels 2
  210. gnus-auto-select-subject 'unread
  211. gnus-large-newsgroup 2000)
  212. (add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp)
  213. (add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
  214. ;;; rss
  215. (setq nnrss-use-local t ;; M-x nnrss-generate-download-script
  216. nnrss-ignore-article-fields '(category
  217. dc:creator
  218. dc:date
  219. enclosure
  220. guid
  221. link
  222. media:content
  223. media:thumbnail
  224. media:title
  225. post-id
  226. pubDate
  227. slash:comments))
  228. (add-to-list 'gnus-parameters `(,(format "nnrss:%s.*"
  229. (regexp-opt jao-gnus-image-groups t))
  230. (mm-html-inhibit-images nil)
  231. (mm-html-blocked-images nil)))
  232. ;;; summary
  233. ;;;; configuration
  234. (setq gnus-summary-ignore-duplicates t
  235. gnus-suppress-duplicates t
  236. ;; gnus-summary-ignored-from-addresses jao-mails-regexp
  237. gnus-process-mark-toggle t
  238. gnus-auto-select-next 'almost-quietly)
  239. ;;;; threading
  240. (setq gnus-face-1 'jao-gnus-face-tree
  241. gnus-show-threads t
  242. gnus-thread-hide-subtree t
  243. gnus-build-sparse-threads nil
  244. gnus-refer-thread-use-search t
  245. gnus-summary-make-false-root 'adopt
  246. gnus-summary-gather-subject-limit nil ;; 120
  247. gnus-summary-thread-gathering-function #'gnus-gather-threads-by-subject
  248. gnus-sort-gathered-threads-function 'gnus-thread-sort-by-date
  249. gnus-thread-sort-functions '(gnus-thread-sort-by-date))
  250. (defun jao-fix-protonmail-references (header)
  251. (let ((references (mail-header-references header)))
  252. (setf (mail-header-references header)
  253. (mapconcat #'(lambda (x)
  254. (if (string-match "protonmail.internalid" x) "" x))
  255. (gnus-split-references references)
  256. " "))
  257. header))
  258. (setq gnus-alter-header-function 'jao-fix-protonmail-references)
  259. ;;;; search on enter nnselect
  260. (defun jao-gnus--maybe-reselect (&rest _i)
  261. (when (string-match-p "^nnselect" (or (gnus-group-name-at-point) ""))
  262. (save-excursion (gnus-group-get-new-news-this-group))))
  263. (advice-add 'gnus-group-select-group :before #'jao-gnus--maybe-reselect)
  264. ;;;; summary line
  265. (setq gnus-not-empty-thread-mark ?↓) ; ↓) ?·
  266. (setq jao-gnus--summary-line-fmt
  267. (concat "%%U %%*%%R %%uj "
  268. "[ %%~(max-right 23)~(pad-right 23)uf "
  269. " %%I%%~(pad-left 2)t ] %%s"
  270. "%%-%s="
  271. "%%~(max-right 8)~(pad-left 8)&user-date;"
  272. "\n"))
  273. (defun jao-gnus--set-summary-line (&optional w)
  274. (let* ((d (if jao-gnus-use-three-panes (+ jao-gnus-groups-width 11) 12))
  275. (w (- (or w (window-width)) d)))
  276. (setq gnus-summary-line-format (format jao-gnus--summary-line-fmt w))))
  277. (add-hook 'gnus-select-group-hook 'jao-gnus--set-summary-line)
  278. ;; (jao-gnus--set-summary-line 187)
  279. (add-to-list 'nnmail-extra-headers 'Cc)
  280. (add-to-list 'nnmail-extra-headers 'BCc)
  281. (use-package gnus-sum
  282. :config
  283. (add-to-list 'gnus-extra-headers 'Cc)
  284. (add-to-list 'gnus-extra-headers 'BCc))
  285. (defun gnus-user-format-function-j (headers)
  286. (let ((to (gnus-extra-header 'To headers)))
  287. (if (string-match jao-mails-regexp to)
  288. (if (string-match "," to) "¬" "»") ;; "~" "=")
  289. (if (or (string-match jao-mails-regexp
  290. (gnus-extra-header 'Cc headers))
  291. (string-match jao-mails-regexp
  292. (gnus-extra-header 'BCc headers)))
  293. "¬" ;; "~"
  294. " "))))
  295. (defconst jao-gnus--news-rx
  296. (concat (regexp-opt '("ElDiaro.es "
  297. "ElDiario.es - ElDiario.es: "
  298. "The Guardian: "
  299. "Aeon | a world of ideas: "
  300. "Planet Debian: "))
  301. "\\|The Conversation – Articles (.+): "
  302. "\\|unofficial mirror of [^:]+: "
  303. "\\|[gq].+ updates on arXiv.org: "))
  304. (defun gnus-user-format-function-f (headers)
  305. (let* ((from (gnus-header-from headers))
  306. (from (gnus-summary-extract-address-component from))
  307. (from (replace-regexp-in-string jao-gnus--news-rx "" from)))
  308. from))
  309. (setq gnus-user-date-format-alist
  310. '(((gnus-seconds-today) . "%H:%M")
  311. ((+ 86400 (gnus-seconds-today)) . "'%H:%M")
  312. ;; (604800 . "%a %H:%M") ;; that's one week
  313. ((gnus-seconds-month) . "%a %d")
  314. ((gnus-seconds-year) . "%b %d")
  315. (t . "%b '%y")))
  316. ;;;; moving messages around
  317. (defvar-local jao-gnus--spam-group nil)
  318. (defvar-local jao-gnus--archiving-group nil)
  319. (defvar-local jao-gnus--archive-as-copy-p nil)
  320. (defvar jao-gnus--last-move nil)
  321. (defun jao-gnus-move-hook (a headers c to d)
  322. (setq jao-gnus--last-move (cons to (mail-header-id headers))))
  323. (defun jao-gnus-goto-last-moved ()
  324. (interactive)
  325. (when jao-gnus--last-move
  326. (when (eq major-mode 'gnus-summary-mode) (gnus-summary-exit))
  327. (gnus-group-goto-group (car jao-gnus--last-move))
  328. (gnus-group-select-group)
  329. (gnus-summary-goto-article (cdr jao-gnus--last-move) nil t)))
  330. (add-hook 'gnus-summary-article-move-hook 'jao-gnus-move-hook)
  331. (defun jao-gnus-archive (follow)
  332. (interactive "P")
  333. (if jao-gnus--archiving-group
  334. (progn
  335. (if (or jao-gnus--archive-as-copy-p
  336. (not (gnus-check-backend-function
  337. 'request-move-article gnus-newsgroup-name)))
  338. (gnus-summary-copy-article nil jao-gnus--archiving-group)
  339. (gnus-summary-move-article nil jao-gnus--archiving-group))
  340. (when follow (jao-gnus-goto-last-moved)))
  341. (gnus-summary-mark-as-read)
  342. (gnus-summary-delete-article)))
  343. (defun jao-gnus-archive-tickingly ()
  344. (interactive)
  345. (gnus-summary-tick-article)
  346. (jao-gnus-archive)
  347. (when jao-gnus--archive-as-copy-p
  348. (gnus-summary-mark-as-read)))
  349. (defun jao-gnus-show-tickled ()
  350. (interactive)
  351. (gnus-summary-limit-to-marks "!"))
  352. (make-variable-buffer-local
  353. (defvar jao-gnus--trash-group nil))
  354. (defun jao-gnus-trash ()
  355. (interactive)
  356. (gnus-summary-mark-as-read)
  357. (if jao-gnus--trash-group
  358. (gnus-summary-move-article nil jao-gnus--trash-group)
  359. (gnus-summary-delete-article)))
  360. (defun jao-gnus-move-to-spam ()
  361. (interactive)
  362. (gnus-summary-mark-as-read)
  363. (gnus-summary-move-article nil jao-gnus--spam-group))
  364. (define-key gnus-summary-mode-map "Ba" 'jao-gnus-archive)
  365. (define-key gnus-summary-mode-map "BA" 'jao-gnus-archive-tickingly)
  366. (define-key gnus-summary-mode-map "Bl" 'jao-gnus-goto-last-moved)
  367. (define-key gnus-summary-mode-map (kbd "B DEL") 'jao-gnus-trash)
  368. (define-key gnus-summary-mode-map (kbd "B <backspace>") 'jao-gnus-trash)
  369. (define-key gnus-summary-mode-map "Bs" 'jao-gnus-move-to-spam)
  370. (define-key gnus-summary-mode-map "/!" 'jao-gnus-show-tickled)
  371. (define-key gnus-summary-mode-map [f7] 'gnus-summary-force-verify-and-decrypt)
  372. ;;;; saving emails
  373. (setq gnus-default-article-saver 'gnus-summary-save-article-mail)
  374. (defvar jao-gnus-file-save-directory (expand-file-name "~/tmp"))
  375. (defun jao-gnus-file-save (newsgroup headers &optional last-file)
  376. (expand-file-name (format "%s.eml" (mail-header-subject headers))
  377. jao-gnus-file-save-directory))
  378. (setq gnus-mail-save-name 'jao-gnus-file-save)
  379. ;;;; arXiv capture
  380. (use-package org-capture
  381. :config
  382. (add-to-list 'org-capture-templates
  383. '("x" "arXiv" entry (file "notes/physics/arxiv.org")
  384. "* %(jao-gnus-subject)\n\n %i\n\n %(jao-gnus-org-url)"
  385. :immediate-finish t)
  386. t)
  387. (add-to-list 'org-capture-templates
  388. '("X" "arXiv" entry (file "notes/physics/arxiv.org")
  389. "* %(jao-gnus-subject)\n\n%(jao-gnus-org-paragraph \"%i\")"
  390. :immediate-finish t)
  391. t)
  392. (org-capture-upgrade-templates org-capture-templates))
  393. (defvar jao-gnus-org-url nil)
  394. (defun jao-gnus-org-url () jao-gnus-org-url)
  395. (defun jao-gnus-org-paragraph (x)
  396. (with-temp-buffer
  397. (insert " " (string-trim (or x "")) "\n ")
  398. (goto-char 0)
  399. (fill-paragraph)
  400. (goto-char (point-max))
  401. (open-rectangle 0 (point))
  402. (concat (buffer-string) "\n " (or jao-gnus-org-url ""))))
  403. (defvar jao-gnus-subject nil)
  404. (defun jao-gnus-subject () jao-gnus-subject)
  405. (defun jao-gnus-arXiv-capture ()
  406. (interactive)
  407. (unless (derived-mode-p '(gnus-summary-mode)) (gnus-article-show-summary))
  408. (setq jao-gnus-subject (gnus-summary-article-subject))
  409. (gnus-summary-select-article-buffer)
  410. (gnus-article-goto-part 0)
  411. (let ((transient-mark-mode t))
  412. (set-mark (point))
  413. (forward-paragraph)
  414. (or (and (save-excursion
  415. (when (re-search-forward "^Link" nil t)
  416. (beginning-of-line)
  417. (setq jao-gnus-org-url (org-eww-url-below-point))))
  418. (org-capture nil "X"))
  419. (and (save-excursion
  420. (when (re-search-forward "^URL: " nil t)
  421. (setq jao-gnus-org-url (thing-at-point-url-at-point))))
  422. (org-capture nil "x"))))
  423. (gnus-article-show-summary))
  424. ;;; article
  425. ;;;; config, headers
  426. (setq mail-source-delete-incoming t)
  427. (setq gnus-gcc-mark-as-read t)
  428. (setq gnus-treat-display-smileys nil)
  429. (setq gnus-treat-fill-long-lines nil)
  430. (setq gnus-treat-fill-article 120)
  431. (setq gnus-treat-fold-headers nil)
  432. (setq gnus-treat-strip-leading-blank-lines t)
  433. (setq gnus-article-auto-eval-lisp-snippets nil)
  434. (setq gnus-posting-styles '((".*" (name "Jose A. Ortega Ruiz"))))
  435. (setq gnus-single-article-buffer nil)
  436. (setq gnus-article-update-lapsed-header 60)
  437. (setq gnus-article-update-date-headers 60)
  438. (with-eval-after-load "gnus-art"
  439. (setq gnus-visible-headers
  440. (concat
  441. gnus-visible-headers
  442. "\\|^List-[iI][Dd]:\\|^X-Newsreader:\\|^X-Mailer:"
  443. "\\|^User-Agent:\\|^X-User-Agent:\\|^X-RSS-Feed:")))
  444. ;;;; html and images
  445. (setq gnus-button-url 'browse-url-generic
  446. gnus-inhibit-images t
  447. mm-discouraged-alternatives nil ;; '("text/html" "text/richtext")
  448. mm-inline-large-images 'resize)
  449. (defvar-local jao-gnus--images nil)
  450. (defun jao-gnus--init-images ()
  451. (with-current-buffer gnus-article-buffer
  452. (setq jao-gnus--images nil)))
  453. (add-hook 'gnus-select-article-hook #'jao-gnus--init-images)
  454. (defun jao-gnus-browse-html ()
  455. (interactive)
  456. (let ((browse-url-browser-function jao-browse-url-external-function)
  457. (browse-url-handlers nil)
  458. (browse-url-default-handlers nil))
  459. (gnus-article-browse-html-article)))
  460. (defun jao-gnus-show-images ()
  461. (interactive)
  462. (if window-system
  463. (save-window-excursion
  464. (gnus-summary-select-article-buffer)
  465. (save-excursion
  466. (if (and jao-afio-use-w3m (fboundp 'w3m-toggle-inline-images))
  467. (w3m-toggle-inline-images)
  468. (setq jao-gnus--images (not jao-gnus--images))
  469. (if jao-gnus--images
  470. (gnus-article-show-images)
  471. (gnus-article-remove-images)))))
  472. (jao-gnus-browse-html)))
  473. ;;;; format from:
  474. (defvar jao-gnus--from-rx
  475. (concat "From: \\\"?\\( *" jao-gnus--news-rx "\\)"))
  476. (defun jao-gnus-format-from ()
  477. (save-excursion
  478. (goto-char (point-min))
  479. (when (re-search-forward jao-gnus--from-rx nil t)
  480. (replace-match "" nil nil nil 1))))
  481. (add-hook 'gnus-part-display-hook 'jao-gnus-format-from)
  482. ;;;; follow links and enclosures
  483. (defun jao-gnus-follow-link (&optional external)
  484. (interactive "P")
  485. (when (eq major-mode 'gnus-summary-mode)
  486. (gnus-summary-select-article-buffer))
  487. (save-excursion
  488. (goto-char (point-min))
  489. (when (or (search-forward-regexp "^Via: h" nil t)
  490. (search-forward-regexp "^URL:[\n ]h" nil t)
  491. (and (search-forward-regexp "^Link$" nil t)
  492. (not (beginning-of-line))))
  493. (cond (external (jao-browse-with-external-browser))
  494. ((featurep 'jao-custom-eww) (eww (jao-url-around-point)))
  495. (t (browse-url (jao-url-around-point)))))))
  496. (defun jao-gnus-from-eww (keep-eww-buffer)
  497. (interactive "P")
  498. (unless keep-eww-buffer (jao-eww-close))
  499. (jao-afio-goto-mail)
  500. (gnus-article-show-summary))
  501. (with-eval-after-load 'eww
  502. (define-key eww-mode-map (kbd "h") #'jao-gnus-from-eww))
  503. (defun jao-gnus-open-enclosure ()
  504. (interactive)
  505. (save-window-excursion
  506. (gnus-summary-select-article-buffer)
  507. (save-excursion
  508. (goto-char (point-min))
  509. (let ((offset (or (and (search-forward-regexp "^Enclosure: ?" nil t) 2)
  510. (and (search-forward-regexp "^Enclosure$" nil t) -2))))
  511. (when offset (forward-char offset))
  512. (if-let ((url (jao-url-around-point)))
  513. (jao-mpc-add-or-play-url url)
  514. (error "No enclosure found"))))))
  515. ;;;; delayed messages
  516. (require 'gnus-util)
  517. (gnus-delay-initialize)
  518. (setq gnus-delay-default-delay "3h")
  519. (eval-after-load "message"
  520. '(setq message-draft-headers (remove 'Date message-draft-headers)))
  521. ;;; daemon and exit
  522. (setq gnus-interactive-exit t)
  523. (defun jao-quit-gnus () (gnus-group-exit) t)
  524. (add-hook 'kill-emacs-query-functions #'jao-quit-gnus)
  525. ;; daemon config
  526. (setq mail-user-agent 'gnus-user-agent)
  527. (setq gnus-asynchronous t)
  528. (setq gnus-use-article-prefetch nil)
  529. (setq gnus-save-killed-list nil)
  530. (setq gnus-check-new-newsgroups nil)
  531. (require 'gnus-demon)
  532. (defun jao-gnus--scan ()
  533. (let ((inhibit-message t))
  534. (gnus-demon-scan-news)
  535. (jao-gnus--notify)))
  536. (defun jao-gnus-add-demon ()
  537. (interactive)
  538. (gnus-demon-add-handler 'jao-gnus--scan 5 1))
  539. (jao-gnus-add-demon)
  540. (gnus-demon-init)
  541. ;; this is, in theory, not needed; but at some point in the way to emacs
  542. ;; version 31 this idle timers have ceased to work after a sleep/awake cycle
  543. (add-to-list 'jao-sleep-awake-functions #'jao-gnus-add-demon)
  544. ;;; add-ons
  545. ;;;; notifications
  546. ;;;;; minibuffer
  547. (defvar jao-gnus-tracked-groups
  548. (let ((feeds (thread-first
  549. (directory-files mail-source-directory nil "feeds\\.[^e]")
  550. (seq-difference '("feeds.trove")))))
  551. `(("nnml:bigml\\.inbox" "B" jao-themes-f00)
  552. ("nnml:bigml\\.alba" "A" jao-themes-f00)
  553. ("nnml:bigml\\.ryou" "R" jao-themes-f00)
  554. ("nnml:bigml\\.bugs" "b" jao-themes-error)
  555. ("nnml:bigml\\.support" "S" default)
  556. ("nnml:bigml\\.[^aibsr]" "W" jao-themes-dimm)
  557. ("nnml:jao\\.\\(inbox\\|trove\\)" "I" jao-themes-f01)
  558. ("nnml:jao.hacking" "H" jao-themes-dimm)
  559. ("nnml:jao.write" "W" jao-themes-warning)
  560. ("nnml:jao.[^ithw]" "J" jao-themes-dimm)
  561. (,(format "^nnml:%s" (regexp-opt feeds)) "F" jao-themes-dimm)
  562. ("feeds\\.e" "E" jao-themes-dimm)
  563. ("nnml:local" "l" jao-themes-dimm)
  564. ("nnrss:.*" "R" jao-themes-dimm)
  565. ("^\\(gwene\\|gmane\\)\\." "N" jao-themes-dimm))))
  566. (defun jao-gnus--unread-counts ()
  567. (seq-reduce (lambda (r g)
  568. (let ((n (gnus-group-unread (car g))))
  569. (if (and (numberp n) (> n 0)) (cons (cons (car g) n) r) r)))
  570. gnus-newsrc-alist
  571. ()))
  572. (defun jao-gnus--unread-label (counts rx label face)
  573. (let ((n (seq-reduce (lambda (n c)
  574. (if (string-match-p rx (car c)) (+ n (cdr c)) n))
  575. counts
  576. 0)))
  577. (when (> n 0) `(:propertize ,(format "%s%d " label n) face ,face))))
  578. (defvar jao-gnus--notify-strs ())
  579. (defun jao-gnus--notify-strs ()
  580. (let ((counts (jao-gnus--unread-counts)))
  581. (seq-filter #'identity
  582. (seq-map (lambda (args)
  583. (apply 'jao-gnus--unread-label counts args))
  584. jao-gnus-tracked-groups))))
  585. (defun jao-gnus--notify ()
  586. (setq jao-gnus--notify-strs (jao-gnus--notify-strs))
  587. (jao-minibuffer-refresh))
  588. (with-eval-after-load "jao-minibuffer"
  589. (jao-minibuffer-add-variable 'jao-gnus--notify-strs -20))
  590. (add-hook 'gnus-started-hook #'jao-gnus--notify)
  591. ;; (add-hook 'gnus-summary-exit-hook #'jao-gnus--notify)
  592. (add-hook 'gnus-after-getting-new-news-hook #'jao-gnus--notify)
  593. ;;;;; agenda and other updates on summary exit
  594. (let ((exit-count 0))
  595. (defun jao-gnus--on-summary-exit ()
  596. (when (> (setq exit-count (+ 1 exit-count)) 20)
  597. (setq exit-count 0)
  598. (jao-org-agenda))
  599. (jao-gnus--notify)))
  600. (add-hook 'gnus-summary-exit-hook #'jao-gnus--on-summary-exit)
  601. (add-hook 'gnus-exit-group-hook #'jao-gnus--notify)
  602. ;;;; open mail file in gnus
  603. (defun jao-gnus-file-to-group (file &optional maildir newsdir m-server n-server)
  604. "Compute the Gnus group name from the given file name.
  605. IN: /home/jao/.emacs.d/gnus/Mail/jao.trove/32, /home/jao/.emacs.d/gnus/Mail/
  606. OUT: nnml:jao.trove "
  607. (let* ((maildir (or maildir message-directory))
  608. (newsdir (or newsdir jao-gnus-leafnode-spool))
  609. (m-server (or m-server "nnml"))
  610. (n-server (or n-server "nntp+localhost"))
  611. (nntp (and newsdir (string-match-p newsdir file)))
  612. (g (directory-file-name (file-name-directory file)))
  613. (g (replace-regexp-in-string (file-name-as-directory maildir) "" g))
  614. (g (replace-regexp-in-string (file-name-as-directory newsdir) "" g))
  615. (g (cond (nntp (concat n-server ":" g))
  616. ((file-name-directory g)
  617. (replace-regexp-in-string "^\\([^/]+\\)/"
  618. (concat m-server ":\\1/")
  619. (file-name-directory g) t))
  620. (t (concat m-server ":" g))))
  621. (g (replace-regexp-in-string "/" "." g))
  622. (g (replace-regexp-in-string "[/.]$" "" g)))
  623. (cond ((string-match ":$" g) (concat g "inbox"))
  624. (nntp g)
  625. (t (replace-regexp-in-string ":\\." ":" g)))))
  626. (defun jao-gnus-goto-file (filename &optional _page)
  627. (let ((group (jao-gnus-file-to-group filename))
  628. (id (file-name-nondirectory filename)))
  629. (if (and group id)
  630. (org-gnus-follow-link group id)
  631. (message "Couldn't get relevant info for switching to Gnus."))))
  632. ;;;; afio
  633. (defun jao-gnus--on-afio-switch ()
  634. (when (derived-mode-p 'gnus-group-mode)
  635. (let ((no (or (gnus-group-unread (gnus-group-group-name)) 0)))
  636. (unless (> no 0) (gnus-group-first-unread-group)))))
  637. (add-hook 'jao-afio-switch-hook #'jao-gnus--on-afio-switch)
  638. (defun jao-gnus-refresh-workspace ()
  639. (interactive)
  640. (save-window-excursion (calendar) (jao-org-agenda)))
  641. ;;;; gnus-icalendar
  642. (require 'ol-gnus)
  643. (use-package gnus-icalendar
  644. :demand t
  645. :init (setq gnus-icalendar-org-capture-file
  646. (expand-file-name "inbox.org" org-directory)
  647. gnus-icalendar-org-capture-headline '("Appointments"))
  648. :config (gnus-icalendar-org-setup))
  649. ;;;; bbdb
  650. (with-eval-after-load "bbdb"
  651. ;; (bbdb-initialize 'gnus 'message 'pgp)
  652. (bbdb-mua-auto-update-init 'gnus)
  653. (with-eval-after-load "gnus-sum"
  654. (define-key gnus-summary-mode-map ":" 'bbdb-mua-annotate-sender)
  655. (define-key gnus-summary-mode-map ";" 'bbdb-mua-annotate-recipients)))
  656. ;;;; randomsig
  657. (with-eval-after-load "randomsig"
  658. (with-eval-after-load "gnus-sum"
  659. (define-key gnus-summary-save-map "-" 'gnus/randomsig-summary-read-sig)))
  660. ;;;; recoll
  661. (unless jao-notmuch-enabled
  662. (with-eval-after-load "org"
  663. (org-link-set-parameters "message" :follow #'jao-gnus-goto-file))
  664. (with-eval-after-load "consult-recoll"
  665. (add-to-list 'consult-recoll-open-fns
  666. '("message/rfc822" . jao-gnus-goto-file))))
  667. ;;;; notmuch
  668. (use-package jao-notmuch-gnus
  669. :demand t)
  670. (jao-load-path "consult-notmuch")
  671. (use-package consult-notmuch
  672. :bind (:map gnus-group-mode-map ("S" . #'jao-gnus-consult-notmuch)))
  673. ;;; keyboard shortcuts
  674. (define-key gnus-article-mode-map "i" 'jao-gnus-show-images)
  675. (define-key gnus-summary-mode-map "i" 'jao-gnus-show-images)
  676. (define-key gnus-article-mode-map "\M-g" 'jao-gnus-follow-link)
  677. (define-key gnus-summary-mode-map "\M-g" 'jao-gnus-follow-link)
  678. (define-key gnus-summary-mode-map "v" 'scroll-other-window)
  679. (define-key gnus-summary-mode-map "V" 'scroll-other-window-down)
  680. (define-key gnus-summary-mode-map "X" 'jao-gnus-arXiv-capture)
  681. (define-key gnus-summary-mode-map "e" 'jao-gnus-open-enclosure)
  682. (define-key gnus-summary-mode-map "\C-l" nil)
  683. (define-key gnus-group-mode-map "a" 'jao-gnus-refresh-workspace)