*** empty log message ***

[gnus] / lisp / gnus-score.el

diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index a2616b6..4e7b0ba 100644 (file)
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -1,8 +1,8 @@
-1;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;;; gnus-score.el --- scoring code for Gnus
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.

 
 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
 
 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>

-;;     Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;;     Lars Magne Ingebrigtsen <larsi@gnus.org>

 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.


@@ -32,6 +32,7 @@
 (require 'gnus-sum)
 (require 'gnus-range)
 (require 'message)
 (require 'gnus-sum)
 (require 'gnus-range)
 (require 'message)

+(require 'score-mode)

 
 (defcustom gnus-global-score-files nil
   "List of global score files and directories.
 
 (defcustom gnus-global-score-files nil
   "List of global score files and directories.


@@ -107,7 +108,11 @@ 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
 
 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."
+score alists.
+
+If functions other than these pre-defined functions are used,
+the `a' symbolic prefix to the score commands will always use
+\"all.SCORE\"."

   :group 'gnus-score-files
   :type '(radio (function-item gnus-score-find-single)
                (function-item gnus-score-find-hierarchical)
   :group 'gnus-score-files
   :type '(radio (function-item gnus-score-find-single)
                (function-item gnus-score-find-hierarchical)


@@ -195,8 +200,8 @@ It can be:
   :type '(choice string
                 (repeat (choice string
                                 (cons regexp (repeat file))
   :type '(choice string
                 (repeat (choice string
                                 (cons regexp (repeat file))

-                                function))
-                function))
+                                (function :value fun)))
+                (function :value fun)))

 
 (defcustom gnus-home-adapt-file nil
   "Variable to control where new adaptive score entries are to go.
 
 (defcustom gnus-home-adapt-file nil
   "Variable to control where new adaptive score entries are to go.


@@ -206,8 +211,8 @@ This variable allows the same syntax as `gnus-home-score-file'."
   :type '(choice string
                 (repeat (choice string
                                 (cons regexp (repeat file))
   :type '(choice string
                 (repeat (choice string
                                 (cons regexp (repeat file))

-                                function))
-                function))
+                                (function :value fun)))
+                (function :value fun)))

 
 (defcustom gnus-default-adaptive-score-alist
   '((gnus-kill-file-mark)
 
 (defcustom gnus-default-adaptive-score-alist
   '((gnus-kill-file-mark)


@@ -216,7 +221,7 @@ This variable allows the same syntax as `gnus-home-score-file'."
     (gnus-catchup-mark (subject -10))
     (gnus-killed-mark (from -1) (subject -20))
     (gnus-del-mark (from -2) (subject -15)))
     (gnus-catchup-mark (subject -10))
     (gnus-killed-mark (from -1) (subject -20))
     (gnus-del-mark (from -2) (subject -15)))

-"Alist of marks and scores."
+"*Alist of marks and scores."

 :group 'gnus-score-adapt
 :type '(repeat (cons (symbol :tag "Mark")
                     (repeat (list (choice :tag "Header"
 :group 'gnus-score-adapt
 :type '(repeat (cons (symbol :tag "Mark")
                     (repeat (list (choice :tag "Header"


@@ -245,7 +250,7 @@ This variable allows the same syntax as `gnus-home-score-file'."
     "being" "current" "back" "still" "go" "point" "value" "each" "did"
     "both" "true" "off" "say" "another" "state" "might" "under" "start"
     "try" "re")
     "being" "current" "back" "still" "go" "point" "value" "each" "did"
     "both" "true" "off" "say" "another" "state" "might" "under" "start"
     "try" "re")

-  "Default list of words to be ignored when doing adaptive word scoring."
+  "*Default list of words to be ignored when doing adaptive word scoring."

   :group 'gnus-score-adapt
   :type '(repeat string))
 
   :group 'gnus-score-adapt
   :type '(repeat string))
 


@@ -254,7 +259,7 @@ This variable allows the same syntax as `gnus-home-score-file'."
     (,gnus-catchup-mark . -10)
     (,gnus-killed-mark . -20)
     (,gnus-del-mark . -15))
     (,gnus-catchup-mark . -10)
     (,gnus-killed-mark . -20)
     (,gnus-del-mark . -15))

-"Alist of marks and scores."
+"*Alist of marks and scores."

 :group 'gnus-score-adapt
 :type '(repeat (cons (character :tag "Mark")
                     (integer :tag "Score"))))
 :group 'gnus-score-adapt
 :type '(repeat (cons (character :tag "Mark")
                     (integer :tag "Score"))))


@@ -264,6 +269,11 @@ This variable allows the same syntax as `gnus-home-score-file'."
   :group 'gnus-score-adapt
   :type '(choice (const nil) integer))
 
   :group 'gnus-score-adapt
   :type '(choice (const nil) integer))
 

+(defcustom gnus-adaptive-word-no-group-words nil
+  "If t, don't adaptively score words included in the group name."
+  :group 'gnus-score-adapt
+  :type 'boolean)
+

 (defcustom gnus-score-mimic-keymap nil
   "*Have the score entry functions pretend that they are a keymap."
   :group 'gnus-score-default
 (defcustom gnus-score-mimic-keymap nil
   "*Have the score entry functions pretend that they are a keymap."
   :group 'gnus-score-default


@@ -298,6 +308,7 @@ Should be one of the following symbols.
  i: message-id
  t: references
  x: xref
  i: message-id
  t: references
  x: xref

+ e: `extra' (non-standard overview)

  l: lines
  d: date
  f: followup
  l: lines
  d: date
  f: followup


@@ -311,6 +322,7 @@ If nil, the user will be asked for a header."
                 (const :tag "message-id" i)
                 (const :tag "references" t)
                 (const :tag "xref" x)
                 (const :tag "message-id" i)
                 (const :tag "references" t)
                 (const :tag "xref" x)

+                (const :tag "extra" e)

                 (const :tag "lines" l)
                 (const :tag "date" d)
                 (const :tag "followup" f)
                 (const :tag "lines" l)
                 (const :tag "date" d)
                 (const :tag "followup" f)


@@ -326,7 +338,7 @@ Should be one of the following symbols.
  f: fuzzy string
  r: regexp string
  b: before date
  f: fuzzy string
  r: regexp string
  b: before date

- a: at date
+ a: after date

  n: this date
  <: less than number
  >: greater than number
  n: this date
  <: less than number
  >: greater than number


@@ -339,7 +351,7 @@ If nil, the user will be asked for a match type."
                 (const :tag "fuzzy string" f)
                 (const :tag "regexp string" r)
                 (const :tag "before date" b)
                 (const :tag "fuzzy string" f)
                 (const :tag "regexp string" r)
                 (const :tag "before date" b)

-                (const :tag "at date" a)
+                (const :tag "after date" a)

                 (const :tag "this date" n)
                 (const :tag "less than number" <)
                 (const :tag "greater than number" >)
                 (const :tag "this date" n)
                 (const :tag "less than number" <)
                 (const :tag "greater than number" >)


@@ -372,6 +384,11 @@ If nil, the user will be asked for a duration."
   :group 'gnus-score-files
   :type 'function)
 
   :group 'gnus-score-files
   :type 'function)
 

+(defcustom gnus-score-thread-simplify nil
+  "If non-nil, subjects will simplified as in threading."
+  :group 'gnus-score-various
+  :type 'boolean)
+

 \f
 
 ;; Internal variables.
 \f
 
 ;; Internal variables.


@@ -429,6 +446,7 @@ of the last successful match.")
     ("chars" 6 gnus-score-integer)
     ("lines" 7 gnus-score-integer)
     ("xref" 8 gnus-score-string)
     ("chars" 6 gnus-score-integer)
     ("lines" 7 gnus-score-integer)
     ("xref" 8 gnus-score-string)

+    ("extra" 9 gnus-score-string)

     ("head" -1 gnus-score-body)
     ("body" -1 gnus-score-body)
     ("all" -1 gnus-score-body)
     ("head" -1 gnus-score-body)
     ("body" -1 gnus-score-body)
     ("all" -1 gnus-score-body)


@@ -439,7 +457,6 @@ of the last successful match.")
 
 (gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
   "s" gnus-summary-set-score
 
 (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
   "C" gnus-score-customize
   "S" gnus-summary-current-score
   "c" gnus-score-change-score-file
   "C" gnus-score-customize


@@ -485,13 +502,14 @@ used as score."
            (?s "subject" nil nil string)
            (?b "body" "" nil body-string)
            (?h "head" "" nil body-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)
+           (?i "message-id" nil nil string)
+           (?r "references" "message-id" nil string)

            (?x "xref" nil nil string)
            (?x "xref" nil nil string)

+           (?e "extra" nil nil string)

            (?l "lines" nil nil number)
            (?d "date" nil nil date)
            (?f "followup" nil nil string)
            (?l "lines" nil nil number)
            (?d "date" nil nil date)
            (?f "followup" nil nil string)

-           (?T "thread" nil nil string)))
+           (?t "thread" "message-id" nil string)))

         (char-to-type
          '((?s s "substring" string)
            (?e e "exact string" string)
         (char-to-type
          '((?s s "substring" string)
            (?e e "exact string" string)


@@ -500,8 +518,8 @@ used as score."
            (?z s "substring" body-string)
            (?p r "regexp string" body-string)
            (?b before "before date" date)
            (?z s "substring" body-string)
            (?p r "regexp string" body-string)
            (?b before "before date" date)

-           (?a at "at date" date)
-           (?n now "this date" date)
+           (?a after "after date" date)
+           (?n at "this date" date)

            (?< < "less than number" number)
            (?> > "greater than number" number)
            (?= = "equal to number" number)))
            (?< < "less than number" number)
            (?> > "greater than number" number)
            (?= = "equal to number" number)))


@@ -516,7 +534,7 @@ used as score."
                     (aref (symbol-name gnus-score-default-type) 0)))
         (pchar (and gnus-score-default-duration
                     (aref (symbol-name gnus-score-default-duration) 0)))
                     (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)
+        entry temporary type match extra)

 
     (unwind-protect
        (progn
 
     (unwind-protect
        (progn


@@ -538,7 +556,7 @@ used as score."
          (gnus-score-kill-help-buffer)
          (unless (setq entry (assq (downcase hchar) char-to-header))
            (if mimic (error "%c %c" prefix hchar)
          (gnus-score-kill-help-buffer)
          (unless (setq entry (assq (downcase hchar) char-to-header))
            (if mimic (error "%c %c" prefix hchar)

-             (error "Illegal header type")))
+             (error "Invalid header type")))

 
          (when (/= (downcase hchar) hchar)
            ;; This was a majuscule, so we end reading and set the defaults.
 
          (when (/= (downcase hchar) hchar)
            ;; This was a majuscule, so we end reading and set the defaults.


@@ -571,13 +589,13 @@ used as score."
            (gnus-score-kill-help-buffer)
            (unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
              (if mimic (error "%c %c" prefix hchar)
            (gnus-score-kill-help-buffer)
            (unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
              (if mimic (error "%c %c" prefix hchar)

-               (error "Illegal match type"))))
+               (error "Invalid match type"))))

 
          (when (/= (downcase tchar) tchar)
            ;; It was a majuscule, so we end reading and use the default.
            (if mimic (message "%c %c %c" prefix hchar tchar)
              (message ""))
 
          (when (/= (downcase tchar) tchar)
            ;; It was a majuscule, so we end reading and use the default.
            (if mimic (message "%c %c %c" prefix hchar tchar)
              (message ""))

-           (setq pchar (or pchar ?p)))
+           (setq pchar (or pchar ?t)))

 
          ;; We continue reading.
          (while (not pchar)
 
          ;; We continue reading.
          (while (not pchar)


@@ -604,13 +622,30 @@ used as score."
              (error "You rang?"))
            (if mimic
                (error "%c %c %c %c" prefix hchar tchar pchar)
              (error "You rang?"))
            (if mimic
                (error "%c %c %c %c" prefix hchar tchar pchar)

-             (error "Illegal match duration"))))
+             (error "Invalid match duration"))))

       ;; Always kill the score help buffer.
       (gnus-score-kill-help-buffer))
 
       ;; Always kill the score help buffer.
       (gnus-score-kill-help-buffer))
 

+    ;; If scoring an extra (non-standard overview) header,
+    ;; we must find out which header is in question.
+    (setq extra
+         (and gnus-extra-headers
+              (equal (nth 1 entry) "extra")
+              (intern                  ; need symbol
+               (gnus-completing-read
+                (symbol-name (car gnus-extra-headers)) ; default response
+                "Score extra header:"  ; prompt
+                (mapcar (lambda (x)    ; completion list
+                          (cons (symbol-name x) x))
+                        gnus-extra-headers)
+                nil                    ; no completion limit
+                t))))                  ; require match
+    ;; extra is now nil or a symbol.
+

     ;; We have all the data, so we enter this score.
     (setq match (if (string= (nth 2 entry) "") ""
     ;; 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)))))
+                 (gnus-summary-header (or (nth 2 entry) (nth 1 entry))
+                                      nil extra)))

 
     ;; Modify the match, perhaps.
     (cond
 
     ;; Modify the match, perhaps.
     (cond


@@ -628,8 +663,16 @@ used as score."
       (save-excursion
        (set-buffer gnus-summary-buffer)
        (gnus-score-load-file
       (save-excursion
        (set-buffer gnus-summary-buffer)
        (gnus-score-load-file

-        (gnus-score-file-name "all"))))
-    
+        ;; This is a kludge; yes...
+        (cond
+         ((eq gnus-score-find-score-files-function
+              'gnus-score-find-hierarchical)
+          (gnus-score-file-name ""))
+         ((eq gnus-score-find-score-files-function 'gnus-score-find-single)
+          current-score-file)
+         (t
+          (gnus-score-file-name "all"))))))
+

     (gnus-summary-score-entry
      (nth 1 entry)                     ; Header
      match                             ; Match
     (gnus-summary-score-entry
      (nth 1 entry)                     ; Header
      match                             ; Match


@@ -638,7 +681,9 @@ used as score."
      (if (eq temporary 'perm)          ; Temp
         nil
        temporary)
      (if (eq temporary 'perm)          ; Temp
         nil
        temporary)

-     (not (nth 3 entry)))              ; Prompt
+     (not (nth 3 entry))               ; Prompt
+     nil                               ; not silent
+     extra)                            ; non-standard overview.

 
     (when (eq symp 'a)
       ;; We change the score file back to the previous one.
 
     (when (eq symp 'a)
       ;; We change the score file back to the previous one.


@@ -649,8 +694,8 @@ used as score."
 (defun gnus-score-insert-help (string alist idx)
   (setq gnus-score-help-winconf (current-window-configuration))
   (save-excursion
 (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))
+    (set-buffer (gnus-get-buffer-create "*Score Help*"))
+    (buffer-disable-undo)

     (delete-windows-on (current-buffer))
     (erase-buffer)
     (insert string ":\n\n")
     (delete-windows-on (current-buffer))
     (erase-buffer)
     (insert string ":\n\n")


@@ -687,14 +732,16 @@ used as score."
       (shrink-window-if-larger-than-buffer))
     (select-window (get-buffer-window gnus-summary-buffer))))
 
       (shrink-window-if-larger-than-buffer))
     (select-window (get-buffer-window gnus-summary-buffer))))
 

-(defun gnus-summary-header (header &optional no-err)
+(defun gnus-summary-header (header &optional no-err extra)

   ;; 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))
   ;; 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 extra                   ; `header' must be "extra"
+               (or (cdr (assq extra (mail-header-extra headers))) "")
+             (aref headers (nth 1 (assoc header gnus-header-index))))

          (if no-err
              nil
            (error "Pseudo-articles can't be scored")))
          (if no-err
              nil
            (error "Pseudo-articles can't be scored")))


@@ -720,7 +767,7 @@ used as score."
                  (gnus-newsgroup-score-alist)))))
 
 (defun gnus-summary-score-entry (header match type score date
                  (gnus-newsgroup-score-alist)))))
 
 (defun gnus-summary-score-entry (header match type score date

-                                       &optional prompt silent)
+                                       &optional prompt silent extra)

   "Enter score file entry.
 HEADER is the header being scored.
 MATCH is the string we are looking for.
   "Enter score file entry.
 HEADER is the header being scored.
 MATCH is the string we are looking for.


