-1;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;;; gnus-score.el --- scoring code for Gnus
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
-;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
(require 'gnus-sum)
(require 'gnus-range)
(require 'message)
+(require 'score-mode)
(defcustom gnus-global-score-files nil
"List of global score files and directories.
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."
+score alists.
+
+If functions other than these pre-defined functions are used,
+the `a' symbolic prefix to the score commands will always use
+\"all.SCORE\"."
:group 'gnus-score-files
:type '(radio (function-item gnus-score-find-single)
(function-item gnus-score-find-hierarchical)
(defcustom gnus-orphan-score nil
"*All orphans get this score added. Set in the score file."
:group 'gnus-score-default
- :type 'integer)
+ :type '(choice (const nil)
+ integer))
(defcustom gnus-decay-scores nil
"*If non-nil, decay non-permanent scores."
:type '(choice string
(repeat (choice string
(cons regexp (repeat file))
- function))
- function))
+ (function :value fun)))
+ (function :value fun)))
(defcustom gnus-home-adapt-file nil
"Variable to control where new adaptive score entries are to go.
:type '(choice string
(repeat (choice string
(cons regexp (repeat file))
- function))
- function))
+ (function :value fun)))
+ (function :value fun)))
(defcustom gnus-default-adaptive-score-alist
'((gnus-kill-file-mark)
(gnus-catchup-mark (subject -10))
(gnus-killed-mark (from -1) (subject -20))
(gnus-del-mark (from -2) (subject -15)))
-"Alist of marks and scores."
+"*Alist of marks and scores."
:group 'gnus-score-adapt
:type '(repeat (cons (symbol :tag "Mark")
(repeat (list (choice :tag "Header"
"being" "current" "back" "still" "go" "point" "value" "each" "did"
"both" "true" "off" "say" "another" "state" "might" "under" "start"
"try" "re")
- "Default list of words to be ignored when doing adaptive word scoring."
+ "*Default list of words to be ignored when doing adaptive word scoring."
:group 'gnus-score-adapt
:type '(repeat string))
(,gnus-catchup-mark . -10)
(,gnus-killed-mark . -20)
(,gnus-del-mark . -15))
-"Alist of marks and scores."
+"*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."
+ :group 'gnus-score-adapt
+ :type '(choice (const nil) integer))
+
+(defcustom gnus-adaptive-word-no-group-words nil
+ "If t, don't adaptively score words included in the group name."
+ :group 'gnus-score-adapt
+ :type 'boolean)
+
(defcustom gnus-score-mimic-keymap nil
"*Have the score entry functions pretend that they are a keymap."
:group 'gnus-score-default
(const :tag "xref" x)
(const :tag "lines" l)
(const :tag "date" d)
- (const :tag "followup" f)))
+ (const :tag "followup" f)
+ (const :tag "ask" nil)))
(defcustom gnus-score-default-type nil
"Default match type when entering new scores.
f: fuzzy string
r: regexp string
b: before date
- a: at date
+ a: after date
n: this date
<: less than number
>: greater than number
(const :tag "fuzzy string" f)
(const :tag "regexp string" r)
(const :tag "before date" b)
- (const :tag "at date" a)
+ (const :tag "after date" a)
(const :tag "this date" n)
(const :tag "less than number" <)
(const :tag "greater than number" >)
- (const :tag "equal than number" =)))
+ (const :tag "equal than number" =)
+ (const :tag "ask" nil)))
(defcustom gnus-score-default-fold nil
"Use case folding for new score file entries iff not nil."
:group 'gnus-score-files
:type 'function)
+(defcustom gnus-score-thread-simplify nil
+ "If non-nil, subjects will simplified as in threading."
+ :group 'gnus-score-various
+ :type 'boolean)
+
\f
;; Internal variables.
(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
"s" gnus-summary-set-score
- "a" gnus-summary-score-entry
"S" gnus-summary-current-score
"c" gnus-score-change-score-file
"C" gnus-score-customize
permanence, and the string to be used. The numerical prefix will be
used as score."
(interactive (gnus-interactive "P\ny"))
- (gnus-set-global-variables)
(let* ((nscore (gnus-score-default score))
(prefix (if (< nscore 0) ?L ?I))
(increase (> nscore 0))
(?b "body" "" nil body-string)
(?h "head" "" nil body-string)
(?i "message-id" nil t string)
- (?t "references" "message-id" nil string)
+ (?r "references" "message-id" nil string)
(?x "xref" nil nil string)
(?l "lines" nil nil number)
(?d "date" nil nil date)
(?f "followup" nil nil string)
- (?T "thread" nil nil string)))
+ (?t "thread" nil nil string)))
(char-to-type
'((?s s "substring" string)
(?e e "exact string" string)
(?z s "substring" body-string)
(?p r "regexp string" body-string)
(?b before "before date" date)
- (?a at "at date" date)
- (?n now "this date" date)
+ (?a after "after date" date)
+ (?n at "this date" date)
(?< < "less than number" number)
(?> > "greater than number" number)
(?= = "equal to number" number)))
(save-excursion
(set-buffer gnus-summary-buffer)
(gnus-score-load-file
- (gnus-score-file-name "all"))))
+ ;; This is a kludge; yes...
+ (cond
+ ((eq gnus-score-find-score-files-function
+ 'gnus-score-find-hierarchical)
+ (gnus-score-file-name ""))
+ ((eq gnus-score-find-score-files-function 'gnus-score-find-single)
+ current-score-file)
+ (t
+ (gnus-score-file-name "all"))))))
(gnus-summary-score-entry
(nth 1 entry) ; Header
(defun gnus-score-insert-help (string alist idx)
(setq gnus-score-help-winconf (current-window-configuration))
(save-excursion
- (set-buffer (get-buffer-create "*Score Help*"))
+ (set-buffer (gnus-get-buffer-create "*Score Help*"))
(buffer-disable-undo (current-buffer))
(delete-windows-on (current-buffer))
(erase-buffer)
DATE is the expire date, or nil for no expire, or 'now for immediate expire.
If optional argument `PROMPT' is non-nil, allow user to edit match.
If optional argument `SILENT' is nil, show effect of score entry."
- (interactive
- (list (completing-read "Header: "
- gnus-header-index
- (lambda (x) (fboundp (nth 2 x)))
- t)
- (read-string "Match: ")
- (if (y-or-n-p "Use regexp match? ") 'r 's)
- (and current-prefix-arg
- (prefix-numeric-value current-prefix-arg))
- (cond ((not (y-or-n-p "Add to score file? "))
- 'now)
- ((y-or-n-p "Expire kill? ")
- (current-time-string))
- (t nil))))
;; Regexp is the default type.
(when (eq type t)
(setq type 'r))
(or (nth 1 new)
gnus-score-interactive-default-score)))
;; Nope, we have to add a new elem.
- (gnus-score-set header (if old (cons new old) (list new))))
+ (gnus-score-set header (if old (cons new old) (list new)) nil t))
(gnus-score-set 'touched '(t))))
;; Score the current buffer.
"references" id 's
score (current-time-string))))))))
-(defun gnus-score-set (symbol value &optional alist)
+(defun gnus-score-set (symbol value &optional alist warn)
;; Set SYMBOL to VALUE in ALIST.
(let* ((alist
(or alist
(entry (assoc symbol alist)))
(cond ((gnus-score-get 'read-only alist)
;; This is a read-only score file, so we do nothing.
- )
+ (when warn
+ (gnus-message 4 "Note: read-only score file; entry discarded")))
(entry
(setcdr entry value))
((null alist)
(defun gnus-summary-raise-score (n)
"Raise the score of the current article by N."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-set-score (+ (gnus-summary-article-score)
(or n gnus-score-interactive-default-score ))))
(defun gnus-summary-set-score (n)
"Set the score of the current article to N."
(interactive "p")
- (gnus-set-global-variables)
(save-excursion
(gnus-summary-show-thread)
(let ((buffer-read-only nil))
(defun gnus-summary-current-score ()
"Return the score of the current article."
(interactive)
- (gnus-set-global-variables)
(gnus-message 1 "%s" (gnus-summary-article-score)))
(defun gnus-score-change-score-file (file)
(defun gnus-score-edit-current-scores (file)
"Edit the current score alist."
(interactive (list gnus-current-score-file))
- (gnus-set-global-variables)
- (let ((winconf (current-window-configuration)))
- (when (buffer-name gnus-summary-buffer)
- (gnus-score-save))
- (gnus-make-directory (file-name-directory file))
- (setq gnus-score-edit-buffer (find-file-noselect file))
- (gnus-configure-windows 'edit-score)
- (select-window (get-buffer-window gnus-score-edit-buffer))
- (gnus-score-mode)
- (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf))
- (gnus-message
- 4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+ (if (not gnus-current-score-file)
+ (error "No current score file")
+ (let ((winconf (current-window-configuration)))
+ (when (buffer-name gnus-summary-buffer)
+ (gnus-score-save))
+ (gnus-make-directory (file-name-directory file))
+ (setq gnus-score-edit-buffer (find-file-noselect file))
+ (gnus-configure-windows 'edit-score)
+ (gnus-score-mode)
+ (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf))
+ (gnus-message
+ 4 (substitute-command-keys
+ "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
(defun gnus-score-edit-file (file)
"Edit a score file."
;; Load score file FILE. Returns a list a retrieved score-alists.
(let* ((file (expand-file-name
(or (and (string-match
- (concat "^" (expand-file-name
- gnus-kill-files-directory))
+ (concat "^" (regexp-quote
+ (expand-file-name
+ gnus-kill-files-directory)))
(expand-file-name file))
file)
(concat (file-name-as-directory gnus-kill-files-directory)
found)
(while a
;; Downcase all header names.
- (when (stringp (caar a))
+ (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.
(decay (car (gnus-score-get 'decay alist)))
(eval (car (gnus-score-get 'eval alist))))
;; Perform possible decays.
- (when gnus-decay-scores
- (when (or (not decay)
- (gnus-decay-scores alist decay))
- (gnus-score-set 'touched '(t) alist)
- (gnus-score-set 'decay (list (gnus-time-to-day (current-time))))))
+ (when (and 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 (gnus-time-to-day (current-time))) alist))
;; We do not respect eval and files atoms from global score
;; files.
- (and files (not global)
- (setq lists (apply 'append lists
- (mapcar (lambda (file)
- (gnus-score-load-file file))
- (if adapt-file (cons adapt-file files)
- files)))))
- (and eval (not global) (eval eval))
+ (when (and files (not global))
+ (setq lists (apply 'append lists
+ (mapcar (lambda (file)
+ (gnus-score-load-file file))
+ (if adapt-file (cons adapt-file files)
+ files)))))
+ (when (and eval (not global))
+ (eval eval))
;; We then expand any exclude-file directives.
(setq gnus-scores-exclude-files
(nconc
- (mapcar
- (lambda (sfile)
- (expand-file-name sfile (file-name-directory file)))
- exclude-files)
+ (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))
- (if (not local)
- ()
+ (when local
(save-excursion
(set-buffer gnus-summary-buffer)
(while local
(read (current-buffer))
(error
(gnus-error 3.2 "Problem with score file %s" file))))))
- (if (eq (car alist) 'setq)
- ;; This is an old-style score file.
- (setq gnus-score-alist (gnus-score-transform-old-to-new alist))
- (setq gnus-score-alist alist))
+ (cond
+ ((and alist
+ (atom alist))
+ ;; Bogus score file.
+ (error "Invalid syntax with score file %s" file))
+ ((eq (car alist) 'setq)
+ ;; This is an old-style score file.
+ (setq gnus-score-alist (gnus-score-transform-old-to-new alist)))
+ (t
+ (setq gnus-score-alist alist)))
;; Check the syntax of the score file.
(setq gnus-score-alist
(gnus-score-check-syntax gnus-score-alist file)))))
(and (file-exists-p file)
(not (file-writable-p file))))
()
- (setq score (setcdr entry (delq (assq 'touched score) score)))
+ (setq score (setcdr entry (gnus-delete-alist 'touched score)))
(erase-buffer)
(let (emacs-lisp-mode-hook)
(if (string-match
(gnus-prin1 score)
;; This is a normal score file, so we print it very
;; prettily.
- (pp score (current-buffer))))
+ (let ((lisp-mode-syntax-table score-mode-syntax-table))
+ (pp score (current-buffer)))))
(gnus-make-directory (file-name-directory file))
;; If the score file is empty, we delete it.
(if (zerop (buffer-size))
gnus-scores-articles))))
(save-excursion
- (set-buffer (get-buffer-create "*Headers*"))
+ (set-buffer (gnus-get-buffer-create "*Headers*"))
(buffer-disable-undo (current-buffer))
(when (gnus-buffer-live-p gnus-summary-buffer)
(message-clone-locals gnus-summary-buffer))
(setq request-func 'gnus-request-article))
(while articles
(setq article (mail-header-number (caar articles)))
- (gnus-message 7 "Scoring on article %s of %s..." article last)
+ (gnus-message 7 "Scoring article %s of %s..." article last)
(when (funcall request-func article gnus-newsgroup-name)
(widen)
(goto-char (point-min))
;; Insert the unique article headers in the buffer.
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
;; gnus-score-index is used as a free variable.
+ (simplify (and gnus-score-thread-simplify
+ (string= "subject" header)))
alike last this art entries alist articles
fuzzies arts words kill)
(erase-buffer)
(while (setq art (pop articles))
(setq this (aref (car art) gnus-score-index))
+ (if simplify
+ (setq this (gnus-map-function gnus-simplify-subject-functions this)))
(if (equal last this)
;; O(N*H) cons-cells used here, where H is the number of
;; headers.
entries (assoc header alist))
(while (cdr entries) ;First entry is the header index.
(let* ((kill (cadr entries))
- (match (nth 0 kill))
(type (or (nth 3 kill) 's))
(score (or (nth 1 kill) gnus-score-interactive-default-score))
(date (nth 2 kill))
(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
+ (match (if (and simplify (not (memq dmt '(?f ?r))))
+ (gnus-map-function
+ gnus-simplify-subject-functions
+ (nth 0 kill))
+ (nth 0 kill)))
(search-func
(cond ((= dmt ?r) 're-search-forward)
((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
(cond
;; Fuzzy matches. We save these for later.
((= dmt ?f)
- (push (cons entries alist) fuzzies))
+ (push (cons entries alist) fuzzies)
+ (setq entries (cdr entries)))
;; Word matches. Save these for even later.
((= dmt ?w)
- (push (cons entries alist) words))
+ (push (cons entries alist) words)
+ (setq entries (cdr entries)))
;; Exact matches.
((= dmt ?e)
;; Do exact matching.
gnus-score-trace))
(while (setq art (pop arts))
(setcdr art (+ score (cdr art)))))))
- (forward-line 1)))
+ (forward-line 1))
+ ;; Update expiry date
+ (if trace
+ (setq entries (cdr entries))
+ (cond
+ ;; Permanent entry.
+ ((null date)
+ (setq entries (cdr entries)))
+ ;; We have a match, so we update the date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now)
+ (setq entries (cdr entries)))
+ ;; This entry has expired, so we remove it.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cddr entries)))
+ ;; No match; go to next entry.
+ (t
+ (setq entries (cdr entries))))))
;; Regexp and substring matching.
(t
(goto-char (point-min))
gnus-score-trace))
(while (setq art (pop arts))
(setcdr art (+ score (cdr art)))))
- (forward-line 1))))
- ;; Update expiry date
- (if trace
- (setq entries (cdr entries))
- (cond
- ;; Permanent entry.
- ((null date)
- (setq entries (cdr entries)))
- ;; We have a match, so we update the date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now)
- (setq entries (cdr entries)))
- ;; This entry has expired, so we remove it.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cddr entries)))
- ;; No match; go to next entry.
- (t
- (setq entries (cdr entries))))))))
+ (forward-line 1))
+ ;; Update expiry date
+ (if trace
+ (setq entries (cdr entries))
+ (cond
+ ;; Permanent entry.
+ ((null date)
+ (setq entries (cdr entries)))
+ ;; We have a match, so we update the date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now)
+ (setq entries (cdr entries)))
+ ;; This entry has expired, so we remove it.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cddr entries)))
+ ;; No match; go to next entry.
+ (t
+ (setq entries (cdr entries))))))))))
;; Find fuzzy matches.
(when fuzzies
(setcdr art (+ score (cdr art))))))
(forward-line 1))
;; Update expiry date
- (cond
- ;; Permanent.
- ((null date)
- )
- ;; Match, update date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) (cdar fuzzies))
- (setcar (nthcdr 2 kill) now))
- ;; Old entry, remove.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) (cdar fuzzies))
- (setcdr (caar fuzzies) (cddaar fuzzies))))
+ (if (not trace)
+ (cond
+ ;; Permanent.
+ ((null date)
+ )
+ ;; Match, update date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) (cdar fuzzies))
+ (setcar (nthcdr 2 kill) now))
+ ;; Old entry, remove.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) (cdar fuzzies))
+ (setcdr (caar fuzzies) (cddaar fuzzies)))))
(setq fuzzies (cdr fuzzies)))))
(when words
(while (setq art (pop arts))
(setcdr art (+ score (cdr art))))))
;; Update expiry date
- (cond
- ;; Permanent.
- ((null date)
- )
- ;; Match, update date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) (cdar words))
- (setcar (nthcdr 2 kill) now))
- ;; Old entry, remove.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) (cdar words))
- (setcdr (caar words) (cddaar words))))
+ (if (not trace)
+ (cond
+ ;; Permanent.
+ ((null date)
+ )
+ ;; Match, update date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) (cdar words))
+ (setcar (nthcdr 2 kill) now))
+ ;; Old entry, remove.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) (cdar words))
+ (setcdr (caar words) (cddaar words)))))
(setq words (cdr words))))))
nil))
(set-syntax-table syntab))
;; 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
(gnus-sethash (pop ignored) nil hashtb)))))
(set-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.
(alist malist)
(date (current-time-string))
(data gnus-newsgroup-data)
- elem headers match)
+ elem headers match func)
;; First we transform the adaptive rule alist into something
;; that's faster to process.
(while malist
(setcar elem (symbol-value (car elem))))
(setq elem (cdr elem))
(while elem
- (setcdr (car elem)
- (cons (if (eq (caar elem) 'followup)
- "references"
- (symbol-name (caar elem)))
- (cdar elem)))
- (setcar (car elem)
- `(lambda (h)
- (,(intern
+ (when (fboundp
+ (setq func
+ (intern
(concat "mail-header-"
(if (eq (caar elem) 'followup)
"message-id"
- (downcase (symbol-name (caar elem))))))
- h)))
+ (downcase (symbol-name (caar elem))))))))
+ (setcdr (car elem)
+ (cons (if (eq (caar elem) 'followup)
+ "references"
+ (symbol-name (caar elem)))
+ (cdar elem)))
+ (setcar (car elem)
+ `(lambda (h)
+ (,func h))))
(setq elem (cdr elem)))
(setq malist (cdr malist)))
;; Then we score away.
;; Put the word and score into the hashtb.
(setq val (gnus-gethash (setq word (match-string 0))
hashtb))
- (gnus-sethash word (+ (or val 0) score) hashtb))
+ (setq val (+ score (or val 0)))
+ (if (and gnus-adaptive-word-minimum
+ (< val gnus-adaptive-word-minimum))
+ (setq val gnus-adaptive-word-minimum))
+ (gnus-sethash word val hashtb))
(erase-buffer))))
(set-syntax-table syntab))
;; 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
(gnus-sethash (pop ignored) nil hashtb)))
1 "No score rules apply to the current article (default score %d)."
gnus-summary-default-score)
(set-buffer "*Score Trace*")
- (gnus-add-current-to-buffer-list)
(while trace
(insert (format "%S -> %s\n" (cdar trace)
(if (caar trace)
(while rules
(insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
(pop rules))
- (gnus-add-current-to-buffer-list)
(goto-char (point-min))
(gnus-configure-windows 'score-words))))
(trans (cdr (assq ?: nnheader-file-name-translation-alist)))
ofiles not-match regexp)
(save-excursion
- (set-buffer (get-buffer-create "*gnus score files*"))
+ (set-buffer (gnus-get-buffer-create "*gnus score files*"))
(buffer-disable-undo (current-buffer))
;; Go through all score file names and create regexp with them
;; as the source.
(let ((funcs gnus-score-find-score-files-function)
(group (or group gnus-newsgroup-name))
score-files)
- ;; Make sure funcs is a list.
- (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)))
- ;; Go through all the functions for finding score files (or actual
- ;; scores) and add them to a list.
- (while funcs
- (when (gnus-functionp (car 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)))
- ;; Expand all files names.
- (let ((files score-files))
- (while files
- (when (stringp (car files))
- (setcar files (expand-file-name
- (car files) gnus-kill-files-directory)))
- (pop files)))
- (setq score-files (nreverse score-files))
- ;; Remove any duplicate score files.
- (while (and score-files
- (member (car score-files) (cdr score-files)))
- (pop score-files))
- (let ((files score-files))
- (while (cdr files)
- (if (member (cadr files) (cddr files))
- (setcdr files (cddr files))
- (pop files))))
- ;; Do the scoring if there are any score files for this group.
- score-files))
+ (when group
+ ;; Make sure funcs is a list.
+ (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)))
+ ;; Go through all the functions for finding score files (or actual
+ ;; scores) and add them to a list.
+ (while funcs
+ (when (gnus-functionp (car 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)))
+ ;; Expand all files names.
+ (let ((files score-files))
+ (while files
+ (when (stringp (car files))
+ (setcar files (expand-file-name
+ (car files) gnus-kill-files-directory)))
+ (pop files)))
+ (setq score-files (nreverse score-files))
+ ;; Remove any duplicate score files.
+ (while (and score-files
+ (member (car score-files) (cdr score-files)))
+ (pop score-files))
+ (let ((files score-files))
+ (while (cdr files)
+ (if (member (cadr files) (cddr files))
+ (setcdr files (cddr files))
+ (pop files))))
+ ;; Do the scoring if there are any score files for this group.
+ score-files)))
(defun gnus-possibly-score-headers (&optional trace)
"Do scoring if scoring is required."
((or (null newsgroup)
(string-equal newsgroup ""))
;; The global score file is placed at top of the directory.
- (expand-file-name
- suffix gnus-kill-files-directory))
+ (expand-file-name suffix gnus-kill-files-directory))
((gnus-use-long-file-name 'not-score)
;; Append ".SCORE" to newsgroup name.
(expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
(interactive (list gnus-global-score-files))
(let (out)
(while files
+ ;; #### /$ Unix-specific?
(if (string-match "/$" (car files))
(setq out (nconc (directory-files
(car files) t
(funcall elem group))
;; Regexp-file cons
((consp elem)
- (when (string-match (car elem) group)
- (cadr elem))))))
+ (when (string-match (gnus-globalify-regexp (car elem)) group)
+ (replace-match (cadr elem) t nil group ))))))
(when found
(nnheader-concat gnus-kill-files-directory found))))
(concat group (if (gnus-use-long-file-name 'not-score) "." "/")
gnus-adaptive-file-suffix)))
+(defun gnus-current-home-score-file (group)
+ "Return the \"current\" regular score file."
+ (car (nreverse (gnus-score-find-alist group))))
+
;;;
;;; Score decays
;;;
projects / gnus / blobdiff