Merge from emacs--devo--0
[gnus] / lisp / gnus-score.el
index 909d39c..f910bfb 100644 (file)
@@ -1,6 +1,7 @@
 ;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -10,7 +11,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -20,8 +21,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -139,16 +140,22 @@ If this variable is nil, no score file entries will be expired."
                 number))
 
 (defcustom gnus-update-score-entry-dates t
-  "*In non-nil, update matching score entry dates.
+  "*If non-nil, update matching score entry dates.
 If this variable is nil, then score entries that provide matches
 will be expired along with non-matching score entries."
   :group 'gnus-score-expire
   :type 'boolean)
 
 (defcustom gnus-decay-scores nil
-  "*If non-nil, decay non-permanent scores."
+  "*If non-nil, decay non-permanent scores.
+
+If it is a regexp, only decay score files matching regexp."
   :group 'gnus-score-decay
-  :type 'boolean)
+  :type `(choice (const :tag "never" nil)
+                (const :tag "always" t)
+                (const :tag "adaptive score files"
+                       ,(concat "\\." gnus-adaptive-file-suffix "\\'"))
+                (regexp)))
 
 (defcustom gnus-decay-score-function 'gnus-decay-score
   "*Function called to decay a score.
@@ -172,7 +179,7 @@ It is called with one parameter -- the score to be decayed."
 It can be:
 
  * A string
-   This file file will be used as the home score file.
+   This file will be used as the home score file.
 
  * A function
    The result of this function will be used as the home score file.
@@ -183,7 +190,7 @@ It can be:
    The elements in this list can be:
 
    * `(regexp file-name ...)'
-     If the `regexp' matches the group name, the first `file-name' will
+     If the `regexp' matches the group name, the first `file-name'
      will be used as the home score file.  (Multiple filenames are
      allowed so that one may use gnus-score-file-single-match-alist to
      set this variable.)
@@ -201,10 +208,10 @@ It can be:
   :type '(choice string
                 (repeat (choice string
                                 (cons regexp (repeat file))
-                                (function :value fun)))
+                                function))
                 (function-item gnus-hierarchial-home-score-file)
                 (function-item gnus-current-home-score-file)
