path: root/gnus-conf.el

;;; gnus-conf.el --- My Gnus configurations -*- lexical-binding: t; -*-

;; Copyright (C) 2021  Durand

;; Author: Durand;;; gnus-conf.el --- My Gnus configurations -*- lexical-binding: t; -*- <durand@jsdurand.xyz>
;; Keywords: mail, comm, hardware

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

;; This file configures my gnus setup.

;;; Code:

;;; Select methods

(require 'message)
(require 'gnus)
(require 'epa)
(epa-file-enable)

(setq gnus-select-method '(nnnil ""))
(setq gnus-secondary-select-methods
      '((nntp "news.gmane.io")
        (nnmaildir "gmail" (directory "~/.nnmaildir/gmail"))
        (nnmaildir "durand" (directory "~/.nnmaildir/mymail"))
        ;; (nndiary "diary")
        ;; (nnmaildir "sent" (directory "~/.nnmaildir"))
        ;; (nnimap "LocalMail"
        ;;  (nnimap-address "localhost")
        ;;  (nnimap-stream network)
        ;;  (nnimap-server-port 143))
        ))

;;; Levels of groups

(setq gnus-level-subscribed 5)
(setq gnus-level-unsubscribed 7)
(setq gnus-level-zombie 8)
(setq gnus-level-killed 9)
(setq gnus-activate-level 4)
(setq gnus-group-default-list-level gnus-activate-level)

;;; Group timestamps

(require 'gnus-group)

(add-hook 'gnus-select-group-hook #'gnus-group-set-timestamp)

;;; diary reminder

(require 'nndiary)

(setq nndiary-reminders (list (cons 0 'day) (cons 60 'minute)))

;;; Prefer TEXT than HTML mails

(require 'mm-decode)

(add-to-list 'mm-discouraged-alternatives "text/html")
(add-to-list 'mm-discouraged-alternatives "text/richtext")

;;; display using display-buffer

(defun durand-display-gnus (&rest _args)
  "Display the group buffer using `display-buffer'."
  (cond
   ((null (get-buffer "*Group*"))
    (user-error "No group buffer!"))
   (t
    (quit-window)
    (display-buffer (get-buffer "*Group*")))))

(advice-add #'gnus :after #'durand-display-gnus)

(autoload 'durand-member "common")

(defun durand-gnus-kill-tab (&rest _args)
  "Kill the tab when exiting Gnus."
  (cond
   ((durand-member "email"
                   (mapcar (lambda (tab) (cdr (assq 'name tab)))
                           (funcall tab-bar-tabs-function))
                   #'string=)
    (tab-bar-close-tab-by-name "email"))))

(defun durand-gnus-quit ()
  "Quit and kill tab at the same time."
  (interactive)
  (bury-buffer)
  (durand-gnus-kill-tab))

(add-hook 'gnus-exit-gnus-hook #'durand-gnus-kill-tab)

;;; repunctuate sentences

(add-hook 'gnus-part-display-hook 'gnus-treat-repunctuate)

;;;###autoload
(defun gnus-treat-repunctuate ()
  "Do a quick repunctuation."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (repunctuate-sentences t)))

;;; To be able to see the encrypted mails sent by me.

(setq mml-secure-openpgp-encrypt-to-self
      (list "mmemmew@gmail.com"
            "durand@jsdurand.xyz"))

;;; mail aliases

(setq message-mail-alias-type 'abbrev)

;;; Decryptions and signatures

(require 'gnus-art)

(setq gnus-buttonized-mime-types '("multipart/signed" "multipart/alternative"))

(setq mm-decrypt-option 'known)

(setq mm-verify-option 'known)

;;; Update by mu4e

(autoload 'mu4e-update-mail-and-index "mu4e-utils")
(autoload 'load-config "init")

(defalias 'durand-update-mail #'mu4e-update-mail-and-index)

;; Let notmuch know about the changes automatically.

(load-config "notmuch-conf.el")

(require 'notmuch)

(add-hook 'mu4e-index-updated-hook #'notmuch-poll)

(define-key gnus-group-mode-map (vector 117) #'durand-update-mail)
(define-key global-map (vector ?\C-c ?g) 'gnus)

;;; Use notmuch to search mails

;;;; Helper function to convert file name to article numbers

(require 'nnmaildir)

(defun durand-gnus-file-name-to-article-number (filename)
  "Convert FILENAME to the article number.
An article number is something Gnus uses internally to identity
malis.  This is not simply deduced from the file names.  At least
I do not know how to do so.  The only way that I know of is to
consult information stored in a structure called
\"nnmaildir--grp\".  The function
`nnmaildir-base-name-to-article-number' does this conveniently
for us.

Note that this function is tailored to my specific directory
structure used to store mails.  Different mail directory
structures need different functions.

Perhaps one can consult `nnmaildir--servers' to find all
available servers, and then find which server corresponds to the
given file name, and then loop through the groups in the server
to determine the corresponding group.  But I have few servers and
groups, so that is a generalization I do not need, at present."
  (let* ((filebase (file-name-nondirectory filename))
         (server
          (cond
           ((string-match-p "mbsync/mymail/" filename) "durand")
           ("gmail")))
         (group
          (cond
           ((string-match-p "INBOX" filename) "private")
           ("sent"))))
    (vector
     (format "nnmaildir+%s:%s" server group)
     (nnmaildir-base-name-to-article-number
      (replace-regexp-in-string ":.*$" "" filebase)
      group server)
     100)))

;;;; Query function

(defvar durand-gnus-notmuch-query-history nil
  "History of the queries.")

(defalias 'durand-gnunque #'durand-gnus-notmuch-query)

(defun durand-gnus-notmuch-query (query &optional partial-p)
  "Search mails by QUERY.
If PARTIAL-P is non-nil, only return matching mails; otherwise,
all mails in the same thread as some matching mails are
returned.

If called interactively, PARTIAL-P is non-nil if and only if
called with a universal argument \\[universal-argument]."
  (interactive
   (list
    (read-string
     "Query: "
     nil
     'durand-gnus-notmuch-query-history
     durand-gnus-notmuch-query-history t)
    current-prefix-arg))
  (let ((query (split-string query " "))
        results)
    (cond
     (partial-p
      (setq
       results
       (apply
        #'process-lines
        "notmuch" "search" "--format=text"
        "--output=files" query)))
     ;; split and join back as a form of normalizatoin
     ((setq query (mapconcat #'identity query " "))
      (setq
       results
       (process-lines "dnw" query))))
    ;; convert message file names to "article numbers" that Gnus uses
    ;; internally
    (setq
     results
     (apply
      #'vector
      (mapcar #'durand-gnus-file-name-to-article-number results)))
    ;; then read the articles
    (gnus-group-read-ephemeral-group
     (concat "nnselect-" (message-unique-id))
     (list (intern "nnselect") "nnselect")
     nil (cons (current-buffer) gnus-current-window-configuration)
     nil nil
     (list (cons 'nnselect-specs
                 (list (cons 'nnselect-function #'identity)
                       (cons 'nnselect-args results)))))))

;;;; Proper exit

(defun durand-gnunque-exit-hook ()
  "This function is called in `gnus-exit-group-hook'.
Since an nnselect virtual group would be unfeasible after we exit
the summary buffer, unless we run the query again, there would be
no loss in removing this group from other variables."
  (cond
   ((string-match-p (rx bos "nnselect") gnus-newsgroup-name)
    (remhash gnus-newsgroup-name gnus-active-hashtb))))

(add-hook 'gnus-summary-exit-hook #'durand-gnunque-exit-hook)

;;;; Save queries to functions

(defmacro durand-gnus-save-query (name query)
  "Save QUERY as a function named NAME."
  (declare (indent 1))
  (list
   'defun (intern (format "durand-gnus-view-%s" name))
   nil
   (format "Run the query: %s" query)
   (list 'interactive)
   (list 'durand-gnunque query)))

;; Protesilaos' mails
(durand-gnus-save-query "prot" "from:prot* or to:prot*")

;; From my professors
(durand-gnus-save-query "minglung"
  "from:Ming-Lun.Hsieh* or to:Ming-Lun.Hsieh*")
(durand-gnus-save-query "tan" "from:tan* or to:tan*")

;; friends
(durand-gnus-save-query "friends"
  "from:r03221010* or to:r03221010*
or from:bill821230bill* or to:bill821230bill*
or from:u1991123* or to:u1991123*")

;;;; bind in gnus group buffer

(define-key gnus-group-mode-map (vector ?v ?p) #'durand-gnus-view-prot)
(define-key gnus-group-mode-map (vector ?v ?m) #'durand-gnus-view-minglung)
(define-key gnus-group-mode-map (vector ?v ?t) #'durand-gnus-view-tan)
(define-key gnus-group-mode-map (vector ?v ?f) #'durand-gnus-view-friends)
(define-key gnus-group-mode-map (vector ?v ?q) #'durand-gnunque)

;;; user settings

(setq gnus-ignored-from-addresses
      (list
       "mmemmew@gmail.com"
       "durand@jsdurand.xyz"))

(require 'smtpmail)

(setq send-mail-function #'smtpmail-send-it)
(setq smtpmail-smtp-user "durand@jsdurand.xyz")

(setq gnus-user-agent '(emacs gnus config))

;; too many questions!

(setq gnus-agent-go-online t)

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

(setq read-mail-command #'gnus)

(set 'gnus-novice-user nil)

(setq nnmail-expiry-wait 'immediate)

;;; parameters

(setq gnus-parameters
      `((".*"
         (posting-style
          (gcc "nnmaildir+gmail:sent")))))

(require 'gnus-msg)

;;; posting style

(setq gnus-posting-styles
      '((".*"
         (signature "李俊緯")
         (address "mmemmew@gmail.com")
         (From (format "Durand <%s>" user-mail-address)))
        ((header "from" "protesilaos")
         (signature "Durand"))
        ((header "from" "tan\\|mlh\\|hsialc\\|tingyu")
         (name "李俊緯")
         (From (format "李俊緯 <%s>" user-mail-address))
         (body "老師好：\n")
         (signature "生 俊緯"))))

(setq gnus-gcc-mark-as-read t)

;;; Multiple SMTP servers

;;;; Set the correct server on sending mails

;; This is adapted from the following URL:
;; https://www.emacswiki.org/emacs/MultipleSMTPAccounts.

(defvar durand-smtp-servers nil
  "The list of SMTP servers that I use.
Each server is a list of the form:

\(SENDER SERVER PORT USERNAME)

SENDER is a string to match the \"FROM\" field of EMails.

SERVER is the server to use.

PORT is the port to use.

USERNAME is used to look up passwords in ~/.authinfo.gpg.")

(setq durand-smtp-servers
      (list
       (list "durand@jsdurand.xyz"
             "mail.jsdurand.xyz"
             587
             "durand@jsdurand.xyz")
       (list "mmemmew@gmail.com"
             "smtp.gmail.com"
             587
             "mmemmew@gmail.com")))

(defun durand-set-smtp-server-message-send-and-exit ()
  "Set SMTP server according to `durand-smtp-servers' and send mail."
  (interactive)
  ;; We always determine this automatically.
  (message-remove-header "X-Message-SMTP-Method")
  (let* ((sender (message-fetch-field "From"))
         (server-form (alist-get sender durand-smtp-servers
                                 nil nil #'string-match-p)))
    (cond
     ((and (null server-form)
           (y-or-n-p
            "Do you want to change the default SMTP server?"))
      (setq server-form
            (alist-get (completing-read "Choose a server: "
                                        durand-smtp-servers
                                        nil t)
                       durand-smtp-servers
                       nil nil #'string=))))
    ;; if there is a server to use, we change to it
    (cond
     (server-form
      (message-add-header
       (format
        "X-Message-SMTP-Method: smtp %s %d %s"
        (car server-form) (cadr server-form) (caddr server-form)))))
    ;; send the message if possible
    (let ((xmess (message-fetch-field "X-Message-SMTP-Method")))
      (cond
       (xmess
        (message
         (format "Sending message using '%s' with config '%s'"
                 sender xmess))
        (message-send-and-exit))
       ((user-error
         (concat
          "Could not find SMTP Server for this Sender address: %s."
          "You might want to correct it or add it to "
          "the list 'durand-smtp-servers'.")
         sender))))))

(define-key message-mode-map (vector 3 3)
  #'durand-set-smtp-server-message-send-and-exit)

;;;; Choose the correct identity when entering message buffers

(defvar durand-identities
  (list
   (list "mmew" "Durand <mmemmew@gmail.com>" "nnmaildir+gmail:sent")
   (list "durand"
         "Durand <durand@jsdurand.xyz>"
         "nnmaildir+durand:sent" "Durand")
   (list "alt"
         "李俊緯 <durand@jsdurand.xyz>"
         "nnmaildir+durand:sent" "生 俊緯"))
  "The list of identities to choose.
Each element is of the form

NICK ADDR GCC [SIG]

NICK: The name to type to choose this identity.

ADDR: The string that appears as the FROM field of the message.

GCC: The string that appears as the GCC field of the message.

SIG: Optionally include a signature.")

(defun durand-choose-identity (&optional arg)
  "Choose an identity when entering `message-mode'.
If ARG is non-nil, ask which identity to use.  Otherwise use the
identity named durand."
  (interactive "P")
  (let* (choice
         (to (message-fetch-field "To"))
         (all-mnemonics
          (flatten-tree
           (mapcar (lambda (c)
                     (mapcar #'identity
                             (category-set-mnemonics
                              (char-category-set c))))
                   to)))
         (default (cond
                   ((memq ?C all-mnemonics) "alt")
                   ("durand")))
         (identity-to-use
          (cond
           (arg
            (setq choice
                  (completing-read
                   (format "Choose an identity [%s]: " default)
                   durand-identities nil t nil nil
                   default))
            (alist-get choice durand-identities nil nil #'string=))
           ((alist-get
             (setq choice default)
             durand-identities nil nil #'string=))
           ((user-error "No identity crisis!"))))
         (from (car identity-to-use))
         (gcc (cadr identity-to-use))
         (sig (caddr identity-to-use)))
    (message-remove-header "From")
    (message-remove-header "Gcc")
    (message-add-header (format "From: %s" from))
    (message-add-header (format "Gcc: %s" gcc))
    ;; deal with signature
    (cond
     (sig
      (save-excursion
        (goto-char (point-max))
        (cond
         ((re-search-backward "^-- $")
          ;; found a pre-existing signature; let me update this.
          (forward-line 1)
          (delete-region (point) (point-max))))
        (insert sig))))
    (message "Chose %s as the identity now!" choice)))

(define-key message-mode-map (vector 3 ?i) #'durand-choose-identity)

;;; Always view HTML emails in an external browser

(defun durand-browse-html-mail-advice (fn &rest args)
  "Browse HTML mails in an external browser.
FN is the function modified by this advice.

ARGS is the list of arguments passed to FN."
  (let ((browse-url-browser-function
         browse-url-secondary-browser-function))
    (funcall fn (car args))))

(advice-add #'gnus-article-browse-html-article
            :around #'durand-browse-html-mail-advice)

;;; Call me an expert.

(setq gnus-expert-user t)

(setq gnus-agent t)

(setq gnus-check-new-newsgroups 'ask-server)
(setq gnus-read-active-file 'some)

(setq gnus-use-dribble-file t)
(setq gnus-always-read-dribble-file nil)

;;; treatings

(setq gnus-treat-display-smileys nil)
(setq gnus-treat-emphasize t)
(setq gnus-treat-fill-article nil)
(setq gnus-summary-goto-unread 'never)

(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)

;;; group line format

(setq gnus-group-line-format "%M%S%p%P%5y:%B%(%g%)\n")

;; (setq gnus-topic-alist
;;       '(("devel" "gmane.emacs.devel")
;;         ("orgmode" "gmane.emacs.orgmode")
;;         ("bug" "gmane.emacs.bugs")
;;         ("emacs")
;;         ("Gnus" "nndraft:drafts")))

;;; thread sorting

(setq gnus-thread-sort-functions
      '(gnus-thread-sort-by-most-recent-date
        gnus-thread-sort-by-most-recent-number))

(setq gnus-subthread-sort-functions
      'gnus-thread-sort-by-date)

(setq gnus-thread-hide-subtree nil)

;;; move between topics

(define-key gnus-group-mode-map [?\M-n] 'gnus-topic-goto-next-topic)
(define-key gnus-group-mode-map [?\M-p] 'gnus-topic-goto-previous-topic)

;;; exiting

(define-key gnus-group-mode-map (vector ?q) #'durand-gnus-quit)
(define-key gnus-group-mode-map (vector ?x) #'gnus-group-exit)

;;; agent key bindings

(require 'gnus-agent)

(define-key gnus-agent-summary-mode-map (vector ?$) #'previous-line)
(define-key gnus-agent-summary-mode-map (vector ?ù) #'next-line)
(define-key gnus-agent-summary-mode-map (vector ?n) #'gnus-summary-next-article)
(define-key gnus-agent-summary-mode-map (vector ?p) #'gnus-summary-prev-article)
(define-key gnus-agent-summary-mode-map (vector ?N) #'gnus-summary-next-unread-article)
(define-key gnus-agent-summary-mode-map (vector ?P) #'gnus-summary-prev-unread-article)
(define-key gnus-agent-summary-mode-map (vector ?o) #'gnus-summary-save-article)
(define-key gnus-agent-summary-mode-map (vector ?y) #'gnus-summary-scroll-down)
(define-key gnus-agent-summary-mode-map (vector ?!) #'gnus-summary-mark-as-processable)
(define-key gnus-agent-summary-mode-map (vector ?\M-n) #'gnus-summary-next-thread)
(define-key gnus-agent-summary-mode-map (vector ?\M-p) #'gnus-summary-prev-thread)
(define-key gnus-agent-summary-mode-map (vector ?\C-\M-n) #'gnus-summary-next-group)
(define-key gnus-agent-summary-mode-map (vector ?\C-\M-p) #'gnus-summary-prev-group)

;; I do not use these functions now.
;; (define-key gnus-agent-summary-mode-map (vector ?z ?t) #'recenter-to-top)
;; (define-key gnus-agent-summary-mode-map (vector ?z ?b) #'recenter-to-bottom)
;; (define-key gnus-agent-summary-mode-map (vector ?z ?z) #'recenter-to-middle)

(define-key gnus-agent-group-mode-map (vector ?n) #'gnus-group-next-group)
(define-key gnus-agent-group-mode-map (vector ?p) #'gnus-group-prev-group)
(define-key gnus-agent-group-mode-map (vector ?N) #'gnus-group-next-unread-group)
(define-key gnus-agent-group-mode-map (vector ?P) #'gnus-group-prev-unread-group)

;;; article

(require 'gnus-art)

;; (define-key gnus-article-mode-map [?z ?t] 'recenter-to-top)
;; (define-key gnus-article-mode-map [?z ?b] 'recenter-to-bottom)
;; (define-key gnus-article-mode-map [?z ?z] 'recenter-to-middle)
(define-key gnus-article-mode-map [?o] 'gnus-mime-inline-part)

(setq gnus-article-sort-functions
      '((not gnus-article-sort-by-number)
        (not gnus-article-sort-by-date)))

(require 'gnus-html)

(setq gnus-html-frame-width 80)
(setq gnus-inhibit-images nil)
(setq gnus-max-image-proportion 0.7)

;;; Summary

(setq gnus-auto-select-first nil)
(setq gnus-summary-ignore-duplicates t)
(setq gnus-suppress-duplicates t)
(setq gnus-summary-goto-unread 'never)
(setq gnus-summary-to-prefix "To: ")
(setq gnus-summary-line-format
      "%U%R%z %-16,16&user-date; %*%(%-30,30a  %B%s%)\n")
(setq gnus-summary-mode-line-format "%p")
(setq gnus-summary-make-false-root 'adopt)
(setq gnus-sum-thread-tree-false-root "─┬> ")
(setq gnus-sum-thread-tree-indent " ")
(setq gnus-sum-thread-tree-leaf-with-other "├─> ")
(setq gnus-sum-thread-tree-root "")
(setq gnus-sum-thread-tree-single-leaf "└─> ")
(setq gnus-sum-thread-tree-vertical "│")
(setq gnus-summary-thread-gathering-function
      #'gnus-gather-threads-by-subject)

;;; delayed sending

(gnus-delay-initialize)

;;; disable auto-save for newrc file

(defun durand-disable-auto-save-for-newsrc-ad (&rest _args)
  "Disable auto-save for newsrc file."
  (cond
   ((get-buffer ".newsrc-dribble")
    (with-current-buffer ".newsrc-dribble"
      (setq-local buffer-auto-save-file-name nil)))))

(advice-add #'gnus :after #'durand-disable-auto-save-for-newsrc-ad)

;;; Supercite

(require 'supercite)

;; This is the only thing we need to enable using Supercite
(add-hook 'mail-citation-hook #'sc-cite-original)

;; I can start the eelectirc reference mode later on, by the function
;; `sc-insert-reference' (bound to "C-c C-p w" by default).
(setq sc-electric-references-p nil)

;; I find this style quite balanced: not too verbose but still
;; informative enough
(setq sc-preferred-header-style 1)

;; I used to use the nested style, but now I think the non-nested
;; style is clearer and cleaner
(setq sc-nested-citation-p nil)

;; Don't query me each time
(setq sc-confirm-always-p nil)

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