;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
See the documentation to these functions for more information.
This variable can also be a list of functions to be called. Each
-function should either return a list of score files, or a list of
-score alists.
+function is given the group name as argument and should either return
+a list of score files, or a list of score alists.
If functions other than these pre-defined functions are used,
the `a' symbolic prefix to the score commands will always use
:type '(radio (function-item gnus-score-find-single)
(function-item gnus-score-find-hierarchical)
(function-item gnus-score-find-bnews)
- (function :tag "Other")))
+ (repeat :tag "List of functions"
+ (choice (function :tag "Other" :value 'ignore)
+ (function-item gnus-score-find-single)
+ (function-item gnus-score-find-hierarchical)
+ (function-item gnus-score-find-bnews)))
+ (function :tag "Other" :value 'ignore)))
(defcustom gnus-score-interactive-default-score 1000
"*Scoring commands will raise/lower the score with this number as the default."
:group 'gnus-score-expire
:type 'boolean)
-(defcustom gnus-orphan-score nil
- "*All orphans get this score added. Set in the score file."
- :group 'gnus-score-default
- :type '(choice (const nil)
- integer))
-
(defcustom gnus-decay-scores nil
"*If non-nil, decay non-permanent scores."
:group 'gnus-score-decay
(repeat (choice string
(cons regexp (repeat file))
(function :value fun)))
+ (function-item gnus-hierarchial-home-score-file)
+ (function-item gnus-current-home-score-file)
(function :value fun)))
(defcustom gnus-home-adapt-file nil
(gnus-catchup-mark (subject -10))
(gnus-killed-mark (from -1) (subject -20))
(gnus-del-mark (from -2) (subject -15)))
-"*Alist of marks and scores."
-:group 'gnus-score-adapt
-:type '(repeat (cons (symbol :tag "Mark")
- (repeat (list (choice :tag "Header"
- (const from)
- (const subject)
- (symbol :tag "other"))
- (integer :tag "Score"))))))
+ "*Alist of marks and scores."
+ :group 'gnus-score-adapt
+ :type '(repeat (cons (symbol :tag "Mark")
+ (repeat (list (choice :tag "Header"
+ (const from)
+ (const subject)
+ (symbol :tag "other"))
+ (integer :tag "Score"))))))
(defcustom gnus-ignored-adaptive-words nil
"List of words to be ignored when doing adaptive word scoring."
(,gnus-catchup-mark . -10)
(,gnus-killed-mark . -20)
(,gnus-del-mark . -15))
-"*Alist of marks and scores."
-:group 'gnus-score-adapt
-:type '(repeat (cons (character :tag "Mark")
- (integer :tag "Score"))))
+ "*Alist of marks and scores."
+ :group 'gnus-score-adapt
+ :type '(repeat (cons (character :tag "Mark")
+ (integer :tag "Score"))))
(defcustom gnus-adaptive-word-minimum nil
"If a number, this is the minimum score value that can be assigned to a word."
(defcustom gnus-score-thread-simplify nil
"If non-nil, subjects will simplified as in threading."
:group 'gnus-score-various
- :type 'boolean)
+ :type 'boolean)
\f
;; Internal variables.
+(defvar gnus-score-use-all-scores t
+ "If nil, only `gnus-score-find-score-files-function' is used.")
+
(defvar gnus-adaptive-word-syntax-table
(let ((table (copy-syntax-table (standard-syntax-table)))
(numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
(defconst gnus-header-index
;; Name to index alist.
- '(("number" 1 gnus-score-integer)
- ("subject" 8 gnus-score-string)
- ("from" 9 gnus-score-string)
- ("date" 10 gnus-score-date)
- ("message-id" 11 gnus-score-string)
- ("references" 12 gnus-score-string)
- ("chars" 13 gnus-score-integer)
- ("lines" 14 gnus-score-integer)
- ("xref" 15 gnus-score-string)
- ("extra" 16 gnus-score-string)
+ `(("number"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'location)
+ gnus-score-integer)
+ ("subject"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'subject)
+ gnus-score-string)
+ ("from"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'from)
+ gnus-score-string)
+ ("date"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'date)
+ gnus-score-date)
+ ("message-id"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'id)
+ gnus-score-string)
+ ("references"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'references)
+ gnus-score-string)
+ ("chars"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'chars)
+ gnus-score-integer)
+ ("lines"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'lines)
+ gnus-score-integer)
+ ("xref"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'xref)
+ gnus-score-string)
+;; ("extra" 16 gnus-score-string)
+ ("extra" -1 gnus-score-body)
("head" -1 gnus-score-body)
("body" -1 gnus-score-body)
("all" -1 gnus-score-body)
- ("followup" 9 gnus-score-followup)
- ("thread" 12 gnus-score-thread)))
+ ("followup"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'from)
+ gnus-score-followup)
+ ("thread"
+ ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity)
+ 'references)
+ gnus-score-thread)))
;;; Summary mode score maps.
permanence, and the string to be used. The numerical prefix will be
used as score."
(interactive (gnus-interactive "P\ny"))
- (gnus-summary-increase-score (- (gnus-score-default score)) symp))
+ (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
(defun gnus-score-kill-help-buffer ()
(when (get-buffer "*Score Help*")
permanence, and the string to be used. The numerical prefix will be
used as score."
(interactive (gnus-interactive "P\ny"))
- (let* ((nscore (gnus-score-default score))
+ (let* ((nscore (gnus-score-delta-default score))
(prefix (if (< nscore 0) ?L ?I))
(increase (> nscore 0))
(char-to-header
(?s "subject" nil nil string)
(?b "body" "" nil body-string)
(?h "head" "" nil body-string)
- (?i "message-id" nil t string)
+ (?i "message-id" nil nil string)
(?r "references" "message-id" nil string)
(?x "xref" nil nil string)
(?e "extra" nil nil string)
(gnus-score-kill-help-buffer)
(unless (setq entry (assq (downcase hchar) char-to-header))
(if mimic (error "%c %c" prefix hchar)
- (error "Illegal header type")))
+ (error "Invalid header type")))
(when (/= (downcase hchar) hchar)
;; This was a majuscule, so we end reading and set the defaults.
(gnus-score-kill-help-buffer)
(unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
(if mimic (error "%c %c" prefix hchar)
- (error "Illegal match type"))))
+ (error "Invalid match type"))))
(when (/= (downcase tchar) tchar)
;; It was a majuscule, so we end reading and use the default.
;; Deal with der(r)ided superannuated paradigms.
(when (and (eq (1+ prefix) 77)
(eq (+ hchar 12) 109)
- (eq tchar 114)
+ (eq (1- tchar) 113)
(eq (- pchar 4) 111))
(error "You rang?"))
(if mimic
(error "%c %c %c %c" prefix hchar tchar pchar)
- (error "Illegal match duration"))))
+ (error "Invalid match duration"))))
;; Always kill the score help buffer.
(gnus-score-kill-help-buffer))
(setq extra
(and gnus-extra-headers
(equal (nth 1 entry) "extra")
- (intern ; need symbol
+ (intern ; need symbol
(gnus-completing-read
(symbol-name (car gnus-extra-headers)) ; default response
- "Score extra header:" ; prompt
- (mapcar (lambda (x) ; completion list
+ "Score extra header:" ; prompt
+ (mapcar (lambda (x) ; completion list
(cons (symbol-name x) x))
gnus-extra-headers)
- nil ; no completion limit
- t)))) ; require match
+ nil ; no completion limit
+ t)))) ; require match
;; extra is now nil or a symbol.
;; We have all the data, so we enter this score.
current-score-file)
(t
(gnus-score-file-name "all"))))))
-
+
(gnus-summary-score-entry
(nth 1 entry) ; Header
match ; Match
nil
temporary)
(not (nth 3 entry)) ; Prompt
- nil ; not silent
+ nil ; not silent
extra) ; non-standard overview.
(when (eq symp 'a)
(pop-to-buffer "*Score Help*")
(let ((window-min-height 1))
(shrink-window-if-larger-than-buffer))
- (select-window (get-buffer-window gnus-summary-buffer))))
+ (select-window (get-buffer-window gnus-summary-buffer t))))
(defun gnus-summary-header (header &optional no-err extra)
;; Return HEADER for current articles, or error.
(defun gnus-summary-score-entry (header match type score date
&optional prompt silent extra)
- (interactive)
"Enter score file entry.
HEADER is the header being scored.
MATCH is the string we are looking for.
(setq match (if match (gnus-simplify-subject-re match) "")))
((eq type 'f)
(setq match (gnus-simplify-subject-fuzzy match))))
- (let ((score (gnus-score-default score))
- (header (format "%s" (downcase header)))
+ (let ((score (gnus-score-delta-default score))
+ (header (downcase header))
new)
+ (set-text-properties 0 (length header) nil header)
(when prompt
(setq match (read-string
(format "Match %s on %s, %s: "
(int-to-string match)
match))))
- ;; Get rid of string props.
- (setq match (format "%s" match))
+ (set-text-properties 0 (length match) nil match)
;; If this is an integer comparison, we transform from string to int.
(when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
(defun gnus-score-followup-article (&optional score)
"Add SCORE to all followups to the article in the current buffer."
(interactive "P")
- (setq score (gnus-score-default score))
+ (setq score (gnus-score-delta-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
(save-restriction
(defun gnus-score-followup-thread (&optional score)
"Add SCORE to all later articles in the thread the current buffer is part of."
(interactive "P")
- (setq score (gnus-score-default score))
+ (setq score (gnus-score-delta-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
(save-restriction
(let ((buffer-read-only nil))
;; Set score.
(gnus-summary-update-mark
- (if (= n (or gnus-summary-default-score 0)) ?
+ (if (= n (or gnus-summary-default-score 0)) ? ;Whitespace
(if (< n (or gnus-summary-default-score 0))
gnus-score-below-mark gnus-score-over-mark))
'score))
err
(cond
((not (listp (car a)))
- (format "Illegal score element %s in %s" (car a) file))
+ (format "Invalid score element %s in %s" (car a) file))
((stringp (caar a))
(cond
((not (listp (setq sr (cdar a))))
- (format "Illegal header match %s in %s" (nth 1 (car a)) file))
+ (format "Invalid header match %s in %s" (nth 1 (car a)) file))
(t
(setq type (caar a))
(while (and sr (not err))
((if (member (downcase type) '("lines" "chars"))
(not (numberp (car s)))
(not (stringp (car s))))
- (format "Illegal match %s in %s" (car s) file))
+ (format "Invalid match %s in %s" (car s) file))
((and (cadr s) (not (integerp (cadr s))))
(format "Non-integer score %s in %s" (cadr s) file))
((and (caddr s) (not (integerp (caddr s))))
(while cache
(current-buffer)
(setq entry (pop cache)
- file (car entry)
+ file (nnheader-translate-file-chars (car entry) t)
score (cdr entry))
(if (or (not (equal (gnus-score-get 'touched score) '(t)))
(gnus-score-get 'read-only score)
(when (setq new (funcall (nth 2 entry) scores header
now expire trace))
(push new news))))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (let ((scored gnus-newsgroup-scored))
+ (with-current-buffer gnus-summary-buffer
+ (setq gnus-newsgroup-scored scored))))
;; Remove the buffer.
(kill-buffer (current-buffer)))
(let (score)
(while (setq score (pop scores))
(while score
- (when (listp (caar score))
+ (when (consp (caar score))
(gnus-score-advanced (car score) trace))
(pop score))))
(gnus-message 5 "Scoring...done"))))))
+(defun gnus-score-lower-thread (thread score-adjust)
+ "Lower the socre on THREAD with SCORE-ADJUST.
+THREAD is expected to contain a list of the form `(PARENT [CHILD1
+CHILD2 ...])' where PARENT is a header array and each CHILD is a list
+of the same form as THREAD. The empty list `nil' is valid. For each
+article in the tree, the score of the corresponding entry in
+GNUS-NEWSGROUP-SCORED is adjusted by SCORE-ADJUST."
+ (while thread
+ (let ((head (car thread)))
+ (if (listp head)
+ ;; handle a child and its descendants
+ (gnus-score-lower-thread head score-adjust)
+ ;; handle the parent
+ (let* ((article (mail-header-number head))
+ (score (assq article gnus-newsgroup-scored)))
+ (if score (setcdr score (+ (cdr score) score-adjust))
+ (push (cons article score-adjust) gnus-newsgroup-scored)))))
+ (setq thread (cdr thread))))
-(defun gnus-get-new-thread-ids (articles)
- (let ((index (nth 1 (assoc "message-id" gnus-header-index)))
- (refind gnus-score-index)
- id-list art this tref)
- (while articles
- (setq art (car articles)
- this (aref (car art) index)
- tref (aref (car art) refind)
- articles (cdr articles))
- (when (string-equal tref "") ;no references line
- (push this id-list)))
- id-list))
-
-;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers).
(defun gnus-score-orphans (score)
- (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles))
- alike articles art arts this last this-id)
-
- (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
- articles gnus-scores-articles)
-
- ;;more or less the same as in gnus-score-string
- (erase-buffer)
- (while articles
- (setq art (car articles)
- this (aref (car art) gnus-score-index)
- articles (cdr articles))
- ;;completely skip if this is empty (not a child, so not an orphan)
- (when (not (string= this ""))
- (if (equal last this)
- ;; O(N*H) cons-cells used here, where H is the number of
- ;; headers.
- (push art alike)
- (when last
- ;; Insert the line, with a text property on the
- ;; terminating newline referring to the articles with
- ;; this line.
- (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))
-
- ;; PLM: now delete those lines that contain an entry from new-thread-ids
- (while new-thread-ids
- (setq this-id (car new-thread-ids)
- new-thread-ids (cdr new-thread-ids))
- (goto-char (point-min))
- (while (search-forward this-id nil t)
- ;; found a match. remove this line
- (beginning-of-line)
- (kill-line 1)))
-
- ;; now for each line: update its articles with score by moving to
- ;; every end-of-line in the buffer and read the articles property
- (goto-char (point-min))
- (while (eq 0 (progn
- (end-of-line)
- (setq arts (get-text-property (point) 'articles))
- (while arts
- (setq art (car arts)
- arts (cdr arts))
- (setcdr art (+ score (cdr art))))
- (forward-line))))))
-
+ "Score orphans.
+A root is an article with no references. An orphan is an article
+which has references, but is not connected via its references to a
+root article. This function finds all the orphans, and adjusts their
+score in GNUS-NEWSGROUP-SCORED by SCORE."
+ (let ((threads (gnus-make-threads)))
+ ;; gnus-make-threads produces a list, where each entry is a "thread"
+ ;; as described in the gnus-score-lower-thread docs. This function
+ ;; will be called again (after limiting has been done) if the display
+ ;; is threaded. It would be nice to somehow save this info and use
+ ;; it later.
+ (while threads
+ (let* ((thread (car threads))
+ (id (aref (car thread) gnus-score-index)))
+ ;; If the parent of the thread is not a root, lower the score of
+ ;; it and its descendants. Note that some roots seem to satisfy
+ ;; (eq id nil) and some (eq id ""); not sure why.
+ (if (and id (not (string= id "")))
+ (gnus-score-lower-thread thread score)))
+ (setq threads (cdr threads)))))
(defun gnus-score-integer (scores header now expire &optional trace)
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
entries alist)
-
;; Find matches.
(while scores
(setq alist (car scores)
(match-func (if (or (eq type '>) (eq type '<) (eq type '<=)
(eq type '>=) (eq type '=))
type
- (error "Illegal match type: %s" type)))
+ (error "Invalid match type: %s" type)))
(articles gnus-scores-articles))
;; Instead of doing all the clever stuff that
;; `gnus-score-string' does to minimize searches and stuff,
(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)
((eq type 'regexp)
(setq match-func 'string-match
match (nth 0 kill)))
- (t (error "Illegal match type: %s" type)))
+ (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
(while articles
(setq article (mail-header-number (caar articles)))
(gnus-message 7 "Scoring article %s of %s..." article last)
+ (widen)
(when (funcall request-func article gnus-newsgroup-name)
- (widen)
(goto-char (point-min))
;; If just parts of the article is to be searched, but the
;; backend didn't support partial fetching, we just narrow
(eq type 'string) (eq type 'String))
'search-forward)
(t
- (error "Illegal match type: %s" type)))))
+ (error "Invalid match type: %s" type)))))
(goto-char (point-min))
(when (funcall search-func match nil t)
;; Found a match, update scores.
(search-func
(cond ((= dmt ?r) 're-search-forward)
((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
- (t (error "Illegal match type: %s" type))))
+ (t (error "Invalid match type: %s" type))))
arts art)
(goto-char (point-min))
(if (= dmt ?e)
;; with working on them as a group. What a hassle.
;; Just wait 'til you see what horrors we commit against `match'...
(if (= gnus-score-index 9)
- (setq this (prin1-to-string this))) ; ick.
+ (setq this (prin1-to-string this))) ; ick.
(if simplify
(setq this (gnus-map-function gnus-simplify-subject-functions this)))
(mt (aref (symbol-name type) 0))
(case-fold-search (not (memq mt '(?R ?S ?E ?F))))
(dmt (downcase mt))
- ; Assume user already simplified regexp and fuzzies
+ ;; Assume user already simplified regexp and fuzzies
(match (if (and simplify (not (memq dmt '(?f ?r))))
(gnus-map-function
gnus-simplify-subject-functions
(cond ((= dmt ?r) 're-search-forward)
((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
((= dmt ?w) nil)
- (t (error "Illegal match type: %s" type)))))
+ (t (error "Invalid match type: %s" type)))))
;; Evil hackery to make match usable in non-standard headers.
(when extra
- (setq match (concat "[ (](" extra " \\. \"[^)]*" match "[^(]*\")[ )]")
- search-func 're-search-forward)) ; XXX danger?!?
+ (setq match (concat "[ (](" extra " \\. \"[^)]*"
+ match "[^(]*\")[ )]")
+ search-func 're-search-forward)) ; XXX danger?!?
(cond
;; Fuzzy matches. We save these for later.
(cond
;; Permanent.
((null date)
+ ;; Do nothing.
)
;; Match, update date.
((and found gnus-update-score-entry-dates)
(cond
;; Permanent.
((null date)
+ ;; Do nothing.
)
;; Match, update date.
((and found gnus-update-score-entry-dates)
(let ((ignored (append gnus-ignored-adaptive-words
(if gnus-adaptive-word-no-group-words
(message-tokenize-header
- (gnus-group-real-name
+ (gnus-group-real-name
gnus-newsgroup-name)
"."))
gnus-default-ignored-adaptive-words)))
(gnus-summary-raise-score score))
(gnus-summary-next-subject 1 t)))
-(defun gnus-score-default (level)
+(defun gnus-score-delta-default (level)
(if level (prefix-numeric-value level)
gnus-score-interactive-default-score))
(defun gnus-summary-raise-thread (&optional score)
"Raise the score of the articles in the current thread with SCORE."
(interactive "P")
- (setq score (gnus-score-default score))
+ (setq score (gnus-score-delta-default score))
(let (e)
(save-excursion
(let ((articles (gnus-summary-articles-in-thread)))
(defun gnus-summary-lower-thread (&optional score)
"Lower score of articles in the current thread with SCORE."
(interactive "P")
- (gnus-summary-raise-thread (- (1- (gnus-score-default score)))))
+ (gnus-summary-raise-thread (- (1- (gnus-score-delta-default score)))))
;;; Finding score files.
(klen (length kill-dir))
(score-regexp (gnus-score-file-regexp))
(trans (cdr (assq ?: nnheader-file-name-translation-alist)))
+ (group-trans (nnheader-translate-file-chars group t))
ofiles not-match regexp)
(save-excursion
(set-buffer (gnus-get-buffer-create "*gnus score files*"))
;; too much.
(delete-char (min (1- (point-max)) klen))
(goto-char (point-max))
- (search-backward "/")
+ (search-backward (char-to-string directory-sep-char))
(delete-region (1+ (point)) (point-min)))
;; If short file names were used, we have to translate slashes.
(goto-char (point-min))
(if (looking-at "not.")
(progn
(setq not-match t)
- (setq regexp (concat "^" (buffer-substring 5 (point-max)) "$")))
+ (setq regexp
+ (concat "^" (buffer-substring 5 (point-max)) "$")))
(setq regexp (concat "^" (buffer-substring 1 (point-max)) "$"))
(setq not-match nil))
;; Finally - if this resulting regexp matches the group name,
;; we add this score file to the list of score files
;; applicable to this group.
(when (or (and not-match
- (not (string-match regexp group)))
- (and (not not-match)
- (string-match regexp group)))
+ (ignore-errors
+ (not (string-match regexp group-trans))))
+ (and (not not-match)
+ (ignore-errors (string-match regexp group-trans))))
(push (car sfiles) ofiles)))
(setq sfiles (cdr sfiles)))
(kill-buffer (current-buffer))
(and funcs
(not (listp funcs))
(setq funcs (list funcs)))
- ;; Get the initial score files for this group.
- (when funcs
- (setq score-files (nreverse (gnus-score-find-alist group))))
- ;; Add any home adapt files.
- (let ((home (gnus-home-score-file group t)))
- (when home
- (push home score-files)
- (setq gnus-newsgroup-adaptive-score-file home)))
- ;; Check whether there is a `adapt-file' group parameter.
- (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
- (when param-file
- (push param-file score-files)
- (setq gnus-newsgroup-adaptive-score-file param-file)))
+ (when gnus-score-use-all-scores
+ ;; Get the initial score files for this group.
+ (when funcs
+ (setq score-files (nreverse (gnus-score-find-alist group))))
+ ;; Add any home adapt files.
+ (let ((home (gnus-home-score-file group t)))
+ (when home
+ (push home score-files)
+ (setq gnus-newsgroup-adaptive-score-file home)))
+ ;; Check whether there is a `adapt-file' group parameter.
+ (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
+ (when param-file
+ (push param-file score-files)
+ (setq gnus-newsgroup-adaptive-score-file param-file))))
;; Go through all the functions for finding score files (or actual
;; scores) and add them to a list.
(while funcs
(setq score-files
(nconc score-files (nreverse (funcall (car funcs) group)))))
(setq funcs (cdr funcs)))
- ;; Add any home score files.
- (let ((home (gnus-home-score-file group)))
- (when home
- (push home score-files)))
- ;; Check whether there is a `score-file' group parameter.
- (let ((param-file (gnus-group-find-parameter group 'score-file)))
- (when param-file
- (push param-file score-files)))
+ (when gnus-score-use-all-scores
+ ;; Add any home score files.
+ (let ((home (gnus-home-score-file group)))
+ (when home
+ (push home score-files)))
+ ;; Check whether there is a `score-file' group parameter.
+ (let ((param-file (gnus-group-find-parameter group 'score-file)))
+ (when param-file
+ (push param-file score-files))))
;; Expand all files names.
(let ((files score-files))
(while files
;; Function.
((gnus-functionp elem)
(funcall elem group))
- ;; Regexp-file cons
+ ;; Regexp-file cons.
((consp elem)
(when (string-match (gnus-globalify-regexp (car elem)) group)
- (replace-match (cadr elem) t nil group ))))))
+ (replace-match (cadr elem) t nil group))))))
(when found
- (nnheader-concat gnus-kill-files-directory found))))
+ (if (file-name-absolute-p found)
+ found
+ (nnheader-concat gnus-kill-files-directory found)))))
(defun gnus-hierarchial-home-score-file (group)
"Return the score file of the top-level hierarchy of GROUP."
n times)
(while (natnump (decf n))
(setq score (funcall gnus-decay-score-function score)))
- (setcdr kill (cons score
+ (setcdr kill (cons score
(cdr (cdr kill)))))))))
;; Return whether this score file needs to be saved. By Je-haysuss!
updated))
(cond
(bad (cons 'bad bad))
(new (cons 'new new))
- ;; or nil
- )))))
+ (t nil))))))
(provide 'gnus-score)