@@ -728,21 +775,8 @@ 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.
 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))))
+If optional argument `SILENT' is nil, show effect of score entry.
+If optional argument `EXTRA' is non-nil, it's a non-standard overview header."

   ;; Regexp is the default type.
   (when (eq type t)
     (setq type 'r))
   ;; Regexp is the default type.
   (when (eq type t)
     (setq type 'r))


@@ -783,12 +817,17 @@ If optional argument `SILENT' is nil, show effect of score entry."
            elem)
        (setq new
              (cond
            elem)
        (setq new
              (cond

+              (extra
+               (list match score
+                     (and date (if (numberp date) date
+                                 (date-to-day date)))
+                     type (symbol-name extra)))

               (type
                (list match score
                      (and date (if (numberp date) date
               (type
                (list match score
                      (and date (if (numberp date) date

-                                 (gnus-day-number date)))
+                                 (date-to-day date)))

                      type))
                      type))

-              (date (list match score (gnus-day-number date)))
+              (date (list match score (date-to-day date)))

               (score (list match score))
               (t (list match))))
        ;; We see whether we can collapse some score entries.
               (score (list match score))
               (t (list match))))
        ;; We see whether we can collapse some score entries.


@@ -805,7 +844,7 @@ 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.
                                  (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 header (if old (cons new old) (list new)) nil t))

        (gnus-score-set 'touched '(t))))
 
     ;; Score the current buffer.
        (gnus-score-set 'touched '(t))))
 
     ;; Score the current buffer.


@@ -813,18 +852,19 @@ If optional argument `SILENT' is nil, show effect of score entry."
       (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
               (eq (nth 2 (assoc header gnus-header-index))
                   'gnus-score-string))
       (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-score-effect header match type score extra)

        (gnus-summary-rescore)))
 
     ;; Return the new scoring rule.
     new))
 
        (gnus-summary-rescore)))
 
     ;; Return the new scoring rule.
     new))
 

