2002-01-27 Richard M. Stallman <rms@gnu.org>

[gnus] / lisp / gnus-logic.el

diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el
index 9facfad..77fc948 100644 (file)
--- a/lisp/gnus-logic.el
+++ b/lisp/gnus-logic.el
@@ -1,7 +1,8 @@
 ;;; gnus-logic.el --- advanced scoring code for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;;        Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -25,11 +26,13 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-score)
 (require 'gnus-util)
 
-;;; Internal variables. 
+;;; Internal variables.
 
 (defvar gnus-advanced-headers nil)
 
@@ -53,24 +56,24 @@
 
 (eval-and-compile
   (autoload 'parse-time-string "parse-time"))
-     
+
 (defun gnus-score-advanced (rule &optional trace)
   "Apply advanced scoring RULE to all the articles in the current group."
-  (let ((headers gnus-newsgroup-headers)
-       gnus-advanced-headers score)
-    (while (setq gnus-advanced-headers (pop headers))
-      (when (gnus-advanced-score-rule (car rule))
-       ;; This rule was successful, so we add the score to
-       ;; this article.
+  (let (new-score score multiple)
+    (dolist (gnus-advanced-headers gnus-newsgroup-headers)
+      (when (setq multiple (gnus-advanced-score-rule (car rule)))
+       (setq new-score (or (nth 1 rule)
+                           gnus-score-interactive-default-score))
+       (when (numberp multiple)
+         (setq new-score (* multiple new-score)))
+       ;; This rule was successful, so we add the score to this
+       ;; article.
        (if (setq score (assq (mail-header-number gnus-advanced-headers)
                              gnus-newsgroup-scored))
            (setcdr score
-                   (+ (cdr score)
-                      (or (nth 1 rule)
-                          gnus-score-interactive-default-score)))
+                   (+ (cdr score) new-score))
          (push (cons (mail-header-number gnus-advanced-headers)
-                     (or (nth 1 rule)
-                         gnus-score-interactive-default-score))
+                     new-score)
                gnus-newsgroup-scored)
          (when trace
            (push (cons "A file" rule)
@@ -79,7 +82,7 @@
 (defun gnus-advanced-score-rule (rule)
   "Apply RULE to `gnus-advanced-headers'."
   (let ((type (car rule)))
-    (cond 
+    (cond
      ;; "And" rule.
      ((or (eq type '&) (eq type 'and))
       (pop rule)
@@ -106,14 +109,14 @@
      ;; This is a `1-'-type redirection rule.
      ((and (symbolp type)
           (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type)))
-      (let ((gnus-advanced-headers 
+      (let ((gnus-advanced-headers
             (gnus-parent-headers
              gnus-advanced-headers
              (if (string-match "^\\([0-9]+\\)-$" (symbol-name type))
                  ;; 1- type redirection.
                  (string-to-number
                   (substring (symbol-name type)
-                             (match-beginning 0) (match-end 0)))
+                             (match-beginning 1) (match-end 1)))
                ;; ^^^ type redirection.
                (length (symbol-name type))))))
        (when gnus-advanced-headers
@@ -126,9 +129,8 @@
       (error "Unknown advanced score type: %s" rule)))))
 
 (defun gnus-advanced-score-article (rule)
-  ;; `rule' is a semi-normal score rule, so we find out
-  ;; what function that's supposed to do the actual
-  ;; processing.
+  ;; `rule' is a semi-normal score rule, so we find out what function
+  ;; that's supposed to do the&nbs