X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=260dbceff1e1aba6acd86001d65404e938e4b0d4;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=4ddc3135b0e114e9e022313a7cfe9834c87dae75;hpb=3c19a9d1054e341f806d39714ddf1d70b03ef142;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index 4ddc313..260dbce 100644
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -1,5 +1,5 @@
 ;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
@@ -28,6 +28,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+(eval-when-compile (require 'gnus-clfns))
 
 (require 'gnus)
 (require 'gnus-sum)
@@ -47,7 +48,7 @@ score files in the \"/ftp.some-where:/pub/score\" directory.
 
  (setq gnus-global-score-files
        '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
-         \"/ftp.some-where:/pub/score\"))"
+	 \"/ftp.some-where:/pub/score\"))"
   :group 'gnus-score-files
   :type '(repeat file))
 
@@ -59,10 +60,10 @@ Each element of this alist should be of the form
 If the name of a group is matched by REGEXP, the corresponding scorefiles
 will be used for that group.
 The first match found is used, subsequent matching entries are ignored (to
-use multiple matches, see gnus-score-file-multiple-match-alist).
+use multiple matches, see `gnus-score-file-multiple-match-alist').
 
 These score files are loaded in addition to any files returned by
-gnus-score-find-score-files-function (which see)."
+`gnus-score-find-score-files-function'."
   :group 'gnus-score-files
   :type '(repeat (cons regexp (repeat file))))
 
@@ -75,10 +76,10 @@ If the name of a group is matched by REGEXP, the corresponding scorefiles
 will be used for that group.
 If multiple REGEXPs match a group, the score files corresponding to each
 match will be used (for only one match to be used, see
-gnus-score-file-single-match-alist).
+`gnus-score-file-single-match-alist').
 
 These score files are loaded in addition to any files returned by
-gnus-score-find-score-files-function (which see)."
+`gnus-score-find-score-files-function'."
   :group 'gnus-score-files
   :type '(repeat (cons regexp (repeat file))))
 
@@ -101,15 +102,15 @@ files do not actually have to exist.
 
 Predefined values are:
 
-gnus-score-find-single: Only apply the group's own score file.
-gnus-score-find-hierarchical: Also apply score files from parent groups.
-gnus-score-find-bnews: Apply score files whose names matches.
+`gnus-score-find-single': Only apply the group's own score file.
+`gnus-score-find-hierarchical': Also apply score files from parent groups.
+`gnus-score-find-bnews': Apply score files whose names matches.
 
 See the documentation to these functions for more information.
 
 This variable can also be a list of functions to be called.  Each
-function should either return a list of score files, or a list of
-score alists.
+function is given the group name as argument and should either return
+a list of score files, or a list of score alists.
 
 If functions other than these pre-defined functions are used,
 the `a' symbolic prefix to the score commands will always use
@@ -118,7 +119,12 @@ the `a' symbolic prefix to the score commands will always use
   :type '(radio (function-item gnus-score-find-single)
 		(function-item gnus-score-find-hierarchical)
 		(function-item gnus-score-find-bnews)
-		(function :tag "Other")))
+		(repeat :tag "List of functions"
+			(choice (function :tag "Other" :value 'ignore)
+				(function-item gnus-score-find-single)
+				(function-item gnus-score-find-hierarchical)
+				(function-item gnus-score-find-bnews)))
+		(function :tag "Other" :value 'ignore)))
 
 (defcustom gnus-score-interactive-default-score 1000
   "*Scoring commands will raise/lower the score with this number as the default."
@@ -196,6 +202,8 @@ It can be:
 		 (repeat (choice string
 				 (cons regexp (repeat file))
 				 (function :value fun)))
+		 (function-item gnus-hierarchial-home-score-file)
+		 (function-item gnus-current-home-score-file)
 		 (function :value fun)))
 
 (defcustom gnus-home-adapt-file nil
@@ -225,6 +233,11 @@ This variable allows the same syntax as `gnus-home-score-file'."
 					     (symbol :tag "other"))
 				     (integer :tag "Score"))))))
 
