;;; Code:
(require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-sum)
+(require 'gnus-range)
-(defvar 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.
Set this variable if you want to use people's score files. One entry
for each score file or each score file directory. Gnus will decide
by itself what score files are applicable to which group.
(setq gnus-global-score-files
'(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
- \"/ftp.some-where:/pub/score\"))")
+ \"/ftp.some-where:/pub/score\"))"
+ :group 'gnus-score
+ :type '(repeat file))
-(defvar gnus-score-file-single-match-alist nil
- "*Alist mapping regexps to lists of score files.
+(defcustom gnus-score-file-single-match-alist nil
+ "Alist mapping regexps to lists of score files.
Each element of this alist should be of the form
(\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
use multiple matches, see gnus-score-file-multiple-match-alist).
These score files are loaded in addition to any files returned by
-gnus-score-find-score-files-function (which see).")
+gnus-score-find-score-files-function (which see)."
+ :group 'gnus-score
+ :type '(repeat (cons regexp (repeat file))))
-(defvar gnus-score-file-multiple-match-alist nil
- "*Alist mapping regexps to lists of score files.
+(defcustom gnus-score-file-multiple-match-alist nil
+ "Alist mapping regexps to lists of score files.
Each element of this alist should be of the form
(\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
gnus-score-file-single-match-alist).
These score files are loaded in addition to any files returned by
-gnus-score-find-score-files-function (which see).")
-
-(defvar gnus-score-file-suffix "SCORE"
- "*Suffix of the score files.")
-
-(defvar gnus-adaptive-file-suffix "ADAPT"
- "*Suffix of the adaptive score files.")
-
-(defvar gnus-score-find-score-files-function 'gnus-score-find-bnews
- "*Function used to find score files.
+gnus-score-find-score-files-function (which see)."
+ :group 'gnus-score
+ :type '(repeat (cons regexp (repeat file))))
+
+(defcustom gnus-score-file-suffix "SCORE"
+ "Suffix of the score files."
+ :group 'gnus-score
+ :type 'string)
+
+(defcustom gnus-adaptive-file-suffix "ADAPT"
+ "Suffix of the adaptive score files."
+ :group 'gnus-score
+ :type 'string)
+
+(defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
+ "Function used to find score files.
The function will be called with the group name as the argument, and
should return a list of score files to apply to that group. The score
files do not actually have to exist.
This variable can also be a list of functions to be called. Each
function should either return a list of score files, or a list of
-score alists.")
-
-(defvar gnus-score-interactive-default-score 1000
- "*Scoring commands will raise/lower the score with this number as the default.")
-
-(defvar gnus-score-expiry-days 7
+score alists."
+ :group 'gnus-score
+ :type '(radio (function-item gnus-score-find-single)
+ (function-item gnus-score-find-hierarchical)
+ (function-item gnus-score-find-bnews)
+ (function :tag "Other")))
+
+(defcustom gnus-score-interactive-default-score 1000
+ "*Scoring commands will raise/lower the score with this number as the default."
+ :group 'gnus-score
+ :type 'integer)
+
+(defcustom gnus-score-expiry-days 7
"*Number of days before unused score file entries are expired.
-If this variable is nil, no score file entries will be expired.")
+If this variable is nil, no score file entries will be expired."
+ :group 'gnus-score
+ :type '(choice (const :tag "never" nil)
+ number))
-(defvar gnus-update-score-entry-dates t
+(defcustom gnus-update-score-entry-dates t
"*In non-nil, update matching score entry dates.
If this variable is nil, then score entries that provide matches
-will be expired along with non-matching score entries.")
-
-(defvar gnus-orphan-score nil
- "*All orphans get this score added. Set in the score file.")
-
-(defvar gnus-default-adaptive-score-alist
+will be expired along with non-matching score entries."
+ :group 'gnus-score
+ :type 'boolean)
+
+(defcustom gnus-orphan-score nil
+ "*All orphans get this score added. Set in the score file."
+ :group 'gnus-score
+ :type 'integer)
+
+(defcustom gnus-decay-scores nil
+ "*If non-nil, decay non-permanent scores."
+ :group 'gnus-score
+ :type 'boolean)
+
+(defcustom gnus-decay-score-function 'gnus-decay-score
+ "*Function called to decay a score.
+It is called with one parameter -- the score to be decayed."
+ :group 'gnus-score
+ :type '(radio (function-item gnus-decay-score)
+ (function :tag "Other")))
+
+(defcustom gnus-score-decay-constant 3
+ "*Decay all \"small\" scores with this amount."
+ :group 'gnus-score
+ :type 'integer)
+
+(defcustom gnus-score-decay-scale .05
+ "*Decay all \"big\" scores with this factor."
+ :group 'gnus-score
+ :type 'number)
+
+(defcustom gnus-home-score-file nil
+ "Variable to control where interactive score entries are to go.
+It can be:
+
+ * A string
+ This file file will be used as the home score file.
+
+ * A function
+ The result of this function will be used as the home score file.
+ The function will be passed the name of the group as its
+ parameter.
+
+ * A list
+ The elements in this list can be:
+
+ * `(regexp file-name ...)'
+ If the `regexp' matches the group name, the first `file-name' will
+ will be used as the home score file. (Multiple filenames are
+ allowed so that one may use gnus-score-file-single-match-alist to
+ set this variable.)
+
+ * A function.
+ If the function returns non-nil, the result will be used
+ as the home score file. The function will be passed the
+ name of the group as its parameter.
+
+ * A string. Use the string as the home score file.
+
+ The list will be traversed from the beginning towards the end looking
+ for matches."
+ :group 'gnus-score
+ :type '(choice string
+ (repeat (choice string
+ (cons regexp (repeat file))
+ function))
+ function))
+
+(defcustom gnus-home-adapt-file nil
+ "Variable to control where new adaptive score entries are to go.
+This variable allows the same syntax as `gnus-home-score-file'."
+ :group 'gnus-score
+ :type '(choice string
+ (repeat (choice string
+ (cons regexp (repeat file))
+ function))
+ function))
+
+(defcustom gnus-default-adaptive-score-alist
'((gnus-kill-file-mark)
(gnus-unread-mark)
- (gnus-read-mark (from 3) (subject 30))
+ (gnus-read-mark (from 3) (subject 30))
(gnus-catchup-mark (subject -10))
(gnus-killed-mark (from -1) (subject -20))
(gnus-del-mark (from -2) (subject -15)))
-"*Alist of marks and scores.")
-
-(defvar gnus-score-mimic-keymap nil
- "*Have the score entry functions pretend that they are a keymap.")
-
-(defvar gnus-score-exact-adapt-limit 10
+"Alist of marks and scores."
+:group 'gnus-score
+:type '(repeat (cons (symbol :tag "Mark")
+ (repeat (list (choice :tag "Header"
+ (const from)
+ (const subject)
+ (symbol :tag "other"))
+ (integer :tag "Score"))))))
+
+(defcustom gnus-ignored-adaptive-words nil
+ "List of words to be ignored when doing adaptive word scoring."
+ :group 'gnus-score
+ :type '(repeat string))
+
+(defcustom gnus-default-ignored-adaptive-words
+ '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you"
+ "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can"
+ "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one"
+ "so" "we" "they" "what" "would" "any" "which" "about" "get" "your"
+ "use" "some" "me" "then" "name" "like" "out" "when" "up" "time"
+ "other" "more" "only" "just" "end" "also" "know" "how" "new" "should"
+ "been" "than" "them" "he" "who" "make" "may" "people" "these" "now"
+ "their" "here" "into" "first" "could" "way" "had" "see" "work" "well"
+ "were" "two" "very" "where" "while" "us" "because" "good" "same"
+ "even" "much" "most" "many" "such" "long" "his" "over" "last" "since"
+ "right" "before" "our" "without" "too" "those" "why" "must" "part"
+ "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."
+ :group 'gnus-score
+ :type '(repeat string))
+
+(defcustom gnus-default-adaptive-word-score-alist
+ `((,gnus-read-mark . 30)
+ (,gnus-catchup-mark . -10)
+ (,gnus-killed-mark . -20)
+ (,gnus-del-mark . -15))
+"Alist of marks and scores."
+:group 'gnus-score
+:type '(repeat (cons (character :tag "Mark")
+ (integer :tag "Score"))))
+
+(defcustom gnus-score-mimic-keymap nil
+ "*Have the score entry functions pretend that they are a keymap."
+ :group 'gnus-score
+ :type 'boolean)
+
+(defcustom gnus-score-exact-adapt-limit 10
"*Number that says how long a match has to be before using substring matching.
When doing adaptive scoring, one normally uses fuzzy or substring
matching. However, if the header one matches is short, the possibility
for false positives is great, so if the length of the match is less
than this variable, exact matching will be used.
-If this variable is nil, exact matching will always be used.")
+If this variable is nil, exact matching will always be used."
+ :group 'gnus-score
+ :type '(choice (const nil) integer))
-(defvar gnus-score-uncacheable-files "ADAPT$"
- "*All score files that match this regexp will not be cached.")
+(defcustom gnus-score-uncacheable-files "ADAPT$"
+ "All score files that match this regexp will not be cached."
+ :group 'gnus-score
+ :type 'regexp)
-(defvar gnus-score-default-header nil
+(defcustom gnus-score-default-header nil
"Default header when entering new scores.
Should be one of the following symbols.
d: date
f: followup
-If nil, the user will be asked for a header.")
-
-(defvar gnus-score-default-type nil
+If nil, the user will be asked for a header."
+ :group 'gnus-score
+ :type '(choice (const :tag "from" a)
+ (const :tag "subject" s)
+ (const :tag "body" b)
+ (const :tag "head" h)
+ (const :tag "message-id" i)
+ (const :tag "references" t)
+ (const :tag "xref" x)
+ (const :tag "lines" l)
+ (const :tag "date" d)
+ (const :tag "followup" f)))
+
+(defcustom gnus-score-default-type nil
"Default match type when entering new scores.
Should be one of the following symbols.
>: greater than number
=: equal to number
-If nil, the user will be asked for a match type.")
-
-(defvar gnus-score-default-fold nil
- "Use case folding for new score file entries iff not nil.")
-
-(defvar gnus-score-default-duration nil
+If nil, the user will be asked for a match type."
+ :group 'gnus-score
+ :type '(choice (const :tag "substring" s)
+ (const :tag "exact string" e)
+ (const :tag "fuzzy string" f)
+ (const :tag "regexp string" r)
+ (const :tag "before date" b)
+ (const :tag "at date" a)
+ (const :tag "this date" n)
+ (const :tag "less than number" <)
+ (const :tag "greater than number" >)
+ (const :tag "equal than number" =)))
+
+(defcustom gnus-score-default-fold nil
+ "Use case folding for new score file entries iff not nil."
+ :group 'gnus-score
+ :type 'boolean)
+
+(defcustom gnus-score-default-duration nil
"Default duration of effect when entering new scores.
Should be one of the following symbols.
p: permanent
i: immediate
-If nil, the user will be asked for a duration.")
+If nil, the user will be asked for a duration."
+ :group 'gnus-score
+ :type '(choice (const :tag "temporary" t)
+ (const :tag "permanent" p)
+ (const :tag "immediate" i)))
-(defvar gnus-score-after-write-file-function nil
- "*Function called with the name of the score file just written to disk.")
+(defcustom gnus-score-after-write-file-function nil
+ "Function called with the name of the score file just written to disk."
+ :group 'gnus-score
+ :type 'function)
\f
;; Internal variables.
+(defvar gnus-adaptive-word-syntax-table
+ (let ((table (copy-syntax-table (standard-syntax-table)))
+ (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
+ (while numbers
+ (modify-syntax-entry (pop numbers) " " table))
+ (modify-syntax-entry ?' "w" table)
+ table)
+ "Syntax table used when doing adaptive word scoring.")
+
+(defvar gnus-scores-exclude-files nil)
(defvar gnus-internal-global-score-files nil)
(defvar gnus-score-file-list nil)
(defvar gnus-score-help-winconf nil)
(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
+(defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist)
(defvar gnus-score-trace nil)
(defvar gnus-score-edit-buffer nil)
files: List of other score files to load when loading this one.
eval: Sexp to be evaluated when the score file is loaded.
-String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
+String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
where HEADER is the header being scored, MATCH is the string we are
looking for, TYPE is a flag indicating whether it should use regexp or
substring matching, SCORE is the score to add and DATE is the date
("subject" 1 gnus-score-string)
("from" 2 gnus-score-string)
("date" 3 gnus-score-date)
- ("message-id" 4 gnus-score-string)
- ("references" 5 gnus-score-string)
- ("chars" 6 gnus-score-integer)
- ("lines" 7 gnus-score-integer)
+ ("message-id" 4 gnus-score-string)
+ ("references" 5 gnus-score-string)
+ ("chars" 6 gnus-score-integer)
+ ("lines" 7 gnus-score-integer)
("xref" 8 gnus-score-string)
("head" -1 gnus-score-body)
("body" -1 gnus-score-body)
("followup" 2 gnus-score-followup)
("thread" 5 gnus-score-thread)))
-(eval-and-compile
- (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap))
-
;;; Summary mode score maps.
-(gnus-define-keys
- (gnus-summary-score-map "V" gnus-summary-mode-map)
- "s" gnus-summary-set-score
- "a" gnus-summary-score-entry
- "S" gnus-summary-current-score
- "c" gnus-score-change-score-file
- "m" gnus-score-set-mark-below
- "x" gnus-score-set-expunge-below
- "R" gnus-summary-rescore
- "e" gnus-score-edit-current-scores
- "f" gnus-score-edit-file
- "F" gnus-score-flush-cache
- "t" gnus-score-find-trace
- "C" gnus-score-customize)
+(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
+ "m" gnus-score-set-mark-below
+ "x" gnus-score-set-expunge-below
+ "R" gnus-summary-rescore
+ "e" gnus-score-edit-current-scores
+ "f" gnus-score-edit-file
+ "F" gnus-score-flush-cache
+ "t" gnus-score-find-trace
+ "w" gnus-score-find-favourite-words)
;; Summary score file commands
(interactive "P")
(gnus-summary-increase-score (- (gnus-score-default score))))
-(defvar gnus-score-default-header nil
- "*The default header to score on when entering a score rule interactively.")
-
-(defvar gnus-score-default-type nil
- "*The default score type to use when entering a score rule interactively.")
-
-(defvar gnus-score-default-duration nil
- "*The default score duration to use on when entering a score rule interactively.")
-
(defun gnus-score-kill-help-buffer ()
(when (get-buffer "*Score Help*")
(kill-buffer "*Score Help*")
- (and gnus-score-help-winconf
- (set-window-configuration gnus-score-help-winconf))))
+ (when gnus-score-help-winconf
+ (set-window-configuration gnus-score-help-winconf))))
(defun gnus-summary-increase-score (&optional score)
"Make a score entry based on the current article.
(?e e "exact string" string)
(?f f "fuzzy string" string)
(?r r "regexp string" string)
- (?s s "substring" body-string)
- (?r s "regexp string" body-string)
+ (?z s "substring" body-string)
+ (?p r "regexp string" body-string)
(?b before "before date" date)
- (?a at "at date" date)
+ (?a at "at date" date)
(?n now "this date" date)
(?< < "less than number" number)
- (?> > "greater than number" number)
+ (?> > "greater than number" number)
(?= = "equal to number" number)))
(char-to-perm
- (list (list ?t (current-time-string) "temporary")
+ (list (list ?t (current-time-string) "temporary")
'(?p perm "permanent") '(?i now "immediate")))
(mimic gnus-score-mimic-keymap)
(hchar (and gnus-score-default-header
(pchar (and gnus-score-default-duration
(aref (symbol-name gnus-score-default-duration) 0)))
entry temporary type match)
-
- ;; First we read the header to score.
- (while (not hchar)
- (if mimic
- (progn
- (sit-for 1)
- (message "%c-" prefix))
- (message "%s header (%s?): " (if increase "Increase" "Lower")
- (mapconcat (lambda (s) (char-to-string (car s)))
- char-to-header "")))
- (setq hchar (read-char))
- (when (or (= hchar ??) (= hchar ?\C-h))
- (setq hchar nil)
- (gnus-score-insert-help "Match on header" char-to-header 1)))
-
- (gnus-score-kill-help-buffer)
- (unless (setq entry (assq (downcase hchar) char-to-header))
- (if mimic (error "%c %c" prefix hchar) (error "")))
-
- (when (/= (downcase hchar) hchar)
- ;; This was a majuscle, so we end reading and set the defaults.
- (if mimic (message "%c %c" prefix hchar) (message ""))
- (setq tchar (or tchar ?s)
- pchar (or pchar ?t)))
- ;; We continue reading - the type.
- (while (not tchar)
- (if mimic
- (progn
- (sit-for 1) (message "%c %c-" prefix hchar))
- (message "%s header '%s' with match type (%s?): "
- (if increase "Increase" "Lower")
- (nth 1 entry)
- (mapconcat (lambda (s)
- (if (eq (nth 4 entry)
- (nth 3 s))
- (char-to-string (car s))
- ""))
- char-to-type "")))
- (setq tchar (read-char))
- (when (or (= tchar ??) (= tchar ?\C-h))
- (setq tchar nil)
- (gnus-score-insert-help "Match type" char-to-type 2)))
-
- (gnus-score-kill-help-buffer)
- (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
- (if mimic (error "%c %c" prefix hchar) (error "")))
-
- (when (/= (downcase tchar) tchar)
- ;; It was a majuscle, so we end reading and the the default.
- (if mimic (message "%c %c %c" prefix hchar tchar)
- (message ""))
- (setq pchar (or pchar ?p)))
-
- ;; We continue reading.
- (while (not pchar)
- (if mimic
- (progn
- (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
- (message "%s permanence (%s?): " (if increase "Increase" "Lower")
- (mapconcat (lambda (s) (char-to-string (car s)))
- char-to-perm "")))
- (setq pchar (read-char))
- (when (or (= pchar ??) (= pchar ?\C-h))
- (setq pchar nil)
- (gnus-score-insert-help "Match permanence" char-to-perm 2)))
-
- (gnus-score-kill-help-buffer)
- (if mimic (message "%c %c %c" prefix hchar tchar pchar)
- (message ""))
- (unless (setq temporary (cadr (assq pchar char-to-perm)))
- (if mimic
- (error "%c %c %c %c" prefix hchar tchar pchar)
- (error "")))
+ (unwind-protect
+ (progn
+
+ ;; First we read the header to score.
+ (while (not hchar)
+ (if mimic
+ (progn
+ (sit-for 1)
+ (message "%c-" prefix))
+ (message "%s header (%s?): " (if increase "Increase" "Lower")
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-header "")))
+ (setq hchar (read-char))
+ (when (or (= hchar ??) (= hchar ?\C-h))
+ (setq hchar nil)
+ (gnus-score-insert-help "Match on header" char-to-header 1)))
+
+ (gnus-score-kill-help-buffer)
+ (unless (setq entry (assq (downcase hchar) char-to-header))
+ (if mimic (error "%c %c" prefix hchar) (error "")))
+
+ (when (/= (downcase hchar) hchar)
+ ;; This was a majuscule, so we end reading and set the defaults.
+ (if mimic (message "%c %c" prefix hchar) (message ""))
+ (setq tchar (or tchar ?s)
+ pchar (or pchar ?t)))
+
+ ;; We continue reading - the type.
+ (while (not tchar)
+ (if mimic
+ (progn
+ (sit-for 1) (message "%c %c-" prefix hchar))
+ (message "%s header '%s' with match type (%s?): "
+ (if increase "Increase" "Lower")
+ (nth 1 entry)
+ (mapconcat (lambda (s)
+ (if (eq (nth 4 entry)
+ (nth 3 s))
+ (char-to-string (car s))
+ ""))
+ char-to-type "")))
+ (setq tchar (read-char))
+ (when (or (= tchar ??) (= tchar ?\C-h))
+ (setq tchar nil)
+ (gnus-score-insert-help
+ "Match type"
+ (delq nil
+ (mapcar (lambda (s)
+ (if (eq (nth 4 entry)
+ (nth 3 s))
+ s nil))
+ char-to-type))
+ 2)))
+
+ (gnus-score-kill-help-buffer)
+ (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
+ (if mimic (error "%c %c" prefix hchar) (error "")))
+
+ (when (/= (downcase tchar) tchar)
+ ;; It was a majuscule, so we end reading and use the default.
+ (if mimic (message "%c %c %c" prefix hchar tchar)
+ (message ""))
+ (setq pchar (or pchar ?p)))
+
+ ;; We continue reading.
+ (while (not pchar)
+ (if mimic
+ (progn
+ (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
+ (message "%s permanence (%s?): " (if increase "Increase" "Lower")
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-perm "")))
+ (setq pchar (read-char))
+ (when (or (= pchar ??) (= pchar ?\C-h))
+ (setq pchar nil)
+ (gnus-score-insert-help "Match permanence" char-to-perm 2)))
+
+ (gnus-score-kill-help-buffer)
+ (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+ (message ""))
+ (unless (setq temporary (cadr (assq pchar char-to-perm)))
+ ;; Deal with der(r)ided superannuated paradigms.
+ (when (and (eq (1+ prefix) 77)
+ (eq (+ hchar 12) 109)
+ (eq tchar 114)
+ (eq (- pchar 4) 111))
+ (error "You rang?"))
+ (if mimic
+ (error "%c %c %c %c" prefix hchar tchar pchar)
+ (error ""))))
+ ;; Always kill the score help buffer.
+ (gnus-score-kill-help-buffer))
;; We have all the data, so we enter this score.
(setq match (if (string= (nth 2 entry) "") ""
(nth 1 entry) ; Header
match ; Match
type ; Type
- (if (eq 's score) nil score) ; Score
- (if (eq 'perm temporary) ; Temp
+ (if (eq score 's) nil score) ; Score
+ (if (eq temporary 'perm) ; Temp
nil
- temporary)
projects / gnus / blobdiff