T-gnus 6.14.6; synch up with Gnus v5.8.8.

[elisp/gnus.git-] / lisp / gnus-nocem.el

diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el
index 8efd1fe..1e6207d 100644 (file)
--- a/lisp/gnus-nocem.el
+++ b/lisp/gnus-nocem.el
@@ -1,5 +1,6 @@
 ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -45,15 +46,17 @@
   :type '(repeat (string :tag "Group")))
 
 (defcustom gnus-nocem-issuers
-  '("AutoMoose-1" "Automoose-1"                ; CancelMoose[tm]
-    "rbraver@ohww.norman.ok.us"                ; Robert Braver
-    "clewis@ferret.ocunix.on.ca"       ; Chris Lewis
-    "jem@xpat.com"                     ; Despammer from Korea
-    "snowhare@xmission.com"            ; Benjamin "Snowhare" Franz
-    "red@redpoll.mrfs.oh.us (Richard E. Depew)") ; ARMM! ARMM!
+  '("AutoMoose-1"                      ; CancelMoose[tm]
+    "clewis@ferret.ocunix"             ; Chris Lewis
+    "cosmo.roadkill"
+    "SpamHippo"
+    "hweede@snafu.de")
   "*List of NoCeM issuers to pay attention to.
 
-This can also be a list of `(ISSUER CONDITIONS)' elements."
+This can also be a list of `(ISSUER CONDITION ...)' elements.
+
+See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an
+issuer registry."
   :group 'gnus-nocem
   :type '(repeat (choice string sexp)))
 
@@ -83,6 +86,19 @@ matches an previously scanned and verified nocem message."
   :group 'gnus-nocem
   :type 'boolean)
 
+(defcustom gnus-nocem-check-article-limit 500
+  "*If non-nil, the maximum number of articles to check in any NoCeM group."
+  :group 'gnus-nocem
+  :type '(choice (const :tag "unlimited" nil)
+                (integer 1000)))
+
+(defcustom gnus-nocem-check-from t
+  "Non-nil means check for valid issuers in message bodies.
+Otherwise don't bother fetching articles unless their author matches a
+valid issuer, which is much faster if you are selective about the issuers."
+  :group 'gnus-nocem
+  :type 'boolean)
+
 ;;; Internal variables
 
 (defvar gnus-nocem-active nil)
@@ -166,6 +182,18 @@ matches an previously scanned and verified nocem message."
                  ;; are not allowed to have references, so we can
                  ;; ignore scanning followups.
                  (and (string-match "@@NCM" (mail-header-subject header))
+                      (and gnus-nocem-check-from
+                           (let ((case-fold-search t))
+                             (catch 'ok
+                               (mapcar
+                                (lambda (author)
+                                  (if (consp author)
+                                      (setq author (car author)))
+                                  (if (string-match
+                                       author (mail-header-from header))
+                                      (throw 'ok t)))
+                                gnus-nocem-issuers)
+                               nil)))
                       (or gnus-nocem-liberal-fetch
                           (and (or (string= "" (mail-header-references
                                                 header))
@@ -173,8 +201,10 @@ matches an previously scanned and verified nocem message."
                                (not (member (mail-header-message-id header)
                                             gnus-nocem-seen-message-ids))))
                       (push header check-headers)))
-               (let ((i 0)
-                     (len (length check-headers)))
+               (let* ((i 0)
+                      (check-headers
+                       (last check-headers gnus-nocem-check-article-limit))
+                      (len (length check-headers)))
                  (dolist (h check-headers)
                    (gnus-message
                     7 "Checking article %d in %s for NoCeM (%d of %d)..."
@@ -192,6 +222,7 @@ matches an previously scanned and verified nocem message."
   "Check whether the current article is an NCM article and that we want it."
   ;; Get the article.
   (let ((date (mail-header-date header))
+       (gnus-newsgroup-name group)
        issuer b e type)
     (when (or (not date)
              (time-less-p