projects
/
gnus
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Try to prune the Gnus registry if it's full.
[gnus]
/
lisp
/
gnus-score.el
diff --git
a/lisp/gnus-score.el
b/lisp/gnus-score.el
index
4ca28b8
..
9bbfbfb
100644
(file)
--- a/
lisp/gnus-score.el
+++ b/
lisp/gnus-score.el
@@
-1,7
+1,6
@@
;;; gnus-score.el --- scoring code for Gnus
;;; 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.
+;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@
-9,10
+8,10
@@
;; This file is part of GNU Emacs.
;; 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
;; 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
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@
-20,9
+19,7
@@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Commentary:
@@
-326,7
+323,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
"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
:type 'boolean)
(defcustom gnus-score-default-header nil
@@
-392,7
+389,7
@@
If nil, the user will be asked for a match type."
(const :tag "ask" nil)))
(defcustom gnus-score-default-fold nil
(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)
:group 'gnus-score-default
:type 'boolean)
@@
-422,11
+419,17
@@
If nil, the user will be asked for a duration."
:group 'gnus-score-various
:type 'boolean)
: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
: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))
\f
\f
@@
-676,14
+679,14
@@
file for the command instead of the current score file."
(and gnus-extra-headers
(equal (nth 1 entry) "extra")
(intern ; need symbol
(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 limi
t
- 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-inpu
t
+ (car collection)))))) ; default value
;; extra is now nil or a symbol.
;; We have all the data, so we enter this score.
;; extra is now nil or a symbol.
;; We have all the data, so we enter this score.
@@
-704,8
+707,7
@@
file for the command instead of the current score file."
;; Change score file to the "all.SCORE" file.
(when (eq symp 'a)
;; 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
(gnus-score-load-file
;; This is a kludge; yes...
(cond
@@
-731,14
+733,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.
(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))
(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)
(buffer-disable-undo)
(delete-windows-on (current-buffer))
(erase-buffer)
@@
-912,10
+912,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."
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
+ (gnus-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: "))))
(read-string "Match: ")
(if (y-or-n-p "Use regexp match? ") 'r 's)
(string-to-number (read-string "Score: "))))
@@
-1113,8
+1116,8
@@
EXTRA is the possible non-standard header."
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
(gnus-message
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
(gnus-message
- 4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
+ 4
"%s"
(substitute-command-keys
+
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
(defun gnus-score-edit-all-score ()
"Edit the all.SCORE file."
(defun gnus-score-edit-all-score ()
"Edit the all.SCORE file."
@@
-1141,8
+1144,8
@@
EXTRA is the possible non-standard header."
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
(gnus-message
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
(gnus-message
- 4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+ 4
"%s"
(substitute-command-keys
+
"\\<gnus-score-mode-map>\\[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.
(defun gnus-score-edit-file-at-point (&optional format)
"Edit score file at point in Score Trace buffers.
@@
-1266,8
+1269,7
@@
If FORMAT, also format the current score file."
exclude-files))
gnus-scores-exclude-files))
(when local
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))
(while local
(and (consp (car local))
(symbolp (caar local))
@@
-1391,7
+1393,7
@@
If FORMAT, also format the current score file."
(if err
(progn
(ding)
(if err
(progn
(ding)
- (gnus-message 3 err)
+ (gnus-message 3
"%s"
err)
(sit-for 2)
nil)
alist)))))
(sit-for 2)
nil)
alist)))))
@@
-1524,8
+1526,7
@@
If FORMAT, also format the current score file."
(cons (cons header (or gnus-summary-default-score 0))
gnus-scores-articles))))
(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))
(buffer-disable-undo)
(when (gnus-buffer-live-p gnus-summary-buffer)
(message-clone-locals gnus-summary-buffer))
@@
-1546,10
+1547,20
@@
If FORMAT, also format the current score file."
(lambda (score)
(length (gnus-score-get header score)))
scores)))
(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))))
(> 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))))
(setq new (funcall (nth 2 entry) scores header
now expire trace)))
(push new news))))
@@
-1840,8
+1851,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.
;; 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
(gnus-score-load-file
(or gnus-newsgroup-adaptive-score-file
(gnus-score-file-name
@@
-1932,15
+1942,13
@@
score in `gnus-newsgroup-scored' by SCORE."
(setq rest entries)))
(setq entries rest))))
;; We change the score file back to the previous one.
(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."
(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)
(let* ((id (mail-header-id header))
(scores (car scores))
entry dont)
@@
-2041,8
+2049,11
@@
score in `gnus-newsgroup-scored' by SCORE."
;; Evil hackery to make match usable in non-standard headers.
(when extra
;; 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
search-func 're-search-forward)) ; XXX danger?!?
(cond
@@
-2140,7
+2151,7
@@
score in `gnus-newsgroup-scored' by SCORE."
;; Find fuzzy matches.
(when fuzzies
;; Simplify the entire buffer for easy matching.
;; Find fuzzy matches.
(when fuzzies
;; Simplify the entire buffer for easy matching.
- (gnus-simplify-buffer-fuzzy)
+ (gnus-simplify-buffer-fuzzy
gnus-simplify-subject-fuzzy-regexp
)
(while (setq kill (cadaar fuzzies))
(let* ((match (nth 0 kill))
(type (nth 3 kill))
(while (setq kill (cadaar fuzzies))
(let* ((match (nth 0 kill))
(type (nth 3 kill))
@@
-2265,8
+2276,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.
"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)
(gnus-score-load-file
(or gnus-newsgroup-adaptive-score-file
(gnus-home-score-file gnus-newsgroup-name t)
@@
-2453,6
+2463,13
@@
score in `gnus-newsgroup-scored' by SCORE."
;; .ADAPT directly:
(file-name-nondirectory file)
(abbreviate-file-name file))))
;; .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:
(insert
"\n\nQuick help:
@@
-2673,8
+2690,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)
(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.
(buffer-disable-undo)
;; Go through all score file names and create regexp with them
;; as the source.
@@
-3098,5
+3114,4
@@
See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
(provide 'gnus-score)
(provide 'gnus-score)
-;;; arch-tag: d3922589-764d-46ae-9954-9330fd192634
;;; gnus-score.el ends here
;;; gnus-score.el ends here