+(defcustom gnus-adaptive-word-length-limit nil
+  "*Words of a length lesser than this limit will be ignored when doing adaptive scoring."
+  :group 'gnus-score-adapt
+  :type 'integer)
+
 (defcustom gnus-ignored-adaptive-words nil
   "List of words to be ignored when doing adaptive word scoring."
   :group 'gnus-score-adapt
@@ -377,7 +390,7 @@ If nil, the user will be asked for a duration."
 (defcustom gnus-score-after-write-file-function nil
   "Function called with the name of the score file just written to disk."
   :group 'gnus-score-files
-  :type 'function)
+  :type '(choice (const nil) function))
 
 (defcustom gnus-score-thread-simplify nil
   "If non-nil, subjects will simplified as in threading."
@@ -388,6 +401,9 @@ If nil, the user will be asked for a duration."
 
 ;; Internal variables.
 
+(defvar gnus-score-use-all-scores t
+  "If nil, only `gnus-score-find-score-files-function' is used.")
+
 (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)))
@@ -432,21 +448,55 @@ of the last successful match.")
 
 (defconst gnus-header-index
   ;; Name to index alist.
-  '(("number" 0 gnus-score-integer)
-    ("subject" 1 gnus-score-string)
-    ("from" 2 gnus-score-string)
-    ("date" 3 gnus-score-date)
-    ("message-id" 4 gnus-score-string)
-    ("references" 5 gnus-score-string)
-    ("chars" 6 gnus-score-integer)
-    ("lines" 7 gnus-score-integer)
-    ("xref" 8 gnus-score-string)
-    ("extra" 9 gnus-score-string)
+  `(("number"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'location)
+     gnus-score-integer)
+    ("subject"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'subject)
+     gnus-score-string)
+    ("from"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'from)
+     gnus-score-string)
+    ("date"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'date)
+     gnus-score-date)
+    ("message-id"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'id)
+     gnus-score-string)
+    ("references"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'references)
+     gnus-score-string)
+    ("chars"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'chars)
+     gnus-score-integer)
+    ("lines"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'lines)
+     gnus-score-integer)
+    ("xref"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'xref)
+     gnus-score-string)
+;;    ("extra" 16 gnus-score-string)
+    ("extra" -1 gnus-score-body)
     ("head" -1 gnus-score-body)
     ("body" -1 gnus-score-body)
     ("all" -1 gnus-score-body)
-    ("followup" 2 gnus-score-followup)
-    ("thread" 5 gnus-score-thread)))
+    ("followup"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'from)
+     gnus-score-followup)
+    ("thread"
+     ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+			     'references)
+     gnus-score-thread)))
 
 ;;; Summary mode score maps.
 
@@ -798,11 +848,11 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
 		       (int-to-string match)
 		     match))))
 
-    (set-text-properties 0 (length match) nil match)
-
     ;; If this is an integer comparison, we transform from string to int.
-    (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
-      (setq match (string-to-int match)))
+    (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
+	(if (stringp match)
+	    (setq match (string-to-int match)))
+      (set-text-properties 0 (length match) nil match))
 
     (unless (eq date 'now)
       ;; Add the score entry to the score file.
@@ -1092,8 +1142,7 @@ EXTRA is the possible non-standard header."
 					gnus-kill-files-directory)))
 			  (expand-file-name file))
 			 file)
-		    (concat (file-name-as-directory gnus-kill-files-directory)
-			    file))))
+		    (expand-file-name file gnus-kill-files-directory))))
 	 (cached (assoc file gnus-score-cache))
 	 (global (member file gnus-internal-global-score-files))
 	 lists alist)
@@ -1134,7 +1183,7 @@ EXTRA is the possible non-standard header."
 	  (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
 	  (files (gnus-score-get 'files alist))
 	  (exclude-files (gnus-score-get 'exclude-files alist))
-          (orphan (car (gnus-score-get 'orphan alist)))
+	  (orphan (car (gnus-score-get 'orphan alist)))
 	  (adapt (gnus-score-get 'adapt alist))
 	  (thread-mark-and-expunge
 	   (car (gnus-score-get 'thread-mark-and-expunge alist)))
@@ -1230,8 +1279,8 @@ EXTRA is the possible non-standard header."
 	(setq gnus-score-alist nil)
       ;; Read file.
       (with-temp-buffer
-	(let ((coding-system-for-read score-mode-coding-system))
-	  (insert-file-contents file))
+	(insert-file-contents-as-coding-system
+	 score-mode-coding-system file)
 	(goto-char (point-min))
 	;; Only do the loading if the score file isn't empty.
 	(when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t))
@@ -1364,8 +1413,8 @@ EXTRA is the possible non-standard header."
 	      (delete-file file)
 	    ;; There are scores, so we write the file.
 	    (when (file-writable-p file)
-	      (let ((coding-system-for-write score-mode-coding-system))
-		(gnus-write-buffer file))
+	      (gnus-write-buffer-as-coding-system
+	       score-mode-coding-system file)
 	      (when gnus-score-after-write-file-function
 		(funcall gnus-score-after-write-file-function file)))))
 	(and gnus-score-uncacheable-files
@@ -1419,7 +1468,7 @@ EXTRA is the possible non-standard header."
 	       (headers gnus-newsgroup-headers)
 	       (current-score-file gnus-current-score-file)
 	       entry header new)
-	  (gnus-message 5 "Scoring...")
+	  (gnus-message 7 "Scoring...")
 	  ;; Create articles, an alist of the form `(HEADER . SCORE)'.
 	  (while (setq header (pop headers))
 	    ;; WARNING: The assq makes the function O(N*S) while it could
@@ -1480,15 +1529,15 @@ EXTRA is the possible non-standard header."
 		  (gnus-score-advanced (car score) trace))
 		(pop score))))
 
