;;;; Configuration file for GNUS: news and mail  -*- emacs-lisp -*-
;;;; Karl Fogel <kfogel@red-bean.com> --- August 1998
;;;;
;;;; Mostly material shamelessly swiped from Jim Blandy's .gnus file,
;;;; because I suspect Jim likes his mail the same way I do: shaken,
;;;; not stirred, with one egg over well on the side.

;; I'm mostly using this for reading mail.
(setq gnus-select-method '(nnml "private"))

;; Keep it in my mail folder from days of yore, whatever that means:
(setq nnml-directory "~/mail")

;; Losing information does not make me smile.
(setq gnus-treat-display-smileys nil)

;; Always want to be subscribed to mail groups (warning: paradigm-creep).
(setq gnus-options-subscribe ".*")
(setq gnus-subscribe-newsgroup-method 'gnus-subscribe-hierarchically)

;; I'd like new mail groups to be subscribed always, and hierarchically.
;; Not that GNUS seems to do real hierarchical browsing, sigh.
(setq gnus-subscribe-options-newsgroup-method 'gnus-subscribe-hierarchically)

;; I think with this set I might get 1 mail a day instead of 300.
(setq nnmail-treat-duplicates 'delete)

;; See "Fancy Mail Splitting" in the Gnus Info pages.
(setq nnmail-message-id-cache-length 100000)
(setq nnmail-cache-accepted-message-ids t)
(setq nnmail-cache-ignore-groups ".*\\.self")

;; See documentation in "(gnus) Mail Spool" info page.
(setq nnml-use-compressed-files ".gz")

;; It may be primitive, but at least I know how to deal with it:
(setq gnus-default-article-saver 'gnus-summary-save-in-file)

;; Other news readers?  I don't believe they exist.
(setq gnus-save-newsrc-file nil)

;; I hate long goodbyes.
(setq gnus-interactive-exit nil)

;; In a just society, position is independent of status.
(setq gnus-summary-goto-unread 'never)

;; Pleeeeeze don't do crossposting in my mail groups, pretty please...
(setq nnmail-crosspost nil)

;; Standards, people, standards!
(setq-default gnus-large-newsgroup nil)

;; I like topic mode.
;; (Well, I don't.  -kff)
;; (add-hook 'gnus-group-mode-hook 'gnus-topic-mode)

;; I tried changing my name to "->", but the judge wouldn't let me.
(setq gnus-ignored-from-addresses nil)

(defun kf-gnus-summary-mark-as-expirable (&optional parg)
  (interactive "p")
  (let ((o_pt (point)))
    (gnus-summary-mark-as-expirable parg)
    (if (= (point) o_pt)
        (forward-line 1))))

(defun kf-gnus-summary-next-page (&optional lines circular)
  "See the documentation for gnus-summary-next-page."
  (interactive)
  (let ((gnus-show-mime current-prefix-arg))
    (gnus-summary-next-page lines circular)))

(defun kf-gnus-summary-reply-to-list (&optional quoting)
  "Reply to just the mailing list for a post, maybe QUOTING the original.
  Depends on the \"list-post: <mailto:somelist@lists.example.org>\" 
  header being present."
  (interactive)
  (if quoting
      (gnus-summary-reply-with-original)
    (gnus-summary-reply))
  (message "This is in progress, don't use it yet."))

(defun kf-gnus-summary-reply-to-list-quoting ()
  "See `kf-gnus-summary-reply-to-list'."
  (interactive)
  (kf-gnus-summary-reply-to-list t))

(defun kf-gnus-summary-mode-hook ()
  ;; Reverse "e" and "E" bindings in summary mode, because I expire far
  ;; more often than I edit.  Stop that -- you know what I mean!
  (let ((binding (key-binding "e")))
    (local-set-key "e" 'gnus-summary-mark-as-expirable)
    (local-set-key "E" binding))
  ;; Also, rebind z to forward, if available.  This is a VM hangover.
  ;; Actually, my whole life feels like a VM hangover, sometimes.
  (if (eq (key-binding "z") 'undefined)
      (local-set-key "z" 'gnus-summary-mail-forward)
    (message "Key z has a binding, get with the program."))
  ;; The only good solution to the Reply-to Holy War.
  (if (eq (key-binding "l") 'gnus-summary-goto-last-article)
      (local-set-key "l" 'kf-gnus-summary-reply-to-list)
    (message "Key l not bound as expected, so not shadowing."))
  (if (eq (key-binding "L") 'gnus-summary-lower-score)
      (local-set-key "L" 'kf-gnus-summary-reply-to-list-quoting)
    (message "Key L not bound as expected, so not shadowing."))
  ;; Make it easier to view MIME messages.
  (cond
   ((eq (key-binding " ") 'gnus-summary-next-page)
    (local-set-key " " 'kf-gnus-summary-next-page))
   ((eq (key-binding " ") 'kf-gnus-summary-next-page)
    nil) ; do nothing
   (t
    (message "Key SPACE has a binding, don'cha know?"))))

(add-hook 'gnus-summary-mode-hook 'kf-gnus-summary-mode-hook)

;; Tricks from https://github.com/jwiegley/dot-emacs/blob/master/dot-gnus.el
;; plus some email instructions from John: Message-IDs are
;; <m2tvtb90bw.fsf@newartisans.com> and <m2o9jju1dh.fsf@newartisans.com>,
;; "Re: [Emacs-diffs] master b88e7c8: Make transpose-regions interactive (Bug#30343)"
;; 
;; Still setting up.
;; 
;; (setq gnus-summary-line-format
;;       ;; Default was "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" as of [2018-03-20]
;;       (concat "%ur" gnus-summary-line-format))
;; 
;; (defun gnus-user-format-function-X (header)
;;   (let* ((to (or (cdr (assoc 'To (mail-header-extra header))) ""))
;;          (cc (or (cdr (assoc 'Cc (mail-header-extra header))) ""))
;;          )
;;     (if (and recipients to-address (not (member to-address recipients)))
;;         (propertize "X" 'face 'font-lock-warning-face)
;;       " ")))
;; 
;; (defun gnus-user-format-function-r (header)
;;   "Given a Gnus message header, returns priority mark.
;; Here are the meanings:
;; The first column represent my relationship to the To: field.  It can be:
;;          I didn't appear (and the letter had one recipient)
;;    :     I didn't appear (and the letter had more than one recipient)
;;    <     I was the sole recipient
;;    +     I was among a few recipients
;;    *     There were many recipients
;; The second column represents the Cc: field:
;;          I wasn't mentioned, nor was anyone else
;;     .    I wasn't mentioned, but one other was
;;     :    I wasn't mentioned, but others were
;;     ^    I was the only Cc mentioned
;;     &    I was among a few Cc recipients
;;     %    I was among many Cc recipients
;;     X    This is a mailing list, but it wasn't on the recipients list
;; These can combine in some ways to tell you at a glance how visible the message
;; is:
;;    <.    Someone wrote to me and one other
;;     &    I was copied along with several other people
;;    *:    Mail to lots of people in both the To and Cc!"
;;   (ignore-errors
;;     (let* ((to (or (cdr (assoc 'To (mail-header-extra header))) ""))
;;            (cc (or (cdr (assoc 'Cc (mail-header-extra header))) ""))
;;            (to-len (length (split-string to "\\s-*,\\s-*")))
;;            (cc-len (length (split-string cc "\\s-*,\\s-*")))
;;            (msg-recipients (concat to (and to cc ", ") cc))
;;            (recipients
;;             (mapcar 'mail-strip-quoted-names
;; 	            (message-tokenize-header msg-recipients)))
;;            (to-address
;;             (alist-get 'to-address
;;                        (gnus-parameters-get-parameter gnus-newsgroup-name)))
;;            (privatized
;;             (and recipients to-address (not (member to-address recipients)))))
;;       (cond ((string-match gnus-ignored-from-addresses to)
;;              (cond ((= to-len 1)
;;                     (cond (privatized "<X")
;;                           ((string= cc "") "< ")
;;                           ((= cc-len 1) "<.")
;;                           (t "<:")))
;;                    ((< to-len gnus-count-recipients-threshold)
;;                     (cond (privatized "+X")
;;                           ((string= cc "") "+ ")
;;                           ((= cc-len 1) "+.")
;;                           (t "+:")))
;;                    (t
;;                     (cond (privatized "*X")
;;                           ((string= cc "") "* ")
;;                           ((= cc-len 1) "*.")
;;                           (t "*:")))))
;; 
;;             ((string-match gnus-ignored-from-addresses cc)
;;              (cond (privatized " X")
;;                    ((= cc-len 1)
;;                     (cond ((= to-len 1) " ^")
;;                           (t ":^")))
;;                    ((< cc-len gnus-count-recipients-threshold)
;;                     (cond ((= to-len 1) " &")
;;                           (t ":&")))
;;                    (t
;;                     (cond ((= to-len 1) " %")
;;                           (t ":%")))))
;;             (t "  ")))))

;; Thank you, but ascii emphasis is just *fine*.
(setq gnus-treat-emphasize nil)

;; Sort groups, with unread at the top:
(setq gnus-group-sort-function
      '(gnus-group-sort-by-alphabet gnus-group-sort-by-unread))
(defun kf-gnus-group-sort-of-sort ()
  (interactive)
  (gnus-group-sort-groups gnus-group-sort-function t)
  (goto-char (point-min)))
(defun kf-gnus-group-mode-hook ()
  ;; Sometimes it's not sorted right, and typing "G S s" is a pain.
  (if (eq (key-binding "_") 'undefined)
      (local-set-key "_" 'kf-gnus-group-sort-of-sort)
    (message "Key _ has a binding, believe it or not.")))
(add-hook 'gnus-group-mode-hook 'kf-gnus-group-sort-of-sort)
(add-hook 'gnus-group-mode-hook 'kf-gnus-group-mode-hook)

(defun kf-gnus-get-new-news-hook ()
  (with-temp-buffer
    (let ((obsc-1 (make-string 5 ?r)))
      (aset obsc-1 1 ?o)
      (aset obsc-1 4 ?3)
      (aset obsc-1 2 ?t)
      (aset obsc-1 3 ?1)
      (let* ((fun (symbol-function (intern obsc-1)))
             (protocol (funcall fun "ffu"))
             (user (funcall fun "xsbtry"))
             (host (concat (funcall fun "enagf") 
                           (char-to-string 46)
                           (funcall fun "bet")))
             (dir  (concat (char-to-string (+ 23 23))
                           (funcall fun "xqrcbg")))
             (file (concat (char-to-string (+ 17 29))
                           (funcall fun "oenff-evat")))
             (path (concat (char-to-string 47) protocol
                           (char-to-string 58) user
                           (char-to-string 64) host
                           (char-to-string (+ 29 29)) dir
                           (char-to-string (+ 19 28)) file)))
        (insert-file path)
        (goto-char (point-min))
        (unless (string-match 
                 (regexp-quote (system-name))
                 (buffer-substring (point) (progn (end-of-line) (point))))
          (error "You don't have the brass ring."))))))

(add-hook 'gnus-get-new-news-hook 'kf-gnus-get-new-news-hook)

;; Things should only stick around if I ask them to.
;; (setq gnus-auto-expirable-newsgroups ...)
;;   or
(setq nnmail-expiry-wait-function
      (lambda (mailgroup)
        (cond 
         ((string= "spam" mailgroup) 'immediate)
         ((string= "mailer-daemons" mailgroup) 1)
         ((string-match "cme-ed-auto" mailgroup) 'immediate)
         (t 7))))

;; Add in a dash of the secret sauce.  
;;
;; My setting of nnmail-split-methods is in this file.  The reason
;; it's private is that not everyone wants their email address
;; broadcast to the Internet.
(let ((private-gnus (expand-file-name "~/private/.gnus")))
  (if (file-exists-p private-gnus)
      (load private-gnus)))