X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=dd4d1c95fe0988934007e2ede9ca5a6c38564fbd;hb=95ab2b8214e629e5d842b712e5f0b01b4ed9a04b;hp=3734e8b58c896ccb18f58b44bbbc79814fd5effe;hpb=52788848f0fe5205e9500e3de0b3d194ae230ba6;p=gnus

diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index 3734e8b58..dd4d1c95f 100644
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -1,5 +1,5 @@
 ;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
 ;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -18,8 +18,9 @@
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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:
 
@@ -97,7 +98,13 @@ score alists.")
   "*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.")
+  "*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.")
@@ -117,7 +124,7 @@ score alists.")
 (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
+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.
 
@@ -126,6 +133,59 @@ 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.
@@ -133,6 +193,8 @@ If this variable is nil, exact matching will always be used.")
 (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)
@@ -160,28 +222,23 @@ of the last successful match.")
 (defvar gnus-score-index nil)
 
 (eval-and-compile
-  (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap)
-  (autoload 'appt-select-lowest-window "appt.el"))
+  (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap))
 
 ;;; Summary mode score maps.
 
-(defvar gnus-summary-score-map nil)
-
-(define-prefix-command 'gnus-summary-score-map)
-(define-key gnus-summary-mode-map "V" 'gnus-summary-score-map)
-(define-key gnus-summary-score-map "s" 'gnus-summary-set-score)
-(define-key gnus-summary-score-map "a" 'gnus-summary-score-entry)
-(define-key gnus-summary-score-map "S" 'gnus-summary-current-score)
-(define-key gnus-summary-score-map "c" 'gnus-score-change-score-file)
-(define-key gnus-summary-score-map "m" 'gnus-score-set-mark-below)
-(define-key gnus-summary-score-map "x" 'gnus-score-set-expunge-below)
-(define-key gnus-summary-score-map "R" 'gnus-summary-rescore)
-(define-key gnus-summary-score-map "e" 'gnus-score-edit-alist)
-(define-key gnus-summary-score-map "f" 'gnus-score-edit-file)
-(define-key gnus-summary-score-map "t" 'gnus-score-find-trace)
-(define-key gnus-summary-score-map "C" 'gnus-score-customize)
-
-
+(gnus-define-keys
+ (gnus-summary-score-map "V" gnus-summary-mode-map)
+ "s" gnus-summary-set-score
+ "a" gnus-summary-score-entry
+ "S" gnus-summary-current-score
+ "c" gnus-score-change-score-file
+ "m" gnus-score-set-mark-below
+ "x" gnus-score-set-expunge-below
+ "R" gnus-summary-rescore
+ "e" gnus-score-edit-current-scores
+ "f" gnus-score-edit-file
+ "t" gnus-score-find-trace
+ "C" gnus-score-customize)
 
 ;; Summary score file commands
 
@@ -196,6 +253,21 @@ 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,
@@ -212,11 +284,12 @@ used as score."
 	    (?b "body" "" nil body-string)
 	    (?h "head" "" nil body-string)
 	    (?i "message-id" nil t string)
-	    (?t "references" "message-id" 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)))
+	    (?f "followup" nil nil string)
+	    (?T "thread" nil nil string)))
 	 (char-to-type
 	  '((?s s "substring" string)
 	    (?e e "exact string" string)
@@ -234,7 +307,14 @@ used as score."
 	  (list (list ?t (current-time-string) "temporary") 
 		'(?p perm "permanent") '(?i now "immediate")))
 	 (mimic gnus-score-mimic-keymap)
-	 hchar entry temporary tchar pchar end type match)
+	 (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)
+
     ;; First we read the header to score.
     (while (not hchar)
       (if mimic
@@ -245,123 +325,95 @@ used as score."
 		 (mapconcat (lambda (s) (char-to-string (car s)))
 			    char-to-header "")))
       (setq hchar (read-char))
-      (if (not (or (= hchar ??) (= hchar ?\C-h)))
-	  ()
+      (when (or (= hchar ??) (= hchar ?\C-h))
 	(setq hchar nil)
 	(gnus-score-insert-help "Match on header" char-to-header 1)))
 
-    (and (get-buffer "*Score Help*")
-	 (progn
-	   (kill-buffer "*Score Help*")
-	   (and gnus-score-help-winconf
-		(set-window-configuration gnus-score-help-winconf))))
-
-    (or (setq entry (assq (downcase hchar) char-to-header))
-	(progn
-	  (ding)
-	  (setq end t)
-	  (if mimic (message "%c %c" prefix hchar) (message ""))))
-    (if (or end (/= (downcase hchar) hchar))
-	(progn
-	  ;; This was a majuscle, so we end reading and set the defaults.
-	  (if mimic (message "%c %c" prefix hchar) (message ""))
-	  (setq type nil
-		temporary (current-time-string)))
-
-      ;; 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))
-	(if (not (or (= tchar ??) (= tchar ?\C-h)))
-	    ()
-	  (setq tchar nil)
-	  (gnus-score-insert-help "Match type" char-to-type 2)))
-
-      (and (get-buffer "*Score Help*")
-	   (progn
-	     (and gnus-score-help-winconf
-		  (set-window-configuration gnus-score-help-winconf))
-	     (kill-buffer "*Score Help*")))
-      
-      (or (setq type (nth 1 (assq (downcase tchar) char-to-type)))
+    (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
-	    (ding)
-	    (if mimic (message "%c %c" prefix hchar) (message ""))
-	    (setq end t)))
-      (if (or end (/= (downcase tchar) tchar))
+	    (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" 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
-	    ;; It was a majuscle, so we end reading and the the default.
-	    (if mimic (message "%c %c %c" prefix hchar tchar)
-	      (message ""))
-	    (setq temporary (current-time-string)))
-
-	;; 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))
-	  (if (not (or (= pchar ??) (= pchar ?\C-h)))
-	      ()
-	    (setq pchar nil)
-	    (gnus-score-insert-help "Match permanence" char-to-perm 2)))
-
-	(and (get-buffer "*Score Help*")
-	     (progn
-	       (and gnus-score-help-winconf
-		    (set-window-configuration gnus-score-help-winconf))
-	       (kill-buffer "*Score Help*")))
-
-	(if mimic (message "%c %c %c" prefix hchar tchar pchar)
-	  (message ""))
-	(if (setq temporary (nth 1 (assq pchar char-to-perm)))
-	    ()
-	  (ding)
-	  (setq end t)
-	  (if mimic 
-	      (message "%c %c %c %c" prefix hchar tchar pchar)
-	    (message "")))))
+	    (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 "")))
 
     ;; We have all the data, so we enter this score.
-    (if end
-	()
-      (setq match (if (string= (nth 2 entry) "") ""
-		    (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
+    (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))))))
-
-      (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
-      )))
+    ;; 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))
@@ -393,11 +445,11 @@ used as score."
 	  (insert "\n"))
 	(setq pad (- width 3))
 	(setq format (concat "%c: %-" (int-to-string pad) "s"))