-	  (gnus-message 5 "Scoring...done"))))))
+	  (gnus-message 7 "Scoring...done"))))))
 
 (defun gnus-score-lower-thread (thread score-adjust)
-  "Lower the socre on THREAD with SCORE-ADJUST.
+  "Lower the score on THREAD with SCORE-ADJUST.
 THREAD is expected to contain a list of the form `(PARENT [CHILD1
 CHILD2 ...])' where PARENT is a header array and each CHILD is a list
 of the same form as THREAD.  The empty list `nil' is valid.  For each
 article in the tree, the score of the corresponding entry in
-GNUS-NEWSGROUP-SCORED is adjusted by SCORE-ADJUST."
+`gnus-newsgroup-scored' is adjusted by SCORE-ADJUST."
   (while thread
     (let ((head (car thread)))
       (if (listp head)
@@ -1506,22 +1555,20 @@ GNUS-NEWSGROUP-SCORED is adjusted by SCORE-ADJUST."
 A root is an article with no references.  An orphan is an article
 which has references, but is not connected via its references to a
 root article.  This function finds all the orphans, and adjusts their
-score in GNUS-NEWSGROUP-SCORED by SCORE."
-  (let ((threads (gnus-make-threads)))
-    ;; gnus-make-threads produces a list, where each entry is a "thread"
-    ;; as described in the gnus-score-lower-thread docs.  This function
-    ;; will be called again (after limiting has been done) if the display
-    ;; is threaded.  It would be nice to somehow save this info and use
-    ;; it later.
-    (while threads
-      (let* ((thread (car threads))
-	     (id (aref (car thread) gnus-score-index)))
-	;; If the parent of the thread is not a root, lower the score of
-	;; it and its descendants.  Note that some roots seem to satisfy
-	;; (eq id nil) and some (eq id "");  not sure why.
-	(if (and id (not (string= id "")))
-	    (gnus-score-lower-thread thread score)))
-      (setq threads (cdr threads)))))
+score in `gnus-newsgroup-scored' by SCORE."
+  ;; gnus-make-threads produces a list, where each entry is a "thread"
+  ;; as described in the gnus-score-lower-thread docs.  This function
+  ;; will be called again (after limiting has been done) if the display
+  ;; is threaded.  It would be nice to somehow save this info and use
+  ;; it later.
+  (dolist (thread (gnus-make-threads))
+    (let ((id (aref (car thread) gnus-score-index)))
+      ;; If the parent of the thread is not a root, lower the score of
+      ;; it and its descendants.  Note that some roots seem to satisfy
+      ;; (eq id nil) and some (eq id "");  not sure why.
+      (when (and id
+		 (not (string= id "")))
+	(gnus-score-lower-thread thread score)))))
 
 (defun gnus-score-integer (scores header now expire &optional trace)
   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
@@ -1629,204 +1676,211 @@ score in GNUS-NEWSGROUP-SCORED by SCORE."
   nil)
 
 (defun gnus-score-body (scores header now expire &optional trace)
-  (save-excursion
-    (setq gnus-scores-articles
-	  (sort gnus-scores-articles
-		(lambda (a1 a2)
-		  (< (mail-header-number (car a1))
-		     (mail-header-number (car a2))))))
-    (set-buffer nntp-server-buffer)
-    (save-restriction
-      (let* ((buffer-read-only nil)
-	     (articles gnus-scores-articles)
-	     (all-scores scores)
-	     (request-func (cond ((string= "head" header)
-				  'gnus-request-head)
-				 ((string= "body" header)
-				  'gnus-request-body)
-				 (t 'gnus-request-article)))
-	     entries alist ofunc article last)
-	(when articles
-	  (setq last (mail-header-number (caar (last articles))))
-	  ;; Not all backends support partial fetching.  In that case,
-	  ;; we just fetch the entire 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 article %s of %s..." article last)
-	    (widen)
-	    (when (funcall request-func article gnus-newsgroup-name)
-	      (goto-char (point-min))
-	      ;; If just parts of the article is to be searched, but the
-	      ;; backend didn't support partial fetching, we just narrow
-	      ;; to the relevant parts.
-	      (when ofunc
-		(if (eq ofunc 'gnus-request-head)
+  (if gnus-agent-fetching
+      nil
+    (save-excursion
+      (setq gnus-scores-articles
+	    (sort gnus-scores-articles
+		  (lambda (a1 a2)
+		    (< (mail-header-number (car a1))
+		       (mail-header-number (car a2))))))
+      (set-buffer nntp-server-buffer)
+      (save-restriction
+	(let* ((buffer-read-only nil)
+	       (articles gnus-scores-articles)
+	       (all-scores scores)
+	       (request-func (cond ((string= "head" header)
+				    'gnus-request-head)
+				   ((string= "body" header)
+				    'gnus-request-body)
+				   (t 'gnus-request-article)))
+	       entries alist ofunc article last)
+	  (when articles
+	    (setq last (mail-header-number (caar (last articles))))
+	    ;; Not all backends support partial fetching.  In that case,
+	    ;; we just fetch the entire 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 article %s of %s..." article last)
+	      (widen)
+	      (when (funcall request-func article gnus-newsgroup-name)
+		(goto-char (point-min))
+		;; If just parts of the article is to be searched, but the
+		;; backend didn't support partial fetching, we just narrow
+		;; to the relevant parts.
+		(when ofunc
+		  (if (eq ofunc 'gnus-request-head)
+		      (narrow-to-region
+		       (point)
+		       (or (search-forward "\n\n" nil t) (point-max)))
 		    (narrow-to-region
-		     (point)
-		     (or (search-forward "\n\n" nil t) (point-max)))
-		  (narrow-to-region
-		   (or (search-forward "\n\n" nil t) (point))
-		   (point-max))))
-	      (setq scores all-scores)
-	      ;; Find matches.
-	      (while scores
-		(setq alist (pop 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))
-			 (date (nth 2 kill))
-			 (found nil)
-			 (case-fold-search
-			  (not (or (eq type 'R) (eq type 'S)
-				   (eq type 'Regexp) (eq type 'String))))
-			 (search-func
-			  (cond ((or (eq type 'r) (eq type 'R)
-				     (eq type 'regexp) (eq type 'Regexp))
-				 're-search-forward)
-				((or (eq type 's) (eq type 'S)
-				     (eq type 'string) (eq type 'String))
-				 'search-forward)
-				(t
-				 (error "Invalid match type: %s" type)))))
-		    (goto-char (point-min))
-		    (when (funcall search-func match nil t)
-		      ;; Found a match, update scores.
-		      (setcdr (car articles) (+ score (cdar articles)))
-		      (setq found t)
-		      (when trace
-			(push
-			 (cons (car-safe (rassq alist gnus-score-cache)) kill)
-			 gnus-score-trace)))
-		    ;; 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)))))
-	    (setq articles (cdr articles)))))))
-  nil)
+		     (or (search-forward "\n\n" nil t) (point))
+		     (point-max))))
+		(setq scores all-scores)
+		;; Find matches.
+		(while scores
+		  (setq alist (pop 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))
+			   (date (nth 2 kill))
+			   (found nil)
+			   (case-fold-search
+			    (not (or (eq type 'R) (eq type 'S)
+				     (eq type 'Regexp) (eq type 'String))))
+			   (search-func
+			    (cond ((or (eq type 'r) (eq type 'R)
+				       (eq type 'regexp) (eq type 'Regexp))
+				   're-search-forward)
+				  ((or (eq type 's) (eq type 'S)
+				       (eq type 'string) (eq type 'String))
+				   'search-forward)
+				  (t
+				   (error "Invalid match type: %s" type)))))
+		      (goto-char (point-min))
+		      (when (funcall search-func match nil t)
+			;; Found a match, update scores.
+			(setcdr (car articles) (+ score (cdar articles)))
+			(setq found t)
+			(when trace
+			  (push
+			   (cons (car-safe (rassq alist gnus-score-cache)) kill)
+			   gnus-score-trace)))
+		      ;; 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)))))
+	      (setq articles (cdr articles)))))))
+    nil))
 
 (defun gnus-score-thread (scores header now expire &optional trace)
   (gnus-score-followup scores header now expire trace t))
 
 (defun gnus-score-followup (scores header now expire &optional trace thread)
-  ;; Insert the unique article headers in the buffer.
-  (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
-	(current-score-file gnus-current-score-file)
-	(all-scores scores)
-	;; gnus-score-index is used as a free variable.
-	alike last this art entries alist articles
-	new news)
-
-    ;; Change score file to the adaptive score file.  All entries that
-    ;; this function makes will be put into this 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))))
-
-    (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
-	  articles gnus-scores-articles)
+  (if gnus-agent-fetching
+      ;; FIXME: It seems doable in fetching mode.
+      nil
+    ;; Insert the unique article headers in the buffer.
+    (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
+	  (current-score-file gnus-current-score-file)
+	  (all-scores scores)
+	  ;; gnus-score-index is used as a free variable.
+	  alike last this art entries alist articles
+	  new news)
+
+      ;; Change score file to the adaptive score file.  All entries that
+      ;; this function makes will be put into this 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))))
 
