view mail-from-inf.el @ 63:e7c2deb7de20

old changes ??, get add-white working
author Henry S Thompson <ht@inf.ed.ac.uk>
date Mon, 16 Dec 2024 18:19:39 +0000
parents 963ac2f8e386
children
line wrap: on
line source

(setq my-mail-dir "/disk/scratch/mail"
      gnus-your-organization "HCRC, University of Edinburgh"
      gnus-home-directory "/disk/scratch/gnus"
      gnus-default-directory "/disk/scratch"
      nnmail-message-id-cache-file "/disk/scratch/gnus/.nnmail-cache"
      mail-sources
      '((file :path "/disk/scratch/mail/ht_mbox"))
      mail-source-crash-box "/tmp/crashbox" ; local disk
      nndraft-directory "/disk/scratch/drafts/"
      message-auto-save-directory "/disk/scratch/drafts/"
      mail-archive-file-name (concat "/disk/scratch/mail/cpy/general/"
						  (format-time-string
						   "%Y-%m" (current-time))
						  ".mbox")
)

(setq rmail-dont-reply-to-names "hthompso*\\|h\\.thompso*\\|ht@*" )

(setq rmail-show-mime nil)
(set-default 'ht-last-file (expand-file-name "/disk/scratch/mail/"))
(setq ht-diary-file-name "/disk/scratch/mail/diary.babyl")
(setq user-mail-address "ht@inf.ed.ac.uk")
(setq mail-append-host "inf.ed.ac.uk")
(setq mail-host-address "inf.ed.ac.uk")
(setq rmail-spool-directory (file-name-as-directory
			     (concat rmail-spool-directory
				     "ht-mail")))
;; don't know why this is necessary
(setq rmail-primary-inbox-list
      (list (concat rmail-spool-directory "ht")))

(setq white-subjects "\\b\\(phd\\|ilcc\\)\\b")

(setq white-domains (list))

(setq ad-domains (list "planetx.co.uk"))

(setq w3c-lists1
      '((any "w3c-xml-schema-\\([a-zA-Z]+\\)\\(@\\.w3\\.org\\)?" "xml-schema-\\1")
	(any "chairs\\(@\\.w3\\.org\\)?" "w3c-chairs" )
	(to "\\(w3c\\|public\\|member\\)-xml-\\([-a-zA-Z]+\\)\\(\\.w3\\.org\\)?"
	    "xml-\\2" )
	;(list "w3t-\\([-a-zA-Z]+\\)\\(\\.w3\\.org\\)?" "w3t-\\1")
	;(list "team-\\([-a-zA-Z]+\\)\\(\\.w3\\.org\\)?" "w3-team-\\1")
	;(list "w3c-\\(xsl-wg\\|format\\|i18n-ig\\)\\(\\.w3\\.org\\)?" "w3c-xsl")
	(any "w3c-\\([-a-zA-Z]+\\)\\(@\\.w3\\.org\\)?" "w3c-\\1")
	(any "member-\\(ac-uk\\|access\\)" "w3-member-\\1");[-a-zA-Z]+\\)
	(to "public-xpointer-registry\\(-request\\)?"
	    "xpointer-registry");[-a-zA-Z]+
	(to "public-\\([-a-zA-Z]+\\)" "w3-public-\\1")
	(to "w3c-xml-schema-\\([a-zA-Z]+\\)" "xml-schema-\\1")
	(to "chairs" "w3c-chairs")
	(to "w3c-xml-\\([-a-zA-Z]+\\)" "xml-\\1" )
	(to "www-xml-\\([-a-zA-Z]+\\)" "xml-\\1")
	;(list "www-\\([-a-zA-Z]+\\)" "www-\\1")
	;(to "w3c-\\(xsl-wg\\|format\\|i18n-ig\\)" "w3c-xsl")
	;(to "w3t-\\([-a-zA-Z]+\\)" "w3t-\\1")
	;(to "team-\\([-a-zA-Z]+\\)" "w3-team-\\1")
	;(to "w3c-\\([-a-zA-Z]+\\)" "w3c-\\1")
	;(to "xml-\\([-a-zA-Z]+\\)" "w3c-\\1")
	;(to "member-\\([-a-zA-Z]+\\)" "w3-member-\\1")
	;(to "ercim-\\([-a-zA-Z]+\\)" "ercim-\\1")
	;(to "w3t" "w3t")
	))

