[PATCH] Expiry based on headers

[Nevin Kapur <nevin@jhu.edu>]

Recently, I've seen a few requests for a function that will expire
articles based on their headers.  I've been using such a function for
a while.  I am proposing it for inclusion into Gnus.

ChangeLog:

2001-12-08  Nevin Kapur  <nevin@jhu.edu>

	* nnmail.el (nnmail-fancy-expiry-targets): New variable.
	(nnmail-fancy-expiry-target): Use it.



Index: lisp/nnmail.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/nnmail.el,v
retrieving revision 6.27
diff -u -r6.27 nnmail.el
--- lisp/nnmail.el	2001/09/26 17:55:05	6.27
+++ lisp/nnmail.el	2001/12/08 16:33:42
@@ -190,6 +190,16 @@
 		 (function :format "%v" nnmail-)
 		 string))
 
+;; Need to make this a defcustom
+(defvar nnmail-fancy-expiry-targets nil 
+  "A list of (\"header\" \"regexp\" \"target\" \"date format\").  If
+`nnmail-expiry-target' is set to `nnmail-fancy-expiry-target' and the 
+header matches the regexp, the message will be expired to the target
+group with the date in the specified format, appended.  If no date
+format is specified the %Y is assumed.  In the special cases that
+header is from, the regexp will match the from or to header.  See
+the manual for examples.")
+
 (defcustom nnmail-cache-accepted-message-ids nil
   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
 If non-nil, also update the cache when copy or move articles."
@@ -1699,6 +1709,38 @@
       (setq target (funcall target group)))
     (unless (eq target 'delete)
       (gnus-request-accept-article target nil nil t))))
+
+(defun nnmail-fancy-expiry-target (group)
+  "Returns a target expiry group depending on the last match in nnmail-fancy-expiry-targets."
+  (if (or (string= group "drafts") (string= group "queue"))
+      'delete
+    (let* (header
+	   (case-fold-search nil)
+	   (from (or (message-fetch-field "from") ""))
+	   (to (or (message-fetch-field "to") ""))
+	   (date (date-to-time
+		  (or (message-fetch-field "date") (current-time-string))))
+	   (target 'delete))
+      ;; Note that last match will be returned.
+      (dolist (regexp-target-pair nnmail-fancy-expiry-targets target)
+	(setq header (car regexp-target-pair))
+	(cond
+	 ;; If the header is "from" or "to" match either field
+	 ((and (or (string-match header "from") (string-match header "to"))
+	       (or (string-match (cadr regexp-target-pair) from)
+		   (and (string-match message-dont-reply-to-names from)
+			(string-match (cadr regexp-target-pair) to))))
+	  (setq target (concat (caddr regexp-target-pair)
+			       "-"
+			       (format-time-string
+				(or (cadddr regexp-target-pair) "%Y") date))))
+	 ((string-match (cadr regexp-target-pair) (message-fetch-field header))
+	  (setq target (concat (caddr regexp-target-pair)
+			       "-"
+			       (format-time-string
+				(or (cadddr regexp-target-pair) "%Y")
+				date)))))))))
+  
 
 (defun nnmail-check-syntax ()
   "Check (and modify) the syntax of the message in the current buffer."


Here is the manual entry:

Index: texi/gnus.texi
===================================================================
RCS file: /usr/local/cvsroot/gnus/texi/gnus.texi,v
retrieving revision 6.189
diff -u -r6.189 gnus.texi
--- texi/gnus.texi	2001/12/05 10:15:25	6.189
+++ texi/gnus.texi	2001/12/08 16:37:14
@@ -13073,6 +13073,26 @@
 (setq nnmail-expiry-target "nnml:expired")
 @end lisp
 
+Gnus provides a function @code{nnmail-fancy-expiry-target} which will
+expire mail to groups according to the variable
+@code{nnmail-fancy-expiry-targets}.  Here's an example:
+
+@lisp
+ (setq nnmail-expiry-target 'nnmail-fancy-expiry-target
+       nnmail-fancy-expiry-targets
+       '(("from" ".*" "nnfolder:Archive" "%Y-%b")
+    	 ("subject" "IMPORTANT" "nnfolder:IMPORTANT")
+	 ("from" "boss" "nnfolder:Work")))
+@end lisp
+
+With this setup, any mail that has @code{IMPORTANT} in its Subject
+header and was sent in the year @code{YYYY}, will get expired to the
+group @code{nnfolder:IMPORTANT-YYYY}. If its From or To header contains
+the string @code{boss}, it will get expired to
+@code{nnfolder:Work-YYYY}. All other mail will get expired to
+@code{nnfolder:Archive-YYYY-MMM}.
+
+
 
 @vindex nnmail-keep-last-article
 If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never

-- 
Nevin