X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=732a52b6fdd7d4ff39c661e1a5ef233a17d49408;hb=59d9999f64c3cd54a446cf7b6a83ec36d02dddf5;hp=dac4d0df84cdd2710bf0ab652bb256408b0cac04;hpb=36048222ff92da54019cb189e1bb680af870e636;p=gnus diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index dac4d0df8..732a52b6f 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,6 +1,7 @@ ;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen @@ -20,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -36,8 +37,6 @@ (require 'message) (require 'score-mode) -(autoload 'ffap-string-at-point "ffap") - (defcustom gnus-global-score-files nil "List of global score files and directories. Set this variable if you want to use people's score files. One entry @@ -141,16 +140,22 @@ If this variable is nil, no score file entries will be expired." number)) (defcustom gnus-update-score-entry-dates t - "*In non-nil, update matching score entry dates. + "*If non-nil, update matching score entry dates. If this variable is nil, then score entries that provide matches will be expired along with non-matching score entries." :group 'gnus-score-expire :type 'boolean) (defcustom gnus-decay-scores nil - "*If non-nil, decay non-permanent scores." + "*If non-nil, decay non-permanent scores. + +If it is a regexp, only decay score files matching regexp." :group 'gnus-score-decay - :type 'boolean) + :type `(choice (const :tag "never" nil) + (const :tag "always" t) + (const :tag "adaptive score files" + ,(concat "\\." gnus-adaptive-file-suffix "\\'")) + (regexp))) (defcustom gnus-decay-score-function 'gnus-decay-score "*Function called to decay a score. @@ -174,7 +179,7 @@ It is called with one parameter -- the score to be decayed." It can be: * A string - This file file will be used as the home score file. + This file will be used as the home score file. * A function The result of this function will be used as the home score file. @@ -185,7 +190,7 @@ It can be: The elements in this list can be: * `(regexp file-name ...)' - If the `regexp' matches the group name, the first `file-name' will + If the `regexp' matches the group name, the first `file-name' will be used as the home score file. (Multiple filenames are allowed so that one may use gnus-score-file-single-match-alist to set this variable.) @@ -220,13 +225,22 @@ This variable allows the same syntax as `gnus-home-score-file'." (function :value fun))) (defcustom gnus-default-adaptive-score-alist - '((gnus-kill-file-mark) + `((gnus-kill-file-mark) (gnus-unread-mark) - (gnus-read-mark (from 3) (subject 30)) - (gnus-catchup-mark (subject -10)) - (gnus-killed-mark (from -1) (subject -20)) - (gnus-del-mark (from -2) (subject -15))) - "*Alist of marks and scores." + (gnus-read-mark + (from , (+ 2 gnus-score-decay-constant)) + (subject , (+ 27 gnus-score-decay-constant))) + (gnus-catchup-mark + (subject , (+ -7 (* -1 gnus-score-decay-constant)))) + (gnus-killed-mark + (from , (- -1 gnus-score-decay-constant)) + (subject , (+ -17 (* -1 gnus-score-decay-constant)))) + (gnus-del-mark + (from , (- -1 gnus-score-decay-constant)) + (subject , (+ -12 (* -1 gnus-score-decay-constant))))) + "Alist of marks and scores. +If you use score decays, you might want to set values higher than +`gnus-score-decay-constant'." :group 'gnus-score-adapt :type '(repeat (cons (symbol :tag "Mark") (repeat (list (choice :tag "Header" @@ -237,9 +251,10 @@ This variable allows the same syntax as `gnus-home-score-file'." (defcustom gnus-adaptive-word-length-limit nil "*Words of a length lesser than this limit will be ignored when doing adaptive scoring." + :version "22.1" :group 'gnus-score-adapt :type '(radio (const :format "Unlimited " nil) - (integer :format "Maximum length: %v\n" :size 0))) + (integer :format "Maximum length: %v"))) (defcustom gnus-ignored-adaptive-words nil "List of words to be ignored when doing adaptive word scoring." @@ -307,6 +322,13 @@ If this variable is nil, exact matching will always be used." :group 'gnus-score-files :type 'regexp) +(defcustom gnus-adaptive-pretty-print nil + "If non-nil, adaptive score files fill are pretty printed." + :group 'gnus-score-files + :group 'gnus-score-adapt + :version "23.0" ;; No Gnus + :type 'boolean) + (defcustom gnus-score-default-header nil "Default header when entering new scores. @@ -627,7 +649,7 @@ file for the command instead of the current score file." (gnus-score-insert-help "Match permanence" char-to-perm 2))) (gnus-score-kill-help-buffer) - (if mimic (message "%c %c %c" prefix hchar tchar pchar) + (if mimic (message "%c %c %c %c" prefix hchar tchar pchar) (message "")) (unless (setq temporary (cadr (assq pchar char-to-perm))) ;; Deal with der(r)ided superannuated paradigms. @@ -650,7 +672,7 @@ file for the command instead of the current score file." (intern ; need symbol (gnus-completing-read-with-default (symbol-name (car gnus-extra-headers)) ; default response - "Score extra header:" ; prompt + "Score extra header" ; prompt (mapcar (lambda (x) ; completion list (cons (symbol-name x) x)) gnus-extra-headers) @@ -742,7 +764,7 @@ file for the command instead of the current score file." (setq i (1+ i)))) (goto-char (point-min)) ;; display ourselves in a small window at the bottom - (gnus-appt-select-lowest-window) + (gnus-select-lowest-window) (if (< (/ (window-height) 2) window-min-height) (switch-to-buffer "*Score Help*") (split-window) @@ -825,7 +847,7 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." ;; If this is an integer comparison, we transform from string to int. (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) (if (stringp match) - (setq match (string-to-int match))) + (setq match (string-to-number match))) (set-text-properties 0 (length match) nil match)) (unless (eq date 'now) @@ -890,7 +912,7 @@ EXTRA is the possible non-standard header." t) (read-string "Match: ") (if (y-or-n-p "Use regexp match? ") 'r 's) - (string-to-int (read-string "Score: ")))) + (string-to-number (read-string "Score: ")))) (save-excursion (unless (and (stringp match) (> (length match) 0)) (error "No match")) @@ -944,7 +966,7 @@ EXTRA is the possible non-standard header." "Automatically mark articles with score below SCORE as read." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Mark below: "))))) + (string-to-number (read-string "Mark below: "))))) (setq score (or score gnus-summary-default-score 0)) (gnus-score-set 'mark (list score)) (gnus-score-set 'touched '(t)) @@ -978,7 +1000,7 @@ EXTRA is the possible non-standard header." "Automatically expunge articles with score below SCORE." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Set expunge below: "))))) + (string-to-number (read-string "Set expunge below: "))))) (setq score (or score gnus-summary-default-score 0)) (gnus-score-set 'expunge (list score)) (gnus-score-set 'touched '(t))) @@ -1092,7 +1114,11 @@ EXTRA is the possible non-standard header." "Edit the all.SCORE file." (interactive) (find-file (gnus-score-file-name "all")) - (gnus-score-mode)) + (gnus-score-mode) + (setq gnus-score-edit-exit-function 'gnus-score-edit-done) + (gnus-message + 4 (substitute-command-keys + "\\\\[gnus-score-edit-exit] to save edits"))) (defun gnus-score-edit-file (file) "Edit a score file." @@ -1204,7 +1230,9 @@ If FORMAT, also format the current score file." (decay (car (gnus-score-get 'decay alist))) (eval (car (gnus-score-get 'eval alist)))) ;; Perform possible decays. - (when (and gnus-decay-scores + (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))) @@ -1214,8 +1242,7 @@ If FORMAT, also format the current score file." ;; files. (when (and files (not global)) (setq lists (apply 'append lists - (mapcar (lambda (file) - (gnus-score-load-file file)) + (mapcar 'gnus-score-load-file (if adapt-file (cons adapt-file files) files))))) (when (and eval (not global)) @@ -1407,17 +1434,18 @@ If FORMAT, also format the current score file." (setq score (setcdr entry (gnus-delete-alist 'touched score))) (erase-buffer) (let (emacs-lisp-mode-hook) - (if (string-match - (concat (regexp-quote gnus-adaptive-file-suffix) "$") - file) - ;; This is an adaptive score file, so we do not run - ;; it through `pp'. These files can get huge, and - ;; are not meant to be edited by human hands. + (if (and (not gnus-adaptive-pretty-print) + (string-match + (concat (regexp-quote gnus-adaptive-file-suffix) "$") + file)) + ;; This is an adaptive score file, so we do not run it through + ;; `pp' unless requested. These files can get huge, and are + ;; not meant to be edited by human hands. (gnus-prin1 score) ;; This is a normal score file, so we print it very ;; prettily. (let ((lisp-mode-syntax-table score-mode-syntax-table)) - (pp score (current-buffer))))) + (gnus-pp score)))) (gnus-make-directory (file-name-directory file)) ;; If the score file is empty, we delete it. (if (zerop (buffer-size)) @@ -2360,7 +2388,8 @@ score in `gnus-newsgroup-scored' by SCORE." (when winconf (set-window-configuration winconf)) (gnus-score-remove-from-cache bufnam) - (gnus-score-load-file bufnam))) + (gnus-score-load-file bufnam) + (run-hooks 'gnus-score-edit-done-hook))) (defun gnus-score-find-trace () "Find all score rules that applies to the current article." @@ -2767,9 +2796,7 @@ Destroys the current buffer." (lambda (file) (cons (inline (gnus-score-file-rank file)) file)) files))) - (mapcar - (lambda (f) (cdr f)) - (sort alist 'car-less-than-car))))) + (mapcar 'cdr (sort alist 'car-less-than-car))))) (defun gnus-score-find-alist (group) "Return list of score files for GROUP. @@ -3062,4 +3089,5 @@ See Info node `(gnus)Scoring Tips' for examples of good regular expressions." (provide 'gnus-score) +;;; arch-tag: d3922589-764d-46ae-9954-9330fd192634 ;;; gnus-score.el ends here