;; bert's Gnus settings

;; mark start
(message "%s's Gnus setup [e21]..." user-login-name)

(require 'nnmail)
(require 'gnus-group)
(require 'message)

;; make Gnus read mail (in MH-E-like ways)

(setq gnus-select-method '(nnml "")
      ; gnus-secondary-select-methods '((nntp "news.mit.edu"))
      mail-sources '((pop :program "/usr/athena/bin/movemail po:%u %t"
			  :password ""))
      ; mail-sources '((pop :program "/mit/bert/chaos/washmail po:%u %t"
      ;                     :password ""))
      ; nnmail-spool-file (concat "po:" (user-login-name))  ; obsolete!
      ; nnmail-crash-box (concat "/var/tmp/gnus-crash-box." user-login-name)
      mail-source-crash-box (concat "/var/tmp/gnus-crash-box." user-login-name)
      nnmail-message-id-cache-file "~/Mail/.nnmail-cache"
      nnmail-message-id-cache-length 15000
      nndraft-directory "~/Mail/drafts/"
      ; nnmh-get-new-mail nil           ; never get mail via nnmh
      nnml-get-new-mail t               ; but do get mail via nnml
      ; nnml-get-new-mail nil           ; uncomment this in case of panic =)
      ; nnmail-treat-duplicates 'warn
      nnmail-treat-duplicates 'delete   ; ...and this *after* panic...
      nnmail-crosspost-link-function 'copy-file ; no hard links w/ AFS!
      gnus-level-default-subscribed 3
      gnus-level-unsubscribed 6
      gnus-auto-expirable-newsgroups
        (concat "^cro\\|^random\\|^is\\.\\|^maint.cron\\|^mail.bounce"
                "\\|^bug.sipb.exmh\\|^JUNK")
      gnus-large-newsgroup 9999         ; ask only if >=10000 messages
      ; gnus-group-list-inactive-groups 't ; show even inactive groups

      gnus-summary-gather-subject-limit 'fuzzy
      gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
      gnus-summary-make-false-root 'empty

      mm-discouraged-alternatives '("text/html")
      mm-inline-override-types    '("text/html")
      gnus-break-pages nil              ; don't show "Next Page..." for ^L

      ; this is for sending mail
      message-interactive 't
      ;message-send-mail-function 'message-send-mail-with-mh
      message-send-mail-function 'message-send-mail-with-sendmail
      message-syntax-checks '((from . disabled)) )

;; arrange mail splittage
(defvar default-nnmail-split-abbrev-alist nnmail-split-abbrev-alist)
(setq nnmail-split-methods 'nnmail-split-fancy
      nnmail-split-abbrev-alist
      (append default-nnmail-split-abbrev-alist
              '((dest . "to\\|cc\\|resent-to\\|resent-cc")
                (list . "to\\|cc\\|resent-to\\|resent-cc\\|reply-to")
                (all . ".*")
                (abuse . "abuse@.*\\|spam@.*\\|sysadmin@.*\\|nobody@UU\\.NET\\|helpdesk@ibm\\.e-mail\\.com\\|nobody@mci\\.net")
                (cyberpromo . "freeresponder\\.com\\|freerelays\\.com\\|scamford\\.org\\|scamford\\.net\\|scamford\\.com\\|cyberout\\.com\\|cyber\\-promo\\.com\\|savetrees\\.com\\|answerme\\.com\\|cybermirror1\\.com\\|cyberpromotions\\.com\\|cpmall\\.com\\|ispam\\.com\\|spamford\\.net\\|ispam\\.net\\|spamford\\.com\\|cyberpromo\\.com\\|reedrules\\.com\\|noblock\\.com\\|fight4rights\\.com\\|yougotmail\\.com\\|swallace\\.com\\|nocensorship\\.com\\|1stamend\\.com\\|mailreport\\.com\\|sanfordw\\.com\\|savepaper\\.com\\|pleaseread\\.com\\|cyberemag\\.com"))))
                                        ; from /mit/bert/PERL/cyber.pl

