;;; -*- lexical-binding: t -*-

;;; Externalities.

;; user-full-name       from /etc/passwd; set with chfn(1).
;; user-mail-address    from EMAIL variable; set with ~/.profile,
;;                      ~/.xsessionrc, DE's convention-du-jour.

;; ~/.authinfo.gpg:
;;      machine imap.gmail.com login LOGIN password PASSWORD port 993
;;      machine smtp.gmail.com login LOGIN password PASSWORD port 587

;;; Þe Olde Setq.
(setq gnus-select-method
      '(nnimap "gmail"
               ;; TODO: try auth-source-xoauth2-plugin:
               ;; (nnimap-authenticator xoauth2)
               (nnimap-address "imap.gmail.com")
               (nnimap-server-port 993)
               (nnmail-expiry-target "nnimap+gmail:[Gmail]/Trash")
               (nnmail-expiry-wait immediate))
      gnus-secondary-select-methods
      '((nntp "archive.lwn.net")
        (nntp "news.gmane.io"))

      smtpmail-smtp-server "smtp.gmail.com"
      smtpmail-smtp-service 587

      ;; Archival of sent messages.
      gnus-gcc-mark-as-read t
      ;; The next setting makes the previous one useless; keeping both
      ;; for now because I'm not sure which I'll settle for.
      gnus-message-archive-group nil

      ;; Groups.
      gnus-group-uncollapsed-levels 2

      ;; Summary.
      gnus-auto-center-summary nil
      gnus-prompt-before-saving t
      gnus-summary-line-format "%*%U%R  %-16,16&user-date; %B%-23,23f  %s\n"
      gnus-summary-dummy-line-format "                     ╭                          %S\n"
      gnus-summary-make-false-root 'dummy
      gnus-sum-thread-tree-root "╭ "
      gnus-sum-thread-tree-false-root "┬ "
      gnus-sum-thread-tree-single-indent "  "
      gnus-sum-thread-tree-indent " "
      gnus-sum-thread-tree-single-leaf "╰► "
      gnus-sum-thread-tree-leaf-with-other "├► "
      gnus-sum-thread-tree-vertical "│"
      gnus-thread-sort-functions
      '(gnus-thread-sort-by-number
        (not gnus-thread-sort-by-most-recent-date))
      gnus-user-date-format-alist '(((gnus-seconds-today)
                                     . "%H:%M")
                                    ((+ 86400 (gnus-seconds-today))
                                     . "Yesterday %H:%M")
                                    ((* 6 86400)
                                     . "%a %H:%M")
                                    ((gnus-seconds-month)
                                     . "%a %d")
                                    ((gnus-seconds-year)
                                     . "%b %d")
                                    (t
                                     . "%F"))
      ;; Articles.
      gnus-cite-parse-max-size nil
      gnus-header-face-alist
      '(("From" nil gnus-header-from)
        ("Subject" nil gnus-header-subject)
        ("Date" nil eighters-date)
        ("Newsgroups:.*," nil gnus-header-newsgroups)
        ("" gnus-header-name gnus-header-content))
      gnus-sorted-header-list
      (list
       ;; What, when.
       "^Subject:" "^Summary:" "^Keywords:" "^Date:"
       ;; Who.
       "^From:" "^Organization:" "^Followup-To:" "^To:" "^Cc:" "^Newsgroups:")
      gnus-treat-display-smileys nil
      ;; Do not fill anything; let visual-line-mode wrap text.
      ;;; NB: for format=flowed, there is no setting to say "un-fill
      ;;; flowed lines", so we *enable* filling, setting an absurd
      ;;; line length limit, in order to un-fill flowed lines.
      fill-flowed-display-column most-positive-fixnum
      mm-fill-flowed t
      ;;; More long-line-folding settings.
      gnus-article-unfold-long-headers t
      gnus-treat-fill-article nil
      gnus-treat-fill-long-lines nil
      gnus-treat-fold-headers nil)

;;; Window configurations.

(defvar my/gnus-side-by-side-threshold 160)

(gnus-add-configuration
 '(article
   (if (>= (frame-width) my/gnus-side-by-side-threshold)
       '(horizontal 1.0
                    (summary 1.0 point)
                    (article 80))
     '(vertical 1.0
                (summary 0.25 point)
                (article 1.0)))))

