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

   1 1;;; gnus-score.el --- scoring code for Gnus
   2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
   3
   4 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
   5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (require 'gnus)
  30 (require 'gnus-sum)
  31 (require 'gnus-range)
  32 (require 'message)
  33
  34 (defcustom gnus-global-score-files nil
  35   "List of global score files and directories.
  36 Set this variable if you want to use people's score files.  One entry
  37 for each score file or each score file directory.  Gnus will decide
  38 by itself what score files are applicable to which group.
  39
  40 Say you want to use the single score file
  41 \"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
  42 score files in the \"/ftp.some-where:/pub/score\" directory.
  43
  44  (setq gnus-global-score-files
  45        '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
  46          \"/ftp.some-where:/pub/score\"))"
  47   :group 'gnus-score-files
  48   :type '(repeat file))
  49
  50 (defcustom gnus-score-file-single-match-alist nil
  51   "Alist mapping regexps to lists of score files.
  52 Each element of this alist should be of the form
  53         (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
  54
  55 If the name of a group is matched by REGEXP, the corresponding scorefiles
  56 will be used for that group.
  57 The first match found is used, subsequent matching entries are ignored (to
  58 use multiple matches, see gnus-score-file-multiple-match-alist).
  59
  60 These score files are loaded in addition to any files returned by
  61 gnus-score-find-score-files-function (which see)."
  62   :group 'gnus-score-files
  63   :type '(repeat (cons regexp (repeat file))))
  64
  65 (defcustom gnus-score-file-multiple-match-alist nil
  66   "Alist mapping regexps to lists of score files.
  67 Each element of this alist should be of the form
  68         (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
  69
  70 If the name of a group is matched by REGEXP, the corresponding scorefiles
  71 will be used for that group.
  72 If multiple REGEXPs match a group, the score files corresponding to each
  73 match will be used (for only one match to be used, see
  74 gnus-score-file-single-match-alist).
  75
  76 These score files are loaded in addition to any files returned by
  77 gnus-score-find-score-files-function (which see)."
  78   :group 'gnus-score-files
  79   :type '(repeat (cons regexp (repeat file))))
  80
  81 (defcustom gnus-score-file-suffix "SCORE"
  82   "Suffix of the score files."
  83   :group 'gnus-score-files
  84   :type 'string)
  85
  86 (defcustom gnus-adaptive-file-suffix "ADAPT"
  87   "Suffix of the adaptive score files."
  88   :group 'gnus-score-files
  89   :group 'gnus-score-adapt
  90   :type 'string)
  91
  92 (defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
  93   "Function used to find score files.
  94 The function will be called with the group name as the argument, and
  95 should return a list of score files to apply to that group.  The score
  96 files do not actually have to exist.
  97
  98 Predefined values are:
  99
 100 gnus-score-find-single: Only apply the group's own score file.
 101 gnus-score-find-hierarchical: Also apply score files from parent groups.
 102 gnus-score-find-bnews: Apply score files whose names matches.
 103
 104 See the documentation to these functions for more information.
 105
 106 This variable can also be a list of functions to be called.  Each
 107 function should either return a list of score files, or a list of
 108 score alists."
 109   :group 'gnus-score-files
 110   :type '(radio (function-item gnus-score-find-single)
 111                 (function-item gnus-score-find-hierarchical)
 112                 (function-item gnus-score-find-bnews)
 113                 (function :tag "Other")))
 114
 115 (defcustom gnus-score-interactive-default-score 1000
 116   "*Scoring commands will raise/lower the score with this number as the default."
 117   :group 'gnus-score-default
 118   :type 'integer)
 119
 120 (defcustom gnus-score-expiry-days 7
 121   "*Number of days before unused score file entries are expired.
 122 If this variable is nil, no score file entries will be expired."
 123   :group 'gnus-score-expire
 124   :type '(choice (const :tag "never" nil)
 125                  number))
 126
 127 (defcustom gnus-update-score-entry-dates t
 128   "*In non-nil, update matching score entry dates.
 129 If this variable is nil, then score entries that provide matches
 130 will be expired along with non-matching score entries."
 131   :group 'gnus-score-expire
 132   :type 'boolean)
 133
 134 (defcustom gnus-orphan-score nil
 135   "*All orphans get this score added.  Set in the score file."
 136   :group 'gnus-score-default
 137   :type 'integer)
 138
 139 (defcustom gnus-decay-scores nil
 140   "*If non-nil, decay non-permanent scores."
 141   :group 'gnus-score-decay
 142   :type 'boolean)
 143
 144 (defcustom gnus-decay-score-function 'gnus-decay-score
 145   "*Function called to decay a score.
 146 It is called with one parameter -- the score to be decayed."
 147   :group 'gnus-score-decay
 148   :type '(radio (function-item gnus-decay-score)
 149                 (function :tag "Other")))
 150
 151 (defcustom gnus-score-decay-constant 3
 152   "*Decay all \"small\" scores with this amount."
 153   :group 'gnus-score-decay
 154   :type 'integer)
 155
 156 (defcustom gnus-score-decay-scale .05
 157   "*Decay all \"big\" scores with this factor."
 158   :group 'gnus-score-decay
 159   :type 'number)
 160
 161 (defcustom gnus-home-score-file nil
 162   "Variable to control where interactive score entries are to go.
 163 It can be:
 164
 165  * A string
 166    This file file will be used as the home score file.
 167
 168  * A function
 169    The result of this function will be used as the home score file.
 170    The function will be passed the name of the group as its
 171    parameter.
 172
 173  * A list
 174    The elements in this list can be:
 175
 176    * `(regexp file-name ...)'
 177      If the `regexp' matches the group name, the first `file-name' will
 178      will be used as the home score file.  (Multiple filenames are
 179      allowed so that one may use gnus-score-file-single-match-alist to
 180      set this variable.)
 181
 182    * A function.
 183      If the function returns non-nil, the result will be used
 184      as the home score file.  The function will be passed the
 185      name of the group as its parameter.
 186
 187    * A string.  Use the string as the home score file.
 188
 189    The list will be traversed from the beginning towards the end looking
 190    for matches."
 191   :group 'gnus-score-files
 192   :type '(choice string
 193                  (repeat (choice string
 194                                  (cons regexp (repeat file))
 195                                  function))
 196                  function))
 197
 198 (defcustom gnus-home-adapt-file nil
 199   "Variable to control where new adaptive score entries are to go.
 200 This variable allows the same syntax as `gnus-home-score-file'."
 201   :group 'gnus-score-adapt
 202   :group 'gnus-score-files
 203   :type '(choice string
 204                  (repeat (choice string
 205                                  (cons regexp (repeat file))
 206                                  function))
 207                  function))
 208
 209 (defcustom gnus-default-adaptive-score-alist
 210   '((gnus-kill-file-mark)
 211     (gnus-unread-mark)
 212     (gnus-read-mark (from 3) (subject 30))
 213     (gnus-catchup-mark (subject -10))
 214     (gnus-killed-mark (from -1) (subject -20))
 215     (gnus-del-mark (from -2) (subject -15)))
 216 "Alist of marks and scores."
 217 :group 'gnus-score-adapt
 218 :type '(repeat (cons (symbol :tag "Mark")
 219                      (repeat (list (choice :tag "Header"
 220                                            (const from)
 221                                            (const subject)
 222                                            (symbol :tag "other"))
 223                                    (integer :tag "Score"))))))
 224
 225 (defcustom gnus-ignored-adaptive-words nil
 226   "List of words to be ignored when doing adaptive word scoring."
 227   :group 'gnus-score-adapt
 228   :type '(repeat string))
 229
 230 (defcustom gnus-default-ignored-adaptive-words
 231   '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you"
 232     "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can"
 233     "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one"
 234     "so" "we" "they" "what" "would" "any" "which" "about" "get" "your"
 235     "use" "some" "me" "then" "name" "like" "out" "when" "up" "time"
 236     "other" "more" "only" "just" "end" "also" "know" "how" "new" "should"
 237     "been" "than" "them" "he" "who" "make" "may" "people" "these" "now"
 238     "their" "here" "into" "first" "could" "way" "had" "see" "work" "well"
 239     "were" "two" "very" "where" "while" "us" "because" "good" "same"
 240     "even" "much" "most" "many" "such" "long" "his" "over" "last" "since"
 241     "right" "before" "our" "without" "too" "those" "why" "must" "part"
 242     "being" "current" "back" "still" "go" "point" "value" "each" "did"
 243     "both" "true" "off" "say" "another" "state" "might" "under" "start"
 244     "try" "re")
 245   "Default list of words to be ignored when doing adaptive word scoring."
 246   :group 'gnus-score-adapt
 247   :type '(repeat string))
 248
 249 (defcustom gnus-default-adaptive-word-score-alist
 250   `((,gnus-read-mark . 30)
 251     (,gnus-catchup-mark . -10)
 252     (,gnus-killed-mark . -20)
 253     (,gnus-del-mark . -15))
 254 "Alist of marks and scores."
 255 :group 'gnus-score-adapt
 256 :type '(repeat (cons (character :tag "Mark")
 257                      (integer :tag "Score"))))
 258
 259 (defcustom gnus-score-mimic-keymap nil
 260   "*Have the score entry functions pretend that they are a keymap."
 261   :group 'gnus-score-default
 262   :type 'boolean)
 263
 264 (defcustom gnus-score-exact-adapt-limit 10
 265   "*Number that says how long a match has to be before using substring matching.
 266 When doing adaptive scoring, one normally uses fuzzy or substring
 267 matching.  However, if the header one matches is short, the possibility
 268 for false positives is great, so if the length of the match is less
 269 than this variable, exact matching will be used.
 270
 271 If this variable is nil, exact matching will always be used."
 272   :group 'gnus-score-adapt
 273   :type '(choice (const nil) integer))
 274
 275 (defcustom gnus-score-uncacheable-files "ADAPT$"
 276   "All score files that match this regexp will not be cached."
 277   :group 'gnus-score-adapt
 278   :group 'gnus-score-files
 279   :type 'regexp)
 280
 281 (defcustom gnus-score-default-header nil
 282   "Default header when entering new scores.
 283
 284 Should be one of the following symbols.
 285
 286  a: from
 287  s: subject
 288  b: body
 289  h: head
 290  i: message-id
 291  t: references
 292  x: xref
 293  l: lines
 294  d: date
 295  f: followup
 296
 297 If nil, the user will be asked for a header."
 298   :group 'gnus-score-default
 299   :type '(choice (const :tag "from" a)
 300                  (const :tag "subject" s)
 301                  (const :tag "body" b)
 302                  (const :tag "head" h)
 303                  (const :tag "message-id" i)
 304                  (const :tag "references" t)
 305                  (const :tag "xref" x)
 306                  (const :tag "lines" l)
 307                  (const :tag "date" d)
 308                  (const :tag "followup" f)))
 309
 310 (defcustom gnus-score-default-type nil
 311   "Default match type when entering new scores.
 312
 313 Should be one of the following symbols.
 314
 315  s: substring
 316  e: exact string
 317  f: fuzzy string
 318  r: regexp string
 319  b: before date
 320  a: at date
 321  n: this date
 322  <: less than number
 323  >: greater than number
 324  =: equal to number
 325
 326 If nil, the user will be asked for a match type."
 327   :group 'gnus-score-default
 328   :type '(choice (const :tag "substring" s)
 329                  (const :tag "exact string" e)
 330                  (const :tag "fuzzy string" f)
 331                  (const :tag "regexp string" r)
 332                  (const :tag "before date" b)
 333                  (const :tag "at date" a)
 334                  (const :tag "this date" n)
 335                  (const :tag "less than number" <)
 336                  (const :tag "greater than number" >)
 337                  (const :tag "equal than number" =)))
 338
 339 (defcustom gnus-score-default-fold nil
 340   "Use case folding for new score file entries iff not nil."
 341   :group 'gnus-score-default
 342   :type 'boolean)
 343
 344 (defcustom gnus-score-default-duration nil
 345   "Default duration of effect when entering new scores.
 346
 347 Should be one of the following symbols.
 348
 349  t: temporary
 350  p: permanent
 351  i: immediate
 352
 353 If nil, the user will be asked for a duration."
 354   :group 'gnus-score-default
 355   :type '(choice (const :tag "temporary" t)
 356                  (const :tag "permanent" p)
 357                  (const :tag "immediate" i)
 358                  (const :tag "ask" nil)))
 359
 360 (defcustom gnus-score-after-write-file-function nil
 361   "Function called with the name of the score file just written to disk."
 362   :group 'gnus-score-files
 363   :type 'function)
 364
 365 \f
 366
 367 ;; Internal variables.
 368
 369 (defvar gnus-adaptive-word-syntax-table
 370   (let ((table (copy-syntax-table (standard-syntax-table)))
 371         (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
 372     (while numbers
 373       (modify-syntax-entry (pop numbers) " " table))
 374     (modify-syntax-entry ?' "w" table)
 375     table)
 376   "Syntax table used when doing adaptive word scoring.")
 377
 378 (defvar gnus-scores-exclude-files nil)
 379 (defvar gnus-internal-global-score-files nil)
 380 (defvar gnus-score-file-list nil)
 381
 382 (defvar gnus-short-name-score-file-cache nil)
 383
 384 (defvar gnus-score-help-winconf nil)
 385 (defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
 386 (defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist)
 387 (defvar gnus-score-trace nil)
 388 (defvar gnus-score-edit-buffer nil)
 389
 390 (defvar gnus-score-alist nil
 391   "Alist containing score information.
 392 The keys can be symbols or strings.  The following symbols are defined.
 393
 394 touched: If this alist has been modified.
 395 mark:    Automatically mark articles below this.
 396 expunge: Automatically expunge articles below this.
 397 files:   List of other score files to load when loading this one.
 398 eval:    Sexp to be evaluated when the score file is loaded.
 399
 400 String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
 401 where HEADER is the header being scored, MATCH is the string we are
 402 looking for, TYPE is a flag indicating whether it should use regexp or
 403 substring matching, SCORE is the score to add and DATE is the date
 404 of the last successful match.")
 405
 406 (defvar gnus-score-cache nil)
 407 (defvar gnus-scores-articles nil)
 408 (defvar gnus-score-index nil)
 409
 410
 411 (defconst gnus-header-index
 412   ;; Name to index alist.
 413   '(("number" 0 gnus-score-integer)
 414     ("subject" 1 gnus-score-string)
 415     ("from" 2 gnus-score-string)
 416     ("date" 3 gnus-score-date)
 417     ("message-id" 4 gnus-score-string)
 418     ("references" 5 gnus-score-string)
 419     ("chars" 6