-    (erase-buffer)
-    (while articles
-      (setq art (car articles)
-	    this (aref (car art) gnus-score-index)
-	    articles (cdr articles))
-      (if (equal last this)
-	  (push art alike)
-	(when last
-	  (insert last ?\n)
-	  (put-text-property (1- (point)) (point) 'articles alike))
-	(setq alike (list art)
-	      last this)))
-    (when last				; Bwadr, duplicate code.
-      (insert last ?\n)
-      (put-text-property (1- (point)) (point) 'articles alike))
+      (setq gnus-scores-articles (sort gnus-scores-articles
+				       'gnus-score-string<)
+	    articles gnus-scores-articles)
 
-    ;; Find matches.
-    (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))
-	       (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))))
-	       (dmt (downcase mt))
-	       (search-func
-		(cond ((= dmt ?r) 're-search-forward)
-		      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
-		      (t (error "Invalid match type: %s" type))))
-	       arts art)
-	  (goto-char (point-min))
-	  (if (= dmt ?e)
+      (erase-buffer)
+      (while articles
+	(setq art (car articles)
+	      this (aref (car art) gnus-score-index)
+	      articles (cdr articles))
+	(if (equal last this)
+	    (push art alike)
+	  (when last
+	    (insert last ?\n)
+	    (put-text-property (1- (point)) (point) 'articles alike))
+	  (setq alike (list art)
+		last this)))
+      (when last			; Bwadr, duplicate code.
+	(insert last ?\n)
+	(put-text-property (1- (point)) (point) 'articles alike))
+
+      ;; Find matches.
+      (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))
+		 (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))))
+		 (dmt (downcase mt))
+		 (search-func
+		  (cond ((= dmt ?r) 're-search-forward)
+			((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
+			(t (error "Invalid match type: %s" type))))
+		 arts art)
+	    (goto-char (point-min))
+	    (if (= dmt ?e)
+		(while (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.
+			 (while arts
+			   (setq art (car arts)
+				 arts (cdr arts))
+			   (gnus-score-add-followups
+			    (car art) score all-scores thread))))
+		  (end-of-line))
 	      (while (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.
-		       (while arts
-			 (setq art (car arts)
-			       arts (cdr arts))
-			 (gnus-score-add-followups
-			  (car art) score all-scores thread))))
-		(end-of-line))
-	    (while (funcall search-func match nil t)
-	      (end-of-line)
-	      (setq found (setq arts (get-text-property (point) 'articles)))
-	      ;; Found a match, update scores.
-	      (while (setq art (pop arts))
-		(when (setq new (gnus-score-add-followups
-				 (car art) score all-scores thread))
-		  (push new news)))))
-	  ;; Update expire date
-	  (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))))
-    ;; We change the score file back to the previous one.
-    (save-excursion
-      (set-buffer gnus-summary-buffer)
-      (gnus-score-load-file current-score-file))
-    (list (cons "references" news))))
+		(end-of-line)
+		(setq found (setq arts (get-text-property (point) 'articles)))
+		;; Found a match, update scores.
+		(while (setq art (pop arts))
+		  (when (setq new (gnus-score-add-followups
+				   (car art) score all-scores thread))
+		    (push new news)))))
+	    ;; Update expire date
+	    (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))))
+      ;; We change the score file back to the previous one.
+      (save-excursion
+	(set-buffer gnus-summary-buffer)
+	(gnus-score-load-file current-score-file))
+      (list (cons "references" news)))))
 
 (defun gnus-score-add-followups (header score scores &optional thread)
   "Add a score entry to the adapt file."
@@ -1855,8 +1909,8 @@ score in GNUS-NEWSGROUP-SCORED by SCORE."
   ;; 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.
-        (simplify (and gnus-score-thread-simplify
-                       (string= "subject" header)))
+	(simplify (and gnus-score-thread-simplify
+		       (string= "subject" header)))
 	alike last this art entries alist articles
 	fuzzies arts words kill)
 