(dolist (buf-name '(forward reply reply-yank))
  (gnus-add-configuration
   `(,buf-name
     (if (>= (frame-width) my/gnus-side-by-side-threshold)
         '(vertical 1.0
                    (summary 0.25)
                    (horizontal 1.0
                                (article 0.5)
                                (message 1.0 point)))
       '(vertical 1.0
                  (summary 0.2)
                  (article 0.2)
                  (message 1.0 point))))))

;;; Summary tweaks.

(defun my/gnus-toggle-article-wrap ()
  (interactive)
  (with-current-buffer gnus-article-buffer
    (visual-line-mode 'toggle)))

(defun my/gnus-summary-tweak-keys ()
  (keymap-local-set "C-c d v" 'my/gnus-toggle-article-wrap))

(add-hook 'gnus-summary-mode-hook 'my/gnus-summary-tweak-keys)

;; message-subject-re-regexp is used both in Gnus summary buffers to
;; detect and elide similar subjects in a thread, and by message mode
;; when replying, to determine what to strip from the subject.
;;
;; Some MUAs add cruft to the subject, turning "Re: bug#123: foobar"
;; into "RE: [External] : Re: bug#1234: foobar", which Debbugs will
;; then turn into "bug#1234: [External] : Re: bug#1234: foobar".
;;
;; The only way I can find to tell the Gnus summary code to
;; canonicalize all that cruft away is by tweaking this regexp, but
;; setting its global value causes message-mode to elide stuff it
;; shouldn't when crafting subjects.  Therefore, chase down the best
;; Gnus hook for the job, and set the regexp locally.
(defun my/gnus-reply-prefixes ()
  (mapcan (lambda (prefix) (list prefix (upcase prefix) (capitalize prefix)))
          '("re" "aw" "sv" "fw" "fwd")))

(setq my/gnus-summary-normalize-subject
      (rx-to-string
       `(seq bol
             (+ (or (seq word-start (or ,@(my/gnus-reply-prefixes)) word-end)
                    (seq "bug#" (+ digit))
                    (seq "[" (or "External" "SPAM UNSURE") "]"))
                (? (* space) ":") (* space)))))

(add-hook 'gnus-summary-generate-hook
          (lambda ()
            (setq-local message-subject-re-regexp
                        my/gnus-summary-normalize-subject)))

(let* ((initials (mapconcat (lambda (s) (substring s 0 1))
                            (split-string user-full-name)
                            nil))
       (sent-prefix (format "%s → " initials)))
  (setq gnus-summary-to-prefix sent-prefix
        gnus-summary-newsgroup-prefix sent-prefix))

;;; Article tweaks.

(defun my/gnus-article-eschew-tables ()
  ;; I set shr-fill-text to nil because I prefer letting
  ;; visual-line-mode manage wrapping.  Unfortunately, many HTML
  ;; emails rely on <table>s for layouts, and rendering can get ugly.
  ;; Work around this by treating <table> & children as any other
  ;; <div>.
  (make-local-variable 'shr-external-rendering-functions)
  (pcase-dolist (`(,tag . ,shr-function)
                 '((table . shr-tag-div)
                   (thead . shr-tag-div)
                   (tbody . shr-tag-div)
                   (tr    . shr-tag-ul)
                   (th    . shr-tag-li)
                   (td    . shr-tag-li)))
    (setf (alist-get tag shr-external-rendering-functions) shr-function)))

(defun my/gnus-article-has-html ()
  ;; Hard to tell the difference between
  ;; * the variable `gnus-article-mime-handles',
  ;; * the function `gnus-article-mime-handles',
  ;; * the variable `gnus-article-mime-handle-alist'.
  ;;
  ;; Stealing debbugs.el's patch-finding logic.
  (seq-some
   (lambda (handle)
     (string= (mm-handle-media-type (cdr handle)) "text/html"))
   (gnus-article-mime-handles)))

(defun my/gnus-article-should-wrap ()
  (save-excursion
    (message-goto-body)
    (let ((should-wrap nil)
          (has-html (my/gnus-article-has-html)))
      (while-let (((not should-wrap))
                  ((not (eobp)))
                  (current-line (thing-at-point 'line)))
        (setq should-wrap
              (and
               ;; The line is bigger than the target width.
               (> (length current-line)
                  (window-width (get-buffer-window gnus-article-buffer)))
               ;; The line is not boring (citation, diff addition/removal).
               (not (string-match-p "\\`[>+-]" current-line))
               ;; Lines that start with spaces are boring, except in
               ;; HTML parts: those are choked with <table> tags that
               ;; shr left-pads with spaces.
               ;; NB: HAS-HTML is a naive heuristic: we are assuming
               ;; that "any text/html part is present" means "we are
               ;; looking at this text/html part".
               (or (not (string-match-p "\\` " current-line)) has-html)))
        (forward-line))
      should-wrap)))

(defun my/gnus-article-wrap-maybe ()
  ;; Enable visual-line-mode when it helps, i.e. when the message has
  ;; long lines that are not part of citations nor patches.
  (with-current-buffer gnus-article-buffer
   (visual-line-mode
    (unless (my/gnus-article-should-wrap) -1))))

;; Article setup is tricky.  In order, `gnus-article-prepare'
;;
;; (1) calls `gnus-article-setup-buffer', which
;;     (a) calls `gnus-article-mode', which runs
;;         gnus-article-mode-hook,
;;     (b) sets truncate-lines from gnus-article-truncate-lines,
;;
;; (2) calls `gnus-display-mime', which may end up calling `mm-shr';
;;     this can call `shr-tag-table', which turns truncate-lines on
;;     unconditionally.
;;
;; (3) runs gnus-article-prepare-hook.
;;
;; Gnus will only run (1a) once, and skip that step when it re-uses
;; the same *Article* buffer for subsequent articles.  So for our
;; purposes, we need to
;;
;; (Ⅰ) hack the shr rendering functions in mode-hook, before `mm-shr'
;;     gets to work.
;; (Ⅱ) call `visual-line-mode' (if needed) in prepare-hook, after
;;     truncate-lines has been set.

(add-hook 'gnus-article-mode-hook 'my/gnus-article-eschew-tables)
(add-hook 'gnus-article-prepare-hook 'my/gnus-article-wrap-maybe)

;;; MIME display.
(defun my/mm-display-markdown-inline (handle)
  (mm-display-inline-fontify handle 'markdown-mode))

(with-eval-after-load 'mm-decode
  ;; bug-gnu-emacs:<jwvzfsnntlq.fsf-monnier+emacs@gnu.org>
  (setf (alist-get "text/markdown" mm-inline-media-tests nil nil 'equal)
        '(my/mm-display-markdown-inline)))

;;; Key bindings.
;;
;; m            compose
;;
;; Group buffer:
;;
;; L            list all groups
;; RET          view unread mail in group
;; C-u RET      view all mail in group
;; g            refresh
;; G G          search group
;;
;; Summary buffer:
;;
;; B m          move message to group
;; / N          fetch new
;; M-g          refresh (expire, move, fetch new, show unread)
;; C-u M-g      refresh (expire, move, fetch new, show all)
;; C-u g        show raw, undecoded message source; g to decode
;; T h          collapse (hide) thread
;; T s          expand (show) thread
;; T k, C-M-k   mark thread as read
;; M-1 T k      mark thread as unread
;; r            reply
;; R            reply (quoting)
;; S w          reply-all
;; S W          reply-all (quoting)
;; C-c C-f      forward
;; d            mark read
;; M-u          clear marks (≡ mark unread)
;; E            expire
;; #            toggle mark for next action
;; M-#, M P u   unmark for next action
;;
;;      Draft summary buffer:
;;
;;      D e     edit draft
;;
;; Article buffer:
;;
;; o            save attachment at point
;; K b          add button for inlined MIME part
;;
;; Composing:
;;
;; C-c C-c      send
;; C-c C-a      attach
;; C-c C-f s    change the subject (append "was:")
;;
;;; FAQ.
;;
;; - how to see *all mails*, not just unread?
;;      - C-u RET
;;
;; - how to do something on a bunch of mail matching a pattern?
;;      - M P R     ; mark all mails with subjects matching regexp
;;      - M-& <x>   ; do <x> on all marked mails
;;
;; - how to delete mail?
;;      - E to mark as expired
;;      - C-u M-g to refresh
;;
;; - how to remove groups deleted on the IMAP server?
;;      - b to iterate over "bogus" groups and remove them
;;
;; - how to list most-recent mails on top?
;;      - cf. gnus-thread-sort-functions
;;
;; - how to close a mail without going back to the group list?
;;      - = to make summary full-screen
;;
;; - how to get contact completion?
;;      - install ebdb from GNU ELPA
;;      - or just use message-mail-alias-type
;;
;; - how to refresh?
;;      - summary buffer:
;;          - / N (fetch new)
;;          - M-g (expire, move, fetch & redisplay)
;;      - group buffer: g
;;
;; - what do all those letters mean?
;;   (info "(gnus) Marking Articles")
;;      - O     old ≡ read during previous session
;;      - R     just read
;;      - r     manually marked as read
;;      - A     answered
;;      - E     expirable
;;      - G     cancelled (e.g. moved somewhere else)
;;      - .     unseen
;;
;; - how to subscribe to mailing lists?
;;      - to browse an NNTP server, either
;;          - hit B in the group buffer, then nntp *some server*
;;          - or add (nntp "*some server*") to gnus-secondary-methods
;;      - over the list: u
;;
;;; TODO.
;;
;; - gnus-summary-line-format (📎 for attachments)
;;
;; - how to archive mails and news locally?
;;
;; - describe-key is mostly useless in article mode:
;;   > X runs the command gnus-article-read-summary-keys
;;
;; - detect possibly missing attachments from keywords