X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-nocem.el;h=5247d1f5c6b326970044668e21d7d77edb0cd08a;hb=cba37d821d6c6196da92a3de2fda31e788294332;hp=7535a25831923c427816e2dae521eda870558e2e;hpb=00f6e602cb6b69286c3edcfcd5f4e06d341cdd14;p=gnus

diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el
index 7535a2583..5247d1f5c 100644
--- a/lisp/gnus-nocem.el
+++ b/lisp/gnus-nocem.el
@@ -1,5 +1,8 @@
 ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
+;;        Free Software Foundation, Inc.
+
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -45,17 +48,19 @@
   :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
+  :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html")
   :type '(repeat (choice string sexp)))
 
 (defcustom gnus-nocem-directory
@@ -80,8 +85,23 @@ isn't bound, the message will be used unconditionally."
 (defcustom gnus-nocem-liberal-fetch nil
   "*If t try to fetch all messages which have @@NCM in the subject.
 Otherwise don't fetch messages which have references or whose message-id
-matches an previously scanned and verified nocem message."
+matches a 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
+  :version "21.1"
+  :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
+  :version "21.1"
   :type 'boolean)
 
 ;;; Internal variables
@@ -121,7 +141,7 @@ matches an previously scanned and verified nocem message."
   (interactive)
   (let ((groups gnus-nocem-groups)
 	(gnus-inhibit-demon t)
-	group active gactive articles)
+	group active gactive articles check-headers)
     (gnus-make-directory gnus-nocem-directory)
     ;; Load any previous NoCeM headers.
     (gnus-nocem-load-cache)
@@ -167,13 +187,34 @@ 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))
 				    (null (mail-header-references header)))
 				(not (member (mail-header-message-id header)
 					     gnus-nocem-seen-message-ids))))
-		       (gnus-nocem-check-article group header)))))))
+		       (push header 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)..."
+		     (mail-header-number h) group (incf i) len)
+		    (gnus-nocem-check-article group h)))))))
 	(setq gnus-nocem-active
 	      (cons (list group gactive)
 		    (delq (assoc group gnus-nocem-active)
@@ -185,9 +226,8 @@ matches an previously scanned and verified nocem message."
 (defun gnus-nocem-check-article (group header)
   "Check whether the current article is an NCM article and that we want it."
   ;; Get the article.
-  (gnus-message 7 "Checking article %d in %s for NoCeM..."
-		(mail-header-number header) group)
   (let ((date (mail-header-date header))
+	(gnus-newsgroup-name group)
 	issuer b e type)
     (when (or (not date)
 	      (time-less-p
@@ -271,7 +311,7 @@ matches an previously scanned and verified nocem message."
 			      gnus-nocem-real-group-hashtb)
 	    ;; Valid group.
 	    (beginning-of-line)
-	    (while (= (following-char) ?\t)
+	    (while (eq (char-after) ?\t)
 	      (forward-line -1))
 	    (setq id (buffer-substring (point) (1- (search-forward "\t"))))
 	    (unless (gnus-gethash id gnus-nocem-hashtb)
@@ -279,7 +319,7 @@ matches an previously scanned and verified nocem message."
 	      (gnus-sethash id t gnus-nocem-hashtb)
 	      (push id ncm))
 	    (forward-line 1)
-	    (while (= (following-char) ?\t)
+	    (while (eq (char-after) ?\t)
 	      (forward-line 1))))))
       (when ncm
 	(setq gnus-nocem-touched-alist t)