(setq w3c-lists2
      '((to "w3t-archive" "w3t-archive")
	(to "w3c-archive" "w3c-archive")))

(setq xml-lists1
      '(;(to "xml-uri" "nsuri")
	(to ".*editor.*" "xml-rec-comments")
	(to "xml-dev" "xml")
	(to "xsl-list" "xsl")
	;(to "[Xx]emacs[- ]beta" "xemacs")
	(to "xmlschema-dev" "schema-dev")
	(to "xproc-dev" "xproc-dev")
	;(to "xml-sig" "xml-python")
	;(to "xml-plenary" "xml-plenary")
	))

(setq xml-lists2
      '((any "ietf-xml-mime\\.imc\\.org" "xml-mime")
	(any "xml-mime\\.ietf\\.org" "xml-mime")))

(setq misc-list1
      '(;(from "w3t-\\([a-zA-Z]+\\)-request" "w3t-\\1")
	;(from "w3c-\\([a-zA-Z]+\\)-request" "w3c-\\1")
	;(from "xml-\\([a-zA-Z]+\\)-request" "xml-\\1")
	;(from "p.woolman" "nhs-xml")
	(from "Cron Daemon" "cron")
	(from ".*@mail.gumtree.com" "personal")
	(from ".*@postman.storyworth.com" "storyworth")
	;(from "\\(Richard\\.Kirkham\\|rachel\\.johnson\\|maria\\.papadaki\\|marisol\\.leonen\\|sangeeta\\.tewar\\|abdullah\\.alshamsi\\|.*@buid\\.ac\\.ae\\)" "buid")
	(to "www-tag" "tag")
	;(to "webarch@noreply.github.com" "tag")
	;(to "dashboard-hackers" "beagle")
	;(to "pellet-users" "pellet")
	(to "tkinter-discuss" "tkinter")
	;(to "sdp-students" "sdp")
	(to "fnlp-students" "fnlp")
	;(from "fox@tardis\\.ed\\.ac\\.uk\\|s1505551" "fnlp")
	;(to "anlp-students" "anlp")
	;(from "nbnotifications" "anlp")
	;(: split-on-whole-field "Subject" "Re: MSc Project 18.*" "msc18")
	;(: split-on-whole-field "Subject" ".*\\(FNLP\\|100782021\\).*" "fnlp")
	;(: split-on-whole-field "Subject" ".*SDP \\(MS .\\|final\\) evaluation" "sdpEval")
	;(: split-on-whole-field "Subject" ".*[[]SDP[]] \\(Your evaluation\\|Evaluation deadline\\).*" "sdpEval")
	;(: split-on-whole-field "Subject" ".*SDP.*" "sdp")
	;(: split-on-whole-field "Subject" ".*Welcome to ANLP, action needed.*" "anlp_github")
	(: split-on-whole-field "Subject" ".*\\(ANLP\\|Accelerated Natural Language Processing\\).*" "anlp")
	(from "ANLP on Piazza" "anlp")
	;(from "FNLP on Piazza" "fnlp")
	(from "alopez\\|learn\\|scohen\\|eponti" "anlp")
	(from "080202022-3SV1SEM2" "inf1-cg")
	(from "INFR111252023-4SV1SEM1" "anlp")
	(from "no-reply@piazza.com" "anlp")
	(: split-on-whole-field "Subject" ".*Personal Tutor.*" "tutees22")
	(: split-on-whole-field "Subject" ".*Course Selection.*" "tutees22")
	;(: split-on-whole-field "Subject" ".*Sutton Trust.*" "inf-recruit")
	(: split-on-whole-field "Subject" "mycron .*" "cron")
	;(: split-on-whole-field "Subject" "INF1-Cg experiment.*" "cgx_2013")
	(: split-on-whole-field "Subject" ".*[[]urn[]].*" "urn")
	(from "\\(106300.457@compuserve.com\\|elizdrummondyoung@gmail.com\\|jcdavey12@btinternet.com\\|andrewdolan@btinternet.com\\|wandbamoyes@btinternet.com\\)" "albertus")
	(to "corpus-admin" "corpora")
	(: split-on-whole-field "Subject" ".*Albertus.*" "albertus")
	(: split-on-whole-field "Subject" ".*\\[corpus-admin\\].*" "corpora")
	;(to ".*@\\(hst\\|hthompson\\|henry\\.thompson\\)\\.name" "personal")
	(from "mikereape@.*" "mikereape")
	(from "\\(.*@mumble\\.net\\|jar@\\.csail\\.mit\\.edu\\)" "jar")
	(from ".*@coulters.io" "belford")
	(from ".*@umega.co.uk" "belford")
	(to ".*@umega.co.uk" "belford")
	(: split-on-whole-field "Subject" ".*belford.*" "belford")
	))

