projects
/
gnus
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add hooks for gcc handling
[gnus]
/
lisp
/
gnus-score.el
diff --git
a/lisp/gnus-score.el
b/lisp/gnus-score.el
index
7a4fb25
..
f86b6f8
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, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 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 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
;; 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:
@@
-525,9
+522,10
@@
of the last successful match.")
(defun gnus-summary-lower-score (&optional score symp)
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
(defun gnus-summary-lower-score (&optional score symp)
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
-permanence, and the string to be used. The numerical prefix will be
-used as score. A symbolic prefix of `a' says to use the `all.SCORE'
-file for the command instead of the current score file."
+permanence, and the string to be used. The numerical prefix will
+be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
+says to use the `all.SCORE' file for the command instead of the
+current score file."
(interactive (gnus-interactive "P\ny"))
(gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
(interactive (gnus-interactive "P\ny"))
(gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
@@
-540,9
+538,10
@@
file for the command instead of the current score file."
(defun gnus-summary-increase-score (&optional score symp)
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
(defun gnus-summary-increase-score (&optional score symp)
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
-permanence, and the string to be used. The numerical prefix will be
-used as score. A symbolic prefix of `a' says to use the `all.SCORE'
-file for the command instead of the current score file."
+permanence, and the string to be used. The numerical prefix will
+be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
+says to use the `all.SCORE' file for the command instead of the
+current score file."
(interactive (gnus-interactive "P\ny"))
(let* ((nscore (gnus-score-delta-default score))
(prefix (if (< nscore 0) ?L ?I))
(interactive (gnus-interactive "P\ny"))
(let* ((nscore (gnus-score-delta-default score))
(prefix (if (< nscore 0) ?L ?I))
@@
-682,14
+681,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.
@@
-710,8
+709,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
@@
-737,14
+735,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)
@@
-918,10
+914,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: "))))
@@
-1119,8
+1118,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."
@@
-1147,8
+1146,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.
@@
-1272,8
+1271,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))
@@
-1397,7
+1395,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)))))
@@
-1530,8
+1528,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))
@@
-1856,8
+1853,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
@@
-1948,15
+1944,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)
@@
-2057,8
+2051,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
@@
-2156,7
+2153,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))
@@
-2281,8
+2278,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)
@@
-2469,6
+2465,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:
@@
-2689,8
+2692,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.
@@
-2834,8
+2836,7
@@
The list is determined from the variable `gnus-score-file-alist'."
;; handle the multiple match alist
(while alist
(when (string-match (caar alist) group)
;; handle the multiple match alist
(while alist
(when (string-match (caar alist) group)
- (setq score-files
- (nconc score-files (copy-sequence (cdar alist)))))
+ (setq score-files (append (cdar alist) score-files)))
(setq alist (cdr alist)))
(setq alist gnus-score-file-single-match-alist)
;; handle the single match alist
(setq alist (cdr alist)))
(setq alist gnus-score-file-single-match-alist)
;; handle the single match alist
@@
-2845,8
+2846,7
@@
The list is determined from the variable `gnus-score-file-alist'."
;; 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
;; 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
- (setq score-files
- (nconc score-files (copy-sequence (cdar alist))))
+ (setq score-files (append (cdar alist) score-files))
(setq alist nil))
(setq alist (cdr alist)))
;; cache the score files
(setq alist nil))
(setq alist (cdr alist)))
;; cache the score files
@@
-2866,7
+2866,7
@@
The list is determined from the variable `gnus-score-file-alist'."
(when gnus-score-use-all-scores
;; Get the initial score files for this group.
(when funcs
(when gnus-score-use-all-scores
;; Get the initial score files for this group.
(when funcs
- (setq score-files (
nrevers
e (gnus-score-find-alist group))))
+ (setq score-files (
copy-sequenc
e (gnus-score-find-alist group))))
;; Add any home adapt files.
(let ((home (gnus-home-score-file group t)))
(when home
;; Add any home adapt files.
(let ((home (gnus-home-score-file group t)))
(when home
@@
-3013,7
+3013,7
@@
If ADAPT, return the home adaptive file instead."
(defun gnus-current-home-score-file (group)
"Return the \"current\" regular score file."
(defun gnus-current-home-score-file (group)
"Return the \"current\" regular score file."
- (car (
nreverse (gnus-score-find-alist group)
)))
+ (car (
gnus-score-find-alist group
)))
;;;
;;; Score decays
;;;
;;; Score decays
@@
-3028,7
+3028,7
@@
If ADAPT, return the home adaptive file instead."
(* (abs score)
gnus-score-decay-scale)))))))
(if (and (featurep 'xemacs)
(* (abs score)
gnus-score-decay-scale)))))))
(if (and (featurep 'xemacs)
- ;; XEmacs' floor can handle only the floating point
+ ;; XEmacs'
s
floor can handle only the floating point
;; number below the half of the maximum integer.
(> (abs n) (lsh -1 -2)))
(string-to-number
;; number below the half of the maximum integer.
(> (abs n) (lsh -1 -2)))
(string-to-number
@@
-3114,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