@@ -1920,10 +1974,10 @@ score in GNUS-NEWSGROUP-SCORED by SCORE."
 	       (dmt (downcase mt))
 	       ;; Assume user already simplified regexp and fuzzies
 	       (match (if (and simplify (not (memq dmt '(?f ?r))))
-                          (gnus-map-function
-                           gnus-simplify-subject-functions
-                           (nth 0 kill))
-                        (nth 0 kill)))
+			  (gnus-map-function
+			   gnus-simplify-subject-functions
+			   (nth 0 kill))
+			(nth 0 kill)))
 	       (search-func
 		(cond ((= dmt ?r) 're-search-forward)
 		      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
@@ -1933,7 +1987,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE."
 	  ;; Evil hackery to make match usable in non-standard headers.
 	  (when extra
 	    (setq match (concat "[ (](" extra " \\. \"[^)]*"
-				match "[^(]*\")[ )]")
+				match "[^\"]*\")[ )]")
 		  search-func 're-search-forward)) ; XXX danger?!?
 
 	  (cond
@@ -2259,11 +2313,14 @@ score in GNUS-NEWSGROUP-SCORED by SCORE."
 		      ;; Put the word and score into the hashtb.
 		      (setq val (gnus-gethash (setq word (match-string 0))
 					      hashtb))
-		      (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))
+		      (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))
 	  ;; Make all the ignorable words ignored.
@@ -2444,7 +2501,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE."
 (defun gnus-summary-lower-thread (&optional score)
   "Lower score of articles in the current thread with SCORE."
   (interactive "P")
-  (gnus-summary-raise-thread (- (1- (gnus-score-delta-default score)))))
+  (gnus-summary-raise-thread (- (gnus-score-delta-default score))))
 
 ;;; Finding score files.
 
@@ -2506,7 +2563,8 @@ score in GNUS-NEWSGROUP-SCORED by SCORE."
 	(push file out))))
     (or out
 	;; Return a dummy value.
-	(list "~/News/this.file.does.not.exist.SCORE"))))
+	(list (expand-file-name "this.file.does.not.exist.SCORE"
+				gnus-kill-files-directory)))))
 
 (defun gnus-score-file-regexp ()
   "Return a regexp that match all score files."
@@ -2544,12 +2602,14 @@ GROUP using BNews sys file syntax."
 	      ;; too much.
 	      (delete-char (min (1- (point-max)) klen))
 	    (goto-char (point-max))
-	    (search-backward "/")
-	    (delete-region (1+ (point)) (point-min)))
+	    (if (re-search-backward gnus-directory-sep-char-regexp nil t)
+		(delete-region (1+ (point)) (point-min))
+	      (gnus-message 1 "Can't find directory separator in %s"
+			    (car sfiles))))
 	  ;; If short file names were used, we have to translate slashes.
 	  (goto-char (point-min))
 	  (let ((regexp (concat
-			 "[/:" (if trans (char-to-string trans) "") "]")))
+			 "[/:" (if trans (char-to-string trans)) "]")))
 	    (while (re-search-forward regexp nil t)
 	      (replace-match "." t t)))
 	  ;; Kludge to get rid of "nntp+" problems.
