X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=79c7985fc0f8d4ea33d552043cdb706c059dafa8;hb=b19ab0bcf7b463d4b14b41bd23f2a5d62d03795a;hp=0463de5114e9e43f6cb185a0f716ac2cae397b9d;hpb=65ef68b0d5e9ee7ffb76373364b13dfb605e19dd;p=gnus

diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index 0463de511..79c7985fc 100644
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -26,8 +26,9 @@
 
 ;;; Code:
 
-(require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-load)
+(require 'gnus-sum)
+(require 'gnus-range)
 
 (defvar gnus-global-score-files nil
   "*List of global score files and directories.
@@ -109,15 +110,98 @@ will be expired along with non-matching score entries.")
 (defvar gnus-orphan-score nil
   "*All orphans get this score added. Set in the score file.")
 
+(defvar gnus-decay-scores nil
+  "*If non-nil, decay non-permanent scores.")
+
+(defvar gnus-decay-score-function 'gnus-decay-score
+  "*Function called to decay a score.
+It is called with one parameter -- the score to be decayed.")
+
+(defvar gnus-score-decay-constant 3
+  "*Decay all \"small\" scores with this amount.")
+
+(defvar gnus-score-decay-scale .05
+  "*Decay all \"big\" scores with this factor.")
+
+(defvar gnus-home-score-file nil
+  "Variable to control where interative score entries are to go.
+It can be:
+
+ * A string
+   This file 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 list
+   The elements in this list can be:
+
+   * `(regexp file-name ...)'
+     If the `regexp' matches the group name, the first `file-name' will
+     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.)
+
+   * A function.
+     If the function returns non-nil, the result will be used
+     as the home score file.
+
+   * A string.
+     Use the string as the home score file.
+
+   The list will be traversed from the beginning towards the end looking
+   for matches.")
+
+(defvar gnus-home-adapt-file nil
+  "Variable to control where new adaptive score entries are to go.
+This variable allows the same syntax as `gnus-home-score-file'.")
+
 (defvar gnus-default-adaptive-score-alist  
   '((gnus-kill-file-mark)
     (gnus-unread-mark)
-    (gnus-read-mark (from  3) (subject  30))
+    (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.")
 
+(defvar gnus-ignored-adaptive-words nil
+  "*List of words to be ignored when doing adaptive word scoring.")
+
+(defvar gnus-default-ignored-adaptive-words
+  '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you"
+    "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can"
+    "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one"
+    "so" "we" "they" "what" "would" "any" "which" "about" "get" "your"
+    "use" "some" "me" "then" "name" "like" "out" "when" "up" "time"
+    "other" "more" "only" "just" "end" "also" "know" "how" "new" "should"
+    "been" "than" "them" "he" "who" "make" "may" "people" "these" "now"
+    "their" "here" "into" "first" "could" "way" "had" "see" "work" "well"
+    "were" "two" "very" "where" "while" "us" "because" "good" "same"
+    "even" "much" "most" "many" "such" "long" "his" "over" "last" "since"
+    "right" "before" "our" "without" "too" "those" "why" "must" "part"
+    "being" "current" "back" "still" "go" "point" "value" "each" "did"
+    "both" "true" "off" "say" "another" "state" "might" "under" "start"
+    "try"
+
+    "re")
+  "Default list of words to be ignored when doing adaptive word scoring.")
+
+(defvar gnus-adaptive-word-syntax-table
+  (let ((table (copy-syntax-table (standard-syntax-table)))
+	(numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
+    (while numbers
+      (modify-syntax-entry (pop numbers) " " table))
+    table)
+  "Syntax table used when doing adaptive word scoring.")
+
+(defvar gnus-default-adaptive-word-score-alist  
+  `((,gnus-read-mark . 30)
+    (,gnus-catchup-mark . -10)
+    (,gnus-killed-mark . -20)
+    (,gnus-del-mark . -15))
+"*Alist of marks and scores.")
+
 (defvar gnus-score-mimic-keymap nil
   "*Have the score entry functions pretend that they are a keymap.")
 
@@ -190,6 +274,7 @@ If nil, the user will be asked for a duration.")
 
 ;; Internal variables.
 
+(defvar gnus-scores-exclude-files nil)
 (defvar gnus-internal-global-score-files nil)
 (defvar gnus-score-file-list nil)
 
@@ -243,20 +328,20 @@ of the last successful match.")
 
 ;;; Summary mode score maps.
 
-(gnus-define-keys
- (gnus-summary-score-map "V" gnus-summary-mode-map)
- "s" gnus-summary-set-score
- "a" gnus-summary-score-entry
- "S" gnus-summary-current-score
- "c" gnus-score-change-score-file
- "m" gnus-score-set-mark-below
- "x" gnus-score-set-expunge-below
- "R" gnus-summary-rescore
- "e" gnus-score-edit-current-scores
- "f" gnus-score-edit-file
- "F" gnus-score-flush-cache
- "t" gnus-score-find-trace
- "C" gnus-score-customize)
+(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
+  "s" gnus-summary-set-score
+  "a" gnus-summary-score-entry
+  "S" gnus-summary-current-score
+  "c" gnus-score-change-score-file
+  "m" gnus-score-set-mark-below
+  "x" gnus-score-set-expunge-below
+  "R" gnus-summary-rescore
+  "e" gnus-score-edit-current-scores
+  "f" gnus-score-edit-file
+  "F" gnus-score-flush-cache
+  "t" gnus-score-find-trace
+  "w" gnus-score-find-favourite-words
+  "C" gnus-score-customize)
 
 ;; Summary score file commands
 
@@ -392,7 +477,7 @@ used as score."
 	    (if mimic (error "%c %c" prefix hchar) (error "")))
 
 	  (when (/= (downcase tchar) tchar)
-	    ;; It was a majuscle, so we end reading and the the default.
+	    ;; It was a majuscle, so we end reading and use the default.
 	    (if mimic (message "%c %c %c" prefix hchar tchar)
 	      (message ""))
 	    (setq pchar (or pchar ?p)))
@@ -504,7 +589,7 @@ used as score."
 
 (defun gnus-newsgroup-score-alist ()
   (or
-   (let ((param-file (gnus-group-get-parameter 
+   (let ((param-file (gnus-group-find-parameter 
 		      gnus-newsgroup-name 'score-file)))
      (when param-file
        (gnus-score-load param-file)))
@@ -519,8 +604,8 @@ used as score."
 		  gnus-score-alist
 		  (gnus-newsgroup-score-alist)))))
 
-(defun gnus-summary-score-entry 
-  (header match type score date &optional prompt silent)
+(defun gnus-summary-score-entry (header match type score date
+					&optional prompt silent)
   "Enter score file entry.
 HEADER is the header being scored.
 MATCH is the string we are looking for.
@@ -551,20 +636,24 @@ If optional argument `SILENT' is nil, show effect of score entry."
 	((eq type 'f)
 	 (setq match (gnus-simplify-subject-fuzzy match))))
   (let ((score (gnus-score-default score))
-	(header (downcase header))
+	(header (format "%s" (downcase header)))
 	new)
-    (and prompt (setq match (read-string 
-			     (format "Match %s on %s, %s: " 
-				     (cond ((eq date 'now)
-					    "now")
-					   ((stringp date)
-					    "temp")
-					   (t "permanent"))
-				     header
-				     (if (< score 0) "lower" "raise"))
-			     (if (numberp match)
-				 (int-to-string match)
-			       match))))
+    (when prompt
+      (setq match (read-string 
+		   (format "Match %s on %s, %s: " 
+			   (cond ((eq date 'now)
+				  "now")
+				 ((stringp date)
+				  "temp")
+				 (t "permanent"))
+			   header
+			   (if (< score 0) "lower" "raise"))
+		   (if (numberp match)
+		       (int-to-string match)
+		     match))))
+
+    ;; Get rid of string props.
+    (setq match (format "%s" match))
 
     ;; If this is an integer comparison, we transform from string to int. 
     (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
@@ -578,7 +667,11 @@ If optional argument `SILENT' is nil, show effect of score entry."
 	    elem)
 	(setq new
 	      (cond 
-	       (type (list match score (and date (gnus-day-number date)) type))
+	       (type
+		(list match score
+		      (and date (if (numberp date) date
+				  (gnus-day-number date)))
+		      type))
 	       (date (list match score (gnus-day-number date)))
 	       (score (list match score))
 	       (t (list match))))
@@ -709,7 +802,7 @@ SCORE is the score to add."
   "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 "Expunge below: ")))))
+	     (string-to-int (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)))
@@ -721,7 +814,7 @@ SCORE is the score to add."
   (when (gnus-buffer-live-p gnus-summary-buffer)
     (save-excursion
       (save-restriction
-	(goto-char (point-min))
+	(message-narrow-to-headers)
 	(let ((id (mail-fetch-field "message-id")))
 	  (when id
 	    (set-buffer gnus-summary-buffer)
@@ -807,7 +900,7 @@ SCORE is the score to add."
   (interactive (list gnus-current-score-file))
   (let ((winconf (current-window-configuration)))
     (and (buffer-name gnus-summary-buffer) (gnus-score-save))
-    (gnus-make-directory (file-name-directory file))
+    (make-directory (file-name-directory file) t)
     (setq gnus-score-edit-buffer (find-file-noselect file))
     (gnus-configure-windows 'edit-score)
     (gnus-score-mode)
@@ -822,7 +915,7 @@ SCORE is the score to add."
   "Edit a score file."
   (interactive 
    (list (read-file-name "Edit score file: " gnus-kill-files-directory)))
-  (gnus-make-directory (file-name-directory file))
+  (make-directory (file-name-directory file) t)
   (and (buffer-name gnus-summary-buffer) (gnus-score-save))
   (let ((winconf (current-window-configuration)))
     (setq gnus-score-edit-buffer (find-file-noselect file))
@@ -887,7 +980,14 @@ SCORE is the score to add."
 	   (car (gnus-score-get 'thread-mark-and-expunge alist)))
 	  (adapt-file (car (gnus-score-get 'adapt-file alist)))
 	  (local (gnus-score-get 'local alist))
+	  (decay (car (gnus-score-get 'decay alist)))
 	  (eval (car (gnus-score-get 'eval alist))))
+      ;; Perform possible decays.
+      (when (and gnus-decay-scores
+		 (gnus-decay-scores 
+		  alist (or decay (gnus-time-to-day (current-time)))))
+	(gnus-score-set 'touched '(t) alist)
+	(gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))
       ;; We do not respect eval and files atoms from global score
       ;; files. 
       (and files (not global)
@@ -957,9 +1057,12 @@ SCORE is the score to add."
 	(delq (assoc file gnus-score-cache) gnus-score-cache)))
 
 (defun gnus-score-load-score-alist (file)
+  "Read score FILE."
   (let (alist)
     (if (not (file-readable-p file))
+	;; Couldn't read file.
 	(setq gnus-score-alist nil)
+      ;; Read file.
       (save-excursion
 	(gnus-set-work-buffer)
 	(insert-file-contents file)
@@ -970,11 +1073,7 @@ SCORE is the score to add."
 		(condition-case ()
 		    (read (current-buffer))
 		  (error 
-		   (progn
-		     (gnus-message 3 "Problem with score file %s" file)
-		     (ding) 
-		     (sit-for 2)
-		     nil))))))
+		   (gnus-error 3.2 "Problem with score file %s" file))))))
       (if (eq (car alist) 'setq)
 	  ;; This is an old-style score file.
 	  (setq gnus-score-alist (gnus-score-transform-old-to-new alist))
@@ -1058,58 +1157,55 @@ SCORE is the score to add."
   
 (defun gnus-score-save ()
   ;; Save all score information.
-  (let ((cache gnus-score-cache))
+  (let ((cache gnus-score-cache)
+	entry score file)
     (save-excursion
       (setq gnus-score-alist nil)
-      (set-buffer (get-buffer-create "*Score*"))
-      (buffer-disable-undo (current-buffer))
-      (let (entry score file)
-	(while cache
-	  (setq entry (car cache)
-		cache (cdr cache)
-		file (car entry)
-		score (cdr entry))
-	  (if (or (not (equal (gnus-score-get 'touched score) '(t)))
-		  (gnus-score-get 'read-only score)
-		  (and (file-exists-p file)
-		       (not (file-writable-p file))))
-	      ()
-	    (setq score (setcdr entry (delq (assq 'touched score) 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.
-		  (prin1 score (current-buffer))
-		;; This is a normal score file, so we print it very
-		;; prettily. 
-		(pp score (current-buffer))))
-	    (if (not (gnus-make-directory (file-name-directory file)))
-		()
-	      ;; If the score file is empty, we delete it.
-	      (if (zerop (buffer-size))
-		  (delete-file file)
-		;; There are scores, so we write the file. 
- 		(when (file-writable-p file)
-		  (write-region (point-min) (point-max) file nil 'silent)
-		  (and gnus-score-after-write-file-function
-		       (funcall gnus-score-after-write-file-function file)))))
-	    (and gnus-score-uncacheable-files
-		 (string-match gnus-score-uncacheable-files file)
-		 (gnus-score-remove-from-cache file)))))
+      (nnheader-set-temp-buffer "*Score*")
+      (while cache
+	(current-buffer)
+	(setq entry (pop cache)
+	      file (car entry)
+	      score (cdr entry))
+	(if (or (not (equal (gnus-score-get 'touched score) '(t)))
+		(gnus-score-get 'read-only score)
+		(and (file-exists-p file)
+		     (not (file-writable-p file))))
+	    ()
+	  (setq score (setcdr entry (delq (assq 'touched score) 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.
+		(gnus-prin1 score)
+	      ;; This is a normal score file, so we print it very
+	      ;; prettily. 
+	      (pp score (current-buffer))))
+	  (if (and (not (file-exists-p (file-name-directory file)))
+		   (make-directory (file-name-directory file) t))
+	      (gnus-error 1 "Can't create directory %s"
+			  (file-name-directory file))
+	    ;; If the score file is empty, we delete it.
+	    (if (zerop (buffer-size))
+		(delete-file file)
+	      ;; There are scores, so we write the file. 
+	      (when (file-writable-p file)
+		(write-region (point-min) (point-max) file nil 'silent)
+		(when gnus-score-after-write-file-function
+		  (funcall gnus-score-after-write-file-function file)))))
+	  (and gnus-score-uncacheable-files
+	       (string-match gnus-score-uncacheable-files file)
+	       (gnus-score-remove-from-cache file))))
       (kill-buffer (current-buffer)))))
-  
-(defun gnus-score-headers (score-files &optional trace)
-  ;; Score `gnus-newsgroup-headers'.
-  (let (scores news)
-    ;; PLM: probably this is not the best place to clear orphan-score
-    (setq gnus-orphan-score nil)
-    (setq gnus-scores-articles nil)
-    (setq gnus-scores-exclude-files nil)
-    ;; Load the score files.
+
+(defun gnus-score-load-files (score-files)
+  "Load all score files in SCORE-FILES."
+  ;; Load the score files.
+  (let (scores)
     (while score-files
       (if (stringp (car score-files))
 	  ;; It is a string, which means that it's a score file name,
@@ -1128,6 +1224,16 @@ SCORE is the score to add."
 	       (member (car c) gnus-scores-exclude-files)
 	       (setq scores (delq (car s) scores)))
 	  (setq s (cdr s)))))
+    scores))
+
+(defun gnus-score-headers (score-files &optional trace)
+  ;; Score `gnus-newsgroup-headers'.
+  (let (scores news)
+    ;; PLM: probably this is not the best place to clear orphan-score
+    (setq gnus-orphan-score nil
+	  gnus-scores-articles nil
+	  gnus-scores-exclude-files nil
+	  scores (gnus-score-load-files score-files))
     (setq news scores)
     ;; Do the scoring.
     (while news
@@ -1182,14 +1288,21 @@ SCORE is the score to add."
 
 	  ;; Add articles to `gnus-newsgroup-scored'.
 	  (while gnus-scores-articles
-	    (or (= gnus-summary-default-score (cdar gnus-scores-articles))
-		(setq gnus-newsgroup-scored
-		      (cons (cons (mail-header-number 
-				   (caar gnus-scores-articles))
-				  (cdar gnus-scores-articles))
-			    gnus-newsgroup-scored)))
+	    (when (or (/= gnus-summary-default-score
+			  (cdar gnus-scores-articles))
+		      gnus-save-score)
+	      (push (cons (mail-header-number (caar gnus-scores-articles))
+			  (cdar gnus-scores-articles))
+		    gnus-newsgroup-scored))
 	    (setq gnus-scores-articles (cdr gnus-scores-articles)))
 
+	  (let (score)
+	    (while (setq score (pop scores))
+	      (while score
+		(when (listp (caar score))
+		  (gnus-score-advanced (car score) trace))
+		(pop score))))
+		
 	  (gnus-message 5 "Scoring...done"))))))
 
 
@@ -1291,18 +1404,14 @@ SCORE is the score to add."
 	  ;; matches on numbers that any cleverness will take more
 	  ;; time than one would gain.
 	  (while articles
-	    (and (funcall match-func 
+	    (when (funcall match-func 
 			  (or (aref (caar articles) gnus-score-index) 0)
 			  match)
-		 (progn
-		   (and trace (setq gnus-score-trace 
-				    (cons
-				     (cons
-				      (car-safe (rassq alist gnus-score-cache))
-				      kill)
-				     gnus-score-trace)))
-		   (setq found t)
-		   (setcdr (car articles) (+ score (cdar articles)))))
+	      (when trace 
+		(push (cons (car-safe (rassq alist gnus-score-cache)) kill)
+		      gnus-score-trace))
+	      (setq found t)
+	      (setcdr (car articles) (+ score (cdar articles))))
 	    (setq articles (cdr articles)))
 	  ;; Update expire date
 	  (cond ((null date))		;Permanent entry.
@@ -1318,7 +1427,7 @@ SCORE is the score to add."
 
 (defun gnus-score-date (scores header now expire &optional trace)
   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
-	entries alist)
+	entries alist match match-func article)
 
     ;; Find matches.
     (while scores
@@ -1328,37 +1437,40 @@ SCORE is the score to add."
       (while (cdr entries)		;First entry is the header index.
 	(let* ((rest (cdr entries))		
 	       (kill (car rest))
-	       (match (timezone-make-date-sortable (nth 0 kill)))
 	       (type (or (nth 3 kill) 'before))
 	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
 	       (date (nth 2 kill))
 	       (found nil)
-	       (match-func 
-		(cond ((eq type 'after) 'string<)
-		      ((eq type 'before) 'gnus-string>)
-		      ((eq type 'at) 'string=)
-		      (t (error "Illegal match type: %s" type))))
 	       (articles gnus-scores-articles)
 	       l)
+	  (cond
+	   ((eq type 'after)
+	    (setq match-func 'string<
+		  match (gnus-date-iso8601 (nth 0 kill))))
+	   ((eq type 'before)
+	    (setq match-func 'gnus-string>
+		  match (gnus-date-iso8601 (nth 0 kill))))
+	   ((eq type 'at)
+	    (setq match-func 'string=
+		  match (gnus-date-iso8601 (nth 0 kill))))
+	   ((eq type 'regexp)
+	    (setq match-func 'string-match
+		  match (nth 0 kill)))
+	   (t (error "Illegal match type: %s" type)))
 	  ;; Instead of doing all the clever stuff that
 	  ;; `gnus-score-string' does to minimize searches and stuff,
 	  ;; I will assume that people generally will put so few
 	  ;; matches on numbers that any cleverness will take more
 	  ;; time than one would gain.
-	  (while articles
-	    (and
-	     (setq l (aref (caar articles) gnus-score-index))
-	     (funcall match-func match (timezone-make-date-sortable l))
-	     (progn
-	       (and trace (setq gnus-score-trace 
-				(cons
-				 (cons
-				  (car-safe (rassq alist gnus-score-cache))
-				  kill)
-				 gnus-score-trace)))
-	       (setq found t)
-	       (setcdr (car articles) (+ score (cdar articles)))))
-	    (setq articles (cdr articles)))
+	  (while (setq article (pop articles))
+	    (when (and
+		   (setq l (aref (car article) gnus-score-index))
+		   (funcall match-func match (gnus-date-iso8601 l)))
+	      (when trace
+		(push (cons (car-safe (rassq alist gnus-score-cache)) kill)
+		      gnus-score-trace))
+	      (setq found t)
+	      (setcdr article (+ score (cdr article)))))
 	  ;; Update expire date
 	  (cond ((null date))		;Permanent entry.
 		((and found gnus-update-score-entry-dates) ;Match, update date.
@@ -1390,20 +1502,16 @@ SCORE is the score to add."
 				 (t 'gnus-request-article)))
 	     entries alist ofunc article last)
 	(when articles
-	  (while (cdr articles)
-	    (setq articles (cdr articles)))
-	  (setq last (mail-header-number (caar articles)))
-	  (setq articles gnus-scores-articles)
+	  (setq last (mail-header-number (caar (last articles))))
 	  ;; Not all backends support partial fetching.  In that case,
 	  ;; we just fetch the entire article.
-	  (or (gnus-check-backend-function 
-	       (and (string-match "^gnus-" (symbol-name request-func))
-		    (intern (substring (symbol-name request-func)
-				       (match-end 0))))
-	       gnus-newsgroup-name)
-	      (progn
-		(setq ofunc request-func)
-		(setq request-func 'gnus-request-article)))
+	  (unless (gnus-check-backend-function 
+		   (and (string-match "^gnus-" (symbol-name request-func))
+			(intern (substring (symbol-name request-func)
+					   (match-end 0))))
+		   gnus-newsgroup-name)
+	    (setq ofunc request-func)
+	    (setq request-func 'gnus-request-article))
 	  (while articles
 	    (setq article (mail-header-number (caar articles)))
 	    (gnus-message 7 "Scoring on article %s of %s..." article last)
@@ -1604,7 +1712,8 @@ SCORE is the score to add."
   ;; Insert the unique article headers in the buffer.
   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
 	;; gnus-score-index is used as a free variable.
-	alike last this art entries alist articles scores fuzzy)
+	alike last this art entries alist articles scores 
+	fuzzies arts words kill)
 
     ;; Sorting the articles costs os O(N*log N) but will allow us to
     ;; only match with each unique header.  Thus the actual matching
@@ -1616,172 +1725,224 @@ SCORE is the score to add."
 	  articles gnus-scores-articles)
 
     (erase-buffer)
-    (while articles
-      (setq art (car articles)
-	    this (aref (car art) gnus-score-index)
-	    articles (cdr articles))
+    (while (setq art (pop articles))
+      (setq this (aref (car art) gnus-score-index))
       (if (equal last this)
 	  ;; O(N*H) cons-cells used here, where H is the number of
 	  ;; headers.
 	  (setq alike (cons art alike))
-	(if last
-	    (progn
-	      ;; Insert the line, with a text property on the
-	      ;; terminating newline referring to the articles with
-	      ;; this line.
-	      (insert last ?\n)
-	      (put-text-property (1- (point)) (point) 'articles alike)))
+	(when last
+	  ;; Insert the line, with a text property on the
+	  ;; terminating newline referring to the articles with
+	  ;; this line.
+	  (insert last ?\n)
+	  (put-text-property (1- (point)) (point) 'articles alike))
 	(setq alike (list art)
 	      last this)))
-    (and last				; Bwadr, duplicate code.
-	 (progn
-	   (insert last ?\n)			
-	   (put-text-property (1- (point)) (point) 'articles alike)))
-
-    ;; Find ordinary matches.
-    (setq scores score-list) 
-    (while scores
-      (setq alist (car scores)
-	    scores (cdr scores)
+    (when last				; Bwadr, duplicate code.
+      (insert last ?\n)			
+      (put-text-property (1- (point)) (point) 'articles alike))
+
+    ;; Go through all the score alists and pick out the entries
+    ;; for this header.
+    (while score-list
+      (setq alist (pop score-list)
+	    ;; There's only one instance of this header for
+	    ;; each score alist.
 	    entries (assoc header alist))
       (while (cdr entries)		;First entry is the header index.
-	(let* ((rest (cdr entries))		
-	       (kill (car rest))
+	(let* ((kill (cadr entries))
 	       (match (nth 0 kill))
 	       (type (or (nth 3 kill) 's))
 	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
 	       (date (nth 2 kill))
 	       (found nil)
 	       (mt (aref (symbol-name type) 0))
-	       (case-fold-search 
-		(not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F))))
+	       (case-fold-search (not (memq mt '(?R ?S ?E ?F))))
 	       (dmt (downcase mt))
 	       (search-func 
 		(cond ((= dmt ?r) 're-search-forward)
 		      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
-		      (t (error "Illegal match type: %s" type))))
-	       arts art)
-	  (if (= dmt ?f)
-	      (setq fuzzy t)
-	    ;; Do non-fuzzy matching.
+		      ((= dmt ?w) nil)
+		      (t (error "Illegal match type: %s" type)))))
+	  (cond
+	   ;; Fuzzy matches.  We save these for later.
+	   ((= dmt ?f)
+	    (push entries fuzzies))
+	   ;; Word matches.  Save these for even later.
+	   ((= dmt ?w)
+	    (push entries words))
+	   ;; Exact matches.
+	   ((= dmt ?e)
+	    ;; Do exact matching.
 	    (goto-char (point-min))
-	    (if (= dmt ?e)
-		;; Do exact matching.
-		(while (and (not (eobp)) 
-			    (funcall search-func match nil t))
-		  (and (= (progn (beginning-of-line) (point))
-			  (match-beginning 0))
-		       (= (progn (end-of-line) (point))
-			  (match-end 0))
-		       (progn
-			 (setq found (setq arts (get-text-property 
-						 (point) 'articles)))
-			 ;; Found a match, update scores.
-			 (if trace
-			     (while arts
-			       (setq art (car arts)
-				     arts (cdr arts))
-			       (setcdr art (+ score (cdr art)))
-			       (setq gnus-score-trace
-				     (cons
-				      (cons
-				       (car-safe
-					(rassq alist gnus-score-cache))
-				       kill)
-				      gnus-score-trace)))
-			   (while arts
-			     (setq art (car arts)
-				   arts (cdr arts))
-			     (setcdr art (+ score (cdr art)))))))
-		  (forward-line 1))
-	      ;; Do regexp and substring matching.
-	      (and (string= match "") (setq match "\n"))
-	      (while (and (not (eobp))
-			  (funcall search-func match nil t))
-		(goto-char (match-beginning 0))
-		(end-of-line)
-		(setq found (setq arts (get-text-property (point) 'articles)))
-		;; Found a match, update scores.
-		(if trace
-		    (while arts
-		      (setq art (pop arts))
-		      (setcdr art (+ score (cdr art)))
-		      (push (cons
-			      (car-safe (rassq alist gnus-score-cache))
-			      kill)
-			    gnus-score-trace))
-		  (while arts
-		    (setq art (pop arts))
-		    (setcdr art (+ score (cdr art)))))
-		(forward-line 1)))
-	    ;; Update expire date
+	    (while (and (not (eobp)) 
+			(funcall search-func match nil t))
+	      ;; Is it really exact?
+	      (and (eolp)
+		   (= (gnus-point-at-bol) (match-beginning 0))
+		   ;; Yup.
+		   (progn
+		     (setq found (setq arts (get-text-property 
+					     (point) 'articles)))
+		     ;; Found a match, update scores.
+		     (if trace
+			 (while (setq art (pop arts))
+			   (setcdr art (+ score (cdr art)))
+			   (setq gnus-score-trace
+				 (cons
+				  (cons
+				   (car-safe
+				    (rassq alist gnus-score-cache))
+				   kill)
+				  gnus-score-trace)))
+		       (while (setq art (pop arts))
+			 (setcdr art (+ score (cdr art)))))))
+	      (forward-line 1)))
+	   ;; Regexp and substring matching.
+	   (t
+	    (goto-char (point-min))
+	    (when (string= match "")
+	      (setq match "\n"))
+	    (while (and (not (eobp))
+			(funcall search-func match nil t))
+	      (goto-char (match-beginning 0))
+	      (end-of-line)
+	      (setq found (setq arts (get-text-property (point) 'articles)))
+	      ;; Found a match, update scores.
+	      (if trace
+		  (while (setq art (pop arts))
+		    (setcdr art (+ score (cdr art)))
+		    (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
+			  gnus-score-trace))
+		(while (setq art (pop arts))
+		  (setcdr art (+ score (cdr art)))))
+	      (forward-line 1))))
+	  ;; Update expiry date
+	  (if trace
+	      (setq entries (cdr entries))
 	    (cond 
-	     ((null date))		;Permanent entry.
-	     ((and found gnus-update-score-entry-dates) ;Match, update date.
+	     ;; Permanent entry.
+	     ((null date)
+	      (setq entries (cdr entries)))
+	     ;; We have a match, so we update the date.
+	     ((and found gnus-update-score-entry-dates)
 	      (gnus-score-set 'touched '(t) alist)
-	      (setcar (nthcdr 2 kill) now))
-	     ((and expire (< date expire)) ;Old entry, remove.
+	      (setcar (nthcdr 2 kill) now)
+	      (setq entries (cdr entries)))
+	     ;; This entry has expired, so we remove it.
+	     ((and expire (< date expire))
 	      (gnus-score-set 'touched '(t) alist)
-	      (setcdr entries (cdr rest))
-	      (setq rest entries))))
-	  (setq entries rest))))
+	      (setcdr entries (cddr entries)))
+	     ;; No match; go to next entry.
+	     (t
+	      (setq entries (cdr entries))))))))
 
     ;; Find fuzzy matches.
-    (when fuzzy
-      (setq scores score-list)
+    (when fuzzies
+      ;; Simplify the entire buffer for easy matching.
       (gnus-simplify-buffer-fuzzy)
-      (while scores
-	(setq alist (car scores)
-	      scores (cdr scores)
-	      entries (assoc header alist))
-	(while (cdr entries)		;First entry is the header index.
-	  (let* ((rest (cdr entries))		
-		 (kill (car rest))
-		 (match (nth 0 kill))
-		 (type (or (nth 3 kill) 's))
-		 (score (or (nth 1 kill) gnus-score-interactive-default-score))
+      (while (setq kill (cadar fuzzies))
+	(let* ((match (nth 0 kill))
+	       (type (nth 3 kill))
+	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
+	       (date (nth 2 kill))
+	       (mt (aref (symbol-name type) 0))
+	       (case-fold-search (not (= mt ?F)))
+	       found)
+	  (goto-char (point-min))
+	  (while (and (not (eobp)) 
+		      (search-forward match nil t))
+	    (when (and (= (gnus-point-at-bol) (match-beginning 0))
+		       (eolp))
+	      (setq found (setq arts (get-text-property (point) 'articles)))
+	      (if trace
+		  (while (setq art (pop arts))
+		    (setcdr art (+ score (cdr art)))
+		    (push (cons
+			   (car-safe (rassq alist gnus-score-cache)) kill)
+			  gnus-score-trace))
+		;; Found a match, update scores.
+		(while (setq art (pop arts))
+		  (setcdr art (+ score (cdr art))))))
+	    (forward-line 1))
+	  ;; Update expiry date
+	  (cond
+	   ;; Permanent.
+	   ((null date)
+	    )
+	   ;; Match, update date.
+	   ((and found gnus-update-score-entry-dates)
+	    (gnus-score-set 'touched '(t) alist)
+	    (setcar (nthcdr 2 kill) now))
+	   ;; Old entry, remove.
+	   ((and expire (< date expire)) 
+	    (gnus-score-set 'touched '(t) alist)
+	    (setcdr (car fuzzies) (cddar fuzzies))))
+	  (setq fuzzies (cdr fuzzies)))))
+
+    (when words
+      ;; Enter all words into the hashtb.
+      (let ((hashtb (gnus-make-hashtable
+		     (* 10 (count-lines (point-min) (point-max))))))
+	(gnus-enter-score-words-into-hashtb hashtb)
+	(while (setq kill (cadar words))
+	  (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score))
 		 (date (nth 2 kill))
-		 (found nil)
-		 (mt (aref (symbol-name type) 0))
-		 (case-fold-search (not (= mt ?F)))
-		 (dmt (downcase mt))
-		 arts art)
-	    (when (= dmt ?f)
-	      (goto-char (point-min))
-	      (while (and (not (eobp)) 
-			  (search-forward match nil t))
-		(when (and (= (progn (beginning-of-line) (point))
-			      (match-beginning 0))
-			   (= (progn (end-of-line) (point))
-			      (match-end 0)))
-		  (setq found (setq arts (get-text-property 
-					  (point) 'articles)))
-		  ;; Found a match, update scores.
-		  (if trace
-		      (while arts
-			(setq art (pop arts))
-			(setcdr art (+ score (cdr art)))
-			(push (cons
-			       (car-safe (rassq alist gnus-score-cache))
-			       kill)
-			      gnus-score-trace))
-		    (while arts
-		      (setq art (pop arts))
-		      (setcdr art (+ score (cdr art))))))
-		(forward-line 1))
-	      ;; Update expire date
-	      (unless trace
-		(cond 
-		 ((null date))		;Permanent entry.
-		 ((and found gnus-update-score-entry-dates) ;Match, update date.
-		  (gnus-score-set 'touched '(t) alist)
-		  (setcar (nthcdr 2 kill) now))
-		 ((and expire (< date expire)) ;Old entry, remove.
-		  (gnus-score-set 'touched '(t) alist)
-		  (setcdr entries (cdr rest))
-		  (setq rest entries)))))
-	    (setq entries rest))))))
-  nil)
+		 found)
+	    (when (setq arts (intern-soft (nth 0 kill) hashtb))
+	      (setq arts (symbol-value arts))
+	      (setq found t)
+	      (if trace
+		  (while (setq art (pop arts))
+		    (setcdr art (+ score (cdr art)))
+		    (push (cons
+			   (car-safe (rassq alist gnus-score-cache)) kill)
+			  gnus-score-trace))
+		;; Found a match, update scores.
+		(while (setq art (pop arts))
+		  (setcdr art (+ score (cdr art))))))
+	    ;; Update expiry date
+	    (cond
+	     ;; Permanent.
+	     ((null date)
+	      )
+	     ;; Match, update date.
+	     ((and found gnus-update-score-entry-dates)
+	      (gnus-score-set 'touched '(t) alist)
+	      (setcar (nthcdr 2 kill) now))
+	     ;; Old entry, remove.
+	     ((and expire (< date expire)) 
+	      (gnus-score-set 'touched '(t) alist)
+	      (setcdr (car words) (cddar words))))
+	    (setq words (cdr words))))))
+    nil))
+
+(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)
+    (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 (gnus-point-at-eol) 'articles) val)
+	     hashtb)))
+      (set-syntax-table syntab))
+    ;; Make all the ignorable words ignored.
+    (let ((ignored (append gnus-ignored-adaptive-words
+			   gnus-default-ignored-adaptive-words)))
+      (while ignored
+	(gnus-sethash (pop ignored) nil hashtb)))))
 
 (defun gnus-score-string< (a1 a2)
   ;; Compare headers in articles A2 and A2.
@@ -1789,10 +1950,6 @@ SCORE is the score to add."
   (string-lessp (aref (car a1) gnus-score-index)
 		(aref (car a2) gnus-score-index)))
 
-(defun gnus-score-build-cons (article)
-  ;; Build a `gnus-newsgroup-scored' type cons from ARTICLE.
-  (cons (mail-header-number (car article)) (cdr article)))
-
 (defun gnus-current-score-file-nondirectory (&optional score-file)
   (let ((score-file (or score-file gnus-current-score-file)))
     (if score-file 
@@ -1800,69 +1957,121 @@ SCORE is the score to add."
       "none")))
 
 (defun gnus-score-adaptive ()
-  (save-excursion
-    (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
-	   (alist malist)
-	   (date (current-time-string)) 
-	   (data gnus-newsgroup-data)
-	   elem headers match)
-      ;; First we transform the adaptive rule alist into something
-      ;; that's faster to process.
-      (while malist
-	(setq elem (car malist))
-	(if (symbolp (car elem))
-	    (setcar elem (symbol-value (car elem))))
-	(setq elem (cdr elem))
-	(while elem
-	  (setcdr (car elem) 
-		  (cons (if (eq (caar elem) 'followup)
-			    "references"
-			  (symbol-name (caar elem)))
-			(cdar elem)))
-	  (setcar (car elem) 
-		  `(lambda (h)
-		     (,(intern 
-			(concat "mail-header-" 
-				(if (eq (caar elem) 'followup)
-				    "message-id"
-				  (downcase (symbol-name (caar elem))))))
-		      h)))
-	  (setq elem (cdr elem)))
-	(setq malist (cdr malist)))
-      ;; We change the score file to the adaptive score file.
+  "Create adaptive score rules for this newsgroup."
+  (when gnus-use-adaptive-scoring
+    ;; We change the score file to the adaptive score file.
+    (save-excursion
+      (set-buffer gnus-summary-buffer)
+      (gnus-score-load-file 
+       (or gnus-newsgroup-adaptive-score-file
+	   (gnus-score-file-name 
+	    gnus-newsgroup-name gnus-adaptive-file-suffix))))
+    (cond
+     ;; Perform ordinary line scoring.
+     ((or (not (listp gnus-use-adaptive-scoring))
+	  (memq 'line gnus-use-adaptive-scoring))
       (save-excursion
-	(set-buffer gnus-summary-buffer)
-	(gnus-score-load-file 
-	 (or gnus-newsgroup-adaptive-score-file
-	     (gnus-score-file-name 
-	      gnus-newsgroup-name gnus-adaptive-file-suffix))))
-      ;; The we score away.
-      (while data
-	(setq elem (cdr (assq (gnus-data-mark (car data)) alist)))
-	(if (or (not elem)
-		(gnus-data-pseudo-p (car data)))
-	    ()
-	  (when (setq headers (gnus-data-header (car data)))
-	    (while elem 
-	      (setq match (funcall (caar elem) headers))
-	      (gnus-summary-score-entry 
-	       (nth 1 (car elem)) match
-	       (cond
-		((numberp match)
-		 '=)
-		((equal (nth 1 (car elem)) "date")
-		 'a)
-		(t
-		 ;; Whether we use substring or exact matches are controlled
-		 ;; here.  
-		 (if (or (not gnus-score-exact-adapt-limit)
-			 (< (length match) gnus-score-exact-adapt-limit))
-		     'e 
-		   (if (equal (nth 1 (car elem)) "subject")
-		       'f 's))))
-	       (nth 2 (car elem)) date nil t)
-	      (setq elem (cdr elem)))))
-	(setq data (cdr data))))))
+	(let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
+	       (alist malist)
+	       (date (current-time-string)) 
+	       (data gnus-newsgroup-data)
+	       elem headers match)
+	  ;; First we transform the adaptive rule alist into something
+	  ;; that's faster to process.
+	  (while malist
+	    (setq elem (car malist))
+	    (if (symbolp (car elem))
+		(setcar elem (symbol-value (car elem))))
+	    (setq elem (cdr elem))
+	    (while elem
+	      (setcdr (car elem) 
+		      (cons (if (eq (caar elem) 'followup)
+				"references"
+			      (symbol-name (caar elem)))
+			    (cdar elem)))
+	      (setcar (car elem) 
+		      `(lambda (h)
+			 (,(intern 
+			    (concat "mail-header-" 
+				    (if (eq (caar elem) 'followup)
+					"message-id"
+				      (downcase (symbol-name (caar elem))))))
+			  h)))
+	      (setq elem (cdr elem)))
+	    (setq malist (cdr malist)))
+	  ;; Then we score away.
+	  (while data
+	    (setq elem (cdr (assq (gnus-data-mark (car data)) alist)))
+	    (if (or (not elem)
+		    (gnus-data-pseudo-p (car data)))
+		()
+	      (when (setq headers (gnus-data-header (car data)))
+		(while elem 
+		  (setq match (funcall (caar elem) headers))
+		  (gnus-summary-score-entry 
+		   (nth 1 (car elem)) match
+		   (cond
+		    ((numberp match)
+		     '=)
+		    ((equal (nth 1 (car elem)) "date")
+		     'a)
+		    (t
+		     ;; Whether we use substring or exact matches is
+		     ;; controlled here.  
+		     (if (or (not gnus-score-exact-adapt-limit)
+			     (< (length match) gnus-score-exact-adapt-limit))
+			 'e 
+		       (if (equal (nth 1 (car elem)) "subject")
+			   'f 's))))
+		   (nth 2 (car elem)) date nil t)
+		  (setq elem (cdr elem)))))
+	    (setq data (cdr data))))))
+
+     ;; Perform adaptive word scoring.
+     ((memq 'word gnus-use-adaptive-scoring)
+      (nnheader-temp-write nil
+	(let* ((hashtb (gnus-make-hashtable 1000))
+	       (date (gnus-day-number (current-time-string)))
+	       (data gnus-newsgroup-data)
+	       (syntab (syntax-table))
+	       word d score val)
+	  (unwind-protect
+	      (progn
+		(set-syntax-table syntab)
+		;; Go through all articles.
+		(while (setq d (pop data))
+		  (when (setq score
+			      (cdr (assq 
+				    (gnus-data-mark d)
+				    gnus-default-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))
+		      (gnus-sethash word (+ (or val 0) score) hashtb))
+		    (erase-buffer))))
+	    (set-syntax-table syntab))
+	  ;; Make all the ignorable words ignored.
+	  (let ((ignored (append gnus-ignored-adaptive-words
+				 gnus-default-ignored-adaptive-words)))
+	    (while ignored
+	      (gnus-sethash (pop ignored) nil hashtb)))
+	  ;; Now we have all the words and scores, so we
+	  ;; add these rules to the ADAPT file.
+	  (set-buffer gnus-summary-buffer)
+	  (mapatoms
+	   (lambda (word)
+	     (when (symbol-value word)
+	       (gnus-summary-score-entry
+		"subject" (symbol-name word) 'w (symbol-value word)
+		date nil t)))
+	   hashtb)))))))
 
 (defun gnus-score-edit-done ()
   (let ((bufnam (buffer-file-name (current-buffer)))
@@ -1877,25 +2086,56 @@ SCORE is the score to add."
   (let ((gnus-newsgroup-headers
 	 (list (gnus-summary-article-header)))
 	(gnus-newsgroup-scored nil)
-	(buf (current-buffer))
 	trace)
-    (when (get-buffer "*Gnus Scores*")
-      (save-excursion
-	(set-buffer "*Gnus Scores*")
-	(erase-buffer)))
+    (save-excursion
+      (nnheader-set-temp-buffer "*Score Trace*"))
     (setq gnus-score-trace nil)
     (gnus-possibly-score-headers 'trace)
     (if (not (setq trace gnus-score-trace))
 	(gnus-error 1 "No score rules apply to the current article.")
-      (pop-to-buffer "*Gnus Scores*")
+      (set-buffer "*Score Trace*")
       (gnus-add-current-to-buffer-list)
-      (erase-buffer)
       (while trace
 	(insert (format "%S  ->  %s\n" (cdar trace)
 			(file-name-nondirectory (caar trace))))
 	(setq trace (cdr trace)))
       (goto-char (point-min))
-      (pop-to-buffer buf))))
+      (gnus-configure-windows 'score-trace))))
+
+(defun gnus-score-find-favourite-words ()
+  "List words used in scoring."
+  (interactive)
+  (let ((alists (gnus-score-load-files (gnus-all-score-files)))
+	alist rule rules)
+    ;; Go through all the score alists for this group
+    ;; and find all `w' rules.
+    (while (setq alist (pop alists))
+      (when (and (stringp (setq rule (pop alist)))
+		 (equal "subject" (downcase (pop rule))))
+	(while rule
+	  (when (memq (nth 3 (car rule)) '(w W word Word))
+	    (push (cons (or (nth 1 rule) gnus-score-interactive-default-score)
+			(car rule))
+		  rules))
+	  (pop rule))))
+    (setq rules (sort rules (lambda (r1 r2)
+			      (string-lessp (cdr r1) (cdr r2)))))
+    ;; Add up words that have appeared several times.
+    (let ((r rules))
+      (while (cdr r)
+	(if (equal (cdar r) (cdadr r))
+	    (progn
+	      (setcar (car r) (+ (caar r) (caadr r)))
+	      (setcdr r (cddr r)))
+	  (pop r))))
+    ;; Insert the words.
+    (nnheader-set-temp-buffer "*Score Words*")
+    (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2)))))
+    (while rules
+      (insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
+      (pop rules))
+    (gnus-add-current-to-buffer-list)
+    (gnus-configure-windows 'score-words)))
 
 (defun gnus-summary-rescore ()
   "Redo the entire scoring process in the current summary."
@@ -2027,6 +2267,7 @@ SCORE is the score to add."
   "Return all possible score files under DIR."
   (let ((files (directory-files (expand-file-name dir) t nil t))
 	(regexp (gnus-score-file-regexp))
+	(case-fold-search nil)
 	out file)
     (while (setq file (pop files))
       (cond 
@@ -2180,8 +2421,10 @@ The list is determined from the variable gnus-score-file-alist."
 	    (cons (cons group score-files) gnus-score-file-alist-cache))
       score-files)))
 
-(defun gnus-possibly-score-headers (&optional trace)
+(defun gnus-all-score-files ()
+  "Return a list of all score files for the current group."
   (let ((funcs gnus-score-find-score-files-function)
+	(group gnus-newsgroup-name)
 	score-files)
     ;; Make sure funcs is a list.
     (and funcs
@@ -2189,20 +2432,38 @@ The list is determined from the variable gnus-score-file-alist."
 	 (setq funcs (list funcs)))
     ;; Get the initial score files for this group.
     (when funcs 
-      (setq score-files (gnus-score-find-alist gnus-newsgroup-name)))
+      (setq score-files (gnus-score-find-alist group)))
+    ;; Add any home adapt files.
+    (let ((home (gnus-home-score-file group t)))
+      (when home
+	(push home score-files)
+	(setq gnus-newsgroup-adaptive-score-file home)))
+    ;; Check whether there is a `adapt-file' group parameter.
+    (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
+      (when param-file
+	(push param-file score-files)
+	(setq gnus-newsgroup-adaptive-score-file param-file)))
     ;; Go through all the functions for finding score files (or actual
     ;; scores) and add them to a list.
     (while funcs
       (when (gnus-functionp (car funcs))
 	(setq score-files 
-	      (nconc score-files (funcall (car funcs) gnus-newsgroup-name))))
+	      (nconc score-files (funcall (car funcs) group))))
       (setq funcs (cdr funcs)))
+    ;; Add any home score files.
+    (let ((home (gnus-home-score-file group)))
+      (when home
+	(push home score-files)))
     ;; Check whether there is a `score-file' group parameter.
-    (let ((param-file (gnus-group-get-parameter 
-		       gnus-newsgroup-name 'score-file)))
+    (let ((param-file (gnus-group-find-parameter group 'score-file)))
       (when param-file
 	(push param-file score-files)))
     ;; Do the scoring if there are any score files for this group.
+    score-files))
+    
+(defun gnus-possibly-score-headers (&optional trace)
+  "Do scoring if scoring is required."
+  (let ((score-files (gnus-all-score-files)))
     (when score-files
       (gnus-score-headers score-files trace))))
 
@@ -2250,6 +2511,81 @@ The list is determined from the variable gnus-score-file-alist."
       (gnus-message 1 "New score file entries will be case insensitive.")
     (gnus-message 1 "New score file entries will be case sensitive.")))
 
+;;; Home score file.
+
+(defun gnus-home-score-file (group &optional adapt)
+  "Return the home score file for GROUP.
+If ADAPT, return the home adaptive file instead."
+  (let ((list (if adapt gnus-home-adapt-file gnus-home-score-file))
+	elem found)
+    ;; Make sure we have a list.
+    (unless (listp list)
+      (setq list (list list)))
+    ;; Go through the list and look for matches.
+    (while (and (not found)
+		(setq elem (pop list)))
+      (setq found
+	    (cond
+	     ;; Simple string.
+	     ((stringp elem)
+	      elem)
+	     ;; Function.
+	     ((gnus-functionp elem)
+	      (funcall elem group))
+	     ;; Regexp-file cons
+	     ((consp elem)
+	      (when (string-match (car elem) group)
+		(cadr elem))))))
+    (when found
+      (nnheader-concat gnus-kill-files-directory found))))
+
+(defun gnus-hierarchial-home-score-file (group)
+  "Return the score file of the top-level hierarchy of GROUP."
+  (if (string-match "^[^.]+\\." group)
+      (concat (match-string 0 group) gnus-score-file-suffix)
+    ;; Group name without any dots.
+    (concat group "." gnus-score-file-suffix)))
+      
+(defun gnus-hierarchial-home-adapt-file (group)
+  "Return the adapt file of the top-level hierarchy of GROUP."
+  (if (string-match "^[^.]+\\." group)
+      (concat (match-string 0 group) gnus-adaptive-file-suffix)
+    ;; Group name without any dots.
+    (concat group "." gnus-adaptive-file-suffix)))
+
+;;;
+;;; Score decays
+;;;
+
+(defun gnus-decay-score (score)
+  "Decay SCORE."
+  (floor
+   (- score
+      (* (if (< score 0) 1 -1)
+	 (min score
+	      (max gnus-score-decay-constant
+		   (* (abs score)
+		      gnus-score-decay-scale)))))))
+
+(defun gnus-decay-scores (alist day)
+  "Decay non-permanent scores in ALIST."
+  (let ((times (- (gnus-time-to-day (current-time)) day))
+	kill entry updated score n)
+    (unless (zerop times) ;Done decays today already?
+      (while (setq entry (pop alist))
+	(when (stringp (car entry))
+	  (setq entry (cdr entry))
+	  (while (setq kill (pop entry))
+	    (when (nth 2 kill)
+	      (setq updated t)
+	      (setq score (or (car kill) gnus-score-interactive-default-score)
+		    n times)
+	      (while (natnump (decf n))
+		(setq score (funcall gnus-decay-score-function score)))
+	      (setcar kill score))))))
+    ;; Return whether this score file needs to be saved.  By Je-haysuss!
+    updated))
+
 (provide 'gnus-score)
 
 ;;; gnus-score.el ends here