;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
(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.")
+will be expired along with non-matching score entries."
+ :group 'gnus-score
+ :type 'boolean)
-(defvar gnus-orphan-score nil
- "*All orphans get this score added. Set in the score file.")
+(defcustom gnus-orphan-score nil
+ "*All orphans get this score added. Set in the score file."
+ :group 'gnus-score
+ :type 'integer)
-(defvar gnus-decay-scores nil
- "*If non-nil, decay non-permanent scores.")
+(defcustom gnus-decay-scores nil
+ "*If non-nil, decay non-permanent scores."
+ :group 'gnus-score
+ :type 'boolean)
-(defvar gnus-decay-score-function 'gnus-decay-score
+(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.")
-
-(defvar gnus-score-decay-constant 3
- "*Decay all \"small\" scores with this amount.")
-
-(defvar gnus-score-decay-scale .05
- "*Decay all \"big\" scores with this factor.")
-
-(defvar gnus-home-score-file nil
+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 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:
* A function.
If the function returns non-nil, the result will be used
- as the home score file.
+ 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.
+ * A string. Use the string as the home score file.
The list will be traversed from the beginning towards the end looking
- for matches.")
-
-(defvar gnus-home-adapt-file nil
+ 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'.")
-
-(defvar gnus-default-adaptive-score-alist
+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-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-ignored-adaptive-words nil
- "*List of words to be ignored when doing adaptive word scoring.")
-
-(defvar gnus-default-ignored-adaptive-words
+"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"
"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
+ :type '(repeat string))
-(defvar gnus-default-adaptive-word-score-alist
+(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.")
+"Alist of marks and scores."
+:group 'gnus-score
+:type '(repeat (cons (character :tag "Mark")
+ (integer :tag "Score"))))
-(defvar gnus-score-mimic-keymap nil
- "*Have the score entry functions pretend that they are a keymap.")
+(defcustom gnus-score-mimic-keymap nil
+ "*Have the score entry functions pretend that they are a keymap."
+ :group 'gnus-score
+ :type 'boolean)
-(defvar gnus-score-exact-adapt-limit 10
+(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
("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)
(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*")
(if (eq (nth 4 entry)
(nth 3 s))
s nil))
- char-to-type ))
+ char-to-type))
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 ""))))
(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)
(not (nth 3 entry))) ; Prompt
"Simulate the effect of a score file entry.
HEADER is the header being scored.
MATCH is the string we are looking for.
-TYPE is a flag indicating if it is a regexp or substring.
+TYPE is the score type.
SCORE is the score to add."
(interactive (list (completing-read "Header: "
gnus-header-index
(defun gnus-score-edit-current-scores (file)
"Edit the current score alist."
(interactive (list gnus-current-score-file))
+ (gnus-set-global-variables)
(let ((winconf (current-window-configuration)))
(when (buffer-name gnus-summary-buffer)
(gnus-score-save))
(cond
;; Fuzzy matches. We save these for later.
((= dmt ?f)
- (push entries fuzzies))
+ (push (cons entries alist) fuzzies))
;; Word matches. Save these for even later.
((= dmt ?w)
- (push entries words))
+ (push (cons entries alist) words))
;; Exact matches.
((= dmt ?e)
;; Do exact matching.
(when fuzzies
;; Simplify the entire buffer for easy matching.
(gnus-simplify-buffer-fuzzy)
- (while (setq kill (cadar fuzzies))
+ (while (setq kill (cadaar fuzzies))
(let* ((match (nth 0 kill))
(type (nth 3 kill))
(score (or (nth 1 kill) gnus-score-interactive-default-score))
(while (setq art (pop arts))
(setcdr art (+ score (cdr art)))
(push (cons
- (car-safe (rassq alist gnus-score-cache)) kill)
+ (car-safe (rassq (cdar fuzzies) gnus-score-cache))
+ kill)
gnus-score-trace))
;; Found a match, update scores.
(while (setq art (pop arts))
)
;; Match, update date.
((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) alist)
+ (gnus-score-set 'touched '(t) (cdar fuzzies))
(setcar (nthcdr 2 kill) now))
;; Old entry, remove.
((and expire (< date expire))
- (gnus-score-set 'touched '(t) alist)
- (setcdr (car fuzzies) (cddar fuzzies))))
+ (gnus-score-set 'touched '(t) (cdar fuzzies))
+ (setcdr (caar fuzzies) (cddaar fuzzies))))
(setq fuzzies (cdr fuzzies)))))
(when words
(let ((hashtb (gnus-make-hashtable
(* 10 (count-lines (point-min) (point-max))))))
(gnus-enter-score-words-into-hashtb hashtb)
- (while (setq kill (cadar words))
+ (while (setq kill (cadaar words))
(let* ((score (or (nth 1 kill) gnus-score-interactive-default-score))
(date (nth 2 kill))
found)
(if trace
(while (setq art (pop arts))
(setcdr art (+ score (cdr art)))
- (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
+ (push (cons
+ (car-safe (rassq (cdar words) gnus-score-cache))
+ kill)
gnus-score-trace))
;; Found a match, update scores.
(while (setq art (pop arts))
)
;; Match, update date.
((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) alist)
+ (gnus-score-set 'touched '(t) (cdar words))
(setcar (nthcdr 2 kill) now))
;; Old entry, remove.
((and expire (< date expire))
- (gnus-score-set 'touched '(t) alist)
- (setcdr (car words) (cddar words))))
+ (gnus-score-set 'touched '(t) (cdar words))
+ (setcdr (caar words) (cddaar words))))
(setq words (cdr words))))))
nil))
(or gnus-newsgroup-adaptive-score-file
(gnus-score-file-name
gnus-newsgroup-name gnus-adaptive-file-suffix))))
- (cond
- ;; Perform ordinary line scoring.
- ((or (not (listp gnus-use-adaptive-scoring))
- (memq 'line gnus-use-adaptive-scoring))
+ ;; Perform ordinary line scoring.
+ (when (or (not (listp gnus-use-adaptive-scoring))
+ (memq 'line gnus-use-adaptive-scoring))
(save-excursion
(let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
(alist malist)
(setq elem (cdr elem)))))
(setq data (cdr data))))))
- ;; Perform adaptive word scoring.
- ((memq 'word gnus-use-adaptive-scoring)
+ ;; Perform adaptive word scoring.
+ (when (and (listp gnus-use-adaptive-scoring)
+ (memq 'word gnus-use-adaptive-scoring))
(nnheader-temp-write nil
(let* ((hashtb (gnus-make-hashtable 1000))
(date (gnus-day-number (current-time-string)))
word d score val)
(unwind-protect
(progn
- (set-syntax-table syntab)
+ (set-syntax-table gnus-adaptive-word-syntax-table)
;; Go through all articles.
(while (setq d (pop data))
(when (and
(gnus-summary-score-entry
"subject" (symbol-name word) 'w (symbol-value word)
date nil t)))
- hashtb)))))))
+ hashtb))))))
(defun gnus-score-edit-done ()
(let ((bufnam (buffer-file-name (current-buffer)))
(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))))
(defun gnus-summary-rescore ()
(defun gnus-score-score-files-1 (dir)
"Return all possible score files under DIR."
- (let ((files (directory-files (expand-file-name dir) t nil t))
+ (let ((files (list (expand-file-name dir)))
(regexp (gnus-score-file-regexp))
(case-fold-search nil)
- out file)
+ seen out file)
(while (setq file (pop files))
(cond
;; Ignore "." and "..".
((member (file-name-nondirectory file) '("." ".."))
nil)
- ;; Recurse down directories.
- ((file-directory-p file)
- (setq out (nconc (gnus-score-score-files-1 file) out)))
+ ;; Add subtrees of directory to also be searched.
+ ((and (file-directory-p file)
+ (not (member (file-truename file) seen)))
+ (push (file-truename file) seen)
+ (setq files (nconc (directory-files file t nil t) files)))
;; Add files to the list of score files.
((string-match regexp file)
(push file out))))
;; Kludge to get rid of "nntp+" problems.
(goto-char (point-min))
(when (looking-at "nn[a-z]+\\+")
- (progn
- (search-forward "+")
- (forward-char -1)
- (insert "\\")))
+ (search-forward "+")
+ (forward-char -1)
+ (insert "\\")
+ (forward-char 1))
;; Kludge to deal with "++".
- (goto-char (point-min))
- (while (search-forward "++" nil t)
- (replace-match "\\+\\+" t t))
+ (while (search-forward "+" nil t)
+ (replace-match "\\+" t t))
;; Translate "all" to ".*".
(goto-char (point-min))
(while (search-forward "all" nil t)
(if (looking-at "not.")
(progn
(setq not-match t)
- (setq regexp (buffer-substring 5 (point-max))))
- (setq regexp (buffer-substring 1 (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
(defun gnus-score-find-hierarchical (group)
"Return list of score files for GROUP.
This includes the score file for the group and all its parents."
- (let ((all (copy-sequence '(nil)))
- (start 0))
+ (let* ((prefix (gnus-group-real-prefix group))
+ (all (list nil))
+ (group (gnus-group-real-name group))
+ (start 0))
(while (string-match "\\." group (1+ start))
(setq start (match-beginning 0))
(push (substring group 0 start) all))
(push group all)
- (nconc
- (mapcar (lambda (newsgroup)
- (gnus-score-file-name newsgroup gnus-adaptive-file-suffix))
- (setq all (nreverse all)))
- (mapcar 'gnus-score-file-name all))))
+ (setq all
+ (nconc
+ (mapcar (lambda (group)
+ (gnus-score-file-name group gnus-adaptive-file-suffix))
+ (setq all (nreverse all)))
+ (mapcar 'gnus-score-file-name all)))
+ (if (equal prefix "")
+ all
+ (mapcar
+ (lambda (file)
+ (concat (file-name-directory file) prefix
+ (file-name-nondirectory file)))
+ all))))
(defun gnus-score-file-rank (file)
"Return a number that says how specific score FILE is.
(push (cons group score-files) gnus-score-file-alist-cache)
score-files)))
-(defun gnus-all-score-files ()
+(defun gnus-all-score-files (&optional group)
"Return a list of all score files for the current group."
(let ((funcs gnus-score-find-score-files-function)
- (group gnus-newsgroup-name)
+ (group (or group gnus-newsgroup-name))
score-files)
;; Make sure funcs is a list.
(and funcs
(setq funcs (list funcs)))
;; Get the initial score files for this group.
(when funcs
- (setq score-files (gnus-score-find-alist group)))
+ (setq score-files (nreverse (gnus-score-find-alist group))))
;; Add any home adapt files.
(let ((home (gnus-home-score-file group t)))
(when home
(while funcs
(when (gnus-functionp (car funcs))
(setq score-files
- (nconc score-files (funcall (car funcs) group))))
+ (nconc score-files (nreverse (funcall (car funcs) group)))))
(setq funcs (cdr funcs)))
;; Add any home score files.
(let ((home (gnus-home-score-file group)))
(let ((files score-files))
(while files
(when (stringp (car files))
- (setcar files (expand-file-name (car files))))
+ (setcar files (expand-file-name (car files)
+ gnus-kill-files-directory)))
(pop files)))
+ (setq score-files (nreverse score-files))
;; Remove any duplicate score files.
(while (and score-files
(member (car score-files) (cdr score-files)))
projects / gnus / blobdiff