-	(insert (format format (car (car alist)) (nth idx (car alist))))
+	(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
-    (appt-select-lowest-window)
+    (gnus-appt-select-lowest-window)
     (split-window)
     (pop-to-buffer "*Score Help*")
     (shrink-window-if-larger-than-buffer)
@@ -473,6 +525,8 @@ If optional argument `SILENT' is nil, show effect of score entry."
 			     (if (numberp match)
 				 (int-to-string match)
 			       match))))
+
+    ;; Score the current buffer.
     (and (>= (nth 1 (assoc header gnus-header-index)) 0)
 	 (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-string)
 	 (not silent)
@@ -482,9 +536,9 @@ If optional argument `SILENT' is nil, show effect of score entry."
     (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
 	 (setq match (string-to-int match)))
 
-    (if (eq date 'now)
-	()
-      (and (= score gnus-score-interactive-default-score)
+    (unless (eq date 'now)
+      ;; Add the score entry to the score file.
+      (when (= score gnus-score-interactive-default-score)
 	   (setq score nil))
       (let ((new (cond 
 		  (type
@@ -511,8 +565,9 @@ If optional argument `SILENT' is nil, show effect of score entry."
 				  (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)))))
+	  (gnus-score-set header (if old (cons new old) (list new))))
+	(gnus-score-set 'touched '(t))
+	new))))
 
 (defun gnus-summary-score-effect (header match type score)
   "Simulate the effect of a score file entry.
@@ -533,8 +588,12 @@ SCORE is the score to add."
     (goto-char (point-min))
     (let ((regexp (cond ((eq type 'f)
 			 (gnus-simplify-subject-fuzzy match))
-			(type match)
-			(t (concat "\\`.*" (regexp-quote 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))
@@ -590,6 +649,21 @@ SCORE is the score to add."
       (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 
@@ -603,27 +677,31 @@ SCORE is the score to add."
   "Add SCORE to all followups to the article in the current buffer."
   (interactive "P")
   (setq score (gnus-score-default score))
-  (save-excursion
-    (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)))))))
+  (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))
-  (save-excursion
-    (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)))))))
+  (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.
@@ -652,11 +730,12 @@ SCORE is the score to add."
   (gnus-score-load-file file)
   (gnus-set-mode-line 'summary))
 
-(defun gnus-score-edit-alist (file)
+(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)
@@ -670,6 +749,7 @@ SCORE is the score to add."
   "Edit a score file."
   (interactive 
    (list (read-file-name "Edit score file: " gnus-kill-files-directory)))
+  (gnus-make-directory (file-name-directory file))
   (and (buffer-name gnus-summary-buffer) (gnus-score-save))
   (let ((winconf (current-window-configuration)))
     (setq gnus-score-edit-buffer (find-file-noselect file))
@@ -748,10 +828,10 @@ SCORE is the score to add."
 	  (set-buffer gnus-summary-buffer)
 	  (while local
 	    (and (consp (car local))
-		 (symbolp (car (car local)))
+		 (symbolp (caar local))
 		 (progn
-		   (make-local-variable (car (car local)))
-		   (set (car (car local)) (nth 1 (car local)))))
+		   (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
@@ -796,31 +876,33 @@ SCORE is the score to add."
 
 (defun gnus-score-load-score-alist (file)
   (let (alist)
-    (if (file-readable-p file)
-	(progn
-	  (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.
-	    (if (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)
-	      (setq gnus-score-alist (gnus-score-transform-old-to-new alist))
-	    (setq gnus-score-alist alist))
-	  (setq gnus-score-alist
-		(gnus-score-check-syntax gnus-score-alist file)))
-      (setq gnus-score-alist nil))))
+    (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)
@@ -830,20 +912,41 @@ SCORE is the score to add."
     nil)
    (t
     (let ((a alist)
-	  err)
+	  sr err s type)
       (while (and a (not err))
-	(cond ((not (listp (car a)))
-	       (gnus-message 3 "Illegal score element %s in %s" (car a) file)
-	       (setq err t))
-	      ((and (stringp (car (car a)))
-		    (not (listp (nth 1 (car a)))))
-	       (gnus-message 3 "Illegal header match %s in %s" (nth 1 (car a)) file)
-	       (setq err t))
-	      (t
-	       (setq a (cdr a)))))
+	(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)))))    
 
@@ -859,7 +962,7 @@ SCORE is the score to add."
 	    (setq out (cons entry out))
 	    (while scor
 	      (setcar scor
-		      (list (car (car scor)) (nth 2 (car 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)))
@@ -906,9 +1009,10 @@ SCORE is the score to add."
 	      (if (zerop (buffer-size))
 		  (delete-file file)
 		;; There are scores, so we write the file. 
-		(and (file-writable-p file)
-		     (write-region (point-min) (point-max) 
-				   file nil 'silent))))
+ 		(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)))))
@@ -916,7 +1020,7 @@ SCORE is the score to add."
   
 (defun gnus-score-headers (score-files &optional trace)
   ;; Score `gnus-newsgroup-headers'.
-  (let (scores)
+  (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)
@@ -940,68 +1044,70 @@ SCORE is the score to add."
 	       (member (car c) gnus-scores-exclude-files)
 	       (setq scores (delq (car s) scores)))
 	  (setq s (cdr s)))))
+    (setq news scores)
     ;; Do the scoring.
-    (when (and gnus-summary-default-score
-	       scores
-	       (> (length gnus-newsgroup-headers)
-		  (length gnus-newsgroup-scored)))
-      (let* ((entries gnus-header-index)
-	     (now (gnus-day-number (current-time-string)))
-	     (expire (- now gnus-score-expiry-days))
-	     (headers gnus-newsgroup-headers)
-	     (current-score-file gnus-current-score-file)
-	     entry header)
-	(gnus-message 5 "Scoring...")
-	;; Create articles, an alist of the form `(HEADER . SCORE)'.
-	(while headers
-	  (setq header (car headers)
-		headers (cdr 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))))
+    (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
-          (if gnus-orphan-score 
-              (progn
-                (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 (car entries)
-		  header (downcase (nth 0 entry))
-		  entries (cdr entries))
-	    (setq gnus-score-index (nth 1 (assoc header gnus-header-index)))
-	    (if (< 0 (apply 'max (mapcar
-				  (lambda (score)
-				    (length (gnus-score-get header score)))
-				  scores)))
+	  (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 (car entries)
+		    header (downcase (nth 0 entry))
+		    entries (cdr entries))
+	      (setq 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".
-		(funcall (nth 2 entry) scores header now expire trace)))
-	  ;; Remove the buffer.
-	  (kill-buffer (current-buffer)))
+		(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 (cdr (car gnus-scores-articles)))
-	      (setq gnus-newsgroup-scored
-		    (cons (cons (mail-header-number 
-				 (car (car gnus-scores-articles)))
-				(cdr (car gnus-scores-articles)))
-			  gnus-newsgroup-scored)))
-	  (setq gnus-scores-articles (cdr gnus-scores-articles)))
+	  ;; 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")))))
+	  (gnus-message 5 "Scoring...done"))))))
 
 
 (defun gnus-get-new-thread-ids (articles)
@@ -1040,7 +1146,7 @@ SCORE is the score to add."
             (if last
                 (progn
                   ;; Insert the line, with a text property on the
-                  ;; terminating newline refering to the articles with
+                  ;; terminating newline referring to the articles with
                   ;; this line.
                   (insert last ?\n)
                   (put-text-property (1- (point)) (point) 'articles alike)))
@@ -1103,7 +1209,7 @@ SCORE is the score to add."
 	  ;; time than one would gain.
 	  (while articles
 	    (and (funcall match-func 
-			  (or (aref (car (car articles)) gnus-score-index) 0)
+			  (or (aref (caar articles) gnus-score-index) 0)
 			  match)
 		 (progn
 		   (and trace (setq gnus-score-trace 
@@ -1113,18 +1219,19 @@ SCORE is the score to add."
 				      kill)
 				     gnus-score-trace)))
 		   (setq found t)
-		   (setcdr (car articles) (+ score (cdr (car articles))))))
+		   (setcdr (car articles) (+ score (cdar articles)))))
 	    (setq articles (cdr articles)))
 	  ;; Update expire date
 	  (cond ((null date))		;Permanent entry.
-		(found			;Match, update date.
+		((and found gnus-update-score-entry-dates) ;Match, update date.
 		 (gnus-score-set 'touched '(t) alist)
 		 (setcar (nthcdr 2 kill) now))
-		((< date expire)	;Old entry, remove.
+		((and expire (< date expire)) ;Old entry, remove.
 		 (gnus-score-set 'touched '(t) alist)
 		 (setcdr entries (cdr rest))
 		 (setq rest entries)))
-	  (setq entries rest))))))
+	  (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)))
@@ -1157,7 +1264,7 @@ SCORE is the score to add."
 	  ;; time than one would gain.
 	  (while articles
 	    (and
-	     (setq l (aref (car (car articles)) gnus-score-index))
+	     (setq l (aref (caar articles) gnus-score-index))
 	     (funcall match-func match (timezone-make-date-sortable l))
 	     (progn
 	       (and trace (setq gnus-score-trace 
@@ -1167,33 +1274,42 @@ SCORE is the score to add."
 				  kill)
 				 gnus-score-trace)))
 	       (setq found t)
-	       (setcdr (car articles) (+ score (cdr (car articles))))))
+	       (setcdr (car articles) (+ score (cdar articles)))))
 	    (setq articles (cdr articles)))
 	  ;; Update expire date
 	  (cond ((null date))		;Permanent entry.
-		(found			;Match, update date.
+		((and found gnus-update-score-entry-dates) ;Match, update date.
 		 (gnus-score-set 'touched '(t) alist)
 		 (setcar (nthcdr 2 kill) now))
-		((< date expire)	;Old entry, remove.
+		((and expire (< date expire))	;Old entry, remove.
 		 (gnus-score-set 'touched '(t) alist)
 		 (setcdr entries (cdr rest))
 		 (setq rest entries)))
-	  (setq entries rest))))))
+	  (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)
-	     (last (mail-header-number (car (car gnus-scores-articles))))
 	     (all-scores scores)
 	     (request-func (cond ((string= "head" (downcase header))
 				  'gnus-request-head)
 				 ((string= "body" (downcase header))
 				  'gnus-request-body)
 				 (t 'gnus-request-article)))
-	     entries alist ofunc article)
+	     entries alist ofunc article last)
+	(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 
@@ -1205,7 +1321,7 @@ SCORE is the score to add."
 	      (setq ofunc request-func)
 	      (setq request-func 'gnus-request-article)))
 	(while articles
-	  (setq article (mail-header-number (car (car articles))))
+	  (setq article (mail-header-number (caar articles)))
 	  (gnus-message 7 "Scoring on article %s of %s..." article last)
 	  (if (not (funcall request-func article gnus-newsgroup-name))
 	      ()
@@ -1253,7 +1369,7 @@ SCORE is the score to add."
 		  (if (funcall search-func match nil t)
 		      ;; Found a match, update scores.
 		      (progn
-			(setcdr (car articles) (+ score (cdr (car articles))))
+			(setcdr (car articles) (+ score (cdar articles)))
 			(setq found t)
 			(and trace (setq gnus-score-trace 
 					 (cons
@@ -1263,29 +1379,36 @@ SCORE is the score to add."
 					   kill)
 					  gnus-score-trace)))))
 		  ;; Update expire date
-		  (cond ((null date))	;Permanent entry.
-			(found		;Match, update date.
-			 (gnus-score-set 'touched '(t) alist)
-			 (setcar (nthcdr 2 kill) now))
-			((< date expire) ;Old entry, remove.
-			 (gnus-score-set 'touched '(t) alist)
-			 (setcdr entries (cdr rest))
-			 (setq rest entries)))
+		  (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)))))))
+	  (setq articles (cdr articles))))))
+  nil)
 
