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

[Simon Josefsson <jas@extundo.com>]

Nevin Kapur <nevin@jhu.edu> writes:

> 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.

I modified it a little, what do you think of this approach?  If you
don't like we'll use yours.

Index: nnmail.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/nnmail.el,v
retrieving revision 6.27
diff -u -u -w -r6.27 nnmail.el
--- nnmail.el	2001/09/26 17:55:05	6.27
+++ nnmail.el	2001/12/08 22:24:51
@@ -190,6 +190,39 @@
 		 (function :format "%v" nnmail-)
 		 string))
 
+(defcustom nnmail-fancy-expiry-targets nil 
+  "Determine expiry target based on articles using fancy techniques.
+
+This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries.  If
+`nnmail-expiry-target' is set to the function
+`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
+the message will be expired to a group determined by invoking
+`format-time-string' with TARGET used as the format string and the
+time extracted from the articles' Date header (if missing the current
+time is used).
+
+In the special cases that HEADER is the symbol `to-from', the regexp
+will try to match against both the From and the To header.
+
+Example:
+
+\(setq nnmail-fancy-expiry-targets
+      '((to-from \"boss\" \"nnfolder:Work\")
+	(\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
+	(\"from\" \".*\" \"nnfolder:Archive-%Y\")))
+
+In this case, articles containing the string \"boss\" in the To or the
+From header will be expired to the group \"nnfolder:Work\";
+articles containing the sting \"IMPORTANT\" in the Subject header will
+be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
+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 format string"))))
+
 (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 +1732,31 @@
       (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 determined by `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 (format-time-string (caddr regexp-target-pair) date)))
+       ((and (not (equal header 'to-from))
+	     (string-match (cadr regexp-target-pair)
+			   (message-fetch-field header)))
+	(setq target (format-time-string (caddr regexp-target-pair)
+					 date))))))))
 
 (defun nnmail-check-syntax ()
   "Check (and modify) the syntax of the message in the current buffer."
Index: gnus.texi
===================================================================
RCS file: /usr/local/cvsroot/gnus/texi/gnus.texi,v
retrieving revision 6.189
diff -u -u -w -r6.189 gnus.texi
--- gnus.texi	2001/12/05 10:15:25	6.189
+++ gnus.texi	2001/12/08 22:25:09
@@ -13073,6 +13073,26 @@
 (setq nnmail-expiry-target "nnml:expired")
 @end lisp
 
+@findex nnmail-fancy-expiry-target
+@vindex nnmail-fancy-expiry-targets
+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.%Y.%b")
+         ("from" ".*" "nnfolder:Archive-%Y")))
+@end lisp
+
+With this setup, any mail that has @code{IMPORTANT} in its Subject
+header and was sent in the year @code{YYYY} and month @code{MMM}, will
+get expired to the group @code{nnfolder:IMPORTANT.YYYY.MMM}. If its
+From or To header contains the string @code{boss}, it will get expired
+to @code{nnfolder:Work}. All other mail will get expired to
+@code{nnfolder:Archive-YYYY}.
 
 @vindex nnmail-keep-last-article
 If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never