Lines Matching defs:score
1 ;;; gnus-score.el --- scoring code for Gnus
38 (require 'score-mode)
42 (defcustom gnus-global-score-files nil
43 "List of global score files and directories.
44 Set this variable if you want to use people's score files. One entry
45 for each score file or each score file directory. Gnus will decide
46 by itself what score files are applicable to which group.
48 Say you want to use the single score file
49 \"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
50 score files in the \"/ftp.some-where:/pub/score\" directory.
52 (setq gnus-global-score-files
53 '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
54 \"/ftp.some-where:/pub/score\"))"
55 :group 'gnus-score-files
58 (defcustom gnus-score-file-single-match-alist nil
59 "Alist mapping regexps to lists of score files.
66 use multiple matches, see `gnus-score-file-multiple-match-alist').
68 These score files are loaded in addition to any files returned by
69 `gnus-score-find-score-files-function'."
70 :group 'gnus-score-files
73 (defcustom gnus-score-file-multiple-match-alist nil
74 "Alist mapping regexps to lists of score files.
80 If multiple REGEXPs match a group, the score files corresponding to each
82 `gnus-score-file-single-match-alist').
84 These score files are loaded in addition to any files returned by
85 `gnus-score-find-score-files-function'."
86 :group 'gnus-score-files
89 (defcustom gnus-score-file-suffix "SCORE"
90 "Suffix of the score files."
91 :group 'gnus-score-files
95 "Suffix of the adaptive score files."
96 :group 'gnus-score-files
97 :group 'gnus-score-adapt
100 (defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
101 "Function used to find score files.
103 should return a list of score files to apply to that group. The score
108 `gnus-score-find-single': Only apply the group's own score file.
109 `gnus-score-find-hierarchical': Also apply score files from parent groups.
110 `gnus-score-find-bnews': Apply score files whose names matches.
116 a list of score files, or a list of score alists.
119 the `a' symbolic prefix to the score commands will always use
121 :group 'gnus-score-files
122 :type '(radio (function-item gnus-score-find-single)
123 (function-item gnus-score-find-hierarchical)
124 (function-item gnus-score-find-bnews)
127 (function-item gnus-score-find-single)
128 (function-item gnus-score-find-hierarchical)
129 (function-item gnus-score-find-bnews)))
132 (defcustom gnus-score-interactive-default-score 1000
133 "*Scoring commands will raise/lower the score with this number as the default."
134 :group 'gnus-score-default
137 (defcustom gnus-score-expiry-days 7
138 "*Number of days before unused score file entries are expired.
139 If this variable is nil, no score file entries will be expired."
140 :group 'gnus-score-expire
144 (defcustom gnus-update-score-entry-dates t
145 "*If non-nil, update matching score entry dates.
146 If this variable is nil, then score entries that provide matches
147 will be expired along with non-matching score entries."
148 :group 'gnus-score-expire
153 :group 'gnus-score-decay
156 (defcustom gnus-decay-score-function 'gnus-decay-score
157 "*Function called to decay a score.
158 It is called with one parameter -- the score to be decayed."
159 :group 'gnus-score-decay
160 :type '(radio (function-item gnus-decay-score)
163 (defcustom gnus-score-decay-constant 3
165 :group 'gnus-score-decay
168 (defcustom gnus-score-decay-scale .05
170 :group 'gnus-score-decay
173 (defcustom gnus-home-score-file nil
174 "Variable to control where interactive score entries are to go.
178 This file will be used as the home score file.
181 The result of this function will be used as the home score file.
190 will be used as the home score file. (Multiple filenames are
191 allowed so that one may use gnus-score-file-single-match-alist to
196 as the home score file. The function will be passed the
199 * A string. Use the string as the home score file.
203 :group 'gnus-score-files
208 (function-item gnus-hierarchial-home-score-file)
209 (function-item gnus-current-home-score-file)
213 "Variable to control where new adaptive score entries are to go.
214 This variable allows the same syntax as `gnus-home-score-file'."
215 :group 'gnus-score-adapt
216 :group 'gnus-score-files
223 (defcustom gnus-default-adaptive-score-alist
227 (from , (+ 2 gnus-score-decay-constant))
228 (subject , (+ 27 gnus-score-decay-constant)))
230 (subject , (+ -7 (* -1 gnus-score-decay-constant))))
232 (from , (- -1 gnus-score-decay-constant))
233 (subject , (+ -17 (* -1 gnus-score-decay-constant))))
235 (from , (- -1 gnus-score-decay-constant))
236 (subject , (+ -12 (* -1 gnus-score-decay-constant)))))
238 If you use score decays, you might want to set values higher than
239 `gnus-score-decay-constant'."
240 :group 'gnus-score-adapt
251 :group 'gnus-score-adapt
257 :group 'gnus-score-adapt
276 :group 'gnus-score-adapt
279 (defcustom gnus-default-adaptive-word-score-alist
285 :group 'gnus-score-adapt
290 "If a number, this is the minimum score value that can be assigned to a word."
291 :group 'gnus-score-adapt
295 "If t, don't adaptively score words included in the group name."
296 :group 'gnus-score-adapt
299 (defcustom gnus-score-mimic-keymap nil
300 "*Have the score entry functions pretend that they are a keymap."
301 :group 'gnus-score-default
304 (defcustom gnus-score-exact-adapt-limit 10
312 :group 'gnus-score-adapt
315 (defcustom gnus-score-uncacheable-files "ADAPT$"
316 "All score files that match this regexp will not be cached."
317 :group 'gnus-score-adapt
318 :group 'gnus-score-files
321 (defcustom gnus-score-default-header nil
339 :group 'gnus-score-default
353 (defcustom gnus-score-default-type nil
370 :group 'gnus-score-default
383 (defcustom gnus-score-default-fold nil
384 "Use case folding for new score file entries iff not nil."
385 :group 'gnus-score-default
388 (defcustom gnus-score-default-duration nil
398 :group 'gnus-score-default
404 (defcustom gnus-score-after-write-file-function nil
405 "Function called with the name of the score file just written to disk."
406 :group 'gnus-score-files
409 (defcustom gnus-score-thread-simplify nil
411 :group 'gnus-score-various
419 (defvar gnus-score-use-all-scores t
420 "If nil, only `gnus-score-find-score-files-function' is used.")
432 (defvar gnus-internal-global-score-files nil)
433 (defvar gnus-score-file-list nil)
435 (defvar gnus-short-name-score-file-cache nil)
437 (defvar gnus-score-help-winconf nil)
438 (defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
439 (defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist)
440 (defvar gnus-score-trace nil)
441 (defvar gnus-score-edit-buffer nil)
443 (defvar gnus-score-alist nil
444 "Alist containing score information.
450 files: List of other score files to load when loading this one.
451 eval: Sexp to be evaluated when the score file is loaded.
456 substring matching, SCORE is the score to add and DATE is the date
459 (defvar gnus-score-cache nil)
461 (defvar gnus-score-index nil)
466 '(("number" 0 gnus-score-integer)
467 ("subject" 1 gnus-score-string)
468 ("from" 2 gnus-score-string)
469 ("date" 3 gnus-score-date)
470 ("message-id" 4 gnus-score-string)
471 ("references" 5 gnus-score-string)
472 ("chars" 6 gnus-score-integer)
473 ("lines" 7 gnus-score-integer)
474 ("xref" 8 gnus-score-string)
475 ("extra" 9 gnus-score-string)
476 ("head" -1 gnus-score-body)
477 ("body" -1 gnus-score-body)
478 ("all" -1 gnus-score-body)
479 ("followup" 2 gnus-score-followup)
480 ("thread" 5 gnus-score-thread)))
482 ;;; Summary mode score maps.
484 (gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
485 "s" gnus-summary-set-score
486 "S" gnus-summary-current-score
487 "c" gnus-score-change-score-file
488 "C" gnus-score-customize
489 "m" gnus-score-set-mark-below
490 "x" gnus-score-set-expunge-below
492 "e" gnus-score-edit-current-scores
493 "f" gnus-score-edit-file
494 "F" gnus-score-flush-cache
495 "t" gnus-score-find-trace
496 "w" gnus-score-find-favourite-words)
498 ;; Summary score file commands
500 ;; Much modification of the kill (ahem, score) code and lots of the
503 (defun gnus-summary-lower-score (&optional score symp)
504 "Make a score entry based on the current article.
505 The user will be prompted for header to score on, match type,
507 used as score. A symbolic prefix of `a' says to use the `all.SCORE'
508 file for the command instead of the current score file."
510 (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
512 (defun gnus-score-kill-help-buffer ()
515 (when gnus-score-help-winconf
516 (set-window-configuration gnus-score-help-winconf))))
518 (defun gnus-summary-increase-score (&optional score symp)
519 "Make a score entry based on the current article.
520 The user will be prompted for header to score on, match type,
522 used as score. A symbolic prefix of `a' says to use the `all.SCORE'
523 file for the command instead of the current score file."
525 (let* ((nscore (gnus-score-delta-default score))
554 (current-score-file gnus-current-score-file)
558 (mimic gnus-score-mimic-keymap)
559 (hchar (and gnus-score-default-header
560 (aref (symbol-name gnus-score-default-header) 0)))
561 (tchar (and gnus-score-default-type
562 (aref (symbol-name gnus-score-default-type) 0)))
563 (pchar (and gnus-score-default-duration
564 (aref (symbol-name gnus-score-default-duration) 0)))
570 ;; First we read the header to score.
582 (gnus-score-insert-help "Match on header" char-to-header 1)))
584 (gnus-score-kill-help-buffer)
615 (gnus-score-insert-help "Match type" legal-types 2)))
617 (gnus-score-kill-help-buffer)
639 (gnus-score-insert-help "Match permanence" char-to-perm 2)))
641 (gnus-score-kill-help-buffer)
654 ;; Always kill the score help buffer.
655 (gnus-score-kill-help-buffer))
673 ;; We have all the data, so we enter this score.
689 ;; Change score file to the "all.SCORE" file.
693 (gnus-score-load-file
696 ((eq gnus-score-find-score-files-function
697 'gnus-score-find-hierarchical)
698 (gnus-score-file-name ""))
699 ((eq gnus-score-find-score-files-function 'gnus-score-find-single)
700 current-score-file)
702 (gnus-score-file-name "all"))))))
704 (gnus-summary-score-entry
708 (if (eq score 's) nil score) ; Score
717 ;; We change the score file back to the previous one.
720 (gnus-score-load-file current-score-file)))))
722 (defun gnus-score-insert-help (string alist idx)
723 (setq gnus-score-help-winconf (current-window-configuration))
783 (defun gnus-newsgroup-score-alist ()
786 gnus-newsgroup-name 'score-file)))
788 (gnus-score-load param-file)))
789 (gnus-score-load
790 (gnus-score-file-name gnus-newsgroup-name)))
791 gnus-score-alist)
793 (defsubst gnus-score-get (symbol &optional alist)
797 gnus-score-alist
798 (gnus-newsgroup-score-alist)))))
800 (defun gnus-summary-score-entry (header match type score date
802 "Enter score file entry.
806 SCORE is the score to add.
809 If optional argument `SILENT' is nil, show effect of score entry.
819 (let ((score (gnus-score-delta-default score))
832 (if (< score 0) "lower" "raise"))
838 (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
844 ;; Add the score entry to the score file.
845 (when (= score gnus-score-interactive-default-score)
846 (setq score nil))
847 (let ((old (gnus-score-get header))
852 (list match score
857 (list match score
861 (date (list match score (date-to-day date)))
862 (score (list match score))
864 ;; We see whether we can collapse some score entries.
872 ;; Yup, we just add this new score to the old elem.
874 gnus-score-interactive-default-score)
876 gnus-score-interactive-default-score)))
878 (gnus-score-set header (if old (cons new old) (list new)) nil t))
879 (gnus-score-set 'touched '(t))))
885 'gnus-score-string))
886 (gnus-summary-score-effect header match type score extra)
892 (defun gnus-summary-score-effect (header match type score &optional extra)
893 "Simulate the effect of a score file entry.
896 TYPE is the score type.
897 SCORE is the score to add.
926 (gnus-summary-raise-score score))))
930 (defun gnus-summary-score-crossposting (score date)
931 ;; Enter score file entry for current crossposting.
932 ;; SCORE is the score to add.
945 (gnus-summary-score-entry
946 "xref" (concat " " group ":") nil score date t)))))
954 ;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
956 (defun gnus-score-set-mark-below (score)
957 "Automatically mark articles with score below SCORE as read."
961 (setq score (or score gnus-summary-default-score 0))
962 (gnus-score-set 'mark (list score))
963 (gnus-score-set 'touched '(t))
964 (setq gnus-summary-mark-below score)
965 (gnus-score-update-lines))
967 (defun gnus-score-update-lines ()
975 (defun gnus-score-update-all-lines ()
990 (defun gnus-score-set-expunge-below (score)
991 "Automatically expunge articles with score below SCORE."
995 (setq score (or score gnus-summary-default-score 0))
996 (gnus-score-set 'expunge (list score))
997 (gnus-score-set 'touched '(t)))
999 (defun gnus-score-followup-article (&optional score)
1002 (setq score (gnus-score-delta-default score))
1010 (gnus-summary-score-entry
1012 score (current-time-string) nil t)))))))
1014 (defun gnus-score-followup-thread (&optional score)
1017 (setq score (gnus-score-delta-default score))
1025 (gnus-summary-score-entry
1027 score (current-time-string))))))))
1029 (defun gnus-score-set (symbol value &optional alist warn)
1033 gnus-score-alist
1034 (gnus-newsgroup-score-alist)))
1036 (cond ((gnus-score-get 'read-only alist)
1037 ;; This is a read-only score file, so we do nothing.
1039 (gnus-message 4 "Note: read-only score file; entry discarded")))
1048 (defun gnus-summary-raise-score (n)
1049 "Raise the score of the current article by N."
1051 (gnus-summary-set-score (+ (gnus-summary-article-score)
1052 (or n gnus-score-interactive-default-score ))))
1054 (defun gnus-summary-set-score (n)
1055 "Set the score of the current article to N."
1060 ;; Set score.
1062 (if (= n (or gnus-summary-default-score 0)) ? ;Whitespace
1063 (if (< n (or gnus-summary-default-score 0))
1064 gnus-score-below-mark gnus-score-over-mark))
1065 'score))
1067 (score (assq article gnus-newsgroup-scored)))
1068 (if score (setcdr score n)
1072 (defun gnus-summary-current-score ()
1073 "Return the score of the current article."
1075 (gnus-message 1 "%s" (gnus-summary-article-score)))
1077 (defun gnus-score-change-score-file (file)
1078 "Change current score alist."
1080 (list (read-file-name "Change to score file: " gnus-kill-files-directory)))
1081 (gnus-score-load-file file)
1084 (defvar gnus-score-edit-exit-function)
1085 (defun gnus-score-edit-current-scores (file)
1086 "Edit the current score alist."
1087 (interactive (list gnus-current-score-file))
1088 (if (not gnus-current-score-file)
1089 (error "No current score file")
1092 (gnus-score-save))
1094 (setq gnus-score-edit-buffer (find-file-noselect file))
1095 (gnus-configure-windows 'edit-score)
1096 (gnus-score-mode)
1097 (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
1102 "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
1104 (defun gnus-score-edit-file (file)
1105 "Edit a score file."
1107 (list (read-file-name "Edit score file: " gnus-kill-files-directory)))
1110 (gnus-score-save))
1112 (setq gnus-score-edit-buffer (find-file-noselect file))
1113 (gnus-configure-windows 'edit-score)
1114 (gnus-score-mode)
1115 (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
1120 "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
1122 (defun gnus-score-edit-file-at-point (&optional format)
1123 "Edit score file at point in Score Trace buffers.
1124 If FORMAT, also format the current score file."
1129 ;; Must be synced with `gnus-score-find-trace':
1139 ;; (see `gnus-score-find-trace' and `gnus-score-advanced')
1141 (gnus-error 3 "Can't find a score file in current line.")
1142 (gnus-score-edit-file file)
1144 (gnus-score-pretty-print))
1155 (defun gnus-score-load-file (file)
1156 ;; Load score file FILE. Returns a list a retrieved score-alists.
1165 (cached (assoc file gnus-score-cache))
1166 (global (member file gnus-internal-global-score-files))
1169 ;; The score file was already loaded.
1171 ;; We load the score file.
1172 (setq gnus-score-alist nil)
1173 (setq alist (gnus-score-load-score-alist file))
1178 ;; If it is a global score file, we make it read-only.
1182 (push (cons file alist) gnus-score-cache))
1199 ;; Treat the other possible atoms in the score alist.
1200 (let ((mark (car (gnus-score-get 'mark alist)))
1201 (expunge (car (gnus-score-get 'expunge alist)))
1202 (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
1203 (files (gnus-score-get 'files alist))
1204 (exclude-files (gnus-score-get 'exclude-files alist))
1205 (orphan (car (gnus-score-get 'orphan alist)))
1206 (adapt (gnus-score-get 'adapt alist))
1208 (car (gnus-score-get 'thread-mark-and-expunge alist)))
1209 (adapt-file (car (gnus-score-get 'adapt-file alist)))
1210 (local (gnus-score-get 'local alist))
1211 (decay (car (gnus-score-get 'decay alist)))
1212 (eval (car (gnus-score-get 'eval alist))))
1218 (gnus-score-set 'touched '(t) alist)
1219 (gnus-score-set 'decay (list (time-to-days (current-time))) alist))
1220 ;; We do not respect eval and files atoms from global score
1225 (gnus-score-load-file file))
1253 (setq gnus-orphan-score orphan))
1254 (setq gnus-adaptive-score-alist
1257 gnus-default-adaptive-score-alist)
1264 gnus-default-adaptive-score-alist)))
1271 (setq gnus-newsgroup-adaptive-score-file
1272 (or adapt-file gnus-newsgroup-adaptive-score-file)))
1273 (setq gnus-current-score-file file)
1274 (setq gnus-score-alist alist)
1277 (defun gnus-score-load (file)
1278 ;; Load score FILE.
1279 (let ((cache (assoc file gnus-score-cache)))
1281 (setq gnus-score-alist (cdr cache))
1282 (setq gnus-score-alist nil)
1283 (gnus-score-load-score-alist file)
1284 (unless gnus-score-alist
1285 (setq gnus-score-alist (copy-alist '((touched nil)))))
1286 (push (cons file gnus-score-alist) gnus-score-cache))))
1288 (defun gnus-score-remove-from-cache (file)
1289 (setq gnus-score-cache
1290 (delq (assoc file gnus-score-cache) gnus-score-cache)))
1292 (defun gnus-score-load-score-alist (file)
1293 "Read score FILE."
1297 (setq gnus-score-alist nil)
1300 (let ((coding-system-for-read score-mode-coding-system))
1303 ;; Only do the loading if the score file isn't empty.
1309 (gnus-error 3.2 "Problem with score file %s" file))))))
1313 ;; Bogus score file.
1314 (error "Invalid syntax with score file %s" file))
1316 ;; This is an old-style score file.
1317 (setq gnus-score-alist (gnus-score-transform-old-to-new alist)))
1319 (setq gnus-score-alist alist)))
1320 ;; Check the syntax of the score file.
1321 (setq gnus-score-alist
1322 (gnus-score-check-syntax gnus-score-alist file)))))
1324 (defun gnus-score-check-syntax (alist file)
1325 "Check the syntax of the score ALIST."
1341 (format "Invalid score element %s in %s" (car a) file))
1358 (format "Non-integer score %s in %s" (cadr s) file))
1373 (defun gnus-score-transform-old-to-new (alist)
1397 (defun gnus-score-save ()
1398 ;; Save all score information.
1399 (let ((cache gnus-score-cache)
1400 entry score file)
1402 (setq gnus-score-alist nil)
1408 score (cdr entry))
1409 (if (or (not (equal (gnus-score-get 'touched score) '(t)))
1410 (gnus-score-get 'read-only score)
1414 (setq score (setcdr entry (gnus-delete-alist 'touched score)))
1420 ;; This is an adaptive score file, so we do not run
1423 (gnus-prin1 score)
1424 ;; This is a normal score file, so we print it very
1426 (let ((lisp-mode-syntax-table score-mode-syntax-table))
1427 (gnus-pp score))))
1429 ;; If the score file is empty, we delete it.
1434 (let ((coding-system-for-write score-mode-coding-system))
1436 (when gnus-score-after-write-file-function
1437 (funcall gnus-score-after-write-file-function file)))))
1438 (and gnus-score-uncacheable-files
1439 (string-match gnus-score-uncacheable-files file)
1440 (gnus-score-remove-from-cache file)))
1443 (defun gnus-score-load-files (score-files)
1444 "Load all score files in SCORE-FILES."
1445 ;; Load the score files.
1447 (while score-files
1448 (if (stringp (car score-files))
1449 ;; It is a string, which means that it's a score file name,
1450 ;; so we load the score file and add the score alist to
1452 (setq scores (nconc (gnus-score-load-file (car score-files)) scores))
1454 (setq scores (nconc (car score-files) scores)))
1455 (setq score-files (cdr score-files)))
1456 ;; Prune the score files that are to be excluded, if any.
1461 (and (setq c (rassq (car s) gnus-score-cache))
1467 (defun gnus-score-headers (score-files &optional trace)
1470 ;; PLM: probably this is not the best place to clear orphan-score
1471 (setq gnus-orphan-score nil
1474 scores (gnus-score-load-files score-files))
1480 (when (and gnus-summary-default-score
1484 (expire (and gnus-score-expiry-days
1485 (- now gnus-score-expiry-days)))
1487 (current-score-file gnus-current-score-file)
1497 (cons (cons header (or gnus-summary-default-score 0))
1507 (setq gnus-current-score-file current-score-file)
1508 ;; score orphans
1509 (when gnus-orphan-score
1510 (setq gnus-score-index
1512 (gnus-score-orphans gnus-orphan-score))
1513 ;; Run each header through the score process.
1517 gnus-score-index (nth 1 (assoc header gnus-header-index)))
1519 (lambda (score)
1520 (length (gnus-score-get header score)))
1535 (when (or (/= gnus-summary-default-score
1537 gnus-save-score)
1543 (let (score)
1544 (while (setq score (pop scores))
1545 (while score
1546 (when (consp (caar score))
1547 (gnus-score-advanced (car score) trace))
1548 (pop score))))
1552 (defun gnus-score-lower-thread (thread score-adjust)
1553 "Lower the score on THREAD with SCORE-ADJUST.
1557 article in the tree, the score of the corresponding entry in
1563 (gnus-score-lower-thread head score-adjust)
1566 (score (assq article gnus-newsgroup-scored)))
1567 (if score (setcdr score (+ (cdr score) score-adjust))
1568 (push (cons article score-adjust) gnus-newsgroup-scored)))))
1571 (defun gnus-score-orphans (score)
1576 score in `gnus-newsgroup-scored' by SCORE."
1578 ;; as described in the gnus-score-lower-thread docs. This function
1583 (let ((id (aref (car thread) gnus-score-index)))
1584 ;; If the parent of the thread is not a root, lower the score of
1589 (gnus-score-lower-thread thread score)))))
1591 (defun gnus-score-integer (scores header now expire &optional trace)
1592 (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
1604 (score (or (nth 1 kill) gnus-score-interactive-default-score))
1613 ;; `gnus-score-string' does to minimize searches and stuff,
1619 (or (aref (caar articles) gnus-score-index) 0)
1622 (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
1623 gnus-score-trace))
1625 (setcdr (car articles) (+ score (cdar articles))))
1629 ((and found gnus-update-score-entry-dates) ;Match, update date.
1630 (gnus-score-set 'touched '(t) alist)
1633 (gnus-score-set 'touched '(t) alist)
1639 (defun gnus-score-date (scores header now expire &optional trace)
1640 (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
1651 (score (or (nth 1 kill) gnus-score-interactive-default-score))
1671 ;; `gnus-score-string' does to minimize searches and stuff,
1677 (setq l (aref (car article) gnus-score-index))
1680 (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
1681 gnus-score-trace))
1683 (setcdr article (+ score (cdr article)))))
1686 ((and found gnus-update-score-entry-dates) ;Match, update date.
1687 (gnus-score-set 'touched '(t) alist)
1690 (gnus-score-set 'touched '(t) alist)
1696 (defun gnus-score-body (scores header now expire &optional trace)
1754 (score (or (nth 1 kill)
1755 gnus-score-interactive-default-score))
1773 (setcdr (car articles) (+ score (cdar articles)))
1777 (cons (car-safe (rassq alist gnus-score-cache))
1779 gnus-score-trace)))
1784 ((and found gnus-update-score-entry-dates)
1786 (gnus-score-set 'touched '(t) alist)
1789 (gnus-score-set 'touched '(t) alist)
1796 (defun gnus-score-thread (scores header now expire &optional trace)
1797 (gnus-score-followup scores header now expire trace t))
1799 (defun gnus-score-followup (scores header now expire &optional trace thread)
1804 (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
1805 (current-score-file gnus-current-score-file)
1807 ;; gnus-score-index is used as a free variable.
1811 ;; Change score file to the adaptive score file. All entries that
1815 (gnus-score-load-file
1816 (or gnus-newsgroup-adaptive-score-file
1817 (gnus-score-file-name
1821 'gnus-score-string<)
1827 this (aref (car art) gnus-score-index)
1850 (score (or (nth 1 kill) gnus-score-interactive-default-score))
1876 (gnus-score-add-followups
1877 (car art) score all-scores thread))))
1884 (setcdr art (+ score (cdr art)))
1887 (car-safe (rassq alist gnus-score-cache))
1889 gnus-score-trace))
1890 (when (setq new (gnus-score-add-followups
1891 (car art) score all-scores thread))
1895 ((and found gnus-update-score-entry-dates)
1897 (gnus-score-set 'touched '(t) alist)
1900 (gnus-score-set 'touched '(t) alist)
1904 ;; We change the score file back to the previous one.
1907 (gnus-score-load-file current-score-file))
1910 (defun gnus-score-add-followups (header score scores &optional thread)
1911 "Add a score entry to the adapt file."
1917 ;; Don't enter a score if there already is one.
1925 (gnus-summary-score-entry
1927 id 's score (current-time-string) nil t)))))
1929 (defun gnus-score-string (score-list header now expire &optional trace)
1935 (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
1936 ;; gnus-score-index is used as a free variable.
1937 (simplify (and gnus-score-thread-simplify
1950 (if (= gnus-score-index 9)
1952 (sort gnus-scores-articles 'gnus-score-string<))
1957 (setq this (aref (car art) gnus-score-index))
1962 (if (= gnus-score-index 9)
1983 ;; Go through all the score alists and pick out the entries
1985 (while score-list
1986 (setq alist (pop score-list)
1988 ;; each score alist.
1993 (score (or (nth 1 kill) gnus-score-interactive-default-score))
2043 (setcdr art (+ score (cdr art)))
2046 (car-safe (rassq alist gnus-score-cache))
2048 gnus-score-trace))
2050 (setcdr art (+ score (cdr art)))))))
2060 ((and found gnus-update-score-entry-dates)
2061 (gnus-score-set 'touched '(t) alist)
2066 (gnus-score-set 'touched '(t) alist)
2084 (setcdr art (+ score (cdr art)))
2085 (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
2086 gnus-score-trace))
2088 (setcdr art (+ score (cdr art)))))
2098 ((and found gnus-update-score-entry-dates)
2099 (gnus-score-set 'touched '(t) alist)
2104 (gnus-score-set 'touched '(t) alist)
2117 (score (or (nth 1 kill) gnus-score-interactive-default-score))
2130 (setcdr art (+ score (cdr art)))
2132 (car-safe (rassq (cdar fuzzies) gnus-score-cache))
2134 gnus-score-trace))
2137 (setcdr art (+ score (cdr art))))))
2147 ((and found gnus-update-score-entry-dates)
2148 (gnus-score-set 'touched '(t) (cdar fuzzies))
2152 (gnus-score-set 'touched '(t) (cdar fuzzies))
2160 (gnus-enter-score-words-into-hashtb hashtb)
2162 (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score))
2170 (setcdr art (+ score (cdr art)))
2172 (car-safe (rassq (cdar words) gnus-score-cache))
2174 gnus-score-trace))
2177 (setcdr art (+ score (cdr art))))))
2186 ((and found gnus-update-score-entry-dates)
2187 (gnus-score-set 'touched '(t) (cdar words))
2191 (gnus-score-set 'touched '(t) (cdar words))
2196 (defun gnus-enter-score-words-into-hashtb (hashtb)
2226 (defun gnus-score-string< (a1 a2)
2228 ;; The header index used is the free variable `gnus-score-index'.
2229 (string-lessp (aref (car a1) gnus-score-index)
2230 (aref (car a2) gnus-score-index)))
2232 (defun gnus-current-score-file-nondirectory (&optional score-file)
2233 (let ((score-file (or score-file gnus-current-score-file)))
2234 (if score-file
2235 (gnus-short-group-name (file-name-nondirectory score-file))
2238 (defun gnus-score-adaptive ()
2239 "Create adaptive score rules for this newsgroup."
2241 ;; We change the score file to the adaptive score file.
2244 (gnus-score-load-file
2245 (or gnus-newsgroup-adaptive-score-file
2246 (gnus-home-score-file gnus-newsgroup-name t)
2247 (gnus-score-file-name
2253 (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
2283 ;; Then we score away.
2292 (gnus-summary-score-entry
2302 (if (or (not gnus-score-exact-adapt-limit)
2303 (< (length match) gnus-score-exact-adapt-limit))
2319 word d score val)
2327 (setq score
2330 gnus-adaptive-word-score-alist))))
2338 ;; Put the word and score into the hashtb.
2344 (setq val (+ score (or val 0)))
2367 (gnus-summary-score-entry
2372 (defun gnus-score-edit-done ()
2377 (gnus-score-remove-from-cache bufnam)
2378 (gnus-score-load-file bufnam)))
2380 (defun gnus-score-find-trace ()
2381 "Find all score rules that applies to the current article."
2387 ;; Must be synced with `gnus-score-edit-file-at-point':
2393 (setq gnus-score-trace nil)
2394 (gnus-possibly-score-headers 'trace)
2395 (if (not (setq trace gnus-score-trace))
2397 1 "No score rules apply to the current article (default score %d)."
2398 gnus-summary-default-score)
2407 "Run `gnus-score-edit-file-at-point'."
2409 (gnus-score-edit-file-at-point)))
2411 "Run `gnus-score-edit-file-at-point'."
2413 (gnus-score-edit-file-at-point 'format)))
2419 ;; `gnus-score-edit-file-at-point':
2431 Type `e' to edit score file corresponding to the score rule on current line,
2432 `f' to format (pretty print) the score file and edit it,
2436 The first sexp on each line is the score rule, followed by the file name of
2437 the score file and its full name, including the directory.")
2439 (gnus-configure-windows 'score-trace)))
2443 (defun gnus-score-find-favourite-words ()
2446 (let ((alists (gnus-score-load-files (gnus-all-score-files)))
2448 ;; Go through all the score alists for this group
2457 gnus-score-interactive-default-score)
2473 (gnus-error 3 "No word score rules")
2478 (gnus-configure-windows 'score-words))))
2483 (gnus-score-save)
2484 (setq gnus-score-cache nil)
2486 (gnus-possibly-score-headers)
2487 (gnus-score-update-all-lines))
2489 (defun gnus-score-flush-cache ()
2490 "Flush the cache of score files."
2492 (gnus-score-save)
2493 (setq gnus-score-cache nil
2494 gnus-score-alist nil
2495 gnus-short-name-score-file-cache nil)
2496 (gnus-message 6 "The score cache is now flushed"))
2498 (gnus-add-shutdown 'gnus-score-close 'gnus)
2500 (defvar gnus-score-file-alist-cache nil)
2502 (defun gnus-score-close ()
2503 "Clear all internal score variables."
2504 (setq gnus-score-cache nil
2505 gnus-internal-global-score-files nil
2506 gnus-score-file-list nil
2507 gnus-score-file-alist-cache nil))
2509 ;; Summary score marking commands.
2511 (defun gnus-summary-raise-same-subject-and-select (score)
2515 (gnus-summary-raise-score score)
2517 (gnus-summary-raise-score score))
2520 (defun gnus-summary-raise-same-subject (score)
2524 (gnus-summary-raise-score score)
2526 (gnus-summary-raise-score score))
2529 (defun gnus-score-delta-default (level)
2531 gnus-score-interactive-default-score))
2533 (defun gnus-summary-raise-thread (&optional score)
2534 "Raise the score of the articles in the current thread with SCORE."
2536 (setq score (gnus-score-delta-default score))
2542 (gnus-summary-raise-score score)
2552 (defun gnus-summary-lower-same-subject-and-select (score)
2555 (gnus-summary-raise-same-subject-and-select (- score)))
2557 (defun gnus-summary-lower-same-subject (score)
2560 (gnus-summary-raise-same-subject (- score)))
2562 (defun gnus-summary-lower-thread (&optional score)
2563 "Lower score of articles in the current thread with SCORE."
2565 (gnus-summary-raise-thread (- (gnus-score-delta-default score))))
2567 ;;; Finding score files.
2569 (defun gnus-score-score-files (group)
2570 "Return a list of all possible score files."
2571 ;; Search and set any global score files.
2572 (when gnus-global-score-files
2573 (unless gnus-internal-global-score-files
2574 (gnus-score-search-global-directories gnus-global-score-files)))
2578 ;; If we can't read it, there are no score files.
2580 (setq gnus-score-file-list nil)
2581 (if (not (gnus-use-long-file-name 'not-score))
2584 (setq gnus-score-file-list
2586 (or gnus-short-name-score-file-cache
2588 (gnus-message 6 "Finding all score files...")
2589 (setq gnus-short-name-score-file-cache
2590 (gnus-score-score-files-1
2592 (gnus-message 6 "Finding all score files...done")))))
2594 (when (or (not gnus-score-file-list)
2595 (not (car gnus-score-file-list))
2597 (car gnus-score-file-list)))
2598 (setq gnus-score-file-list
2603 (gnus-score-file-regexp)))))))
2604 (cdr gnus-score-file-list)))
2606 (defun gnus-score-score-files-1 (dir)
2607 "Return all possible score files under DIR."
2609 (regexp (gnus-score-file-regexp))
2622 ;; Add files to the list of score files.
2630 (defun gnus-score-file-regexp ()
2631 "Return a regexp that match all score files."
2632 (concat "\\(" (regexp-quote gnus-score-file-suffix )
2635 (defun gnus-score-find-bnews (group)
2636 "Return a list of score files for GROUP.
2637 The score files are those files in the ~/News/ directory which matches
2639 (let* ((sfiles (append (gnus-score-score-files group)
2640 gnus-internal-global-score-files))
2644 (score-regexp (gnus-score-file-regexp))
2649 (set-buffer (gnus-get-buffer-create "*gnus score files*"))
2651 ;; Go through all score file names and create regexp with them
2658 (when (re-search-forward (concat "." score-regexp) nil t)
2700 ;; we add this score file to the list of score files
2710 ;; Slight kludge here - the last score file returned should be
2711 ;; the local score file, whether it exists or not. This is so
2712 ;; that any score commands the user enters will go to the right
2713 ;; file, and not end up in some global score file.
2714 (let ((localscore (gnus-score-file-name group)))
2716 (gnus-sort-score-files (nreverse ofiles)))))
2718 (defun gnus-score-find-single (group)
2719 "Return list containing the score file for GROUP."
2720 (list (or gnus-newsgroup-adaptive-score-file
2721 (gnus-score-file-name group gnus-adaptive-file-suffix))
2722 (gnus-score-file-name group)))
2724 (defun gnus-score-find-hierarchical (group)
2725 "Return list of score files for GROUP.
2726 This includes the score file for the group and all its parents."
2738 (gnus-score-file-name group gnus-adaptive-file-suffix))
2740 (mapcar 'gnus-score-file-name all)))
2750 (defun gnus-score-file-rank (file)
2751 "Return a number that says how specific score FILE is.
2753 (if (member file gnus-internal-global-score-files)
2772 (defun gnus-sort-score-files (files)
2778 (cons (inline (gnus-score-file-rank file)) file))
2784 (defun gnus-score-find-alist (group)
2785 "Return list of score files for GROUP.
2786 The list is determined from the variable `gnus-score-file-alist'."
2787 (let ((alist gnus-score-file-multiple-match-alist)
2788 score-files)
2790 (if (setq score-files (assoc group gnus-score-file-alist-cache))
2791 (cdr score-files) ;ensures caching groups with no matches
2795 (setq score-files
2796 (nconc score-files (copy-sequence (cdar alist)))))
2798 (setq alist gnus-score-file-single-match-alist)
2803 ;; and score-files is still nil. -sj
2806 (setq score-files
2807 (nconc score-files (copy-sequence (cdar alist))))
2810 ;; cache the score files
2811 (push (cons group score-files) gnus-score-file-alist-cache)
2812 score-files)))
2814 (defun gnus-all-score-files (&optional group)
2815 "Return a list of all score files for the current group."
2816 (let ((funcs gnus-score-find-score-files-function)
2818 score-files)
2824 (when gnus-score-use-all-scores
2825 ;; Get the initial score files for this group.
2827 (setq score-files (nreverse (gnus-score-find-alist group))))
2829 (let ((home (gnus-home-score-file group t)))
2831 (push home score-files)
2832 (setq gnus-newsgroup-adaptive-score-file home)))
2836 (push param-file score-files)
2837 (setq gnus-newsgroup-adaptive-score-file param-file))))
2838 ;; Go through all the functions for finding score files (or actual
2842 (setq score-files
2843 (append score-files
2846 (when gnus-score-use-all-scores
2847 ;; Add any home score files.
2848 (let ((home (gnus-home-score-file group)))
2850 (push home score-files)))
2851 ;; Check whether there is a `score-file' group parameter.
2852 (let ((param-file (gnus-group-find-parameter group 'score-file)))
2854 (push param-file score-files))))
2856 (let ((files score-files))
2862 (setq score-files (nreverse score-files))
2863 ;; Remove any duplicate score files.
2864 (while (and score-files
2865 (member (car score-files) (cdr score-files)))
2866 (pop score-files))
2867 (let ((files score-files))
2872 ;; Do the scoring if there are any score files for this group.
2873 score-files)))
2875 (defun gnus-possibly-score-headers (&optional trace)
2877 (let ((score-files (gnus-all-score-files)))
2878 (when score-files
2879 (gnus-score-headers score-files trace))))
2881 (defun gnus-score-file-name (newsgroup &optional suffix)
2882 "Return the name of a score file for NEWSGROUP."
2883 (let ((suffix (or suffix gnus-score-file-suffix)))
2888 ;; The global score file is placed at top of the directory.
2890 ((gnus-use-long-file-name 'not-score)
2901 (defun gnus-score-search-global-directories (files)
2902 "Scan all global score directories for score files."
2903 ;; Set the variable `gnus-internal-global-score-files' to all
2904 ;; available global score files.
2905 (interactive (list gnus-global-score-files))
2912 (concat (gnus-score-file-regexp) "$"))))
2915 (setq gnus-internal-global-score-files out)))
2917 (defun gnus-score-default-fold-toggle ()
2918 "Toggle folding for new score file entries."
2920 (setq gnus-score-default-fold (not gnus-score-default-fold))
2921 (if gnus-score-default-fold
2922 (gnus-message 1 "New score file entries will be case insensitive.")
2923 (gnus-message 1 "New score file entries will be case sensitive.")))
2925 ;;; Home score file.
2927 (defun gnus-home-score-file (group &optional adapt)
2928 "Return the home score file for GROUP.
2930 (let ((list (if adapt gnus-home-adapt-file gnus-home-score-file))
2956 (defun gnus-hierarchial-home-score-file (group)
2957 "Return the score file of the top-level hierarchy of GROUP."
2959 (concat (match-string 0 group) gnus-score-file-suffix)
2961 (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
2962 gnus-score-file-suffix)))
2969 (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
2972 (defun gnus-current-home-score-file (group)
2973 "Return the \"current\" regular score file."
2974 (car (nreverse (gnus-score-find-alist group))))
2980 (defun gnus-decay-score (score)
2981 "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'."
2982 (let ((n (- score
2983 (* (if (< score 0) -1 1)
2984 (min (abs score)
2985 (max gnus-score-decay-constant
2986 (* (abs score)
2987 gnus-score-decay-scale)))))))
2999 kill entry updated score n)
3007 (setq score (or (nth 1 kill)
3008 gnus-score-interactive-default-score)
3011 (setq score (funcall gnus-decay-score-function score)))
3012 (setcdr kill (cons score
3014 ;; Return whether this score file needs to be saved. By Je-haysuss!
3017 (defun gnus-score-regexp-bad-p (regexp)
3073 (provide 'gnus-score)
3076 ;;; gnus-score.el ends here