--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/gnus/gnus-score.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,2255 @@
+;;; gnus-score.el --- scoring code for Gnus
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
+;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(eval-when-compile (require 'cl))
+
+(defvar gnus-global-score-files nil
+  "*List of global score files and directories.
+Set this variable if you want to use people's score files.  One entry
+for each score file or each score file directory.  Gnus will decide
+by itself what score files are applicable to which group.
+
+Say you want to use the single score file
+\"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
+score files in the \"/ftp.some-where:/pub/score\" directory.
+
+ (setq gnus-global-score-files
+       '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
+         \"/ftp.some-where:/pub/score\"))")
+
+(defvar gnus-score-file-single-match-alist nil
+  "*Alist mapping regexps to lists of score files.
+Each element of this alist should be of the form
+	(\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
+
+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).
+
+These score files are loaded in addition to any files returned by
+gnus-score-find-score-files-function (which see).")
+
+(defvar gnus-score-file-multiple-match-alist nil
+  "*Alist mapping regexps to lists of score files.
+Each element of this alist should be of the form
+	(\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
+
+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).
+
+These score files are loaded in addition to any files returned by
+gnus-score-find-score-files-function (which see).")
+
+(defvar gnus-score-file-suffix "SCORE"
+  "*Suffix of the score files.")
+
+(defvar gnus-adaptive-file-suffix "ADAPT"
+  "*Suffix of the adaptive score files.")
+
+(defvar gnus-score-find-score-files-function 'gnus-score-find-bnews
+  "*Function used to find score files.
+The function will be called with the group name as the argument, and
+should return a list of score files to apply to that group.  The score
+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.
+
+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.")
+
+(defvar gnus-score-interactive-default-score 1000
+  "*Scoring commands will raise/lower the score with this number as the default.")
+
+(defvar gnus-score-expiry-days 7
+  "*Number of days before unused score file entries are expired.
+If this variable is nil, no score file entries will be expired.")
+
+(defvar gnus-update-score-entry-dates t
+  "*In non-nil, update matching score entry dates.
+If this variable is nil, then score entries that provide matches
+will be expired along with non-matching score entries.")
+
+(defvar gnus-orphan-score nil
+  "*All orphans get this score added. Set in the score file.")
+
+(defvar gnus-default-adaptive-score-alist  
+  '((gnus-kill-file-mark)
+    (gnus-unread-mark)
+    (gnus-read-mark (from  3) (subject  30))
+    (gnus-catchup-mark (subject -10))
+    (gnus-killed-mark (from -1) (subject -20))
+    (gnus-del-mark (from -2) (subject -15)))
+"*Alist of marks and scores.")
+
+(defvar gnus-score-mimic-keymap nil
+  "*Have the score entry functions pretend that they are a keymap.")
+
+(defvar gnus-score-exact-adapt-limit 10
+  "*Number that says how long a match has to be before using substring matching.
+When doing adaptive scoring, one normally uses fuzzy or substring
+matching.  However, if the header one matches is short, the possibility
+for false positives is great, so if the length of the match is less
+than this variable, exact matching will be used.
+
+If this variable is nil, exact matching will always be used.")
+
+(defvar gnus-score-uncacheable-files "ADAPT$"
+  "*All score files that match this regexp will not be cached.")
+
+(defvar gnus-score-default-header nil
+  "Default header when entering new scores.
+
+Should be one of the following symbols.
+
+ a: from
+ s: subject
+ b: body
+ h: head
+ i: message-id
+ t: references
+ x: xref
+ l: lines
+ d: date
+ f: followup
+
+If nil, the user will be asked for a header.")
+
+(defvar gnus-score-default-type nil
+  "Default match type when entering new scores.
+
+Should be one of the following symbols.
+
+ s: substring
+ e: exact string
+ f: fuzzy string
+ r: regexp string
+ b: before date
+ a: at date
+ n: this date
+ <: less than number
+ >: greater than number
+ =: equal to number
+
+If nil, the user will be asked for a match type.")
+
+(defvar gnus-score-default-fold nil
+  "Use case folding for new score file entries iff not nil.")
+
+(defvar gnus-score-default-duration nil
+  "Default duration of effect when entering new scores.
+
+Should be one of the following symbols.
+
+ t: temporary
+ p: permanent
+ i: immediate
+
+If nil, the user will be asked for a duration.")
+
+(defvar gnus-score-after-write-file-function nil
+  "*Function called with the name of the score file just written to disk.")
+
+
+
+;; Internal variables.
+
+(defvar gnus-internal-global-score-files nil)
+(defvar gnus-score-file-list nil)
+
+(defvar gnus-short-name-score-file-cache nil)
+
+(defvar gnus-score-help-winconf nil)
+(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
+(defvar gnus-score-trace nil)
+(defvar gnus-score-edit-buffer nil)
+
+(defvar gnus-score-alist nil
+  "Alist containing score information.
+The keys can be symbols or strings.  The following symbols are defined. 
+
+touched: If this alist has been modified.
+mark:    Automatically mark articles below this.
+expunge: Automatically expunge articles below this.
+files:   List of other score files to load when loading this one.
+eval:    Sexp to be evaluated when the score file is loaded.
+
+String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) 
+where HEADER is the header being scored, MATCH is the string we are
+looking for, TYPE is a flag indicating whether it should use regexp or
+substring matching, SCORE is the score to add and DATE is the date
+of the last successful match.")
+
+(defvar gnus-score-cache nil)
+(defvar gnus-scores-articles nil)
+(defvar gnus-score-index nil)
+
+
+(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)
+    ("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)))
+
+(eval-and-compile
+  (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap))
+
+;;; 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)
+
+;; Summary score file commands
+
+;; Much modification of the kill (ahem, score) code and lots of the
+;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
+
+(defun gnus-summary-lower-score (&optional score)
+  "Make a score entry based on the current article.
+The user will be prompted for header to score on, match type,
+permanence, and the string to be used.  The numerical prefix will be
+used as score."
+  (interactive "P")
+  (gnus-summary-increase-score (- (gnus-score-default score))))
+
+(defvar gnus-score-default-header nil
+  "*The default header to score on when entering a score rule interactively.")
+
+(defvar gnus-score-default-type nil
+  "*The default score type to use when entering a score rule interactively.")
+
+(defvar gnus-score-default-duration nil
+  "*The default score duration to use on when entering a score rule interactively.")
+
+(defun gnus-score-kill-help-buffer ()
+  (when (get-buffer "*Score Help*")
+    (kill-buffer "*Score Help*")
+    (and gnus-score-help-winconf
+	 (set-window-configuration gnus-score-help-winconf))))
+
+(defun gnus-summary-increase-score (&optional score)
+  "Make a score entry based on the current article.
+The user will be prompted for header to score on, match type,
+permanence, and the string to be used.  The numerical prefix will be
+used as score."
+  (interactive "P")
+  (gnus-set-global-variables)
+  (let* ((nscore (gnus-score-default score))
+	 (prefix (if (< nscore 0) ?L ?I))
+	 (increase (> nscore 0))
+	 (char-to-header 
+	  '((?a "from" nil nil string)
+	    (?s "subject" nil nil string)
+	    (?b "body" "" nil body-string)
+	    (?h "head" "" nil body-string)
+	    (?i "message-id" nil t string)
+	    (?t "references" "message-id" nil string)
+	    (?x "xref" nil nil string)
+	    (?l "lines" nil nil number)
+	    (?d "date" nil nil date)
+	    (?f "followup" nil nil string)
+	    (?T "thread" nil nil string)))
+	 (char-to-type
+	  '((?s s "substring" string)
+	    (?e e "exact string" string)
+	    (?f f "fuzzy string" string)
+	    (?r r "regexp string" string)
+	    (?z s "substring" body-string)
+	    (?p s "regexp string" body-string)
+	    (?b before "before date" date)
+	    (?a at "at date" date) 
+	    (?n now "this date" date)
+	    (?< < "less than number" number)
+	    (?> > "greater than number" number) 
+	    (?= = "equal to number" number)))
+	 (char-to-perm
+	  (list (list ?t (current-time-string) "temporary") 
+		'(?p perm "permanent") '(?i now "immediate")))
+	 (mimic gnus-score-mimic-keymap)
+	 (hchar (and gnus-score-default-header 
+		     (aref (symbol-name gnus-score-default-header) 0)))
+	 (tchar (and gnus-score-default-type
+		     (aref (symbol-name gnus-score-default-type) 0)))
+	 (pchar (and gnus-score-default-duration
+		     (aref (symbol-name gnus-score-default-duration) 0)))
+	 entry temporary type match)
+    
+    (unwind-protect
+	(progn
+
+	  ;; First we read the header to score.
+	  (while (not hchar)
+	    (if mimic
+		(progn 
+		  (sit-for 1)
+		  (message "%c-" prefix))
+	      (message "%s header (%s?): " (if increase "Increase" "Lower")
+		       (mapconcat (lambda (s) (char-to-string (car s)))
+				  char-to-header "")))
+	    (setq hchar (read-char))
+	    (when (or (= hchar ??) (= hchar ?\C-h))
+	      (setq hchar nil)
+	      (gnus-score-insert-help "Match on header" char-to-header 1)))
+
+	  (gnus-score-kill-help-buffer)
+	  (unless (setq entry (assq (downcase hchar) char-to-header))
+	    (if mimic (error "%c %c" prefix hchar) (error "")))
+
+	  (when (/= (downcase hchar) hchar)
+	    ;; This was a majuscle, so we end reading and set the defaults.
+	    (if mimic (message "%c %c" prefix hchar) (message ""))
+	    (setq tchar (or tchar ?s)
+		  pchar (or pchar ?t)))
+    
+	  ;; We continue reading - the type.
+	  (while (not tchar)
+	    (if mimic
+		(progn
+		  (sit-for 1) (message "%c %c-" prefix hchar))
+	      (message "%s header '%s' with match type (%s?): "
+		       (if increase "Increase" "Lower")
+		       (nth 1 entry)
+		       (mapconcat (lambda (s) 
+				    (if (eq (nth 4 entry) 
+					    (nth 3 s))
+					(char-to-string (car s))
+				      ""))
+				  char-to-type "")))
+	    (setq tchar (read-char))
+	    (when (or (= tchar ??) (= tchar ?\C-h))
+	      (setq tchar nil)
+	      (gnus-score-insert-help
+	       "Match type"
+	       (delq nil
+		     (mapcar (lambda (s) 
+			       (if (eq (nth 4 entry) 
+				       (nth 3 s))
+				   s nil))
+			     char-to-type ))
+	       2)))
+
+	  (gnus-score-kill-help-buffer)
+	  (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
+	    (if mimic (error "%c %c" prefix hchar) (error "")))
+
+	  (when (/= (downcase tchar) tchar)
+	    ;; It was a majuscle, so we end reading and the the default.
+	    (if mimic (message "%c %c %c" prefix hchar tchar)
+	      (message ""))
+	    (setq pchar (or pchar ?p)))
+
+	  ;; We continue reading.
+	  (while (not pchar)
+	    (if mimic
+		(progn
+		  (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
+	      (message "%s permanence (%s?): " (if increase "Increase" "Lower")
+		       (mapconcat (lambda (s) (char-to-string (car s)))
+				  char-to-perm "")))
+	    (setq pchar (read-char))
+	    (when (or (= pchar ??) (= pchar ?\C-h))
+	      (setq pchar nil)
+	      (gnus-score-insert-help "Match permanence" char-to-perm 2)))
+
+	  (gnus-score-kill-help-buffer)
+	  (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+	    (message ""))
+	  (unless (setq temporary (cadr (assq pchar char-to-perm)))
+	    (if mimic 
+		(error "%c %c %c %c" prefix hchar tchar pchar)
+	      (error ""))))
+      ;; Always kill the score help buffer.
+      (gnus-score-kill-help-buffer))
+
+    ;; We have all the data, so we enter this score.
+    (setq match (if (string= (nth 2 entry) "") ""
+		  (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
+      
+    ;; Modify the match, perhaps.
+    (cond 
+     ((equal (nth 1 entry) "xref")
+      (when (string-match "^Xref: *" match)
+	(setq match (substring match (match-end 0))))
+      (when (string-match "^[^:]* +" match)
+	(setq match (substring match (match-end 0))))))
+    
+    (when (memq type '(r R regexp Regexp))
+      (setq match (regexp-quote match)))
+
+    (gnus-summary-score-entry
+     (nth 1 entry)			; Header
+     match				; Match
+     type				; Type
+     (if (eq 's score) nil score)	; Score
+     (if (eq 'perm temporary)		; Temp
+	 nil
+        temporary)
+     (not (nth 3 entry)))		; Prompt
+    ))
+  
+(defun gnus-score-insert-help (string alist idx)
+  (setq gnus-score-help-winconf (current-window-configuration))
+  (save-excursion
+    (set-buffer (get-buffer-create "*Score Help*"))
+    (buffer-disable-undo (current-buffer))
+    (delete-windows-on (current-buffer))
+    (erase-buffer)
+    (insert string ":\n\n")
+    (let ((max -1)
+	  (list alist)
+	  (i 0)
+	  n width pad format)
+      ;; find the longest string to display
+      (while list
+	(setq n (length (nth idx (car list))))
+	(or (> max n)
+	    (setq max n))
+	(setq list (cdr list)))
+      (setq max (+ max 4))		; %c, `:', SPACE, a SPACE at end
+      (setq n (/ (1- (window-width)) max))	; items per line
+      (setq width (/ (1- (window-width)) n)) ; width of each item
+      ;; insert `n' items, each in a field of width `width' 
+      (while alist
+	(if (< i n)
+	    ()
+	  (setq i 0)
+	  (delete-char -1)		; the `\n' takes a char
+	  (insert "\n"))
+	(setq pad (- width 3))
+	(setq format (concat "%c: %-" (int-to-string pad) "s"))
+	(insert (format format (caar alist) (nth idx (car alist))))
+	(setq alist (cdr alist))
+	(setq i (1+ i))))
+    ;; display ourselves in a small window at the bottom
+    (gnus-appt-select-lowest-window)
+    (split-window)
+    (pop-to-buffer "*Score Help*")
+    (let ((window-min-height 1))
+      (shrink-window-if-larger-than-buffer))
+    (select-window (get-buffer-window gnus-summary-buffer))))
+  
+(defun gnus-summary-header (header &optional no-err)
+  ;; Return HEADER for current articles, or error.
+  (let ((article (gnus-summary-article-number))
+	headers)
+    (if article
+	(if (and (setq headers (gnus-summary-article-header article))
+		 (vectorp headers))
+	    (aref headers (nth 1 (assoc header gnus-header-index)))
+	  (if no-err
+	      nil
+	    (error "Pseudo-articles can't be scored")))
+      (if no-err
+	  (error "No article on current line")
+	nil))))
+
+(defun gnus-newsgroup-score-alist ()
+  (or
+   (let ((param-file (gnus-group-get-parameter 
+		      gnus-newsgroup-name 'score-file)))
+     (when param-file
+       (gnus-score-load param-file)))
+   (gnus-score-load
+    (gnus-score-file-name gnus-newsgroup-name)))
+  gnus-score-alist)
+
+(defsubst gnus-score-get (symbol &optional alist)
+  ;; Get SYMBOL's definition in ALIST.
+  (cdr (assoc symbol 
+	      (or alist 
+		  gnus-score-alist
+		  (gnus-newsgroup-score-alist)))))
+
+(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.
+TYPE is the match type: substring, regexp, exact, fuzzy.
+SCORE is the score to add.
+DATE is the expire date, or nil for no expire, or 'now for immediate expire.
+If optional argument `PROMPT' is non-nil, allow user to edit match.
+If optional argument `SILENT' is nil, show effect of score entry."
+  (interactive
+   (list (completing-read "Header: "
+			  gnus-header-index
+			  (lambda (x) (fboundp (nth 2 x)))
+			  t)
+	 (read-string "Match: ")
+	 (if (y-or-n-p "Use regexp match? ") 'r 's)
+	 (and current-prefix-arg
+	      (prefix-numeric-value current-prefix-arg))
+	 (cond ((not (y-or-n-p "Add to score file? "))
+		'now)
+	       ((y-or-n-p "Expire kill? ")
+		(current-time-string))
+	       (t nil))))
+  ;; Regexp is the default type.
+  (if (eq type t) (setq type 'r))
+  ;; Simplify matches...
+  (cond ((or (eq type 'r) (eq type 's) (eq type nil))
+	 (setq match (if match (gnus-simplify-subject-re match) "")))
+	((eq type 'f)
+	 (setq match (gnus-simplify-subject-fuzzy match))))
+  (let ((score (gnus-score-default score))
+	(header (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))))
+
+    ;; If this is an integer comparison, we transform from string to int. 
+    (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
+	 (setq match (string-to-int match)))
+
+    (unless (eq date 'now)
+      ;; Add the score entry to the score file.
+      (when (= score gnus-score-interactive-default-score)
+	   (setq score nil))
+      (let ((old (gnus-score-get header))
+	    elem)
+	(setq new
+	      (cond 
+	       (type (list match score (and date (gnus-day-number date)) type))
+	       (date (list match score (gnus-day-number date)))
+	       (score (list match score))
+	       (t (list match))))
+	;; We see whether we can collapse some score entries.
+	;; This isn't quite correct, because there may be more elements
+	;; later on with the same key that have matching elems... Hm.
+	(if (and old
+		 (setq elem (assoc match old))
+		 (eq (nth 3 elem) (nth 3 new))
+		 (or (and (numberp (nth 2 elem)) (numberp (nth 2 new)))
+		     (and (not (nth 2 elem)) (not (nth 2 new)))))
+	    ;; Yup, we just add this new score to the old elem.
+	    (setcar (cdr elem) (+ (or (nth 1 elem) 
+				      gnus-score-interactive-default-score)
+				  (or (nth 1 new)
+				      gnus-score-interactive-default-score)))
+	  ;; Nope, we have to add a new elem.
+	  (gnus-score-set header (if old (cons new old) (list new))))
+	(gnus-score-set 'touched '(t))))
+
+    ;; Score the current buffer.
+    (unless silent
+      (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
+	       (eq (nth 2 (assoc header gnus-header-index))
+		   'gnus-score-string))
+	  (gnus-summary-score-effect header match type score)
+	(gnus-summary-rescore)))
+
+    ;; Return the new scoring rule.
+    new))
+
+(defun gnus-summary-score-effect (header match type score)
+  "Simulate the effect of a score file entry.
+HEADER is the header being scored.
+MATCH is the string we are looking for.
+TYPE is a flag indicating if it is a regexp or substring.
+SCORE is the score to add."
+  (interactive (list (completing-read "Header: "
+				      gnus-header-index
+				      (lambda (x) (fboundp (nth 2 x)))
+				      t)
+		     (read-string "Match: ")
+		     (y-or-n-p "Use regexp match? ")
+		     (prefix-numeric-value current-prefix-arg)))
+  (save-excursion
+    (or (and (stringp match) (> (length match) 0))
+	(error "No match"))
+    (goto-char (point-min))
+    (let ((regexp (cond ((eq type 'f)
+			 (gnus-simplify-subject-fuzzy match))
+			((eq type 'r) 
+			 match)
+			((eq type 'e)
+			 (concat "\\`" (regexp-quote match) "\\'"))
+			(t 
+			 (regexp-quote match)))))
+      (while (not (eobp))
+	(let ((content (gnus-summary-header header 'noerr))
+	      (case-fold-search t))
+	  (and content
+	       (if (if (eq type 'f)
+		       (string-equal (gnus-simplify-subject-fuzzy content)
+				     regexp)
+		     (string-match regexp content))
+		   (gnus-summary-raise-score score))))
+	(beginning-of-line 2)))))
+
+(defun gnus-summary-score-crossposting (score date)
+  ;; Enter score file entry for current crossposting.
+  ;; SCORE is the score to add.
+  ;; DATE is the expire date.
+  (let ((xref (gnus-summary-header "xref"))
+	(start 0)
+	group)
+    (or xref (error "This article is not crossposted"))
+    (while (string-match " \\([^ \t]+\\):" xref start)
+      (setq start (match-end 0))
+      (if (not (string= 
+		(setq group 
+		      (substring xref (match-beginning 1) (match-end 1)))
+		gnus-newsgroup-name))
+	  (gnus-summary-score-entry
+	   "xref" (concat " " group ":") nil score date t)))))
+
+
+;;;
+;;; Gnus Score Files
+;;;
+
+;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
+
+;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defun gnus-score-set-mark-below (score)
+  "Automatically mark articles with score below SCORE as read."
+  (interactive 
+   (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
+	     (string-to-int (read-string "Mark below: ")))))
+  (setq score (or score gnus-summary-default-score 0))
+  (gnus-score-set 'mark (list score))
+  (gnus-score-set 'touched '(t))
+  (setq gnus-summary-mark-below score)
+  (gnus-score-update-lines))
+
+(defun gnus-score-update-lines ()
+  "Update all lines in the summary buffer."
+  (save-excursion
+    (goto-char (point-min))
+    (while (not (eobp))
+      (gnus-summary-update-line)
+      (forward-line 1))))
+
+(defun gnus-score-update-all-lines ()
+  "Update all lines in the summary buffer, even the hidden ones."
+  (save-excursion
+    (goto-char (point-min))
+    (let (hidden)
+      (while (not (eobp))
+	(when (gnus-summary-show-thread)
+	  (push (point) hidden))
+	(gnus-summary-update-line)
+	(forward-line 1))
+      ;; Re-hide the hidden threads.
+      (while hidden
+	(goto-char (pop hidden))
+	(gnus-summary-hide-thread)))))
+
+(defun gnus-score-set-expunge-below (score)
+  "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: ")))))
+  (setq score (or score gnus-summary-default-score 0))
+  (gnus-score-set 'expunge (list score))
+  (gnus-score-set 'touched '(t)))
+
+(defun gnus-score-followup-article (&optional score)
+  "Add SCORE to all followups to the article in the current buffer."
+  (interactive "P")
+  (setq score (gnus-score-default score))
+  (when (gnus-buffer-live-p gnus-summary-buffer)
+    (save-excursion
+      (set-buffer gnus-summary-buffer)
+      (save-restriction
+	(goto-char (point-min))
+	(let ((id (mail-fetch-field "message-id")))
+	  (when id
+	    (gnus-summary-score-entry
+	     "references" (concat id "[ \t]*$") 'r
+	     score (current-time-string) nil t)))))))
+
+(defun gnus-score-followup-thread (&optional score)
+  "Add SCORE to all later articles in the thread the current buffer is part of."
+  (interactive "P")
+  (setq score (gnus-score-default score))
+  (when (gnus-buffer-live-p gnus-summary-buffer)
+    (save-excursion
+      (set-buffer gnus-summary-buffer)
+      (save-restriction
+	(goto-char (point-min))
+	(let ((id (mail-fetch-field "message-id")))
+	  (when id
+	    (gnus-summary-score-entry
+	     "references" id 's
+	     score (current-time-string))))))))
+
+(defun gnus-score-set (symbol value &optional alist)
+  ;; Set SYMBOL to VALUE in ALIST.
+  (let* ((alist 
+	  (or alist 
+	      gnus-score-alist
+	      (gnus-newsgroup-score-alist)))
+	 (entry (assoc symbol alist)))
+    (cond ((gnus-score-get 'read-only alist)
+	   ;; This is a read-only score file, so we do nothing.
+	   )
+	  (entry
+	   (setcdr entry value))
+	  ((null alist)
+	   (error "Empty alist"))
+	  (t
+	   (setcdr alist
+		   (cons (cons symbol value) (cdr alist)))))))
+
+(defun gnus-summary-raise-score (n)
+  "Raise the score of the current article by N."
+  (interactive "p")
+  (gnus-set-global-variables)
+  (gnus-summary-set-score (+ (gnus-summary-article-score) 
+			     (or n gnus-score-interactive-default-score ))))
+
+(defun gnus-summary-set-score (n)
+  "Set the score of the current article to N."
+  (interactive "p")
+  (gnus-set-global-variables)
+  (save-excursion
+    (gnus-summary-show-thread)
+    (let ((buffer-read-only nil))
+      ;; Set score.
+      (gnus-summary-update-mark
+       (if (= n (or gnus-summary-default-score 0)) ? 
+	 (if (< n (or gnus-summary-default-score 0))
+	     gnus-score-below-mark gnus-score-over-mark)) 'score))
+    (let* ((article (gnus-summary-article-number))
+	   (score (assq article gnus-newsgroup-scored)))
+      (if score (setcdr score n)
+	(setq gnus-newsgroup-scored
+	      (cons (cons article n) gnus-newsgroup-scored))))
+    (gnus-summary-update-line)))
+
+(defun gnus-summary-current-score ()
+  "Return the score of the current article."
+  (interactive)
+  (gnus-set-global-variables)
+  (gnus-message 1 "%s" (gnus-summary-article-score)))
+
+(defun gnus-score-change-score-file (file)
+  "Change current score alist."
+  (interactive 
+   (list (read-file-name "Change to score file: " gnus-kill-files-directory)))
+  (gnus-score-load-file file)
+  (gnus-set-mode-line 'summary))
+
+(defvar gnus-score-edit-exit-function)
+(defun gnus-score-edit-current-scores (file)
+  "Edit the current score alist."
+  (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))
+    (setq gnus-score-edit-buffer (find-file-noselect file))
+    (gnus-configure-windows 'edit-score)
+    (gnus-score-mode)
+    (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
+    (make-local-variable 'gnus-prev-winconf)
+    (setq gnus-prev-winconf winconf))
+  (gnus-message 
+   4 (substitute-command-keys 
+      "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+  
+(defun gnus-score-edit-file (file)
+  "Edit a score file."
+  (interactive 
+   (list (read-file-name "Edit score file: " gnus-kill-files-directory)))
+  (gnus-make-directory (file-name-directory file))
+  (and (buffer-name gnus-summary-buffer) (gnus-score-save))
+  (let ((winconf (current-window-configuration)))
+    (setq gnus-score-edit-buffer (find-file-noselect file))
+    (gnus-configure-windows 'edit-score)
+    (gnus-score-mode)
+    (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
+    (make-local-variable 'gnus-prev-winconf)
+    (setq gnus-prev-winconf winconf))
+  (gnus-message 
+   4 (substitute-command-keys 
+      "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+  
+(defun gnus-score-load-file (file)
+  ;; Load score file FILE.  Returns a list a retrieved score-alists.
+  (let* ((file (expand-file-name 
+		(or (and (string-match
+			  (concat "^" (expand-file-name
+				       gnus-kill-files-directory)) 
+			  (expand-file-name file))
+			 file)
+		    (concat (file-name-as-directory gnus-kill-files-directory)
+			    file))))
+	 (cached (assoc file gnus-score-cache))
+	 (global (member file gnus-internal-global-score-files))
+	 lists alist)
+    (if cached
+	;; The score file was already loaded.
+	(setq alist (cdr cached))
+      ;; We load the score file.
+      (setq gnus-score-alist nil)
+      (setq alist (gnus-score-load-score-alist file))
+      ;; We add '(touched) to the alist to signify that it hasn't been
+      ;; touched (yet). 
+      (or (assq 'touched alist) (setq alist (cons (list 'touched nil) alist)))
+      ;; If it is a global score file, we make it read-only.
+      (and global
+	   (not (assq 'read-only alist))
+	   (setq alist (cons (list 'read-only t) alist)))
+      (setq gnus-score-cache
+	    (cons (cons file alist) gnus-score-cache)))
+    (let ((a alist)
+	  found)
+      (while a
+	;; Downcase all header names.
+	(when (stringp (caar a))
+	  (setcar (car a) (downcase (caar a)))
+	  (setq found t))
+	(pop a))
+      ;; If there are actual scores in the alist, we add it to the
+      ;; return value of this function.
+      (when found
+	(setq lists (list alist))))
+    ;; Treat the other possible atoms in the score alist.
+    (let ((mark (car (gnus-score-get 'mark alist)))
+	  (expunge (car (gnus-score-get 'expunge alist)))
+	  (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)))
+	  (adapt (gnus-score-get 'adapt alist))
+	  (thread-mark-and-expunge
+	   (car (gnus-score-get 'thread-mark-and-expunge alist)))
+	  (adapt-file (car (gnus-score-get 'adapt-file alist)))
+	  (local (gnus-score-get 'local alist))
+	  (eval (car (gnus-score-get 'eval alist))))
+      ;; We do not respect eval and files atoms from global score
+      ;; files. 
+      (and files (not global)
+	   (setq lists (apply 'append lists
+			      (mapcar (lambda (file)
+					(gnus-score-load-file file)) 
+				      (if adapt-file (cons adapt-file files)
+					files)))))
+      (and eval (not global) (eval eval))
+      ;; We then expand any exclude-file directives.
+      (setq gnus-scores-exclude-files 
+	    (nconc 
+	     (mapcar 
+	      (lambda (sfile) 
+		(expand-file-name sfile (file-name-directory file)))
+	      exclude-files) gnus-scores-exclude-files))
+      (if (not local)
+	  ()
+	(save-excursion
+	  (set-buffer gnus-summary-buffer)
+	  (while local
+	    (and (consp (car local))
+		 (symbolp (caar local))
+		 (progn
+		   (make-local-variable (caar local))
+		   (set (caar local) (nth 1 (car local)))))
+	    (setq local (cdr local)))))
+      (if orphan (setq gnus-orphan-score orphan))
+      (setq gnus-adaptive-score-alist
+	    (cond ((equal adapt '(t))
+		   (setq gnus-newsgroup-adaptive t)
+		   gnus-default-adaptive-score-alist)
+		  ((equal adapt '(ignore))
+		   (setq gnus-newsgroup-adaptive nil))
+		  ((consp adapt)
+		   (setq gnus-newsgroup-adaptive t)
+		   adapt)
+		  (t
+		   ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring)
+		   gnus-default-adaptive-score-alist)))
+      (setq gnus-thread-expunge-below 
+	    (or thread-mark-and-expunge gnus-thread-expunge-below))
+      (setq gnus-summary-mark-below 
+	    (or mark mark-and-expunge gnus-summary-mark-below))
+      (setq gnus-summary-expunge-below 
+	    (or expunge mark-and-expunge gnus-summary-expunge-below))
+      (setq gnus-newsgroup-adaptive-score-file 
+	    (or adapt-file gnus-newsgroup-adaptive-score-file)))
+    (setq gnus-current-score-file file)
+    (setq gnus-score-alist alist)
+    lists))
+
+(defun gnus-score-load (file)
+  ;; Load score FILE.
+  (let ((cache (assoc file gnus-score-cache)))
+    (if cache
+	(setq gnus-score-alist (cdr cache))
+      (setq gnus-score-alist nil)
+      (gnus-score-load-score-alist file)
+      (or gnus-score-alist
+	  (setq gnus-score-alist (copy-alist '((touched nil)))))
+      (setq gnus-score-cache
+	    (cons (cons file gnus-score-alist) gnus-score-cache)))))
+
+(defun gnus-score-remove-from-cache (file)
+  (setq gnus-score-cache 
+	(delq (assoc file gnus-score-cache) gnus-score-cache)))
+
+(defun gnus-score-load-score-alist (file)
+  (let (alist)
+    (if (not (file-readable-p file))
+	(setq gnus-score-alist nil)
+      (save-excursion
+	(gnus-set-work-buffer)
+	(insert-file-contents 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))
+	  (setq alist
+		(condition-case ()
+		    (read (current-buffer))
+		  (error 
+		   (progn
+		     (gnus-message 3 "Problem with score file %s" file)
+		     (ding) 
+		     (sit-for 2)
+		     nil))))))
+      (if (eq (car alist) 'setq)
+	  ;; This is an old-style score file.
+	  (setq gnus-score-alist (gnus-score-transform-old-to-new alist))
+	(setq gnus-score-alist alist))
+      ;; Check the syntax of the score file.
+      (setq gnus-score-alist
+	    (gnus-score-check-syntax gnus-score-alist file)))))
+
+(defun gnus-score-check-syntax (alist file)
+  "Check the syntax of the score ALIST."
+  (cond 
+   ((null alist)
+    nil)
+   ((not (consp alist))
+    (gnus-message 1 "Score file is not a list: %s" file)
+    (ding)
+    nil)
+   (t
+    (let ((a alist)
+	  sr err s type)
+      (while (and a (not err))
+	(setq
+	 err
+	 (cond
+	  ((not (listp (car a)))
+	   (format "Illegal score element %s in %s" (car a) file))
+	  ((stringp (caar a))
+	   (cond 
+	    ((not (listp (setq sr (cdar a))))
+	     (format "Illegal header match %s in %s" (nth 1 (car a)) file))
+	    (t
+	     (setq type (caar a))
+	     (while (and sr (not err))
+	       (setq s (pop sr))
+	       (setq 
+		err
+		(cond
+		 ((if (member (downcase type) '("lines" "chars"))
+		      (not (numberp (car s)))
+		    (not (stringp (car s))))
+		  (format "Illegal match %s in %s" (car s) file))
+		 ((and (cadr s) (not (integerp (cadr s))))
+		  (format "Non-integer score %s in %s" (cadr s) file))
+		 ((and (caddr s) (not (integerp (caddr s))))
+		  (format "Non-integer date %s in %s" (caddr s) file))
+		 ((and (cadddr s) (not (symbolp (cadddr s))))
+		  (format "Non-symbol match type %s in %s" (cadddr s) file)))))
+	     err)))))
+	(setq a (cdr a)))
+      (if err
+	  (progn
+	    (ding)
+	    (gnus-message 3 err)
+	    (sit-for 2)
+	    nil)
+	alist)))))    
+
+(defun gnus-score-transform-old-to-new (alist)
+  (let* ((alist (nth 2 alist))
+	 out entry)
+    (if (eq (car alist) 'quote)
+	(setq alist (nth 1 alist)))
+    (while alist
+      (setq entry (car alist))
+      (if (stringp (car entry))
+	  (let ((scor (cdr entry)))
+	    (setq out (cons entry out))
+	    (while scor
+	      (setcar scor
+		      (list (caar scor) (nth 2 (car scor))
+			    (and (nth 3 (car scor))
+				 (gnus-day-number (nth 3 (car scor))))
+			    (if (nth 1 (car scor)) 'r 's)))
+	      (setq scor (cdr scor))))
+	(setq out (cons (if (not (listp (cdr entry))) 
+			    (list (car entry) (cdr entry))
+			  entry)
+			out)))
+      (setq alist (cdr alist)))
+    (cons (list 'touched t) (nreverse out))))
+  
+(defun gnus-score-save ()
+  ;; Save all score information.
+  (let ((cache gnus-score-cache))
+    (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)))))
+      (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.
+    (while score-files
+      (if (stringp (car score-files))
+	  ;; It is a string, which means that it's a score file name,
+	  ;; so we load the score file and add the score alist to
+	  ;; the list of alists.
+	  (setq scores (nconc (gnus-score-load-file (car score-files)) scores))
+	;; It is an alist, so we just add it to the list directly.
+	(setq scores (nconc (car score-files) scores)))
+      (setq score-files (cdr score-files)))
+    ;; Prune the score files that are to be excluded, if any.
+    (when gnus-scores-exclude-files
+      (let ((s scores)
+	    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)))))
+    (setq news scores)
+    ;; Do the scoring.
+    (while news
+      (setq scores news
+	    news nil)
+      (when (and gnus-summary-default-score
+		 scores)
+	(let* ((entries gnus-header-index)
+	       (now (gnus-day-number (current-time-string)))
+	       (expire (and gnus-score-expiry-days
+			    (- now gnus-score-expiry-days)))
+	       (headers gnus-newsgroup-headers)
+	       (current-score-file gnus-current-score-file)
+	       entry header new)
+	  (gnus-message 5 "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
+	    ;; be written as O(N+S), where N is (length gnus-newsgroup-headers)
+	    ;; and S is (length gnus-newsgroup-scored).
+	    (or (assq (mail-header-number header) gnus-newsgroup-scored)
+		(setq gnus-scores-articles ;Total of 2 * N cons-cells used.
+		      (cons (cons header (or gnus-summary-default-score 0))
+			    gnus-scores-articles))))
+
+	  (save-excursion
+	    (set-buffer (get-buffer-create "*Headers*"))
+	    (buffer-disable-undo (current-buffer))
+
+	    ;; Set the global variant of this variable.
+	    (setq gnus-current-score-file current-score-file)
+	    ;; score orphans
+	    (when gnus-orphan-score 
+	      (setq gnus-score-index 
+		    (nth 1 (assoc "references" gnus-header-index)))
+	      (gnus-score-orphans gnus-orphan-score))
+	    ;; Run each header through the score process.
+	    (while entries
+	      (setq entry (pop entries)
+		    header (nth 0 entry)
+		    gnus-score-index (nth 1 (assoc header gnus-header-index)))
+	      (when (< 0 (apply 'max (mapcar
+				      (lambda (score)
+					(length (gnus-score-get header score)))
+				      scores)))
+		;; Call the scoring function for this type of "header".
+		(when (setq new (funcall (nth 2 entry) scores header
+					 now expire trace))
+		  (push new news))))
+	    ;; Remove the buffer.
+	    (kill-buffer (current-buffer)))
+
+	  ;; 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)))
+	    (setq gnus-scores-articles (cdr gnus-scores-articles)))
+
+	  (gnus-message 5 "Scoring...done"))))))
+
+
+(defun gnus-get-new-thread-ids (articles)
+  (let ((index (nth 1 (assoc "message-id" gnus-header-index)))
+        (refind gnus-score-index)
+        id-list art this tref)
+    (while articles
+      (setq art (car articles)
+            this (aref (car art) index)
+            tref (aref (car art) refind)
+            articles (cdr articles))
+      (if (string-equal tref "")        ;no references line
+          (setq id-list (cons this id-list))))
+    id-list))
+
+;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers).
+(defun gnus-score-orphans (score)
+  (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles))
+        alike articles art arts this last this-id)
+    
+    (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
+	  articles gnus-scores-articles)
+
+    ;;more or less the same as in gnus-score-string
+    (erase-buffer)
+    (while articles
+      (setq art (car articles)
+            this (aref (car art) gnus-score-index)
+            articles (cdr articles))
+      ;;completely skip if this is empty (not a child, so not an orphan)
+      (if (not (string= this ""))
+          (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)))
+            (setq alike (list art)
+                  last this))))
+    (and last                           ; Bwadr, duplicate code.
+         (progn
+           (insert last ?\n)                    
+           (put-text-property (1- (point)) (point) 'articles alike)))
+
+    ;; PLM: now delete those lines that contain an entry from new-thread-ids
+    (while new-thread-ids
+      (setq this-id (car new-thread-ids)
+            new-thread-ids (cdr new-thread-ids))
+      (goto-char (point-min))
+      (while (search-forward this-id nil t)
+        ;; found a match. remove this line
+	(beginning-of-line)
+	(kill-line 1)))
+
+    ;; now for each line: update its articles with score by moving to
+    ;; every end-of-line in the buffer and read the articles property
+    (goto-char (point-min))
+    (while (eq 0 (progn
+                   (end-of-line)
+                   (setq arts (get-text-property (point) 'articles))
+                   (while arts
+                     (setq art (car arts)
+                           arts (cdr arts))
+                     (setcdr art (+ score (cdr art))))
+                   (forward-line))))))
+             
+
+(defun gnus-score-integer (scores header now expire &optional trace)
+  (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
+	entries alist)
+
+    ;; 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) '>))
+	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
+	       (date (nth 2 kill))
+	       (found nil)
+	       (match-func (if (or (eq type '>) (eq type '<) (eq type '<=)
+				   (eq type '>=) (eq type '=))
+			       type
+			     (error "Illegal match type: %s" type)))
+	       (articles gnus-scores-articles))
+	  ;; 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 (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)))))
+	    (setq articles (cdr articles)))
+	  ;; 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)))))
+  nil)
+
+(defun gnus-score-date (scores header now expire &optional trace)
+  (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
+	entries alist)
+
+    ;; 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 (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)
+	  ;; 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)))
+	  ;; 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)))))
+  nil)
+
+(defun gnus-score-body (scores header now expire &optional trace)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (setq gnus-scores-articles
+	  (sort gnus-scores-articles
+		(lambda (a1 a2)
+		  (< (mail-header-number (car a1))
+		     (mail-header-number (car a2))))))
+    (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
+	  (while (cdr articles)
+	    (setq articles (cdr articles)))
+	  (setq last (mail-header-number (caar articles)))
+	  (setq articles gnus-scores-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)))
+	  (while articles
+	    (setq article (mail-header-number (caar articles)))
+	    (gnus-message 7 "Scoring on article %s of %s..." article last)
+	    (when (funcall request-func article gnus-newsgroup-name)
+	      (widen)
+	      (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.
+	      (if ofunc
+		  (if (eq ofunc 'gnus-request-head)
+		      (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 (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)
+			 (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 "Illegal match type: %s" type)))))
+		    (goto-char (point-min))
+		    (if (funcall search-func match nil t)
+			;; Found a match, update scores.
+			(progn
+			  (setcdr (car articles) (+ score (cdar articles)))
+			  (setq found t)
+			  (and trace (setq gnus-score-trace 
+					   (cons
+					    (cons
+					     (car-safe
+					      (rassq alist gnus-score-cache))
+					     kill)
+					    gnus-score-trace)))))
+		    ;; 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)))))
+	    (setq articles (cdr articles)))))))
+  nil)
+
+(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)
+
+    (erase-buffer)
+    (while articles
+      (setq art (car articles)
+	    this (aref (car art) gnus-score-index)
+	    articles (cdr articles))
+      (if (equal last this)
+	  (setq alike (cons art alike))
+	(if last
+	    (progn
+	      (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 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 "Illegal 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)
+	      (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."
+  (save-excursion
+    (set-buffer gnus-summary-buffer)
+    (let* ((id (mail-header-id header))
+	   (scores (car scores))
+	   entry dont)
+      ;; Don't enter a score if there already is one.
+      (while (setq entry (pop scores))
+	(and (equal "references" (car entry))
+	     (or (null (nth 3 (cadr entry)))
+		 (eq 's (nth 3 (cadr entry))))
+	     (assoc id entry)
+	     (setq dont t)))
+      (unless dont
+	(gnus-summary-score-entry 
+	 (if thread "thread" "references")
+	 id 's score (current-time-string) nil t)))))
+
+(defun gnus-score-string (score-list header now expire &optional trace)
+  ;; Score ARTICLES according to HEADER in SCORE-LIST.
+  ;; Update matching entries to NOW and remove unmatched entries older
+  ;; than EXPIRE.
+  
+  ;; 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)
+
+    ;; Sorting the articles costs os O(N*log N) but will allow us to
+    ;; only match with each unique header.  Thus the actual matching
+    ;; will be O(M*U) where M is the number of strings to match with,
+    ;; and U is the number of unique headers.  It is assumed (but
+    ;; untested) this will be a net win because of the large constant
+    ;; factor involved with string matching.
+    (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
+	  articles gnus-scores-articles)
+
+    (erase-buffer)
+    (while articles
+      (setq art (car articles)
+	    this (aref (car art) gnus-score-index)
+	    articles (cdr articles))
+      (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)))
+	(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)
+	    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 "Illegal match type: %s" type))))
+	       arts art)
+	  (if (= dmt ?f)
+	      (setq fuzzy t)
+	    ;; Do non-fuzzy 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
+	    (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))))
+
+    ;; Find fuzzy matches.
+    (when fuzzy
+      (setq scores score-list)
+      (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))
+		 (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)
+
+(defun gnus-score-string< (a1 a2)
+  ;; Compare headers in articles A2 and A2.
+  ;; The header index used is the free variable `gnus-score-index'.
+  (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 
+	(gnus-short-group-name (file-name-nondirectory score-file))
+      "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.
+      (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))))))
+
+(defun gnus-score-edit-done ()
+  (let ((bufnam (buffer-file-name (current-buffer)))
+	(winconf gnus-prev-winconf))
+    (and winconf (set-window-configuration winconf))
+    (gnus-score-remove-from-cache bufnam)
+    (gnus-score-load-file bufnam)))
+
+(defun gnus-score-find-trace ()
+  "Find all score rules that applies to the current article."
+  (interactive)
+  (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)))
+    (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*")
+      (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))))
+
+(defun gnus-summary-rescore ()
+  "Redo the entire scoring process in the current summary."
+  (interactive)
+  (gnus-score-save)
+  (setq gnus-score-cache nil)
+  (setq gnus-newsgroup-scored nil)
+  (gnus-possibly-score-headers)
+  (gnus-score-update-all-lines))
+  
+(defun gnus-score-flush-cache ()
+  "Flush the cache of score files."
+  (interactive)
+  (gnus-score-save)
+  (setq gnus-score-cache nil
+	gnus-score-alist nil
+	gnus-short-name-score-file-cache nil)
+  (gnus-message 6 "The score cache is now flushed"))
+
+(gnus-add-shutdown 'gnus-score-close 'gnus)
+
+(defvar gnus-score-file-alist-cache nil)
+
+(defun gnus-score-close ()
+  "Clear all internal score variables."
+  (setq gnus-score-cache nil
+	gnus-internal-global-score-files nil
+	gnus-score-file-list nil
+	gnus-score-file-alist-cache nil))
+
+;; Summary score marking commands.
+
+(defun gnus-summary-raise-same-subject-and-select (score)
+  "Raise articles which has the same subject with SCORE and select the next."
+  (interactive "p")
+  (let ((subject (gnus-summary-article-subject)))
+    (gnus-summary-raise-score score)
+    (while (gnus-summary-find-subject subject)
+      (gnus-summary-raise-score score))
+    (gnus-summary-next-article t)))
+
+(defun gnus-summary-raise-same-subject (score)
+  "Raise articles which has the same subject with SCORE."
+  (interactive "p")
+  (let ((subject (gnus-summary-article-subject)))
+    (gnus-summary-raise-score score)
+    (while (gnus-summary-find-subject subject)
+      (gnus-summary-raise-score score))
+    (gnus-summary-next-subject 1 t)))
+
+(defun gnus-score-default (level)
+  (if level (prefix-numeric-value level) 
+    gnus-score-interactive-default-score))
+
+(defun gnus-summary-raise-thread (&optional score)
+  "Raise the score of the articles in the current thread with SCORE."
+  (interactive "P")
+  (setq score (gnus-score-default score))
+  (let (e)
+    (save-excursion
+      (let ((articles (gnus-summary-articles-in-thread)))
+	(while articles
+	  (gnus-summary-goto-subject (car articles))
+	  (gnus-summary-raise-score score)
+	  (setq articles (cdr articles))))
+      (setq e (point)))
+    (let ((gnus-summary-check-current t))
+      (or (zerop (gnus-summary-next-subject 1 t))
+	  (goto-char e))))
+  (gnus-summary-recenter)
+  (gnus-summary-position-point)
+  (gnus-set-mode-line 'summary))
+
+(defun gnus-summary-lower-same-subject-and-select (score)
+  "Raise articles which has the same subject with SCORE and select the next."
+  (interactive "p")
+  (gnus-summary-raise-same-subject-and-select (- score)))
+
+(defun gnus-summary-lower-same-subject (score)
+  "Raise articles which has the same subject with SCORE."
+  (interactive "p")
+  (gnus-summary-raise-same-subject (- 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-default score)))))
+
+;;; Finding score files. 
+
+(defun gnus-score-score-files (group)
+  "Return a list of all possible score files."
+  ;; Search and set any global score files.
+  (and gnus-global-score-files 
+       (or gnus-internal-global-score-files
+	   (gnus-score-search-global-directories gnus-global-score-files)))
+  ;; Fix the kill-file dir variable.
+  (setq gnus-kill-files-directory 
+	(file-name-as-directory gnus-kill-files-directory))
+  ;; If we can't read it, there are no score files.
+  (if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
+      (setq gnus-score-file-list nil)
+    (if (not (gnus-use-long-file-name 'not-score))
+	;; We do not use long file names, so we have to do some
+	;; directory traversing.  
+	(setq gnus-score-file-list 
+	      (cons nil 
+		    (or gnus-short-name-score-file-cache
+			(prog2
+			    (gnus-message 6 "Finding all score files...")
+			    (setq gnus-short-name-score-file-cache
+				  (gnus-score-score-files-1
+				   gnus-kill-files-directory))
+			  (gnus-message 6 "Finding all score files...done")))))
+      ;; We want long file names.
+      (when (or (not gnus-score-file-list)
+		(not (car gnus-score-file-list))
+		(gnus-file-newer-than gnus-kill-files-directory
+				      (car gnus-score-file-list)))
+	(setq gnus-score-file-list 
+	      (cons (nth 5 (file-attributes gnus-kill-files-directory))
+		    (nreverse 
+		     (directory-files 
+		      gnus-kill-files-directory t 
+		      (gnus-score-file-regexp)))))))
+    (cdr gnus-score-file-list)))
+
+(defun gnus-score-score-files-1 (dir)
+  "Return all possible score files under DIR."
+  (let ((files (directory-files (expand-file-name dir) t nil t))
+	(regexp (gnus-score-file-regexp))
+	out file)
+    (while (setq file (pop files))
+      (cond 
+       ;; Ignore "." and "..".
+       ((member (file-name-nondirectory file) '("." ".."))
+	nil)
+       ;; Recurse down directories.
+       ((file-directory-p file)
+	(setq out (nconc (gnus-score-score-files-1 file) out)))
+       ;; Add files to the list of score files.
+       ((string-match regexp file)
+	(push file out))))
+    (or out
+	;; Return a dummy value.
+	(list "~/News/this.file.does.not.exist.SCORE"))))
+       
+(defun gnus-score-file-regexp ()
+  "Return a regexp that match all score files."
+  (concat "\\(" (regexp-quote gnus-score-file-suffix )
+	  "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'"))
+	
+(defun gnus-score-find-bnews (group)
+  "Return a list of score files for GROUP.
+The score files are those files in the ~/News/ directory which matches
+GROUP using BNews sys file syntax."
+  (let* ((sfiles (append (gnus-score-score-files group)
+			 gnus-internal-global-score-files))
+	 (kill-dir (file-name-as-directory 
+		    (expand-file-name gnus-kill-files-directory)))
+	 (klen (length kill-dir))
+	 (score-regexp (gnus-score-file-regexp))
+	 (trans (cdr (assq ?: nnheader-file-name-translation-alist)))
+	 ofiles not-match regexp)
+    (save-excursion
+      (set-buffer (get-buffer-create "*gnus score files*"))
+      (buffer-disable-undo (current-buffer))
+      ;; Go through all score file names and create regexp with them
+      ;; as the source.  
+      (while sfiles
+	(erase-buffer)
+	(insert (car sfiles))
+	(goto-char (point-min))
+	;; First remove the suffix itself.
+	(when (re-search-forward (concat "." score-regexp) nil t)
+	  (replace-match "" t t) 
+	  (goto-char (point-min))
+	  (if (looking-at (regexp-quote kill-dir))
+	      ;; If the file name was just "SCORE", `klen' is one character
+	      ;; too much.
+	      (delete-char (min (1- (point-max)) klen))
+	    (goto-char (point-max))
+	    (search-backward "/")
+	    (delete-region (1+ (point)) (point-min)))
+	  ;; If short file names were used, we have to translate slashes.
+	  (goto-char (point-min))
+	  (let ((regexp (concat
+			 "[/:" (if trans (char-to-string trans) "") "]")))
+	    (while (re-search-forward regexp nil t)
+	      (replace-match "." t t)))
+	  ;; Cludge to get rid of "nntp+" problems.
+	  (goto-char (point-min))
+	  (and (looking-at "nn[a-z]+\\+")
+	       (progn
+		 (search-forward "+")
+		 (forward-char -1)
+		 (insert "\\")))
+	  ;; Kludge to deal with "++".
+	  (goto-char (point-min))
+	  (while (search-forward "++" nil t)
+	    (replace-match "\\+\\+" t t))
+	  ;; Translate "all" to ".*".
+	  (goto-char (point-min))
+	  (while (search-forward "all" nil t)
+	    (replace-match ".*" t t))
+	  (goto-char (point-min))
+	  ;; Deal with "not."s.
+	  (if (looking-at "not.")
+	      (progn
+		(setq not-match t)
+		(setq regexp (buffer-substring 5 (point-max))))
+	    (setq regexp (buffer-substring 1 (point-max)))
+	    (setq not-match nil))
+	  ;; Finally - if this resulting regexp matches the group name,
+	  ;; we add this score file to the list of score files
+	  ;; applicable to this group.
+	  (if (or (and not-match
+		       (not (string-match regexp group)))
+		  (and (not not-match)
+		       (string-match regexp group)))
+	      (setq ofiles (cons (car sfiles) ofiles))))
+	(setq sfiles (cdr sfiles)))
+      (kill-buffer (current-buffer))
+      ;; Slight kludge here - the last score file returned should be
+      ;; the local score file, whether it exists or not. This is so
+      ;; that any score commands the user enters will go to the right
+      ;; file, and not end up in some global score file.
+      (let ((localscore (gnus-score-file-name group)))
+	(setq ofiles (cons localscore (delete localscore ofiles))))
+      (nreverse ofiles))))
+
+(defun gnus-score-find-single (group)
+  "Return list containing the score file for GROUP."
+  (list (or gnus-newsgroup-adaptive-score-file
+	    (gnus-score-file-name group gnus-adaptive-file-suffix))
+	(gnus-score-file-name group)))
+
+(defun gnus-score-find-hierarchical (group)
+  "Return list of score files for GROUP.
+This includes the score file for the group and all its parents."
+  (let ((all (copy-sequence '(nil)))
+	(start 0))
+    (while (string-match "\\." group (1+ start))
+      (setq start (match-beginning 0))
+      (setq all (cons (substring group 0 start) all)))
+    (setq all (cons group all))
+    (nconc
+     (mapcar (lambda (newsgroup)
+	       (gnus-score-file-name newsgroup gnus-adaptive-file-suffix))
+	     (setq all (nreverse all)))
+     (mapcar 'gnus-score-file-name all))))
+
+(defun gnus-score-find-alist (group)
+  "Return list of score files for GROUP.
+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
+    (if (setq score-files (assoc group gnus-score-file-alist-cache))
+	(cdr score-files)		;ensures caching groups with no matches
+      ;; handle the multiple match alist
+      (while alist
+	(and (string-match (caar alist) group)
+	     (setq score-files
+		   (nconc score-files (copy-sequence (cdar alist)))))
+	(setq alist (cdr alist)))
+      (setq alist gnus-score-file-single-match-alist)
+      ;; handle the single match alist
+      (while alist
+	(and (string-match (caar alist) group)
+	     ;; progn used just in case ("regexp") has no files
+	     ;; and score-files is still nil. -sj
+	     ;; this can be construed as a "stop searching here" feature :>
+	     ;; and used to simplify regexps in the single-alist 
+	     (progn
+	       (setq score-files
+		     (nconc score-files (copy-sequence (cdar alist))))
+	       (setq alist nil)))
+	(setq alist (cdr alist)))
+      ;; cache the score files
+      (setq gnus-score-file-alist-cache
+	    (cons (cons group score-files) gnus-score-file-alist-cache))
+      score-files)))
+
+(defun gnus-possibly-score-headers (&optional trace)
+  (let ((funcs gnus-score-find-score-files-function)
+	score-files)
+    ;; Make sure funcs is a list.
+    (and funcs
+	 (not (listp funcs))
+	 (setq funcs (list funcs)))
+    ;; Get the initial score files for this group.
+    (when funcs 
+      (setq score-files (gnus-score-find-alist gnus-newsgroup-name)))
+    ;; 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))))
+      (setq funcs (cdr funcs)))
+    ;; Check whether there is a `score-file' group parameter.
+    (let ((param-file (gnus-group-get-parameter 
+		       gnus-newsgroup-name 'score-file)))
+      (when param-file
+	(push param-file score-files)))
+    ;; Do the scoring if there are any score files for this group.
+    (when score-files
+      (gnus-score-headers score-files trace))))
+
+(defun gnus-score-file-name (newsgroup &optional suffix)
+  "Return the name of a score file for NEWSGROUP."
+  (let ((suffix (or suffix gnus-score-file-suffix)))
+    (nnheader-translate-file-chars
+     (cond
+      ((or (null newsgroup)
+	   (string-equal newsgroup ""))
+       ;; The global score file is placed at top of the directory.
+       (expand-file-name 
+	suffix gnus-kill-files-directory))
+      ((gnus-use-long-file-name 'not-score)
+       ;; Append ".SCORE" to newsgroup name.
+       (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
+				 "." suffix)
+			 gnus-kill-files-directory))
+      (t
+       ;; Place "SCORE" under the hierarchical directory.
+       (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
+				 "/" suffix)
+			 gnus-kill-files-directory))))))
+
+(defun gnus-score-search-global-directories (files)
+  "Scan all global score directories for score files."
+  ;; Set the variable `gnus-internal-global-score-files' to all
+  ;; available global score files.
+  (interactive (list gnus-global-score-files))
+  (let (out)
+    (while files
+      (if (string-match "/$" (car files))
+	  (setq out (nconc (directory-files 
+			    (car files) t
+			    (concat (gnus-score-file-regexp) "$"))))
+	(setq out (cons (car files) out)))
+      (setq files (cdr files)))
+    (setq gnus-internal-global-score-files out)))
+
+(defun gnus-score-default-fold-toggle ()
+  "Toggle folding for new score file entries."
+  (interactive)
+  (setq gnus-score-default-fold (not gnus-score-default-fold))
+  (if gnus-score-default-fold
+      (gnus-message 1 "New score file entries will be case insensitive.")
+    (gnus-message 1 "New score file entries will be case sensitive.")))
+
+(provide 'gnus-score)
+
+;;; gnus-score.el ends here