Function: gnus-score-load-file

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

Signature

(gnus-score-load-file FILE)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-score.el.gz
(defun gnus-score-load-file (file)
  ;; Load score file FILE.  Returns a list a retrieved score-alists.
  (let* ((file (expand-file-name
		(or (and (string-match
			  (concat "^" (regexp-quote
				       (expand-file-name
					gnus-kill-files-directory)))
			  (expand-file-name file))
			 file)
		    (expand-file-name file gnus-kill-files-directory))))
	 (cached (assoc file gnus-score-cache))
	 (global (member file gnus-internal-global-score-files))
	 lists alist)
    (if cached
	;; The score file was already loaded.
	(setq alist (cdr cached))
      ;; We load the score file.
      (setq gnus-score-alist nil)
      (setq alist (gnus-score-load-score-alist file))
      ;; We add '(touched) to the alist to signify that it hasn't been
      ;; touched (yet).
      (unless (assq 'touched alist)
	(push (list 'touched nil) alist))
      ;; If it is a global score file, we make it read-only.
      (and global
	   (not (assq 'read-only alist))
	   (push (list 'read-only t) alist))
      (push (cons file alist) gnus-score-cache))
    (let ((a alist)
	  found)
      (while a
	;; Downcase all header names.
	(cond
	 ((stringp (caar a))
	  (setcar (car a) (downcase (caar a)))
	  (setq found t))
	 ;; Advanced scoring.
	 ((consp (caar a))
	  (setq found t)))
	(pop a))
      ;; If there are actual scores in the alist, we add it to the
      ;; return value of this function.
      (when found
	(setq lists (list alist))))
    ;; Treat the other possible atoms in the score alist.
    (let ((mark (car (gnus-score-get 'mark alist)))
	  (expunge (car (gnus-score-get 'expunge alist)))
	  (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
	  ;; (score-fn (car (gnus-score-get 'score-fn alist)))
	  (files (gnus-score-get 'files alist))
	  (exclude-files (gnus-score-get 'exclude-files alist))
	  (orphan (car (gnus-score-get 'orphan alist)))
	  (adapt (gnus-score-get 'adapt alist))
	  (thread-mark-and-expunge
	   (car (gnus-score-get 'thread-mark-and-expunge alist)))
	  (adapt-file (car (gnus-score-get 'adapt-file alist)))
	  (local (gnus-score-get 'local alist))
	  (decay (car (gnus-score-get 'decay alist)))
	  (eval (car (gnus-score-get 'eval alist))))
      ;; Perform possible decays.
      (when (and (if (stringp gnus-decay-scores)
		     (string-match gnus-decay-scores file)
		   gnus-decay-scores)
		 (or cached (file-exists-p file))
		 (or (not decay)
		     (gnus-decay-scores alist decay)))
	(gnus-score-set 'touched '(t) alist)
	(gnus-score-set 'decay (list (time-to-days nil)) alist))
      ;; We do not respect eval and files atoms from global score
      ;; files.
      (when (and files (not global))
	(setq lists (apply #'append lists
			   (mapcar #'gnus-score-load-file
				   (if adapt-file (cons adapt-file files)
				     files)))))
      (when (and eval (not global))
	(eval eval t))
      ;; We then expand any exclude-file directives.
      (setq gnus-scores-exclude-files
	    (nconc
	     (apply
	      #'nconc
	      (mapcar
	       (lambda (sfile)
		 (list
		  (expand-file-name sfile (file-name-directory file))
		  (expand-file-name sfile gnus-kill-files-directory)))
	       exclude-files))
	     gnus-scores-exclude-files))
      (when local
	(with-current-buffer gnus-summary-buffer
	  (while local
	    (and (consp (car local))
		 (symbolp (caar local))
		 (progn
		   (make-local-variable (caar local))
		   (set (caar local) (nth 1 (car local)))))
	    (setq local (cdr local)))))
      (when orphan
	(setq gnus-orphan-score orphan))
      (setq gnus-adaptive-score-alist
	    (cond ((equal adapt '(t))
		   (setq gnus-newsgroup-adaptive t)
		   gnus-default-adaptive-score-alist)
		  ((equal adapt '(ignore))
		   (setq gnus-newsgroup-adaptive nil))
		  ((consp adapt)
		   (setq gnus-newsgroup-adaptive t)
		   adapt)
		  (t
		   gnus-default-adaptive-score-alist)))
      (setq gnus-thread-expunge-below
	    (or thread-mark-and-expunge gnus-thread-expunge-below))
      (setq gnus-summary-mark-below
	    (or mark mark-and-expunge gnus-summary-mark-below))
      (setq gnus-summary-expunge-below
	    (or expunge mark-and-expunge gnus-summary-expunge-below))
      (setq gnus-newsgroup-adaptive-score-file
	    (or adapt-file gnus-newsgroup-adaptive-score-file)))
    (setq gnus-current-score-file file)
    (setq gnus-score-alist alist)
    lists))