-                (function :value fun)))
+                function))
 
 (defcustom gnus-home-adapt-file nil
   "Variable to control where new adaptive score entries are to go.
@@ -214,17 +221,26 @@ This variable allows the same syntax as `gnus-home-score-file'."
   :type '(choice string
                 (repeat (choice string
                                 (cons regexp (repeat file))
-                                (function :value fun)))
-                (function :value fun)))
+                                function))
+                function))
 
 (defcustom gnus-default-adaptive-score-alist
-  '((gnus-kill-file-mark)
+  `((gnus-kill-file-mark)
     (gnus-unread-mark)
-    (gnus-read-mark (from 3) (subject 30))
-    (gnus-catchup-mark (subject -10))
-    (gnus-killed-mark (from -1) (subject -20))
-    (gnus-del-mark (from -2) (subject -15)))
-  "*Alist of marks and scores."
+    (gnus-read-mark
+     (from , (+ 2 gnus-score-decay-constant))
+     (subject , (+ 27 gnus-score-decay-constant)))
+    (gnus-catchup-mark
+     (subject , (+ -7 (* -1 gnus-score-decay-constant))))
+    (gnus-killed-mark
+     (from , (- -1 gnus-score-decay-constant))
+     (subject , (+ -17 (* -1 gnus-score-decay-constant))))
+    (gnus-del-mark
+     (from , (- -1 gnus-score-decay-constant))
+     (subject , (+ -12 (* -1 gnus-score-decay-constant)))))
+  "Alist of marks and scores.
+If you use score decays, you might want to set values higher than
+`gnus-score-decay-constant'."
   :group 'gnus-score-adapt
   :type '(repeat (cons (symbol :tag "Mark")
                       (repeat (list (choice :tag "Header"
@@ -235,8 +251,10 @@ This variable allows the same syntax as `gnus-home-score-file'."
 
 (defcustom gnus-adaptive-word-length-limit nil
   "*Words of a length lesser than this limit will be ignored when doing adaptive scoring."
+  :version "22.1"
   :group 'gnus-score-adapt
-  :type 'integer)
+  :type '(radio (const :format "Unlimited " nil)
+               (integer :format "Maximum length: %v")))
 
 (defcustom gnus-ignored-adaptive-words nil
   "List of words to be ignored when doing adaptive word scoring."
@@ -304,6 +322,13 @@ If this variable is nil, exact matching will always be used."
   :group 'gnus-score-files
   :type 'regexp)
 
+(defcustom gnus-adaptive-pretty-print nil
+  "If non-nil, adaptive score files fill are pretty printed."
+  :group 'gnus-score-files
+  :group 'gnus-score-adapt
+  :version "23.0" ;; No Gnus
+  :type 'boolean)
+
 (defcustom gnus-score-default-header nil
   "Default header when entering new scores.
 
@@ -367,7 +392,7 @@ If nil, the user will be asked for a match type."
                 (const :tag "ask" nil)))
 
 (defcustom gnus-score-default-fold nil
-  "Use case folding for new score file entries iff not nil."
+  "Non-nil means use case folding for new score file entries."
   :group 'gnus-score-default
   :type 'boolean)
 
@@ -397,6 +422,18 @@ If nil, the user will be asked for a duration."
   :group 'gnus-score-various
   :type 'boolean)
 
+(defcustom gnus-inhibit-slow-scoring nil
+  "Inhibit slow scoring, e.g. scoring on headers or body.
+
+If a regexp, scoring on headers or body is inhibited if the group
+matches the regexp.  If it is t, scoring on headers or body is
+inhibited for all groups."
+  :group 'gnus-score-various
+  :version "23.0" ;; No Gnus
+  :type '(choice (const :tag "All" nil)
+                (const :tag "None" t)
+                regexp))
+
 \f
 
 ;; Internal variables.
@@ -489,7 +526,8 @@ of the last successful match.")
   "Make a score entry based on the current article.
 The user will be prompted for header to score on, match type,
 permanence, and the string to be used.  The numerical prefix will be
-used as score."
+used as score.  A symbolic prefix of `a' says to use the `all.SCORE'
+file for the command instead of the current score file."
   (interactive (gnus-interactive "P\ny"))
   (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
 
@@ -503,7 +541,8 @@ used as score."
   "Make a score entry based on the current article.
 The user will be prompted for header to score on, match type,
 permanence, and the string to be used.  The numerical prefix will be
-used as score."
+used as score.  A symbolic prefix of `a' says to use the `all.SCORE'
+file for the command instead of the current score file."
   (interactive (gnus-interactive "P\ny"))
   (let* ((nscore (gnus-score-delta-default score))
         (prefix (if (< nscore 0) ?L ?I))
@@ -622,7 +661,7 @@ used as score."
              (gnus-score-insert-help "Match permanence" char-to-perm 2)))
 
          (gnus-score-kill-help-buffer)
-         (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+         (if mimic (message "%c %c %c %c" prefix hchar tchar pchar)
            (message ""))
          (unless (setq temporary (cadr (assq pchar char-to-perm)))
            ;; Deal with der(r)ided superannuated paradigms.
@@ -645,7 +684,7 @@ used as score."
               (intern                  ; need symbol
                (gnus-completing-read-with-default
                 (symbol-name (car gnus-extra-headers)) ; default response
-                "Score extra header:"  ; prompt
+                "Score extra header  ; prompt
                 (mapcar (lambda (x)    ; completion list
                           (cons (symbol-name x) x))
                         gnus-extra-headers)
@@ -737,7 +776,7 @@ used as score."
        (setq i (1+ i))))
     (goto-char (point-min))
     ;; display ourselves in a small window at the bottom
-    (gnus-appt-select-lowest-window)
+    (gnus-select-lowest-window)
     (if (< (/ (window-height) 2) window-min-height)
        (switch-to-buffer "*Score Help*")
       (split-window)
@@ -820,7 +859,7 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
     ;; If this is an integer comparison, we transform from string to int.
     (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
        (if (stringp match)
-           (setq match (string-to-int match)))
+           (setq match (string-to-number match)))
       (set-text-properties 0 (length match) nil match))
 
     (unless (eq date 'now)
@@ -872,7 +911,7 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
     ;; Return the new scoring rule.
     new))
 
-(defun gnus-summary-score-effect (header match type score extra)
+(defun gnus-summary-score-effect (header match type score &optional extra)
   "Simulate the effect of a score file entry.
 HEADER is the header being scored.
 MATCH is the string we are looking for.
@@ -884,8 +923,8 @@ EXTRA is the possible non-standard header."
                                      (lambda (x) (fboundp (nth 2 x)))
                                      t)
                     (read-string "Match: ")
-                    (y-or-n-p "Use regexp match? ")
-                    (prefix-numeric-value current-prefix-arg)))
+                    (if (y-or-n-p "Use r