X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=26c3ca34e7b24dc3026293b5f05a8010b8762d02;hb=8339220cc25db3fbdab4367d6252e596bddd9cb1;hp=d79007b92e64e7d5402d87da0ba476cc3b42e9d0;hpb=6ba76b55f35a87f988e7edd3392183a49af01773;p=gnus diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index d79007b92..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, 2007, 2008 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 3, 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: @@ -682,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. @@ -710,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 @@ -737,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) @@ -918,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: ")))) @@ -1119,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." @@ -1147,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. @@ -1272,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)) @@ -1397,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))))) @@ -1530,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)) @@ -1552,20 +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-inhibit-slow-scoring - (if (and (stringp 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)) - t - nil) + (string-match + gnus-inhibit-slow-scoring + gnus-newsgroup-name))) (> 0 (nth 1 (assoc header gnus-header-index)))) (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)))) @@ -1856,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 @@ -1948,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) @@ -2057,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 @@ -2281,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) @@ -2469,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: @@ -2689,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. @@ -3114,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