(defun if-message-id-is-empty (if-true &optional if-false)
  "Returns IF-TRUE if the Message-Id field of the current buffer is empty,
IF-FALSE (or nil) otherwise.  The buffer must only contain message headers
or be narrowed only to them."
  (let ((msgid (message-fetch-field "message-id")))
    (if (and (stringp msgid) (string-match "<>" msgid))
        if-true
      if-false)))

(setq nnmail-split-fancy
      '(| ("from" mail                 ; bounces, messages from postmaster
               (| (dest "bert@.*" "mail.bounce.me")
                  "mail.bounce"))
          ("from" abuse               ; messages from abuse-like people...
           - "abuse@spamalicious\\.com" ; ...except Mycroft
           "mail.bounce")
          ; spam control
          ("x-spam-flag" "yes" "JUNK.spamassassin")
          (all cyberpromo    "JUNK.missed.cyberpromo") ; SPAM (cyberpromo)
          (all "iemmc\\.org" "JUNK.missed.iemmc")      ; SPAM (iemmc)
          (all "\\<spad.*"   "JUNK.missed.bastards")   ; "throw-away" addrs
          (: if-message-id-is-empty "JUNK.no-id")  ; empty Message-Id
              ; what about empty From: ?
          ; Gazette
          ("subject" "Daily Gazette" "maint.gazette")
          ; OLC-related filtering
          ("subject" "eolcr"   "olc-dev.eolcr")
          ("subject" "olc"     "olc-dev.current")
          ("subject" "rpd"     "olc-dev.current")
          ("subject" "polld"   "olc-dev.current")
          ("subject" "matisse" "olc-dev.current")
          (any "root@matisse"  "olc-dev.current")
          (any "bert-olc@.*"   "olc-dev.current")
          (any "olcdev@.*"     "olc-dev.current")
          ; mail from root etc. on various machines
          (from "root@.*mit\\.edu"
               (| ("subject" "Output from.*cron"
                             (| ("from" "root@\\([^.]*\\)\\..*"
                                        "maint.cron.\\1")
                                "maint.cron"))
                  ("subject" "check-backups\\|clean-db" "maint.cron.backups")
                  "maint.misc"))
          (to "root@.*mit\\.edu" "maint.misc")
          (any mail "maint.postmaster")
          (any "ftp-bugs@.*" "maint.ftp-bugs")
          ; bug-sipb mail (separate out common automated sources)
          (list "bug-sipb@.*" (| ("subject" "error exmh" "bug.sipb.exmh")
                                 "bug.sipb"))
          ; other bug-*
          (list    "bug-\\(\\w*\\)@.*" "bug.\\1")
          (list           "perldev@.*" "bug.perldev")  ; not bug-*, but close
          (list        "consultdev@.*" "bug.consult")  ; not bug-*, but close
          (list          "dotfiles@.*" "bug.dotfiles") ; not bug-*, but close
          (list            "diswww@.*" "bug.diswww")         ; likewise
          (list    "diswww-request@.*" "bug.diswww.request") ; ditto
          ; *-maintainers etc
          (list "\\<\\(.*\\)-maintainers@.*" "sipb.\\1")
          (list  "release-announce@.*" "maint.athena")
          (list     "athena-outage@.*" "maint.outage")
          (list          "netusers@.*" "maint.athena")
          (list         "zone-cell@.*" "watchmaker.zone-cell")
          ; various SIPB lists
          (list        "sipb-staff@.*" "sipb.staff")
          (list       "sipb-office@.*" "sipb.staff")
          (list "sipb-machine-room@.*" "sipb.staff")
          (list      "sipb-members@.*" "sipb.members")
          (list          "sipb-all@.*" "sipb.members")
          (list "sipb-prospectives@.*" "sipb.prospectives")
          (list   "sipb-discussion@.*" "sipb.flames")
          (list      "sipb-minutes@.*" "sipb.minutes")
          (list       "sipb-backup@.*" "sipb.backup")
          (list              "sipb@.*" "sipb.question")
          (list             "sipb-.*"  "sipb.other")
          ; various MIT lists
          (list          "\\<rumor@.*" "assassin.rumor")
          (all         "terror-gms@.*" (| (all "bert@.*" "assassin.terror.me")
                                          "assassin.terror"))
          (all    "\\<\\(.*\\)-gms@.*" "assassin.\\1")
          (list   "assassins-guild@.*" "assassin")
          (list          "apo-news@.*" "apo.news")
          (list         "axaa-news@.*" "apo.news.axaa")
          (list       "apo-pftgoto@.*" "apo.pftgoto")
          (list        "apo-summer@.*" "apo.summer")
          (list            "\\<apo@.*" "apo.all")
          (list              "apo-.*"  "apo.other")
          (list             "mitoc@.*" "mitoc")
          (list          "climbers@.*" "mitoc.climbers")
          (list              "esg-.*"  "random.esg")
          (list      "senior-house@.*" "random.senior-house")
          (list       "senior-haus@.*" "random.senior-house")
          (list           "sh-alum@.*" "random.senior-house.alum")
          (list               "aac@.*" "random.athletically-clined")
          (list          "diskless@.*" "random.diskless")
          (list           "patrol-.*"  "random.patrol")
          (list          "sipb-soc@.*" "random.sipb")
          (list               "sps@.*" "random.sps")
          (list         "mpcevents@.*" "random.sps")
          (list          "hyperion@.*" "random.b5")
          (list             "reuse@.*" "random.reuse")
          (list            "reuse-.*"  "random.reuse")
          (list         "institvte@.*" "random.institvte")
          (list          "ilg-talk@.*" "random.ilg.talk")
          (list          "ilg-news@.*" "random.ilg.news")
          (list             "ihtfc@.*" "random.ilg.ihtfc")
          (list               "gli@.*" "random.ancient-silly-lists")
          (list          "gedanken@.*" "random.gedanken")
          (list        "extropians.*"  "random.ick.extropians")
          (list  "lsc-info-request@.*" "random.lsc")
          (from    "www@lsc.mit.edu"   "random.lsc")   ; mailbot announcements
          (list               "fen@.*" "random.fenway")
          (list           "fen-all@.*" "random.fenway")
          (list           "mitsfs-.*"  "random.mitsfs")
          (list          "whovians@.*" "random.dr-who")
          (list              "bspd@.*" "random.bspd")
          (list  "chocolate-lovers@.*" "random.lovers.chocolate")
          (list        "summer-fun@.*" "random.summer-fun")
          (list         "black-tie@.*" "random.black-tie")
          (list       "diners-club@.*" "random.diners-club")
          (list        "nawm-users@.*" "hack.sw.nawm")
          (list      "zion-testers@.*" "hack.sw.zion")
          (list              "fftw@.*" "hack.sw.fftw")
          (list      "java-hackers@.*" "hack.java")
          (list           "hackers@.*" "hack.general")
          (list         "hacked.ws@.*" "maint.hacked-ws")
          (list             "ihtfp@.*" "hack.ihtfp")
          (list      "sushi-lovers@.*" "food.sushi")
          (list        "rav-eaters@.*" "food.rav-eaters")
          (list        "rav_eaters@.*" "food.rav-eaters")
          (list      "snapperheads@.*" "food.snapperheads")
          (list        "lunch-wars@.*" "food.lunch-wars")
          (list       "blood-drive@.*" "mit.blood-drive")
          (list "blood-drive-request@.*" "mit.blood-drive")
          (list           "MIT1995@.*" "mit.alum.1995")
          (list            "MITBOS@.*" "mit.alum.boston")
          (list           "MITYBOS@.*" "mit.alum.boston")
          ; IS cra^H^H^Hlists
          (list    "watchma?ke?rs?@.*" "watchmaker.general")
          (list         "source-.*@.*" "is.athena")
          (list      "athena-login@.*" "is.athena")
          (list              "dcns@.*" "is.dcns")
          (list          "dcns-dev@.*" "is.dcns")
          (list           "saurons@.*" "is.dcns")
          (list             "cwis-.*"  "is.cwis")
          (list             "ise40@.*" "is.e40")
          (list           "e40fish@.*" "is.e40.fish")
          (list           "infosys@.*" "is.general")
          (list           "acteams@.*" "is.general")
          (list            "chours@.*" "olc.hours")
          (list        "all-athena@.*" "olc.all")
          (list       "consultants@.*" "olc.all")
          (list      "n42-students@.*" "olc.n42")
          (list            "n42all@.*" "olc.n42")
          (list     "summer-athena@.*" "olc.all.summer")
          (list  "support-timecard@.*" "olc.timecard")
          (list    ".*svi@.*grad\\.hr" "cro.grad")
          ; non-MIT lists I read a lot
          ("reply-to"   "misljenja@.*" "cro.misljenja")
          (any "hrvatski-razgovori@.*" "cro.razgovori")
          (list           "hfdovci@.*" "cro.hfd")
          ; personal is just a little separate
          (dest "bert@.*"
                (| (from "abbe@.*"               "people.abbe")
                   (from "acohen@.*"             "people.abbe")
                   (from "dubravko.tomasovic@.*" "people.dubravko")
                   (from "konjevod\\+?@.*"       "people.goran")
                   (dest "bert@alum.mit.edu"     "mail.personal.alum")
                   "mail.personal"))
          ; filters for old lists (temporary-- for cleanup of mail.misc)
          (list        "wamit@.*" "JUNK.old-lists")
          (list          "lgc@.*" "JUNK.old-lists")
          (list         "ilg-.*"  "JUNK.old-lists")
          (list "housing-talk@.*" "JUNK.old-lists")
          ; default sorting rules for people I know should go here.
          ; finally, the default places for everything else.
          (any "infocalypse\\.mit\\.edu" "mail.misc.inf")
          (from "mit\\.edu"    "mail.misc.mit")
          (from "proven\\.org" "mail.misc")
          (from "ihack\\.net"  "mail.misc")
          (from ".*\\.hr\\>"   "mail.misc.hr")
          "mail.other"))
