|
17493
|
1 ;;; gnus-cus.el --- customization commands for Gnus
|
|
64754
|
2
|
|
|
3 ;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004,
|
|
106815
|
4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
|
17493
|
5
|
|
|
6 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
|
|
|
7 ;; Keywords: news
|
|
|
8
|
|
|
9 ;; This file is part of GNU Emacs.
|
|
|
10
|
|
94662
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
17493
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
94662
|
13 ;; the Free Software Foundation, either version 3 of the License, or
|
|
|
14 ;; (at your option) any later version.
|
|
17493
|
15
|
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
94662
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
17493
|
19 ;; GNU General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
94662
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
17493
|
23
|
|
|
24 ;;; Commentary:
|
|
|
25
|
|
|
26 ;;; Code:
|
|
|
27
|
|
|
28 (require 'wid-edit)
|
|
56927
|
29 (require 'gnus)
|
|
|
30 (require 'gnus-agent)
|
|
17493
|
31 (require 'gnus-score)
|
|
31716
|
32 (require 'gnus-topic)
|
|
56927
|
33 (require 'gnus-art)
|
|
17493
|
34
|
|
|
35 ;;; Widgets:
|
|
|
36
|
|
|
37 (defun gnus-custom-mode ()
|
|
|
38 "Major mode for editing Gnus customization buffers.
|
|
|
39
|
|
|
40 The following commands are available:
|
|
|
41
|
|
|
42 \\[widget-forward] Move to next button or editable field.
|
|
|
43 \\[widget-backward] Move to previous button or editable field.
|
|
|
44 \\[widget-button-click] Activate button under the mouse pointer.
|
|
|
45 \\[widget-button-press] Activate button under point.
|
|
|
46
|
|
|
47 Entry to this mode calls the value of `gnus-custom-mode-hook'
|
|
|
48 if that value is non-nil."
|
|
|
49 (kill-all-local-variables)
|
|
|
50 (setq major-mode 'gnus-custom-mode
|
|
|
51 mode-name "Gnus Customize")
|
|
68910
|
52 (use-local-map widget-keymap)
|
|
31716
|
53 ;; Emacs 21 stuff:
|
|
|
54 (when (and (facep 'custom-button-face)
|
|
|
55 (facep 'custom-button-pressed-face))
|
|
|
56 (set (make-local-variable 'widget-button-face)
|
|
|
57 'custom-button-face)
|
|
|
58 (set (make-local-variable 'widget-button-pressed-face)
|
|
|
59 'custom-button-pressed-face)
|
|
|
60 (set (make-local-variable 'widget-mouse-face)
|
|
|
61 'custom-button-pressed-face))
|
|
|
62 (when (and (boundp 'custom-raised-buttons)
|
|
|
63 (symbol-value 'custom-raised-buttons))
|
|
|
64 (set (make-local-variable 'widget-push-button-prefix) "")
|
|
|
65 (set (make-local-variable 'widget-push-button-suffix) "")
|
|
|
66 (set (make-local-variable 'widget-link-prefix) "")
|
|
|
67 (set (make-local-variable 'widget-link-suffix) ""))
|
|
62890
|
68 (gnus-run-mode-hooks 'gnus-custom-mode-hook))
|
|
17493
|
69
|
|
|
70 ;;; Group Customization:
|
|
|
71
|
|
|
72 (defconst gnus-group-parameters
|
|
56927
|
73 '((extra-aliases (choice
|
|
31716
|
74 :tag "Extra Aliases"
|
|
|
75 (list
|
|
|
76 :tag "List"
|
|
|
77 (editable-list
|
|
|
78 :inline t
|
|
|
79 (gnus-email-address :tag "Address")))
|
|
|
80 (gnus-email-address :tag "Address")) "\
|
|
|
81 Store messages posted from or to this address in this group.
|
|
|
82
|
|
|
83 You must be using gnus-group-split for this to work. The VALUE of the
|
|
|
84 nnmail-split-fancy SPLIT generated for this group will match these
|
|
|
85 addresses.")
|
|
|
86
|
|
|
87 (split-regexp (regexp :tag "gnus-group-split Regular Expression") "\
|
|
|
88 Like gnus-group-split Address, but expects a regular expression.")
|
|
|
89
|
|
|
90 (split-exclude (list :tag "gnus-group-split Restricts"
|
|
|
91 (editable-list
|
|
|
92 :inline t (regexp :tag "Restrict"))) "\
|
|
|
93 Regular expression that cancels gnus-group-split matches.
|
|
|
94
|
|
|
95 Each entry is added to the nnmail-split-fancy SPLIT as a separate
|
|
|
96 RESTRICT clause.")
|
|
|
97
|
|
|
98 (split-spec (choice :tag "gnus-group-split Overrider"
|
|
|
99 (sexp :tag "Fancy Split")
|
|
|
100 (const :tag "Catch All" catch-all)
|
|
|
101 (const :tag "Ignore" nil)) "\
|
|
|
102 Override all other gnus-group-split fields.
|
|
|
103
|
|
|
104 In `Fancy Split', you can enter any nnmail-split-fancy SPLIT. Note
|
|
|
105 that the name of this group won't be automatically assumed, you have
|
|
|
106 to add it to the SPLITs yourself. This means you can use such splits
|
|
|
107 to split messages to other groups too.
|
|
|
108
|
|
|
109 If you select `Catch All', this group will get postings for any
|
|
|
110 messages not matched in any other group. It overrides the variable
|
|
|
111 gnus-group-split-default-catch-all-group.
|
|
|
112
|
|
|
113 Selecting `Ignore' forces no SPLIT to be generated for this group,
|
|
|
114 disabling all other gnus-group-split fields.")
|
|
17493
|
115
|
|
|
116 (broken-reply-to (const :tag "Broken Reply To" t) "\
|
|
|
117 Ignore `Reply-To' headers in this group.
|
|
|
118
|
|
|
119 That can be useful if you're reading a mailing list group where the
|
|
|
120 listserv has inserted `Reply-To' headers that point back to the
|
|
|
121 listserv itself. This is broken behavior. So there!")
|
|
|
122
|
|
|
123 (to-group (string :tag "To Group") "\
|
|
31716
|
124 All posts will be sent to the specified group.")
|
|
17493
|
125
|
|
|
126 (gcc-self (choice :tag "GCC"
|
|
|
127 :value t
|
|
33173
|
128 (const :tag "To current group" t)
|
|
17493
|
129 (const none)
|
|
|
130 (string :format "%v" :hide-front-space t)) "\
|
|
|
131 Specify default value for GCC header.
|
|
|
132
|
50849
702762701b10
(gnus-group-parameters): Don't quote nil and t in docstrings.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
133 If this symbol is present in the group parameter list and set to t,
|
|
31716
|
134 new composed messages will be `Gcc''d to the current group. If it is
|
|
17493
|
135 present and set to `none', no `Gcc:' header will be generated, if it
|
|
|
136 is present and a string, this string will be inserted literally as a
|
|
|
137 `gcc' header (this symbol takes precedence over any default `Gcc'
|
|
|
138 rules as described later).")
|
|
|
139
|
|
|
140 (expiry-wait (choice :tag "Expire Wait"
|
|
|
141 :value never
|
|
|
142 (const never)
|
|
|
143 (const immediate)
|
|
|
144 (number :hide-front-space t
|
|
|
145 :format "%v")) "\
|
|
|
146 When to expire.
|
|
|
147
|
|
|
148 Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function'
|
|
31716
|
149 when expiring expirable messages. The value can either be a number of
|
|
17493
|
150 days (not necessarily an integer) or the symbols `never' or
|
|
|
151 `immediate'.")
|
|
|
152
|
|
31716
|
153 (expiry-target (choice :tag "Expiry Target"
|
|
56927
|
154 :value delete
|
|
|
155 (const delete)
|
|
|
156 (function :format "%v" nnmail-)
|
|
|
157 string) "\
|
|
31716
|
158 Where expired messages end up.
|
|
|
159
|
|
56927
|
160 Overrides `nnmail-expiry-target'.")
|
|
31716
|
161
|
|
17493
|
162 (score-file (file :tag "Score File") "\
|
|
|
163 Make the specified file into the current score file.
|
|
|
164 This means that all score commands you issue will end up in this file.")
|
|
|
165
|
|
|
166 (adapt-file (file :tag "Adapt File") "\
|
|
|
167 Make the specified file into the current adaptive file.
|
|
|
168 All adaptive score entries will be put into this file.")
|
|
|
169
|
|
|
170 (admin-address (gnus-email-address :tag "Admin Address") "\
|
|
|
171 Administration address for a mailing list.
|
|
|
172
|
|
|
173 When unsubscribing to a mailing list you should never send the
|
|
|
174 unsubscription notice to the mailing list itself. Instead, you'd
|
|
|
175 send messages to the administrative address. This parameter allows
|
|
|
176 you to put the admin address somewhere convenient.")
|
|
|
177
|
|
|
178 (display (choice :tag "Display"
|
|
|
179 :value default
|
|
|
180 (const all)
|
|
56927
|
181 (integer)
|
|
|
182 (const default)
|
|
|
183 (sexp :tag "Other")) "\
|
|
17493
|
184 Which articles to display on entering the group.
|
|
|
185
|
|
|
186 `all'
|
|
|
187 Display all articles, both read and unread.
|
|
|
188
|
|
56927
|
189 `integer'
|
|
|
190 Display the last NUMBER articles in the group. This is the same as
|
|
|
191 entering the group with C-u NUMBER.
|
|
|
192
|
|
17493
|
193 `default'
|
|
|
194 Display the default visible articles, which normally includes
|
|
56927
|
195 unread and ticked articles.
|
|
|
196
|
|
|
197 `Other'
|
|
|
198 Display the articles that satisfy the S-expression. The S-expression
|
|
|
199 should be in an array form.")
|
|
17493
|
200
|
|
|
201 (comment (string :tag "Comment") "\
|
|
24357
|
202 An arbitrary comment on the group.")
|
|
|
203
|
|
|
204 (visible (const :tag "Permanently visible" t) "\
|
|
56927
|
205 Always display this group, even when there are no unread articles in it.")
|
|
47937
|
206
|
|
|
207 (highlight-words
|
|
31716
|
208 (choice :tag "Highlight words"
|
|
|
209 :value nil
|
|
|
210 (repeat (list (regexp :tag "Highlight regexp")
|
|
|
211 (number :tag "Group for entire word" 0)
|
|
|
212 (number :tag "Group for displayed part" 0)
|
|
47937
|
213 (symbol :tag "Face"
|
|
31716
|
214 gnus-emphasis-highlight-words))))
|
|
|
215 "highlight regexps.
|
|
56927
|
216 See `gnus-emphasis-alist'.")
|
|
34752
|
217
|
|
|
218 (posting-style
|
|
|
219 (choice :tag "Posting style"
|
|
|
220 :value nil
|
|
|
221 (repeat (list
|
|
56927
|
222 (choice :tag "Type"
|
|
34752
|
223 :value nil
|
|
|
224 (const signature)
|
|
56927
|
225 (const signature-file)
|
|
|
226 (const organization)
|
|
|
227 (const address)
|
|
68129
|
228 (const x-face-file)
|
|
56927
|
229 (const name)
|
|
68129
|
230 (const body)
|
|
|
231 (symbol)
|
|
|
232 (string :tag "Header"))
|
|
34752
|
233 (string :format "%v"))))
|
|
|
234 "post style.
|
|
56927
|
235 See `gnus-posting-styles'."))
|
|
31716
|
236 "Alist of valid group or topic parameters.
|
|
17493
|
237
|
|
|
238 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
|
|
|
239 itself (a symbol), TYPE is the parameters type (a sexp widget), and
|
|
|
240 DOC is a documentation string for the parameter.")
|
|
|
241
|
|
31716
|
242 (defconst gnus-extra-topic-parameters
|
|
|
243 '((subscribe (regexp :tag "Subscribe") "\
|
|
56927
|
244 If `gnus-subscribe-newsgroup-method' or
|
|
|
245 `gnus-subscribe-options-newsgroup-method' is set to
|
|
31716
|
246 `gnus-subscribe-topics', new groups that matches this regexp will
|
|
56927
|
247 automatically be subscribed to this topic")
|
|
|
248 (subscribe-level (integer :tag "Subscribe Level" :value 1) "\
|
|
|
249 If this topic parameter is set, when new groups are subscribed
|
|
|
250 automatically under this topic (via the `subscribe' topic parameter)
|
|
|
251 assign this level to the group, rather than the default level
|
|
|
252 set in `gnus-level-default-subscribed'"))
|
|
31716
|
253 "Alist of topic parameters that are not also group parameters.
|
|
|
254
|
|
|
255 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
|
|
|
256 itself (a symbol), TYPE is the parameters type (a sexp widget), and
|
|
|
257 DOC is a documentation string for the parameter.")
|
|
|
258
|
|
|
259 (defconst gnus-extra-group-parameters
|
|
|
260 '((uidvalidity (string :tag "IMAP uidvalidity") "\
|
|
|
261 Server-assigned value attached to IMAP groups, used to maintain consistency."))
|
|
|
262 "Alist of group parameters that are not also topic parameters.
|
|
|
263
|
|
|
264 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
|
|
|
265 itself (a symbol), TYPE is the parameters type (a sexp widget), and
|
|
|
266 DOC is a documentation string for the parameter.")
|
|
56927
|
267
|
|
|
268 (eval-and-compile
|
|
|
269 (defconst gnus-agent-parameters
|
|
|
270 '((agent-predicate
|
|
|
271 (sexp :tag "Selection Predicate" :value false)
|
|
|
272 "Predicate used to automatically select articles for downloading."
|
|
|
273 gnus-agent-cat-predicate)
|
|
|
274 (agent-score
|
|
|
275 (choice :tag "Score File" :value nil
|
|
|
276 (const file :tag "Use group's score files")
|
|
|
277 (repeat (list (string :format "%v" :tag "File name"))))
|
|
|
278 "Which score files to use when using score to select articles to fetch.
|
|
|
279
|
|
|
280 `nil'
|
|
|
281 All articles will be scored to zero (0).
|
|
|
282
|
|
|
283 `file'
|
|
|
284 The group's score files will be used to score the articles.
|
|
|
285
|
|
|
286 `List'
|
|
|
287 A list of score file names."
|
|
|
288 gnus-agent-cat-score-file)
|
|
|
289 (agent-short-article
|
|
|
290 (integer :tag "Max Length of Short Article" :value "")
|
|
|
291 "The SHORT predicate will evaluate to true when the article is
|
|
|
292 shorter than this length." gnus-agent-cat-length-when-short)
|
|
|
293 (agent-long-article
|
|
|
294 (integer :tag "Min Length of Long Article" :value "")
|
|
|
295 "The LONG predicate will evaluate to true when the article is
|
|
|
296 longer than this length." gnus-agent-cat-length-when-long)
|
|
|
297 (agent-low-score
|
|
|
298 (integer :tag "Low Score Limit" :value "")
|
|
|
299 "The LOW predicate will evaluate to true when the article scores
|
|
|
300 lower than this limit." gnus-agent-cat-low-score)
|
|
|
301 (agent-high-score
|
|
|
302 (integer :tag "High Score Limit" :value "")
|
|
|
303 "The HIGH predicate will evaluate to true when the article scores
|
|
|
304 higher than this limit." gnus-agent-cat-high-score)
|
|
|
305 (agent-days-until-old
|
|
|
306 (integer :tag "Days Until Old" :value "")
|
|
|
307 "The OLD predicate will evaluate to true when the fetched article
|
|
|
308 has been stored locally for at least this many days."
|
|
|
309 gnus-agent-cat-days-until-old)
|
|
|
310 (agent-enable-expiration
|
|
|
311 (radio :tag "Expire in this Group or Topic" :value nil
|
|
|
312 (const :format "Enable " ENABLE)
|
|
|
313 (const :format "Disable " DISABLE))
|
|
|
314 "\nEnable, or disable, agent expiration in this group or topic."
|
|
|
315 gnus-agent-cat-enable-expiration)
|
|
|
316 (agent-enable-undownloaded-faces
|
|
|
317 (boolean :tag "Enable Agent Faces")
|
|
|
318 "Have the summary buffer use the agent's undownloaded faces.
|
|
|
319 These faces, when enabled, act as a warning that an article has not
|
|
|
320 been fetched into either the agent nor the cache. This is of most use
|
|
|
321 to users who use the agent as a cache (i.e. they only operate on
|
|
|
322 articles that have been downloaded). Leave disabled to display normal
|
|
|
323 article faces even when the article hasn't been downloaded."
|
|
|
324 gnus-agent-cat-enable-undownloaded-faces))
|
|
|
325 "Alist of group parameters that are not also topic parameters.
|
|
|
326
|
|
|
327 Each entry has the form (NAME TYPE DOC ACCESSOR), where NAME is the
|
|
|
328 parameter itself (a symbol), TYPE is the parameters type (a sexp
|
|
|
329 widget), DOC is a documentation string for the parameter, and ACCESSOR
|
|
|
330 is a function (symbol) that extracts the current value from the
|
|
|
331 category."))
|
|
|
332
|
|
17493
|
333 (defvar gnus-custom-params)
|
|
|
334 (defvar gnus-custom-method)
|
|
|
335 (defvar gnus-custom-group)
|
|
31716
|
336 (defvar gnus-custom-topic)
|
|
17493
|
337
|
|
31716
|
338 (defun gnus-group-customize (group &optional topic)
|
|
|
339 "Edit the group or topic on the current line."
|
|
|
340 (interactive (list (gnus-group-group-name) (gnus-group-topic-name)))
|
|
24357
|
341 (let (info
|
|
17493
|
342 (types (mapcar (lambda (entry)
|
|
|
343 `(cons :format "%v%h\n"
|
|
|
344 :doc ,(nth 2 entry)
|
|
|
345 (const :format "" ,(nth 0 entry))
|
|
|
346 ,(nth 1 entry)))
|
|
56927
|
347 (append (reverse gnus-group-parameters-more)
|
|
|
348 gnus-group-parameters
|
|
31716
|
349 (if group
|
|
|
350 gnus-extra-group-parameters
|
|
56927
|
351 gnus-extra-topic-parameters))))
|
|
|
352 (agent (mapcar (lambda (entry)
|
|
|
353 (let ((type (nth 1 entry))
|
|
|
354 vcons)
|
|
|
355 (if (listp type)
|
|
|
356 (setq type (copy-sequence type)))
|
|
|
357
|
|
|
358 (setq vcons (cdr (memq :value type)))
|
|
|
359
|
|
|
360 (if (symbolp (car vcons))
|
|
|
361 (condition-case nil
|
|
|
362 (setcar vcons (symbol-value (car vcons)))
|
|
|
363 (error)))
|
|
|
364 `(cons :format "%v%h\n"
|
|
|
365 :doc ,(nth 2 entry)
|
|
|
366 (const :format "" ,(nth 0 entry))
|
|
|
367 ,type)))
|
|
|
368 (if gnus-agent
|
|
|
369 gnus-agent-parameters))))
|
|
31716
|
370 (unless (or group topic)
|
|
17493
|
371 (error "No group on current line"))
|
|
31716
|
372 (when (and group topic)
|
|
56927
|
373 (error "Both a group an topic on current line"))
|
|
31716
|
374 (unless (or topic (setq info (gnus-get-info group)))
|
|
17493
|
375 (error "Killed group; can't be edited"))
|
|
|
376 ;; Ready.
|
|
56927
|
377 (gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
|
|
24357
|
378 (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
|
|
17493
|
379 (gnus-custom-mode)
|
|
|
380 (make-local-variable 'gnus-custom-group)
|
|
|
381 (setq gnus-custom-group group)
|
|
31716
|
382 (make-local-variable 'gnus-custom-topic)
|
|
|
383 (setq gnus-custom-topic topic)
|
|
|
384 (buffer-disable-undo)
|
|
17493
|
385 (widget-insert "Customize the ")
|
|
31716
|
386 (if group
|
|
|
387 (widget-create 'info-link
|
|
|
388 :help-echo "Push me to learn more."
|
|
|
389 :tag "group parameters"
|
|
|
390 "(gnus)Group Parameters")
|
|
|
391 (widget-create 'info-link
|
|
|
392 :help-echo "Push me to learn more."
|
|
|
393 :tag "topic parameters"
|
|
|
394 "(gnus)Topic Parameters"))
|
|
17493
|
395 (widget-insert " for <")
|
|
31716
|
396 (widget-insert (gnus-group-decoded-name (or group topic)))
|
|
17493
|
397 (widget-insert "> and press ")
|
|
|
398 (widget-create 'push-button
|
|
|
399 :tag "done"
|
|
|
400 :help-echo "Push me when done customizing."
|
|
|
401 :action 'gnus-group-customize-done)
|
|
|
402 (widget-insert ".\n\n")
|
|
|
403 (make-local-variable 'gnus-custom-params)
|
|
56927
|
404
|
|
|
405 (let ((values (if group
|
|
|
406 (gnus-info-params info)
|
|
|
407 (gnus-topic-parameters topic))))
|
|
|
408
|
|
|
409 ;; The parameters in values may contain duplicates. This is
|
|
|
410 ;; normally OK as assq returns the first. However, right here
|
|
|
411 ;; every duplicate ends up being displayed. So, rather than
|
|
|
412 ;; display them, remove them from the list.
|
|
|
413
|
|
|
414 (let ((tmp (setq values (gnus-copy-sequence values)))
|
|
|
415 elem)
|
|
|
416 (while (cdr tmp)
|
|
|
417 (while (setq elem (assq (caar tmp) (cdr tmp)))
|
|
|
418 (delq elem tmp))
|
|
|
419 (setq tmp (cdr tmp))))
|
|
|
420
|
|
|
421 (setq gnus-custom-params
|
|
|
422 (apply 'widget-create 'group
|
|
|
423 :value values
|
|
|
424 (delq nil
|
|
|
425 (list `(set :inline t
|
|
|
426 :greedy t
|
|
|
427 :tag "Parameters"
|
|
|
428 :format "%t:\n%h%v"
|
|
|
429 :doc "\
|
|
31716
|
430 These special parameters are recognized by Gnus.
|
|
|
431 Check the [ ] for the parameters you want to apply to this group or
|
|
|
432 to the groups in this topic, then edit the value to suit your taste."
|
|
56927
|
433 ,@types)
|
|
|
434 (when gnus-agent
|
|
|
435 `(set :inline t
|
|
|
436 :greedy t
|
|
|
437 :tag "Agent Parameters"
|
|
|
438 :format "%t:\n%h%v"
|
|
|
439 :doc "\ These agent parameters are
|
|
|
440 recognized by Gnus. They control article selection and expiration for
|
|
|
441 use in the unplugged cache. Check the [ ] for the parameters you want
|
|
|
442 to apply to this group or to the groups in this topic, then edit the
|
|
|
443 value to suit your taste.
|
|
|
444
|
|
|
445 For those interested, group parameters override topic parameters while
|
|
|
446 topic parameters override agent category parameters. Underlying
|
|
|
447 category parameters are the customizable variables." ,@agent))
|
|
|
448 '(repeat :inline t
|
|
|
449 :tag "Variables"
|
|
|
450 :format "%t:\n%h%v%i\n\n"
|
|
|
451 :doc "\
|
|
17493
|
452 Set variables local to the group you are entering.
|
|
|
453
|
|
|
454 If you want to turn threading off in `news.answers', you could put
|
|
|
455 `(gnus-show-threads nil)' in the group parameters of that group.
|
|
|
456 `gnus-show-threads' will be made into a local variable in the summary
|
50849
702762701b10
(gnus-group-parameters): Don't quote nil and t in docstrings.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
457 buffer you enter, and the form nil will be `eval'ed there.
|
|
17493
|
458
|
|
|
459 This can also be used as a group-specific hook function, if you'd
|
|
|
460 like. If you want to hear a beep when you enter a group, you could
|
|
|
461 put something like `(dummy-variable (ding))' in the parameters of that
|
|
|
462 group. `dummy-variable' will be set to the result of the `(ding)'
|
|
|
463 form, but who cares?"
|
|
56927
|
464 (list :format "%v" :value (nil nil)
|
|
|
465 (symbol :tag "Variable")
|
|
|
466 (sexp :tag
|
|
|
467 "Value")))
|
|
17493
|
468
|
|
56927
|
469 '(repeat :inline t
|
|
|
470 :tag "Unknown entries"
|
|
|
471 sexp))))))
|
|
31716
|
472 (when group
|
|
|
473 (widget-insert "\n\nYou can also edit the ")
|
|
|
474 (widget-create 'info-link
|
|
|
475 :tag "select method"
|
|
|
476 :help-echo "Push me to learn more about select methods."
|
|
|
477 "(gnus)Select Methods")
|
|
|
478 (widget-insert " for the group.\n")
|
|
|
479 (setq gnus-custom-method
|
|
|
480 (widget-create 'sexp
|
|
|
481 :tag "Method"
|
|
|
482 :value (gnus-info-method info))))
|
|
68910
|
483 (use-local-map widget-keymap)
|
|
31716
|
484 (widget-setup)
|
|
|
485 (buffer-enable-undo)
|
|
|
486 (goto-char (point-min))))
|
|
17493
|
487
|
|
|
488 (defun gnus-group-customize-done (&rest ignore)
|
|
|
489 "Apply changes and bury the buffer."
|
|
|
490 (interactive)
|
|
31716
|
491 (if gnus-custom-topic
|
|
|
492 (gnus-topic-set-parameters gnus-custom-topic
|
|
|
493 (widget-value gnus-custom-params))
|
|
|
494 (gnus-group-edit-group-done 'params gnus-custom-group
|
|
|
495 (widget-value gnus-custom-params))
|
|
|
496 (gnus-group-edit-group-done 'method gnus-custom-group
|
|
|
497 (widget-value gnus-custom-method)))
|
|
17493
|
498 (bury-buffer))
|
|
|
499
|
|
|
500 ;;; Score Customization:
|
|
|
501
|
|
|
502 (defconst gnus-score-parameters
|
|
|
503 '((mark (number :tag "Mark") "\
|
|
|
504 The value of this entry should be a number.
|
|
|
505 Any articles with a score lower than this number will be marked as read.")
|
|
|
506
|
|
|
507 (expunge (number :tag "Expunge") "\
|
|
|
508 The value of this entry should be a number.
|
|
|
509 Any articles with a score lower than this number will be removed from
|
|
|
510 the summary buffer.")
|
|
|
511
|
|
|
512 (mark-and-expunge (number :tag "Mark-and-expunge") "\
|
|
|
513 The value of this entry should be a number.
|
|
|
514 Any articles with a score lower than this number will be marked as
|
|
|
515 read and removed from the summary buffer.")
|
|
|
516
|
|
|
517 (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\
|
|
|
518 The value of this entry should be a number.
|
|
|
519 All articles that belong to a thread that has a total score below this
|
|
|
520 number will be marked as read and removed from the summary buffer.
|
|
|
521 `gnus-thread-score-function' says how to compute the total score
|
|
|
522 for a thread.")
|
|
|
523
|
|
24357
|
524 (files (repeat :inline t :tag "Files" file) "\
|
|
17493
|
525 The value of this entry should be any number of file names.
|
|
|
526 These files are assumed to be score files as well, and will be loaded
|
|
|
527 the same way this one was.")
|
|
|
528
|
|
24357
|
529 (exclude-files (repeat :inline t :tag "Exclude-files" file) "\
|
|
17493
|
530 The clue of this entry should be any number of files.
|
|
|
531 These files will not be loaded, even though they would normally be so,
|
|
|
532 for some reason or other.")
|
|
|
533
|
|
|
534 (eval (sexp :tag "Eval" :value nil) "\
|
|
|
535 The value of this entry will be `eval'el.
|
|
|
536 This element will be ignored when handling global score files.")
|
|
|
537
|
|
|
538 (read-only (boolean :tag "Read-only" :value t) "\
|
|
|
539 Read-only score files will not be updated or saved.
|
|
|
540 Global score files should feature this atom.")
|
|
|
541
|
|
|
542 (orphan (number :tag "Orphan") "\
|
|
|
543 The value of this entry should be a number.
|
|
|
544 Articles that do not have parents will get this number added to their
|
|
|
545 scores. Imagine you follow some high-volume newsgroup, like
|
|
|
546 `comp.lang.c'. Most likely you will only follow a few of the threads,
|
|
|
547 also want to see any new threads.
|
|
|
548
|
|
|
549 You can do this with the following two score file entries:
|
|
|
550
|
|
|
551 (orphan -500)
|
|
|
552 (mark-and-expunge -100)
|
|
|
553
|
|
|
554 When you enter the group the first time, you will only see the new
|
|
|
555 threads. You then raise the score of the threads that you find
|
|
|
556 interesting (with `I T' or `I S'), and ignore (`C y') the rest.
|
|
|
557 Next time you enter the group, you will see new articles in the
|
|
|
558 interesting threads, plus any new threads.
|
|
|
559
|
|
|
560 I.e.---the orphan score atom is for high-volume groups where there
|
|
|
561 exist a few interesting threads which can't be found automatically
|
|
|
562 by ordinary scoring rules.")
|
|
|
563
|
|
|
564 (adapt (choice :tag "Adapt"
|
|
|
565 (const t)
|
|
|
566 (const ignore)
|
|
|
567 (sexp :format "%v"
|
|
|
568 :hide-front-space t)) "\
|
|
|
569 This entry controls the adaptive scoring.
|
50849
702762701b10
(gnus-group-parameters): Don't quote nil and t in docstrings.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
570 If it is t, the default adaptive scoring rules will be used. If it
|
|
17493
|
571 is `ignore', no adaptive scoring will be performed on this group. If
|
|
|
572 it is a list, this list will be used as the adaptive scoring rules.
|
50849
702762701b10
(gnus-group-parameters): Don't quote nil and t in docstrings.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
573 If it isn't present, or is something other than t or `ignore', the
|
|
17493
|
574 default adaptive scoring rules will be used. If you want to use
|
|
|
575 adaptive scoring on most groups, you'd set `gnus-use-adaptive-scoring'
|
50849
702762701b10
(gnus-group-parameters): Don't quote nil and t in docstrings.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
576 to t, and insert an `(adapt ignore)' in the groups where you do not
|
|
17493
|
577 want adaptive scoring. If you only want adaptive scoring in a few
|
50849
702762701b10
(gnus-group-parameters): Don't quote nil and t in docstrings.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
578 groups, you'd set `gnus-use-adaptive-scoring' to nil, and insert
|
|
17493
|
579 `(adapt t)' in the score files of the groups where you want it.")
|
|
|
580
|
|
|
581 (adapt-file (file :tag "Adapt-file") "\
|
|
|
582 All adaptive score entries will go to the file named by this entry.
|
|
|
583 It will also be applied when entering the group. This atom might
|
|
|
584 be handy if you want to adapt on several groups at once, using the
|
|
|
585 same adaptive file for a number of groups.")
|
|
|
586
|
|
|
587 (local (repeat :tag "Local"
|
|
|
588 (group :value (nil nil)
|
|
|
589 (symbol :tag "Variable")
|
|
|
590 (sexp :tag "Value"))) "\
|
|
|
591 The value of this entry should be a list of `(VAR VALUE)' pairs.
|
|
|
592 Each VAR will be made buffer-local to the current summary buffer,
|
|
|
593 and set to the value specified. This is a convenient, if somewhat
|
|
|
594 strange, way of setting variables in some groups if you don't like
|
|
|
595 hooks much.")
|
|
|
596 (touched (sexp :format "Touched\n") "Internal variable."))
|
|
|
597 "Alist of valid symbolic score parameters.
|
|
|
598
|
|
|
599 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
|
|
|
600 itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a
|
|
|
601 documentation string for the parameter.")
|
|
|
602
|
|
|
603 (define-widget 'gnus-score-string 'group
|
|
|
604 "Edit score entries for string-valued headers."
|
|
|
605 :convert-widget 'gnus-score-string-convert)
|
|
|
606
|
|
|
607 (defun gnus-score-string-convert (widget)
|
|
|
608 ;; Set args appropriately.
|
|
|
609 (let* ((tag (widget-get widget :tag))
|
|
|
610 (item `(const :format "" :value ,(downcase tag)))
|
|
|
611 (match '(string :tag "Match"))
|
|
|
612 (score '(choice :tag "Score"
|
|
31716
|
613 (const :tag "default" nil)
|
|
|
614 (integer :format "%v"
|
|
|
615 :hide-front-space t)))
|
|
17493
|
616 (expire '(choice :tag "Expire"
|
|
|
617 (const :tag "off" nil)
|
|
|
618 (integer :format "%v"
|
|
|
619 :hide-front-space t)))
|
|
|
620 (type '(choice :tag "Type"
|
|
|
621 :value s
|
|
|
622 ;; I should really create a forgiving :match
|
|
|
623 ;; function for each type below, that only
|
|
|
624 ;; looked at the first letter.
|
|
|
625 (const :tag "Regexp" r)
|
|
|
626 (const :tag "Regexp (fixed case)" R)
|
|
|
627 (const :tag "Substring" s)
|
|
|
628 (const :tag "Substring (fixed case)" S)
|
|
|
629 (const :tag "Exact" e)
|
|
|
630 (const :tag "Exact (fixed case)" E)
|
|
|
631 (const :tag "Word" w)
|
|
|
632 (const :tag "Word (fixed case)" W)
|
|
|
633 (const :tag "default" nil)))
|
|
|
634 (group `(group ,match ,score ,expire ,type))
|
|
|
635 (doc (concat (or (widget-get widget :doc)
|
|
|
636 (concat "Change score based on the " tag
|
|
|
637 " header.\n"))
|
|
|
638 "
|
|
|
639 You can have an arbitrary number of score entries for this header,
|
|
|
640 each score entry has four elements:
|
|
|
641
|
|
|
642 1. The \"match element\". This should be the string to look for in the
|
|
|
643 header.
|
|
|
644
|
|
|
645 2. The \"score element\". This number should be an integer in the
|
|
|
646 neginf to posinf interval. This number is added to the score
|
|
|
647 of the article if the match is successful. If this element is
|
|
|
648 not present, the `gnus-score-interactive-default-score' number
|
|
|
649 will be used instead. This is 1000 by default.
|
|
|
650
|
|
|
651 3. The \"date element\". This date says when the last time this score
|
|
|
652 entry matched, which provides a mechanism for expiring the
|
|
|
653 score entries. It this element is not present, the score
|
|
|
654 entry is permanent. The date is represented by the number of
|
|
|
655 days since December 31, 1 ce.
|
|
|
656
|
|
|
657 4. The \"type element\". This element specifies what function should
|
|
|
658 be used to see whether this score entry matches the article.
|
|
|
659
|
|
|
660 There are the regexp, as well as substring types, and exact match,
|
|
|
661 and word match types. If this element is not present, Gnus will
|
|
|
662 assume that substring matching should be used. There is case
|
|
|
663 sensitive variants of all match types.")))
|
|
|
664 (widget-put widget :args `(,item
|
|
|
665 (repeat :inline t
|
|
|
666 :indent 0
|
|
|
667 :tag ,tag
|
|
|
668 :doc ,doc
|
|
|
669 :format "%t:\n%h%v%i\n\n"
|
|
|
670 (choice :format "%v"
|
|
|
671 :value ("" nil nil s)
|
|
|
672 ,group
|
|
|
673 sexp)))))
|
|
|
674 widget)
|
|
|
675
|
|
|
676 (define-widget 'gnus-score-integer 'group
|
|
|
677 "Edit score entries for integer-valued headers."
|
|
|
678 :convert-widget 'gnus-score-integer-convert)
|
|
|
679
|
|
|
680 (defun gnus-score-integer-convert (widget)
|
|
|
681 ;; Set args appropriately.
|
|
|
682 (let* ((tag (widget-get widget :tag))
|
|
|
683 (item `(const :format "" :value ,(downcase tag)))
|
|
|
684 (match '(integer :tag "Match"))
|
|
|
685 (score '(choice :tag "Score"
|
|
31716
|
686 (const :tag "default" nil)
|
|
|
687 (integer :format "%v"
|
|
|
688 :hide-front-space t)))
|
|
17493
|
689 (expire '(choice :tag "Expire"
|
|
|
690 (const :tag "off" nil)
|
|
|
691 (integer :format "%v"
|
|
|
692 :hide-front-space t)))
|
|
|
693 (type '(choice :tag "Type"
|
|
|
694 :value <
|
|
|
695 (const <)
|
|
|
696 (const >)
|
|
|
697 (const =)
|
|
|
698 (const >=)
|
|
|
699 (const <=)))
|
|
|
700 (group `(group ,match ,score ,expire ,type))
|
|
|
701 (doc (concat (or (widget-get widget :doc)
|
|
|
702 (concat "Change score based on the " tag
|
|
|
703 " header.")))))
|
|
|
704 (widget-put widget :args `(,item
|
|
|
705 (repeat :inline t
|
|
|
706 :indent 0
|
|
|
707 :tag ,tag
|
|
|
708 :doc ,doc
|
|
|
709 :format "%t:\n%h%v%i\n\n"
|
|
|
710 ,group))))
|
|
|
711 widget)
|
|
|
712
|
|
|
713 (define-widget 'gnus-score-date 'group
|
|
|
714 "Edit score entries for date-valued headers."
|
|
|
715 :convert-widget 'gnus-score-date-convert)
|
|
|
716
|
|
|
717 (defun gnus-score-date-convert (widget)
|
|
|
718 ;; Set args appropriately.
|
|
|
719 (let* ((tag (widget-get widget :tag))
|
|
|
720 (item `(const :format "" :value ,(downcase tag)))
|
|
|
721 (match '(string :tag "Match"))
|
|
|
722 (score '(choice :tag "Score"
|
|
31716
|
723 (const :tag "default" nil)
|
|
|
724 (integer :format "%v"
|
|
|
725 :hide-front-space t)))
|
|
17493
|
726 (expire '(choice :tag "Expire"
|
|
|
727 (const :tag "off" nil)
|
|
|
728 (integer :format "%v"
|
|
|
729 :hide-front-space t)))
|
|
|
730 (type '(choice :tag "Type"
|
|
|
731 :value regexp
|
|
|
732 (const regexp)
|
|
|
733 (const before)
|
|
|
734 (const at)
|
|
|
735 (const after)))
|
|
|
736 (group `(group ,match ,score ,expire ,type))
|
|
|
737 (doc (concat (or (widget-get widget :doc)
|
|
|
738 (concat "Change score based on the " tag
|
|
|
739 " header."))
|
|
|
740 "
|
|
|
741 For the Date header we have three kinda silly match types: `before',
|
|
|
742 `at' and `after'. I can't really imagine this ever being useful, but,
|
|
|
743 like, it would feel kinda silly not to provide this function. Just in
|
|
|
744 case. You never know. Better safe than sorry. Once burnt, twice
|
|
|
745 shy. Don't judge a book by its cover. Never not have sex on a first
|
|
|
746 date. (I have been told that at least one person, and I quote,
|
|
|
747 \"found this function indispensable\", however.)
|
|
|
748
|
|
|
749 A more useful match type is `regexp'. With it, you can match the date
|
|
|
750 string using a regular expression. The date is normalized to ISO8601
|
|
|
751 compact format first---`YYYYMMDDTHHMMSS'. If you want to match all
|
|
|
752 articles that have been posted on April 1st in every year, you could
|
|
|
753 use `....0401.........' as a match string, for instance. (Note that
|
|
|
754 the date is kept in its original time zone, so this will match
|
|
|
755 articles that were posted when it was April 1st where the article was
|
|
|
756 posted from. Time zones are such wholesome fun for the whole family,
|
|
|
757 eh?")))
|
|
|
758 (widget-put widget :args `(,item
|
|
|
759 (repeat :inline t
|
|
|
760 :indent 0
|
|
|
761 :tag ,tag
|
|
|
762 :doc ,doc
|
|
|
763 :format "%t:\n%h%v%i\n\n"
|
|
|
764 ,group))))
|
|
|
765 widget)
|
|
|
766
|
|
79022
|
767 (define-widget 'gnus-score-extra 'group
|
|
|
768 "Edit score entries for extra headers."
|
|
|
769 :convert-widget 'gnus-score-extra-convert)
|
|
|
770
|
|
|
771 (defun gnus-score-extra-convert (widget)
|
|
|
772 ;; Set args appropriately.
|
|
|
773 (let* ((tag (widget-get widget :tag))
|
|
|
774 (item `(const :format "" :value ,(downcase tag)))
|
|
|
775 (match '(string :tag "Match"))
|
|
|
776 (score '(choice :tag "Score"
|
|
|
777 (const :tag "default" nil)
|
|
|
778 (integer :format "%v"
|
|
|
779 :hide-front-space t)))
|
|
|
780 (expire '(choice :tag "Expire"
|
|
|
781 (const :tag "off" nil)
|
|
|
782 (integer :format "%v"
|
|
|
783 :hide-front-space t)))
|
|
|
784 (type '(choice :tag "Type"
|
|
|
785 :value s
|
|
|
786 ;; I should really create a forgiving :match
|
|
|
787 ;; function for each type below, that only
|
|
|
788 ;; looked at the first letter.
|
|
|
789 (const :tag "Regexp" r)
|
|
|
790 (const :tag "Regexp (fixed case)" R)
|
|
|
791 (const :tag "Substring" s)
|
|
|
792 (const :tag "Substring (fixed case)" S)
|
|
|
793 (const :tag "Exact" e)
|
|
|
794 (const :tag "Exact (fixed case)" E)
|
|
|
795 (const :tag "Word" w)
|
|
|
796 (const :tag "Word (fixed case)" W)
|
|
|
797 (const :tag "default" nil)))
|
|
|
798 (header (if gnus-extra-headers
|
|
|
799 (let (name)
|
|
|
800 `(choice :tag "Header"
|
|
|
801 ,@(mapcar (lambda (h)
|
|
|
802 (setq name (symbol-name h))
|
|
|
803 (list 'const :tag name name))
|
|
|
804 gnus-extra-headers)
|
|
|
805 (string :tag "Other" :format "%v")))
|
|
|
806 '(string :tag "Header")))
|
|
|
807 (group `(group ,match ,score ,expire ,type ,header))
|
|
|
808 (doc (concat (or (widget-get widget :doc)
|
|
|
809 (concat "Change score based on the " tag
|
|
|
810 " header.\n")))))
|
|
|
811 (widget-put
|
|
|
812 widget :args
|
|
|
813 `(,item
|
|
|
814 (repeat :inline t
|
|
|
815 :indent 0
|
|
|
816 :tag ,tag
|
|
|
817 :doc ,doc
|
|
|
818 :format "%t:\n%h%v%i\n\n"
|
|
|
819 (choice :format "%v"
|
|
|
820 :value ("" nil nil s
|
|
|
821 ,(if gnus-extra-headers
|
|
|
822 (symbol-name (car gnus-extra-headers))
|
|
|
823 ""))
|
|
|
824 ,group
|
|
|
825 sexp)))))
|
|
|
826 widget)
|
|
|
827
|
|
17493
|
828 (defvar gnus-custom-scores)
|
|
|
829 (defvar gnus-custom-score-alist)
|
|
|
830
|
|
|
831 (defun gnus-score-customize (file)
|
|
56927
|
832 "Customize score file FILE.
|
|
|
833 When called interactively, FILE defaults to the current score file.
|
|
|
834 This can be changed using the `\\[gnus-score-change-score-file]' command."
|
|
17493
|
835 (interactive (list gnus-current-score-file))
|
|
56927
|
836 (unless file
|
63492
980e418a44ee
(gnus-score-customize): Don't use `format' on `error' arguments.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
837 (error "No score file for %s"
|
980e418a44ee
(gnus-score-customize): Don't use `format' on `error' arguments.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
838 (gnus-group-decoded-name gnus-newsgroup-name)))
|
|
17493
|
839 (let ((scores (gnus-score-load file))
|
|
|
840 (types (mapcar (lambda (entry)
|
|
31716
|
841 `(group :format "%v%h\n"
|
|
|
842 :doc ,(nth 2 entry)
|
|
|
843 (const :format "" ,(nth 0 entry))
|
|
|
844 ,(nth 1 entry)))
|
|
|
845 gnus-score-parameters)))
|
|
17493
|
846 ;; Ready.
|
|
24357
|
847 (kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
|
|
|
848 (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
|
|
17493
|
849 (gnus-custom-mode)
|
|
|
850 (make-local-variable 'gnus-custom-score-alist)
|
|
|
851 (setq gnus-custom-score-alist scores)
|
|
|
852 (widget-insert "Customize the ")
|
|
|
853 (widget-create 'info-link
|
|
|
854 :help-echo "Push me to learn more."
|
|
|
855 :tag "score entries"
|
|
|
856 "(gnus)Score File Format")
|
|
|
857 (widget-insert " for\n\t")
|
|
|
858 (widget-insert file)
|
|
|
859 (widget-insert "\nand press ")
|
|
|
860 (widget-create 'push-button
|
|
|
861 :tag "done"
|
|
|
862 :help-echo "Push me when done customizing."
|
|
|
863 :action 'gnus-score-customize-done)
|
|
|
864 (widget-insert ".\n
|
|
|
865 Check the [ ] for the entries you want to apply to this score file, then
|
|
|
866 edit the value to suit your taste. Don't forget to mark the checkbox,
|
|
|
867 if you do all your changes will be lost. ")
|
|
|
868 (widget-create 'push-button
|
|
|
869 :action (lambda (&rest ignore)
|
|
|
870 (require 'gnus-audio)
|
|
|
871 (gnus-audio-play "Evil_Laugh.au"))
|
|
|
872 "Bhahahah!")
|
|
|
873 (widget-insert "\n\n")
|
|
|
874 (make-local-variable 'gnus-custom-scores)
|
|
|
875 (setq gnus-custom-scores
|
|
|
876 (widget-create 'group
|
|
|
877 :value scores
|
|
|
878 `(checklist :inline t
|
|
|
879 :greedy t
|
|
|
880 (gnus-score-string :tag "From")
|
|
|
881 (gnus-score-string :tag "Subject")
|
|
|
882 (gnus-score-string :tag "References")
|
|
|
883 (gnus-score-string :tag "Xref")
|
|
79022
|
884 (gnus-score-extra :tag "Extra")
|
|
17493
|
885 (gnus-score-string :tag "Message-ID")
|
|
|
886 (gnus-score-integer :tag "Lines")
|
|
|
887 (gnus-score-integer :tag "Chars")
|
|
|
888 (gnus-score-date :tag "Date")
|
|
|
889 (gnus-score-string :tag "Head"
|
|
|
890 :doc "\
|
|
|
891 Match all headers in the article.
|
|
|
892
|
|
|
893 Using one of `Head', `Body', `All' will slow down scoring considerable.
|
|
|
894 ")
|
|
|
895 (gnus-score-string :tag "Body"
|
|
|
896 :doc "\
|
|
|
897 Match the body sans header of the article.
|
|
|
898
|
|
|
899 Using one of `Head', `Body', `All' will slow down scoring considerable.
|
|
|
900 ")
|
|
|
901 (gnus-score-string :tag "All"
|
|
|
902 :doc "\
|
|
|
903 Match the entire article, including both headers and body.
|
|
|
904
|
|
|
905 Using one of `Head', `Body', `All' will slow down scoring
|
|
|
906 considerable.
|
|
|
907 ")
|
|
|
908 (gnus-score-string :tag
|
|
|
909 "Followup"
|
|
|
910 :doc "\
|
|
|
911 Score all followups to the specified authors.
|
|
|
912
|
|
|
913 This entry is somewhat special, in that it will match the `From:'
|
|
|
914 header, and affect the score of not only the matching articles, but
|
|
|
915 also all followups to the matching articles. This allows you
|
|
|
916 e.g. increase the score of followups to your own articles, or decrease
|
|
|
917 the score of followups to the articles of some known trouble-maker.
|
|
|
918 ")
|
|
|
919 (gnus-score-string :tag "Thread"
|
|
|
920 :doc "\
|
|
|
921 Add a score entry on all articles that are part of a thread.
|
|
|
922
|
|
|
923 This match key works along the same lines as the `Followup' match key.
|
|
|
924 If you say that you want to score on a (sub-)thread that is started by
|
|
|
925 an article with a `Message-ID' X, then you add a `thread' match. This
|
|
|
926 will add a new `thread' match for each article that has X in its
|
|
|
927 `References' header. (These new `thread' matches will use the
|
|
|
928 `Message-ID's of these matching articles.) This will ensure that you
|
|
|
929 can raise/lower the score of an entire thread, even though some
|
|
|
930 articles in the thread may not have complete `References' headers.
|
|
|
931 Note that using this may lead to undeterministic scores of the
|
|
|
932 articles in the thread.
|
|
|
933 ")
|
|
|
934 ,@types)
|
|
|
935 '(repeat :inline t
|
|
|
936 :tag "Unknown entries"
|
|
|
937 sexp)))
|
|
68910
|
938 (use-local-map widget-keymap)
|
|
17493
|
939 (widget-setup)))
|
|
|
940
|
|
|
941 (defun gnus-score-customize-done (&rest ignore)
|
|
|
942 "Reset the score alist with the present value."
|
|
|
943 (let ((alist gnus-custom-score-alist)
|
|
|
944 (value (widget-value gnus-custom-scores)))
|
|
|
945 (setcar alist (car value))
|
|
|
946 (setcdr alist (cdr value))
|
|
|
947 (gnus-score-set 'touched '(t) alist))
|
|
|
948 (bury-buffer))
|
|
|
949
|
|
86154
|
950 (defvar category-fields nil)
|
|
|
951 (defvar gnus-agent-cat-name)
|
|
|
952 (defvar gnus-agent-cat-score-file)
|
|
|
953 (defvar gnus-agent-cat-length-when-short)
|
|
|
954 (defvar gnus-agent-cat-length-when-long)
|
|
|
955 (defvar gnus-agent-cat-low-score)
|
|
|
956 (defvar gnus-agent-cat-high-score)
|
|
|
957 (defvar gnus-agent-cat-enable-expiration)
|
|
|
958 (defvar gnus-agent-cat-days-until-old)
|
|
|
959 (defvar gnus-agent-cat-predicate)
|
|
|
960 (defvar gnus-agent-cat-groups)
|
|
|
961 (defvar gnus-agent-cat-enable-undownloaded-faces)
|
|
56927
|
962
|
|
|
963 (defun gnus-trim-whitespace (s)
|
|
|
964 (when (string-match "\\`[ \n\t]+" s)
|
|
|
965 (setq s (substring s (match-end 0))))
|
|
|
966 (when (string-match "[ \n\t]+\\'" s)
|
|
|
967 (setq s (substring s 0 (match-beginning 0))))
|
|
|
968 s)
|
|
|
969
|
|
|
970 (defmacro gnus-agent-cat-prepare-category-field (parameter)
|
|
|
971 (let* ((entry (assq parameter gnus-agent-parameters))
|
|
|
972 (field (nth 3 entry)))
|
|
|
973 `(let* ((type (copy-sequence
|
|
|
974 (nth 1 (assq ',parameter gnus-agent-parameters))))
|
|
|
975 (val (,field info))
|
|
|
976 (deflt (if (,field defaults)
|
|
|
977 (concat " [" (gnus-trim-whitespace
|
|
|
978 (gnus-pp-to-string (,field defaults)))
|
|
85712
|
979 "]")))
|
|
56927
|
980 symb)
|
|
|
981
|
|
|
982 (if (eq (car type) 'radio)
|
|
|
983 (let* ((rtype (nreverse type))
|
|
|
984 (rt rtype))
|
|
|
985 (while (listp (or (cadr rt) 'not-list))
|
|
|
986 (setq rt (cdr rt)))
|
|
|
987
|
|
|
988 (setcdr rt (cons '(const :format "Inherit " nil) (cdr rt)))
|
|
|
989 (setq type (nreverse rtype))))
|
|
|
990
|
|
|
991 (if deflt
|
|
|
992 (let ((tag (cdr (memq :tag type))))
|
|
|
993 (when (string-match "\n" deflt)
|
|
|
994 (while (progn (setq deflt (replace-match "\n " t t
|
|
|
995 deflt))
|
|
|
996 (string-match "\n" deflt (match-end 0))))
|
|
|
997 (setq deflt (concat "\n" deflt)))
|
|
|
998
|
|
|
999 (setcar tag (concat (car tag) deflt))))
|
|
|
1000
|
|
|
1001 (widget-insert "\n")
|
|
|
1002
|
|
|
1003 (setq val (if val
|
|
|
1004 (widget-create type :value val)
|
|
|
1005 (widget-create type))
|
|
|
1006 symb (set (make-local-variable ',field) val))
|
|
|
1007
|
|
|
1008 (widget-put symb :default val)
|
|
|
1009 (widget-put symb :accessor ',field)
|
|
|
1010 (push symb category-fields))))
|
|
|
1011
|
|
|
1012 (defun gnus-agent-customize-category (category)
|
|
|
1013 "Edit the CATEGORY."
|
|
|
1014 (interactive (list (gnus-category-name)))
|
|
|
1015 (let ((info (assq category gnus-category-alist))
|
|
|
1016 (defaults (list nil '(agent-predicate . false)
|
|
|
1017 (cons 'agent-enable-expiration
|
|
|
1018 gnus-agent-enable-expiration)
|
|
|
1019 '(agent-days-until-old . 7)
|
|
|
1020 (cons 'agent-length-when-short
|
|
|
1021 gnus-agent-short-article)
|
|
|
1022 (cons 'agent-length-when-long gnus-agent-long-article)
|
|
|
1023 (cons 'agent-low-score gnus-agent-low-score)
|
|
|
1024 (cons 'agent-high-score gnus-agent-high-score))))
|
|
|
1025
|
|
|
1026 (let ((old (get-buffer "*Gnus Agent Category Customize*")))
|
|
|
1027 (when old
|
|
|
1028 (gnus-kill-buffer old)))
|
|
|
1029 (switch-to-buffer (gnus-get-buffer-create
|
|
|
1030 "*Gnus Agent Category Customize*"))
|
|
|
1031
|
|
|
1032 (let ((inhibit-read-only t))
|
|
|
1033 (gnus-custom-mode)
|
|
|
1034 (buffer-disable-undo)
|
|
|
1035
|
|
|
1036 (let* ((name (gnus-agent-cat-name info)))
|
|
|
1037 (widget-insert "Customize the Agent Category '")
|
|
|
1038 (widget-insert (symbol-name name))
|
|
|
1039 (widget-insert "' and press ")
|
|
|
1040 (widget-create
|
|
|
1041 'push-button
|
|
|
1042 :notify
|
|
|
1043 '(lambda (&rest ignore)
|
|
|
1044 (let* ((info (assq gnus-agent-cat-name gnus-category-alist))
|
|
|
1045 (widgets category-fields))
|
|
|
1046 (while widgets
|
|
|
1047 (let* ((widget (pop widgets))
|
|
|
1048 (value (condition-case nil (widget-value widget) (error))))
|
|
|
1049 (eval `(setf (,(widget-get widget :accessor) ',info)
|
|
|
1050 ',value)))))
|
|
|
1051 (gnus-category-write)
|
|
|
1052 (gnus-kill-buffer (current-buffer))
|
|
|
1053 (when (get-buffer gnus-category-buffer)
|
|
|
1054 (switch-to-buffer (get-buffer gnus-category-buffer))
|
|
|
1055 (gnus-category-list)))
|
|
|
1056 "Done")
|
|
|
1057 (widget-insert
|
|
|
1058 "\n Note: Empty fields default to the customizable global\
|
|
|
1059 variables.\n\n")
|
|
|
1060
|
|
|
1061 (set (make-local-variable 'gnus-agent-cat-name)
|
|
|
1062 name))
|
|
|
1063
|
|
|
1064 (set (make-local-variable 'category-fields) nil)
|
|
|
1065 (gnus-agent-cat-prepare-category-field agent-predicate)
|
|
|
1066
|
|
|
1067 (gnus-agent-cat-prepare-category-field agent-score)
|
|
|
1068 (gnus-agent-cat-prepare-category-field agent-short-article)
|
|
|
1069 (gnus-agent-cat-prepare-category-field agent-long-article)
|
|
|
1070 (gnus-agent-cat-prepare-category-field agent-low-score)
|
|
|
1071 (gnus-agent-cat-prepare-category-field agent-high-score)
|
|
|
1072
|
|
|
1073 ;; The group list is NOT handled with
|
|
|
1074 ;; gnus-agent-cat-prepare-category-field as I don't want the
|
|
|
1075 ;; group list to appear when customizing a topic.
|
|
|
1076 (widget-insert "\n")
|
63492
980e418a44ee
(gnus-score-customize): Don't use `format' on `error' arguments.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1077
|
980e418a44ee
(gnus-score-customize): Don't use `format' on `error' arguments.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1078 (let ((symb
|
980e418a44ee
(gnus-score-customize): Don't use `format' on `error' arguments.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1079 (set
|
|
56927
|
1080 (make-local-variable 'gnus-agent-cat-groups)
|
|
|
1081 (widget-create
|
|
|
1082 `(choice
|
|
|
1083 :format "%[Select Member Groups%]\n%v" :value ignore
|
|
|
1084 (const :menu-tag "do not change" :tag "" :value ignore)
|
|
|
1085 (checklist :entry-format "%b %v"
|
|
|
1086 :menu-tag "display group selectors"
|
|
|
1087 :greedy t
|
|
|
1088 :value
|
|
|
1089 ,(delq nil
|
|
|
1090 (mapcar
|
|
|
1091 (lambda (newsrc)
|
|
|
1092 (car (member
|
|
|
1093 (gnus-info-group newsrc)
|
|
|
1094 (gnus-agent-cat-groups info))))
|
|
|
1095 (cdr gnus-newsrc-alist)))
|
|
|
1096 ,@(mapcar (lambda (newsrc)
|
|
|
1097 `(const ,(gnus-info-group newsrc)))
|
|
|
1098 (cdr gnus-newsrc-alist))))))))
|
|
|
1099
|
|
|
1100 (widget-put symb :default (gnus-agent-cat-groups info))
|
|
|
1101 (widget-put symb :accessor 'gnus-agent-cat-groups)
|
|
|
1102 (push symb category-fields))
|
|
|
1103
|
|
|
1104 (widget-insert "\nExpiration Settings ")
|
|
|
1105
|
|
|
1106 (gnus-agent-cat-prepare-category-field agent-enable-expiration)
|
|
|
1107 (gnus-agent-cat-prepare-category-field agent-days-until-old)
|
|
|
1108
|
|
|
1109 (widget-insert "\nVisual Settings ")
|
|
|
1110
|
|
|
1111 (gnus-agent-cat-prepare-category-field agent-enable-undownloaded-faces)
|
|
|
1112
|
|
68910
|
1113 (use-local-map widget-keymap)
|
|
56927
|
1114 (widget-setup)
|
|
|
1115 (buffer-enable-undo))))
|
|
|
1116
|
|
17493
|
1117 ;;; The End:
|
|
|
1118
|
|
|
1119 (provide 'gnus-cus)
|
|
|
1120
|
|
93975
|
1121 ;; arch-tag: a37c285a-49bc-4235-8244-804536effeaf
|
|
17493
|
1122 ;;; gnus-cus.el ends here
|
