X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=26c3ca34e7b24dc3026293b5f05a8010b8762d02;hb=8339220cc25db3fbdab4367d6252e596bddd9cb1;hp=6dcb6bd6326084fb4a480bd6652e9423b2f94cc0;hpb=858fee8ecb8b06d446feea0c65d8014598c26fbc;p=gnus diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 6dcb6bd63..26c3ca34e 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,7 +1,7 @@ ;;; gnus-score.el --- scoring code for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen @@ -9,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +20,7 @@ ;; GNU General Public License for more details. ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -208,10 +206,10 @@ It can be: :type '(choice string (repeat (choice string (cons regexp (repeat file)) - (function :value fun))) + function)) (function-item gnus-hierarchial-home-score-file) (function-item gnus-current-home-score-file) - (function :value fun))) + function)) (defcustom gnus-home-adapt-file nil "Variable to control where new adaptive score entries are to go. @@ -221,8 +219,8 @@ This variable allows the same syntax as `gnus-home-score-file'." :type '(choice string (repeat (choice string (cons regexp (repeat file)) - (function :value fun))) - (function :value fun))) + function)) + function)) (defcustom gnus-default-adaptive-score-alist `((gnus-kill-file-mark) @@ -326,7 +324,7 @@ If this variable is nil, exact matching will always be used." "If non-nil, adaptive score files fill are pretty printed." :group 'gnus-score-files :group 'gnus-score-adapt - :version "23.0" ;; No Gnus + :version "23.1" ;; No Gnus :type 'boolean) (defcustom gnus-score-default-header nil @@ -392,7 +390,7 @@ If nil, the user will be asked for a match type." (const :tag "ask" nil))) (defcustom gnus-score-default-fold nil - "Use case folding for new score file entries iff not nil." + "Non-nil means use case folding for new score file entries." :group 'gnus-score-default :type 'boolean) @@ -422,11 +420,17 @@ If nil, the user will be asked for a duration." :group 'gnus-score-various :type 'boolean) -(defcustom gnus-score-fast-scoring nil - "If non-nil, no scoring on headers or body is done." +(defcustom gnus-inhibit-slow-scoring nil + "Inhibit slow scoring, e.g. scoring on headers or body. + +If a regexp, scoring on headers or body is inhibited if the group +matches the regexp. If it is t, scoring on headers or body is +inhibited for all groups." :group 'gnus-score-various - :version "23.0" ;; No Gnus - :type 'boolean) + :version "23.1" ;; No Gnus + :type '(choice (const :tag "All" nil) + (const :tag "None" t) + regexp)) @@ -676,14 +680,14 @@ file for the command instead of the current score file." (and gnus-extra-headers (equal (nth 1 entry) "extra") (intern ; need symbol - (gnus-completing-read-with-default - (symbol-name (car gnus-extra-headers)) ; default response - "Score extra header" ; prompt - (mapcar (lambda (x) ; completion list - (cons (symbol-name x) x)) - gnus-extra-headers) - nil ; no completion limit - t)))) ; require match + (let ((collection (mapcar 'symbol-name gnus-extra-headers))) + (gnus-completing-read + "Score extra header" ; prompt + collection ; completion list + t ; require match + nil ; no history + nil ; no initial-input + (car collection)))))) ; default value ;; extra is now nil or a symbol. ;; We have all the data, so we enter this score. @@ -704,8 +708,7 @@ file for the command instead of the current score file." ;; Change score file to the "all.SCORE" file. (when (eq symp 'a) - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-score-load-file ;; This is a kludge; yes... (cond @@ -731,14 +734,12 @@ file for the command instead of the current score file." (when (eq symp 'a) ;; We change the score file back to the previous one. - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-score-load-file current-score-file))))) (defun gnus-score-insert-help (string alist idx) (setq gnus-score-help-winconf (current-window-configuration)) - (save-excursion - (set-buffer (gnus-get-buffer-create "*Score Help*")) + (with-current-buffer (gnus-get-buffer-create "*Score Help*") (buffer-disable-undo) (delete-windows-on (current-buffer)) (erase-buffer) @@ -912,10 +913,13 @@ MATCH is the string we are looking for. TYPE is the score type. SCORE is the score to add. EXTRA is the possible non-standard header." - (interactive (list (completing-read "Header: " - gnus-header-index - (lambda (x) (fboundp (nth 2 x))) - t) + (interactive (list (gnus-completing-read "Header" + (mapcar + 'car + (remove-if-not + (lambda (x) (fboundp (nth 2 x))) + gnus-header-index)) + t) (read-string "Match: ") (if (y-or-n-p "Use regexp match? ") 'r 's) (string-to-number (read-string "Score: ")))) @@ -1113,8 +1117,8 @@ EXTRA is the possible non-standard header." (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits")))) + 4 "%s" (substitute-command-keys + "\\\\[gnus-score-edit-exit] to save edits")))) (defun gnus-score-edit-all-score () "Edit the all.SCORE file." @@ -1141,8 +1145,8 @@ EXTRA is the possible non-standard header." (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits"))) + 4 "%s" (substitute-command-keys + "\\\\[gnus-score-edit-exit] to save edits"))) (defun gnus-score-edit-file-at-point (&optional format) "Edit score file at point in Score Trace buffers. @@ -1266,8 +1270,7 @@ If FORMAT, also format the current score file." exclude-files)) gnus-scores-exclude-files)) (when local - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (while local (and (consp (car local)) (symbolp (caar local)) @@ -1391,7 +1394,7 @@ If FORMAT, also format the current score file." (if err (progn (ding) - (gnus-message 3 err) + (gnus-message 3 "%s" err) (sit-for 2) nil) alist))))) @@ -1524,8 +1527,7 @@ If FORMAT, also format the current score file." (cons (cons header (or gnus-summary-default-score 0)) gnus-scores-articles)))) - (save-excursion - (set-buffer (gnus-get-buffer-create "*Headers*")) + (with-current-buffer (gnus-get-buffer-create "*Headers*") (buffer-disable-undo) (when (gnus-buffer-live-p gnus-summary-buffer) (message-clone-locals gnus-summary-buffer)) @@ -1546,10 +1548,20 @@ If FORMAT, also format the current score file." (lambda (score) (length (gnus-score-get header score))) scores))) - ;; Call the scoring function for this type of "header". - (when (if (and gnus-score-fast-scoring + (when (if (and gnus-inhibit-slow-scoring + (or (eq gnus-inhibit-slow-scoring t) + (and (stringp gnus-inhibit-slow-scoring) + ;; Always true here? + ;; (stringp gnus-newsgroup-name) + (string-match + gnus-inhibit-slow-scoring + gnus-newsgroup-name))) (> 0 (nth 1 (assoc header gnus-header-index)))) - nil + (progn + (gnus-message + 7 "Scoring on headers or body skipped.") + nil) + ;; Call the scoring function for this type of "header". (setq new (funcall (nth 2 entry) scores header now expire trace))) (push new news)))) @@ -1840,8 +1852,7 @@ score in `gnus-newsgroup-scored' by SCORE." ;; Change score file to the adaptive score file. All entries that ;; this function makes will be put into this file. - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-score-load-file (or gnus-newsgroup-adaptive-score-file (gnus-score-file-name @@ -1932,15 +1943,13 @@ score in `gnus-newsgroup-scored' by SCORE." (setq rest entries))) (setq entries rest)))) ;; We change the score file back to the previous one. - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-score-load-file current-score-file)) (list (cons "references" news))))) (defun gnus-score-add-followups (header score scores &optional thread) "Add a score entry to the adapt file." - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (let* ((id (mail-header-id header)) (scores (car scores)) entry dont) @@ -2041,8 +2050,11 @@ score in `gnus-newsgroup-scored' by SCORE." ;; Evil hackery to make match usable in non-standard headers. (when extra - (setq match (concat "[ (](" extra " \\. \"[^)]*" - match "[^\"]*\")[ )]") + (setq match (concat "[ (](" extra " \\. \"\\([^\"]*\\\\\"\\)*[^\"]*" + (if (eq search-func 're-search-forward) + match + (regexp-quote match)) + "\\([^\"]*\\\\\"\\)*[^\"]*\")[ )]") search-func 're-search-forward)) ; XXX danger?!? (cond @@ -2265,8 +2277,7 @@ score in `gnus-newsgroup-scored' by SCORE." "Create adaptive score rules for this newsgroup." (when gnus-newsgroup-adaptive ;; We change the score file to the adaptive score file. - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-score-load-file (or gnus-newsgroup-adaptive-score-file (gnus-home-score-file gnus-newsgroup-name t) @@ -2453,6 +2464,13 @@ score in `gnus-newsgroup-scored' by SCORE." ;; .ADAPT directly: (file-name-nondirectory file) (abbreviate-file-name file)))) + (insert + (format "\nTotal score: %d" + (apply '+ (mapcar + (lambda (s) + (or (caddr s) + gnus-score-interactive-default-score)) + trace)))) (insert "\n\nQuick help: @@ -2673,8 +2691,7 @@ GROUP using BNews sys file syntax." (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*")) + (with-current-buffer (gnus-get-buffer-create "*gnus score files*") (buffer-disable-undo) ;; Go through all score file names and create regexp with them ;; as the source. @@ -3098,5 +3115,4 @@ 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