cgit.sxemacs.org Git - gnus/blob - lisp/gnus-score.el

   1 ;;; gnus-score.el --- scoring code for Gnus
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   4 ;;   2004, 2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
   7 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
   8 ;; Keywords: news
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 (eval-when-compile (require 'cl))
  32
  33 (require 'gnus)
  34 (require 'gnus-sum)
  35 (require 'gnus-range)
  36 (require 'gnus-win)
  37 (require 'message)
  38 (require 'score-mode)
  39
  40 (defcustom gnus-global-score-files nil
  41   "List of global score files and directories.
  42 Set this variable if you want to use people's score files.  One entry
  43 for each score file or each score file directory.  Gnus will decide
  44 by itself what score files are applicable to which group.
  45
  46 Say you want to use the single score file
  47 \"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
  48 score files in the \"/ftp.some-where:/pub/score\" directory.
  49
  50  (setq gnus-global-score-files
  51        '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
  52          \"/ftp.some-where:/pub/score\"))"
  53   :group 'gnus-score-files
  54   :type '(repeat file))
  55
  56 (defcustom gnus-score-file-single-match-alist nil
  57   "Alist mapping regexps to lists of score files.
  58 Each element of this alist should be of the form
  59         (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
  60
  61 If the name of a group is matched by REGEXP, the corresponding scorefiles
  62 will be used for that group.
  63 The first match found is used, subsequent matching entries are ignored (to
  64 use multiple matches, see `gnus-score-file-multiple-match-alist').
  65
  66 These score files are loaded in addition to any files returned by
  67 `gnus-score-find-score-files-function'."
  68   :group 'gnus-score-files
  69   :type '(repeat (cons regexp (repeat file))))
  70
  71 (defcustom gnus-score-file-multiple-match-alist nil
  72   "Alist mapping regexps to lists of score files.
  73 Each element of this alist should be of the form
  74         (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
  75
  76 If the name of a group is matched by REGEXP, the corresponding scorefiles
  77 will be used for that group.
  78 If multiple REGEXPs match a group, the score files corresponding to each
  79 match will be used (for only one match to be used, see
  80 `gnus-score-file-single-match-alist').
  81
  82 These score files are loaded in addition to any files returned by
  83 `gnus-score-find-score-files-function'."
  84   :group 'gnus-score-files
  85   :type '(repeat (cons regexp (repeat file))))
  86
  87 (defcustom gnus-score-file-suffix "SCORE"
  88   "Suffix of the score files."
  89   :group 'gnus-score-files
  90   :type 'string)
  91
  92 (defcustom gnus-adaptive-file-suffix "ADAPT"
  93   "Suffix of the adaptive score files."
  94   :group 'gnus-score-files
  95   :group 'gnus-score-adapt
  96   :type 'string)
  97
  98 (defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
  99   "Function used to find score files.
 100 The function will be called with the group name as the argument, and
 101 should return a list of score files to apply to that group.  The score
 102 files do not actually have to exist.
 103
 104 Predefined values are:
 105
 106 `gnus-score-find-single': Only apply the group's own score file.
 107 `gnus-score-find-hierarchical': Also apply score files from parent groups.
 108 `gnus-score-find-bnews': Apply score files whose names matches.
 109
 110 See the documentation to these functions for more information.
 111
 112 This variable can also be a list of functions to be called.  Each
 113 function is given the group name as argument and should either return
 114 a list of score files, or a list of score alists.
 115
 116 If functions other than these pre-defined functions are used,
 117 the `a' symbolic prefix to the score commands will always use
 118 \"all.SCORE\"."
 119   :group 'gnus-score-files
 120   :type '(radio (function-item gnus-score-find-single)
 121                 (function-item gnus-score-find-hierarchical)
 122                 (function-item gnus-score-find-bnews)
 123                 (repeat :tag "List of functions"
 124                         (choice (function :tag "Other" :value 'ignore)
 125                                 (function-item gnus-score-find-single)
 126                                 (function-item gnus-score-find-hierarchical)
 127                                 (function-item gnus-score-find-bnews)))
 128                 (function :tag "Other" :value 'ignore)))
 129
 130 (defcustom gnus-score-interactive-default-score 1000
 131   "*Scoring commands will raise/lower the score with this number as the default."
 132   :group 'gnus-score-default
 133   :type 'integer)
 134
 135 (defcustom gnus-score-expiry-days 7
 136   "*Number of days before unused score file entries are expired.
 137 If this variable is nil, no score file entries will be expired."
 138   :group 'gnus-score-expire
 139   :type '(choice (const :tag "never" nil)
 140                  number))
 141
 142 (defcustom gnus-update-score-entry-dates t
 143   "*If non-nil, update matching score entry dates.
 144 If this variable is nil, then score entries that provide matches
 145 will be expired along with non-matching score entries."
 146   :group 'gnus-score-expire
 147   :type 'boolean)
 148
 149 (defcustom gnus-decay-scores nil
 150   "*If non-nil, decay non-permanent scores.
 151
 152 If it is a regexp, only decay score files matching regexp."
 153   :group 'gnus-score-decay
 154   :type `(choice (const :tag "never" nil)
 155                  (const :tag "always" t)
 156                  (const :tag "adaptive score files"
 157                         ,(concat "\\." gnus-adaptive-file-suffix "\\'"))
 158                  (regexp)))
 159
 160 (defcustom gnus-decay-score-function 'gnus-decay-score
 161   "*Function called to decay a score.
 162 It is called with one parameter -- the score to be decayed."
 163   :group 'gnus-score-decay
 164   :type '(radio (function-item gnus-decay-score)
 165                 (function :tag "Other")))
 166
 167 (defcustom gnus-score-decay-constant 3
 168   "*Decay all \"small\" scores with this amount."
 169   :group 'gnus-score-decay
 170   :type 'integer)
 171
 172 (defcustom gnus-score-decay-scale .05
 173   "*Decay all \"big\" scores with this factor."
 174   :group 'gnus-score-decay
 175   :type 'number)
 176
 177 (defcustom gnus-home-score-file nil
 178   "Variable to control where interactive score entries are to go.
 179 It can be:
 180
 181  * A string
 182    This file will be used as the home score file.
 183
 184  * A function
 185    The result of this function will be used as the home score file.
 186    The function will be passed the name of the group as its
 187    parameter.
 188
 189  * A list
 190    The elements in this list can be:
 191
 192    * `(regexp file-name ...)'
 193      If the `regexp' matches the group name, the first `file-name'
 194      will be used as the home score file.  (Multiple filenames are
 195      allowed so that one may use gnus-score-file-single-match-alist to
 196      set this variable.)
 197
 198    * A function.
 199      If the function returns non-nil, the result will be used
 200      as the home score file.  The function will be passed the
 201      name of the group as its parameter.
 202
 203    * A string.  Use the string as the home score file.
 204
 205    The list will be traversed from the beginning towards the end looking
 206    for matches."
 207   :group 'gnus-score-files
 208   :type '(choice string
 209                  (repeat (choice string
 210                                  (cons regexp (repeat file))
 211                                  (function :value fun)))
 212                  (function-item gnus-hierarchial-home-score-file)
 213                  (function-item gnus-current-home-score-file)
 214                  (function :value fun)))
 215
 216 (defcustom gnus-home-adapt-file nil
 217   "Variable to control where new adaptive score entries are to go.
 218 This variable allows the same syntax as `gnus-home-score-file'."
 219   :group 'gnus-score-adapt
 220   :group 'gnus-score-files
 221   :type '(choice string
 222                  (repeat (choice string
 223                                  (cons regexp (repeat file))
 224                                  (function :value fun)))
 225                  (function :value fun)))
 226
 227 (defcustom gnus-default-adaptive-score-alist
 228   `((gnus-kill-file-mark)
 229     (gnus-unread-mark)
 230     (gnus-read-mark
 231      (from , (+ 2 gnus-score-decay-constant))
 232      (subject , (+ 27 gnus-score-decay-constant)))
 233     (gnus-catchup-mark
 234      (subject , (+ -7 (* -1 gnus-score-decay-constant))))
 235     (gnus-killed-mark
 236      (from , (- -1 gnus-score-decay-constant))
 237      (subject , (+ -17 (* -1 gnus-score-decay-constant))))
 238     (gnus-del-mark
 239      (from , (- -1 gnus-score-decay-constant))
 240      (subject , (+ -12 (* -1 gnus-score-decay-constant)))))
 241   "Alist of marks and scores.
 242 If you use score decays, you might want to set values higher than
 243 `gnus-score-decay-constant'."
 244   :group 'gnus-score-adapt
 245   :type '(repeat (cons (symbol :tag "Mark")
 246                        (repeat (list (choice :tag "Header"
 247                                              (const from)
 248                                              (const subject)
 249                                              (symbol :tag "other"))
 250                                      (integer :tag "Score"))))))
 251
 252 (defcustom gnus-adaptive-word-length-limit nil
 253   "*Words of a length lesser than this limit will be ignored when doing adaptive scoring."
 254   :version "22.1"
 255   :group 'gnus-score-adapt
 256   :type '(radio (const :format "Unlimited " nil)
 257                 (integer :format "Maximum length: %v")))
 258
 259 (defcustom gnus-ignored-adaptive-words nil
 260   "List of words to be ignored when doing adaptive word scoring."
 261   :group 'gnus-score-adapt
 262   :type '(repeat string))
 263
 264 (defcustom gnus-default-ignored-adaptive-words
 265   '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you"
 266     "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can"
 267     "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one"
 268     "so" "we" "they" "what" "would" "any" "which" "about" "get" "your"
 269     "use" "some" "me" "then" "name" "like" "out" "when" "up" "time"
 270     "other" "more" "only" "just" "end" "also" "know" "how" "new" "should"
 271     "been" "than" "them" "he" "who" "make" "may" "people" "these" "now"
 272     "their" "here" "into" "first" "could" "way" "had" "see" "work" "well"
 273     "were" "two" "very" "where" "while" "us" "because" "good" "same"
 274     "even" "much" "most" "many" "such" "long" "his" "over" "last" "since"
 275     "right" "before" "our" "without" "too" "those" "why" "must" "part"
 276     "being" "current" "back" "still" "go" "point" "value" "each" "did"
 277     "both" "true" "off" "say" "another" "state" "might" "under" "start"
 278     "try" "re")
 279   "*Default list of words to be ignored when doing adaptive word scoring."
 280   :group 'gnus-score-adapt
 281   :type '(repeat string))
 282
 283 (defcustom gnus-default-adaptive-word-score-alist
 284   `((,gnus-read-mark . 30)
 285     (,gnus-catchup-mark . -10)
 286     (,gnus-killed-mark . -20)
 287     (,gnus-del-mark . -15))
 288   "*Alist of marks and scores."
 289   :group 'gnus-score-adapt
 290   :type '(repeat (cons (character :tag "Mark")
 291                        (integer :tag "Score"))))
 292
 293 (defcustom gnus-adaptive-word-minimum nil
 294   "If a number, this is the minimum score value that can be assigned to a word."
 295   :group 'gnus-score-adapt
 296   :type '(choice (const nil) integer))
 297
 298 (defcustom gnus-adaptive-word-no-group-words nil
 299   "If t, don't adaptively score words included in the group name."
 300   :group 'gnus-score-adapt
 301   :type 'boolean)
 302
 303 (defcustom gnus-score-mimic-keymap nil
 304   "*Have the score entry functions pretend that they are a keymap."
 305   :group 'gnus-score-default
 306   :type 'boolean)
 307
 308 (defcustom gnus-score-exact-adapt-limit 10
 309   "*Number that says how long a match has to be before using substring matching.
 310 When doing adaptive scoring, one normally uses fuzzy or substring
 311 matching.  However, if the header one matches is short, the possibility
 312 for false positives is great, so if the length of the match is less
 313 than this variable, exact matching will be used.
 314
 315 If this variable is nil, exact matching will always be used."
 316   :group 'gnus-score-adapt
 317   :type '(choice (const nil) integer))
 318
 319 (defcustom gnus-score-uncacheable-files "ADAPT$"
 320   "All score files that match this regexp will not be cached."
 321   :group 'gnus-score-adapt
 322   :group 'gnus-score-files
 323   :type 'regexp)
 324
 325 (defcustom gnus-adaptive-pretty-print nil
 326   "If non-nil, adaptive score files fill are pretty printed."
 327   :group 'gnus-score-files
 328   :group 'gnus-score-adapt
 329   :version "23.0" ;; No Gnus
 330   :type 'boolean)
 331
 332 (defcustom gnus-score-default-header nil
 333   "Default header when entering new scores.
 334
 335 Should be one of the following symbols.
 336
 337  a: from
 338  s: subject
 339  b: body
 340  h: head
 341  i: message-id
 342  t: references
 343  x: xref
 344  e: `extra' (non-standard overview)
 345  l: lines
 346  d: date
 347  f: followup
 348
 349 If nil, the user will be asked for a header."
 350   :group 'gnus-score-default
 351   :type '(choice (const :tag "from" a)
 352                  (const :tag "subject" s)
 353                  (const :tag "body" b)
 354                  (const :tag "head" h)
 355                  (const :tag "message-id" i)
 356                  (const :tag "references" t)
 357                  (const :tag "xref" x)
 358                  (const :tag "extra" e)
 359                  (const :tag "lines" l)
 360                  (const :tag "date" d)
 361                  (const :tag "followup" f)
 362                  (const :tag "ask" nil)))
 363
 364 (defcustom gnus-score-default-type nil
 365   "Default match type when entering new scores.
 366
 367 Should be one of the following symbols.
 368
 369  s: substring
 370  e: exact string
 371  f: fuzzy string
 372  r: regexp string
 373  b: before date
 374  a: after date
 375  n: this date
 376  <: less than number
 377  >: greater than number
 378  =: equal to number
 379
 380 If nil, the user will be asked for a match type."
 381   :group 'gnus-score-default
 382   :type '(choice (const :tag "substring" s)
 383                  (const :tag "exact string" e)
 384                  (const :tag "fuzzy string" f)
 385                  (const :tag "regexp string" r)
 386                  (const :tag "before date" b)
 387                  (const :tag "after date" a)
 388                  (const :tag "this date" n)
 389                  (const :tag "less than number" <)
 390                  (const :tag "greater than number" >)
 391                  (const :tag "equal than number" =)
 392                  (const :tag "ask" nil)))
 393
 394 (defcustom gnus-score-default-fold nil
 395   "Use case folding for new score file entries iff not nil."
 396   :group 'gnus-score-default
 397   :type 'boolean)
 398
 399 (defcustom gnus-score-default-duration nil
 400   "Default duration of effect when entering new scores.
 401
 402 Should be one of the following symbols.
 403
 404  t: temporary
 405  p: permanent
 406  i: immediate
 407
 408 If nil, the user will be asked for a duration."
 409   :group 'gnus-score-default
 410   :type '(choice (const :tag "temporary" t)
 411                  (const :tag "permanent" p)
 412                  (const :tag "immediate" i)
 413                  (const :tag "ask" nil)))
 414
 415 (defcustom gnus-score-after-write-file-function nil
 416   "Function called with the name of the score file just written to disk."
 417   :group 'gnus-score-files
 418   :type '(choice (const nil) function))
 419
 420 (defcustom gnus-score-thread-simplify nil
 421   "If non-nil, subjects will simplified as in threading."
 422   :group 'gnus-score-various
 423   :type 'boolean)
 424
 425 \f
 426
 427 ;; Internal variables.
 428
 429 (defvar gnus-score-use-all-scores t
 430   "If nil, only `gnus-score-find-score-files-function' is used.")
 431
 432 (defvar gnus-adaptive-word-syntax-table
 433   (let ((table (copy-syntax-table (standard-syntax-table)))
 434         (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
 435     (while numbers
 436       (modify-syntax-entry (pop numbers) " " table))
 437     (modify-syntax-entry ?' "w" table)
 438     table)
 439   "Syntax table used when doing adaptive word scoring.")
 440
 441 (defvar gnus-scores-exclude-files nil)
 442 (defvar gnus-internal-global-score-files nil)
 443 (defvar gnus-score-file-list nil)
 444
 445 (defvar gnus-short-name-score-file-cache nil)
 446
 447 (defvar gnus-score-help-winconf nil)
 448 (defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
 449 (defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist)
 450 (defvar gnus-score-trace nil)
 451 (defvar gnus-score-edit-buffer nil)
 452
 453 (defvar gnus-score-alist nil
 454   "Alist containing score information.
 455 The keys can be symbols or strings.  The following symbols are defined.
 456
 457 touched: If this alist has been modified.
 458 mark:    Automatically mark articles below this.
 459 expunge: Automatically expunge articles below this.
 460 files:   List of other score files to load when loading this one.
 461 eval:    Sexp to be evaluated when the score file is loaded.
 462
 463 String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
 464 where HEADER is the header being scored, MATCH is the string we are
 465 looking for, TYPE is a flag indicating whether it should use regexp or
 466 substring matching, SCORE is the score to add and DATE is the date
 467 of the last successful match.")
 468
 469 (defvar gnus-score-cache nil)
 470 (defvar gnus-scores-articles nil)
 471 (defvar gnus-score-index nil)
 472
 473
 474 (defconst gnus-header-index
 475   ;; Name to index alist.
 476   '(("number" 0 gnus-score-integer)
 477     ("subject" 1 gnus-score-string)
 478     ("from" 2 gnus-score-string)
 479     ("date" 3 gnus-score-date)
 480     ("message-id" 4 gnus-score-string)
 481     ("references" 5 gnus-score-string)
 482     ("chars" 6 gnus-score-integer)
 483     ("lines" 7 gnus-score-integer)
 484     ("xref" 8 gnus-score-string)
 485     ("extra" 9 gnus-score-string)
 486     ("head" -1 gnus-score-body)
 487     ("body" -1 gnus-score-body)
 488     ("all" -1 gnus-score-body)
 489     ("followup" 2 gnus-score-followup)
 490     ("thread" 5 gnus-score-thread)))
 491
 492 ;;; Summary mode score maps.
 493
 494 (gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
 495   "s" gnus-summary-set-score
 496   "S" gnus-summary-current-score
 497   "c" gnus-score-change-score-file
 498   "C" gnus-score-customize
 499   "m" gnus-score-set-mark-below
 500   "x" gnus-score-set-expunge-below
 501   "R" gnus-summary-rescore
 502   "e" gnus-score-edit-current-scores
 503   "f" gnus-score-edit-file
 504   "F" gnus-score-flush-cache
 505   "t" gnus-score-find-trace
 506   "w" gnus-score-find-favourite-words)
 507
 508 ;; Summary score file commands
 509
 510 ;; Much modification of the kill (ahem, score) code and lots of the
 511 ;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
 512
 513 (defun gnus-summary-lower-score (&optional score symp)
 514   "Make a score entry based on the current article.
 515 The user will be prompted for header to score on, match type,
 516 permanence, and the string to be used.  The numerical prefix will be
 517 used as score.  A symbolic prefix of `a' says to use the `all.SCORE'
 518 file for the command instead of the current score file."
 519   (interactive (gnus-interactive "P\ny"))
 520   (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
 521
 522 (defun gnus-score-kill-help-buffer ()
 523   (when (get-buffer "*Score Help*")
 524     (kill-buffer "*Score Help*")
 525     (when gnus-score-help-winconf
 526       (set-window-configuration gnus-score-help-winconf))))
 527
 528 (defun gnus-summary-increase-score (&optional score symp)
 529   "Make a score entry based on the current article.
 530 The user will be prompted for header to score on, match type,
 531 permanence, and the string to be used.  The numerical prefix will be
 532 used as score.  A symbolic prefix of `a' says to use the `all.SCORE'
 533 file for the command instead of the current score file."
 534   (interactive (gnus-interactive "P\ny"))
 535   (let* ((nscore (gnus-score-delta-default score))
 536          (prefix (if (< nscore 0) ?L ?I))
 537          (increase (> nscore 0))
 538          (char-to-header
 539           '((?a "from" nil nil string)
 540             (?s "subject" nil nil string)
 541             (?b "body" "" nil body-string)
 542             (?h "head" "" nil body-string)
 543             (?i "message-id" nil nil string)
 544             (?r "references" "message-id" nil string)
 545             (?x "xref" nil nil string)
 546             (?e "extra" nil nil string)
 547             (?l "lines" nil nil number)
 548             (?d "date" nil nil date)
 549             (?f "followup" nil nil string)
 550             (?t "thread" "message-id" nil string)))
 551          (char-to-type
 552           '((?s s "substring" string)
 553             (?e e "exact string" string)
 554             (?f f "fuzzy string" string)
 555             (?r r "regexp string" string)
 556             (?z s "substring" body-string)
 557             (?p r "regexp string" body-string)
 558             (?b before "before date" date)
 559             (?a after "after date" date)
 560             (?n at "this date" date)
 561             (?< < "less than number" number)
 562             (?> > "greater than number" number)
 563             (?= = "equal to number" number)))
 564          (current-score-file gnus-current-score-file)
 565          (char-to-perm
 566           (list (list ?t (current-time-string) "temporary")
 567                 '(?p perm "permanent") '(?i now "immediate")))
 568          (mimic gnus-score-mimic-keymap)
 569          (hchar (and gnus-score-default-header
 570                      (aref (symbol-name gnus-score-default-header) 0)))
 571          (tchar (and gnus-score-default-type
 572                      (aref (symbol-name gnus-score-default-type) 0)))
 573          (pchar (and gnus-score-default-duration
 574                      (aref (symbol-name gnus-score-default-duration) 0)))
 575          entry temporary type match extra)
 576
 577     (unwind-protect
 578         (progn
 579
 580           ;; First we read the header to score.
 581           (while (not hchar)
 582             (if mimic
 583                 (progn
 584                   (sit-for 1)
 585                   (message "%c-" prefix))
 586               (message "%s header (%s?): " (if increase "Increase" "Lower")
 587                        (mapconcat (lambda (s) (char-to-string (car s)))
 588                                   char-to-header "")))
 589             (setq hchar (read-char))
 590             (when (or (= hchar ??) (= hchar ?\C-h))
 591               (setq hchar nil)
 592               (gnus-score-insert-help "Match on header" char-to-header 1)))
 593
 594           (gnus-score-kill-help-buffer)
 595           (unless (setq entry (assq (downcase hchar) char-to-header))
 596             (if mimic (error "%c %c" prefix hchar)
 597               (error "Invalid header type")))
 598
 599           (when (/= (downcase hchar) hchar)
 600             ;; This was a majuscule, so we end reading and set the defaults.
 601             (if mimic (message "%c %c" prefix hchar) (message ""))
 602             (setq tchar (or tchar ?s)
 603                   pchar (or pchar ?t)))
 604
 605           (let ((legal-types
 606                  (delq nil
 607                        (mapcar (lambda (s)
 608                                  (if (eq (nth 4 entry)
 609                                          (nth 3 s))
 610                                      s nil))
 611                                char-to-type))))
 612             ;; We continue reading - the type.
 613             (while (not tchar)
 614               (if mimic
 615                   (progn
 616                     (sit-for 1) (message "%c %c-" prefix hchar))
 617                 (message "%s header '%s' with match type (%s?): "
 618                          (if increase "Increase" "Lower")
 619                          (nth 1 entry)
 620                          (mapconcat (lambda (s) (char-to-string (car s)))
 621                                     legal-types "")))
 622               (setq tchar (read-char))
 623               (when (or (= tchar ??) (= tchar ?\C-h))
 624                 (setq tchar nil)
 625                 (gnus-score-insert-help "Match type" legal-types 2)))
 626
 627             (gnus-score-kill-help-buffer)
 628             (unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
 629               (if mimic (error "%c %c" prefix hchar)
 630                 (error "Invalid match type"))))
 631
 632           (when (/= (downcase tchar) tchar)
 633             ;; It was a majuscule, so we end reading and use the default.
 634             (if mimic (message "%c %c %c" prefix hchar tchar)
 635               (message ""))
 636             (setq pchar (or pchar ?t)))
 637
 638           ;; We continue reading.
 639           (while (not pchar)
 640             (if mimic
 641                 (progn
 642                   (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
 643               (message "%s permanence (%s?): " (if increase "Increase" "Lower")
 644                        (mapconcat (lambda (s) (char-to-string (car s)))
 645                                   char-to-perm "")))
 646             (setq pchar (read-char))
 647             (when (or (= pchar ??) (= pchar ?\C-h))
 648               (setq pchar nil)
 649               (gnus-score-insert-help "Match permanence" char-to-perm 2)))
 650
 651           (gnus-score-kill-help-buffer)
 652           (if mimic (message "%c %c %c %c" prefix hchar tchar pchar)
 653             (message ""))
 654           (unless (setq temporary (cadr (assq pchar char-to-perm)))
 655             ;; Deal with der(r)ided superannuated paradigms.
 656             (when (and (eq (1+ prefix) 77)
 657                        (eq (+ hchar 12) 109)
 658                        (eq (1- tchar) 113)
 659                        (eq (- pchar 4) 111))
 660               (error "You rang?"))
 661             (if mimic
 662                 (error "%c %c %c %c" prefix hchar tchar pchar)
 663               (error "Invalid match duration"))))
 664       ;; Always kill the score help buffer.
 665       (gnus-score-kill-help-buffer))
 666
 667     ;; If scoring an extra (non-standard overview) header,
 668     ;; we must find out which header is in question.
 669     (setq extra
 670           (and gnus-extra-headers
 671                (equal (nth 1 entry) "extra")
 672                (intern                  ; need symbol
 673                 (gnus-completing-read-with-default
 674                  (symbol-name (car gnus-extra-headers)) ; default response
 675                  "Score extra header"   ; prompt
 676                  (mapcar (lambda (x)    ; completion list
 677                            (cons (symbol-name x) x))
 678                          gnus-extra-headers)
 679                  nil                    ; no completion limit
 680                  t))))                  ; require match
 681     ;; extra is now nil or a symbol.
 682
 683     ;; We have all the data, so we enter this score.
 684     (setq match (if (string= (nth 2 entry) "") ""
 685           &n