--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/emacs/gnus-init.el	Tue May 25 13:58:37 2021 -0400
@@ -0,0 +1,316 @@
+;; Last edited: Fri Aug 20 14:49:23 1999
+;; gnus customisation
+(setq mm-inline-large-images t)		;prevent crash in mm-image-fit-p ???
+(setq gnus-novice-user nil)
+(setq gnus-message-archive-group
+      '((concat "general." (format-time-string
+			   "%Y-%m" (current-time)))))
+
+(setq 	gnus-summary-ignore-duplicates t
+	gnus-auto-select-next 'quietly
+	gnus-summary-display-arrow nil
+	gnus-your-organization "HCRC, University of Edinburgh"
+	gnus-ignored-headers
+	      "^Errors-To:\\|^Precedence:\\|^UNIX-From:"
+        mm-discouraged-alternatives '("text/html")
+	nnmail-expiry-wait 28
+	nnmail-spool-file
+	'((file)(file :path "/home/ht/mbox")))
+
+(setq bbdb/news-auto-create-p t)
+
+(defconst hash-file "/home/ht/.whitelist")
+
+(defvar white-hash (make-hash-table :test (function equal)))
+
+(with-current-buffer (get-buffer-create " *Whitelist")
+  (insert-file-contents hash-file)
+  (goto-char (point-min))
+  (while (not (eobp))
+    (puthash (buffer-substring (point) (progn
+					 (end-of-line)
+					 (point)))
+	     t
+	     white-hash)
+    (forward-line)))
+
+(defun get-from-addr ()
+  (gnus-extract-address-components
+   (gnus-fetch-field "From")))
+
+(defun get-current-from-addr ()
+  (with-current-buffer gnus-article-buffer
+    (get-from-addr)))
+
+(defun white-list (list)
+  (if (or (gethash (cadr (get-from-addr))
+		   white-hash)
+	  (let ((subj (gnus-fetch-field "Subject")))
+	    (and subj
+		 (string-match "\\[\\([^]]*\\)\\]" subj)
+		 (member (match-string 1 subj) white-lists))))			     
+      list))
+
+(defun add-white ()
+  (interactive)
+  (gnus-summary-goto-article (gnus-summary-article-number))
+  (do-add-white (cadr (get-current-from-addr))))
+
+(defun do-add-white (addr)    
+  (puthash addr t white-hash)
+  (with-current-buffer (get-buffer " *Whitelist")
+    (let ((max (point-max)))
+      (goto-char max)
+      (insert addr)
+      (insert "\n")
+      (write-region max (point) hash-file t))))
+
+(defun bogoNote (group) 
+  (shell-command-on-region (point-min) (point-max) 
+                           "/home/ht/bin/makeBogo") 
+  'delete)
+
+
+(defun whiten-recip ()
+  ;;; a hook for outgoing mail
+  (let ((recips (message-options-get 'message-recipients)))
+    (mapcar (function new-white)
+                      (split-string recips ",[ \f\t\n\r\v]+" t))))
+
+(add-hook 'message-sent-hook (function whiten-recip))
+
+(defun new-white (addr)
+  (if (gethash addr white-hash)
+      nil
+    (do-add-white addr)))
+
+(setq wsp-cache nil)
+
+(defun split-on-whole-field (field pat list)
+  (goto-char (point-max))
+  (let ((hit (assq pat wsp-cache))
+        rpat)
+    (if hit
+        (setq rpat (cdr hit))
+      (setq rpat
+         (concat "^"
+                 field
+                 ":\\s-*"
+                 (if (stringp pat)
+                     pat
+                   (cdr (assq pat
+                              nnmail-split-abbrev-alist)))
+                 "$"))
+      (setq wsp-cache (cons (cons pat rpat) wsp-cache)))
+    (if (re-search-backward rpat nil t)
+        list)))
+
+(setq nnmail-crosspost nil)
+(setq nnmail-split-methods 'nnmail-split-fancy)
+
+(setq ht-lists
+      '(("Subject" "Cron <mt> /home/mt/bin/heartbeat" "heartbeat")
+	("Subject" "Cron <mt[@]markup> /home/mt/bin/heartbeat" "heartbeat")
+	(to "xml-dev" "xml")
+	(to "markup@markup[a-zA-Z]*" "markup")
+	(to "general@developer.marklogic.com" "marklogic")
+	(to "betterform-users@lists.sourceforge.net" "betterform")
+	(to "betterform-developer@lists.sourceforge.net" "betterform")
+	(to "mrbs-[a-zA-Z]*@lists.sourceforge.net" "mrbs")
+	(to "selenium-users" "selenium")
+	(to "sqlobject-discuss" "sqlobject")
+	(to "exist-open@lists.sourceforge.net" "exist")
+	(to "exim-users@exim.org" "exim")
+	(to "exist-development@lists.sourceforge.net" "exist")
+	(to "xsltforms-support@lists.sourceforge.net" "xsltforms")
+	(to "mtt" "mtt")
+	(to "ding" "gnus")))
+
+(setq white-lists '("selenium-users" "Betterform-users" "Exist-development" "Exist-open"))
+
+(defvar ht-compiled-split nil)
+
+(defun set-ht-compiled-split ()
+  "update the mail splitting rules"
+  (interactive)
+  (setq ht-compiled-split
+      (let* ((month
+              (format-time-string "%Y-%m" (current-time)))
+             (now-group (concat "group-" month))
+             (now-pers (concat "pers-" month)))
+        `(|
+          (: split-on-whole-field "Subject" "testing" 'junk)
+          ,@ht-lists
+          (to "ht\\|henry\\|\\(h\\.?\\)?thompson?" ,now-pers)
+	  (to "xml-dev" "xml")
+	  ,now-group
+          ))))
+
+(set-ht-compiled-split)
+
+(setq nnmail-split-fancy
+      '(!
+        (lambda (sres)
+          (if (or (equal (car sres) "notSPAM")
+                  (equal (car sres) "waSPAM"))
+              ;; documentation is wrong, no recursion,
+              ;; so we do it ourselves :-(
+              (nnmail-split-it ht-compiled-split)
+            sres))
+        (| (to "ht@hppllc.org" "llc")
+	   ("X-Bogosity" "\\(Yes\\|Unsure\\).*"
+            (| (: white-list "waSPAM")
+               ("X-Spam-Score" "0" "boSPAM")
+	       ("X-Bogosity" "Unsure.*" "mSPAM")
+               "bfSPAM"))
+           (: split-on-whole-field "X-Spam-Level" "\\*\\*\\*\\*.*"
+              '(| (: white-list "waSPAM")
+                  "saSPAM"))
+           ("X-Spam-Status" "Yes.*"
+            (| (: white-list "waSPAM")
+               "saSPAM"))
+           "notSPAM")))
+
+(defun ht-gnus-summary-delete-forward ()
+  "REAL delete for nnmail gnus"  
+  (interactive)
+  (gnus-summary-delete-article)
+  (gnus-summary-next-unread-article))
+
+(require 'my-news)
+(setq gnus-show-mime t) ; stale
+
+;; try to ignore list name in subject for sorting
+(setq message-subject-re-regexp "^[ 	]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ 	]*\\)*\\(\\[[^]]*\\]\\)?[ 	]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ 	]*\\)*")
+
+(custom-set-variables
+ '(gnus-treat-display-picons nil))
+(custom-set-faces)
+
+(require 'mm-decode)
+(setq mm-automatic-display (remove "text/html" mm-automatic-display))
+
+(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
+
+(add-hook 'gnus-summary-mode-hook 'gnus-summary-mode-fun1)
+ 
+;; run the first time we make a summary window
+(defun gnus-summary-mode-fun1 ()
+  "install ht's mods"
+  (define-key gnus-summary-mode-map "D" 'ht-gnus-summary-delete-forward)
+  (define-key gnus-summary-mode-map "\M-d" 'gnus-edit-and-move-to-diary)
+  (define-key gnus-summary-mode-map "\M-e" 'gnus-extract-attachment)
+  (define-key gnus-summary-mode-map "\M-w" 'add-white)
+  (define-key gnus-summary-mode-map "\M-h" 'showMPAhtml)
+  (define-key gnus-summary-mode-map "~" 'mark-and-mark)
+  (remove-hook 'gnus-summary-mode-hook 'gnus-summary-mode-fun1))
+
+(defun ht-gnus-pers-refresh (n)
+  (interactive "p")
+  (let ((gn (concat "nnml+ht:pers-"
+				 (format-time-string "%Y-%m" (current-time)))))
+    (gnus-group-goto-group gn)
+    (gnus-group-get-new-news-this-group n)
+    (gnus-group-goto-group gn)
+    (gnus-group-read-group))
+  )
+
+(add-hook 'gnus-group-mode-hook 'gnus-group-mode-fun1)
+ 
+;; run the first time we make a group window
+(defun gnus-group-mode-fun1 ()
+  "install ht's mods"
+  (define-key gnus-group-mode-map "\M-\C-g" 'ht-gnus-pers-refresh)
+  (remove-hook 'gnus-group-mode-hook 'gnus-group-mode-fun1))
+
+(defun gnus-user-format-function-t (header)
+  "display the to field (for archive messages)"
+  (let ((n (mail-header-number header)))
+    (with-current-buffer nntp-server-buffer
+      (save-excursion
+	(save-restriction
+	  (let ((inhibit-point-motion-hooks t))
+	    (goto-char (point-min))
+	    (let ((beg (search-forward (format " %d Article retrieved." n)))
+		  (end (search-forward "\n.\n")))
+	      (narrow-to-region beg end)
+	      (goto-char beg)
+	      (message-fetch-field "To"))))))))
+
+(defun showMPAhtml ()
+  "Show the text/html parts of an multipart/alternative message using lynx"
+  (interactive)
+  (gnus-summary-select-article)
+  (with-current-buffer gnus-original-article-buffer
+    (shell-command-on-region (point-min) (point-max) "/home/ht/bin/showMPA.sh")
+    )
+  )
+
+(defun gnus-extract-attachment ()
+  "extract attachments from a multi-part mime message"
+  (interactive)
+  (let ((sm gnus-show-mime))
+    (if sm
+	(progn (setq gnus-show-mime nil)
+	       (gnus-summary-select-article t 'force))
+        )
+    (gnus-article-show-all-headers)
+    (with-current-buffer gnus-article-buffer
+      (save-excursion
+	(save-restriction
+	  (mime/viewer-mode)
+	  (delete-other-windows)
+	  (let ((pt 0))
+	    (while (progn
+		     (mime-viewer/next-content)
+		     (and
+		      (equal "*Preview-*Article**" (buffer-name (current-buffer)))
+		      (not (= pt (point)))))
+	      (setq pt (point))
+	      (if (looking-at "^\\[[0-9]* \\([^ ]+ \\)+<")
+		  (mime-viewer/extract-content)))))))
+    (kill-buffer "*Preview-*Article**")
+    (setq gnus-show-mime sm)
+    ))
+
+(make-variable-buffer-local 'gnus-extra-headers)
+(make-variable-buffer-local 'nnmail-extra-headers)
+(add-hook 'gnus-parse-headers-hook
+	  '(lambda ()
+	     (gnus-summary-set-local-parameters gnus-newsgroup-name)))
+
+(defun del-dups () 
+  (interactive) 
+  (gnus-summary-sort-by-subject) 
+  (gnus-summary-clear-mark-forward 1) 
+  (goto-char (point-min)) 
+  (let ((pos)) 
+    (while (setq pos (search-forward "] " nil t)) 
+      (end-of-line) 
+      (let ((subj (buffer-substring pos (point)))) 
+        (unless (equal subj "") 
+          (let ((target (if (< (length subj) 26) 
+                            (concat "] " subj "\n") 
+                          (concat "] " (substring subj 0 25)))) 
+                (done 0) 
+                (case-fold-search nil)) 
+          (while (and (= done 0) 
+                      (search-forward target nil t)) 
+            (forward-char -3) 
+            (setq done (gnus-summary-mark-as-read-forward 1)))))))) 
+  (gnus-summary-limit-to-unread) 
+  (gnus-summary-sort-by-original)) 
+
+(add-hook 'gnus-get-new-news-hook (lambda () (setq ht-gnus-just-read nil)))
+
+(add-hook 'gnus-after-getting-new-news-hook
+          (lambda () (message "%s" ht-gnus-just-read)))
+
+(defvar ht-gnus-just-read nil)
+
+(defun ht-gnus-note-save-to-group ()
+  (let ((g (caar group-art)))
+    (if (not (member g ht-gnus-just-read))
+	(setq ht-gnus-just-read (cons g ht-gnus-just-read)))))
+
+(add-hook 'nnml-prepare-save-mail-hook (function ht-gnus-note-save-to-group))