; ---END---
; since the above will auto-create groups, make sure we see those groups
(setq gnus-auto-subscribed-groups                   ; anything except "^nntp"
      "^.$\\|^..$\\|^...$\\|^[^n]\\|^n[^n]\\|^nn[^t]\\|^nnt[^p]"
      gnus-subscribe-newsgroup-method 'gnus-subscribe-hierarchically)

;(add-hook 'gnus-started-hook 'gnus-group-list-zombies 't) ; no-op if none such

; enable topics

;(setq gnus-topic-display-empty-topics nil)
(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)

;; Other foreign methods and groups

(setq nnvirtual-always-rescan 't
      nneething-map-file-directory "~/elisp/Gnus/nneething/")

;; Tweak summary and article displays

(setq gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20A%]%) %s\n"
      gnus-sorted-header-list
         '("^Received:" "^Message-Id:" "^From:" "^Organization:"
           "^Subject:" "^Summary:" "^Keywords:" "^To:" "^Cc:"
           "^Newsgroups:" "^Date:"))

;; Sort groups: backend, level, unread messages within each backend/level

(defvar my-gnus-backend-order '((nnml 10) (nnmh 2) (nntp -5))
  "An alist which defines the ordering of various backends for purposes of
sorting via `my-gnus-group-sort-by-backend-order' (q.v.).  The car of each
cell should be a symbol, while the cadr should be an integer value.")

(defun my-gnus-group-sort-by-backend-order (info1 info2)
  "Sort methods [backends] in customizable order.  The backend (a symbol)
is looked up in `my-gnus-backend-order', and resulting values sorted
numerically.  If a backend name isn't found, it defaults to 0; thus,
backends with order values above 0 go above unlisted ones, those with
values below go below."
  (let ((be1 (car (gnus-find-method-for-group (gnus-info-group info1) info1)))
        (be2 (car (gnus-find-method-for-group (gnus-info-group info2) info2))))
    (if (eq be1 be2) nil
      (> (or (nth 1 (assoc be1 my-gnus-backend-order)) 0)
         (or (nth 1 (assoc be2 my-gnus-backend-order)) 0)) )))

