Import Oort Gnus v0.19.
[elisp/gnus.git-] / lisp / spam.el
index e95baf5..b6e25db 100644 (file)
 (eval-and-compile
   (autoload 'query-dig "dig"))
 
+;; autoload spam-report
+(eval-and-compile
+  (autoload 'spam-report-gmane "spam-report"))
+
 ;; autoload query-dns
 (eval-and-compile
   (autoload 'query-dns "dns"))
@@ -74,6 +78,14 @@ spam groups."
   :type 'boolean
   :group 'spam)
 
+(defcustom spam-mark-only-unseen-as-spam t
+  "Whether only unseen articles should be marked as spam in spam
+groups.  When nil, all unread articles in a spam group are marked as
+spam.  Set this if you want to leave an article unread in a spam group
+without losing it to the automatic spam-marking process."
+  :type 'boolean
+  :group 'spam)
+
 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
   "Whether ham should be marked unread before it's moved out of a spam
 group according to ham-process-destination.  This variable is an
@@ -190,29 +202,6 @@ All unmarked article in such group receive the spam mark on group entry."
   :type 'regexp
   :group 'spam)
 
-(defcustom spam-ham-marks (list 'gnus-del-mark 'gnus-read-mark 
-                               'gnus-killed-mark 'gnus-kill-file-mark 
-                               'gnus-low-score-mark)
-  "Marks considered as being ham (positively not spam).
-Such articles will be processed as ham (non-spam) on group exit."
-  :type '(set
-         (variable-item gnus-del-mark)
-         (variable-item gnus-read-mark)
-         (variable-item gnus-killed-mark)
-         (variable-item gnus-kill-file-mark)
-         (variable-item gnus-low-score-mark))
-  :group 'spam)
-
-(defcustom spam-spam-marks (list 'gnus-spam-mark)
-  "Marks considered as being spam (positively spam).
-Such articles will be transmitted to `bogofilter -s' on group exit."
-  :type '(set 
-         (variable-item gnus-spam-mark)
-         (variable-item gnus-killed-mark)
-         (variable-item gnus-kill-file-mark)
-         (variable-item gnus-low-score-mark))
-  :group 'spam)
-
 (defcustom spam-face 'gnus-splash-face
   "Face for spam-marked articles"
   :type 'face
@@ -316,6 +305,29 @@ your main source of newsgroup names."
       gnus-summary-highlight)
 
 ;; convenience functions
+(defun spam-group-ham-mark-p (group mark &optional spam)
+  (when (stringp group)
+    (let* ((marks (spam-group-ham-marks group spam))
+          (marks (if (symbolp mark) 
+                     marks 
+                   (mapcar 'symbol-value marks))))
+      (memq mark marks))))
+
+(defun spam-group-spam-mark-p (group mark)
+  (spam-group-ham-mark-p group mark t))
+
+(defun spam-group-ham-marks (group &optional spam)
+  (when (stringp group)
+    (let* ((marks (if spam
+                    (gnus-parameter-spam-marks group)
+                  (gnus-parameter-ham-marks group)))
+          (marks (car marks))
+          (marks (if (listp (car marks)) (car marks) marks)))
+      marks)))
+
+(defun spam-group-spam-marks (group)
+  (spam-group-ham-marks group t))
+
 (defun spam-group-spam-contents-p (group)
   (if (stringp group)
       (or (member group spam-junk-mailgroups)
@@ -335,6 +347,9 @@ your main source of newsgroup names."
       (member processor (car (gnus-parameter-spam-process group)))
     nil))
 
+(defun spam-group-spam-processor-report-gmane-p (group)
+  (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
+
 (defun spam-group-spam-processor-bogofilter-p (group)
   (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
 
@@ -394,6 +409,10 @@ your main source of newsgroup names."
       (gnus-message 5 "Registering spam with the blacklist")
       (spam-blacklist-register-routine))
 
+    (when (spam-group-spam-processor-report-gmane-p gnus-newsgroup-name)
+      (gnus-message 5 "Registering spam with the Gmane report")
+      (spam-report-gmane-register-routine))
+
     (if spam-move-spam-nonspam-groups-only      
        (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
          (spam-mark-spam-as-expired-and-move-routine
@@ -441,13 +460,15 @@ your main source of newsgroup names."
   ;; check the global list of group names spam-junk-mailgroups and the
   ;; group parameters
   (when (spam-group-spam-contents-p gnus-newsgroup-name)
-    (gnus-message 5 "Marking unread articles as spam")
-    (let ((articles gnus-newsgroup-articles)
-         article)
-      (while articles
-       (setq article (pop articles))
-       (when (eq (gnus-summary-article-mark article) gnus-unread-mark)
-         (gnus-summary-mark-article article gnus-spam-mark))))))
+    (gnus-message 5 "Marking %s articles as spam"
+                 (if spam-mark-only-unseen-as-spam 
+                     "unseen"
+                   "unread"))
+    (let ((articles (if spam-mark-only-unseen-as-spam 
+                       gnus-newsgroup-unseen
+                     gnus-newsgroup-unreads)))
+      (dolist (article articles)
+       (gnus-summary-mark-article article gnus-spam-mark)))))
 
 (defun spam-mark-spam-as-expired-and-move-routine (&optional group)
   (gnus-summary-kill-process-mark)
@@ -469,13 +490,12 @@ your main source of newsgroup names."
 (defun spam-ham-move-routine (&optional group copy)
   (gnus-summary-kill-process-mark)
   (let ((articles gnus-newsgroup-articles)
-       article ham-mark-values mark tomove)
+       article mark tomove)
     (when (stringp group)              ; this routine will do nothing
                                        ; without a valid group
-      (dolist (mark spam-ham-marks)
-       (push (symbol-value mark) ham-mark-values))
       (dolist (article articles)
-       (when (memq (gnus-summary-article-mark article) ham-mark-values)
+       (when (spam-group-ham-mark-p gnus-newsgroup-name
+                                    (gnus-summary-article-mark article))
          (push article tomove)))
 
       ;; now do the actual move
@@ -491,24 +511,17 @@ your main source of newsgroup names."
  
 (defun spam-generic-register-routine (spam-func ham-func)
   (let ((articles gnus-newsgroup-articles)
-       article mark ham-articles spam-articles spam-mark-values 
-       ham-mark-values)
-
-    ;; marks are stored as symbolic values, so we have to dereference
-    ;; them for memq to work.  we wouldn't have to do this if
-    ;; gnus-summary-article-mark returned a symbol.
-    (dolist (mark spam-ham-marks)
-      (push (symbol-value mark) ham-mark-values))
-
-    (dolist (mark spam-spam-marks)
-      (push (symbol-value mark) spam-mark-values))
+       article mark ham-articles spam-articles)
 
     (while articles
       (setq article (pop articles)
            mark (gnus-summary-article-mark article))
-      (cond ((memq mark spam-mark-values) (push article spam-articles))
+      (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark) 
+            (push article spam-articles))
            ((memq article gnus-newsgroup-saved))
-           ((memq mark ham-mark-values) (push article ham-articles))))
+           ((spam-group-ham-mark-p gnus-newsgroup-name mark)
+            (push article ham-articles))))
+
     (when (and ham-articles ham-func)
       (mapc ham-func ham-articles))    ; we use mapc because unlike
                                        ; mapcar it discards the
@@ -596,32 +609,35 @@ definitely a spam.")
 "The spam-list-of-statistical-checks list contains all the mail
 splitters that need to have the full message body available.")
 
-(defun spam-split ()
+(defun spam-split (&rest specific-checks)
   "Split this message into the `spam' group if it is spam.
 This function can be used as an entry in `nnmail-split-fancy', for
-example like this: (: spam-split)
+example like this: (: spam-split).  It can take checks as parameters.
 
 See the Info node `(gnus)Fancy Mail Splitting' for more details."
   (interactive)
-
-  (dolist (check spam-list-of-statistical-checks)
-    (when (symbol-value check)
-      (widen)
-      (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
-                   (symbol-name check))
-      (return)))
-;;   (progn (widen) (debug (buffer-string)))
-  (let ((list-of-checks spam-list-of-checks)
-       decision)
-    (while (and list-of-checks (not decision))
-      (let ((pair (pop list-of-checks)))
-       (when (symbol-value (car pair))
-         (gnus-message 5 "spam-split: calling the %s function" (symbol-name (cdr pair)))
-         (setq decision (funcall (cdr pair))))))
-    (if (eq decision t)
-       nil
-      decision)))
-
+  (save-excursion
+    (save-restriction
+      (dolist (check spam-list-of-statistical-checks)
+       (when (symbol-value check)
+         (widen)
+         (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
+                       (symbol-name check))
+         (return)))
+      ;;   (progn (widen) (debug (buffer-string)))
+      (let ((list-of-checks spam-list-of-checks)
+           decision)
+       (while (and list-of-checks (not decision))
+         (let ((pair (pop list-of-checks)))
+           (when (and (symbol-value (car pair))
+                      (or (null specific-checks)
+                          (memq (car pair) specific-checks)))
+             (gnus-message 5 "spam-split: calling the %s function" (symbol-name (cdr pair)))
+             (setq decision (funcall (cdr pair))))))
+       (if (eq decision t)
+           nil
+         decision)))))
+  
 (defun spam-setup-widening ()
   (dolist (check spam-list-of-statistical-checks)
     (when (symbol-value check)
@@ -968,8 +984,14 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
           (spam-enter-whitelist from))))))
 
 \f
-;;;; Bogofilter
+;;;; Spam-report glue
+(defun spam-report-gmane-register-routine ()
+  (spam-generic-register-routine
+   'spam-report-gmane
+   nil))
 
+\f
+;;;; Bogofilter
 (defun spam-check-bogofilter-headers (&optional score)
   (let ((header (message-fetch-field spam-bogofilter-header)))
       (when (and header
@@ -987,7 +1009,8 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
   (save-window-excursion
     (gnus-summary-show-article t)
     (set-buffer gnus-article-buffer)
-    (let ((score (spam-check-bogofilter t)))
+    (let ((score (or (spam-check-bogofilter-headers t)
+                    (spam-check-bogofilter t))))
       (message "Spamicity score %s" score)
       (or score "0"))))