-(defun gnus-score-followup (scores header now expire &optional trace)
+(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)
+	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.
-    (gnus-score-load-file (gnus-score-file-name 
-			   gnus-newsgroup-name gnus-adaptive-file-suffix))
+    (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)
@@ -1345,52 +1468,53 @@ SCORE is the score to add."
 			 (setq art (car arts)
 			       arts (cdr arts))
 			 (gnus-score-add-followups 
-			  (car art) score all-scores)))))
+			  (car art) score all-scores thread)))))
 	    (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 arts
-		(setq art (car arts)
-		      arts (cdr arts))
-		(gnus-score-add-followups (car art) score all-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.
-		(found			;Match, update date.
+		((and found gnus-update-score-entry-dates) ;Match, update date.
 		 (gnus-score-set 'touched '(t) alist)
 		 (setcar (nthcdr 2 kill) now))
-		((< date expire)	;Old entry, remove.
+		((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.
-    (gnus-score-load-file current-score-file)))
+    (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)
+(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 scores
-	(setq entry (car scores))
+      (while (setq entry (pop scores))
 	(and (equal "references" (car entry))
-	     (or (null (nth 3 (car (cdr entry))))
-		 (eq 's (nth 3 (car (cdr entry)))))
-	     (progn
-	       (if (assoc id entry)
-		   (setq dont t))))
-	(setq scores (cdr scores)))
-      (or dont
-	  (gnus-summary-score-entry 
-	   "references" id 's score (current-time-string) nil t)))))
-
+	     (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 matches entries to NOW and remove unmatched entried older
+  ;; Update matching entries to NOW and remove unmatched entries older
   ;; than EXPIRE.
   
   ;; Insert the unique article headers in the buffer.
@@ -1419,7 +1543,7 @@ SCORE is the score to add."
 	(if last
 	    (progn
 	      ;; Insert the line, with a text property on the
-	      ;; terminating newline refering to the articles with
+	      ;; terminating newline referring to the articles with
 	      ;; this line.
 	      (insert last ?\n)
 	      (put-text-property (1- (point)) (point) 'articles alike)))
@@ -1507,14 +1631,15 @@ SCORE is the score to add."
 		    (setcdr art (+ score (cdr art)))))
 		(forward-line 1)))
 	    ;; Update expire date
-	    (cond ((null date))		;Permanent entry.
-		  (found		;Match, update date.
-		   (gnus-score-set 'touched '(t) alist)
-		   (setcar (nthcdr 2 kill) now))
-		  ((< date expire)	;Old entry, remove.
-		   (gnus-score-set 'touched '(t) alist)
-		   (setcdr entries (cdr rest))
-		   (setq rest entries))))
+	    (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.
@@ -1562,15 +1687,17 @@ SCORE is the score to add."
 		(forward-line 1))
 	      ;; Update expire date
 	      (unless trace
-		(cond ((null date))		;Permanent entry.
-		      (found		;Match, update date.
-		       (gnus-score-set 'touched '(t) alist)
-		       (setcar (nthcdr 2 kill) now))
-		      ((< date expire)	;Old entry, remove.
-		       (gnus-score-set 'touched '(t) alist)
-		       (setcdr entries (cdr rest))
-		       (setq rest entries)))))
-	    (setq entries rest)))))))
+		(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.
@@ -1596,7 +1723,8 @@ SCORE is the score to add."
     ("head" -1 gnus-score-body)
     ("body" -1 gnus-score-body)
     ("all" -1 gnus-score-body)
-    ("followup" 2 gnus-score-followup)))
+    ("followup" 2 gnus-score-followup)
+    ("thread" 5 gnus-score-thread)))
 
 (defun gnus-current-score-file-nondirectory (&optional score-file)
   (let ((score-file (or score-file gnus-current-score-file)))
@@ -1620,16 +1748,18 @@ SCORE is the score to add."
 	(setq elem (cdr elem))
 	(while elem
 	  (setcdr (car elem) 
-		  (cons (if (eq (car (car elem)) 'followup)
+		  (cons (if (eq (caar elem) 'followup)
 			    "references"
-			  (symbol-name (car (car elem))))
-			(cdr (car elem))))
+			  (symbol-name (caar elem)))
+			(cdar elem)))
 	  (setcar (car elem) 
-		  (intern 
-		   (concat "gnus-header-" 
-			   (if (eq (car (car elem)) 'followup)
-			       "message-id"
-			     (downcase (symbol-name (car (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.
@@ -1645,7 +1775,7 @@ SCORE is the score to add."
 	    ()
 	  (when (setq headers (gnus-data-header (car data)))
 	    (while elem 
-	      (setq match (funcall (car (car elem)) headers))
+	      (setq match (funcall (caar elem) headers))
 	      (gnus-summary-score-entry 
 	       (nth 1 (car elem)) match
 	       (cond
@@ -1669,14 +1799,20 @@ SCORE is the score to add."
 ;;; Score mode.
 ;;;
 
-(defvar gnus-score-mode-map nil)
-(defvar gnus-score-mode-hook nil)
+(defvar gnus-score-mode-hook nil
+  "*Hook run in score mode buffers.")
 
-(if gnus-score-mode-map
-    ()
+(defvar gnus-score-menu-hook nil
+  "*Hook run after creating the score mode menu.")
+
+(defvar gnus-score-mode-map nil)
+(unless gnus-score-mode-map
   (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map))
-  (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-done)
-  (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date))
+  (gnus-define-keys 
+   gnus-score-mode-map
+   "\C-c\C-c" gnus-score-edit-done
+   "\C-c\C-d" gnus-score-edit-insert-date
+   "\C-c\C-p" gnus-score-pretty-print))
 
 (defun gnus-score-mode ()
   "Mode for editing score files.
@@ -1686,16 +1822,39 @@ This mode is an extended emacs-lisp mode.
   (interactive)
   (kill-all-local-variables)
   (use-local-map gnus-score-mode-map)
+  (when (and menu-bar-mode
+	     (gnus-visual-p 'score-menu 'menu))
+    (gnus-score-make-menu-bar))
   (set-syntax-table emacs-lisp-mode-syntax-table)
   (setq major-mode 'gnus-score-mode)
   (setq mode-name "Score")
   (lisp-mode-variables nil)
   (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
 
+(defun gnus-score-make-menu-bar ()
+  (unless (boundp 'gnus-score-menu)
+    (easy-menu-define
+     gnus-score-menu gnus-score-mode-map ""
+     '("Score"
+       ["Exit" gnus-score-edit-done t]
+       ["Insert date" gnus-score-edit-insert-date t]
+       ["Format" gnus-score-pretty-print t]
+       ))
+    (run-hooks 'gnus-score-menu-hook)))
+
 (defun gnus-score-edit-insert-date ()
   "Insert date in numerical format."
   (interactive)
-  (insert (int-to-string (gnus-day-number (current-time-string)))))
+  (princ (gnus-day-number (current-time-string)) (current-buffer)))
+
+(defun gnus-score-pretty-print ()
+  "Format the current score file."
+  (interactive)
+  (goto-char (point-min))
+  (let ((form (read (current-buffer))))
+    (erase-buffer)
+    (pp form (current-buffer)))
+  (goto-char (point-min)))
 
 (defun gnus-score-edit-done ()
   "Save the score file and return to the summary buffer."
@@ -1705,9 +1864,9 @@ This mode is an extended emacs-lisp mode.
     (gnus-make-directory (file-name-directory (buffer-file-name)))
     (save-buffer)
     (kill-buffer (current-buffer))
+    (and winconf (set-window-configuration winconf))
     (gnus-score-remove-from-cache bufnam)
-    (gnus-score-load-file bufnam)
-    (and winconf (set-window-configuration winconf))))
+    (gnus-score-load-file bufnam)))
 
 (defun gnus-score-find-trace ()
   "Find all score rules that applies to the current article."
@@ -1725,8 +1884,8 @@ This mode is an extended emacs-lisp mode.
     (gnus-add-current-to-buffer-list)
     (erase-buffer)
     (while trace
-      (insert (format "%S  ->  %s\n"  (cdr (car trace))
-		      (file-name-nondirectory (car (car 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)))
@@ -1735,20 +1894,26 @@ This mode is an extended emacs-lisp mode.
   "Redo the entire scoring process in the current summary."
   (interactive)
   (setq gnus-newsgroup-scored nil)
-  (gnus-score-flush-cache)
+  (setq gnus-score-cache nil)
+  (setq gnus-newsgroup-scored nil)
   (gnus-possibly-score-headers)
-  (gnus-score-update-lines))
+  (gnus-score-update-all-lines))
   
 (defun gnus-score-flush-cache ()
   "Flush the cache of score files."
   (interactive)
-  (setq gnus-score-cache nil)
+  (setq gnus-score-cache nil
+	gnus-short-name-score-file-cache nil)
   (gnus-message 6 "The score cache is now flushed"))
 
+(gnus-add-shutdown 'gnus-score-close 'gnus)
+
 (defun gnus-score-close ()
   "Clear all internal score variables."
   (setq gnus-score-cache nil
-	gnus-internal-global-score-files nil))
+	gnus-internal-global-score-files nil
+	gnus-score-file-list nil
+	gnus-score-file-alist-cache nil))
 
 ;; Summary score marking commands.
 
@@ -1827,7 +1992,14 @@ This mode is an extended emacs-lisp mode.
 	;; We do not use long file names, so we have to do some
 	;; directory traversing.  
 	(setq gnus-score-file-list 
-	      (cons nil (gnus-score-score-files-1 gnus-kill-files-directory)))
+	      (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))
@@ -1846,16 +2018,20 @@ This mode is an extended emacs-lisp mode.
   (let ((files (directory-files (expand-file-name dir) t nil t))
 	(regexp (gnus-score-file-regexp))
 	out file)
-    (while files
-      (setq file (pop files))
+    (while (setq file (pop files))
       (cond 
+       ;; Ignore "." and "..".
        ((string-match "/\\.\\.?\\'" 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))))
-    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."
@@ -1872,6 +2048,7 @@ GROUP using BNews sys file syntax."
 		    (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*"))
@@ -1895,8 +2072,10 @@ GROUP using BNews sys file syntax."
 	    (delete-region (1+ (point)) (point-min)))
 	  ;; If short file names were used, we have to translate slashes.
 	  (goto-char (point-min))
-	  (while (re-search-forward "[/:]" nil t)
-	    (replace-match "." t t))
+	  (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]+\\+")
@@ -1935,7 +2114,8 @@ GROUP using BNews sys file syntax."
 
 (defun gnus-score-find-single (group)
   "Return list containing the score file for GROUP."
-  (list (gnus-score-file-name group gnus-adaptive-file-suffix)
+  (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)
@@ -1965,21 +2145,21 @@ The list is determined from the variable gnus-score-file-alist."
 	(cdr score-files)		;ensures caching groups with no matches
       ;; handle the multiple match alist
       (while alist
-	(and (string-match (car (car alist)) group)
+	(and (string-match (caar alist) group)
 	     (setq score-files
-		   (nconc score-files (copy-sequence (cdr (car alist))))))
+		   (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 (car (car alist)) group)
+	(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 (cdr (car alist)))))
+		     (nconc score-files (copy-sequence (cdar alist))))
 	       (setq alist nil)))
 	(setq alist (cdr alist)))
       ;; cache the score files
@@ -2016,22 +2196,23 @@ The list is determined from the variable gnus-score-file-alist."
 (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)))
-    (cond 
-     ((or (null newsgroup)
-	  (string-equal newsgroup ""))
-      ;; The global score file is placed at top of the directory.
-      (expand-file-name 
-       suffix (or gnus-kill-files-directory "~/News")))
-     ((gnus-use-long-file-name 'not-score)
-      ;; Append ".SCORE" to newsgroup name.
-      (expand-file-name (concat (gnus-newsgroup-saveable-name newsgroup)
-				"." suffix)
-			(or gnus-kill-files-directory "~/News")))
-     (t
-      ;; Place "SCORE" under the hierarchical directory.
-      (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
-				"/" suffix)
-			(or gnus-kill-files-directory "~/News"))))))
+    (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 (or gnus-kill-files-directory "~/News")))
+      ((gnus-use-long-file-name 'not-score)
+       ;; Append ".SCORE" to newsgroup name.
+       (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
+				 "." suffix)
+			 (or gnus-kill-files-directory "~/News")))
+      (t
+       ;; Place "SCORE" under the hierarchical directory.
+       (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
+				 "/" suffix)
+			 (or gnus-kill-files-directory "~/News")))))))
 
 (defun gnus-score-search-global-directories (files)
   "Scan all global score directories for score files."
@@ -2048,6 +2229,14 @@ The list is determined from the variable gnus-score-file-alist."
       (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
+      (message "New score file entries will be case insensitive.")
+    (message "New score file entries will be case sensitive.")))
+
 (provide 'gnus-score)
 
 ;;; gnus-score.el ends here