[PATCH] New spam processor: ham copy

[PATCH] New spam processor: ham copy

[Michael Shields]

I've set up my Gnus configuration to copy ham and move spam to
dedicated groups for later processing, as someone suggested here a few
weeks ago.  This lets me run Bayesian trainers across them from a
cronjob on the server.

Gnus is already able to move spam to a dedicated group, but the ham
copying support is new.

I also found and fixed a bug in spam-ham-move-routine and
spam-mark-spam-as-expired-and-move-routine: they set the process mark
on all articles to be moved and then call gnus-summary-move-article,
but if there are no articles to be moved, g-s-m-a will move the
current article.



lisp/ChangeLog addition:

2003-02-21  Michael Shields  <shields@msrl.com>

	* gnus.el (gnus-install-group-spam-parameters): New.
	* spam.el (spam-group-ham-processor-copy-p): New.
	* spam.el (spam-summary-prepare-exit): Support for ham copying.
	* spam.el (spam-mark-spam-as-expired-and-move-routine): Fix bug
	that would cause the current message to be moved if the group had
	no spam.
	* spam.el (spam-ham-move-routine): New `copy' argument.

gnus source patch:
Diff command:   cvs -q diff -u
Files affected: lisp/spam.el lisp/gnus.el


Index: lisp/gnus.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus.el,v
retrieving revision 6.159
diff -u -r6.159 gnus.el
--- lisp/gnus.el	20 Feb 2003 01:31:11 -0000	6.159
+++ lisp/gnus.el	21 Feb 2003 21:52:01 -0000
@@ -1845,6 +1845,10 @@
     "The BBDB summary exit ham processor.
 Only applicable to non-spam (unclassified and ham) groups.")
 
+  (defvar gnus-group-ham-exit-processor-copy "copy"
+    "The ham copy exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
   (gnus-define-group-parameter
    spam-process
    :type list
@@ -1860,7 +1864,8 @@
 				   (variable-item gnus-group-ham-exit-processor-ifile)
 				   (variable-item gnus-group-ham-exit-processor-stat)
 				   (variable-item gnus-group-ham-exit-processor-whitelist)
-				   (variable-item gnus-group-ham-exit-processor-BBDB))))
+				   (variable-item gnus-group-ham-exit-processor-BBDB)
+				   (variable-item gnus-group-ham-exit-processor-copy))))
    :function-document
    "Which spam or ham processors will be applied to the GROUP articles at summary exit."
    :variable gnus-spam-process-newsgroups
@@ -1884,7 +1889,8 @@
 				      (variable-item gnus-group-ham-exit-processor-ifile)
 				      (variable-item gnus-group-ham-exit-processor-stat)
 				      (variable-item gnus-group-ham-exit-processor-whitelist)
-				      (variable-item gnus-group-ham-exit-processor-BBDB))))
+				      (variable-item gnus-group-ham-exit-processor-BBDB)
+				      (variable-item gnus-group-ham-exit-processor-copy))))
    :parameter-document
    "Which spam processors will be applied to the spam or ham GROUP articles at summary exit.")
 
Index: lisp/spam.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/spam.el,v
retrieving revision 6.71
diff -u -r6.71 spam.el
--- lisp/spam.el	20 Feb 2003 00:39:05 -0000	6.71
+++ lisp/spam.el	21 Feb 2003 21:52:02 -0000
@@ -336,6 +349,9 @@
 (defun spam-group-ham-processor-BBDB-p (group)
   (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
 
+(defun spam-group-ham-processor-copy-p (group)
+  (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
+
 ;;; Summary entry and exit processing.
 
 (defun spam-summary-prepare ()
@@ -394,6 +410,11 @@
       (gnus-message 5 "Registering ham with the BBDB")
       (spam-BBDB-register-routine)))
 
+  (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
+    (gnus-message 5 "Copying ham")
+    (spam-ham-move-routine
+     (gnus-parameter-ham-process-destination gnus-newsgroup-name) t))
+
   ;; now move all ham articles out of spam groups
   (when (spam-group-spam-contents-p gnus-newsgroup-name)
     (gnus-message 5 "Moving ham messages from spam group")
@@ -424,13 +445,14 @@
 	(push article tomove)))
 
     ;; now do the actual move
-    (when (stringp group)
+    (when (and tomove
+	       (stringp group))
       (dolist (article tomove)
 	(gnus-summary-set-process-mark article))
       (when tomove (gnus-summary-move-article nil group))))
   (gnus-summary-yank-process-mark))
  
-(defun spam-ham-move-routine (&optional group)
+(defun spam-ham-move-routine (&optional group copy)
   (gnus-summary-kill-process-mark)
   (let ((articles gnus-newsgroup-articles)
 	article ham-mark-values mark tomove)
@@ -443,9 +465,12 @@
 	  (push article tomove)))
 
       ;; now do the actual move
-      (dolist (article tomove)
-	(gnus-summary-set-process-mark article))
-      (when tomove (gnus-summary-move-article nil group))))
+      (when tomove
+	(dolist (article tomove)
+	  (gnus-summary-set-process-mark article))
+	(if copy
+	    (gnus-summary-copy-article nil group)
+	  (gnus-summary-move-article nil group)))))
   (gnus-summary-yank-process-mark))
  
 (defun spam-generic-register-routine (spam-func ham-func)

-- 
Shields.