Function: gnus-score-followup

gnus-score-followup is a byte-compiled function defined in gnus-score.el.gz.

Signature

(gnus-score-followup SCORES HEADER NOW EXPIRE &optional TRACE THREAD)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-score.el.gz
(defun gnus-score-followup (scores header now expire &optional trace thread)
  (if gnus-agent-fetching
      ;; FIXME: It seems doable in fetching mode.
      nil
    ;; Insert the unique article headers in the buffer.
    (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
	  (current-score-file gnus-current-score-file)
	  (all-scores scores)
	  ;; gnus-score-index is used as a free variable.
	  alike last this art entries alist articles
	  new news)

      ;; Change score file to the adaptive score file.  All entries that
      ;; this function makes will be put into this file.
      (with-current-buffer gnus-summary-buffer
	(gnus-score-load-file
	 (or gnus-newsgroup-adaptive-score-file
	     (gnus-score-file-name
	      gnus-newsgroup-name gnus-adaptive-file-suffix))))

      (setq gnus-scores-articles (sort gnus-scores-articles
				       #'gnus-score-string<)
	    articles gnus-scores-articles)

      (erase-buffer)
      (while articles
	(setq art (car articles)
	      this (aref (car art) gnus-score-index)
	      articles (cdr articles))
	(if (equal last this)
	    (push art alike)
	  (when last
	    (insert last ?\n)
	    (put-text-property (1- (point)) (point) 'articles alike))
	  (setq alike (list art)
		last this)))
      (when last			; Bwadr, duplicate code.
	(insert last ?\n)
	(put-text-property (1- (point)) (point) 'articles alike))

      ;; Find matches.
      (while scores
	(setq alist (car scores)
	      scores (cdr scores)
	      entries (assoc header alist))
	(while (cdr entries)		;First entry is the header index.
	  (let* ((rest (cdr entries))
		 (kill (car rest))
		 (match (nth 0 kill))
		 (type (or (nth 3 kill) 's))
		 (score (or (nth 1 kill) gnus-score-interactive-default-score))
		 (date (nth 2 kill))
		 (found nil)
		 (mt (aref (symbol-name type) 0))
		 (case-fold-search
		  (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F))))
		 (dmt (downcase mt))
		 (search-func
		  (cond ((= dmt ?r) 're-search-forward)
			((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
			(t (error "Invalid match type: %s" type))))
		 arts art)
	    (goto-char (point-min))
	    (if (= dmt ?e)
		(while (funcall search-func match nil t)
		  (and (= (point-at-bol)
			  (match-beginning 0))
		       (= (progn (end-of-line) (point))
			  (match-end 0))
		       (progn
			 (setq found (setq arts (get-text-property
						 (point) 'articles)))
			 ;; Found a match, update scores.
			 (while arts
			   (setq art (car arts)
				 arts (cdr arts))
			   (gnus-score-add-followups
			    (car art) score all-scores thread))))
		  (end-of-line))
	      (while (funcall search-func match nil t)
		(end-of-line)
		(setq found (setq arts (get-text-property (point) 'articles)))
		;; Found a match, update scores.
		(while (setq art (pop arts))
		  (setcdr art (+ score (cdr art)))
		  (when trace
		    (push (cons
			   (car-safe (rassq alist gnus-score-cache))
			   kill)
			  gnus-score-trace))
		  (when (setq new (gnus-score-add-followups
				   (car art) score all-scores thread))
		    (push new news)))))
	    ;; Update expire date
	    (cond ((null date))		;Permanent entry.
		  ((and found gnus-update-score-entry-dates)
					;Match, update date.
		   (gnus-score-set 'touched '(t) alist)
		   (setcar (nthcdr 2 kill) now))
		  ((and expire (< date expire))	;Old entry, remove.
		   (gnus-score-set 'touched '(t) alist)
		   (setcdr entries (cdr rest))
		   (setq rest entries)))
	    (setq entries rest))))
      ;; We change the score file back to the previous one.
      (with-current-buffer gnus-summary-buffer
	(gnus-score-load-file current-score-file))
      (list (cons "references" news)))))