2010-01-08 Jason Rumney <jasonr@gnu.org>

[gnus] / lisp / gnus-score.el

diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index 29d0df5..02e1b2f 100644 (file)
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -1,6 +1,7 @@
 ;;; gnus-score.el --- scoring code for Gnus
 ;;; gnus-score.el --- scoring code for Gnus

-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.

 
 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>


@@ -8,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -19,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; 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.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -36,8 +35,6 @@
 (require 'message)
 (require 'score-mode)
 
 (require 'message)
 (require 'score-mode)
 

-(autoload 'ffap-string-at-point "ffap")
-

 (defcustom gnus-global-score-files nil
   "List of global score files and directories.
 Set this variable if you want to use people's score files.  One entry
 (defcustom gnus-global-score-files nil
   "List of global score files and directories.
 Set this variable if you want to use people's score files.  One entry


@@ -141,16 +138,22 @@ If this variable is nil, no score file entries will be expired."
                 number))
 
 (defcustom gnus-update-score-entry-dates t
                 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 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
   :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.
 
 (defcustom gnus-decay-score-function 'gnus-decay-score
   "*Function called to decay a score.


@@ -174,7 +177,7 @@ It is called with one parameter -- the score to be decayed."
 It can be:
 
  * A string
 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.
 
  * A function
    The result of this function will be used as the home score file.


@@ -185,7 +188,7 @@ It can be:
    The elements in this list can be:
 
    * `(regexp file-name ...)'
    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.)
      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.)


@@ -203,10 +206,10 @@ It can be:
   :type '(choice string
                 (repeat (choice string
                                 (cons regexp (repeat file))
   :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-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.
 
 (defcustom gnus-home-adapt-file nil
   "Variable to control where new adaptive score entries are to go.


@@ -216,17 +219,26 @@ This variable allows the same syntax as `gnus-home-score-file'."
   :type '(choice string
                 (repeat (choice string
                                 (cons regexp (repeat 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
 
 (defcustom gnus-default-adaptive-score-alist

-  '((gnus-kill-file-mark)
+  `((gnus-kill-file-mark)

     (gnus-unread-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"
   :group 'gnus-score-adapt
   :type '(repeat (cons (symbol :tag "Mark")
                       (repeat (list (choice :tag "Header"


@@ -237,9 +249,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."
 
 (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 '(radio (const :format "Unlimited " nil)
   :group 'gnus-score-adapt
   :type '(radio (const :format "Unlimited " nil)

-               (integer :format "Maximum length: %v\n" :size 0)))
+               (integer :format "Maximum length: %v")))

 
 (defcustom gnus-ignored-adaptive-words nil
   "List of words to be ignored when doing adaptive word scoring."
 
 (defcustom gnus-ignored-adaptive-words nil
   "List of words to be ignored when doing adaptive word scoring."


@@ -307,6 +320,13 @@ If this variable is nil, exact matching will always be used."
   :group 'gnus-score-files
   :type 'regexp)
 
   :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.1" ;; No Gnus
+  :type 'boolean)
+

 (defcustom gnus-score-default-header nil
   "Default header when entering new scores.
 
 (defcustom gnus-score-default-header nil
   "Default header when entering new scores.
 


@@ -370,7 +390,7 @@ If nil, the user will be asked for a match type."
                 (const :tag "ask" nil)))
 
 (defcustom gnus-score-default-fold nil
                 (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)
 
   :group 'gnus-score-default
   :type 'boolean)
 


@@ -400,6 +420,18 @@ If nil, the user will be asked for a duration."
   :group 'gnus-score-various
   :type 'boolean)
 
   :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.1" ;; No Gnus
+  :type '(choice (const :tag "All" nil)
+                (const :tag "None" t)
+                regexp))
+

 \f
 
 ;; Internal variables.
 \f
 
 ;; Internal variables.


@@ -627,7 +659,7 @@ file for the command instead of the current score file."
              (gnus-score-insert-help "Match permanence" char-to-perm 2)))
 
          (gnus-score-kill-help-buffer)
              (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.
            (message ""))
          (unless (setq temporary (cadr (assq pchar char-to-perm)))
            ;; Deal with der(r)ided superannuated paradigms.


@@ -650,7 +682,7 @@ file for the command instead of the current score file."
               (intern                  ; need symbol
                (gnus-completing-read-with-default
                 (symbol-name (car gnus-extra-headers)) ; default response
               (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)
                 (mapcar (lambda (x)    ; completion list
                           (cons (symbol-name x) x))
                         gnus-extra-headers)


@@ -742,7 +774,7 @@ file for the command instead of the current score file."
        (setq i (1+ i))))
     (goto-char (point-min))
     ;; display ourselves in a small window at the bottom
        (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)
     (if (< (/ (window-height) 2) window-min-height)
        (switch-to-buffer "*Score Help*")
       (split-window)


@@ -825,7 +857,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)
     ;; 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)
       (set-text-properties 0 (length match) nil match))
 
     (unless (eq date 'now)


@@ -890,7 +922,7 @@ EXTRA is the possible non-standard header."
                                      t)
                     (read-string "Match: ")
                     (if (y-or-n-p "Use regexp match? ") 'r 's)
                                      t)
                     (read-string "Match: ")
                     (if (y-or-n-p "Use regexp match? ") 'r 's)

-                    (string-to-int (read-string "Score: "))))
+                    (string-to-number (read-string "Score: "))))

   (save-excursion
     (unless (and (stringp match) (> (length match) 0))
       (error "No match"))
   (save-excursion
     (unless (and (stringp match) (> (length match) 0))
       (error "No match"))


@@ -944,7 +976,7 @@ EXTRA is the possible non-standard header."
   "Automatically mark articles with score below SCORE as read."
   (interactive
    (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
   "Automatically mark articles with score below SCORE as read."
   (interactive
    (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))

-            (string-to-int (read-string "Mark below: ")))))
+            (string-to-number (read-string "Mark below: ")))))

   (setq score (or score gnus-summary-default-score 0))
   (gnus-score-set 'mark (list score))
   (gnus-score-set 'touched '(t))
   (setq score (or score gnus-summary-default-score 0))
   (gnus-score-set 'mark (list score))
   (gnus-score-set 'touched '(t))


@@ -978,7 +1010,7 @@ EXTRA is the possible non-standard header."
   "Automatically expunge articles with score below SCORE."
   (interactive
    (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
   "Automatically expunge articles with score below SCORE."
   (interactive
    (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))

-            (string-to-int (read-string "Set expunge below: ")))))
+            (string-to-number (read-string "Set expunge below: ")))))

   (setq score (or score gnus-summary-default-score 0))
   (gnus-score-set 'expunge (list score))
   (gnus-score-set 'touched '(t)))
   (setq score (or score gnus-summary-default-score 0))
   (gnus-score-set 'expunge (list score))
   (gnus-score-set 'touched '(t)))


@@ -1088,10 +1120,15 @@ EXTRA is the possible non-standard header."
      4 (substitute-command-keys
        "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
 
      4 (substitute-command-keys
        "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
 

-(defun gnus-score-edit-all-score (file)
+(defun gnus-score-edit-all-score ()

   "Edit the all.SCORE file."
   (interactive)
   "Edit the all.SCORE file."
   (interactive)

-  (find-file (gnus-score-file-name "all")))
+  (find-file (gnus-score-file-name "all"))
+  (gnus-score-mode)
+  (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
+  (gnus-message
+   4 (substitute-command-keys
+      "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))

 
 (defun gnus-score-edit-file (file)
   "Edit a score file."
 
 (defun gnus-score-edit-file (file)
   "Edit a score file."


@@ -1203,7 +1240,9 @@ If FORMAT, also format the current score file."
          (decay (car (gnus-score-get 'decay alist)))
          (eval (car (gnus-score-get 'eval alist))))
       ;; Perform possible decays.
          (decay (car (gnus-score-get 'decay alist)))
          (eval (car (gnus-score-get 'eval alist))))
       ;; Perform possible decays.

-      (when (and gnus-decay-scores
+      (when (and (if (stringp gnus-decay-scores)
+                    (string-match gnus-decay-scores file)
+                  gnus-decay-scores)

                 (or cached (file-exists-p file))
                 (or (not decay)
                     (gnus-decay-scores alist decay)))
                 (or cached (file-exists-p file))
                 (or (not decay)
                     (gnus-decay-scores alist decay)))


@@ -1213,8 +1252,7 @@ If FORMAT, also format the current score file."
       ;; files.
       (when (and files (not global))
        (setq lists (apply 'append lists
       ;; files.
       (when (and files (not global))
        (setq lists (apply 'append lists

-                          (mapcar (lambda (file)
-                                    (gnus-score-load-file file))
+                          (mapcar 'gnus-score-load-file

                                   (if adapt-file (cons adapt-file files)
                                     files)))))
       (when (and eval (not global))
                                   (if adapt-file (cons adapt-file files)
                                     files)))))
       (when (and eval (not global))


@@ -1406,17 +1444,18 @@ If FORMAT, also format the current score file."
          (setq score (setcdr entry (gnus-delete-alist 'touched score)))
          (erase-buffer)
          (let (emacs-lisp-mode-hook)
          (setq score (setcdr entry (gnus-delete-alist 'touched score)))
          (erase-buffer)
          (let (emacs-lisp-mode-hook)

-           (if (string-match
-                (concat (regexp-quote gnus-adaptive-file-suffix) "$")
-                file)
-               ;; This is an adaptive score file, so we do not run
-               ;; it through `pp'.  These files can get huge, and
-               ;; are not meant to be edited by human hands.
+           (if (and (not gnus-adaptive-pretty-print)
+                    (string-match
+                     (concat (regexp-quote gnus-adaptive-file-suffix) "$")
+                     file))
+               ;; This is an adaptive score file, so we do not run it through
+               ;; `pp' unless requested.  These files can get huge, and are
+               ;; not meant to be edited by human hands.

                (gnus-prin1 score)
              ;; This is a normal score file, so we print it very
              ;; prettily.
              (let ((lisp-mode-syntax-table score-mode-syntax-table))
                (gnus-prin1 score)
              ;; This is a normal score file, so we print it very
              ;; prettily.
              (let ((lisp-mode-syntax-table score-mode-syntax-table))

-               (pp score (current-buffer)))))
+               (gnus-pp score))))

          (gnus-make-directory (file-name-directory file))
          ;; If the score file is empty, we delete it.
          (if (zerop (buffer-size))
          (gnus-make-directory (file-name-directory file))
          ;; If the score file is empty, we delete it.
          (if (zerop (buffer-size))


@@ -1511,9 +1550,22 @@ If FORMAT, also format the current score file."
                                      (lambda (score)
                                        (length (gnus-score-get header score)))
                                      scores)))
                                      (lambda (score)
                                        (length (gnus-score-get header score)))
                                      scores)))

-               ;; Call the scoring function for this type of "header".
-               (when (setq new (funcall (nth 2 entry) scores header
-                                        now expire trace))
+               (when (if (and gnus-inhibit-slow-scoring
+                              (or (eq gnus-inhibit-slow-scoring t)
+                                  (and (stringp gnus-inhibit-slow-scoring)
+                                       ;; Always true here?
+                                       ;; (stringp gnus-newsgroup-name)
+                                       (string-match
+                                        gnus-inhibit-slow-scoring
+                                        gnus-newsgroup-name)))
+                              (> 0 (nth 1 (assoc header gnus-header-index))))
+                         (progn
+                           (gnus-message
+                            7 "Scoring on headers or body skipped.")
+                           nil)
+                       ;; Call the scoring function for this type of "header".
+                       (setq new (funcall (nth 2 entry) scores header
+                                          now expire trace)))

                  (push new news))))
            (when (gnus-buffer-live-p gnus-summary-buffer)
              (let ((scored gnus-newsgroup-scored))
                  (push new news))))
            (when (gnus-buffer-live-p gnus-summary-buffer)
              (let ((scored gnus-newsgroup-scored))


@@ -2188,23 +2240,19 @@ score in `gnus-newsgroup-scored' by SCORE."
 (defun gnus-enter-score-words-into-hashtb (hashtb)
   ;; Find all the words in the buffer and enter them into
   ;; the hashtable.
 (defun gnus-enter-score-words-into-hashtb (hashtb)
   ;; Find all the words in the buffer and enter them into
   ;; the hashtable.

-  (let ((syntab (syntax-table))
-       word val)
+  (let (word val)

     (goto-char (point-min))
     (goto-char (point-min))

-    (unwind-protect
-       (progn
-         (set-syntax-table gnus-adaptive-word-syntax-table)
-         (while (re-search-forward "\\b\\w+\\b" nil t)
-           (setq val
-                 (gnus-gethash
-                  (setq word (downcase (buffer-substring
-                                        (match-beginning 0) (match-end 0))))
-                  hashtb))
-           (gnus-sethash
-            word
-            (append (get-text-property (point-at-eol) 'articles) val)
-            hashtb)))
-      (set-syntax-table syntab))
+    (with-syntax-table gnus-adaptive-word-syntax-table
+      (while (re-search-forward "\\b\\w+\\b" nil t)
+       (setq val
+             (gnus-gethash
+              (setq word (downcase (buffer-substring
+                                    (match-beginning 0) (match-end 0))))
+              hashtb))
+       (gnus-sethash
+        word
+        (append (get-text-property (point-at-eol) 'articles) val)
+        hashtb)))

     ;; Make all the ignorable words ignored.
     (let ((ignored (append gnus-ignored-adaptive-words
                           (if gnus-adaptive-word-no-group-words
     ;; Make all the ignorable words ignored.
     (let ((ignored (append gnus-ignored-adaptive-words
                           (if gnus-adaptive-word-no-group-words


@@ -2307,39 +2355,35 @@ score in `gnus-newsgroup-scored' by SCORE."
        (let* ((hashtb (gnus-make-hashtable 1000))
               (date (date-to-day (current-time-string)))
               (data gnus-newsgroup-data)
        (let* ((hashtb (gnus-make-hashtable 1000))
               (date (date-to-day (current-time-string)))
               (data gnus-newsgroup-data)

-              (syntab (syntax-table))

               word d score val)
               word d score val)

-         (unwind-protect
-             (progn
-               (set-syntax-table gnus-adaptive-word-syntax-table)
-               ;; Go through all articles.
-               (while (setq d (pop data))
-                 (when (and
-                        (not (gnus-data-pseudo-p d))
-                        (setq score
-                              (cdr (assq
-                                    (gnus-data-mark d)
-                                    gnus-adaptive-word-score-alist))))
-                   ;; This article has a mark that should lead to
-                   ;; adaptive word rules, so we insert the subject
-                   ;; and find all words in that string.
-                   (insert (mail-header-subject (gnus-data-header d)))
-                   (downcase-region (point-min) (point-max))
-                   (goto-char (point-min))
-                   (while (re-search-forward "\\b\\w+\\b" nil t)
-                     ;; Put the word and score into the hashtb.
-                     (setq val (gnus-gethash (setq word (match-string 0))
-                                             hashtb))
-                     (when (or (not gnus-adaptive-word-length-limit)
-                               (> (length word)
-                                  gnus-adaptive-word-length-limit))
-                       (setq val (+ score (or val 0)))
-                       (if (and gnus-adaptive-word-minimum
-                                (< val gnus-adaptive-word-minimum))
-                           (setq val gnus-adaptive-word-minimum))
-                       (gnus-sethash word val hashtb)))
-                   (erase-buffer))))
-           (set-syntax-table syntab))
+         (with-syntax-table gnus-adaptive-word-syntax-table
+           ;; Go through all articles.
+           (while (setq d (pop data))
+             (when (and
+                    (not (gnus-data-pseudo-p d))
+                    (setq score
+                          (cdr (assq
+                                (gnus-data-mark d)
+                                gnus-adaptive-word-score-alist))))
+               ;; This article has a mark that should lead to
+               ;; adaptive word rules, so we insert the subject
+               ;; and find all words in that string.
+               (insert (mail-header-subject (gnus-data-header d)))
+               (downcase-region (point-min) (point-max))
+               (goto-char (point-min))
+               (while (re-search-forward "\\b\\w+\\b" nil t)
+                 ;; Put the word and score into the hashtb.
+                 (setq val (gnus-gethash (setq word (match-string 0))
+                                         hashtb))
+                 (when (or (not gnus-adaptive-word-length-limit)
+                           (> (length word)
+                              gnus-adaptive-word-length-limit))
+                   (setq val (+ score (or val 0)))
+                   (if (and gnus-adaptive-word-minimum
+                            (< val gnus-adaptive-word-minimum))
+                       (setq val gnus-adaptive-word-minimum))
+                   (gnus-sethash word val hashtb)))
+               (erase-buffer))))

          ;; Make all the ignorable words ignored.
          (let ((ignored (append gnus-ignored-adaptive-words
                                 (if gnus-adaptive-word-no-group-words
          ;; Make all the ignorable words ignored.
          (let ((ignored (append gnus-ignored-adaptive-words
                                 (if gnus-adaptive-word-no-group-words


@@ -2367,7 +2411,8 @@ score in `gnus-newsgroup-scored' by SCORE."
     (when winconf
       (set-window-configuration winconf))
     (gnus-score-remove-from-cache bufnam)
     (when winconf
       (set-window-configuration winconf))
     (gnus-score-remove-from-cache bufnam)

-    (gnus-score-load-file bufnam)))
+    (gnus-score-load-file bufnam)
+    (run-hooks 'gnus-score-edit-done-hook)))

 
 (defun gnus-score-find-trace ()
   "Find all score rules that applies to the current article."
 
 (defun gnus-score-find-trace ()
   "Find all score rules that applies to the current article."


@@ -2395,6 +2440,11 @@ score in `gnus-newsgroup-scored' by SCORE."
                         (interactive)
                         (bury-buffer nil)
                         (gnus-summary-expand-window)))
                         (interactive)
                         (bury-buffer nil)
                         (gnus-summary-expand-window)))

+       (local-set-key "k"
+                      (lambda ()
+                        (interactive)
+                        (kill-buffer (current-buffer))
+                        (gnus-summary-expand-window)))

        (local-set-key "e" (lambda ()
                             "Run `gnus-score-edit-file-at-point'."
                             (interactive)
        (local-set-key "e" (lambda ()
                             "Run `gnus-score-edit-file-at-point'."
                             (interactive)


@@ -2417,13 +2467,20 @@ score in `gnus-newsgroup-scored' by SCORE."
                   ;; .ADAPT directly:
                   (file-name-nondirectory file)
                   (abbreviate-file-name file))))
                   ;; .ADAPT directly:
                   (file-name-nondirectory file)
                   (abbreviate-file-name file))))

+       (insert
+        (format "\nTotal score: %d"
+                (apply '+ (mapcar
+                           (lambda (s)
+                             (or (caddr s)
+                                 gnus-score-interactive-default-score))
+                           trace))))

        (insert
         "\n\nQuick help:
 
 Type `e' to edit score file corresponding to the score rule on current line,
 `f' to format (pretty print) the score file and edit it,
 `t' toggle to truncate long lines in this buffer,
        (insert
         "\n\nQuick help:
 
 Type `e' to edit score file corresponding to the score rule on current line,
 `f' to format (pretty print) the score file and edit it,
 `t' toggle to truncate long lines in this buffer,

-`q' to quit.
+`q' to quit, `k' to kill score trace buffer.

 
 The first sexp on each line is the score rule, followed by the file name of
 the score file and its full name, including the directory.")
 
 The first sexp on each line is the score rule, followed by the file name of
 the score file and its full name, including the directory.")


@@ -2769,9 +2826,7 @@ Destroys the current buffer."
            (lambda (file)
              (cons (inline (gnus-score-file-rank file)) file))
            files)))
            (lambda (file)
              (cons (inline (gnus-score-file-rank file)) file))
            files)))

-      (mapcar
-       (lambda (f) (cdr f))
-       (sort alist 'car-less-than-car)))))
+      (mapcar 'cdr (sort alist 'car-less-than-car)))))

 
 (defun gnus-score-find-alist (group)
   "Return list of score files for GROUP.
 
 (defun gnus-score-find-alist (group)
   "Return list of score files for GROUP.


@@ -3064,4 +3119,5 @@ See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
 
 (provide 'gnus-score)
 
 
 (provide 'gnus-score)
 

+;; arch-tag: d3922589-764d-46ae-9954-9330fd192634

 ;;; gnus-score.el ends here
 ;;; gnus-score.el ends here