X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=2325a757f12788c028d08a631504871447c6bbf5;hb=4c0bad76d2316c59b181d93baf04bb796ed439b0;hp=3024db1227e131944cdd004c595a7fd5b76b8e3d;hpb=d0a7c2475a8172dd6358727d726cb301baf8613e;p=gnus diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 3024db122..2325a757f 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -108,7 +108,7 @@ If this variable is nil, then score entries that provide matches will be expired along with non-matching score entries.") (defvar gnus-orphan-score nil - "*All orphans get this score added. Set in the score file.") + "*All orphans get this score added. Set in the score file.") (defvar gnus-decay-scores nil "*If non-nil, decay non-permanent scores.") @@ -528,7 +528,7 @@ used as score." (if (eq 's score) nil score) ; Score (if (eq 'perm temporary) ; Temp nil - temporary) + temporary) (not (nth 3 entry))) ; Prompt )) @@ -551,7 +551,7 @@ used as score." (setq max n)) (setq list (cdr list))) (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end - (setq n (/ (1- (window-width)) max)) ; items per line + (setq n (/ (1- (window-width)) max)) ; items per line (setq width (/ (1- (window-width)) n)) ; width of each item ;; insert `n' items, each in a field of width `width' (while alist @@ -663,7 +663,7 @@ If optional argument `SILENT' is nil, show effect of score entry." (unless (eq date 'now) ;; Add the score entry to the score file. (when (= score gnus-score-interactive-default-score) - (setq score nil)) + (setq score nil)) (let ((old (gnus-score-get header)) elem) (setq new @@ -678,7 +678,7 @@ If optional argument `SILENT' is nil, show effect of score entry." (t (list match)))) ;; We see whether we can collapse some score entries. ;; This isn't quite correct, because there may be more elements - ;; later on with the same key that have matching elems... Hm. + ;; later on with the same key that have matching elems... Hm. (if (and old (setq elem (assoc match old)) (eq (nth 3 elem) (nth 3 new)) @@ -1162,7 +1162,7 @@ SCORE is the score to add." entry score file) (save-excursion (setq gnus-score-alist nil) - (nnheader-set-temp-buffer "*Score*") + (nnheader-set-temp-buffer " *Gnus Scores*") (while cache (current-buffer) (setq entry (pop cache) @@ -1186,20 +1186,18 @@ SCORE is the score to add." ;; This is a normal score file, so we print it very ;; prettily. (pp score (current-buffer)))) - (if (not (gnus-make-directory (file-name-directory file))) - (gnus-error 1 "Can't create directory %s" - (file-name-directory file)) - ;; If the score file is empty, we delete it. - (if (zerop (buffer-size)) - (delete-file file) - ;; There are scores, so we write the file. - (when (file-writable-p file) - (write-region (point-min) (point-max) file nil 'silent) - (when gnus-score-after-write-file-function - (funcall gnus-score-after-write-file-function file))))) - (and gnus-score-uncacheable-files - (string-match gnus-score-uncacheable-files file) - (gnus-score-remove-from-cache file)))) + (gnus-make-directory (file-name-directory file)) + ;; If the score file is empty, we delete it. + (if (zerop (buffer-size)) + (delete-file file) + ;; There are scores, so we write the file. + (when (file-writable-p file) + (write-region (point-min) (point-max) file nil 'silent) + (when gnus-score-after-write-file-function + (funcall gnus-score-after-write-file-function file))))) + (and gnus-score-uncacheable-files + (string-match gnus-score-uncacheable-files file) + (gnus-score-remove-from-cache file))) (kill-buffer (current-buffer))))) (defun gnus-score-load-files (score-files) @@ -1359,7 +1357,7 @@ SCORE is the score to add." new-thread-ids (cdr new-thread-ids)) (goto-char (point-min)) (while (search-forward this-id nil t) - ;; found a match. remove this line + ;; found a match. remove this line (beginning-of-line) (kill-line 1))) @@ -1405,8 +1403,8 @@ SCORE is the score to add." ;; time than one would gain. (while articles (when (funcall match-func - (or (aref (caar articles) gnus-score-index) 0) - match) + (or (aref (caar articles) gnus-score-index) 0) + match) (when trace (push (cons (car-safe (rassq alist gnus-score-cache)) kill) gnus-score-trace)) @@ -1476,7 +1474,7 @@ SCORE is the score to add." ((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. + ((and expire (< date expire)) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) @@ -1674,7 +1672,7 @@ SCORE is the score to add." ((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. + ((and expire (< date expire)) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) @@ -1922,7 +1920,7 @@ SCORE is the score to add." ;; Find all the words in the buffer and enter them into ;; the hashtable. (let ((syntab (syntax-table)) - word val) + word val) (goto-char (point-min)) (unwind-protect (progn @@ -2040,10 +2038,12 @@ SCORE is the score to add." (set-syntax-table syntab) ;; Go through all articles. (while (setq d (pop data)) - (when (setq score - (cdr (assq - (gnus-data-mark d) - gnus-default-adaptive-word-score-alist))) + (when (and + (not (gnus-data-pseudo-p d)) + (setq score + (cdr (assq + (gnus-data-mark d) + gnus-default-adaptive-word-score-alist)))) ;; This article has a mark that should lead to ;; adaptive word rules, so we insert the subject ;; and find all words in that string. @@ -2363,12 +2363,12 @@ GROUP using BNews sys file syntax." (setq sfiles (cdr sfiles))) (kill-buffer (current-buffer)) ;; Slight kludge here - the last score file returned should be - ;; the local score file, whether it exists or not. This is so + ;; the local score file, whether it exists or not. This is so ;; that any score commands the user enters will go to the right ;; file, and not end up in some global score file. (let ((localscore (gnus-score-file-name group))) (setq ofiles (cons localscore (delete localscore ofiles)))) - (nreverse ofiles)))) + (gnus-sort-score-files (nreverse ofiles))))) (defun gnus-score-find-single (group) "Return list containing the score file for GROUP." @@ -2391,6 +2391,38 @@ This includes the score file for the group and all its parents." (setq all (nreverse all))) (mapcar 'gnus-score-file-name all)))) +(defun gnus-score-file-rank (file) + "Return a number that says how specific score FILE is. +Destroys the current buffer." + (when (string-match + (concat "^" (regexp-quote + (expand-file-name + (file-name-as-directory gnus-kill-files-directory)))) + file) + (setq file (substring file (match-end 0)))) + (insert file) + (goto-char (point-min)) + (let ((beg (point)) + elems) + (while (re-search-forward "[./]" nil t) + (push (buffer-substring beg (1- (point))) + elems)) + (erase-buffer) + (setq elems (delete "all" elems)) + (length elems))) + +(defun gnus-sort-score-files (files) + "Sort FILES so that the most general files come first." + (nnheader-temp-write nil + (let ((alist + (mapcar + (lambda (file) + (cons (inline (gnus-score-file-rank file)) file)) + files))) + (mapcar + (lambda (f) (cdr f)) + (sort alist (lambda (f1 f2) (< (car f1) (car f2)))))))) + (defun gnus-score-find-alist (group) "Return list of score files for GROUP. The list is determined from the variable gnus-score-file-alist." @@ -2410,7 +2442,7 @@ The list is determined from the variable gnus-score-file-alist." (while alist (and (string-match (caar alist) group) ;; progn used just in case ("regexp") has no files - ;; and score-files is still nil. -sj + ;; and score-files is still nil. -sj ;; this can be construed as a "stop searching here" feature :> ;; and used to simplify regexps in the single-alist (progn @@ -2573,7 +2605,7 @@ If ADAPT, return the home adaptive file instead." "Decay non-permanent scores in ALIST." (let ((times (- (gnus-time-to-day (current-time)) day)) kill entry updated score n) - (unless (zerop times) ;Done decays today already? + (unless (zerop times) ;Done decays today already? (while (setq entry (pop alist)) (when (stringp (car entry)) (setq entry (cdr entry))