Re: [PATCH] Expiry based on headers (Take 2)

[Nevin Kapur <nevin@jhu.edu>]

Here's a revised patch for a header-based expiry function that
incorporates all of Simon's suggestion.  This is my first attempt at
using custom non-trivially, so any correction would be welcome.

ChangeLog:

2001-12-08  Nevin Kapur  <nevin@jhu.edu> (Suggestions from Simon
            Josefsson <jas@extundo.com>)

	* 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 21:04:15
@@ -190,6 +190,38 @@
 		 (function :format "%v" nnmail-)
 		 string))
 
+(defcustom 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 the symbol `to-from', the regexp
+will try to match against From or the To header.
+
+Example:
+
+(setq nnmail-fancy-expiry-targets
+      '((to-from \"boss\" \"nnfolder:Work-\")
+	(\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.\" \"%Y.%b\")
+	(\"from\" \".*\" \"nnfolder:Archive-\")))
+
+In this case, mail that has the string \"boss\" in the To or the From
+header will be expired to the groun nnfolder:Work-YYYY; mail that
+has the sting \"IMPORTANT\" in the Subject header will be expired
+to the group nnfolder:IMPORTANT.YYYY.MMM; everything else will
+be expired to nnfolder:Archive-YYYY."
+
+  :group 'nnmail-expire
+  :type '(repeat (list (choice :tag "Match against"
+                        (string :tag "Header")
+                        (const to-from))
+                       regexp
+                       (string :tag "Target group")
+                       (string :tag "Date format"
+                               :value "%Y"))))
+
 (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 +1731,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'."
+  (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))
+      (dolist (regexp-target-pair
+	       (reverse nnmail-fancy-expiry-targets) target)
+	(setq header (car regexp-target-pair))
+	(cond
+	 ;; If the header is to-from then match against the
+	 ;; To or From header
+	 ((and (equal header 'to-from)
+	       (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))))
+	 ((and (not (equal header 'to-from))
+	       (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."


The patch for the manual:

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 21:05:53
@@ -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
+       '((to-from "boss" "nnfolder:Work.")
+    	 ("subject" "IMPORTANT" "nnfolder:IMPORTANT" "")
+         ("from" ".*" "nnfolder:Archive-" "%Y-%b")))
+@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}. 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 Kapur
nevin@jhu.edu