Lines Matching +refs:gnus +refs:score +refs:set
0 ;;; gnus-score.el --- scoring code for Gnus
7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
33 (require 'gnus)
34 (require 'gnus-sum)
35 (require 'gnus-range)
36 (require 'gnus-win)
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
94 (defcustom gnus-adaptive-file-suffix "ADAPT"
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
151 (defcustom gnus-decay-scores nil
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
192 set this variable.)
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)
212 (defcustom gnus-home-adapt-file nil
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
224 `((gnus-kill-file-mark)
225 (gnus-unread-mark)
226 (gnus-read-mark
227 (from , (+ 2 gnus-score-decay-constant))
228 (subject , (+ 27 gnus-score-decay-constant)))
229 (gnus-catchup-mark
230 (subject , (+ -7 (* -1 gnus-score-decay-constant))))
231 (gnus-killed-mark
232 (from , (- -1 gnus-score-decay-constant))
233 (subject , (+ -17 (* -1 gnus-score-decay-constant))))
234 (gnus-del-mark
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
248 (defcustom gnus-adaptive-word-length-limit nil
251 :group 'gnus-score-adapt
255 (defcustom gnus-ignored-adaptive-words nil
257 :group 'gnus-score-adapt
260 (defcustom gnus-default-ignored-adaptive-words
276 :group 'gnus-score-adapt
279 (defcustom gnus-default-adaptive-word-score-alist
280 `((,gnus-read-mark . 30)
281 (,gnus-catchup-mark . -10)
282 (,gnus-killed-mark . -20)
283 (,gnus-del-mark . -15))
285 :group 'gnus-score-adapt
289 (defcustom gnus-adaptive-word-minimum nil
290 "If a number, this is the minimum score value that can be assigned to a word."
291 :group 'gnus-score-adapt
294 (defcustom gnus-adaptive-word-no-group-words nil
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.")
422 (defvar gnus-adaptive-word-syntax-table
431 (defvar gnus-scores-exclude-files nil)
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)
460 (defvar gnus-scores-articles nil)
461 (defvar gnus-score-index nil)
464 (defconst gnus-header-index
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
491 "R" gnus-summary-rescore
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."
509 (interactive (gnus-interactive "P\ny"))
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."
524 (interactive (gnus-interactive "P\ny"))
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)
590 ;; This was a majuscule, so we end reading and set the defaults.
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))
660 (and gnus-extra-headers
663 (gnus-completing-read-with-default
664 (symbol-name (car gnus-extra-headers)) ; default response
668 gnus-extra-headers)
673 ;; We have all the data, so we enter this score.
675 (gnus-summary-header (or (nth 2 entry) (nth 1 entry))
689 ;; Change score file to the "all.SCORE" file.
692 (set-buffer gnus-summary-buffer)
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.
719 (set-buffer gnus-summary-buffer)
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))
725 (set-buffer (gnus-get-buffer-create "*Score Help*"))
757 (gnus-appt-select-lowest-window)
764 (select-window (gnus-get-buffer-window gnus-summary-buffer t))))
766 (defun gnus-summary-header (header &optional no-err extra)
768 (let ((article (gnus-summary-article-number))
771 (if (and (setq headers (gnus-summary-article-header article))
775 (aref headers (nth 1 (assoc header gnus-header-index))))
783 (defun gnus-newsgroup-score-alist ()
785 (let ((param-file (gnus-group-find-parameter
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.
816 (setq match (if match (gnus-simplify-subject-re match) "")))
818 (setq match (gnus-simplify-subject-fuzzy match))))
819 (let ((score (gnus-score-delta-default score))
822 (set-text-properties 0 (length header) nil header)
832 (if (< score 0) "lower" "raise"))
838 (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
841 (set-text-properties 0 (length match) nil match))
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))))
883 (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
884 (eq (nth 2 (assoc header gnus-header-index))
885 'gnus-score-string))
886 (gnus-summary-score-effect header match type score extra)
887 (gnus-summary-rescore)))
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.
900 gnus-header-index
911 (gnus-simplify-subject-fuzzy match))
919 (let ((content (gnus-summary-header header 'noerr extra))
923 (string-equal (gnus-simplify-subject-fuzzy content)
926 (gnus-summary-raise-score score))))
928 (gnus-set-mode-line 'summary))
930 (defun gnus-summary-score-crossposting (score date)
931 ;; Enter score file entry for current crossposting.
932 ;; SCORE is the score to add.
934 (let ((xref (gnus-summary-header "xref"))
944 gnus-newsgroup-name))
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 ()
972 (gnus-summary-update-line)
975 (defun gnus-score-update-all-lines ()
981 (when (gnus-summary-show-thread)
983 (gnus-summary-update-line)
988 (gnus-summary-hide-thread)))))
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))
1003 (when (gnus-buffer-live-p gnus-summary-buffer)
1009 (set-buffer gnus-summary-buffer)
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))
1018 (when (gnus-buffer-live-p gnus-summary-buffer)
1024 (set-buffer gnus-summary-buffer)
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."
1058 (gnus-summary-show-thread)
1060 ;; Set score.
1061 (gnus-summary-update-mark
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))
1066 (let* ((article (gnus-summary-article-number))
1067 (score (assq article gnus-newsgroup-scored)))
1068 (if score (setcdr score n)
1069 (push (cons article n) gnus-newsgroup-scored)))
1070 (gnus-summary-update-line)))
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)
1082 (gnus-set-mode-line 'summary))
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")
1091 (when (buffer-name gnus-summary-buffer)
1092 (gnus-score-save))
1093 (gnus-make-directory (file-name-directory file))
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)
1098 (make-local-variable 'gnus-prev-winconf)
1099 (setq gnus-prev-winconf winconf))
1100 (gnus-message
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)))
1108 (gnus-make-directory (file-name-directory file))
1109 (when (buffer-name gnus-summary-buffer)
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)
1116 (make-local-variable 'gnus-prev-winconf)
1117 (setq gnus-prev-winconf winconf))
1118 (gnus-message
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':
1133 (if (and (re-search-backward reg (gnus-point-at-bol) t)
1134 (re-search-forward reg (gnus-point-at-eol) t))
1135 (buffer-substring (point) (gnus-point-at-eol))
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.
1161 gnus-kill-files-directory)))
1164 (expand-file-name file gnus-kill-files-directory))))
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))))
1214 (when (and gnus-decay-scores
1217 (gnus-decay-scores alist decay)))
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))
1231 (setq gnus-scores-exclude-files
1239 (expand-file-name sfile gnus-kill-files-directory)))
1241 gnus-scores-exclude-files))
1244 (set-buffer gnus-summary-buffer)
1250 (set (caar local) (nth 1 (car local)))))
1253 (setq gnus-orphan-score orphan))
1254 (setq gnus-adaptive-score-alist
1256 (setq gnus-newsgroup-adaptive t)
1257 gnus-default-adaptive-score-alist)
1259 (setq gnus-newsgroup-adaptive nil))
1261 (setq gnus-newsgroup-adaptive t)
1264 gnus-default-adaptive-score-alist)))
1265 (setq gnus-thread-expunge-below
1266 (or thread-mark-and-expunge gnus-thread-expunge-below))
1267 (setq gnus-summary-mark-below
1268 (or mark mark-and-expunge gnus-summary-mark-below))
1269 (setq gnus-summary-expunge-below
1270 (or expunge mark-and-expunge gnus-summary-expunge-below))
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."
1330 (gnus-message 1 "Score file is not a list: %s" file)
1341 (format "Invalid score element %s in %s" (car a) file))
1358 (format "Non-integer score %s in %s" (cadr s) file))
1368 (gnus-message 3 err)
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)
1403 (nnheader-set-temp-buffer " *Gnus Scores*")
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)))
1418 (concat (regexp-quote gnus-adaptive-file-suffix) "$")
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))))
1428 (gnus-make-directory (file-name-directory file))
1429 ;; If the score file is empty, we delete it.
1434 (let ((coding-system-for-write score-mode-coding-system))
1435 (gnus-write-buffer file))
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.
1457 (when gnus-scores-exclude-files
1461 (and (setq c (rassq (car s) gnus-score-cache))
1462 (member (car c) gnus-scores-exclude-files)
1467 (defun gnus-score-headers (score-files &optional trace)
1468 ;; Score `gnus-newsgroup-headers'.
1470 ;; PLM: probably this is not the best place to clear orphan-score
1471 (setq gnus-orphan-score nil
1472 gnus-scores-articles nil
1473 gnus-scores-exclude-files nil
1474 scores (gnus-score-load-files score-files))
1480 (when (and gnus-summary-default-score
1482 (let* ((entries gnus-header-index)
1484 (expire (and gnus-score-expiry-days
1485 (- now gnus-score-expiry-days)))
1486 (headers gnus-newsgroup-headers)
1487 (current-score-file gnus-current-score-file)
1489 (gnus-message 7 "Scoring...")
1493 ;; be written as O(N+S), where N is (length gnus-newsgroup-headers)
1494 ;; and S is (length gnus-newsgroup-scored).
1495 (unless (assq (mail-header-number header) gnus-newsgroup-scored)
1496 (setq gnus-scores-articles ;Total of 2 * N cons-cells used.
1497 (cons (cons header (or gnus-summary-default-score 0))
1498 gnus-scores-articles))))
1501 (set-buffer (gnus-get-buffer-create "*Headers*"))
1503 (when (gnus-buffer-live-p gnus-summary-buffer)
1504 (message-clone-locals gnus-summary-buffer))
1507 (setq gnus-current-score-file current-score-file)
1508 ;; score orphans
1509 (when gnus-orphan-score
1510 (setq gnus-score-index
1511 (nth 1 (assoc "references" gnus-header-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)))
1526 (when (gnus-buffer-live-p gnus-summary-buffer)
1527 (let ((scored gnus-newsgroup-scored))
1528 (with-current-buffer gnus-summary-buffer
1529 (setq gnus-newsgroup-scored scored))))
1531 (gnus-kill-buffer (current-buffer)))
1533 ;; Add articles to `gnus-newsgroup-scored'.
1534 (while gnus-scores-articles
1535 (when (or (/= gnus-summary-default-score
1536 (cdar gnus-scores-articles))
1537 gnus-save-score)
1538 (push (cons (mail-header-number (caar gnus-scores-articles))
1539 (cdar gnus-scores-articles))
1540 gnus-newsgroup-scored))
1541 (setq gnus-scores-articles (cdr gnus-scores-articles)))
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))))
1550 (gnus-message 7 "Scoring...done"))))))
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
1558 `gnus-newsgroup-scored' is adjusted by SCORE-ADJUST."
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."
1577 ;; gnus-make-threads produces a list, where each entry is a "thread"
1578 ;; as described in the gnus-score-lower-thread docs. This function
1582 (dolist (thread (gnus-make-threads))
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))
1611 (articles gnus-scores-articles))
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))
1654 (articles gnus-scores-articles)
1659 match (gnus-date-iso8601 (nth 0 kill))))
1661 (setq match-func 'gnus-string>
1662 match (gnus-date-iso8601 (nth 0 kill))))
1665 match (gnus-date-iso8601 (nth 0 kill))))
1671 ;; `gnus-score-string' does to minimize searches and stuff,
1677 (setq l (aref (car article) gnus-score-index))
1678 (funcall match-func match (gnus-date-iso8601 l)))
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)
1697 (if gnus-agent-fetching
1700 (setq gnus-scores-articles
1701 (sort gnus-scores-articles
1705 (set-buffer nntp-server-buffer)
1708 (articles gnus-scores-articles)
1711 'gnus-request-head)
1713 'gnus-request-body)
1714 (t 'gnus-request-article)))
1720 (unless (gnus-check-backend-function
1721 (and (string-match "^gnus-" (symbol-name request-func))
1724 gnus-newsgroup-name)
1726 (setq request-func 'gnus-request-article))
1729 (gnus-message 7 "Scoring article %s of %s..." article last)
1731 (when (funcall request-func article gnus-newsgroup-name)
1737 (if (eq ofunc 'gnus-request-head)
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)
1800 (if gnus-agent-fetching
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
1814 (set-buffer gnus-summary-buffer)
1815 (gnus-score-load-file
1816 (or gnus-newsgroup-adaptive-score-file
1817 (gnus-score-file-name
1818 gnus-newsgroup-name gnus-adaptive-file-suffix))))
1820 (setq gnus-scores-articles (sort gnus-scores-articles
1821 'gnus-score-string<)
1822 articles gnus-scores-articles)
1827 this (aref (car art) gnus-score-index)
1850 (score (or (nth 1 kill) gnus-score-interactive-default-score))
1865 (and (= (gnus-point-at-bol)
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.
1906 (set-buffer gnus-summary-buffer)
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."
1913 (set-buffer gnus-summary-buffer)
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
1948 (setq gnus-scores-articles
1950 (if (= gnus-score-index 9)
1951 gnus-scores-articles
1952 (sort gnus-scores-articles 'gnus-score-string<))
1953 articles gnus-scores-articles)
1957 (setq this (aref (car art) gnus-score-index))
1962 (if (= gnus-score-index 9)
1963 (setq this (gnus-prin1-to-string this))) ; ick.
1966 (setq this (gnus-map-function gnus-simplify-subject-functions this)))
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))
2002 (gnus-map-function
2003 gnus-simplify-subject-functions
2035 (= (gnus-point-at-bol) (match-beginning 0))
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)
2113 (gnus-simplify-buffer-fuzzy)
2117 (score (or (nth 1 kill) gnus-score-interactive-default-score))
2125 (when (and (= (gnus-point-at-bol) (match-beginning 0))
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))
2158 (let ((hashtb (gnus-make-hashtable
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)
2204 (set-syntax-table gnus-adaptive-word-syntax-table)
2207 (gnus-gethash
2211 (gnus-sethash
2213 (append (get-text-property (gnus-point-at-eol) 'articles) val)
2215 (set-syntax-table syntab))
2217 (let ((ignored (append gnus-ignored-adaptive-words
2218 (if gnus-adaptive-word-no-group-words
2220 (gnus-group-real-name gnus-newsgroup-name)
2222 gnus-default-ignored-adaptive-words)))
2224 (gnus-sethash (pop ignored) nil 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."
2240 (when gnus-newsgroup-adaptive
2241 ;; We change the score file to the adaptive score file.
2243 (set-buffer gnus-summary-buffer)
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
2248 gnus-newsgroup-name gnus-adaptive-file-suffix))))
2250 (when (or (not (listp gnus-newsgroup-adaptive))
2251 (memq 'line gnus-newsgroup-adaptive))
2253 (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
2256 (data gnus-newsgroup-data)
2283 ;; Then we score away.
2285 (setq elem (cdr (assq (gnus-data-mark (car data)) alist)))
2287 (gnus-data-pseudo-p (car data)))
2289 (when (setq headers (gnus-data-header (car data)))
2292 (gnus-summary-score-entry
2302 (if (or (not gnus-score-exact-adapt-limit)
2303 (< (length match) gnus-score-exact-adapt-limit))
2312 (when (and (listp gnus-newsgroup-adaptive)
2313 (memq 'word gnus-newsgroup-adaptive))
2315 (let* ((hashtb (gnus-make-hashtable 1000))
2317 (data gnus-newsgroup-data)
2319 word d score val)
2322 (set-syntax-table gnus-adaptive-word-syntax-table)
2326 (not (gnus-data-pseudo-p d))
2327 (setq score
2329 (gnus-data-mark d)
2330 gnus-adaptive-word-score-alist))))
2334 (insert (mail-header-subject (gnus-data-header d)))
2338 ;; Put the word and score into the hashtb.
2339 (setq val (gnus-gethash (setq word (match-string 0))
2341 (when (or (not gnus-adaptive-word-length-limit)
2343 gnus-adaptive-word-length-limit))
2344 (setq val (+ score (or val 0)))
2345 (if (and gnus-adaptive-word-minimum
2346 (< val gnus-adaptive-word-minimum))
2347 (setq val gnus-adaptive-word-minimum))
2348 (gnus-sethash word val hashtb)))
2350 (set-syntax-table syntab))
2352 (let ((ignored (append gnus-ignored-adaptive-words
2353 (if gnus-adaptive-word-no-group-words
2355 (gnus-group-real-name
2356 gnus-newsgroup-name)
2358 gnus-default-ignored-adaptive-words)))
2360 (gnus-sethash (pop ignored) nil hashtb)))
2363 (set-buffer gnus-summary-buffer)
2367 (gnus-summary-score-entry
2372 (defun gnus-score-edit-done ()
2374 (winconf gnus-prev-winconf))
2376 (set-window-configuration winconf))
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."
2383 (let ((old-scored gnus-newsgroup-scored))
2384 (let ((gnus-newsgroup-headers
2385 (list (gnus-summary-article-header)))
2386 (gnus-newsgroup-scored nil)
2387 ;; Must be synced with `gnus-score-edit-file-at-point':
2392 (nnheader-set-temp-buffer "*Score Trace*"))
2393 (setq gnus-score-trace nil)
2394 (gnus-possibly-score-headers 'trace)
2395 (if (not (setq trace gnus-score-trace))
2396 (gnus-error
2397 1 "No score rules apply to the current article (default score %d)."
2398 gnus-summary-default-score)
2399 (set-buffer "*Score Trace*")
2401 (local-set-key "q"
2405 (gnus-summary-expand-window)))
2406 (local-set-key "e" (lambda ()
2407 "Run `gnus-score-edit-file-at-point'."
2409 (gnus-score-edit-file-at-point)))
2410 (local-set-key "f" (lambda ()
2411 "Run `gnus-score-edit-file-at-point'."
2413 (gnus-score-edit-file-at-point 'format)))
2414 (local-set-key "t" 'toggle-truncate-lines)
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)))
2440 (set-buffer gnus-summary-buffer)
2441 (setq gnus-newsgroup-scored old-scored)))
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)
2471 (nnheader-set-temp-buffer "*Score Words*")
2473 (gnus-error 3 "No word score rules")
2478 (gnus-configure-windows 'score-words))))
2480 (defun gnus-summary-rescore ()
2483 (gnus-score-save)
2484 (setq gnus-score-cache nil)
2485 (setq gnus-newsgroup-scored 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)
2514 (let ((subject (gnus-summary-article-subject)))
2515 (gnus-summary-raise-score score)
2516 (while (gnus-summary-find-subject subject)
2517 (gnus-summary-raise-score score))
2518 (gnus-summary-next-article t)))
2520 (defun gnus-summary-raise-same-subject (score)
2523 (let ((subject (gnus-summary-article-subject)))
2524 (gnus-summary-raise-score score)
2525 (while (gnus-summary-find-subject subject)
2526 (gnus-summary-raise-score score))
2527 (gnus-summary-next-subject 1 t)))
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))
2539 (let ((articles (gnus-summary-articles-in-thread)))
2541 (gnus-summary-goto-subject (car articles))
2542 (gnus-summary-raise-score score)
2545 (let ((gnus-summary-check-current t))
2546 (unless (zerop (gnus-summary-next-subject 1 t))
2548 (gnus-summary-recenter)
2549 (gnus-summary-position-point)
2550 (gnus-set-mode-line 'summary))
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)))
2576 (setq gnus-kill-files-directory
2577 (file-name-as-directory gnus-kill-files-directory))
2578 ;; If we can't read it, there are no score files.
2579 (if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
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
2591 gnus-kill-files-directory))
2592 (gnus-message 6 "Finding all score files...done")))))
2594 (when (or (not gnus-score-file-list)
2595 (not (car gnus-score-file-list))
2596 (gnus-file-newer-than gnus-kill-files-directory
2597 (car gnus-score-file-list)))
2598 (setq gnus-score-file-list
2599 (cons (nth 5 (file-attributes gnus-kill-files-directory))
2602 gnus-kill-files-directory t
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.
2628 gnus-kill-files-directory)))))
2630 (defun gnus-score-file-regexp ()
2631 "Return a regexp that match all score files."
2632 (concat "\\(" (regexp-quote gnus-score-file-suffix )
2633 "\\|" (regexp-quote gnus-adaptive-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))
2642 (expand-file-name gnus-kill-files-directory)))
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)
2666 (if (re-search-backward gnus-directory-sep-char-regexp nil t)
2668 (gnus-message 1 "Can't find directory separator in %s"
2700 ;; we add this score file to the list of score files
2709 (gnus-kill-buffer (current-buffer))
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."
2727 (let* ((prefix (gnus-group-real-prefix group))
2729 (group (gnus-group-real-name group))
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)
2758 (file-name-as-directory gnus-kill-files-directory))))
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)
2817 (group (or group gnus-newsgroup-name))
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)))
2834 (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
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))
2860 (car files) gnus-kill-files-directory)))
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.
2889 (expand-file-name suffix gnus-kill-files-directory))
2890 ((gnus-use-long-file-name 'not-score)
2892 (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
2894 gnus-kill-files-directory))
2897 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
2899 gnus-kill-files-directory))))))
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))
2948 (when (string-match (gnus-globalify-regexp (car elem)) group)
2954 (nnheader-concat gnus-kill-files-directory found)))))
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)))
2964 (defun gnus-hierarchial-home-adapt-file (group)
2967 (concat (match-string 0 group) gnus-adaptive-file-suffix)
2969 (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
2970 gnus-adaptive-file-suffix)))
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)))))))
2996 (defun gnus-decay-scores (alist day)
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)
3027 See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
3073 (provide 'gnus-score)
3076 ;;; gnus-score.el ends here