X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=9732f6f90beb5067861432767cecdac410b620ed;hb=1a96d7bf660263f25557962103bc0ec2495d1d07;hp=c2b40cad58ca9fda39d207802e63231fd306b0e3;hpb=483d191790b7f8cf5ee888f0ac120b81b65b9580;p=gnus

diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index c2b40cad5..9732f6f90 100644
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -110,6 +110,19 @@ 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:
@@ -123,9 +136,11 @@ It can be:
  * A list
    The elements in this list can be:
 
-   * `(regexp . file-name)'
-     If the `regexp' matches the group name, the `file-name' will
-     will be used as the home score file.
+   * `(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
@@ -144,12 +159,49 @@ 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.")
 
@@ -288,6 +340,7 @@ of the last successful match.")
   "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
@@ -536,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)))
@@ -551,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.
@@ -614,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))))
@@ -757,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)
@@ -923,7 +980,13 @@ 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 decay))
+	(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)
@@ -993,9 +1056,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)
@@ -1006,11 +1072,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))
@@ -1118,7 +1180,7 @@ SCORE is the score to add."
 		;; 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))
+		(gnus-prin1 score)
 	      ;; This is a normal score file, so we print it very
 	      ;; prettily. 
 	      (pp score (current-buffer))))
@@ -1138,15 +1200,11 @@ SCORE is the score to add."
 	       (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,
@@ -1159,12 +1217,22 @@ SCORE is the score to add."
     ;; Prune the score files that are to be excluded, if any.
     (when gnus-scores-exclude-files
       (let ((s scores)
-	    c type)
+	    c)
 	(while s
 	  (and (setq c (rassq (car s) gnus-score-cache))
 	       (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
@@ -1219,12 +1287,12 @@ 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)
@@ -1358,7 +1426,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
@@ -1368,37 +1436,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.
@@ -1430,20 +1501,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)
@@ -1644,7 +1711,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
@@ -1656,172 +1724,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.
@@ -1829,10 +1949,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 
@@ -1840,69 +1956,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)))
@@ -1917,25 +2085,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."
@@ -2067,6 +2266,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 
@@ -2220,7 +2420,8 @@ 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)
@@ -2237,7 +2438,7 @@ The list is determined from the variable gnus-score-file-alist."
 	(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-get-parameter group 'adapt-file)))
+    (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)))
@@ -2251,12 +2452,17 @@ The list is determined from the variable gnus-score-file-alist."
     ;; Add any home score files.
     (let ((home (gnus-home-score-file group)))
       (when home
-	(setq score-files (nconc score-files (list home)))))
+	(push home score-files)))
     ;; Check whether there is a `score-file' group parameter.
-    (let ((param-file (gnus-group-get-parameter group 'score-file)))
+    (let ((param-file (gnus-group-find-parameter group 'score-file)))
       (when param-file
-	(setq score-files (nconc score-files (list 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))))
 
@@ -2328,24 +2534,57 @@ If ADAPT, return the home adaptive file instead."
 	     ;; Regexp-file cons
 	     ((consp elem)
 	      (when (string-match (car elem) group)
-		(cdr elem))))))
+		(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) "all." gnus-score-file-suffix)
+      (concat (match-string 0 group) gnus-score-file-suffix)
     ;; Group name without any dots.
-    (concat group ".all." gnus-score-file-suffix)))
+    (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) "all." gnus-adaptive-file-suffix)
+      (concat (match-string 0 group) gnus-adaptive-file-suffix)
     ;; Group name without any dots.
-    (concat group ".all." gnus-adaptive-file-suffix)))
-      
+    (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