(setq gnus-group-sort-function '(gnus-group-sort-by-alphabet
                                 gnus-group-sort-by-level
                                 my-gnus-group-sort-by-backend-order))

;; Sort articles by length (# of lines).

; Needed to do (gnus-summary-sort 'lines ...)
(defsubst gnus-article-sort-by-lines (h1 h2)
  "Sort articles by article length (in lines)."
  (< (mail-header-lines h1)
     (mail-header-lines h2)))
; Needed by (gnus-summary-sort 'lines ...)
(defun gnus-thread-sort-by-lines (h1 h2)
  "Sort threads by root article length (in lines)."
  (gnus-article-sort-by-lines
   (gnus-thread-header h1) (gnus-thread-header h2)))

;; Preety cooolooors... [...with a LARGE hammer. =)]

(if (and window-system (x-display-color-p))
    (progn

      (if (boundp 'gnus-group-highlight)
      (setq gnus-group-highlight
            (append
       '(((and (= unread 0) mailp (eq level 1)) . gnus-group-mail-1-empty-face)
         ((and              mailp (eq level 1)) . gnus-group-mail-1-face)
         ((and (= unread 0) mailp (eq level 2)) . gnus-group-mail-2-empty-face)
         ((and              mailp (eq level 2)) . gnus-group-mail-2-face)
         ((and (= unread 0) mailp (eq level 3)) . gnus-group-mail-3-empty-face)
         ((and              mailp (eq level 3)) . gnus-group-mail-3-face)
         ((and (= unread 0) mailp (eq level 4)) . gnus-group-mail-4-empty-face)
         ((and              mailp (eq level 4)) . gnus-group-mail-4-face)
         ((and (= unread 0) mailp) . gnus-group-mail-low-empty-face)
         ((and              mailp) . gnus-group-mail-low-face))
       gnus-group-highlight)))

      (copy-face 'default 'gnus-group-mail-4-empty-face)
      (copy-face 'bold    'gnus-group-mail-4-face)

      (set-face-foreground 'gnus-group-mail-1-face         "orange2")
      (set-face-foreground 'gnus-group-mail-1-empty-face   "orange2")
      (set-face-foreground 'gnus-group-mail-2-face         "DeepPink3")
      (set-face-foreground 'gnus-group-mail-2-empty-face   "DeepPink3")
      (set-face-foreground 'gnus-group-mail-3-face         "MediumSlateBlue")
      (set-face-foreground 'gnus-group-mail-3-empty-face   "MediumSlateBlue")
      (set-face-foreground 'gnus-group-mail-4-face         "magenta4")
      (set-face-foreground 'gnus-group-mail-4-empty-face   "magenta4")
      (set-face-foreground 'gnus-group-mail-low-face       "gray60")
      (set-face-foreground 'gnus-group-mail-low-empty-face "gray60")
))

;; silly audio tricks

;(setq gnus-audio-au-player  "~/chaos/play-au-at-8000.sh"
;      gnus-audio-wav-player "~/chaos/play-wav-at-8000.sh"
;      gnus-audio-directory "/afs/sipb/contrib/emacs/packages/gnus-etc/sounds"
;      gnus-play-startup-jingle 't)

;; mark end
(message "%s's Gnus setup: done." user-login-name)