X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=85c91e3aa66d6ae359c180c9e4f9fb6dfeefdfc9;hb=31ac812d0664c72238c6c2266c35d478474c7697;hp=069c4953ed2dfd321107a0609775b75914f6272a;hpb=eb74fc64c467475be5780b96954fd6e12f63c402;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 069c495..85c91e3 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,5 +1,6 @@ ;;; 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 ;; Lars Magne Ingebrigtsen @@ -107,8 +108,8 @@ gnus-score-find-bnews: Apply score files whose names matches. 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 @@ -117,7 +118,12 @@ 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." @@ -138,12 +144,6 @@ will be expired along with non-matching score entries." :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 @@ -201,6 +201,8 @@ It can be: (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 @@ -221,14 +223,14 @@ This variable allows the same syntax as `gnus-home-score-file'." (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." @@ -259,10 +261,10 @@ This variable allows the same syntax as `gnus-home-score-file'." (,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." @@ -387,12 +389,15 @@ If nil, the user will be asked for a duration." (defcustom gnus-score-thread-simplify nil "If non-nil, subjects will simplified as in threading." :group 'gnus-score-various - :type 'boolean) + :type 'boolean) ;; 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))) @@ -437,21 +442,55 @@ of the last successful match.") (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. @@ -480,7 +519,7 @@ The user will be prompted for header to score on, match type, 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*") @@ -494,7 +533,7 @@ The user will be prompted for header to score on, match type, 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 @@ -502,7 +541,7 @@ used as score." (?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) @@ -556,7 +595,7 @@ used as score." (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. @@ -589,7 +628,7 @@ used as score." (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. @@ -617,12 +656,12 @@ used as score." ;; 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)) @@ -631,15 +670,15 @@ used as score." (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. @@ -672,7 +711,7 @@ used as score." current-score-file) (t (gnus-score-file-name "all")))))) - + (gnus-summary-score-entry (nth 1 entry) ; Header match ; Match @@ -682,7 +721,7 @@ used as score." nil temporary) (not (nth 3 entry)) ; Prompt - nil ; not silent + nil ; not silent extra) ; non-standard overview. (when (eq symp 'a) @@ -730,7 +769,7 @@ used as score." (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. @@ -768,7 +807,6 @@ used as score." (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. @@ -786,9 +824,10 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (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: " @@ -803,8 +842,7 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (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) @@ -969,7 +1007,7 @@ EXTRA is the possible non-standard header." (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 @@ -984,7 +1022,7 @@ EXTRA is the possible non-standard header." (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 @@ -1029,7 +1067,7 @@ EXTRA is the possible non-standard header." (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)) @@ -1277,11 +1315,11 @@ EXTRA is the possible non-standard header." 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)) @@ -1292,7 +1330,7 @@ EXTRA is the possible non-standard header." ((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)))) @@ -1343,7 +1381,7 @@ EXTRA is the possible non-standard header." (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) @@ -1462,6 +1500,10 @@ EXTRA is the possible non-standard header." (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))) @@ -1478,85 +1520,56 @@ EXTRA is the possible non-standard header." (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) @@ -1573,7 +1586,7 @@ EXTRA is the possible non-standard header." (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, @@ -1605,7 +1618,6 @@ EXTRA is the possible non-standard header." (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) @@ -1633,7 +1645,7 @@ EXTRA is the possible non-standard header." ((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 @@ -1692,8 +1704,8 @@ EXTRA is the possible non-standard header." (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 @@ -1731,7 +1743,7 @@ EXTRA is the possible non-standard header." (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. @@ -1817,7 +1829,7 @@ EXTRA is the possible non-standard header." (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) @@ -1913,7 +1925,7 @@ EXTRA is the possible non-standard header." ;; 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))) @@ -1950,7 +1962,7 @@ EXTRA is the possible non-standard header." (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 @@ -1960,12 +1972,13 @@ EXTRA is the possible non-standard header." (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. @@ -2093,6 +2106,7 @@ EXTRA is the possible non-standard header." (cond ;; Permanent. ((null date) + ;; Do nothing. ) ;; Match, update date. ((and found gnus-update-score-entry-dates) @@ -2131,6 +2145,7 @@ EXTRA is the possible non-standard header." (cond ;; Permanent. ((null date) + ;; Do nothing. ) ;; Match, update date. ((and found gnus-update-score-entry-dates) @@ -2299,7 +2314,7 @@ EXTRA is the possible non-standard header." (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))) @@ -2437,14 +2452,14 @@ EXTRA is the possible non-standard header." (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))) @@ -2473,7 +2488,7 @@ EXTRA is the possible non-standard header." (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. @@ -2553,6 +2568,7 @@ GROUP using BNews sys file syntax." (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*")) @@ -2572,7 +2588,7 @@ GROUP using BNews sys file syntax." ;; 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)) @@ -2599,16 +2615,18 @@ GROUP using BNews sys file syntax." (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)) @@ -2726,19 +2744,20 @@ The list is determined from the variable gnus-score-file-alist." (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 @@ -2746,14 +2765,15 @@ The list is determined from the variable gnus-score-file-alist." (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 @@ -2845,12 +2865,14 @@ If ADAPT, return the home adaptive file instead." ;; 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." @@ -2902,7 +2924,7 @@ If ADAPT, return the home adaptive file instead." 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)) @@ -2961,8 +2983,7 @@ See `(Gnus)Scoring Tips' for examples of good regular expressions." (cond (bad (cons 'bad bad)) (new (cons 'new new)) - ;; or nil - ))))) + (t nil)))))) (provide 'gnus-score)