annotate lisp/gnus-score.el @ 15559:8d8bf85d356a

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