annotate lisp/gnus/gnus-score.el @ 20483:141c2d41d39c

(toggle-enable-multibyte-characters): Doc fix.
author Richard M. Stallman <rms@gnu.org>
date Sun, 21 Dec 1997 01:49:03 +0000
parents 5f1ab3dd344d
children c760c9b2e5bf
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
1 1;;; gnus-score.el --- scoring code for Gnus
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
3
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
4 ;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
6 ;; Keywords: news
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
7
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
9
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
13 ;; any later version.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
14
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
19
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
23 ;; Boston, MA 02111-1307, USA.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
24
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
25 ;;; Commentary:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
26
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
27 ;;; Code:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
28
19521
6f6cf9184e93 Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents: 17493
diff changeset
29 (eval-when-compile (require 'cl))
6f6cf9184e93 Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents: 17493
diff changeset
30
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
31 (require 'gnus)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
32 (require 'gnus-sum)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
33 (require 'gnus-range)
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
34 (require 'message)
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
35
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
36 (defcustom gnus-global-score-files nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
37 "List of global score files and directories.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
38 Set this variable if you want to use people's score files. One entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
39 for each score file or each score file directory. Gnus will decide
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
40 by itself what score files are applicable to which group.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
41
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
42 Say you want to use the single score file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
43 \"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
44 score files in the \"/ftp.some-where:/pub/score\" directory.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
45
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
46 (setq gnus-global-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
47 '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
48 \"/ftp.some-where:/pub/score\"))"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
49 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
50 :type '(repeat file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
51
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
52 (defcustom gnus-score-file-single-match-alist nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
53 "Alist mapping regexps to lists of score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
54 Each element of this alist should be of the form
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
55 (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
56
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
57 If the name of a group is matched by REGEXP, the corresponding scorefiles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
58 will be used for that group.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
59 The first match found is used, subsequent matching entries are ignored (to
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
60 use multiple matches, see gnus-score-file-multiple-match-alist).
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
61
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
62 These score files are loaded in addition to any files returned by
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
63 gnus-score-find-score-files-function (which see)."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
64 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
65 :type '(repeat (cons regexp (repeat file))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
66
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
67 (defcustom gnus-score-file-multiple-match-alist nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
68 "Alist mapping regexps to lists of score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
69 Each element of this alist should be of the form
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
70 (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
71
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
72 If the name of a group is matched by REGEXP, the corresponding scorefiles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
73 will be used for that group.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
74 If multiple REGEXPs match a group, the score files corresponding to each
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
75 match will be used (for only one match to be used, see
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
76 gnus-score-file-single-match-alist).
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
77
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
78 These score files are loaded in addition to any files returned by
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
79 gnus-score-find-score-files-function (which see)."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
80 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
81 :type '(repeat (cons regexp (repeat file))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
82
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
83 (defcustom gnus-score-file-suffix "SCORE"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
84 "Suffix of the score files."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
85 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
86 :type 'string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
87
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
88 (defcustom gnus-adaptive-file-suffix "ADAPT"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
89 "Suffix of the adaptive score files."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
90 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
91 :group 'gnus-score-adapt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
92 :type 'string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
93
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
94 (defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
95 "Function used to find score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
96 The function will be called with the group name as the argument, and
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
97 should return a list of score files to apply to that group. The score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
98 files do not actually have to exist.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
99
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
100 Predefined values are:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
101
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
102 gnus-score-find-single: Only apply the group's own score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
103 gnus-score-find-hierarchical: Also apply score files from parent groups.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
104 gnus-score-find-bnews: Apply score files whose names matches.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
105
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
106 See the documentation to these functions for more information.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
107
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
108 This variable can also be a list of functions to be called. Each
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
109 function should either return a list of score files, or a list of
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
110 score alists."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
111 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
112 :type '(radio (function-item gnus-score-find-single)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
113 (function-item gnus-score-find-hierarchical)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
114 (function-item gnus-score-find-bnews)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
115 (function :tag "Other")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
116
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
117 (defcustom gnus-score-interactive-default-score 1000
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
118 "*Scoring commands will raise/lower the score with this number as the default."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
119 :group 'gnus-score-default
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
120 :type 'integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
121
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
122 (defcustom gnus-score-expiry-days 7
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
123 "*Number of days before unused score file entries are expired.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
124 If this variable is nil, no score file entries will be expired."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
125 :group 'gnus-score-expire
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
126 :type '(choice (const :tag "never" nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
127 number))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
128
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
129 (defcustom gnus-update-score-entry-dates t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
130 "*In non-nil, update matching score entry dates.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
131 If this variable is nil, then score entries that provide matches
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
132 will be expired along with non-matching score entries."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
133 :group 'gnus-score-expire
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
134 :type 'boolean)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
135
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
136 (defcustom gnus-orphan-score nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
137 "*All orphans get this score added. Set in the score file."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
138 :group 'gnus-score-default
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
139 :type 'integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
140
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
141 (defcustom gnus-decay-scores nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
142 "*If non-nil, decay non-permanent scores."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
143 :group 'gnus-score-decay
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
144 :type 'boolean)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
145
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
146 (defcustom gnus-decay-score-function 'gnus-decay-score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
147 "*Function called to decay a score.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
148 It is called with one parameter -- the score to be decayed."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
149 :group 'gnus-score-decay
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
150 :type '(radio (function-item gnus-decay-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
151 (function :tag "Other")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
152
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
153 (defcustom gnus-score-decay-constant 3
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
154 "*Decay all \"small\" scores with this amount."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
155 :group 'gnus-score-decay
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
156 :type 'integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
157
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
158 (defcustom gnus-score-decay-scale .05
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
159 "*Decay all \"big\" scores with this factor."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
160 :group 'gnus-score-decay
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
161 :type 'number)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
162
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
163 (defcustom gnus-home-score-file nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
164 "Variable to control where interactive score entries are to go.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
165 It can be:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
166
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
167 * A string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
168 This file file will be used as the home score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
169
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
170 * A function
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
171 The result of this function will be used as the home score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
172 The function will be passed the name of the group as its
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
173 parameter.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
174
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
175 * A list
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
176 The elements in this list can be:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
177
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
178 * `(regexp file-name ...)'
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
179 If the `regexp' matches the group name, the first `file-name' will
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
180 will be used as the home score file. (Multiple filenames are
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
181 allowed so that one may use gnus-score-file-single-match-alist to
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
182 set this variable.)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
183
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
184 * A function.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
185 If the function returns non-nil, the result will be used
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
186 as the home score file. The function will be passed the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
187 name of the group as its parameter.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
188
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
189 * A string. Use the string as the home score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
190
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
191 The list will be traversed from the beginning towards the end looking
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
192 for matches."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
193 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
194 :type '(choice string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
195 (repeat (choice string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
196 (cons regexp (repeat file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
197 function))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
198 function))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
199
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
200 (defcustom gnus-home-adapt-file nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
201 "Variable to control where new adaptive score entries are to go.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
202 This variable allows the same syntax as `gnus-home-score-file'."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
203 :group 'gnus-score-adapt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
204 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
205 :type '(choice string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
206 (repeat (choice string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
207 (cons regexp (repeat file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
208 function))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
209 function))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
210
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
211 (defcustom gnus-default-adaptive-score-alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
212 '((gnus-kill-file-mark)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
213 (gnus-unread-mark)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
214 (gnus-read-mark (from 3) (subject 30))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
215 (gnus-catchup-mark (subject -10))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
216 (gnus-killed-mark (from -1) (subject -20))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
217 (gnus-del-mark (from -2) (subject -15)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
218 "Alist of marks and scores."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
219 :group 'gnus-score-adapt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
220 :type '(repeat (cons (symbol :tag "Mark")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
221 (repeat (list (choice :tag "Header"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
222 (const from)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
223 (const subject)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
224 (symbol :tag "other"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
225 (integer :tag "Score"))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
226
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
227 (defcustom gnus-ignored-adaptive-words nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
228 "List of words to be ignored when doing adaptive word scoring."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
229 :group 'gnus-score-adapt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
230 :type '(repeat string))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
231
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
232 (defcustom gnus-default-ignored-adaptive-words
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
233 '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
234 "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
235 "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
236 "so" "we" "they" "what" "would" "any" "which" "about" "get" "your"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
237 "use" "some" "me" "then" "name" "like" "out" "when" "up" "time"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
238 "other" "more" "only" "just" "end" "also" "know" "how" "new" "should"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
239 "been" "than" "them" "he" "who" "make" "may" "people" "these" "now"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
240 "their" "here" "into" "first" "could" "way" "had" "see" "work" "well"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
241 "were" "two" "very" "where" "while" "us" "because" "good" "same"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
242 "even" "much" "most" "many" "such" "long" "his" "over" "last" "since"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
243 "right" "before" "our" "without" "too" "those" "why" "must" "part"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
244 "being" "current" "back" "still" "go" "point" "value" "each" "did"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
245 "both" "true" "off" "say" "another" "state" "might" "under" "start"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
246 "try" "re")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
247 "Default list of words to be ignored when doing adaptive word scoring."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
248 :group 'gnus-score-adapt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
249 :type '(repeat string))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
250
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
251 (defcustom gnus-default-adaptive-word-score-alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
252 `((,gnus-read-mark . 30)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
253 (,gnus-catchup-mark . -10)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
254 (,gnus-killed-mark . -20)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
255 (,gnus-del-mark . -15))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
256 "Alist of marks and scores."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
257 :group 'gnus-score-adapt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
258 :type '(repeat (cons (character :tag "Mark")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
259 (integer :tag "Score"))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
260
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
261 (defcustom gnus-score-mimic-keymap nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
262 "*Have the score entry functions pretend that they are a keymap."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
263 :group 'gnus-score-default
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
264 :type 'boolean)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
265
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
266 (defcustom gnus-score-exact-adapt-limit 10
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
267 "*Number that says how long a match has to be before using substring matching.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
268 When doing adaptive scoring, one normally uses fuzzy or substring
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
269 matching. However, if the header one matches is short, the possibility
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
270 for false positives is great, so if the length of the match is less
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
271 than this variable, exact matching will be used.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
272
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
273 If this variable is nil, exact matching will always be used."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
274 :group 'gnus-score-adapt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
275 :type '(choice (const nil) integer))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
276
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
277 (defcustom gnus-score-uncacheable-files "ADAPT$"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
278 "All score files that match this regexp will not be cached."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
279 :group 'gnus-score-adapt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
280 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
281 :type 'regexp)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
282
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
283 (defcustom gnus-score-default-header nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
284 "Default header when entering new scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
285
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
286 Should be one of the following symbols.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
287
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
288 a: from
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
289 s: subject
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
290 b: body
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
291 h: head
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
292 i: message-id
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
293 t: references
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
294 x: xref
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
295 l: lines
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
296 d: date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
297 f: followup
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
298
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
299 If nil, the user will be asked for a header."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
300 :group 'gnus-score-default
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
301 :type '(choice (const :tag "from" a)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
302 (const :tag "subject" s)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
303 (const :tag "body" b)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
304 (const :tag "head" h)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
305 (const :tag "message-id" i)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
306 (const :tag "references" t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
307 (const :tag "xref" x)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
308 (const :tag "lines" l)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
309 (const :tag "date" d)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
310 (const :tag "followup" f)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
311
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
312 (defcustom gnus-score-default-type nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
313 "Default match type when entering new scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
314
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
315 Should be one of the following symbols.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
316
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
317 s: substring
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
318 e: exact string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
319 f: fuzzy string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
320 r: regexp string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
321 b: before date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
322 a: at date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
323 n: this date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
324 <: less than number
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
325 >: greater than number
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
326 =: equal to number
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
327
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
328 If nil, the user will be asked for a match type."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
329 :group 'gnus-score-default
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
330 :type '(choice (const :tag "substring" s)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
331 (const :tag "exact string" e)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
332 (const :tag "fuzzy string" f)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
333 (const :tag "regexp string" r)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
334 (const :tag "before date" b)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
335 (const :tag "at date" a)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
336 (const :tag "this date" n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
337 (const :tag "less than number" <)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
338 (const :tag "greater than number" >)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
339 (const :tag "equal than number" =)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
340
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
341 (defcustom gnus-score-default-fold nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
342 "Use case folding for new score file entries iff not nil."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
343 :group 'gnus-score-default
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
344 :type 'boolean)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
345
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
346 (defcustom gnus-score-default-duration nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
347 "Default duration of effect when entering new scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
348
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
349 Should be one of the following symbols.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
350
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
351 t: temporary
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
352 p: permanent
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
353 i: immediate
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
354
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
355 If nil, the user will be asked for a duration."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
356 :group 'gnus-score-default
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
357 :type '(choice (const :tag "temporary" t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
358 (const :tag "permanent" p)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
359 (const :tag "immediate" i)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
360 (const :tag "ask" nil)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
361
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
362 (defcustom gnus-score-after-write-file-function nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
363 "Function called with the name of the score file just written to disk."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
364 :group 'gnus-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
365 :type 'function)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
366
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
367
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
368
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
369 ;; Internal variables.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
370
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
371 (defvar gnus-adaptive-word-syntax-table
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
372 (let ((table (copy-syntax-table (standard-syntax-table)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
373 (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
374 (while numbers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
375 (modify-syntax-entry (pop numbers) " " table))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
376 (modify-syntax-entry ?' "w" table)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
377 table)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
378 "Syntax table used when doing adaptive word scoring.")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
379
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
380 (defvar gnus-scores-exclude-files nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
381 (defvar gnus-internal-global-score-files nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
382 (defvar gnus-score-file-list nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
383
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
384 (defvar gnus-short-name-score-file-cache nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
385
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
386 (defvar gnus-score-help-winconf nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
387 (defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
388 (defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
389 (defvar gnus-score-trace nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
390 (defvar gnus-score-edit-buffer nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
391
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
392 (defvar gnus-score-alist nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
393 "Alist containing score information.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
394 The keys can be symbols or strings. The following symbols are defined.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
395
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
396 touched: If this alist has been modified.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
397 mark: Automatically mark articles below this.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
398 expunge: Automatically expunge articles below this.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
399 files: List of other score files to load when loading this one.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
400 eval: Sexp to be evaluated when the score file is loaded.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
401
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
402 String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
403 where HEADER is the header being scored, MATCH is the string we are
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
404 looking for, TYPE is a flag indicating whether it should use regexp or
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
405 substring matching, SCORE is the score to add and DATE is the date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
406 of the last successful match.")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
407
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
408 (defvar gnus-score-cache nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
409 (defvar gnus-scores-articles nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
410 (defvar gnus-score-index nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
411
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
412
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
413 (defconst gnus-header-index
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
414 ;; Name to index alist.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
415 '(("number" 0 gnus-score-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
416 ("subject" 1 gnus-score-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
417 ("from" 2 gnus-score-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
418 ("date" 3 gnus-score-date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
419 ("message-id" 4 gnus-score-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
420 ("references" 5 gnus-score-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
421 ("chars" 6 gnus-score-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
422 ("lines" 7 gnus-score-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
423 ("xref" 8 gnus-score-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
424 ("head" -1 gnus-score-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
425 ("body" -1 gnus-score-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
426 ("all" -1 gnus-score-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
427 ("followup" 2 gnus-score-followup)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
428 ("thread" 5 gnus-score-thread)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
429
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
430 ;;; Summary mode score maps.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
431
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
432 (gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
433 "s" gnus-summary-set-score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
434 "a" gnus-summary-score-entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
435 "S" gnus-summary-current-score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
436 "c" gnus-score-change-score-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
437 "C" gnus-score-customize
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
438 "m" gnus-score-set-mark-below
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
439 "x" gnus-score-set-expunge-below
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
440 "R" gnus-summary-rescore
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
441 "e" gnus-score-edit-current-scores
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
442 "f" gnus-score-edit-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
443 "F" gnus-score-flush-cache
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
444 "t" gnus-score-find-trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
445 "w" gnus-score-find-favourite-words)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
446
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
447 ;; Summary score file commands
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
448
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
449 ;; Much modification of the kill (ahem, score) code and lots of the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
450 ;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
451
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
452 (defun gnus-summary-lower-score (&optional score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
453 "Make a score entry based on the current article.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
454 The user will be prompted for header to score on, match type,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
455 permanence, and the string to be used. The numerical prefix will be
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
456 used as score."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
457 (interactive "P")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
458 (gnus-summary-increase-score (- (gnus-score-default score))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
459
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
460 (defun gnus-score-kill-help-buffer ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
461 (when (get-buffer "*Score Help*")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
462 (kill-buffer "*Score Help*")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
463 (when gnus-score-help-winconf
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
464 (set-window-configuration gnus-score-help-winconf))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
465
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
466 (defun gnus-summary-increase-score (&optional score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
467 "Make a score entry based on the current article.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
468 The user will be prompted for header to score on, match type,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
469 permanence, and the string to be used. The numerical prefix will be
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
470 used as score."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
471 (interactive "P")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
472 (gnus-set-global-variables)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
473 (let* ((nscore (gnus-score-default score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
474 (prefix (if (< nscore 0) ?L ?I))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
475 (increase (> nscore 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
476 (char-to-header
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
477 '((?a "from" nil nil string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
478 (?s "subject" nil nil string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
479 (?b "body" "" nil body-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
480 (?h "head" "" nil body-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
481 (?i "message-id" nil t string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
482 (?t "references" "message-id" nil string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
483 (?x "xref" nil nil string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
484 (?l "lines" nil nil number)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
485 (?d "date" nil nil date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
486 (?f "followup" nil nil string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
487 (?T "thread" nil nil string)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
488 (char-to-type
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
489 '((?s s "substring" string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
490 (?e e "exact string" string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
491 (?f f "fuzzy string" string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
492 (?r r "regexp string" string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
493 (?z s "substring" body-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
494 (?p r "regexp string" body-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
495 (?b before "before date" date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
496 (?a at "at date" date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
497 (?n now "this date" date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
498 (?< < "less than number" number)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
499 (?> > "greater than number" number)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
500 (?= = "equal to number" number)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
501 (char-to-perm
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
502 (list (list ?t (current-time-string) "temporary")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
503 '(?p perm "permanent") '(?i now "immediate")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
504 (mimic gnus-score-mimic-keymap)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
505 (hchar (and gnus-score-default-header
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
506 (aref (symbol-name gnus-score-default-header) 0)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
507 (tchar (and gnus-score-default-type
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
508 (aref (symbol-name gnus-score-default-type) 0)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
509 (pchar (and gnus-score-default-duration
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
510 (aref (symbol-name gnus-score-default-duration) 0)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
511 entry temporary type match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
512
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
513 (unwind-protect
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
514 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
515
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
516 ;; First we read the header to score.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
517 (while (not hchar)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
518 (if mimic
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
519 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
520 (sit-for 1)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
521 (message "%c-" prefix))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
522 (message "%s header (%s?): " (if increase "Increase" "Lower")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
523 (mapconcat (lambda (s) (char-to-string (car s)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
524 char-to-header "")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
525 (setq hchar (read-char))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
526 (when (or (= hchar ??) (= hchar ?\C-h))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
527 (setq hchar nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
528 (gnus-score-insert-help "Match on header" char-to-header 1)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
529
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
530 (gnus-score-kill-help-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
531 (unless (setq entry (assq (downcase hchar) char-to-header))
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
532 (if mimic (error "%c %c" prefix hchar)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
533 (error "Illegal header type")))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
534
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
535 (when (/= (downcase hchar) hchar)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
536 ;; This was a majuscule, so we end reading and set the defaults.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
537 (if mimic (message "%c %c" prefix hchar) (message ""))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
538 (setq tchar (or tchar ?s)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
539 pchar (or pchar ?t)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
540
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
541 (let ((legal-types
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
542 (delq nil
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
543 (mapcar (lambda (s)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
544 (if (eq (nth 4 entry)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
545 (nth 3 s))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
546 s nil))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
547 char-to-type))))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
548 ;; We continue reading - the type.
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
549 (while (not tchar)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
550 (if mimic
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
551 (progn
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
552 (sit-for 1) (message "%c %c-" prefix hchar))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
553 (message "%s header '%s' with match type (%s?): "
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
554 (if increase "Increase" "Lower")
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
555 (nth 1 entry)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
556 (mapconcat (lambda (s) (char-to-string (car s)))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
557 legal-types "")))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
558 (setq tchar (read-char))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
559 (when (or (= tchar ??) (= tchar ?\C-h))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
560 (setq tchar nil)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
561 (gnus-score-insert-help "Match type" legal-types 2)))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
562
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
563 (gnus-score-kill-help-buffer)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
564 (unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
565 (if mimic (error "%c %c" prefix hchar)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
566 (error "Illegal match type"))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
567
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
568 (when (/= (downcase tchar) tchar)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
569 ;; It was a majuscule, so we end reading and use the default.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
570 (if mimic (message "%c %c %c" prefix hchar tchar)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
571 (message ""))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
572 (setq pchar (or pchar ?p)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
573
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
574 ;; We continue reading.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
575 (while (not pchar)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
576 (if mimic
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
577 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
578 (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
579 (message "%s permanence (%s?): " (if increase "Increase" "Lower")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
580 (mapconcat (lambda (s) (char-to-string (car s)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
581 char-to-perm "")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
582 (setq pchar (read-char))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
583 (when (or (= pchar ??) (= pchar ?\C-h))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
584 (setq pchar nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
585 (gnus-score-insert-help "Match permanence" char-to-perm 2)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
586
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
587 (gnus-score-kill-help-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
588 (if mimic (message "%c %c %c" prefix hchar tchar pchar)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
589 (message ""))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
590 (unless (setq temporary (cadr (assq pchar char-to-perm)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
591 ;; Deal with der(r)ided superannuated paradigms.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
592 (when (and (eq (1+ prefix) 77)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
593 (eq (+ hchar 12) 109)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
594 (eq tchar 114)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
595 (eq (- pchar 4) 111))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
596 (error "You rang?"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
597 (if mimic
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
598 (error "%c %c %c %c" prefix hchar tchar pchar)
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
599 (error "Illegal match duration"))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
600 ;; Always kill the score help buffer.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
601 (gnus-score-kill-help-buffer))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
602
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
603 ;; We have all the data, so we enter this score.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
604 (setq match (if (string= (nth 2 entry) "") ""
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
605 (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
606
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
607 ;; Modify the match, perhaps.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
608 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
609 ((equal (nth 1 entry) "xref")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
610 (when (string-match "^Xref: *" match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
611 (setq match (substring match (match-end 0))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
612 (when (string-match "^[^:]* +" match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
613 (setq match (substring match (match-end 0))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
614
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
615 (when (memq type '(r R regexp Regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
616 (setq match (regexp-quote match)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
617
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
618 (gnus-summary-score-entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
619 (nth 1 entry) ; Header
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
620 match ; Match
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
621 type ; Type
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
622 (if (eq score 's) nil score) ; Score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
623 (if (eq temporary 'perm) ; Temp
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
624 nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
625 temporary)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
626 (not (nth 3 entry))) ; Prompt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
627 ))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
628
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
629 (defun gnus-score-insert-help (string alist idx)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
630 (setq gnus-score-help-winconf (current-window-configuration))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
631 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
632 (set-buffer (get-buffer-create "*Score Help*"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
633 (buffer-disable-undo (current-buffer))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
634 (delete-windows-on (current-buffer))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
635 (erase-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
636 (insert string ":\n\n")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
637 (let ((max -1)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
638 (list alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
639 (i 0)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
640 n width pad format)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
641 ;; find the longest string to display
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
642 (while list
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
643 (setq n (length (nth idx (car list))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
644 (unless (> max n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
645 (setq max n))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
646 (setq list (cdr list)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
647 (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
648 (setq n (/ (1- (window-width)) max)) ; items per line
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
649 (setq width (/ (1- (window-width)) n)) ; width of each item
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
650 ;; insert `n' items, each in a field of width `width'
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
651 (while alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
652 (if (< i n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
653 ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
654 (setq i 0)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
655 (delete-char -1) ; the `\n' takes a char
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
656 (insert "\n"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
657 (setq pad (- width 3))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
658 (setq format (concat "%c: %-" (int-to-string pad) "s"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
659 (insert (format format (caar alist) (nth idx (car alist))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
660 (setq alist (cdr alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
661 (setq i (1+ i))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
662 ;; display ourselves in a small window at the bottom
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
663 (gnus-appt-select-lowest-window)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
664 (split-window)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
665 (pop-to-buffer "*Score Help*")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
666 (let ((window-min-height 1))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
667 (shrink-window-if-larger-than-buffer))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
668 (select-window (get-buffer-window gnus-summary-buffer))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
669
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
670 (defun gnus-summary-header (header &optional no-err)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
671 ;; Return HEADER for current articles, or error.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
672 (let ((article (gnus-summary-article-number))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
673 headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
674 (if article
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
675 (if (and (setq headers (gnus-summary-article-header article))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
676 (vectorp headers))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
677 (aref headers (nth 1 (assoc header gnus-header-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
678 (if no-err
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
679 nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
680 (error "Pseudo-articles can't be scored")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
681 (if no-err
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
682 (error "No article on current line")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
683 nil))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
684
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
685 (defun gnus-newsgroup-score-alist ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
686 (or
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
687 (let ((param-file (gnus-group-find-parameter
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
688 gnus-newsgroup-name 'score-file)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
689 (when param-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
690 (gnus-score-load param-file)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
691 (gnus-score-load
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
692 (gnus-score-file-name gnus-newsgroup-name)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
693 gnus-score-alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
694
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
695 (defsubst gnus-score-get (symbol &optional alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
696 ;; Get SYMBOL's definition in ALIST.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
697 (cdr (assoc symbol
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
698 (or alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
699 gnus-score-alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
700 (gnus-newsgroup-score-alist)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
701
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
702 (defun gnus-summary-score-entry (header match type score date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
703 &optional prompt silent)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
704 "Enter score file entry.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
705 HEADER is the header being scored.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
706 MATCH is the string we are looking for.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
707 TYPE is the match type: substring, regexp, exact, fuzzy.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
708 SCORE is the score to add.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
709 DATE is the expire date, or nil for no expire, or 'now for immediate expire.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
710 If optional argument `PROMPT' is non-nil, allow user to edit match.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
711 If optional argument `SILENT' is nil, show effect of score entry."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
712 (interactive
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
713 (list (completing-read "Header: "
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
714 gnus-header-index
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
715 (lambda (x) (fboundp (nth 2 x)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
716 t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
717 (read-string "Match: ")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
718 (if (y-or-n-p "Use regexp match? ") 'r 's)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
719 (and current-prefix-arg
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
720 (prefix-numeric-value current-prefix-arg))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
721 (cond ((not (y-or-n-p "Add to score file? "))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
722 'now)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
723 ((y-or-n-p "Expire kill? ")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
724 (current-time-string))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
725 (t nil))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
726 ;; Regexp is the default type.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
727 (when (eq type t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
728 (setq type 'r))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
729 ;; Simplify matches...
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
730 (cond ((or (eq type 'r) (eq type 's) (eq type nil))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
731 (setq match (if match (gnus-simplify-subject-re match) "")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
732 ((eq type 'f)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
733 (setq match (gnus-simplify-subject-fuzzy match))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
734 (let ((score (gnus-score-default score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
735 (header (format "%s" (downcase header)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
736 new)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
737 (when prompt
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
738 (setq match (read-string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
739 (format "Match %s on %s, %s: "
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
740 (cond ((eq date 'now)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
741 "now")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
742 ((stringp date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
743 "temp")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
744 (t "permanent"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
745 header
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
746 (if (< score 0) "lower" "raise"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
747 (if (numberp match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
748 (int-to-string match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
749 match))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
750
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
751 ;; Get rid of string props.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
752 (setq match (format "%s" match))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
753
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
754 ;; If this is an integer comparison, we transform from string to int.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
755 (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
756 (setq match (string-to-int match)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
757
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
758 (unless (eq date 'now)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
759 ;; Add the score entry to the score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
760 (when (= score gnus-score-interactive-default-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
761 (setq score nil))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
762 (let ((old (gnus-score-get header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
763 elem)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
764 (setq new
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
765 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
766 (type
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
767 (list match score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
768 (and date (if (numberp date) date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
769 (gnus-day-number date)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
770 type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
771 (date (list match score (gnus-day-number date)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
772 (score (list match score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
773 (t (list match))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
774 ;; We see whether we can collapse some score entries.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
775 ;; This isn't quite correct, because there may be more elements
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
776 ;; later on with the same key that have matching elems... Hm.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
777 (if (and old
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
778 (setq elem (assoc match old))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
779 (eq (nth 3 elem) (nth 3 new))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
780 (or (and (numberp (nth 2 elem)) (numberp (nth 2 new)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
781 (and (not (nth 2 elem)) (not (nth 2 new)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
782 ;; Yup, we just add this new score to the old elem.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
783 (setcar (cdr elem) (+ (or (nth 1 elem)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
784 gnus-score-interactive-default-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
785 (or (nth 1 new)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
786 gnus-score-interactive-default-score)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
787 ;; Nope, we have to add a new elem.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
788 (gnus-score-set header (if old (cons new old) (list new))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
789 (gnus-score-set 'touched '(t))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
790
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
791 ;; Score the current buffer.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
792 (unless silent
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
793 (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
794 (eq (nth 2 (assoc header gnus-header-index))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
795 'gnus-score-string))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
796 (gnus-summary-score-effect header match type score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
797 (gnus-summary-rescore)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
798
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
799 ;; Return the new scoring rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
800 new))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
801
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
802 (defun gnus-summary-score-effect (header match type score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
803 "Simulate the effect of a score file entry.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
804 HEADER is the header being scored.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
805 MATCH is the string we are looking for.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
806 TYPE is the score type.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
807 SCORE is the score to add."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
808 (interactive (list (completing-read "Header: "
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
809 gnus-header-index
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
810 (lambda (x) (fboundp (nth 2 x)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
811 t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
812 (read-string "Match: ")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
813 (y-or-n-p "Use regexp match? ")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
814 (prefix-numeric-value current-prefix-arg)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
815 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
816 (unless (and (stringp match) (> (length match) 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
817 (error "No match"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
818 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
819 (let ((regexp (cond ((eq type 'f)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
820 (gnus-simplify-subject-fuzzy match))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
821 ((eq type 'r)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
822 match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
823 ((eq type 'e)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
824 (concat "\\`" (regexp-quote match) "\\'"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
825 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
826 (regexp-quote match)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
827 (while (not (eobp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
828 (let ((content (gnus-summary-header header 'noerr))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
829 (case-fold-search t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
830 (and content
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
831 (when (if (eq type 'f)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
832 (string-equal (gnus-simplify-subject-fuzzy content)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
833 regexp)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
834 (string-match regexp content))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
835 (gnus-summary-raise-score score))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
836 (beginning-of-line 2))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
837 (gnus-set-mode-line 'summary))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
838
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
839 (defun gnus-summary-score-crossposting (score date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
840 ;; Enter score file entry for current crossposting.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
841 ;; SCORE is the score to add.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
842 ;; DATE is the expire date.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
843 (let ((xref (gnus-summary-header "xref"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
844 (start 0)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
845 group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
846 (unless xref
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
847 (error "This article is not crossposted"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
848 (while (string-match " \\([^ \t]+\\):" xref start)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
849 (setq start (match-end 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
850 (when (not (string=
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
851 (setq group
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
852 (substring xref (match-beginning 1) (match-end 1)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
853 gnus-newsgroup-name))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
854 (gnus-summary-score-entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
855 "xref" (concat " " group ":") nil score date t)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
856
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
857
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
858 ;;;
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
859 ;;; Gnus Score Files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
860 ;;;
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
861
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
862 ;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
863
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
864 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
865 (defun gnus-score-set-mark-below (score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
866 "Automatically mark articles with score below SCORE as read."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
867 (interactive
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
868 (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
869 (string-to-int (read-string "Mark below: ")))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
870 (setq score (or score gnus-summary-default-score 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
871 (gnus-score-set 'mark (list score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
872 (gnus-score-set 'touched '(t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
873 (setq gnus-summary-mark-below score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
874 (gnus-score-update-lines))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
875
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
876 (defun gnus-score-update-lines ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
877 "Update all lines in the summary buffer."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
878 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
879 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
880 (while (not (eobp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
881 (gnus-summary-update-line)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
882 (forward-line 1))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
883
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
884 (defun gnus-score-update-all-lines ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
885 "Update all lines in the summary buffer, even the hidden ones."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
886 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
887 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
888 (let (hidden)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
889 (while (not (eobp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
890 (when (gnus-summary-show-thread)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
891 (push (point) hidden))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
892 (gnus-summary-update-line)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
893 (forward-line 1))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
894 ;; Re-hide the hidden threads.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
895 (while hidden
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
896 (goto-char (pop hidden))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
897 (gnus-summary-hide-thread)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
898
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
899 (defun gnus-score-set-expunge-below (score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
900 "Automatically expunge articles with score below SCORE."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
901 (interactive
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
902 (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
903 (string-to-int (read-string "Set expunge below: ")))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
904 (setq score (or score gnus-summary-default-score 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
905 (gnus-score-set 'expunge (list score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
906 (gnus-score-set 'touched '(t)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
907
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
908 (defun gnus-score-followup-article (&optional score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
909 "Add SCORE to all followups to the article in the current buffer."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
910 (interactive "P")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
911 (setq score (gnus-score-default score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
912 (when (gnus-buffer-live-p gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
913 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
914 (save-restriction
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
915 (message-narrow-to-headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
916 (let ((id (mail-fetch-field "message-id")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
917 (when id
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
918 (set-buffer gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
919 (gnus-summary-score-entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
920 "references" (concat id "[ \t]*$") 'r
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
921 score (current-time-string) nil t)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
922
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
923 (defun gnus-score-followup-thread (&optional score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
924 "Add SCORE to all later articles in the thread the current buffer is part of."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
925 (interactive "P")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
926 (setq score (gnus-score-default score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
927 (when (gnus-buffer-live-p gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
928 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
929 (save-restriction
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
930 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
931 (let ((id (mail-fetch-field "message-id")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
932 (when id
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
933 (set-buffer gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
934 (gnus-summary-score-entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
935 "references" id 's
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
936 score (current-time-string))))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
937
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
938 (defun gnus-score-set (symbol value &optional alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
939 ;; Set SYMBOL to VALUE in ALIST.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
940 (let* ((alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
941 (or alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
942 gnus-score-alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
943 (gnus-newsgroup-score-alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
944 (entry (assoc symbol alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
945 (cond ((gnus-score-get 'read-only alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
946 ;; This is a read-only score file, so we do nothing.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
947 )
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
948 (entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
949 (setcdr entry value))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
950 ((null alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
951 (error "Empty alist"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
952 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
953 (setcdr alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
954 (cons (cons symbol value) (cdr alist)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
955
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
956 (defun gnus-summary-raise-score (n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
957 "Raise the score of the current article by N."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
958 (interactive "p")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
959 (gnus-set-global-variables)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
960 (gnus-summary-set-score (+ (gnus-summary-article-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
961 (or n gnus-score-interactive-default-score ))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
962
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
963 (defun gnus-summary-set-score (n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
964 "Set the score of the current article to N."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
965 (interactive "p")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
966 (gnus-set-global-variables)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
967 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
968 (gnus-summary-show-thread)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
969 (let ((buffer-read-only nil))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
970 ;; Set score.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
971 (gnus-summary-update-mark
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
972 (if (= n (or gnus-summary-default-score 0)) ?
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
973 (if (< n (or gnus-summary-default-score 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
974 gnus-score-below-mark gnus-score-over-mark))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
975 'score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
976 (let* ((article (gnus-summary-article-number))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
977 (score (assq article gnus-newsgroup-scored)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
978 (if score (setcdr score n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
979 (push (cons article n) gnus-newsgroup-scored)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
980 (gnus-summary-update-line)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
981
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
982 (defun gnus-summary-current-score ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
983 "Return the score of the current article."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
984 (interactive)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
985 (gnus-set-global-variables)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
986 (gnus-message 1 "%s" (gnus-summary-article-score)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
987
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
988 (defun gnus-score-change-score-file (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
989 "Change current score alist."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
990 (interactive
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
991 (list (read-file-name "Change to score file: " gnus-kill-files-directory)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
992 (gnus-score-load-file file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
993 (gnus-set-mode-line 'summary))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
994
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
995 (defvar gnus-score-edit-exit-function)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
996 (defun gnus-score-edit-current-scores (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
997 "Edit the current score alist."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
998 (interactive (list gnus-current-score-file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
999 (gnus-set-global-variables)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1000 (let ((winconf (current-window-configuration)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1001 (when (buffer-name gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1002 (gnus-score-save))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1003 (gnus-make-directory (file-name-directory file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1004 (setq gnus-score-edit-buffer (find-file-noselect file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1005 (gnus-configure-windows 'edit-score)
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
1006 (select-window (get-buffer-window gnus-score-edit-buffer))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1007 (gnus-score-mode)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1008 (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1009 (make-local-variable 'gnus-prev-winconf)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1010 (setq gnus-prev-winconf winconf))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1011 (gnus-message
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1012 4 (substitute-command-keys
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1013 "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1014
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1015 (defun gnus-score-edit-file (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1016 "Edit a score file."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1017 (interactive
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1018 (list (read-file-name "Edit score file: " gnus-kill-files-directory)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1019 (gnus-make-directory (file-name-directory file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1020 (when (buffer-name gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1021 (gnus-score-save))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1022 (let ((winconf (current-window-configuration)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1023 (setq gnus-score-edit-buffer (find-file-noselect file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1024 (gnus-configure-windows 'edit-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1025 (gnus-score-mode)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1026 (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1027 (make-local-variable 'gnus-prev-winconf)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1028 (setq gnus-prev-winconf winconf))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1029 (gnus-message
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1030 4 (substitute-command-keys
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1031 "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1032
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1033 (defun gnus-score-load-file (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1034 ;; Load score file FILE. Returns a list a retrieved score-alists.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1035 (let* ((file (expand-file-name
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1036 (or (and (string-match
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1037 (concat "^" (expand-file-name
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1038 gnus-kill-files-directory))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1039 (expand-file-name file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1040 file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1041 (concat (file-name-as-directory gnus-kill-files-directory)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1042 file))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1043 (cached (assoc file gnus-score-cache))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1044 (global (member file gnus-internal-global-score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1045 lists alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1046 (if cached
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1047 ;; The score file was already loaded.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1048 (setq alist (cdr cached))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1049 ;; We load the score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1050 (setq gnus-score-alist nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1051 (setq alist (gnus-score-load-score-alist file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1052 ;; We add '(touched) to the alist to signify that it hasn't been
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1053 ;; touched (yet).
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1054 (unless (assq 'touched alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1055 (push (list 'touched nil) alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1056 ;; If it is a global score file, we make it read-only.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1057 (and global
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1058 (not (assq 'read-only alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1059 (push (list 'read-only t) alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1060 (push (cons file alist) gnus-score-cache))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1061 (let ((a alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1062 found)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1063 (while a
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1064 ;; Downcase all header names.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1065 (when (stringp (caar a))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1066 (setcar (car a) (downcase (caar a)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1067 (setq found t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1068 (pop a))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1069 ;; If there are actual scores in the alist, we add it to the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1070 ;; return value of this function.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1071 (when found
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1072 (setq lists (list alist))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1073 ;; Treat the other possible atoms in the score alist.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1074 (let ((mark (car (gnus-score-get 'mark alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1075 (expunge (car (gnus-score-get 'expunge alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1076 (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1077 (files (gnus-score-get 'files alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1078 (exclude-files (gnus-score-get 'exclude-files alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1079 (orphan (car (gnus-score-get 'orphan alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1080 (adapt (gnus-score-get 'adapt alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1081 (thread-mark-and-expunge
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1082 (car (gnus-score-get 'thread-mark-and-expunge alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1083 (adapt-file (car (gnus-score-get 'adapt-file alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1084 (local (gnus-score-get 'local alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1085 (decay (car (gnus-score-get 'decay alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1086 (eval (car (gnus-score-get 'eval alist))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1087 ;; Perform possible decays.
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
1088 (when gnus-decay-scores
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
1089 (when (or (not decay)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
1090 (gnus-decay-scores alist decay))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
1091 (gnus-score-set 'touched '(t) alist)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
1092 (gnus-score-set 'decay (list (gnus-time-to-day (current-time))))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1093 ;; We do not respect eval and files atoms from global score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1094 ;; files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1095 (and files (not global)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1096 (setq lists (apply 'append lists
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1097 (mapcar (lambda (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1098 (gnus-score-load-file file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1099 (if adapt-file (cons adapt-file files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1100 files)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1101 (and eval (not global) (eval eval))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1102 ;; We then expand any exclude-file directives.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1103 (setq gnus-scores-exclude-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1104 (nconc
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1105 (mapcar
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1106 (lambda (sfile)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1107 (expand-file-name sfile (file-name-directory file)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1108 exclude-files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1109 gnus-scores-exclude-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1110 (if (not local)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1111 ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1112 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1113 (set-buffer gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1114 (while local
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1115 (and (consp (car local))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1116 (symbolp (caar local))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1117 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1118 (make-local-variable (caar local))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1119 (set (caar local) (nth 1 (car local)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1120 (setq local (cdr local)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1121 (when orphan
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1122 (setq gnus-orphan-score orphan))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1123 (setq gnus-adaptive-score-alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1124 (cond ((equal adapt '(t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1125 (setq gnus-newsgroup-adaptive t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1126 gnus-default-adaptive-score-alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1127 ((equal adapt '(ignore))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1128 (setq gnus-newsgroup-adaptive nil))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1129 ((consp adapt)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1130 (setq gnus-newsgroup-adaptive t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1131 adapt)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1132 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1133 ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1134 gnus-default-adaptive-score-alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1135 (setq gnus-thread-expunge-below
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1136 (or thread-mark-and-expunge gnus-thread-expunge-below))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1137 (setq gnus-summary-mark-below
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1138 (or mark mark-and-expunge gnus-summary-mark-below))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1139 (setq gnus-summary-expunge-below
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1140 (or expunge mark-and-expunge gnus-summary-expunge-below))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1141 (setq gnus-newsgroup-adaptive-score-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1142 (or adapt-file gnus-newsgroup-adaptive-score-file)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1143 (setq gnus-current-score-file file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1144 (setq gnus-score-alist alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1145 lists))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1146
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1147 (defun gnus-score-load (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1148 ;; Load score FILE.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1149 (let ((cache (assoc file gnus-score-cache)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1150 (if cache
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1151 (setq gnus-score-alist (cdr cache))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1152 (setq gnus-score-alist nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1153 (gnus-score-load-score-alist file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1154 (unless gnus-score-alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1155 (setq gnus-score-alist (copy-alist '((touched nil)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1156 (push (cons file gnus-score-alist) gnus-score-cache))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1157
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1158 (defun gnus-score-remove-from-cache (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1159 (setq gnus-score-cache
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1160 (delq (assoc file gnus-score-cache) gnus-score-cache)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1161
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1162 (defun gnus-score-load-score-alist (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1163 "Read score FILE."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1164 (let (alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1165 (if (not (file-readable-p file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1166 ;; Couldn't read file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1167 (setq gnus-score-alist nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1168 ;; Read file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1169 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1170 (gnus-set-work-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1171 (insert-file-contents file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1172 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1173 ;; Only do the loading if the score file isn't empty.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1174 (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1175 (setq alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1176 (condition-case ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1177 (read (current-buffer))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1178 (error
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1179 (gnus-error 3.2 "Problem with score file %s" file))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1180 (if (eq (car alist) 'setq)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1181 ;; This is an old-style score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1182 (setq gnus-score-alist (gnus-score-transform-old-to-new alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1183 (setq gnus-score-alist alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1184 ;; Check the syntax of the score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1185 (setq gnus-score-alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1186 (gnus-score-check-syntax gnus-score-alist file)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1187
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1188 (defun gnus-score-check-syntax (alist file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1189 "Check the syntax of the score ALIST."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1190 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1191 ((null alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1192 nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1193 ((not (consp alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1194 (gnus-message 1 "Score file is not a list: %s" file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1195 (ding)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1196 nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1197 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1198 (let ((a alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1199 sr err s type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1200 (while (and a (not err))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1201 (setq
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1202 err
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1203 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1204 ((not (listp (car a)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1205 (format "Illegal score element %s in %s" (car a) file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1206 ((stringp (caar a))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1207 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1208 ((not (listp (setq sr (cdar a))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1209 (format "Illegal header match %s in %s" (nth 1 (car a)) file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1210 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1211 (setq type (caar a))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1212 (while (and sr (not err))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1213 (setq s (pop sr))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1214 (setq
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1215 err
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1216 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1217 ((if (member (downcase type) '("lines" "chars"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1218 (not (numberp (car s)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1219 (not (stringp (car s))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1220 (format "Illegal match %s in %s" (car s) file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1221 ((and (cadr s) (not (integerp (cadr s))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1222 (format "Non-integer score %s in %s" (cadr s) file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1223 ((and (caddr s) (not (integerp (caddr s))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1224 (format "Non-integer date %s in %s" (caddr s) file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1225 ((and (cadddr s) (not (symbolp (cadddr s))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1226 (format "Non-symbol match type %s in %s" (cadddr s) file)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1227 err)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1228 (setq a (cdr a)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1229 (if err
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1230 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1231 (ding)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1232 (gnus-message 3 err)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1233 (sit-for 2)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1234 nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1235 alist)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1236
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1237 (defun gnus-score-transform-old-to-new (alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1238 (let* ((alist (nth 2 alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1239 out entry)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1240 (when (eq (car alist) 'quote)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1241 (setq alist (nth 1 alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1242 (while alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1243 (setq entry (car alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1244 (if (stringp (car entry))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1245 (let ((scor (cdr entry)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1246 (push entry out)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1247 (while scor
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1248 (setcar scor
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1249 (list (caar scor) (nth 2 (car scor))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1250 (and (nth 3 (car scor))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1251 (gnus-day-number (nth 3 (car scor))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1252 (if (nth 1 (car scor)) 'r 's)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1253 (setq scor (cdr scor))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1254 (push (if (not (listp (cdr entry)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1255 (list (car entry) (cdr entry))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1256 entry)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1257 out))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1258 (setq alist (cdr alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1259 (cons (list 'touched t) (nreverse out))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1260
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1261 (defun gnus-score-save ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1262 ;; Save all score information.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1263 (let ((cache gnus-score-cache)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1264 entry score file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1265 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1266 (setq gnus-score-alist nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1267 (nnheader-set-temp-buffer " *Gnus Scores*")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1268 (while cache
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1269 (current-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1270 (setq entry (pop cache)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1271 file (car entry)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1272 score (cdr entry))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1273 (if (or (not (equal (gnus-score-get 'touched score) '(t)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1274 (gnus-score-get 'read-only score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1275 (and (file-exists-p file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1276 (not (file-writable-p file))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1277 ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1278 (setq score (setcdr entry (delq (assq 'touched score) score)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1279 (erase-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1280 (let (emacs-lisp-mode-hook)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1281 (if (string-match
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
1282 (concat (regexp-quote gnus-adaptive-file-suffix) "$")
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1283 file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1284 ;; This is an adaptive score file, so we do not run
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1285 ;; it through `pp'. These files can get huge, and
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1286 ;; are not meant to be edited by human hands.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1287 (gnus-prin1 score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1288 ;; This is a normal score file, so we print it very
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1289 ;; prettily.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1290 (pp score (current-buffer))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1291 (gnus-make-directory (file-name-directory file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1292 ;; If the score file is empty, we delete it.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1293 (if (zerop (buffer-size))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1294 (delete-file file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1295 ;; There are scores, so we write the file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1296 (when (file-writable-p file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1297 (gnus-write-buffer file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1298 (when gnus-score-after-write-file-function
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1299 (funcall gnus-score-after-write-file-function file)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1300 (and gnus-score-uncacheable-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1301 (string-match gnus-score-uncacheable-files file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1302 (gnus-score-remove-from-cache file)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1303 (kill-buffer (current-buffer)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1304
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1305 (defun gnus-score-load-files (score-files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1306 "Load all score files in SCORE-FILES."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1307 ;; Load the score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1308 (let (scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1309 (while score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1310 (if (stringp (car score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1311 ;; It is a string, which means that it's a score file name,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1312 ;; so we load the score file and add the score alist to
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1313 ;; the list of alists.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1314 (setq scores (nconc (gnus-score-load-file (car score-files)) scores))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1315 ;; It is an alist, so we just add it to the list directly.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1316 (setq scores (nconc (car score-files) scores)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1317 (setq score-files (cdr score-files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1318 ;; Prune the score files that are to be excluded, if any.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1319 (when gnus-scores-exclude-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1320 (let ((s scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1321 c)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1322 (while s
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1323 (and (setq c (rassq (car s) gnus-score-cache))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1324 (member (car c) gnus-scores-exclude-files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1325 (setq scores (delq (car s) scores)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1326 (setq s (cdr s)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1327 scores))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1328
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1329 (defun gnus-score-headers (score-files &optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1330 ;; Score `gnus-newsgroup-headers'.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1331 (let (scores news)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1332 ;; PLM: probably this is not the best place to clear orphan-score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1333 (setq gnus-orphan-score nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1334 gnus-scores-articles nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1335 gnus-scores-exclude-files nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1336 scores (gnus-score-load-files score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1337 (setq news scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1338 ;; Do the scoring.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1339 (while news
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1340 (setq scores news
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1341 news nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1342 (when (and gnus-summary-default-score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1343 scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1344 (let* ((entries gnus-header-index)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1345 (now (gnus-day-number (current-time-string)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1346 (expire (and gnus-score-expiry-days
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1347 (- now gnus-score-expiry-days)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1348 (headers gnus-newsgroup-headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1349 (current-score-file gnus-current-score-file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1350 entry header new)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1351 (gnus-message 5 "Scoring...")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1352 ;; Create articles, an alist of the form `(HEADER . SCORE)'.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1353 (while (setq header (pop headers))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1354 ;; WARNING: The assq makes the function O(N*S) while it could
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1355 ;; be written as O(N+S), where N is (length gnus-newsgroup-headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1356 ;; and S is (length gnus-newsgroup-scored).
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1357 (unless (assq (mail-header-number header) gnus-newsgroup-scored)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1358 (setq gnus-scores-articles ;Total of 2 * N cons-cells used.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1359 (cons (cons header (or gnus-summary-default-score 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1360 gnus-scores-articles))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1361
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1362 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1363 (set-buffer (get-buffer-create "*Headers*"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1364 (buffer-disable-undo (current-buffer))
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
1365 (message-clone-locals gnus-summary-buffer)
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1366
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1367 ;; Set the global variant of this variable.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1368 (setq gnus-current-score-file current-score-file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1369 ;; score orphans
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1370 (when gnus-orphan-score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1371 (setq gnus-score-index
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1372 (nth 1 (assoc "references" gnus-header-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1373 (gnus-score-orphans gnus-orphan-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1374 ;; Run each header through the score process.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1375 (while entries
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1376 (setq entry (pop entries)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1377 header (nth 0 entry)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1378 gnus-score-index (nth 1 (assoc header gnus-header-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1379 (when (< 0 (apply 'max (mapcar
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1380 (lambda (score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1381 (length (gnus-score-get header score)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1382 scores)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1383 ;; Call the scoring function for this type of "header".
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1384 (when (setq new (funcall (nth 2 entry) scores header
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1385 now expire trace))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1386 (push new news))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1387 ;; Remove the buffer.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1388 (kill-buffer (current-buffer)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1389
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1390 ;; Add articles to `gnus-newsgroup-scored'.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1391 (while gnus-scores-articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1392 (when (or (/= gnus-summary-default-score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1393 (cdar gnus-scores-articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1394 gnus-save-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1395 (push (cons (mail-header-number (caar gnus-scores-articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1396 (cdar gnus-scores-articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1397 gnus-newsgroup-scored))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1398 (setq gnus-scores-articles (cdr gnus-scores-articles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1399
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1400 (let (score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1401 (while (setq score (pop scores))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1402 (while score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1403 (when (listp (caar score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1404 (gnus-score-advanced (car score) trace))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1405 (pop score))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1406
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1407 (gnus-message 5 "Scoring...done"))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1408
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1409
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1410 (defun gnus-get-new-thread-ids (articles)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1411 (let ((index (nth 1 (assoc "message-id" gnus-header-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1412 (refind gnus-score-index)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1413 id-list art this tref)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1414 (while articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1415 (setq art (car articles)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1416 this (aref (car art) index)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1417 tref (aref (car art) refind)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1418 articles (cdr articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1419 (when (string-equal tref "") ;no references line
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1420 (push this id-list)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1421 id-list))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1422
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1423 ;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers).
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1424 (defun gnus-score-orphans (score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1425 (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1426 alike articles art arts this last this-id)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1427
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1428 (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1429 articles gnus-scores-articles)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1430
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1431 ;;more or less the same as in gnus-score-string
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1432 (erase-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1433 (while articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1434 (setq art (car articles)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1435 this (aref (car art) gnus-score-index)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1436 articles (cdr articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1437 ;;completely skip if this is empty (not a child, so not an orphan)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1438 (when (not (string= this ""))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1439 (if (equal last this)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1440 ;; O(N*H) cons-cells used here, where H is the number of
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1441 ;; headers.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1442 (push art alike)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1443 (when last
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1444 ;; Insert the line, with a text property on the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1445 ;; terminating newline referring to the articles with
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1446 ;; this line.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1447 (insert last ?\n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1448 (put-text-property (1- (point)) (point) 'articles alike))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1449 (setq alike (list art)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1450 last this))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1451 (when last ; Bwadr, duplicate code.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1452 (insert last ?\n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1453 (put-text-property (1- (point)) (point) 'articles alike))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1454
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1455 ;; PLM: now delete those lines that contain an entry from new-thread-ids
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1456 (while new-thread-ids
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1457 (setq this-id (car new-thread-ids)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1458 new-thread-ids (cdr new-thread-ids))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1459 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1460 (while (search-forward this-id nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1461 ;; found a match. remove this line
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1462 (beginning-of-line)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1463 (kill-line 1)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1464
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1465 ;; now for each line: update its articles with score by moving to
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1466 ;; every end-of-line in the buffer and read the articles property
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1467 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1468 (while (eq 0 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1469 (end-of-line)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1470 (setq arts (get-text-property (point) 'articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1471 (while arts
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1472 (setq art (car arts)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1473 arts (cdr arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1474 (setcdr art (+ score (cdr art))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1475 (forward-line))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1476
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1477
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1478 (defun gnus-score-integer (scores header now expire &optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1479 (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1480 entries alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1481
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1482 ;; Find matches.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1483 (while scores
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1484 (setq alist (car scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1485 scores (cdr scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1486 entries (assoc header alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1487 (while (cdr entries) ;First entry is the header index.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1488 (let* ((rest (cdr entries))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1489 (kill (car rest))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1490 (match (nth 0 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1491 (type (or (nth 3 kill) '>))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1492 (score (or (nth 1 kill) gnus-score-interactive-default-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1493 (date (nth 2 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1494 (found nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1495 (match-func (if (or (eq type '>) (eq type '<) (eq type '<=)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1496 (eq type '>=) (eq type '=))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1497 type
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1498 (error "Illegal match type: %s" type)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1499 (articles gnus-scores-articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1500 ;; Instead of doing all the clever stuff that
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1501 ;; `gnus-score-string' does to minimize searches and stuff,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1502 ;; I will assume that people generally will put so few
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1503 ;; matches on numbers that any cleverness will take more
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1504 ;; time than one would gain.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1505 (while articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1506 (when (funcall match-func
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1507 (or (aref (caar articles) gnus-score-index) 0)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1508 match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1509 (when trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1510 (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1511 gnus-score-trace))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1512 (setq found t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1513 (setcdr (car articles) (+ score (cdar articles))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1514 (setq articles (cdr articles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1515 ;; Update expire date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1516 (cond ((null date)) ;Permanent entry.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1517 ((and found gnus-update-score-entry-dates) ;Match, update date.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1518 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1519 (setcar (nthcdr 2 kill) now))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1520 ((and expire (< date expire)) ;Old entry, remove.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1521 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1522 (setcdr entries (cdr rest))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1523 (setq rest entries)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1524 (setq entries rest)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1525 nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1526
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1527 (defun gnus-score-date (scores header now expire &optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1528 (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1529 entries alist match match-func article)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1530
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1531 ;; Find matches.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1532 (while scores
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1533 (setq alist (car scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1534 scores (cdr scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1535 entries (assoc header alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1536 (while (cdr entries) ;First entry is the header index.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1537 (let* ((rest (cdr entries))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1538 (kill (car rest))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1539 (type (or (nth 3 kill) 'before))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1540 (score (or (nth 1 kill) gnus-score-interactive-default-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1541 (date (nth 2 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1542 (found nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1543 (articles gnus-scores-articles)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1544 l)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1545 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1546 ((eq type 'after)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1547 (setq match-func 'string<
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1548 match (gnus-date-iso8601 (nth 0 kill))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1549 ((eq type 'before)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1550 (setq match-func 'gnus-string>
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1551 match (gnus-date-iso8601 (nth 0 kill))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1552 ((eq type 'at)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1553 (setq match-func 'string=
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1554 match (gnus-date-iso8601 (nth 0 kill))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1555 ((eq type 'regexp)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1556 (setq match-func 'string-match
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1557 match (nth 0 kill)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1558 (t (error "Illegal match type: %s" type)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1559 ;; Instead of doing all the clever stuff that
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1560 ;; `gnus-score-string' does to minimize searches and stuff,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1561 ;; I will assume that people generally will put so few
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1562 ;; matches on numbers that any cleverness will take more
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1563 ;; time than one would gain.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1564 (while (setq article (pop articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1565 (when (and
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1566 (setq l (aref (car article) gnus-score-index))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1567 (funcall match-func match (gnus-date-iso8601 l)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1568 (when trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1569 (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1570 gnus-score-trace))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1571 (setq found t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1572 (setcdr article (+ score (cdr article)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1573 ;; Update expire date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1574 (cond ((null date)) ;Permanent entry.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1575 ((and found gnus-update-score-entry-dates) ;Match, update date.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1576 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1577 (setcar (nthcdr 2 kill) now))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1578 ((and expire (< date expire)) ;Old entry, remove.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1579 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1580 (setcdr entries (cdr rest))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1581 (setq rest entries)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1582 (setq entries rest)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1583 nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1584
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1585 (defun gnus-score-body (scores header now expire &optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1586 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1587 (setq gnus-scores-articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1588 (sort gnus-scores-articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1589 (lambda (a1 a2)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1590 (< (mail-header-number (car a1))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1591 (mail-header-number (car a2))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1592 (set-buffer nntp-server-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1593 (save-restriction
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1594 (let* ((buffer-read-only nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1595 (articles gnus-scores-articles)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1596 (all-scores scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1597 (request-func (cond ((string= "head" header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1598 'gnus-request-head)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1599 ((string= "body" header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1600 'gnus-request-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1601 (t 'gnus-request-article)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1602 entries alist ofunc article last)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1603 (when articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1604 (setq last (mail-header-number (caar (last articles))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1605 ;; Not all backends support partial fetching. In that case,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1606 ;; we just fetch the entire article.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1607 (unless (gnus-check-backend-function
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1608 (and (string-match "^gnus-" (symbol-name request-func))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1609 (intern (substring (symbol-name request-func)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1610 (match-end 0))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1611 gnus-newsgroup-name)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1612 (setq ofunc request-func)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1613 (setq request-func 'gnus-request-article))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1614 (while articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1615 (setq article (mail-header-number (caar articles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1616 (gnus-message 7 "Scoring on article %s of %s..." article last)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1617 (when (funcall request-func article gnus-newsgroup-name)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1618 (widen)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1619 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1620 ;; If just parts of the article is to be searched, but the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1621 ;; backend didn't support partial fetching, we just narrow
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1622 ;; to the relevant parts.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1623 (when ofunc
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1624 (if (eq ofunc 'gnus-request-head)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1625 (narrow-to-region
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1626 (point)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1627 (or (search-forward "\n\n" nil t) (point-max)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1628 (narrow-to-region
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1629 (or (search-forward "\n\n" nil t) (point))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1630 (point-max))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1631 (setq scores all-scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1632 ;; Find matches.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1633 (while scores
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1634 (setq alist (pop scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1635 entries (assoc header alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1636 (while (cdr entries) ;First entry is the header index.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1637 (let* ((rest (cdr entries))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1638 (kill (car rest))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1639 (match (nth 0 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1640 (type (or (nth 3 kill) 's))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1641 (score (or (nth 1 kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1642 gnus-score-interactive-default-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1643 (date (nth 2 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1644 (found nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1645 (case-fold-search
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1646 (not (or (eq type 'R) (eq type 'S)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1647 (eq type 'Regexp) (eq type 'String))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1648 (search-func
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1649 (cond ((or (eq type 'r) (eq type 'R)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1650 (eq type 'regexp) (eq type 'Regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1651 're-search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1652 ((or (eq type 's) (eq type 'S)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1653 (eq type 'string) (eq type 'String))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1654 'search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1655 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1656 (error "Illegal match type: %s" type)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1657 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1658 (when (funcall search-func match nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1659 ;; Found a match, update scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1660 (setcdr (car articles) (+ score (cdar articles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1661 (setq found t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1662 (when trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1663 (push
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1664 (cons (car-safe (rassq alist gnus-score-cache)) kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1665 gnus-score-trace)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1666 ;; Update expire date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1667 (unless trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1668 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1669 ((null date)) ;Permanent entry.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1670 ((and found gnus-update-score-entry-dates)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1671 ;; Match, update date.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1672 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1673 (setcar (nthcdr 2 kill) now))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1674 ((and expire (< date expire)) ;Old entry, remove.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1675 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1676 (setcdr entries (cdr rest))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1677 (setq rest entries))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1678 (setq entries rest)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1679 (setq articles (cdr articles)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1680 nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1681
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1682 (defun gnus-score-thread (scores header now expire &optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1683 (gnus-score-followup scores header now expire trace t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1684
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1685 (defun gnus-score-followup (scores header now expire &optional trace thread)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1686 ;; Insert the unique article headers in the buffer.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1687 (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1688 (current-score-file gnus-current-score-file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1689 (all-scores scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1690 ;; gnus-score-index is used as a free variable.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1691 alike last this art entries alist articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1692 new news)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1693
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1694 ;; Change score file to the adaptive score file. All entries that
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1695 ;; this function makes will be put into this file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1696 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1697 (set-buffer gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1698 (gnus-score-load-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1699 (or gnus-newsgroup-adaptive-score-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1700 (gnus-score-file-name
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1701 gnus-newsgroup-name gnus-adaptive-file-suffix))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1702
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1703 (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1704 articles gnus-scores-articles)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1705
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1706 (erase-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1707 (while articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1708 (setq art (car articles)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1709 this (aref (car art) gnus-score-index)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1710 articles (cdr articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1711 (if (equal last this)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1712 (push art alike)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1713 (when last
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1714 (insert last ?\n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1715 (put-text-property (1- (point)) (point) 'articles alike))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1716 (setq alike (list art)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1717 last this)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1718 (when last ; Bwadr, duplicate code.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1719 (insert last ?\n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1720 (put-text-property (1- (point)) (point) 'articles alike))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1721
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1722 ;; Find matches.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1723 (while scores
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1724 (setq alist (car scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1725 scores (cdr scores)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1726 entries (assoc header alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1727 (while (cdr entries) ;First entry is the header index.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1728 (let* ((rest (cdr entries))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1729 (kill (car rest))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1730 (match (nth 0 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1731 (type (or (nth 3 kill) 's))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1732 (score (or (nth 1 kill) gnus-score-interactive-default-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1733 (date (nth 2 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1734 (found nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1735 (mt (aref (symbol-name type) 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1736 (case-fold-search
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1737 (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1738 (dmt (downcase mt))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1739 (search-func
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1740 (cond ((= dmt ?r) 're-search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1741 ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1742 (t (error "Illegal match type: %s" type))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1743 arts art)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1744 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1745 (if (= dmt ?e)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1746 (while (funcall search-func match nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1747 (and (= (progn (beginning-of-line) (point))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1748 (match-beginning 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1749 (= (progn (end-of-line) (point))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1750 (match-end 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1751 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1752 (setq found (setq arts (get-text-property
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1753 (point) 'articles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1754 ;; Found a match, update scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1755 (while arts
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1756 (setq art (car arts)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1757 arts (cdr arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1758 (gnus-score-add-followups
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1759 (car art) score all-scores thread))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1760 (end-of-line))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1761 (while (funcall search-func match nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1762 (end-of-line)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1763 (setq found (setq arts (get-text-property (point) 'articles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1764 ;; Found a match, update scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1765 (while (setq art (pop arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1766 (when (setq new (gnus-score-add-followups
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1767 (car art) score all-scores thread))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1768 (push new news)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1769 ;; Update expire date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1770 (cond ((null date)) ;Permanent entry.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1771 ((and found gnus-update-score-entry-dates) ;Match, update date.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1772 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1773 (setcar (nthcdr 2 kill) now))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1774 ((and expire (< date expire)) ;Old entry, remove.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1775 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1776 (setcdr entries (cdr rest))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1777 (setq rest entries)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1778 (setq entries rest))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1779 ;; We change the score file back to the previous one.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1780 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1781 (set-buffer gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1782 (gnus-score-load-file current-score-file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1783 (list (cons "references" news))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1784
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1785 (defun gnus-score-add-followups (header score scores &optional thread)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1786 "Add a score entry to the adapt file."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1787 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1788 (set-buffer gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1789 (let* ((id (mail-header-id header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1790 (scores (car scores))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1791 entry dont)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1792 ;; Don't enter a score if there already is one.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1793 (while (setq entry (pop scores))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1794 (and (equal "references" (car entry))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1795 (or (null (nth 3 (cadr entry)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1796 (eq 's (nth 3 (cadr entry))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1797 (assoc id entry)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1798 (setq dont t)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1799 (unless dont
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1800 (gnus-summary-score-entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1801 (if thread "thread" "references")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1802 id 's score (current-time-string) nil t)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1803
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1804 (defun gnus-score-string (score-list header now expire &optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1805 ;; Score ARTICLES according to HEADER in SCORE-LIST.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1806 ;; Update matching entries to NOW and remove unmatched entries older
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1807 ;; than EXPIRE.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1808
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1809 ;; Insert the unique article headers in the buffer.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1810 (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1811 ;; gnus-score-index is used as a free variable.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1812 alike last this art entries alist articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1813 fuzzies arts words kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1814
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1815 ;; Sorting the articles costs os O(N*log N) but will allow us to
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1816 ;; only match with each unique header. Thus the actual matching
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1817 ;; will be O(M*U) where M is the number of strings to match with,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1818 ;; and U is the number of unique headers. It is assumed (but
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1819 ;; untested) this will be a net win because of the large constant
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1820 ;; factor involved with string matching.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1821 (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1822 articles gnus-scores-articles)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1823
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1824 (erase-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1825 (while (setq art (pop articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1826 (setq this (aref (car art) gnus-score-index))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1827 (if (equal last this)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1828 ;; O(N*H) cons-cells used here, where H is the number of
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1829 ;; headers.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1830 (push art alike)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1831 (when last
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1832 ;; Insert the line, with a text property on the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1833 ;; terminating newline referring to the articles with
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1834 ;; this line.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1835 (insert last ?\n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1836 (put-text-property (1- (point)) (point) 'articles alike))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1837 (setq alike (list art)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1838 last this)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1839 (when last ; Bwadr, duplicate code.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1840 (insert last ?\n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1841 (put-text-property (1- (point)) (point) 'articles alike))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1842
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1843 ;; Go through all the score alists and pick out the entries
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1844 ;; for this header.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1845 (while score-list
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1846 (setq alist (pop score-list)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1847 ;; There's only one instance of this header for
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1848 ;; each score alist.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1849 entries (assoc header alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1850 (while (cdr entries) ;First entry is the header index.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1851 (let* ((kill (cadr entries))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1852 (match (nth 0 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1853 (type (or (nth 3 kill) 's))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1854 (score (or (nth 1 kill) gnus-score-interactive-default-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1855 (date (nth 2 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1856 (found nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1857 (mt (aref (symbol-name type) 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1858 (case-fold-search (not (memq mt '(?R ?S ?E ?F))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1859 (dmt (downcase mt))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1860 (search-func
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1861 (cond ((= dmt ?r) 're-search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1862 ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1863 ((= dmt ?w) nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1864 (t (error "Illegal match type: %s" type)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1865 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1866 ;; Fuzzy matches. We save these for later.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1867 ((= dmt ?f)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1868 (push (cons entries alist) fuzzies))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1869 ;; Word matches. Save these for even later.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1870 ((= dmt ?w)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1871 (push (cons entries alist) words))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1872 ;; Exact matches.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1873 ((= dmt ?e)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1874 ;; Do exact matching.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1875 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1876 (while (and (not (eobp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1877 (funcall search-func match nil t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1878 ;; Is it really exact?
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1879 (and (eolp)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1880 (= (gnus-point-at-bol) (match-beginning 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1881 ;; Yup.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1882 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1883 (setq found (setq arts (get-text-property
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1884 (point) 'articles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1885 ;; Found a match, update scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1886 (if trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1887 (while (setq art (pop arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1888 (setcdr art (+ score (cdr art)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1889 (push
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1890 (cons
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1891 (car-safe (rassq alist gnus-score-cache))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1892 kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1893 gnus-score-trace))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1894 (while (setq art (pop arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1895 (setcdr art (+ score (cdr art)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1896 (forward-line 1)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1897 ;; Regexp and substring matching.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1898 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1899 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1900 (when (string= match "")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1901 (setq match "\n"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1902 (while (and (not (eobp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1903 (funcall search-func match nil t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1904 (goto-char (match-beginning 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1905 (end-of-line)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1906 (setq found (setq arts (get-text-property (point) 'articles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1907 ;; Found a match, update scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1908 (if trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1909 (while (setq art (pop arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1910 (setcdr art (+ score (cdr art)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1911 (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1912 gnus-score-trace))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1913 (while (setq art (pop arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1914 (setcdr art (+ score (cdr art)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1915 (forward-line 1))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1916 ;; Update expiry date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1917 (if trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1918 (setq entries (cdr entries))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1919 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1920 ;; Permanent entry.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1921 ((null date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1922 (setq entries (cdr entries)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1923 ;; We have a match, so we update the date.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1924 ((and found gnus-update-score-entry-dates)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1925 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1926 (setcar (nthcdr 2 kill) now)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1927 (setq entries (cdr entries)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1928 ;; This entry has expired, so we remove it.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1929 ((and expire (< date expire))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1930 (gnus-score-set 'touched '(t) alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1931 (setcdr entries (cddr entries)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1932 ;; No match; go to next entry.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1933 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1934 (setq entries (cdr entries))))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1935
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1936 ;; Find fuzzy matches.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1937 (when fuzzies
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1938 ;; Simplify the entire buffer for easy matching.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1939 (gnus-simplify-buffer-fuzzy)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1940 (while (setq kill (cadaar fuzzies))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1941 (let* ((match (nth 0 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1942 (type (nth 3 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1943 (score (or (nth 1 kill) gnus-score-interactive-default-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1944 (date (nth 2 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1945 (mt (aref (symbol-name type) 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1946 (case-fold-search (not (= mt ?F)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1947 found)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1948 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1949 (while (and (not (eobp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1950 (search-forward match nil t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1951 (when (and (= (gnus-point-at-bol) (match-beginning 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1952 (eolp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1953 (setq found (setq arts (get-text-property (point) 'articles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1954 (if trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1955 (while (setq art (pop arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1956 (setcdr art (+ score (cdr art)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1957 (push (cons
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1958 (car-safe (rassq (cdar fuzzies) gnus-score-cache))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1959 kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1960 gnus-score-trace))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1961 ;; Found a match, update scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1962 (while (setq art (pop arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1963 (setcdr art (+ score (cdr art))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1964 (forward-line 1))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1965 ;; Update expiry date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1966 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1967 ;; Permanent.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1968 ((null date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1969 )
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1970 ;; Match, update date.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1971 ((and found gnus-update-score-entry-dates)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1972 (gnus-score-set 'touched '(t) (cdar fuzzies))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1973 (setcar (nthcdr 2 kill) now))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1974 ;; Old entry, remove.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1975 ((and expire (< date expire))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1976 (gnus-score-set 'touched '(t) (cdar fuzzies))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1977 (setcdr (caar fuzzies) (cddaar fuzzies))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1978 (setq fuzzies (cdr fuzzies)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1979
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1980 (when words
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1981 ;; Enter all words into the hashtb.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1982 (let ((hashtb (gnus-make-hashtable
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1983 (* 10 (count-lines (point-min) (point-max))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1984 (gnus-enter-score-words-into-hashtb hashtb)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1985 (while (setq kill (cadaar words))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1986 (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1987 (date (nth 2 kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1988 found)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1989 (when (setq arts (intern-soft (nth 0 kill) hashtb))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1990 (setq arts (symbol-value arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1991 (setq found t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1992 (if trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1993 (while (setq art (pop arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1994 (setcdr art (+ score (cdr art)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1995 (push (cons
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1996 (car-safe (rassq (cdar words) gnus-score-cache))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1997 kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1998 gnus-score-trace))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1999 ;; Found a match, update scores.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2000 (while (setq art (pop arts))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2001 (setcdr art (+ score (cdr art))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2002 ;; Update expiry date
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2003 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2004 ;; Permanent.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2005 ((null date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2006 )
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2007 ;; Match, update date.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2008 ((and found gnus-update-score-entry-dates)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2009 (gnus-score-set 'touched '(t) (cdar words))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2010 (setcar (nthcdr 2 kill) now))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2011 ;; Old entry, remove.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2012 ((and expire (< date expire))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2013 (gnus-score-set 'touched '(t) (cdar words))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2014 (setcdr (caar words) (cddaar words))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2015 (setq words (cdr words))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2016 nil))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2017
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2018 (defun gnus-enter-score-words-into-hashtb (hashtb)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2019 ;; Find all the words in the buffer and enter them into
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2020 ;; the hashtable.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2021 (let ((syntab (syntax-table))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2022 word val)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2023 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2024 (unwind-protect
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2025 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2026 (set-syntax-table gnus-adaptive-word-syntax-table)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2027 (while (re-search-forward "\\b\\w+\\b" nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2028 (setq val
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2029 (gnus-gethash
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2030 (setq word (downcase (buffer-substring
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2031 (match-beginning 0) (match-end 0))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2032 hashtb))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2033 (gnus-sethash
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2034 word
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2035 (append (get-text-property (gnus-point-at-eol) 'articles) val)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2036 hashtb)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2037 (set-syntax-table syntab))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2038 ;; Make all the ignorable words ignored.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2039 (let ((ignored (append gnus-ignored-adaptive-words
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2040 gnus-default-ignored-adaptive-words)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2041 (while ignored
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2042 (gnus-sethash (pop ignored) nil hashtb)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2043
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2044 (defun gnus-score-string< (a1 a2)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2045 ;; Compare headers in articles A2 and A2.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2046 ;; The header index used is the free variable `gnus-score-index'.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2047 (string-lessp (aref (car a1) gnus-score-index)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2048 (aref (car a2) gnus-score-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2049
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2050 (defun gnus-current-score-file-nondirectory (&optional score-file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2051 (let ((score-file (or score-file gnus-current-score-file)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2052 (if score-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2053 (gnus-short-group-name (file-name-nondirectory score-file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2054 "none")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2055
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2056 (defun gnus-score-adaptive ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2057 "Create adaptive score rules for this newsgroup."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2058 (when gnus-newsgroup-adaptive
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2059 ;; We change the score file to the adaptive score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2060 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2061 (set-buffer gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2062 (gnus-score-load-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2063 (or gnus-newsgroup-adaptive-score-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2064 (gnus-score-file-name
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2065 gnus-newsgroup-name gnus-adaptive-file-suffix))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2066 ;; Perform ordinary line scoring.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2067 (when (or (not (listp gnus-newsgroup-adaptive))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2068 (memq 'line gnus-newsgroup-adaptive))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2069 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2070 (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2071 (alist malist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2072 (date (current-time-string))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2073 (data gnus-newsgroup-data)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2074 elem headers match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2075 ;; First we transform the adaptive rule alist into something
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2076 ;; that's faster to process.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2077 (while malist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2078 (setq elem (car malist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2079 (when (symbolp (car elem))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2080 (setcar elem (symbol-value (car elem))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2081 (setq elem (cdr elem))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2082 (while elem
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2083 (setcdr (car elem)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2084 (cons (if (eq (caar elem) 'followup)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2085 "references"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2086 (symbol-name (caar elem)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2087 (cdar elem)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2088 (setcar (car elem)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2089 `(lambda (h)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2090 (,(intern
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2091 (concat "mail-header-"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2092 (if (eq (caar elem) 'followup)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2093 "message-id"
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2094 (downcase (symbol-name (caar elem))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2095 h)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2096 (setq elem (cdr elem)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2097 (setq malist (cdr malist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2098 ;; Then we score away.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2099 (while data
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2100 (setq elem (cdr (assq (gnus-data-mark (car data)) alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2101 (if (or (not elem)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2102 (gnus-data-pseudo-p (car data)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2103 ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2104 (when (setq headers (gnus-data-header (car data)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2105 (while elem
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2106 (setq match (funcall (caar elem) headers))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2107 (gnus-summary-score-entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2108 (nth 1 (car elem)) match
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2109 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2110 ((numberp match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2111 '=)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2112 ((equal (nth 1 (car elem)) "date")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2113 'a)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2114 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2115 ;; Whether we use substring or exact matches is
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2116 ;; controlled here.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2117 (if (or (not gnus-score-exact-adapt-limit)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2118 (< (length match) gnus-score-exact-adapt-limit))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2119 'e
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2120 (if (equal (nth 1 (car elem)) "subject")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2121 'f 's))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2122 (nth 2 (car elem)) date nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2123 (setq elem (cdr elem)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2124 (setq data (cdr data))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2125
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2126 ;; Perform adaptive word scoring.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2127 (when (and (listp gnus-newsgroup-adaptive)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2128 (memq 'word gnus-newsgroup-adaptive))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2129 (nnheader-temp-write nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2130 (let* ((hashtb (gnus-make-hashtable 1000))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2131 (date (gnus-day-number (current-time-string)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2132 (data gnus-newsgroup-data)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2133 (syntab (syntax-table))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2134 word d score val)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2135 (unwind-protect
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2136 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2137 (set-syntax-table gnus-adaptive-word-syntax-table)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2138 ;; Go through all articles.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2139 (while (setq d (pop data))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2140 (when (and
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2141 (not (gnus-data-pseudo-p d))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2142 (setq score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2143 (cdr (assq
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2144 (gnus-data-mark d)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2145 gnus-adaptive-word-score-alist))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2146 ;; This article has a mark that should lead to
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2147 ;; adaptive word rules, so we insert the subject
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2148 ;; and find all words in that string.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2149 (insert (mail-header-subject (gnus-data-header d)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2150 (downcase-region (point-min) (point-max))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2151 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2152 (while (re-search-forward "\\b\\w+\\b" nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2153 ;; Put the word and score into the hashtb.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2154 (setq val (gnus-gethash (setq word (match-string 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2155 hashtb))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2156 (gnus-sethash word (+ (or val 0) score) hashtb))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2157 (erase-buffer))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2158 (set-syntax-table syntab))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2159 ;; Make all the ignorable words ignored.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2160 (let ((ignored (append gnus-ignored-adaptive-words
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2161 gnus-default-ignored-adaptive-words)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2162 (while ignored
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2163 (gnus-sethash (pop ignored) nil hashtb)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2164 ;; Now we have all the words and scores, so we
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2165 ;; add these rules to the ADAPT file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2166 (set-buffer gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2167 (mapatoms
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2168 (lambda (word)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2169 (when (symbol-value word)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2170 (gnus-summary-score-entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2171 "subject" (symbol-name word) 'w (symbol-value word)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2172 date nil t)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2173 hashtb))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2174
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2175 (defun gnus-score-edit-done ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2176 (let ((bufnam (buffer-file-name (current-buffer)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2177 (winconf gnus-prev-winconf))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2178 (when winconf
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2179 (set-window-configuration winconf))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2180 (gnus-score-remove-from-cache bufnam)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2181 (gnus-score-load-file bufnam)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2182
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2183 (defun gnus-score-find-trace ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2184 "Find all score rules that applies to the current article."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2185 (interactive)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2186 (let ((old-scored gnus-newsgroup-scored))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2187 (let ((gnus-newsgroup-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2188 (list (gnus-summary-article-header)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2189 (gnus-newsgroup-scored nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2190 trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2191 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2192 (nnheader-set-temp-buffer "*Score Trace*"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2193 (setq gnus-score-trace nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2194 (gnus-possibly-score-headers 'trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2195 (if (not (setq trace gnus-score-trace))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2196 (gnus-error
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2197 1 "No score rules apply to the current article (default score %d)."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2198 gnus-summary-default-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2199 (set-buffer "*Score Trace*")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2200 (gnus-add-current-to-buffer-list)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2201 (while trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2202 (insert (format "%S -> %s\n" (cdar trace)
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2203 (if (caar trace)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2204 (file-name-nondirectory (caar trace))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2205 "(non-file rule)")))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2206 (setq trace (cdr trace)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2207 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2208 (gnus-configure-windows 'score-trace)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2209 (set-buffer gnus-summary-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2210 (setq gnus-newsgroup-scored old-scored)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2211
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2212 (defun gnus-score-find-favourite-words ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2213 "List words used in scoring."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2214 (interactive)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2215 (let ((alists (gnus-score-load-files (gnus-all-score-files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2216 alist rule rules kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2217 ;; Go through all the score alists for this group
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2218 ;; and find all `w' rules.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2219 (while (setq alist (pop alists))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2220 (while (setq rule (pop alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2221 (when (and (stringp (car rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2222 (equal "subject" (downcase (pop rule))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2223 (while (setq kill (pop rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2224 (when (memq (nth 3 kill) '(w W word Word))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2225 (push (cons (or (nth 1 kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2226 gnus-score-interactive-default-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2227 (car kill))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2228 rules))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2229 (setq rules (sort rules (lambda (r1 r2)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2230 (string-lessp (cdr r1) (cdr r2)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2231 ;; Add up words that have appeared several times.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2232 (let ((r rules))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2233 (while (cdr r)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2234 (if (equal (cdar r) (cdadr r))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2235 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2236 (setcar (car r) (+ (caar r) (caadr r)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2237 (setcdr r (cddr r)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2238 (pop r))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2239 ;; Insert the words.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2240 (nnheader-set-temp-buffer "*Score Words*")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2241 (if (not (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2242 (gnus-error 3 "No word score rules")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2243 (while rules
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2244 (insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2245 (pop rules))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2246 (gnus-add-current-to-buffer-list)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2247 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2248 (gnus-configure-windows 'score-words))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2249
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2250 (defun gnus-summary-rescore ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2251 "Redo the entire scoring process in the current summary."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2252 (interactive)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2253 (gnus-score-save)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2254 (setq gnus-score-cache nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2255 (setq gnus-newsgroup-scored nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2256 (gnus-possibly-score-headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2257 (gnus-score-update-all-lines))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2258
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2259 (defun gnus-score-flush-cache ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2260 "Flush the cache of score files."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2261 (interactive)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2262 (gnus-score-save)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2263 (setq gnus-score-cache nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2264 gnus-score-alist nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2265 gnus-short-name-score-file-cache nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2266 (gnus-message 6 "The score cache is now flushed"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2267
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2268 (gnus-add-shutdown 'gnus-score-close 'gnus)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2269
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2270 (defvar gnus-score-file-alist-cache nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2271
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2272 (defun gnus-score-close ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2273 "Clear all internal score variables."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2274 (setq gnus-score-cache nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2275 gnus-internal-global-score-files nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2276 gnus-score-file-list nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2277 gnus-score-file-alist-cache nil))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2278
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2279 ;; Summary score marking commands.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2280
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2281 (defun gnus-summary-raise-same-subject-and-select (score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2282 "Raise articles which has the same subject with SCORE and select the next."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2283 (interactive "p")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2284 (let ((subject (gnus-summary-article-subject)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2285 (gnus-summary-raise-score score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2286 (while (gnus-summary-find-subject subject)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2287 (gnus-summary-raise-score score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2288 (gnus-summary-next-article t)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2289
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2290 (defun gnus-summary-raise-same-subject (score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2291 "Raise articles which has the same subject with SCORE."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2292 (interactive "p")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2293 (let ((subject (gnus-summary-article-subject)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2294 (gnus-summary-raise-score score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2295 (while (gnus-summary-find-subject subject)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2296 (gnus-summary-raise-score score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2297 (gnus-summary-next-subject 1 t)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2298
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2299 (defun gnus-score-default (level)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2300 (if level (prefix-numeric-value level)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2301 gnus-score-interactive-default-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2302
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2303 (defun gnus-summary-raise-thread (&optional score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2304 "Raise the score of the articles in the current thread with SCORE."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2305 (interactive "P")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2306 (setq score (gnus-score-default score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2307 (let (e)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2308 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2309 (let ((articles (gnus-summary-articles-in-thread)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2310 (while articles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2311 (gnus-summary-goto-subject (car articles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2312 (gnus-summary-raise-score score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2313 (setq articles (cdr articles))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2314 (setq e (point)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2315 (let ((gnus-summary-check-current t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2316 (unless (zerop (gnus-summary-next-subject 1 t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2317 (goto-char e))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2318 (gnus-summary-recenter)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2319 (gnus-summary-position-point)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2320 (gnus-set-mode-line 'summary))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2321
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2322 (defun gnus-summary-lower-same-subject-and-select (score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2323 "Raise articles which has the same subject with SCORE and select the next."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2324 (interactive "p")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2325 (gnus-summary-raise-same-subject-and-select (- score)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2326
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2327 (defun gnus-summary-lower-same-subject (score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2328 "Raise articles which has the same subject with SCORE."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2329 (interactive "p")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2330 (gnus-summary-raise-same-subject (- score)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2331
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2332 (defun gnus-summary-lower-thread (&optional score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2333 "Lower score of articles in the current thread with SCORE."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2334 (interactive "P")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2335 (gnus-summary-raise-thread (- (1- (gnus-score-default score)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2336
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2337 ;;; Finding score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2338
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2339 (defun gnus-score-score-files (group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2340 "Return a list of all possible score files."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2341 ;; Search and set any global score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2342 (when gnus-global-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2343 (unless gnus-internal-global-score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2344 (gnus-score-search-global-directories gnus-global-score-files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2345 ;; Fix the kill-file dir variable.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2346 (setq gnus-kill-files-directory
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2347 (file-name-as-directory gnus-kill-files-directory))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2348 ;; If we can't read it, there are no score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2349 (if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2350 (setq gnus-score-file-list nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2351 (if (not (gnus-use-long-file-name 'not-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2352 ;; We do not use long file names, so we have to do some
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2353 ;; directory traversing.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2354 (setq gnus-score-file-list
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2355 (cons nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2356 (or gnus-short-name-score-file-cache
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2357 (prog2
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2358 (gnus-message 6 "Finding all score files...")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2359 (setq gnus-short-name-score-file-cache
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2360 (gnus-score-score-files-1
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2361 gnus-kill-files-directory))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2362 (gnus-message 6 "Finding all score files...done")))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2363 ;; We want long file names.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2364 (when (or (not gnus-score-file-list)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2365 (not (car gnus-score-file-list))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2366 (gnus-file-newer-than gnus-kill-files-directory
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2367 (car gnus-score-file-list)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2368 (setq gnus-score-file-list
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2369 (cons (nth 5 (file-attributes gnus-kill-files-directory))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2370 (nreverse
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2371 (directory-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2372 gnus-kill-files-directory t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2373 (gnus-score-file-regexp)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2374 (cdr gnus-score-file-list)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2375
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2376 (defun gnus-score-score-files-1 (dir)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2377 "Return all possible score files under DIR."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2378 (let ((files (list (expand-file-name dir)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2379 (regexp (gnus-score-file-regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2380 (case-fold-search nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2381 seen out file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2382 (while (setq file (pop files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2383 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2384 ;; Ignore "." and "..".
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2385 ((member (file-name-nondirectory file) '("." ".."))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2386 nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2387 ;; Add subtrees of directory to also be searched.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2388 ((and (file-directory-p file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2389 (not (member (file-truename file) seen)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2390 (push (file-truename file) seen)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2391 (setq files (nconc (directory-files file t nil t) files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2392 ;; Add files to the list of score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2393 ((string-match regexp file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2394 (push file out))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2395 (or out
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2396 ;; Return a dummy value.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2397 (list "~/News/this.file.does.not.exist.SCORE"))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2398
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2399 (defun gnus-score-file-regexp ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2400 "Return a regexp that match all score files."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2401 (concat "\\(" (regexp-quote gnus-score-file-suffix )
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2402 "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2403
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2404 (defun gnus-score-find-bnews (group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2405 "Return a list of score files for GROUP.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2406 The score files are those files in the ~/News/ directory which matches
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2407 GROUP using BNews sys file syntax."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2408 (let* ((sfiles (append (gnus-score-score-files group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2409 gnus-internal-global-score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2410 (kill-dir (file-name-as-directory
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2411 (expand-file-name gnus-kill-files-directory)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2412 (klen (length kill-dir))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2413 (score-regexp (gnus-score-file-regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2414 (trans (cdr (assq ?: nnheader-file-name-translation-alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2415 ofiles not-match regexp)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2416 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2417 (set-buffer (get-buffer-create "*gnus score files*"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2418 (buffer-disable-undo (current-buffer))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2419 ;; Go through all score file names and create regexp with them
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2420 ;; as the source.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2421 (while sfiles
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2422 (erase-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2423 (insert (car sfiles))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2424 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2425 ;; First remove the suffix itself.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2426 (when (re-search-forward (concat "." score-regexp) nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2427 (replace-match "" t t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2428 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2429 (if (looking-at (regexp-quote kill-dir))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2430 ;; If the file name was just "SCORE", `klen' is one character
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2431 ;; too much.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2432 (delete-char (min (1- (point-max)) klen))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2433 (goto-char (point-max))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2434 (search-backward "/")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2435 (delete-region (1+ (point)) (point-min)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2436 ;; If short file names were used, we have to translate slashes.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2437 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2438 (let ((regexp (concat
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2439 "[/:" (if trans (char-to-string trans) "") "]")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2440 (while (re-search-forward regexp nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2441 (replace-match "." t t)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2442 ;; Kludge to get rid of "nntp+" problems.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2443 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2444 (when (looking-at "nn[a-z]+\\+")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2445 (search-forward "+")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2446 (forward-char -1)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2447 (insert "\\")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2448 (forward-char 1))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2449 ;; Kludge to deal with "++".
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2450 (while (search-forward "+" nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2451 (replace-match "\\+" t t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2452 ;; Translate "all" to ".*".
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2453 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2454 (while (search-forward "all" nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2455 (replace-match ".*" t t))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2456 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2457 ;; Deal with "not."s.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2458 (if (looking-at "not.")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2459 (progn
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2460 (setq not-match t)
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2461 (setq regexp (concat "^" (buffer-substring 5 (point-max)) "$")))
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2462 (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$"))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2463 (setq not-match nil))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2464 ;; Finally - if this resulting regexp matches the group name,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2465 ;; we add this score file to the list of score files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2466 ;; applicable to this group.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2467 (when (or (and not-match
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2468 (not (string-match regexp group)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2469 (and (not not-match)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2470 (string-match regexp group)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2471 (push (car sfiles) ofiles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2472 (setq sfiles (cdr sfiles)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2473 (kill-buffer (current-buffer))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2474 ;; Slight kludge here - the last score file returned should be
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2475 ;; the local score file, whether it exists or not. This is so
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2476 ;; that any score commands the user enters will go to the right
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2477 ;; file, and not end up in some global score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2478 (let ((localscore (gnus-score-file-name group)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2479 (setq ofiles (cons localscore (delete localscore ofiles))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2480 (gnus-sort-score-files (nreverse ofiles)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2481
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2482 (defun gnus-score-find-single (group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2483 "Return list containing the score file for GROUP."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2484 (list (or gnus-newsgroup-adaptive-score-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2485 (gnus-score-file-name group gnus-adaptive-file-suffix))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2486 (gnus-score-file-name group)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2487
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2488 (defun gnus-score-find-hierarchical (group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2489 "Return list of score files for GROUP.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2490 This includes the score file for the group and all its parents."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2491 (let* ((prefix (gnus-group-real-prefix group))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2492 (all (list nil))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2493 (group (gnus-group-real-name group))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2494 (start 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2495 (while (string-match "\\." group (1+ start))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2496 (setq start (match-beginning 0))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2497 (push (substring group 0 start) all))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2498 (push group all)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2499 (setq all
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2500 (nconc
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2501 (mapcar (lambda (group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2502 (gnus-score-file-name group gnus-adaptive-file-suffix))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2503 (setq all (nreverse all)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2504 (mapcar 'gnus-score-file-name all)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2505 (if (equal prefix "")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2506 all
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2507 (mapcar
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2508 (lambda (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2509 (nnheader-translate-file-chars
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2510 (concat (file-name-directory file) prefix
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2511 (file-name-nondirectory file))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2512 all))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2513
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2514 (defun gnus-score-file-rank (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2515 "Return a number that says how specific score FILE is.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2516 Destroys the current buffer."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2517 (if (member file gnus-internal-global-score-files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2518 0
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2519 (when (string-match
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2520 (concat "^" (regexp-quote
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2521 (expand-file-name
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2522 (file-name-as-directory gnus-kill-files-directory))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2523 file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2524 (setq file (substring file (match-end 0))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2525 (insert file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2526 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2527 (let ((beg (point))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2528 elems)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2529 (while (re-search-forward "[./]" nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2530 (push (buffer-substring beg (1- (point)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2531 elems))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2532 (erase-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2533 (setq elems (delete "all" elems))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2534 (length elems))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2535
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2536 (defun gnus-sort-score-files (files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2537 "Sort FILES so that the most general files come first."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2538 (nnheader-temp-write nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2539 (let ((alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2540 (mapcar
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2541 (lambda (file)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2542 (cons (inline (gnus-score-file-rank file)) file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2543 files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2544 (mapcar
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2545 (lambda (f) (cdr f))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2546 (sort alist (lambda (f1 f2) (< (car f1) (car f2))))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2547
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2548 (defun gnus-score-find-alist (group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2549 "Return list of score files for GROUP.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2550 The list is determined from the variable gnus-score-file-alist."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2551 (let ((alist gnus-score-file-multiple-match-alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2552 score-files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2553 ;; if this group has been seen before, return the cached entry
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2554 (if (setq score-files (assoc group gnus-score-file-alist-cache))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2555 (cdr score-files) ;ensures caching groups with no matches
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2556 ;; handle the multiple match alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2557 (while alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2558 (when (string-match (caar alist) group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2559 (setq score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2560 (nconc score-files (copy-sequence (cdar alist)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2561 (setq alist (cdr alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2562 (setq alist gnus-score-file-single-match-alist)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2563 ;; handle the single match alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2564 (while alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2565 (when (string-match (caar alist) group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2566 ;; progn used just in case ("regexp") has no files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2567 ;; and score-files is still nil. -sj
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2568 ;; this can be construed as a "stop searching here" feature :>
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2569 ;; and used to simplify regexps in the single-alist
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2570 (setq score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2571 (nconc score-files (copy-sequence (cdar alist))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2572 (setq alist nil))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2573 (setq alist (cdr alist)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2574 ;; cache the score files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2575 (push (cons group score-files) gnus-score-file-alist-cache)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2576 score-files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2577
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2578 (defun gnus-all-score-files (&optional group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2579 "Return a list of all score files for the current group."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2580 (let ((funcs gnus-score-find-score-files-function)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2581 (group (or group gnus-newsgroup-name))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2582 score-files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2583 ;; Make sure funcs is a list.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2584 (and funcs
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2585 (not (listp funcs))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2586 (setq funcs (list funcs)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2587 ;; Get the initial score files for this group.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2588 (when funcs
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2589 (setq score-files (nreverse (gnus-score-find-alist group))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2590 ;; Add any home adapt files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2591 (let ((home (gnus-home-score-file group t)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2592 (when home
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2593 (push home score-files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2594 (setq gnus-newsgroup-adaptive-score-file home)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2595 ;; Check whether there is a `adapt-file' group parameter.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2596 (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2597 (when param-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2598 (push param-file score-files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2599 (setq gnus-newsgroup-adaptive-score-file param-file)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2600 ;; Go through all the functions for finding score files (or actual
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2601 ;; scores) and add them to a list.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2602 (while funcs
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2603 (when (gnus-functionp (car funcs))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2604 (setq score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2605 (nconc score-files (nreverse (funcall (car funcs) group)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2606 (setq funcs (cdr funcs)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2607 ;; Add any home score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2608 (let ((home (gnus-home-score-file group)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2609 (when home
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2610 (push home score-files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2611 ;; Check whether there is a `score-file' group parameter.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2612 (let ((param-file (gnus-group-find-parameter group 'score-file)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2613 (when param-file
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2614 (push param-file score-files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2615 ;; Expand all files names.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2616 (let ((files score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2617 (while files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2618 (when (stringp (car files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2619 (setcar files (expand-file-name
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2620 (car files) gnus-kill-files-directory)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2621 (pop files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2622 (setq score-files (nreverse score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2623 ;; Remove any duplicate score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2624 (while (and score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2625 (member (car score-files) (cdr score-files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2626 (pop score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2627 (let ((files score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2628 (while (cdr files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2629 (if (member (cadr files) (cddr files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2630 (setcdr files (cddr files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2631 (pop files))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2632 ;; Do the scoring if there are any score files for this group.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2633 score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2634
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2635 (defun gnus-possibly-score-headers (&optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2636 "Do scoring if scoring is required."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2637 (let ((score-files (gnus-all-score-files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2638 (when score-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2639 (gnus-score-headers score-files trace))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2640
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2641 (defun gnus-score-file-name (newsgroup &optional suffix)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2642 "Return the name of a score file for NEWSGROUP."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2643 (let ((suffix (or suffix gnus-score-file-suffix)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2644 (nnheader-translate-file-chars
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2645 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2646 ((or (null newsgroup)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2647 (string-equal newsgroup ""))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2648 ;; The global score file is placed at top of the directory.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2649 (expand-file-name
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2650 suffix gnus-kill-files-directory))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2651 ((gnus-use-long-file-name 'not-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2652 ;; Append ".SCORE" to newsgroup name.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2653 (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2654 "." suffix)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2655 gnus-kill-files-directory))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2656 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2657 ;; Place "SCORE" under the hierarchical directory.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2658 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2659 "/" suffix)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2660 gnus-kill-files-directory))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2661
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2662 (defun gnus-score-search-global-directories (files)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2663 "Scan all global score directories for score files."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2664 ;; Set the variable `gnus-internal-global-score-files' to all
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2665 ;; available global score files.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2666 (interactive (list gnus-global-score-files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2667 (let (out)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2668 (while files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2669 (if (string-match "/$" (car files))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2670 (setq out (nconc (directory-files
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2671 (car files) t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2672 (concat (gnus-score-file-regexp) "$"))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2673 (push (car files) out))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2674 (setq files (cdr files)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2675 (setq gnus-internal-global-score-files out)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2676
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2677 (defun gnus-score-default-fold-toggle ()
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2678 "Toggle folding for new score file entries."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2679 (interactive)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2680 (setq gnus-score-default-fold (not gnus-score-default-fold))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2681 (if gnus-score-default-fold
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2682 (gnus-message 1 "New score file entries will be case insensitive.")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2683 (gnus-message 1 "New score file entries will be case sensitive.")))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2684
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2685 ;;; Home score file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2686
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2687 (defun gnus-home-score-file (group &optional adapt)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2688 "Return the home score file for GROUP.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2689 If ADAPT, return the home adaptive file instead."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2690 (let ((list (if adapt gnus-home-adapt-file gnus-home-score-file))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2691 elem found)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2692 ;; Make sure we have a list.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2693 (unless (listp list)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2694 (setq list (list list)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2695 ;; Go through the list and look for matches.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2696 (while (and (not found)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2697 (setq elem (pop list)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2698 (setq found
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2699 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2700 ;; Simple string.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2701 ((stringp elem)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2702 elem)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2703 ;; Function.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2704 ((gnus-functionp elem)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2705 (funcall elem group))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2706 ;; Regexp-file cons
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2707 ((consp elem)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2708 (when (string-match (car elem) group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2709 (cadr elem))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2710 (when found
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2711 (nnheader-concat gnus-kill-files-directory found))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2712
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2713 (defun gnus-hierarchial-home-score-file (group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2714 "Return the score file of the top-level hierarchy of GROUP."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2715 (if (string-match "^[^.]+\\." group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2716 (concat (match-string 0 group) gnus-score-file-suffix)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2717 ;; Group name without any dots.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2718 (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2719 gnus-score-file-suffix)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2720
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2721 (defun gnus-hierarchial-home-adapt-file (group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2722 "Return the adapt file of the top-level hierarchy of GROUP."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2723 (if (string-match "^[^.]+\\." group)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2724 (concat (match-string 0 group) gnus-adaptive-file-suffix)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2725 ;; Group name without any dots.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2726 (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2727 gnus-adaptive-file-suffix)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2728
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2729 ;;;
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2730 ;;; Score decays
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2731 ;;;
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2732
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2733 (defun gnus-decay-score (score)
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2734 "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'."
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2735 (floor
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2736 (- score
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2737 (* (if (< score 0) -1 1)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2738 (min (abs score)
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2739 (max gnus-score-decay-constant
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2740 (* (abs score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2741 gnus-score-decay-scale)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2742
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2743 (defun gnus-decay-scores (alist day)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2744 "Decay non-permanent scores in ALIST."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2745 (let ((times (- (gnus-time-to-day (current-time)) day))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2746 kill entry updated score n)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2747 (unless (zerop times) ;Done decays today already?
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2748 (while (setq entry (pop alist))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2749 (when (stringp (car entry))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2750 (setq entry (cdr entry))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2751 (while (setq kill (pop entry))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2752 (when (nth 2 kill)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2753 (setq updated t)
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2754 (setq score (or (nth 1 kill)
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2755 gnus-score-interactive-default-score)
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2756 n times)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2757 (while (natnump (decf n))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2758 (setq score (funcall gnus-decay-score-function score)))
19969
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2759 (setcdr kill (cons score
5f1ab3dd344d *** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
2760 (cdr (cdr kill)))))))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2761 ;; Return whether this score file needs to be saved. By Je-haysuss!
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2762 updated))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2763
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2764 (provide 'gnus-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2765
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2766 ;;; gnus-score.el ends here