-(defun gnus-summary-score-effect (header match type score)
+(defun gnus-summary-score-effect (header match type score extra)

   "Simulate the effect of a score file entry.
 HEADER is the header being scored.
 MATCH is the string we are looking for.
 TYPE is the score type.
   "Simulate the effect of a score file entry.
 HEADER is the header being scored.
 MATCH is the string we are looking for.
 TYPE is the score type.

-SCORE is the score to add."
+SCORE is the score to add.
+EXTRA is the possible non-standard header."

   (interactive (list (completing-read "Header: "
                                      gnus-header-index
                                      (lambda (x) (fboundp (nth 2 x)))
   (interactive (list (completing-read "Header: "
                                      gnus-header-index
                                      (lambda (x) (fboundp (nth 2 x)))


@@ -845,7 +885,7 @@ SCORE is the score to add."
                        (t
                         (regexp-quote match)))))
       (while (not (eobp))
                        (t
                         (regexp-quote match)))))
       (while (not (eobp))

-       (let ((content (gnus-summary-header header 'noerr))
+       (let ((content (gnus-summary-header header 'noerr extra))

              (case-fold-search t))
          (and content
               (when (if (eq type 'f)
              (case-fold-search t))
          (and content
               (when (if (eq type 'f)


@@ -955,7 +995,7 @@ SCORE is the score to add."
             "references" id 's
             score (current-time-string))))))))
 
             "references" id 's
             score (current-time-string))))))))
 

-(defun gnus-score-set (symbol value &optional alist)
+(defun gnus-score-set (symbol value &optional alist warn)

   ;; Set SYMBOL to VALUE in ALIST.
   (let* ((alist
          (or alist
   ;; Set SYMBOL to VALUE in ALIST.
   (let* ((alist
          (or alist


@@ -964,7 +1004,8 @@ SCORE is the score to add."
         (entry (assoc symbol alist)))
     (cond ((gnus-score-get 'read-only alist)
           ;; This is a read-only score file, so we do nothing.
         (entry (assoc symbol alist)))
     (cond ((gnus-score-get 'read-only alist)
           ;; This is a read-only score file, so we do nothing.

-          )
+          (when warn
+            (gnus-message 4 "Note: read-only score file; entry discarded")))

          (entry
           (setcdr entry value))
          ((null alist)
          (entry
           (setcdr entry value))
          ((null alist)


@@ -987,7 +1028,7 @@ SCORE is the score to add."
     (let ((buffer-read-only nil))
       ;; Set score.
       (gnus-summary-update-mark
     (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)) ? ;Whitespace

         (if (< n (or gnus-summary-default-score 0))
             gnus-score-below-mark gnus-score-over-mark))
        'score))
         (if (< n (or gnus-summary-default-score 0))
             gnus-score-below-mark gnus-score-over-mark))
        'score))


@@ -1051,8 +1092,9 @@ SCORE is the score to add."
   ;; Load score file FILE.  Returns a list a retrieved score-alists.
   (let* ((file (expand-file-name
                (or (and (string-match
   ;; 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))
+                         (concat "^" (regexp-quote
+                                      (expand-file-name
+                                       gnus-kill-files-directory)))

                          (expand-file-name file))
                         file)
                    (concat (file-name-as-directory gnus-kill-files-directory)
                          (expand-file-name file))
                         file)
                    (concat (file-name-as-directory gnus-kill-files-directory)


@@ -1079,9 +1121,13 @@ SCORE is the score to add."
          found)
       (while a
        ;; Downcase all header names.
          found)
       (while a
        ;; Downcase all header names.

-       (when (stringp (caar a))
+       (cond
+        ((stringp (caar a))

          (setcar (car a) (downcase (caar a)))
          (setq found t))
          (setcar (car a) (downcase (caar a)))
          (setq found t))

+        ;; Advanced scoring.
+        ((consp (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.
        (pop a))
       ;; If there are actual scores in the alist, we add it to the
       ;; return value of this function.


@@ -1107,7 +1153,7 @@ SCORE is the score to add."
                 (or (not decay)
                     (gnus-decay-scores alist decay)))
        (gnus-score-set 'touched '(t) alist)
                 (or (not decay)
                     (gnus-decay-scores alist decay)))
        (gnus-score-set 'touched '(t) alist)

-       (gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))
+       (gnus-score-set 'decay (list (time-to-days (current-time))) alist))

       ;; We do not respect eval and files atoms from global score
       ;; files.
       (when (and files (not global))
       ;; We do not respect eval and files atoms from global score
       ;; files.
       (when (and files (not global))


@@ -1121,12 +1167,16 @@ SCORE is the score to add."
       ;; We then expand any exclude-file directives.
       (setq gnus-scores-exclude-files
            (nconc
       ;; 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)
+            (apply
+             'nconc
+             (mapcar
+              (lambda (sfile)
+                (list
+                 (expand-file-name sfile (file-name-directory file))
+                 (expand-file-name sfile gnus-kill-files-directory)))
+              exclude-files))

             gnus-scores-exclude-files))
             gnus-scores-exclude-files))

-      (unless local
+      (when local

        (save-excursion
          (set-buffer gnus-summary-buffer)
          (while local
        (save-excursion
          (set-buffer gnus-summary-buffer)
          (while local


@@ -1184,9 +1234,9 @@ SCORE is the score to add."
        ;; Couldn't read file.
        (setq gnus-score-alist nil)
       ;; Read file.
        ;; Couldn't read file.
        (setq gnus-score-alist nil)
       ;; Read file.

-      (save-excursion
-       (gnus-set-work-buffer)
-       (insert-file-contents file)
+      (with-temp-buffer
+       (let ((coding-system-for-read score-mode-coding-system))
+         (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))
        (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))


@@ -1195,10 +1245,16 @@ SCORE is the score to add."
                    (read (current-buffer))
                  (error
                   (gnus-error 3.2 "Problem with score file %s" file))))))
                    (read (current-buffer))
                  (error
                   (gnus-error 3.2 "Problem with score file %s" file))))))

-      (if (eq (car alist) 'setq)
-         ;; This is an old-style score file.
-         (setq gnus-score-alist (gnus-score-transform-old-to-new alist))
-       (setq gnus-score-alist alist))
+      (cond
+       ((and alist
+            (atom alist))
+       ;; Bogus score file.
+       (error "Invalid syntax with score file %s" file))
+       ((eq (car alist) 'setq)
+       ;; This is an old-style score file.
+       (setq gnus-score-alist (gnus-score-transform-old-to-new alist)))
+       (t
+       (setq gnus-score-alist alist)))

       ;; Check the syntax of the score file.
       (setq gnus-score-alist
            (gnus-score-check-syntax gnus-score-alist file)))))
       ;; Check the syntax of the score file.
       (setq gnus-score-alist
            (gnus-score-check-syntax gnus-score-alist file)))))


@@ -1220,11 +1276,11 @@ SCORE is the score to add."
         err
         (cond
          ((not (listp (car a)))
         err
         (cond
          ((not (listp (car a)))

-          (format "Illegal score element %s in %s" (car a) file))
+          (format "Invalid score element %s in %s" (car a) file))

          ((stringp (caar a))
           (cond
            ((not (listp (setq sr (cdar a))))
          ((stringp (caar a))
           (cond
            ((not (listp (setq sr (cdar a))))

-            (format "Illegal header match %s in %s" (nth 1 (car a)) file))
+            (format "Invalid header match %s in %s" (nth 1 (car a)) file))

            (t
             (setq type (caar a))
             (while (and sr (not err))
            (t
             (setq type (caar a))
             (while (and sr (not err))


@@ -1235,7 +1291,7 @@ SCORE is the score to add."
                 ((if (member (downcase type) '("lines" "chars"))
                      (not (numberp (car s)))
                    (not (stringp (car s))))
                 ((if (member (downcase type) '("lines" "chars"))
                      (not (numberp (car s)))
                    (not (stringp (car s))))

-                 (format "Illegal match %s in %s" (car s) file))
+                 (format "Invalid 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))))
                 ((and (cadr s) (not (integerp (cadr s))))
                  (format "Non-integer score %s in %s" (cadr s) file))
                 ((and (caddr s) (not (integerp (caddr s))))


@@ -1266,7 +1322,7 @@ SCORE is the score to add."
              (setcar scor
                      (list (caar scor) (nth 2 (car scor))
                            (and (nth 3 (car scor))
              (setcar scor
                      (list (caar scor) (nth 2 (car scor))
                            (and (nth 3 (car scor))

-                                (gnus-day-number (nth 3 (car scor))))
+                                (date-to-day (nth 3 (car scor))))

                            (if (nth 1 (car scor)) 'r 's)))
              (setq scor (cdr scor))))
        (push (if (not (listp (cdr entry)))
                            (if (nth 1 (car scor)) 'r 's)))
              (setq scor (cdr scor))))
        (push (if (not (listp (cdr entry)))


@@ -1286,14 +1342,14 @@ SCORE is the score to add."
       (while cache
        (current-buffer)
        (setq entry (pop cache)
       (while cache
        (current-buffer)
        (setq entry (pop cache)

-             file (car entry)
+             file (nnheader-translate-file-chars (car entry) t)

              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))))
            ()
              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)))
+         (setq score (setcdr entry (gnus-delete-alist 'touched score)))

          (erase-buffer)
          (let (emacs-lisp-mode-hook)
            (if (string-match
          (erase-buffer)
          (let (emacs-lisp-mode-hook)
            (if (string-match


@@ -1305,14 +1361,16 @@ SCORE is the score to add."
                (gnus-prin1 score)
              ;; This is a normal score file, so we print it very
              ;; prettily.
                (gnus-prin1 score)
              ;; This is a normal score file, so we print it very
              ;; prettily.

-             (pp score (current-buffer))))
+             (let ((lisp-mode-syntax-table score-mode-syntax-table))
+               (pp score (current-buffer)))))

          (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)
          (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)

-             (gnus-write-buffer file)
+             (let ((coding-system-for-write score-mode-coding-system))
+               (gnus-write-buffer file))

              (when gnus-score-after-write-file-function
                (funcall gnus-score-after-write-file-function file)))))
        (and gnus-score-uncacheable-files
              (when gnus-score-after-write-file-function
                (funcall gnus-score-after-write-file-function file)))))
        (and gnus-score-uncacheable-files


@@ -1360,7 +1418,7 @@ SCORE is the score to add."
       (when (and gnus-summary-default-score
                 scores)
        (let* ((entries gnus-header-index)
       (when (and gnus-summary-default-score
                 scores)
        (let* ((entries gnus-header-index)

-              (now (gnus-day-number (current-time-string)))
+              (now (date-to-day (current-time-string)))

               (expire (and gnus-score-expiry-days
                            (- now gnus-score-expiry-days)))
               (headers gnus-newsgroup-headers)
               (expire (and gnus-score-expiry-days
                            (- now gnus-score-expiry-days)))
               (headers gnus-newsgroup-headers)


@@ -1378,8 +1436,8 @@ SCORE is the score to add."
                          gnus-scores-articles))))
 
          (save-excursion
                          gnus-scores-articles))))
 
          (save-excursion

-           (set-buffer (get-buffer-create "*Headers*"))
-           (buffer-disable-undo (current-buffer))
+           (set-buffer (gnus-get-buffer-create "*Headers*"))
+           (buffer-disable-undo)

            (when (gnus-buffer-live-p gnus-summary-buffer)
              (message-clone-locals gnus-summary-buffer))
 
            (when (gnus-buffer-live-p gnus-summary-buffer)
              (message-clone-locals gnus-summary-buffer))
 


@@ -1419,7 +1477,7 @@ SCORE is the score to add."
          (let (score)
            (while (setq score (pop scores))
              (while score
          (let (score)
            (while (setq score (pop scores))
              (while score

-               (when (listp (caar score))
+               (when (consp (caar score))

                  (gnus-score-advanced (car score) trace))
                (pop score))))
 
                  (gnus-score-advanced (car score) trace))
                (pop score))))
 


@@ -1514,7 +1572,7 @@ SCORE is the score to add."
               (match-func (if (or (eq type '>) (eq type '<) (eq type '<=)
                                   (eq type '>=) (eq type '=))
                               type
               (match-func (if (or (eq type '>) (eq type '<) (eq type '<=)
                                   (eq type '>=) (eq type '=))
                               type

-                            (error "Illegal match type: %s" type)))
+                            (error "Invalid 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,
               (articles gnus-scores-articles))
          ;; Instead of doing all the clever stuff that
          ;; `gnus-score-string' does to minimize searches and stuff,


@@ -1574,7 +1632,7 @@ SCORE is the score to add."
           ((eq type 'regexp)
            (setq match-func 'string-match
                  match (nth 0 kill)))
           ((eq type 'regexp)
            (setq match-func 'string-match
                  match (nth 0 kill)))

-          (t (error "Illegal match type: %s" type)))
+          (t (error "Invalid match type: %s" type)))

          ;; Instead of doing all the clever stuff that
          ;; `gnus-score-string' does to minimize searches and stuff,
          ;; I will assume that people generally will put so few
          ;; 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


@@ -1632,7 +1690,7 @@ SCORE is the score to add."
            (setq request-func 'gnus-request-article))
          (while articles
            (setq article (mail-header-number (caar articles)))
            (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)
+           (gnus-message 7 "Scoring article %s of %s..." article last)

            (when (funcall request-func article gnus-newsgroup-name)
              (widen)
              (goto-char (point-min))
            (when (funcall request-func article gnus-newsgroup-name)
              (widen)
              (goto-char (point-min))


@@ -1672,7 +1730,7 @@ SCORE is the score to add."
                                     (eq type 'string) (eq type 'String))
                                 'search-forward)
                                (t
                                     (eq type 'string) (eq type 'String))
                                 'search-forward)
                                (t

-                                (error "Illegal match type: %s" type)))))
+                                (error "Invalid match type: %s" type)))))

                    (goto-char (point-min))
                    (when (funcall search-func match nil t)
                      ;; Found a match, update scores.
                    (goto-char (point-min))
                    (when (funcall search-func match nil t)
                      ;; Found a match, update scores.


@@ -1758,7 +1816,7 @@ SCORE is the score to add."
               (search-func
                (cond ((= dmt ?r) 're-search-forward)
                      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
               (search-func
                (cond ((= dmt ?r) 're-search-forward)
                      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)

-                     (t (error "Illegal match type: %s" type))))
+                     (t (error "Invalid match type: %s" type))))

               arts art)
          (goto-char (point-min))
          (if (= dmt ?e)
               arts art)
          (goto-char (point-min))
          (if (= dmt ?e)


@@ -1828,6 +1886,8 @@ SCORE is the score to add."
   ;; Insert the unique article headers in the buffer.
   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
        ;; gnus-score-index is used as a free variable.
   ;; Insert the unique article headers in the buffer.
   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
        ;; gnus-score-index is used as a free variable.

+        (simplify (and gnus-score-thread-simplify
+                       (string= "subject" header)))

        alike last this art entries alist articles
        fuzzies arts words kill)
 
        alike last this art entries alist articles
        fuzzies arts words kill)
 


@@ -1837,12 +1897,25 @@ SCORE is the score to add."
     ;; 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.
     ;; 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<)
+    (setq gnus-scores-articles
+         ;; We cannot string-sort the extra headers list.  *sigh*
+         (if (= gnus-score-index 9)
+             gnus-scores-articles
+           (sort gnus-scores-articles 'gnus-score-string<))

          articles gnus-scores-articles)
 
     (erase-buffer)
     (while (setq art (pop articles))
       (setq this (aref (car art) gnus-score-index))
          articles gnus-scores-articles)
 
     (erase-buffer)
     (while (setq art (pop articles))
       (setq this (aref (car art) gnus-score-index))

+
+      ;; If we're working with non-standard headers, we are stuck
+      ;; with working on them as a group.  What a hassle.
+      ;; Just wait 'til you see what horrors we commit against `match'...
+      (if (= gnus-score-index 9)
+         (setq this (prin1-to-string this)))   ; ick.
+
+      (if simplify
+         (setq this (gnus-map-function gnus-simplify-subject-functions this)))

       (if (equal last this)
          ;; O(N*H) cons-cells used here, where H is the number of
          ;; headers.
       (if (equal last this)
          ;; O(N*H) cons-cells used here, where H is the number of
          ;; headers.


@@ -1868,26 +1941,41 @@ SCORE is the score to add."
            entries (assoc header alist))
       (while (cdr entries)             ;First entry is the header index.
        (let* ((kill (cadr entries))
            entries (assoc header alist))
       (while (cdr entries)             ;First entry is the header index.
        (let* ((kill (cadr entries))

-              (match (nth 0 kill))

               (type (or (nth 3 kill) 's))
               (score (or (nth 1 kill) gnus-score-interactive-default-score))
               (date (nth 2 kill))
               (type (or (nth 3 kill) 's))
               (score (or (nth 1 kill) gnus-score-interactive-default-score))
               (date (nth 2 kill))

+              (extra (nth 4 kill))     ; non-standard header; string.

               (found nil)
               (mt (aref (symbol-name type) 0))
               (case-fold-search (not (memq mt '(?R ?S ?E ?F))))
               (dmt (downcase mt))
               (found nil)
               (mt (aref (symbol-name type) 0))
               (case-fold-search (not (memq mt '(?R ?S ?E ?F))))
               (dmt (downcase mt))

+              ;; Assume user already simplified regexp and fuzzies
+              (match (if (and simplify (not (memq dmt '(?f ?r))))
+                          (gnus-map-function
+                           gnus-simplify-subject-functions
+                           (nth 0 kill))
+                        (nth 0 kill)))

               (search-func
                (cond ((= dmt ?r) 're-search-forward)
                      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
                      ((= dmt ?w) nil)
               (search-func
                (cond ((= dmt ?r) 're-search-forward)
                      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
                      ((= dmt ?w) nil)

-                     (t (error "Illegal match type: %s" type)))))
+                     (t (error "Invalid match type: %s" type)))))
+
+         ;; Evil hackery to make match usable in non-standard headers.
+         (when extra
+           (setq match (concat "[ (](" extra " \\. \"[^)]*"
+                               match "[^(]*\")[ )]")
+                 search-func 're-search-forward))      ; XXX danger?!?
+

          (cond
           ;; Fuzzy matches.  We save these for later.
           ((= dmt ?f)
          (cond
           ;; Fuzzy matches.  We save these for later.
           ((= dmt ?f)

-           (push (cons entries alist) fuzzies))
+           (push (cons entries alist) fuzzies)
+           (setq entries (cdr entries)))

           ;; Word matches.  Save these for even later.
           ((= dmt ?w)
           ;; Word matches.  Save these for even later.
           ((= dmt ?w)

-           (push (cons entries alist) words))
+           (push (cons entries alist) words)
+           (setq entries (cdr entries)))

           ;; Exact matches.
           ((= dmt ?e)
            ;; Do exact matching.
           ;; Exact matches.
           ((= dmt ?e)
            ;; Do exact matching.


@@ -1912,7 +2000,26 @@ SCORE is the score to add."
                            gnus-score-trace))
                       (while (setq art (pop arts))
                         (setcdr art (+ score (cdr art)))))))
                            gnus-score-trace))
                       (while (setq art (pop arts))
                         (setcdr art (+ score (cdr art)))))))

-             (forward-line 1)))
+             (forward-line 1))
+           ;; Update expiry date
+           (if trace
+               (setq entries (cdr entries))
+             (cond
+              ;; Permanent entry.
+              ((null date)
+               (setq entries (cdr entries)))
+              ;; We have a match, so we update the date.
+              ((and found gnus-update-score-entry-dates)
+               (gnus-score-set 'touched '(t) alist)
+               (setcar (nthcdr 2 kill) now)
+               (setq entries (cdr entries)))
+              ;; This entry has expired, so we remove it.
+              ((and expire (< date expire))
+               (gnus-score-set 'touched '(t) alist)
+               (setcdr entries (cddr entries)))
+              ;; No match; go to next entry.
+              (t
+               (setq entries (cdr entries))))))

           ;; Regexp and substring matching.
           (t
            (goto-char (point-min))
           ;; Regexp and substring matching.
           (t
            (goto-char (point-min))


@@ -1931,26 +2038,26 @@ SCORE is the score to add."
                          gnus-score-trace))
                (while (setq art (pop arts))
                  (setcdr art (+ score (cdr art)))))
                          gnus-score-trace))
                (while (setq art (pop arts))
                  (setcdr art (+ score (cdr art)))))

-             (forward-line 1))))
-         ;; Update expiry date
-         (if trace
-             (setq entries (cdr entries))
-           (cond
-            ;; Permanent entry.
-            ((null date)
-             (setq entries (cdr entries)))
-            ;; We have a match, so we update the date.
-            ((and found gnus-update-score-entry-dates)
-             (gnus-score-set 'touched '(t) alist)
-             (setcar (nthcdr 2 kill) now)
-             (setq entries (cdr entries)))
-            ;; This entry has expired, so we remove it.
-            ((and expire (< date expire))
-             (gnus-score-set 'touched '(t) alist)
-             (setcdr entries (cddr entries)))
-            ;; No match; go to next entry.
-            (t
-             (setq entries (cdr entries))))))))
+             (forward-line 1))
+           ;; Update expiry date
+           (if trace
+               (setq entries (cdr entries))
+             (cond
+              ;; Permanent entry.
+              ((null date)
+               (setq entries (cdr entries)))
+              ;; We have a match, so we update the date.
+              ((and found gnus-update-score-entry-dates)
+               (gnus-score-set 'touched '(t) alist)
+               (setcar (nthcdr 2 kill) now)
+               (setq entries (cdr entries)))
+              ;; This entry has expired, so we remove it.
+              ((and expire (< date expire))
+               (gnus-score-set 'touched '(t) alist)
+               (setcdr entries (cddr entries)))
+              ;; No match; go to next entry.
+              (t
+               (setq entries (cdr entries))))))))))

 
     ;; Find fuzzy matches.
     (when fuzzies
 
     ;; Find fuzzy matches.
     (when fuzzies


@@ -1982,18 +2089,19 @@ SCORE is the score to add."
                  (setcdr art (+ score (cdr art))))))
            (forward-line 1))
          ;; Update expiry date
                  (setcdr art (+ score (cdr art))))))
            (forward-line 1))
          ;; Update expiry date

-         (cond
-          ;; Permanent.
-          ((null date)
-           )
-          ;; Match, update date.
-          ((and found gnus-update-score-entry-dates)
-           (gnus-score-set 'touched '(t) (cdar fuzzies))
-           (setcar (nthcdr 2 kill) now))
-          ;; Old entry, remove.
-          ((and expire (< date expire))
-           (gnus-score-set 'touched '(t) (cdar fuzzies))
-           (setcdr (caar fuzzies) (cddaar fuzzies))))
+         (if (not trace)
+             (cond
+              ;; Permanent.
+              ((null date)
+               )
+              ;; Match, update date.
+              ((and found gnus-update-score-entry-dates)
+               (gnus-score-set 'touched '(t) (cdar fuzzies))
+               (setcar (nthcdr 2 kill) now))
+              ;; Old entry, remove.
+              ((and expire (< date expire))
+               (gnus-score-set 'touched '(t) (cdar fuzzies))
+               (setcdr (caar fuzzies) (cddaar fuzzies)))))

          (setq fuzzies (cdr fuzzies)))))
 
     (when words
          (setq fuzzies (cdr fuzzies)))))
 
     (when words


@@ -2019,18 +2127,19 @@ SCORE is the score to add."
                (while (setq art (pop arts))
                  (setcdr art (+ score (cdr art))))))
            ;; Update expiry date
                (while (setq art (pop arts))
                  (setcdr art (+ score (cdr art))))))
            ;; Update expiry date

-           (cond
-            ;; Permanent.
-            ((null date)
-             )
-            ;; Match, update date.
-            ((and found gnus-update-score-entry-dates)
-             (gnus-score-set 'touched '(t) (cdar words))
-             (setcar (nthcdr 2 kill) now))
-            ;; Old entry, remove.
-            ((and expire (< date expire))
-             (gnus-score-set 'touched '(t) (cdar words))
-             (setcdr (caar words) (cddaar words))))
+           (if (not trace)
+               (cond
+                ;; Permanent.
+                ((null date)
+                 )
+                ;; Match, update date.
+                ((and found gnus-update-score-entry-dates)
+                 (gnus-score-set 'touched '(t) (cdar words))
+                 (setcar (nthcdr 2 kill) now))
+                ;; Old entry, remove.
+                ((and expire (< date expire))
+                 (gnus-score-set 'touched '(t) (cdar words))
+                 (setcdr (caar words) (cddaar words)))))

            (setq words (cdr words))))))
     nil))
 
            (setq words (cdr words))))))
     nil))
 