@@ -2579,10 +2639,10 @@ GROUP using BNews sys file syntax."
 	  ;; we add this score file to the list of score files
 	  ;; applicable to this group.
 	  (when (or (and not-match
- 			 (ignore-errors
+			 (ignore-errors
 			   (not (string-match regexp group-trans))))
-  		    (and (not not-match)
- 			 (ignore-errors (string-match regexp group-trans))))
+		    (and (not not-match)
+			 (ignore-errors (string-match regexp group-trans))))
 	    (push (car sfiles) ofiles)))
 	(setq sfiles (cdr sfiles)))
       (kill-buffer (current-buffer))
@@ -2662,7 +2722,7 @@ Destroys the current buffer."
 
 (defun gnus-score-find-alist (group)
   "Return list of score files for GROUP.
-The list is determined from the variable gnus-score-file-alist."
+The list is determined from the variable `gnus-score-file-alist'."
   (let ((alist gnus-score-file-multiple-match-alist)
 	score-files)
     ;; if this group has been seen before, return the cached entry
@@ -2700,34 +2760,37 @@ The list is determined from the variable gnus-score-file-alist."
       (and funcs
 	   (not (listp funcs))
 	   (setq funcs (list funcs)))
-      ;; Get the initial score files for this group.
-      (when funcs
-	(setq score-files (nreverse (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)))
+      (when gnus-score-use-all-scores
+	;; Get the initial score files for this group.
+	(when funcs
+	  (setq score-files (nreverse (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 (nreverse (funcall (car funcs) group)))))
+		(append score-files
+			(nreverse (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-find-parameter group 'score-file)))
-	(when param-file
-	  (push param-file score-files)))
+      (when gnus-score-use-all-scores
+	;; 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-find-parameter group 'score-file)))
+	  (when param-file
+	    (push param-file score-files))))
       ;; Expand all files names.
       (let ((files score-files))
 	(while files
@@ -2782,7 +2845,7 @@ The list is determined from the variable gnus-score-file-alist."
   (let (out)
     (while files
       ;; #### /$ Unix-specific?
-      (if (string-match "/$" (car files))
+      (if (file-directory-p (car files))
 	  (setq out (nconc (directory-files
 			    (car files) t
 			    (concat (gnus-score-file-regexp) "$"))))
@@ -2824,9 +2887,10 @@ If ADAPT, return the home adaptive file instead."
 	      (when (string-match (gnus-globalify-regexp (car elem)) group)
 		(replace-match (cadr elem) t nil group))))))
     (when found
+      (setq found (nnheader-translate-file-chars found))
       (if (file-name-absolute-p found)
-          found
-        (nnheader-concat gnus-kill-files-directory found)))))
+	  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."