(setq quaker-list
      '((to "quaker-\\(l\\|spectrum\\)" "quaker")
	;(to "quaker-b" "quaker-b")
	;(to "QuakerBYM" "quaker-b")
	;(from "quaker-spectrum-approval" "quaker")
	))

(setq sms-list
      '(;(from "s1513009@.*" "ug4_18");\\|s1536017\\(s1443062\\|s1679328
	;(from "Y.Chen-258@.*" "msc_19")
	;(from "\\(s1795066\\|s1825415\\|A.M.Magalhaes\\|T.Makino\\|S.Li-93\\|M.Maggiolo\\|ashe\\|Y.Li-242\\|E.J.Martin\\|K.Lohse\\|D.Li-28\\|S.D.Martin-1\\|K.Chen-35\\|J.Norris-3\\|S.Li-80\\|Y.Liu-236\\|J.Chen-114\\|Q.Zeng-3\\|Y.Liu-244\\|P.Guo-1\\|s1582739\\|B.Lun\\|X.Li-143\\|F.Li-17\\|K.R.Lu\\|Z.Li-86\\)@.*" "tutees18")
	(from "\\(s1895309\\|s1765180\\|s1764494\\|s1645474\\|s1953043\\|s1651774\\|s1732316\\|s1742667\\)@.*" "tutees20")
	))

(defalias 'tut20 (read-kbd-macro
"C-x o C-s < RET C-s @ C-b C-x C-x M-w C-x b gnus SPC RET C-s \"tutees20 RET C-r \\\\) RET \\\\| C-y C-a ESC ESC : nil RET ESC C-x M-x ht- 3*<backspace> set- ht SPC RET C-x C-s C-x b RET C-x o"))

;;; groups only, comes _after_ split to pers-... for to: ht...
(setq misc-list2
      '(;(to "cogsci.general" "junk")
	(from "anrdaemon@yandex.ru\\|gsenopu@gmail.com\\|pradeepan88@hotmail.com" "anr-doom")
	;(to "bp-people" "bp-people")
	;(to "ppelders" "ppelders")
	;(to "7vtw" "7vtw")
	(to "\\(apps-review\\|uri-review\\|apps-discuss\\|discuss\\|architecture-discuss\\|appsdir\\|art\\)@[a-z.]*\\(ietf\\|iab\\).org" "ietf")
	(to "urn@ietf.org" "urn")
	(to "if-people" "if-people")
	(to "maptask" "maptask")
	;(to "i18n-sig" "xml-python")
	;(to "spec-prod" "spec-prod")
	;(to "markup" "markup")
	;(to "system-notices" "w3c-sys-notes")
	(to "[cC]ygwin" "cygwin")
	;(to "jde@sunsite.dk" "jde")
	;(to "jdee-users@lists.sourceforge.net" "jde")
	(to "tagsoup-friends@yahoogroups.com" "tagsoup")
	(to "screen-users@gnu.org" "screen")
	(from "mailinglist@edinburghrc.co.uk" "erc")
	(to "selenium-users" "selenium")
	(to "python-list@python.org" "python")
	;(to "ding" "gnus")
	;(to "dssslist" "dsssl")
	;(to "TEI-L" "tei")
	(to "\\(announcements\\|unicode\\)@.*[.]unicode[.]org" "unicode")
	;(to "squid-users@lists.squid-cache.org\\|squid-users@squid-cache.org"
	;    "squid")
	(to "exist-open" "exist")
	(any "ilcc-\\([a-zA-Z]+\\)" "ilcc-\\1")
	(to "ilcc" "ilcc")
	(to ".*lecturers@inf.ed.ac.uk" "inf-teach")
	(to "\\(aisyllabus\\|acstaff\\)" "inf-teach")
	(to "\\(inf\\)?\\(pg\\|msc\\|teach\\|res\\|staff\\)\@inf\\(ormatics\\)?"
	    "inf-\\2" )
	;(to "directors-of-studies" "inf-dos")
	(to "common-crawl@googlegroups.com" "ccrawl")
	;(list "inkscape-user\\|openbox\\|ffmpeg-user" "misc-list")
	))