@@ -2056,6 +2165,10 @@ SCORE is the score to add."
       (set-syntax-table syntab))
     ;; Make all the ignorable words ignored.
     (let ((ignored (append gnus-ignored-adaptive-words
       (set-syntax-table syntab))
     ;; Make all the ignorable words ignored.
     (let ((ignored (append gnus-ignored-adaptive-words

+                          (if gnus-adaptive-word-no-group-words
+                              (message-tokenize-header
+                               (gnus-group-real-name gnus-newsgroup-name)
+                               "."))

                           gnus-default-ignored-adaptive-words)))
       (while ignored
        (gnus-sethash (pop ignored) nil hashtb)))))
                           gnus-default-ignored-adaptive-words)))
       (while ignored
        (gnus-sethash (pop ignored) nil hashtb)))))


@@ -2148,9 +2261,9 @@ SCORE is the score to add."
     ;; Perform adaptive word scoring.
     (when (and (listp gnus-newsgroup-adaptive)
               (memq 'word gnus-newsgroup-adaptive))
     ;; Perform adaptive word scoring.
     (when (and (listp gnus-newsgroup-adaptive)
               (memq 'word gnus-newsgroup-adaptive))

-      (nnheader-temp-write nil
+      (with-temp-buffer

        (let* ((hashtb (gnus-make-hashtable 1000))
        (let* ((hashtb (gnus-make-hashtable 1000))

-              (date (gnus-day-number (current-time-string)))
+              (date (date-to-day (current-time-string)))

               (data gnus-newsgroup-data)
               (syntab (syntax-table))
               word d score val)
               (data gnus-newsgroup-data)
               (syntab (syntax-table))
               word d score val)


@@ -2184,6 +2297,11 @@ SCORE is the score to add."
            (set-syntax-table syntab))
          ;; Make all the ignorable words ignored.
          (let ((ignored (append gnus-ignored-adaptive-words
            (set-syntax-table syntab))
          ;; Make all the ignorable words ignored.
          (let ((ignored (append gnus-ignored-adaptive-words

+                                (if gnus-adaptive-word-no-group-words
+                                    (message-tokenize-header
+                                     (gnus-group-real-name
+                                      gnus-newsgroup-name)
+                                     "."))

                                 gnus-default-ignored-adaptive-words)))
            (while ignored
              (gnus-sethash (pop ignored) nil hashtb)))
                                 gnus-default-ignored-adaptive-words)))
            (while ignored
              (gnus-sethash (pop ignored) nil hashtb)))


@@ -2223,12 +2341,10 @@ SCORE is the score to add."
           1 "No score rules apply to the current article (default score %d)."
           gnus-summary-default-score)
        (set-buffer "*Score Trace*")
           1 "No score rules apply to the current article (default score %d)."
           gnus-summary-default-score)
        (set-buffer "*Score Trace*")

-       (gnus-add-current-to-buffer-list)
+       (setq truncate-lines t)

        (while trace
          (insert (format "%S  ->  %s\n" (cdar trace)
        (while trace
          (insert (format "%S  ->  %s\n" (cdar trace)

-                         (if (caar trace)
-                             (file-name-nondirectory (caar trace))
-                           "(non-file rule)")))
+                         (or (caar trace) "(non-file rule)")))

          (setq trace (cdr trace)))
        (goto-char (point-min))
        (gnus-configure-windows 'score-trace)))
          (setq trace (cdr trace)))
        (goto-char (point-min))
        (gnus-configure-windows 'score-trace)))


@@ -2269,7 +2385,6 @@ SCORE is the score to add."
       (while rules
        (insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
        (pop rules))
       (while rules
        (insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
        (pop rules))

-      (gnus-add-current-to-buffer-list)

       (goto-char (point-min))
       (gnus-configure-windows 'score-words))))
 
       (goto-char (point-min))
       (gnus-configure-windows 'score-words))))
 


@@ -2407,8 +2522,8 @@ SCORE is the score to add."
        seen out file)
     (while (setq file (pop files))
       (cond
        seen out file)
     (while (setq file (pop files))
       (cond

-       ;; Ignore "." and "..".
-       ((member (file-name-nondirectory file) '("." ".."))
+       ;; Ignore files that start with a dot.
+       ((string-match "^\\." (file-name-nondirectory file))

        nil)
        ;; Add subtrees of directory to also be searched.
        ((and (file-directory-p file)
        nil)
        ;; Add subtrees of directory to also be searched.
        ((and (file-directory-p file)


@@ -2438,10 +2553,11 @@ GROUP using BNews sys file syntax."
         (klen (length kill-dir))
         (score-regexp (gnus-score-file-regexp))
         (trans (cdr (assq ?: nnheader-file-name-translation-alist)))
         (klen (length kill-dir))
         (score-regexp (gnus-score-file-regexp))
         (trans (cdr (assq ?: nnheader-file-name-translation-alist)))

+        (group-trans (nnheader-translate-file-chars group t))

         ofiles not-match regexp)
     (save-excursion
         ofiles not-match regexp)
     (save-excursion

-      (set-buffer (get-buffer-create "*gnus score files*"))
-      (buffer-disable-undo (current-buffer))
+      (set-buffer (gnus-get-buffer-create "*gnus score files*"))
+      (buffer-disable-undo)

       ;; Go through all score file names and create regexp with them
       ;; as the source.
       (while sfiles
       ;; Go through all score file names and create regexp with them
       ;; as the source.
       (while sfiles


@@ -2484,16 +2600,18 @@ GROUP using BNews sys file syntax."
          (if (looking-at "not.")
              (progn
                (setq not-match t)
          (if (looking-at "not.")
              (progn
                (setq not-match t)

-               (setq regexp (concat "^" (buffer-substring 5 (point-max)) "$")))
+               (setq regexp
+                     (concat "^" (buffer-substring 5 (point-max)) "$")))

            (setq regexp (concat "^" (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.
          (when (or (and not-match
            (setq regexp (concat "^" (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.
          (when (or (and not-match

-                        (not (string-match regexp group)))
-                   (and (not not-match)
-                        (string-match regexp group)))
+                        (ignore-errors
+                          (not (string-match regexp group-trans))))
+                   (and (not not-match)
+                        (ignore-errors (string-match regexp group-trans))))

            (push (car sfiles) ofiles)))
        (setq sfiles (cdr sfiles)))
       (kill-buffer (current-buffer))
            (push (car sfiles) ofiles)))
        (setq sfiles (cdr sfiles)))
       (kill-buffer (current-buffer))


@@ -2561,7 +2679,7 @@ Destroys the current buffer."
 
 (defun gnus-sort-score-files (files)
   "Sort FILES so that the most general files come first."
 
 (defun gnus-sort-score-files (files)
   "Sort FILES so that the most general files come first."

-  (nnheader-temp-write nil
+  (with-temp-buffer

     (let ((alist
           (mapcar
            (lambda (file)
     (let ((alist
           (mapcar
            (lambda (file)


@@ -2673,8 +2791,7 @@ The list is determined from the variable gnus-score-file-alist."
       ((or (null newsgroup)
           (string-equal newsgroup ""))
        ;; The global score file is placed at top of the directory.
       ((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))
+       (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)
       ((gnus-use-long-file-name 'not-score)
        ;; Append ".SCORE" to newsgroup name.
        (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)


@@ -2693,6 +2810,7 @@ The list is determined from the variable gnus-score-file-alist."
   (interactive (list gnus-global-score-files))
   (let (out)
     (while files
   (interactive (list gnus-global-score-files))
   (let (out)
     (while files

+      ;; #### /$ Unix-specific?

       (if (string-match "/$" (car files))
          (setq out (nconc (directory-files
                            (car files) t
       (if (string-match "/$" (car files))
          (setq out (nconc (directory-files
                            (car files) t


@@ -2732,10 +2850,12 @@ If ADAPT, return the home adaptive file instead."
              (funcall elem group))
             ;; Regexp-file cons
             ((consp elem)
              (funcall elem group))
             ;; Regexp-file cons
             ((consp elem)

-             (when (string-match (car elem) group)
-               (cadr elem))))))
+             (when (string-match (gnus-globalify-regexp (car elem)) group)
+               (replace-match (cadr elem) t nil group ))))))

     (when found
     (when found

-      (nnheader-concat gnus-kill-files-directory found))))
+      (if (file-name-absolute-p found)
+          found
+        (nnheader-concat gnus-kill-files-directory found)))))

 
 (defun gnus-hierarchial-home-score-file (group)
   "Return the score file of the top-level hierarchy of GROUP."
 
 (defun gnus-hierarchial-home-score-file (group)
   "Return the score file of the top-level hierarchy of GROUP."


@@ -2753,6 +2873,10 @@ If ADAPT, return the home adaptive file instead."
     (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
            gnus-adaptive-file-suffix)))
 
     (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
            gnus-adaptive-file-suffix)))
 

+(defun gnus-current-home-score-file (group)
+  "Return the \"current\" regular score file."
+  (car (nreverse (gnus-score-find-alist group))))
+

 ;;;
 ;;; Score decays
 ;;;
 ;;;
 ;;; Score decays
 ;;;


@@ -2769,7 +2893,7 @@ If ADAPT, return the home adaptive file instead."
 
 (defun gnus-decay-scores (alist day)
   "Decay non-permanent scores in ALIST."
 
 (defun gnus-decay-scores (alist day)
   "Decay non-permanent scores in ALIST."

-  (let ((times (- (gnus-time-to-day (current-time)) day))
+  (let ((times (- (time-to-days (current-time)) day))

        kill entry updated score n)
     (unless (zerop times)              ;Done decays today already?
       (while (setq entry (pop alist))
        kill entry updated score n)
     (unless (zerop times)              ;Done decays today already?
       (while (setq entry (pop alist))


@@ -2783,7 +2907,7 @@ If ADAPT, return the home adaptive file instead."
                    n times)
              (while (natnump (decf n))
                (setq score (funcall gnus-decay-score-function score)))
                    n times)
              (while (natnump (decf n))
                (setq score (funcall gnus-decay-score-function score)))

-             (setcdr kill (cons score 
+             (setcdr kill (cons score

                                 (cdr (cdr kill)))))))))
     ;; Return whether this score file needs to be saved.  By Je-haysuss!
     updated))
                                 (cdr (cdr kill)))))))))
     ;; Return whether this score file needs to be saved.  By Je-haysuss!
     updated))