xemacs-beta: lisp/gnus/gnus-score.el comparison

comparison lisp/gnus/gnus-score.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14

author	cvs
date	Mon, 13 Aug 2007 08:45:50 +0200
parents
children	ac2d302a0011

comparison

equal deleted inserted replaced

--1:000000000000
+:376386a54a3c
+;;; 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

Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-score.el @ 0:376386a54a3c r19-14