;; -*- mode: emacs-lisp; coding: utf-8 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Author: Berthier Nicolas
;; Last modified: Tue Oct 20 09:38:28 2015
;;
;; Splitting rules definition.
;;
;; See `http://people.irisa.fr/Nicolas.Berthier/tools' for related configuration
;; files.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change Log:
;; 14-Nov-2013    Nicolas Berthier  
;;    Better customized gnus-registry.
;; 30-Oct-2013    Nicolas Berthier
;;    Cleaned up unused filters.
;; 9-Jan-2013    Nicolas Berthier
;;    Shifted usage of gnus registry right after mailing-list filters, because
;;    messages of newly subscribed lists were directed to the spam folder
;;    otherwise; dunno why…
;; 21-Nov-2012    Nicolas Berthier
;;    Avoid IMAP subdirectories (due to an IMAP server that seemingly does not
;;    support them).
;; 17-Jul-2012    Nicolas Berthier
;;    Disabled `nac'.
;; 28-Jun-2012    Nicolas Berthier
;;    Gnus-registry integration.
;; 8-Sep-2011    Nicolas Berthier
;;    Added licence header.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License version 3 (or higher) as
;; published by the Free Software Foundation.
;;
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
;; details.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require 'cl)				;I use some common-lisp constructs.
(require 'gnus-registry)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Some regexps to detect flags.
(defconst my-gnus-patch-flag
  (concat ".*" (regexp-opt '("[patch" "patch]" "[rfc" "rfc]")) ".*"))

(defconst my-gnus-bugs-flag
  (concat ".*" (regexp-opt '("[bug" "bugs]" "bug]")) ".*"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Registry configuration
 	

(setq gnus-registry-max-entries 10000
      gnus-registry-use-long-group-names t
      gnus-registry-track-extra '(sender subject)
      gnus-registry-cache-file (expand-file-name "gnus.registry.eioio"
						 gnus-directory))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The rules
(setq nnimap-inbox "INBOX"		;<- since emacs 24
      ;; nnimap-split-inbox '("INBOX" "SENT")
      nnimap-split-predicate "UNDELETED"

      ;; avoid duplicating mail while splitting: the first matching
      ;; rule will be used
      nnimap-split-crosspost nil

      ;; Download message body to use with spam detectors... (not anymore!)
      nnimap-split-download-body nil
      nnimap-split-fancy-match-partial-words t

      nnmail-split-fancy
      (labels
	  ((dev-split (b suf &optional junkpatch junkbugs)
	     (list '\|
		   (list "subject" my-gnus-patch-flag
			 (if junkpatch 'junk (concat b ".patch")))
		   (list "subject" my-gnus-bugs-flag
			 (if junkbugs  'junk (concat b ".bugs")))
		   (concat b suf)))

	   (g (u h)		(regexp-opt (list (concat u "@" h))))
	   (gg (u h)		(concat u (regexp-opt (list (concat "@" h)))))
	   (gs (u hs)		(regexp-opt (mapcar (lambda (h)
						      (concat u "@" h)) hs)))

	   (april (u)			(g u "april.org"))
	   (artist (u)			(g u "lists.artist-embedded.org"))
	   (asf (u)			(g u "sigops-france.fr"))
	   (cines (u)			(g u "cines.fr"))
	   (dbd (u)			(g u "defectivebydesign.org"))
	   (debian-lists (u)		(g u "lists.debian.org"))
	   (ensimag (u)			(g u "ensimag.imag.fr"))
	   (fsf (u)			(g u "fsf.org"))
	   (fsfla (u)			(g u "fsfla.org"))
	   (fsfm (u)			(g u "member.fsf.org"))
	   (gmail (u)			(g u "gmail.com"))
	   (mailoo (u)			(g u "mailoo.org"))
	   (gnu (u)			(g u "gnu.org"))
	   (pgmane (u)			(gg u "plane.gmane.org"))
	   (id (u)			(g u "lists.infradead.org"))
	   (imag (u)			(g u "imag.fr"))
	   (inria (u)			(g u "inria.fr"))
	   (inria+ (u)			(gs u '("inria.fr" "inrialpes.fr")))
	   (inrialp (u)			(g u "inrialpes.fr"))
	   (irisa (u)			(g u "irisa.fr"))
	   (irisa+ (u)			(gs u '("irisa.fr" "inria.fr")))
	   (irisa-lst (u)		(g u "listes.irisa.fr"))
	   (afsec (u)			(g u "afsec.asr.cnrs.fr"))
	   (nongnu (u)			(g u "nongnu.org"))
	   (ornl (u)			(g u "sws1.ornl.gov"))
	   (ujf (u)			(g u "ujf-grenoble.fr"))
	   (ostudresd (u)		(g u "os.inf.tu-dresden.de"))
	   (lst-tue (u)			(g u "listserver.tue.nl"))
	   (ukiel (u)			(g u "informatik.uni-kiel.de"))
	   (sel4 (u)			(g u "sel4.systems"))
	   (nbsp (u)			(gg u "nberth.space"))

	   ;; One of the servers does not seem to support IMAP subdirectories…
	   ;; so, switch to a simpler naming scheme:
	   (finalize (n)		(replace-regexp-in-string "/" "." n))
	   (grp (n)			(finalize n))
	   (lst (n)			(finalize (concat "lst." n)))
	   (mod (n)			(finalize (concat "mod." n)))

	   (flag (w)			(concat ".*\\[" w "\\].*")))

	(let ((courir	(flag "courir@irisa.fr"))
	      (nac	"news.announce.conferences")
	      (mnbsp	(nbsp "m\\(?:ail\\)?")))
	  `(\|
	    
	    ;; lists:
	    ("subject" ,(flag "Artist Mailing List")	,(lst "artist"))
	    (to ,(artist "announcements")		,(lst "artist"))
	    (to ,(asf "membres")			,(lst "asf"))
	    (to ,(cines "asr-forum")			,(lst "asr"))
	    ("subject" ,(flag "asr-forum")		,(lst "asr"))
	    ("subject" ,(flag "SEWORLD")		,(lst "seworld"))
	    (to ,(afsec "afsec")			,(lst "afsec"))
	    (to ,(lst-tue "concurrency")		,(lst "concurrency"))
	    ("subject" ,(flag "Concurrency")		,(lst "concurrency"))

	    (from ,(dbd "info")				,(lst "dbd"))
	    (to ,(april "april-actu")			,(lst "april"))
	    (to ,(debian-lists "debian-hurd")		,(lst "debian-hurd"))
	    (to ,(debian-lists "debian-ports")		,(lst "debian-ports"))
	    (to ,(fsf "info")				,(lst "fsf"))
	    (to ,(fsf "info-fsf")			,(lst "fsf"))
	    (to ,(gnu "bug-hurd")			,(lst "bug-hurd"))
	    (to ,(gnu "emacs-devel")			,(lst "gnu/emacs"))
	    (to ,(gnu "fsfe-france")			,(lst "fsfe/france"))
	    (to ,(gnu "gnu-system-discuss")		,(lst "gnu/system"))
	    (to ,(gnu "info-fsf")			,(lst "fsf"))
	    (to ,(gnu "info-gnu-emacs")			,(lst "gnu/emacs"))
	    (to ,(gnu "emacs-orgmode")			,(lst "gnu/emacs-orgmode"))
	    (to ,(pgmane "public-emacs-orgmode-.*")	,(lst "gnu/emacs-orgmode"))
	    (to ,(inria "bzr-people")			,(lst "bzr"))
	    (to ,(nongnu "gnewsense-dev")		,(lst "gnewsense"))
	    (to ,(nongnu "h-source-users")		,(lst "h-node-users"))

	    ;; Maybe outdated.
	    (to ,(ukiel "rt-sc-sj")			,(lst "rt-sc-sj"))
	    (to ,(gnu "hurd-devel-readers")		,(lst "hurd/devel"))
	    (to ,(gnu "l4-hurd")			,(lst "hurd/l4"))
	    (to ,(gnu "commit-hurd")			,(lst "hurd/commit"))
	    (to ,(fsfla "linux-libre")			,(lst "linux/linux-libre"))
	    (to ,(ostudresd "l4-hackers")		,(lst "l4/hackers"))
	    (to ,(sel4 "announce")			,(lst "sel4/announce"))
	    ;; (to ,(id "linux-arm-kernel")	,(dev-split (lst "linux/arm-kernel") "" t))
	    ;; (to ,(lfdev "codezero-devel")	,(dev-split (lst "l4/codezero") ".dev"))
	    ;; (to ,(vgerk "linux-omap")		,(dev-split (lst "linux/omap") "" t))

	    (\: gnus-registry-split-fancy-with-parent)

	    ;; lab. internals:
	    ("subject" ,courir				,(grp "courir"))
	    (to ,(inria "courir")			,(grp "courir"))
	    (to ,(irisa-lst "courir")			,(grp "courir"))
	    (to ,(irisa+ "sumo")			,(grp "sumo"))
	    (to ,(inria "eluscdc")			,(grp "inria.cdc"))
	    (to ,(inria "inriatous")			,(grp "inria.all"))
	    (to ,(inria "personnel-inria-rba")		,(grp "inria.all"))

	    ;; first filter so that we can avoid scanning already detected
	    ;; spams... (already moved by procmail actually).
	    ("X-Spam-Flag" "YES"			,(grp "spam_by_unknown"))
	    ,(if (fboundp 'my-spamassassin) ; <- my spam filter (see
		 (list : 'my-spamassassin)) ; `my-spam.el' --- nil actually).
	    ;; just in case (should never match):
	    ("X-Spam-Flag" "YES"			,(grp "spam_by_sa"))

	    ;; filtered global mails:
	    ;; none currently.

	    ;; these addresses are private (i.e., replaced by `<@>' when this
	    ;; file is published on the web):
	    ;; format is: `(from ,"<@>" ,(grp group))'

	    ;; course specific:
	    ;; none currently.

	    ;; last filters, when I seem to be really involved:
	    (to ,(fsfm "nberth")				,(grp "fsf"))
	    (to ,(mailoo "nberth")				,(grp "mail"))
	    (to ,(gmail "nberthier")				,(grp "mail"))
	    (to ,(inria "nicolas.berthier")			,(grp "inria"))
	    (to ,mnbsp						,(grp "mail"))
	    (from ,(fsfm "nberth")				,(grp "fsf"))
	    (from ,(mailoo "nberth")				,(grp "mail")) ; ibid
	    (from ,(gmail "nberthier")				,(grp "mail")) ; ibid
	    (from ,(inria "nicolas.berthier")			,(grp "inria"))
	    (from ,mnbsp					,(grp "mail"))
	    
	    ,(grp "undecided"))))
      
      nnimap-split-fancy nnmail-split-fancy
      nnmail-split-methods 'nnmail-split-fancy ;in case…
      nnimap-split-methods 'nnmail-split-fancy
      )

(gnus-registry-initialize)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;