Function: gnus-score-date

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

Signature

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

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-score.el.gz
(defun gnus-score-date (scores header now expire &optional trace)
  (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
	entries alist match match-func article)
    ;; 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))
	       (type (or (nth 3 kill) 'before))
	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
	       (date (nth 2 kill))
	       (found nil)
	       (articles gnus-scores-articles)
	       l)
	  (cond
	   ((eq type 'after)
	    (setq match-func 'string<
		  match (gnus-date-iso8601 (nth 0 kill))))
	   ((eq type '<)
	    (setq type 'after
		  match-func 'string<
		  match (gnus-time-iso8601
			 (time-subtract nil
					(* 86400 (nth 0 kill))))))
	   ((eq type 'before)
	    (setq match-func 'gnus-string>
		  match (gnus-date-iso8601 (nth 0 kill))))
	   ((eq type '>)
	    (setq type 'before
		  match-func 'gnus-string>
		  match (gnus-time-iso8601
			 (time-subtract nil
					(* 86400 (nth 0 kill))))))
	   ((eq type 'at)
	    (setq match-func 'string=
		  match (gnus-date-iso8601 (nth 0 kill))))
	   ((eq type 'regexp)
	    (setq match-func 'string-match
		  match (nth 0 kill)))
	   (t (error "Invalid match type: %s" type)))
	  ;; Instead of doing all the clever stuff that
	  ;; `gnus-score-string' does to minimize searches and stuff,
	  ;; I will assume that people generally will put so few
	  ;; matches on numbers that any cleverness will take more
	  ;; time than one would gain.
	  (while (setq article (pop articles))
	    (when (and
		   (setq l (aref (car article) gnus-score-index))
		   (funcall match-func match (gnus-date-iso8601 l)))
	      (when trace
		(push (cons (car-safe (rassq alist gnus-score-cache)) kill)
		      gnus-score-trace))
	      (setq found t)
	      (setcdr article (+ score (cdr article)))))
	  ;; 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)))))
  nil)