(defconst ht-spam-res '("bfSPAM" "boSPAM" "edSPAM" "saSPAM" "slSPAM"))

(defun log-good-sender (sres)
  (message "good sender %s with result %s" (get-from-gnus-addr) sres))

(setq nnmail-split-fancy
      '(|
	(to "ht\\+d@inf\\.ed\\.ac\\.uk" "_diary")
        (!
	(lambda (sres)
	  (cond
	   ((or (equal (car sres) "notSPAM")
		(white-spam t))
	    ;; documentation is wrong, no recursion,
	    ;; so we do it ourselves :-(
	    (message "was %s, trying further" sres)
	    (setq sres (nnmail-split-it ht-compiled-split))
	    (log-good-sender sres)
	    sres)
	   ((member (car sres) ht-spam-res)
	    sres)
	   (t ; shouldn't happen!
	    (message "Shouldn't happen in nnmail-split-fancy %s" sres)
	    sres))
	  )
	(| (: split-on-whole-field "Subject" ".*=\\?UTF-8\\(\\?B\\\?\\|.*=[A-F][0-9]=\\).*\\?=.*" "slSPAM")
	     ("X-Bogosity" "Yes.*"
	      (| 
	       (From ".*@.*ed\.ac\.uk" "edSPAM") ; NB From not from
	       ("X-Spam-Score" "0" "boSPAM")
	       "bfSPAM"))  
	     (: split-on-whole-field "X-Spam-Level" "\\*\\*\\*\\*.*"
		"saSPAM")
	     ("X-Spam-Status" "Yes.*" "saSPAM")
	     "notSPAM"))))

(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")
	  (: ad-spam "adverts")
;;;	  ("Content-Type" content-spam "gnSPAM")
;;;	  ("Content-Transfer-Encoding" encoding-spam "gnSPAM")
;;;	  (: split-on-whole-subj 'subject-spam "gnSPAM")
	  ;; Special to people who use Yahoo
;;;	  ("X-YahooFilteredBulk" ".*" "gnSPAM")
;;;	  (from author-spam "gnSPAM")
	  ;; A subject with no letters is SPAM
;;;	  (: split-on-whole-subj "^[^a-zA-Z]+$" "gnSPAM")
	  ;; It would be cool to check the
	  ;; date and toss it if it is "old"
	  (to "\\(w3[ct]\\|www\\|team\\|member\\|public\\|ercim\\)[^ ]*@.*"
	      (| ,@w3c-lists1
		 (to "ht\\|henry\\|\\(h\\.?\\)?thompson?" ,now-pers)
		 ,@w3c-lists2
		 (to "x.*@.*" (| ,@xml-lists1
			  (to "ht\\|henry\\|\\(h\\.?\\)?thompson?" ,now-pers)
			  ,@xml-lists2
			  ,now-group))))
	  (to "x.*@.*" (| ,@xml-lists1
			  (to "ht\\|henry\\|\\(h\\.?\\)?thompson?" ,now-pers)
			  ,@xml-lists2))
	  ,@misc-list1
	  (to "ht\\|henry\\|\\(h\\.?\\)?thompson?"
	      (| (from ".*@sms.ed.ac.uk" (|
					  ,@sms-list
					  ,now-pers))
	  
		 ,now-pers))
	  (to "quaker.*" (|
			  ,@quaker-list
			  ,now-group))
	  ,@misc-list2
	  ,now-group
	  ))))

(defun quaker-sig-maybe ()
  (save-excursion
    (goto-char (point-max))
    (search-backward "\n-- \n")
    (when (looking-at "\n-- \n       Henry")
      (forward-char 5)
      (kill-entire-line 6)
      (insert-file "/afs/inf.ed.ac.uk/user/h/ht/.quaker-sig"))))

(defun straight-to-diary ()
  (save-excursion
    (gnus-group-jump-to-group "nnml+ht:_diary")
    (message "s1 %s" (get-text-property (point) 'gnus-group))
    (gnus-group-select-group)
    (while (gnus-summary-first-unread-article)
      (let ((sco (get-buffer "*Shell Command Output*")))
	(if sco
	    (kill-buffer sco)))
      (gnus-edit-and-move-to-diary_1 nil t))
    (gnus-summary-exit)
    )
  )

(add-hook 'gnus-after-getting-new-news-hook
 (lambda ()
   (if (member "_diary" ht-gnus-just-read)
       (straight-to-diary))))

(provide 'mail-from-inf)