Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-score.el @ 24:4103f0995bd7 r19-15b95

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 8fc7fe29b841
children ec9a17fef872
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
41 score files in the \"/ftp.some-where:/pub/score\" directory. 41 score files in the \"/ftp.some-where:/pub/score\" directory.
42 42
43 (setq gnus-global-score-files 43 (setq gnus-global-score-files
44 '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\" 44 '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
45 \"/ftp.some-where:/pub/score\"))" 45 \"/ftp.some-where:/pub/score\"))"
46 :group 'gnus-score 46 :group 'gnus-score-files
47 :type '(repeat file)) 47 :type '(repeat file))
48 48
49 (defcustom gnus-score-file-single-match-alist nil 49 (defcustom gnus-score-file-single-match-alist nil
50 "Alist mapping regexps to lists of score files. 50 "Alist mapping regexps to lists of score files.
51 Each element of this alist should be of the form 51 Each element of this alist should be of the form
56 The first match found is used, subsequent matching entries are ignored (to 56 The first match found is used, subsequent matching entries are ignored (to
57 use multiple matches, see gnus-score-file-multiple-match-alist). 57 use multiple matches, see gnus-score-file-multiple-match-alist).
58 58
59 These score files are loaded in addition to any files returned by 59 These score files are loaded in addition to any files returned by
60 gnus-score-find-score-files-function (which see)." 60 gnus-score-find-score-files-function (which see)."
61 :group 'gnus-score 61 :group 'gnus-score-files
62 :type '(repeat (cons regexp (repeat file)))) 62 :type '(repeat (cons regexp (repeat file))))
63 63
64 (defcustom gnus-score-file-multiple-match-alist nil 64 (defcustom gnus-score-file-multiple-match-alist nil
65 "Alist mapping regexps to lists of score files. 65 "Alist mapping regexps to lists of score files.
66 Each element of this alist should be of the form 66 Each element of this alist should be of the form
72 match will be used (for only one match to be used, see 72 match will be used (for only one match to be used, see
73 gnus-score-file-single-match-alist). 73 gnus-score-file-single-match-alist).
74 74
75 These score files are loaded in addition to any files returned by 75 These score files are loaded in addition to any files returned by
76 gnus-score-find-score-files-function (which see)." 76 gnus-score-find-score-files-function (which see)."
77 :group 'gnus-score 77 :group 'gnus-score-files
78 :type '(repeat (cons regexp (repeat file)))) 78 :type '(repeat (cons regexp (repeat file))))
79 79
80 (defcustom gnus-score-file-suffix "SCORE" 80 (defcustom gnus-score-file-suffix "SCORE"
81 "Suffix of the score files." 81 "Suffix of the score files."
82 :group 'gnus-score 82 :group 'gnus-score-files
83 :type 'string) 83 :type 'string)
84 84
85 (defcustom gnus-adaptive-file-suffix "ADAPT" 85 (defcustom gnus-adaptive-file-suffix "ADAPT"
86 "Suffix of the adaptive score files." 86 "Suffix of the adaptive score files."
87 :group 'gnus-score 87 :group 'gnus-score-files
88 :group 'gnus-score-adapt
88 :type 'string) 89 :type 'string)
89 90
90 (defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews 91 (defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
91 "Function used to find score files. 92 "Function used to find score files.
92 The function will be called with the group name as the argument, and 93 The function will be called with the group name as the argument, and
102 See the documentation to these functions for more information. 103 See the documentation to these functions for more information.
103 104
104 This variable can also be a list of functions to be called. Each 105 This variable can also be a list of functions to be called. Each
105 function should either return a list of score files, or a list of 106 function should either return a list of score files, or a list of
106 score alists." 107 score alists."
107 :group 'gnus-score 108 :group 'gnus-score-files
108 :type '(radio (function-item gnus-score-find-single) 109 :type '(radio (function-item gnus-score-find-single)
109 (function-item gnus-score-find-hierarchical) 110 (function-item gnus-score-find-hierarchical)
110 (function-item gnus-score-find-bnews) 111 (function-item gnus-score-find-bnews)
111 (function :tag "Other"))) 112 (function :tag "Other")))
112 113
113 (defcustom gnus-score-interactive-default-score 1000 114 (defcustom gnus-score-interactive-default-score 1000
114 "*Scoring commands will raise/lower the score with this number as the default." 115 "*Scoring commands will raise/lower the score with this number as the default."
115 :group 'gnus-score 116 :group 'gnus-score-default
116 :type 'integer) 117 :type 'integer)
117 118
118 (defcustom gnus-score-expiry-days 7 119 (defcustom gnus-score-expiry-days 7
119 "*Number of days before unused score file entries are expired. 120 "*Number of days before unused score file entries are expired.
120 If this variable is nil, no score file entries will be expired." 121 If this variable is nil, no score file entries will be expired."
121 :group 'gnus-score 122 :group 'gnus-score-expire
122 :type '(choice (const :tag "never" nil) 123 :type '(choice (const :tag "never" nil)
123 number)) 124 number))
124 125
125 (defcustom gnus-update-score-entry-dates t 126 (defcustom gnus-update-score-entry-dates t
126 "*In non-nil, update matching score entry dates. 127 "*In non-nil, update matching score entry dates.
127 If this variable is nil, then score entries that provide matches 128 If this variable is nil, then score entries that provide matches
128 will be expired along with non-matching score entries." 129 will be expired along with non-matching score entries."
129 :group 'gnus-score 130 :group 'gnus-score-expire
130 :type 'boolean) 131 :type 'boolean)
131 132
132 (defcustom gnus-orphan-score nil 133 (defcustom gnus-orphan-score nil
133 "*All orphans get this score added. Set in the score file." 134 "*All orphans get this score added. Set in the score file."
134 :group 'gnus-score 135 :group 'gnus-score-default
135 :type 'integer) 136 :type 'integer)
136 137
137 (defcustom gnus-decay-scores nil 138 (defcustom gnus-decay-scores nil
138 "*If non-nil, decay non-permanent scores." 139 "*If non-nil, decay non-permanent scores."
139 :group 'gnus-score 140 :group 'gnus-score-decay
140 :type 'boolean) 141 :type 'boolean)
141 142
142 (defcustom gnus-decay-score-function 'gnus-decay-score 143 (defcustom gnus-decay-score-function 'gnus-decay-score
143 "*Function called to decay a score. 144 "*Function called to decay a score.
144 It is called with one parameter -- the score to be decayed." 145 It is called with one parameter -- the score to be decayed."
145 :group 'gnus-score 146 :group 'gnus-score-decay
146 :type '(radio (function-item gnus-decay-score) 147 :type '(radio (function-item gnus-decay-score)
147 (function :tag "Other"))) 148 (function :tag "Other")))
148 149
149 (defcustom gnus-score-decay-constant 3 150 (defcustom gnus-score-decay-constant 3
150 "*Decay all \"small\" scores with this amount." 151 "*Decay all \"small\" scores with this amount."
151 :group 'gnus-score 152 :group 'gnus-score-decay
152 :type 'integer) 153 :type 'integer)
153 154
154 (defcustom gnus-score-decay-scale .05 155 (defcustom gnus-score-decay-scale .05
155 "*Decay all \"big\" scores with this factor." 156 "*Decay all \"big\" scores with this factor."
156 :group 'gnus-score 157 :group 'gnus-score-decay
157 :type 'number) 158 :type 'number)
158 159
159 (defcustom gnus-home-score-file nil 160 (defcustom gnus-home-score-file nil
160 "Variable to control where interactive score entries are to go. 161 "Variable to control where interactive score entries are to go.
161 It can be: 162 It can be:
184 185
185 * A string. Use the string as the home score file. 186 * A string. Use the string as the home score file.
186 187
187 The list will be traversed from the beginning towards the end looking 188 The list will be traversed from the beginning towards the end looking
188 for matches." 189 for matches."
189 :group 'gnus-score 190 :group 'gnus-score-files
190 :type '(choice string 191 :type '(choice string
191 (repeat (choice string 192 (repeat (choice string
192 (cons regexp (repeat file)) 193 (cons regexp (repeat file))
193 function)) 194 function))
194 function)) 195 function))
195 196
196 (defcustom gnus-home-adapt-file nil 197 (defcustom gnus-home-adapt-file nil
197 "Variable to control where new adaptive score entries are to go. 198 "Variable to control where new adaptive score entries are to go.
198 This variable allows the same syntax as `gnus-home-score-file'." 199 This variable allows the same syntax as `gnus-home-score-file'."
199 :group 'gnus-score 200 :group 'gnus-score-adapt
201 :group 'gnus-score-files
200 :type '(choice string 202 :type '(choice string
201 (repeat (choice string 203 (repeat (choice string
202 (cons regexp (repeat file)) 204 (cons regexp (repeat file))
203 function)) 205 function))
204 function)) 206 function))
209 (gnus-read-mark (from 3) (subject 30)) 211 (gnus-read-mark (from 3) (subject 30))
210 (gnus-catchup-mark (subject -10)) 212 (gnus-catchup-mark (subject -10))
211 (gnus-killed-mark (from -1) (subject -20)) 213 (gnus-killed-mark (from -1) (subject -20))
212 (gnus-del-mark (from -2) (subject -15))) 214 (gnus-del-mark (from -2) (subject -15)))
213 "Alist of marks and scores." 215 "Alist of marks and scores."
214 :group 'gnus-score 216 :group 'gnus-score-adapt
215 :type '(repeat (cons (symbol :tag "Mark") 217 :type '(repeat (cons (symbol :tag "Mark")
216 (repeat (list (choice :tag "Header" 218 (repeat (list (choice :tag "Header"
217 (const from) 219 (const from)
218 (const subject) 220 (const subject)
219 (symbol :tag "other")) 221 (symbol :tag "other"))
220 (integer :tag "Score")))))) 222 (integer :tag "Score"))))))
221 223
222 (defcustom gnus-ignored-adaptive-words nil 224 (defcustom gnus-ignored-adaptive-words nil
223 "List of words to be ignored when doing adaptive word scoring." 225 "List of words to be ignored when doing adaptive word scoring."
224 :group 'gnus-score 226 :group 'gnus-score-adapt
225 :type '(repeat string)) 227 :type '(repeat string))
226 228
227 (defcustom gnus-default-ignored-adaptive-words 229 (defcustom gnus-default-ignored-adaptive-words
228 '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you" 230 '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you"
229 "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can" 231 "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can"
238 "right" "before" "our" "without" "too" "those" "why" "must" "part" 240 "right" "before" "our" "without" "too" "those" "why" "must" "part"
239 "being" "current" "back" "still" "go" "point" "value" "each" "did" 241 "being" "current" "back" "still" "go" "point" "value" "each" "did"
240 "both" "true" "off" "say" "another" "state" "might" "under" "start" 242 "both" "true" "off" "say" "another" "state" "might" "under" "start"
241 "try" "re") 243 "try" "re")
242 "Default list of words to be ignored when doing adaptive word scoring." 244 "Default list of words to be ignored when doing adaptive word scoring."
243 :group 'gnus-score 245 :group 'gnus-score-adapt
244 :type '(repeat string)) 246 :type '(repeat string))
245 247
246 (defcustom gnus-default-adaptive-word-score-alist 248 (defcustom gnus-default-adaptive-word-score-alist
247 `((,gnus-read-mark . 30) 249 `((,gnus-read-mark . 30)
248 (,gnus-catchup-mark . -10) 250 (,gnus-catchup-mark . -10)
249 (,gnus-killed-mark . -20) 251 (,gnus-killed-mark . -20)
250 (,gnus-del-mark . -15)) 252 (,gnus-del-mark . -15))
251 "Alist of marks and scores." 253 "Alist of marks and scores."
252 :group 'gnus-score 254 :group 'gnus-score-adapt
253 :type '(repeat (cons (character :tag "Mark") 255 :type '(repeat (cons (character :tag "Mark")
254 (integer :tag "Score")))) 256 (integer :tag "Score"))))
255 257
256 (defcustom gnus-score-mimic-keymap nil 258 (defcustom gnus-score-mimic-keymap nil
257 "*Have the score entry functions pretend that they are a keymap." 259 "*Have the score entry functions pretend that they are a keymap."
258 :group 'gnus-score 260 :group 'gnus-score-default
259 :type 'boolean) 261 :type 'boolean)
260 262
261 (defcustom gnus-score-exact-adapt-limit 10 263 (defcustom gnus-score-exact-adapt-limit 10
262 "*Number that says how long a match has to be before using substring matching. 264 "*Number that says how long a match has to be before using substring matching.
263 When doing adaptive scoring, one normally uses fuzzy or substring 265 When doing adaptive scoring, one normally uses fuzzy or substring
264 matching. However, if the header one matches is short, the possibility 266 matching. However, if the header one matches is short, the possibility
265 for false positives is great, so if the length of the match is less 267 for false positives is great, so if the length of the match is less
266 than this variable, exact matching will be used. 268 than this variable, exact matching will be used.
267 269
268 If this variable is nil, exact matching will always be used." 270 If this variable is nil, exact matching will always be used."
269 :group 'gnus-score 271 :group 'gnus-score-adapt
270 :type '(choice (const nil) integer)) 272 :type '(choice (const nil) integer))
271 273
272 (defcustom gnus-score-uncacheable-files "ADAPT$" 274 (defcustom gnus-score-uncacheable-files "ADAPT$"
273 "All score files that match this regexp will not be cached." 275 "All score files that match this regexp will not be cached."
274 :group 'gnus-score 276 :group 'gnus-score-adapt
277 :group 'gnus-score-files
275 :type 'regexp) 278 :type 'regexp)
276 279
277 (defcustom gnus-score-default-header nil 280 (defcustom gnus-score-default-header nil
278 "Default header when entering new scores. 281 "Default header when entering new scores.
279 282
289 l: lines 292 l: lines
290 d: date 293 d: date
291 f: followup 294 f: followup
292 295
293 If nil, the user will be asked for a header." 296 If nil, the user will be asked for a header."
294 :group 'gnus-score 297 :group 'gnus-score-default
295 :type '(choice (const :tag "from" a) 298 :type '(choice (const :tag "from" a)
296 (const :tag "subject" s) 299 (const :tag "subject" s)
297 (const :tag "body" b) 300 (const :tag "body" b)
298 (const :tag "head" h) 301 (const :tag "head" h)
299 (const :tag "message-id" i) 302 (const :tag "message-id" i)
318 <: less than number 321 <: less than number
319 >: greater than number 322 >: greater than number
320 =: equal to number 323 =: equal to number
321 324
322 If nil, the user will be asked for a match type." 325 If nil, the user will be asked for a match type."
323 :group 'gnus-score 326 :group 'gnus-score-default
324 :type '(choice (const :tag "substring" s) 327 :type '(choice (const :tag "substring" s)
325 (const :tag "exact string" e) 328 (const :tag "exact string" e)
326 (const :tag "fuzzy string" f) 329 (const :tag "fuzzy string" f)
327 (const :tag "regexp string" r) 330 (const :tag "regexp string" r)
328 (const :tag "before date" b) 331 (const :tag "before date" b)
332 (const :tag "greater than number" >) 335 (const :tag "greater than number" >)
333 (const :tag "equal than number" =))) 336 (const :tag "equal than number" =)))
334 337
335 (defcustom gnus-score-default-fold nil 338 (defcustom gnus-score-default-fold nil
336 "Use case folding for new score file entries iff not nil." 339 "Use case folding for new score file entries iff not nil."
337 :group 'gnus-score 340 :group 'gnus-score-default
338 :type 'boolean) 341 :type 'boolean)
339 342
340 (defcustom gnus-score-default-duration nil 343 (defcustom gnus-score-default-duration nil
341 "Default duration of effect when entering new scores. 344 "Default duration of effect when entering new scores.
342 345
345 t: temporary 348 t: temporary
346 p: permanent 349 p: permanent
347 i: immediate 350 i: immediate
348 351
349 If nil, the user will be asked for a duration." 352 If nil, the user will be asked for a duration."
350 :group 'gnus-score 353 :group 'gnus-score-default
351 :type '(choice (const :tag "temporary" t) 354 :type '(choice (const :tag "temporary" t)
352 (const :tag "permanent" p) 355 (const :tag "permanent" p)
353 (const :tag "immediate" i))) 356 (const :tag "immediate" i)))
354 357
355 (defcustom gnus-score-after-write-file-function nil 358 (defcustom gnus-score-after-write-file-function nil
356 "Function called with the name of the score file just written to disk." 359 "Function called with the name of the score file just written to disk."
357 :group 'gnus-score 360 :group 'gnus-score-files
358 :type 'function) 361 :type 'function)
359 362
360 363
361 364
362 ;; Internal variables. 365 ;; Internal variables.
2048 (gnus-short-group-name (file-name-nondirectory score-file)) 2051 (gnus-short-group-name (file-name-nondirectory score-file))
2049 "none"))) 2052 "none")))
2050 2053
2051 (defun gnus-score-adaptive () 2054 (defun gnus-score-adaptive ()
2052 "Create adaptive score rules for this newsgroup." 2055 "Create adaptive score rules for this newsgroup."
2053 (when gnus-use-adaptive-scoring 2056 (when gnus-newsgroup-adaptive
2054 ;; We change the score file to the adaptive score file. 2057 ;; We change the score file to the adaptive score file.
2055 (save-excursion 2058 (save-excursion
2056 (set-buffer gnus-summary-buffer) 2059 (set-buffer gnus-summary-buffer)
2057 (gnus-score-load-file 2060 (gnus-score-load-file
2058 (or gnus-newsgroup-adaptive-score-file 2061 (or gnus-newsgroup-adaptive-score-file
2059 (gnus-score-file-name 2062 (gnus-score-file-name
2060 gnus-newsgroup-name gnus-adaptive-file-suffix)))) 2063 gnus-newsgroup-name gnus-adaptive-file-suffix))))
2061 ;; Perform ordinary line scoring. 2064 ;; Perform ordinary line scoring.
2062 (when (or (not (listp gnus-use-adaptive-scoring)) 2065 (when (or (not (listp gnus-newsgroup-adaptive))
2063 (memq 'line gnus-use-adaptive-scoring)) 2066 (memq 'line gnus-newsgroup-adaptive))
2064 (save-excursion 2067 (save-excursion
2065 (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) 2068 (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
2066 (alist malist) 2069 (alist malist)
2067 (date (current-time-string)) 2070 (date (current-time-string))
2068 (data gnus-newsgroup-data) 2071 (data gnus-newsgroup-data)
2117 (nth 2 (car elem)) date nil t) 2120 (nth 2 (car elem)) date nil t)
2118 (setq elem (cdr elem))))) 2121 (setq elem (cdr elem)))))
2119 (setq data (cdr data)))))) 2122 (setq data (cdr data))))))
2120 2123
2121 ;; Perform adaptive word scoring. 2124 ;; Perform adaptive word scoring.
2122 (when (and (listp gnus-use-adaptive-scoring) 2125 (when (and (listp gnus-newsgroup-adaptive)
2123 (memq 'word gnus-use-adaptive-scoring)) 2126 (memq 'word gnus-newsgroup-adaptive))
2124 (nnheader-temp-write nil 2127 (nnheader-temp-write nil
2125 (let* ((hashtb (gnus-make-hashtable 1000)) 2128 (let* ((hashtb (gnus-make-hashtable 1000))
2126 (date (gnus-day-number (current-time-string))) 2129 (date (gnus-day-number (current-time-string)))
2127 (data gnus-newsgroup-data) 2130 (data gnus-newsgroup-data)
2128 (syntab (syntax-table)) 2131 (syntab (syntax-table))
2700 (defun gnus-hierarchial-home-score-file (group) 2703 (defun gnus-hierarchial-home-score-file (group)
2701 "Return the score file of the top-level hierarchy of GROUP." 2704 "Return the score file of the top-level hierarchy of GROUP."
2702 (if (string-match "^[^.]+\\." group) 2705 (if (string-match "^[^.]+\\." group)
2703 (concat (match-string 0 group) gnus-score-file-suffix) 2706 (concat (match-string 0 group) gnus-score-file-suffix)
2704 ;; Group name without any dots. 2707 ;; Group name without any dots.
2705 (concat group "." gnus-score-file-suffix))) 2708 (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
2709 gnus-score-file-suffix)))
2706 2710
2707 (defun gnus-hierarchial-home-adapt-file (group) 2711 (defun gnus-hierarchial-home-adapt-file (group)
2708 "Return the adapt file of the top-level hierarchy of GROUP." 2712 "Return the adapt file of the top-level hierarchy of GROUP."
2709 (if (string-match "^[^.]+\\." group) 2713 (if (string-match "^[^.]+\\." group)
2710 (concat (match-string 0 group) gnus-adaptive-file-suffix) 2714 (concat (match-string 0 group) gnus-adaptive-file-suffix)
2711 ;; Group name without any dots. 2715 ;; Group name without any dots.
2712 (concat group "." gnus-adaptive-file-suffix))) 2716 (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
2717 gnus-adaptive-file-suffix)))
2713 2718
2714 ;;; 2719 ;;;
2715 ;;; Score decays 2720 ;;; Score decays
2716 ;;; 2721 ;;;
2717 2722