Lines Matching +defs:gnus +defs:current +defs:article
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)
42 (defcustom gnus-global-score-files nil
49 \"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
52 (setq gnus-global-score-files
53 '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
55 :group 'gnus-score-files
58 (defcustom gnus-score-file-single-match-alist nil
66 use multiple matches, see `gnus-score-file-multiple-match-alist').
69 `gnus-score-find-score-files-function'."
70 :group 'gnus-score-files
73 (defcustom gnus-score-file-multiple-match-alist nil
82 `gnus-score-file-single-match-alist').
85 `gnus-score-find-score-files-function'."
86 :group 'gnus-score-files
89 (defcustom gnus-score-file-suffix "SCORE"
91 :group 'gnus-score-files
94 (defcustom gnus-adaptive-file-suffix "ADAPT"
96 :group 'gnus-score-files
97 :group 'gnus-score-adapt
100 (defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
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.
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
134 :group 'gnus-score-default
137 (defcustom gnus-score-expiry-days 7
140 :group 'gnus-score-expire
144 (defcustom gnus-update-score-entry-dates t
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
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
191 allowed so that one may use gnus-score-file-single-match-alist to
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
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)))))
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
272 "being" "current" "back" "still" "go" "point" "value" "each" "did"
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
291 :group 'gnus-score-adapt
294 (defcustom gnus-adaptive-word-no-group-words nil
296 :group 'gnus-score-adapt
299 (defcustom gnus-score-mimic-keymap nil
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$"
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
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
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
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)))
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)
503 (defun gnus-summary-lower-score (&optional score symp)
504 "Make a score entry based on the current article.
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.
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)
556 (list (list ?t (current-time-string) "temporary")
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)))
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)
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)
675 (gnus-summary-header (or (nth 2 entry) (nth 1 entry))
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
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*"))
727 (delete-windows-on (current-buffer))
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)
767 ;; Return HEADER for current articles, or error.
768 (let ((article (gnus-summary-article-number))
770 (if article
771 (if (and (setq headers (gnus-summary-article-header article))
775 (aref headers (nth 1 (assoc header gnus-header-index))))
780 (error "No article on current line")
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
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))
838 (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
845 (when (= score gnus-score-interactive-default-score)
847 (let ((old (gnus-score-get header))
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))))
881 ;; Score the current buffer.
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)
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.
934 (let ((xref (gnus-summary-header "xref"))
938 (error "This article is not crossposted"))
944 gnus-newsgroup-name))
945 (gnus-summary-score-entry
956 (defun gnus-score-set-mark-below (score)
959 (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
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)
993 (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
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)
1000 "Add SCORE to all followups to the article in the current buffer."
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)
1015 "Add SCORE to all later articles in the thread the current buffer is part of."
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)
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)
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))
1066 (let* ((article (gnus-summary-article-number))
1067 (score (assq article gnus-newsgroup-scored)))
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")
1090 (let ((winconf (current-window-configuration)))
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)
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))
1111 (let ((winconf (current-window-configuration)))
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)
1124 If FORMAT, also format the current score file."
1127 (read (current-buffer))))
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)
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))
1172 (setq gnus-score-alist nil)
1173 (setq alist (gnus-score-load-score-alist file))
1182 (push (cons file alist) gnus-score-cache))
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))
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)
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)
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)
1297 (setq gnus-score-alist nil)
1307 (read (current-buffer))
1309 (gnus-error 3.2 "Problem with score file %s" file))))))
1317 (setq gnus-score-alist (gnus-score-transform-old-to-new alist)))
1319 (setq gnus-score-alist alist)))
1321 (setq gnus-score-alist
1322 (gnus-score-check-syntax gnus-score-alist file)))))
1324 (defun gnus-score-check-syntax (alist file)
1330 (gnus-message 1 "Score file is not a list: %s" file)
1368 (gnus-message 3 err)
1373 (defun gnus-score-transform-old-to-new (alist)
1397 (defun gnus-score-save ()
1399 (let ((cache gnus-score-cache)
1402 (setq gnus-score-alist nil)
1405 (current-buffer)
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) "$")
1423 (gnus-prin1 score)
1427 (gnus-pp score))))
1428 (gnus-make-directory (file-name-directory file))
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)))
1441 (kill-buffer (current-buffer)))))
1443 (defun gnus-score-load-files (score-files)
1452 (setq scores (nconc (gnus-score-load-file (car score-files)) scores))
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'.
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)
1483 (now (date-to-day (current-time-string)))
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)
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))
1517 gnus-score-index (nth 1 (assoc header gnus-header-index)))
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)))
1547 (gnus-score-advanced (car score) trace))
1550 (gnus-message 7 "Scoring...done"))))))
1552 (defun gnus-score-lower-thread (thread 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)
1565 (let* ((article (mail-header-number head))
1566 (score (assq article gnus-newsgroup-scored)))
1568 (push (cons article score-adjust) gnus-newsgroup-scored)))))
1571 (defun gnus-score-orphans (score)
1573 A root is an article with no references. An orphan is an article
1575 root article. This function finds all the orphans, and adjusts their
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)))
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))
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)))
1641 entries alist match match-func article)
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,
1675 (while (setq article (pop articles))
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
1708 (articles gnus-scores-articles)
1711 'gnus-request-head)
1713 'gnus-request-body)
1714 (t 'gnus-request-article)))
1715 entries alist ofunc article last)
1719 ;; we just fetch the entire 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))
1728 (setq article (mail-header-number (caar articles)))
1729 (gnus-message 7 "Scoring article %s of %s..." article last)
1731 (when (funcall request-func article gnus-newsgroup-name)
1733 ;; If just parts of the article is to be searched, but the
1737 (if (eq ofunc 'gnus-request-head)
1755 gnus-score-interactive-default-score))
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
1803 ;; Insert the unique article headers in the buffer.
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.
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
1887 (car-safe (rassq alist gnus-score-cache))
1889 gnus-score-trace))
1890 (when (setq new (gnus-score-add-followups
1895 ((and found gnus-update-score-entry-dates)
1897 (gnus-score-set 'touched '(t) alist)
1900 (gnus-score-set 'touched '(t) alist)
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)
1913 (set-buffer gnus-summary-buffer)
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)
1934 ;; Insert the unique article headers in the buffer.
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)))
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))
2046 (car-safe (rassq alist gnus-score-cache))
2048 gnus-score-trace))
2060 ((and found gnus-update-score-entry-dates)
2061 (gnus-score-set 'touched '(t) alist)
2066 (gnus-score-set 'touched '(t) alist)
2085 (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
2086 gnus-score-trace))
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))
2132 (car-safe (rassq (cdar fuzzies) gnus-score-cache))
2134 gnus-score-trace))
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))
2172 (car-safe (rassq (cdar words) gnus-score-cache))
2174 gnus-score-trace))
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)
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)))
2235 (gnus-short-group-name (file-name-nondirectory score-file))
2238 (defun gnus-score-adaptive ()
2240 (when gnus-newsgroup-adaptive
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))
2255 (date (current-time-string))
2256 (data gnus-newsgroup-data)
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))
2316 (date (date-to-day (current-time-string)))
2317 (data gnus-newsgroup-data)
2322 (set-syntax-table gnus-adaptive-word-syntax-table)
2326 (not (gnus-data-pseudo-p d))
2329 (gnus-data-mark d)
2330 gnus-adaptive-word-score-alist))))
2331 ;; This article has a mark that should lead to
2334 (insert (mail-header-subject (gnus-data-header d)))
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))
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)))
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 ()
2373 (let ((bufnam (buffer-file-name (current-buffer)))
2374 (winconf gnus-prev-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':
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)
2405 (gnus-summary-expand-window)))
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,
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)))
2457 gnus-score-interactive-default-score)
2473 (gnus-error 3 "No word score rules")
2478 (gnus-configure-windows 'score-words))))
2480 (defun gnus-summary-rescore ()
2481 "Redo the entire scoring process in the current summary."
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 ()
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 ()
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))
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))))
2569 (defun gnus-score-score-files (group)
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))
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)
2609 (regexp (gnus-score-file-regexp))
2628 gnus-kill-files-directory)))))
2630 (defun gnus-score-file-regexp ()
2632 (concat "\\(" (regexp-quote gnus-score-file-suffix )
2633 "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'"))
2635 (defun gnus-score-find-bnews (group)
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*"))
2666 (if (re-search-backward gnus-directory-sep-char-regexp nil t)
2668 (gnus-message 1 "Can't find directory separator in %s"
2709 (gnus-kill-buffer (current-buffer))
2714 (let ((localscore (gnus-score-file-name group)))
2716 (gnus-sort-score-files (nreverse ofiles)))))
2718 (defun gnus-score-find-single (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)
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)
2752 Destroys the current buffer."
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)
2786 The list is determined from the variable `gnus-score-file-alist'."
2787 (let ((alist gnus-score-file-multiple-match-alist)
2790 (if (setq score-files (assoc group gnus-score-file-alist-cache))
2798 (setq alist gnus-score-file-single-match-alist)
2811 (push (cons group score-files) gnus-score-file-alist-cache)
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))
2824 (when gnus-score-use-all-scores
2827 (setq score-files (nreverse (gnus-score-find-alist group))))
2829 (let ((home (gnus-home-score-file group t)))
2832 (setq gnus-newsgroup-adaptive-score-file home)))
2834 (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
2837 (setq gnus-newsgroup-adaptive-score-file param-file))))
2846 (when gnus-score-use-all-scores
2848 (let ((home (gnus-home-score-file group)))
2852 (let ((param-file (gnus-group-find-parameter group 'score-file)))
2860 (car files) gnus-kill-files-directory)))
2875 (defun gnus-possibly-score-headers (&optional trace)
2877 (let ((score-files (gnus-all-score-files)))
2879 (gnus-score-headers score-files trace))))
2881 (defun gnus-score-file-name (newsgroup &optional suffix)
2883 (let ((suffix (or suffix gnus-score-file-suffix)))
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)
2903 ;; Set the variable `gnus-internal-global-score-files' to all
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 ()
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.")))
2927 (defun gnus-home-score-file (group &optional adapt)
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)
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'."
2985 (max gnus-score-decay-constant
2987 gnus-score-decay-scale)))))))
2996 (defun gnus-decay-scores (alist day)
2998 (let ((times (- (time-to-days (current-time)) day))
3008 gnus-score-interactive-default-score)
3011 (setq score (funcall gnus-decay-score-function score)))
3017 (defun gnus-score-regexp-bad-p (regexp)
3027 See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
3035 tok ; current token
3038 end) ; length of current token
3073 (provide 'gnus-score)
3076 ;;; gnus-score.el ends here