Function: gnus-score-adaptive

gnus-score-adaptive is an autoloaded and byte-compiled function defined in gnus-score.el.gz.

Signature

(gnus-score-adaptive)

Documentation

Create adaptive score rules for this newsgroup.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-score.el.gz
(defun gnus-score-adaptive ()
  "Create adaptive score rules for this newsgroup."
  (when gnus-newsgroup-adaptive
    ;; We change the score file to the adaptive score file.
    (with-current-buffer gnus-summary-buffer
      (gnus-score-load-file
       (or gnus-newsgroup-adaptive-score-file
	   (gnus-home-score-file gnus-newsgroup-name t)
	   (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 (copy-tree gnus-adaptive-score-alist))
	       (alist malist)
	       (date (current-time-string))
	       (data gnus-newsgroup-data)
	       elem headers match func)
	  ;; 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
	      (when (fboundp
		     (setq func
			   (intern
			    (concat "mail-header-"
				    (if (eq (caar elem) 'followup)
					"message-id"
				      (downcase (symbol-name (caar elem))))))))
		(setcdr (car elem)
			(cons (if (eq (caar elem) 'followup)
				  "references"
				(symbol-name (caar elem)))
			      (cdar elem)))
		(setcar (car elem) func))
	      (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))
      (with-temp-buffer
	(let* ((hashtb (gnus-make-hashtable 1000))
	       (date (time-to-days nil))
	       (data gnus-newsgroup-data)
	       word d score val)
	  (with-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 (gethash (setq word (match-string 0))
				     hashtb))
		  (when (or (not gnus-adaptive-word-length-limit)
			    (> (length word)
			       gnus-adaptive-word-length-limit))
		    (setq val (+ score (or val 0)))
		    (if (and gnus-adaptive-word-minimum
			     (< val gnus-adaptive-word-minimum))
			(setq val gnus-adaptive-word-minimum))
		    (puthash word val hashtb)))
		(erase-buffer))))
	  ;; Make all the ignorable words ignored.
	  (let ((ignored (append gnus-ignored-adaptive-words
				 (if gnus-adaptive-word-no-group-words
				     (message-tokenize-header
				      (gnus-group-real-name
				       gnus-newsgroup-name)
				      "."))
				 gnus-default-ignored-adaptive-words)))
	    (while ignored
	      (remhash (pop ignored) hashtb)))
	  ;; Now we have all the words and scores, so we
	  ;; add these rules to the ADAPT file.
	  (set-buffer gnus-summary-buffer)
	  (maphash
	   (lambda (word val)
	     (gnus-summary-score-entry
	      "subject" word 'w val date nil t))
	   hashtb))))))