- (gnus-score-file-name
- gnus-newsgroup-name gnus-adaptive-file-suffix)))
- ;; The we score away.
- (while data
- (setq elem (cdr (assq (gnus-data-mark (car data)) alist)))
- (if (or (not elem)
- (gnus-data-pseudo-p (car data)))
- ()
- (when (setq headers (gnus-data-header (car data)))
- (while elem
- (setq match (funcall (car (car elem)) headers))
- (gnus-summary-score-entry
- (nth 1 (car elem)) match
- (cond
- ((numberp match)
- '=)
- ((equal (nth 1 (car elem)) "date")
- 'a)
- (t
- ;; Whether we use substring or exact matches are controlled
- ;; here.
- (if (or (not gnus-score-exact-adapt-limit)
- (< (length match) gnus-score-exact-adapt-limit))
- 'e
- (if (equal (nth 1 (car elem)) "subject")
- 'f 's))))
- (nth 2 (car elem)) date nil t)
- (setq elem (cdr elem)))))
- (setq data (cdr data))))))
-
-;;;
-;;; Score mode.
-;;;
-
-(defvar gnus-score-mode-hook nil
- "*Hook run in score mode buffers.")
-
-(defvar gnus-score-menu-hook nil
- "*Hook run after creating the score mode menu.")
-
-(defvar gnus-score-mode-map nil)
-(unless gnus-score-mode-map
- (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map))
- (gnus-define-keys
- gnus-score-mode-map
- "\C-c\C-c" gnus-score-edit-done
- "\C-c\C-d" gnus-score-edit-insert-date
- "\C-c\C-p" gnus-score-pretty-print))
-
-(defun gnus-score-mode ()
- "Mode for editing score files.
-This mode is an extended emacs-lisp mode.
-
-\\{gnus-score-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map gnus-score-mode-map)
- (when (and menu-bar-mode
- (gnus-visual-p 'score-menu 'menu))
- (gnus-score-make-menu-bar))
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (setq major-mode 'gnus-score-mode)
- (setq mode-name "Score")
- (lisp-mode-variables nil)
- (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
-
-(defun gnus-score-make-menu-bar ()
- (unless (boundp 'gnus-score-menu)
- (easy-menu-define
- gnus-score-menu gnus-score-mode-map ""
- '("Score"
- ["Exit" gnus-score-edit-done t]
- ["Insert date" gnus-score-edit-insert-date t]
- ["Format" gnus-score-pretty-print t]
- ))
- (run-hooks 'gnus-score-menu-hook)))
-
-(defun gnus-score-edit-insert-date ()
- "Insert date in numerical format."
- (interactive)
- (insert (int-to-string (gnus-day-number (current-time-string)))))
-
-(defun gnus-score-pretty-print ()
- "Format the current score file."
- (interactive)
- (goto-char (point-min))
- (let ((form (read (current-buffer))))
- (erase-buffer)
- (pp form (current-buffer)))
- (goto-char (point-min)))
+ (gnus-score-file-name
+ gnus-newsgroup-name gnus-adaptive-file-suffix))))
+ ;; Perform ordinary line scoring.
+ (when (or (not (listp gnus-newsgroup-adaptive))
+ (memq 'line gnus-newsgroup-adaptive))
+ (save-excursion
+ (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
+ (alist malist)
+ (date (current-time-string))
+ (data gnus-newsgroup-data)
+ elem headers match)
+ ;; First we transform the adaptive rule alist into something
+ ;; that's faster to process.
+ (while malist
+ (setq elem (car malist))
+ (when (symbolp (car elem))
+ (setcar elem (symbol-value (car elem))))
+ (setq elem (cdr elem))
+ (while elem
+ (setcdr (car elem)
+ (cons (if (eq (caar elem) 'followup)
+ "references"
+ (symbol-name (caar elem)))
+ (cdar elem)))
+ (setcar (car elem)
+ `(lambda (h)
+ (,(intern
+ (concat "mail-header-"
+ (if (eq (caar elem) 'followup)
+ "message-id"
+ (downcase (symbol-name (caar elem))))))
+ h)))
+ (setq elem (cdr elem)))
+ (setq malist (cdr malist)))
+ ;; Then we score away.
+ (while data
+ (setq elem (cdr (assq (gnus-data-mark (car data)) alist)))
+ (if (or (not elem)
+ (gnus-data-pseudo-p (car data)))
+ ()
+ (when (setq headers (gnus-data-header (car data)))
+ (while elem
+ (setq match (funcall (caar elem) headers))
+ (gnus-summary-score-entry
+ (nth 1 (car elem)) match
+ (cond
+ ((numberp match)
+ '=)
+ ((equal (nth 1 (car elem)) "date")
+ 'a)
+ (t
+ ;; Whether we use substring or exact matches is
+ ;; controlled here.
+ (if (or (not gnus-score-exact-adapt-limit)
+ (< (length match) gnus-score-exact-adapt-limit))
+ 'e
+ (if (equal (nth 1 (car elem)) "subject")
+ 'f 's))))
+ (nth 2 (car elem)) date nil t)
+ (setq elem (cdr elem)))))
+ (setq data (cdr data))))))
+
+ ;; Perform adaptive word scoring.
+ (when (and (listp gnus-newsgroup-adaptive)
+ (memq 'word gnus-newsgroup-adaptive))
+ (nnheader-temp-write nil
+ (let* ((hashtb (gnus-make-hashtable 1000))
+ (date (gnus-day-number (current-time-string)))
+ (data gnus-newsgroup-data)
+ (syntab (syntax-table))
+ word d score val)
+ (unwind-protect
+ (progn
+ (set-syntax-table gnus-adaptive-word-syntax-table)
+ ;; Go through all articles.
+ (while (setq d (pop data))
+ (when (and
+ (not (gnus-data-pseudo-p d))
+ (setq score
+ (cdr (assq
+ (gnus-data-mark d)
+ gnus-adaptive-word-score-alist))))
+ ;; This article has a mark that should lead to
+ ;; adaptive word rules, so we insert the subject
+ ;; and find all words in that string.
+ (insert (mail-header-subject (gnus-data-header d)))
+ (downcase-region (point-min) (point-max))
+ (goto-char (point-min))
+ (while (re-search-forward "\\b\\w+\\b" nil t)
+ ;; Put the word and score into the hashtb.
+ (setq val (gnus-gethash (setq word (match-string 0))
+ hashtb))
+ (gnus-sethash word (+ (or val 0) score) hashtb))
+ (erase-buffer))))
+ (set-syntax-table syntab))
+ ;; Make all the ignorable words ignored.
+ (let ((ignored (append gnus-ignored-adaptive-words
+ gnus-default-ignored-adaptive-words)))
+ (while ignored
+ (gnus-sethash (pop ignored) nil hashtb)))
+ ;; Now we have all the words and scores, so we
+ ;; add these rules to the ADAPT file.
+ (set-buffer gnus-summary-buffer)
+ (mapatoms
+ (lambda (word)
+ (when (symbol-value word)
+ (gnus-summary-score-entry
+ "subject" (symbol-name word) 'w (symbol-value word)
+ date nil t)))
+ hashtb))))))