Mercurial > emacs
annotate lisp/gnus/gnus-cus.el @ 27150:d8fd3814d591
*** empty log message ***
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Tue, 04 Jan 2000 17:14:55 +0000 |
parents | 15fc6acbae7a |
children | 9968f55ad26e |
rev | line source |
---|---|
17493 | 1 ;;; gnus-cus.el --- customization commands for Gnus |
2 ;; | |
3 ;; Copyright (C) 1996 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> | |
6 ;; Keywords: news | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;;; Code: | |
28 | |
29 (require 'wid-edit) | |
30 (require 'gnus-score) | |
31 | |
32 ;;; Widgets: | |
33 | |
34 ;; There should be special validation for this. | |
35 (define-widget 'gnus-email-address 'string | |
36 "An email address") | |
37 | |
38 (defun gnus-custom-mode () | |
39 "Major mode for editing Gnus customization buffers. | |
40 | |
41 The following commands are available: | |
42 | |
43 \\[widget-forward] Move to next button or editable field. | |
44 \\[widget-backward] Move to previous button or editable field. | |
45 \\[widget-button-click] Activate button under the mouse pointer. | |
46 \\[widget-button-press] Activate button under point. | |
47 | |
48 Entry to this mode calls the value of `gnus-custom-mode-hook' | |
49 if that value is non-nil." | |
50 (kill-all-local-variables) | |
51 (setq major-mode 'gnus-custom-mode | |
52 mode-name "Gnus Customize") | |
53 (use-local-map widget-keymap) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
54 (gnus-run-hooks 'gnus-custom-mode-hook)) |
17493 | 55 |
56 ;;; Group Customization: | |
57 | |
58 (defconst gnus-group-parameters | |
59 '((to-address (gnus-email-address :tag "To Address") "\ | |
60 This will be used when doing followups and posts. | |
61 | |
62 This is primarily useful in mail groups that represent closed | |
63 mailing lists--mailing lists where it's expected that everybody that | |
64 writes to the mailing list is subscribed to it. Since using this | |
65 parameter ensures that the mail only goes to the mailing list itself, | |
66 it means that members won't receive two copies of your followups. | |
67 | |
68 Using `to-address' will actually work whether the group is foreign or | |
69 not. Let's say there's a group on the server that is called | |
70 `fa.4ad-l'. This is a real newsgroup, but the server has gotten the | |
71 articles from a mail-to-news gateway. Posting directly to this group | |
72 is therefore impossible--you have to send mail to the mailing list | |
73 address instead.") | |
74 | |
75 (to-list (gnus-email-address :tag "To List") "\ | |
76 This address will be used when doing a `a' in the group. | |
77 | |
78 It is totally ignored when doing a followup--except that if it is | |
79 present in a news group, you'll get mail group semantics when doing | |
80 `f'.") | |
81 | |
82 (broken-reply-to (const :tag "Broken Reply To" t) "\ | |
83 Ignore `Reply-To' headers in this group. | |
84 | |
85 That can be useful if you're reading a mailing list group where the | |
86 listserv has inserted `Reply-To' headers that point back to the | |
87 listserv itself. This is broken behavior. So there!") | |
88 | |
89 (to-group (string :tag "To Group") "\ | |
90 All posts will be send to the specified group.") | |
91 | |
92 (gcc-self (choice :tag "GCC" | |
93 :value t | |
94 (const t) | |
95 (const none) | |
96 (string :format "%v" :hide-front-space t)) "\ | |
97 Specify default value for GCC header. | |
98 | |
99 If this symbol is present in the group parameter list and set to `t', | |
100 new composed messages will be `Gcc''d to the current group. If it is | |
101 present and set to `none', no `Gcc:' header will be generated, if it | |
102 is present and a string, this string will be inserted literally as a | |
103 `gcc' header (this symbol takes precedence over any default `Gcc' | |
104 rules as described later).") | |
105 | |
106 (auto-expire (const :tag "Automatic Expire" t) "\ | |
107 All articles that are read will be marked as expirable.") | |
108 | |
109 (total-expire (const :tag "Total Expire" t) "\ | |
110 All read articles will be put through the expiry process | |
111 | |
112 This happens even if they are not marked as expirable. | |
113 Use with caution.") | |
114 | |
115 (expiry-wait (choice :tag "Expire Wait" | |
116 :value never | |
117 (const never) | |
118 (const immediate) | |
119 (number :hide-front-space t | |
120 :format "%v")) "\ | |
121 When to expire. | |
122 | |
123 Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' | |
124 when expiring expirable messages. The value can either be a number of | |
125 days (not necessarily an integer) or the symbols `never' or | |
126 `immediate'.") | |
127 | |
128 (score-file (file :tag "Score File") "\ | |
129 Make the specified file into the current score file. | |
130 This means that all score commands you issue will end up in this file.") | |
131 | |
132 (adapt-file (file :tag "Adapt File") "\ | |
133 Make the specified file into the current adaptive file. | |
134 All adaptive score entries will be put into this file.") | |
135 | |
136 (admin-address (gnus-email-address :tag "Admin Address") "\ | |
137 Administration address for a mailing list. | |
138 | |
139 When unsubscribing to a mailing list you should never send the | |
140 unsubscription notice to the mailing list itself. Instead, you'd | |
141 send messages to the administrative address. This parameter allows | |
142 you to put the admin address somewhere convenient.") | |
143 | |
144 (display (choice :tag "Display" | |
145 :value default | |
146 (const all) | |
147 (const default)) "\ | |
148 Which articles to display on entering the group. | |
149 | |
150 `all' | |
151 Display all articles, both read and unread. | |
152 | |
153 `default' | |
154 Display the default visible articles, which normally includes | |
155 unread and ticked articles.") | |
156 | |
157 (comment (string :tag "Comment") "\ | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
158 An arbitrary comment on the group.") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
159 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
160 (visible (const :tag "Permanently visible" t) "\ |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
161 Always display this group, even when there are no unread articles |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
162 in it..")) |
17493 | 163 "Alist of valid group parameters. |
164 | |
165 Each entry has the form (NAME TYPE DOC), where NAME is the parameter | |
166 itself (a symbol), TYPE is the parameters type (a sexp widget), and | |
167 DOC is a documentation string for the parameter.") | |
168 | |
169 (defvar gnus-custom-params) | |
170 (defvar gnus-custom-method) | |
171 (defvar gnus-custom-group) | |
172 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
173 (defun gnus-group-customize (group) |
17493 | 174 "Edit the group on the current line." |
175 (interactive (list (gnus-group-group-name))) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
176 (let (info |
17493 | 177 (types (mapcar (lambda (entry) |
178 `(cons :format "%v%h\n" | |
179 :doc ,(nth 2 entry) | |
180 (const :format "" ,(nth 0 entry)) | |
181 ,(nth 1 entry))) | |
182 gnus-group-parameters))) | |
183 (unless group | |
184 (error "No group on current line")) | |
185 (unless (setq info (gnus-get-info group)) | |
186 (error "Killed group; can't be edited")) | |
187 ;; Ready. | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
188 (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
189 (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
17493 | 190 (gnus-custom-mode) |
191 (make-local-variable 'gnus-custom-group) | |
192 (setq gnus-custom-group group) | |
193 (widget-insert "Customize the ") | |
194 (widget-create 'info-link | |
195 :help-echo "Push me to learn more." | |
196 :tag "group parameters" | |
197 "(gnus)Group Parameters") | |
198 (widget-insert " for <") | |
199 (widget-insert group) | |
200 (widget-insert "> and press ") | |
201 (widget-create 'push-button | |
202 :tag "done" | |
203 :help-echo "Push me when done customizing." | |
204 :action 'gnus-group-customize-done) | |
205 (widget-insert ".\n\n") | |
206 (make-local-variable 'gnus-custom-params) | |
207 (setq gnus-custom-params | |
208 (widget-create 'group | |
209 :value (gnus-info-params info) | |
210 `(set :inline t | |
211 :greedy t | |
212 :tag "Parameters" | |
213 :format "%t:\n%h%v" | |
214 :doc "\ | |
215 These special paramerters are recognized by Gnus. | |
216 Check the [ ] for the parameters you want to apply to this group, then | |
217 edit the value to suit your taste." | |
218 ,@types) | |
219 '(repeat :inline t | |
220 :tag "Variables" | |
221 :format "%t:\n%h%v%i\n\n" | |
222 :doc "\ | |
223 Set variables local to the group you are entering. | |
224 | |
225 If you want to turn threading off in `news.answers', you could put | |
226 `(gnus-show-threads nil)' in the group parameters of that group. | |
227 `gnus-show-threads' will be made into a local variable in the summary | |
228 buffer you enter, and the form `nil' will be `eval'ed there. | |
229 | |
230 This can also be used as a group-specific hook function, if you'd | |
231 like. If you want to hear a beep when you enter a group, you could | |
232 put something like `(dummy-variable (ding))' in the parameters of that | |
233 group. `dummy-variable' will be set to the result of the `(ding)' | |
234 form, but who cares?" | |
235 (group :value (nil nil) | |
236 (symbol :tag "Variable") | |
237 (sexp :tag | |
238 "Value"))) | |
239 | |
240 '(repeat :inline t | |
241 :tag "Unknown entries" | |
242 sexp))) | |
243 (widget-insert "\n\nYou can also edit the ") | |
244 (widget-create 'info-link | |
245 :tag "select method" | |
246 :help-echo "Push me to learn more about select methods." | |
247 "(gnus)Select Methods") | |
248 (widget-insert " for the group.\n") | |
249 (setq gnus-custom-method | |
250 (widget-create 'sexp | |
251 :tag "Method" | |
252 :value (gnus-info-method info))) | |
253 (use-local-map widget-keymap) | |
254 (widget-setup))) | |
255 | |
256 (defun gnus-group-customize-done (&rest ignore) | |
257 "Apply changes and bury the buffer." | |
258 (interactive) | |
259 (gnus-group-edit-group-done 'params gnus-custom-group | |
260 (widget-value gnus-custom-params)) | |
261 (gnus-group-edit-group-done 'method gnus-custom-group | |
262 (widget-value gnus-custom-method)) | |
263 (bury-buffer)) | |
264 | |
265 ;;; Score Customization: | |
266 | |
267 (defconst gnus-score-parameters | |
268 '((mark (number :tag "Mark") "\ | |
269 The value of this entry should be a number. | |
270 Any articles with a score lower than this number will be marked as read.") | |
271 | |
272 (expunge (number :tag "Expunge") "\ | |
273 The value of this entry should be a number. | |
274 Any articles with a score lower than this number will be removed from | |
275 the summary buffer.") | |
276 | |
277 (mark-and-expunge (number :tag "Mark-and-expunge") "\ | |
278 The value of this entry should be a number. | |
279 Any articles with a score lower than this number will be marked as | |
280 read and removed from the summary buffer.") | |
281 | |
282 (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\ | |
283 The value of this entry should be a number. | |
284 All articles that belong to a thread that has a total score below this | |
285 number will be marked as read and removed from the summary buffer. | |
286 `gnus-thread-score-function' says how to compute the total score | |
287 for a thread.") | |
288 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
289 (files (repeat :inline t :tag "Files" file) "\ |
17493 | 290 The value of this entry should be any number of file names. |
291 These files are assumed to be score files as well, and will be loaded | |
292 the same way this one was.") | |
293 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
294 (exclude-files (repeat :inline t :tag "Exclude-files" file) "\ |
17493 | 295 The clue of this entry should be any number of files. |
296 These files will not be loaded, even though they would normally be so, | |
297 for some reason or other.") | |
298 | |
299 (eval (sexp :tag "Eval" :value nil) "\ | |
300 The value of this entry will be `eval'el. | |
301 This element will be ignored when handling global score files.") | |
302 | |
303 (read-only (boolean :tag "Read-only" :value t) "\ | |
304 Read-only score files will not be updated or saved. | |
305 Global score files should feature this atom.") | |
306 | |
307 (orphan (number :tag "Orphan") "\ | |
308 The value of this entry should be a number. | |
309 Articles that do not have parents will get this number added to their | |
310 scores. Imagine you follow some high-volume newsgroup, like | |
311 `comp.lang.c'. Most likely you will only follow a few of the threads, | |
312 also want to see any new threads. | |
313 | |
314 You can do this with the following two score file entries: | |
315 | |
316 (orphan -500) | |
317 (mark-and-expunge -100) | |
318 | |
319 When you enter the group the first time, you will only see the new | |
320 threads. You then raise the score of the threads that you find | |
321 interesting (with `I T' or `I S'), and ignore (`C y') the rest. | |
322 Next time you enter the group, you will see new articles in the | |
323 interesting threads, plus any new threads. | |
324 | |
325 I.e.---the orphan score atom is for high-volume groups where there | |
326 exist a few interesting threads which can't be found automatically | |
327 by ordinary scoring rules.") | |
328 | |
329 (adapt (choice :tag "Adapt" | |
330 (const t) | |
331 (const ignore) | |
332 (sexp :format "%v" | |
333 :hide-front-space t)) "\ | |
334 This entry controls the adaptive scoring. | |
335 If it is `t', the default adaptive scoring rules will be used. If it | |
336 is `ignore', no adaptive scoring will be performed on this group. If | |
337 it is a list, this list will be used as the adaptive scoring rules. | |
338 If it isn't present, or is something other than `t' or `ignore', the | |
339 default adaptive scoring rules will be used. If you want to use | |
340 adaptive scoring on most groups, you'd set `gnus-use-adaptive-scoring' | |
341 to `t', and insert an `(adapt ignore)' in the groups where you do not | |
342 want adaptive scoring. If you only want adaptive scoring in a few | |
343 groups, you'd set `gnus-use-adaptive-scoring' to `nil', and insert | |
344 `(adapt t)' in the score files of the groups where you want it.") | |
345 | |
346 (adapt-file (file :tag "Adapt-file") "\ | |
347 All adaptive score entries will go to the file named by this entry. | |
348 It will also be applied when entering the group. This atom might | |
349 be handy if you want to adapt on several groups at once, using the | |
350 same adaptive file for a number of groups.") | |
351 | |
352 (local (repeat :tag "Local" | |
353 (group :value (nil nil) | |
354 (symbol :tag "Variable") | |
355 (sexp :tag "Value"))) "\ | |
356 The value of this entry should be a list of `(VAR VALUE)' pairs. | |
357 Each VAR will be made buffer-local to the current summary buffer, | |
358 and set to the value specified. This is a convenient, if somewhat | |
359 strange, way of setting variables in some groups if you don't like | |
360 hooks much.") | |
361 (touched (sexp :format "Touched\n") "Internal variable.")) | |
362 "Alist of valid symbolic score parameters. | |
363 | |
364 Each entry has the form (NAME TYPE DOC), where NAME is the parameter | |
365 itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a | |
366 documentation string for the parameter.") | |
367 | |
368 (define-widget 'gnus-score-string 'group | |
369 "Edit score entries for string-valued headers." | |
370 :convert-widget 'gnus-score-string-convert) | |
371 | |
372 (defun gnus-score-string-convert (widget) | |
373 ;; Set args appropriately. | |
374 (let* ((tag (widget-get widget :tag)) | |
375 (item `(const :format "" :value ,(downcase tag))) | |
376 (match '(string :tag "Match")) | |
377 (score '(choice :tag "Score" | |
378 (const :tag "default" nil) | |
379 (integer :format "%v" | |
380 :hide-front-space t))) | |
381 (expire '(choice :tag "Expire" | |
382 (const :tag "off" nil) | |
383 (integer :format "%v" | |
384 :hide-front-space t))) | |
385 (type '(choice :tag "Type" | |
386 :value s | |
387 ;; I should really create a forgiving :match | |
388 ;; function for each type below, that only | |
389 ;; looked at the first letter. | |
390 (const :tag "Regexp" r) | |
391 (const :tag "Regexp (fixed case)" R) | |
392 (const :tag "Substring" s) | |
393 (const :tag "Substring (fixed case)" S) | |
394 (const :tag "Exact" e) | |
395 (const :tag "Exact (fixed case)" E) | |
396 (const :tag "Word" w) | |
397 (const :tag "Word (fixed case)" W) | |
398 (const :tag "default" nil))) | |
399 (group `(group ,match ,score ,expire ,type)) | |
400 (doc (concat (or (widget-get widget :doc) | |
401 (concat "Change score based on the " tag | |
402 " header.\n")) | |
403 " | |
404 You can have an arbitrary number of score entries for this header, | |
405 each score entry has four elements: | |
406 | |
407 1. The \"match element\". This should be the string to look for in the | |
408 header. | |
409 | |
410 2. The \"score element\". This number should be an integer in the | |
411 neginf to posinf interval. This number is added to the score | |
412 of the article if the match is successful. If this element is | |
413 not present, the `gnus-score-interactive-default-score' number | |
414 will be used instead. This is 1000 by default. | |
415 | |
416 3. The \"date element\". This date says when the last time this score | |
417 entry matched, which provides a mechanism for expiring the | |
418 score entries. It this element is not present, the score | |
419 entry is permanent. The date is represented by the number of | |
420 days since December 31, 1 ce. | |
421 | |
422 4. The \"type element\". This element specifies what function should | |
423 be used to see whether this score entry matches the article. | |
424 | |
425 There are the regexp, as well as substring types, and exact match, | |
426 and word match types. If this element is not present, Gnus will | |
427 assume that substring matching should be used. There is case | |
428 sensitive variants of all match types."))) | |
429 (widget-put widget :args `(,item | |
430 (repeat :inline t | |
431 :indent 0 | |
432 :tag ,tag | |
433 :doc ,doc | |
434 :format "%t:\n%h%v%i\n\n" | |
435 (choice :format "%v" | |
436 :value ("" nil nil s) | |
437 ,group | |
438 sexp))))) | |
439 widget) | |
440 | |
441 (define-widget 'gnus-score-integer 'group | |
442 "Edit score entries for integer-valued headers." | |
443 :convert-widget 'gnus-score-integer-convert) | |
444 | |
445 (defun gnus-score-integer-convert (widget) | |
446 ;; Set args appropriately. | |
447 (let* ((tag (widget-get widget :tag)) | |
448 (item `(const :format "" :value ,(downcase tag))) | |
449 (match '(integer :tag "Match")) | |
450 (score '(choice :tag "Score" | |
451 (const :tag "default" nil) | |
452 (integer :format "%v" | |
453 :hide-front-space t))) | |
454 (expire '(choice :tag "Expire" | |
455 (const :tag "off" nil) | |
456 (integer :format "%v" | |
457 :hide-front-space t))) | |
458 (type '(choice :tag "Type" | |
459 :value < | |
460 (const <) | |
461 (const >) | |
462 (const =) | |
463 (const >=) | |
464 (const <=))) | |
465 (group `(group ,match ,score ,expire ,type)) | |
466 (doc (concat (or (widget-get widget :doc) | |
467 (concat "Change score based on the " tag | |
468 " header."))))) | |
469 (widget-put widget :args `(,item | |
470 (repeat :inline t | |
471 :indent 0 | |
472 :tag ,tag | |
473 :doc ,doc | |
474 :format "%t:\n%h%v%i\n\n" | |
475 ,group)))) | |
476 widget) | |
477 | |
478 (define-widget 'gnus-score-date 'group | |
479 "Edit score entries for date-valued headers." | |
480 :convert-widget 'gnus-score-date-convert) | |
481 | |
482 (defun gnus-score-date-convert (widget) | |
483 ;; Set args appropriately. | |
484 (let* ((tag (widget-get widget :tag)) | |
485 (item `(const :format "" :value ,(downcase tag))) | |
486 (match '(string :tag "Match")) | |
487 (score '(choice :tag "Score" | |
488 (const :tag "default" nil) | |
489 (integer :format "%v" | |
490 :hide-front-space t))) | |
491 (expire '(choice :tag "Expire" | |
492 (const :tag "off" nil) | |
493 (integer :format "%v" | |
494 :hide-front-space t))) | |
495 (type '(choice :tag "Type" | |
496 :value regexp | |
497 (const regexp) | |
498 (const before) | |
499 (const at) | |
500 (const after))) | |
501 (group `(group ,match ,score ,expire ,type)) | |
502 (doc (concat (or (widget-get widget :doc) | |
503 (concat "Change score based on the " tag | |
504 " header.")) | |
505 " | |
506 For the Date header we have three kinda silly match types: `before', | |
507 `at' and `after'. I can't really imagine this ever being useful, but, | |
508 like, it would feel kinda silly not to provide this function. Just in | |
509 case. You never know. Better safe than sorry. Once burnt, twice | |
510 shy. Don't judge a book by its cover. Never not have sex on a first | |
511 date. (I have been told that at least one person, and I quote, | |
512 \"found this function indispensable\", however.) | |
513 | |
514 A more useful match type is `regexp'. With it, you can match the date | |
515 string using a regular expression. The date is normalized to ISO8601 | |
516 compact format first---`YYYYMMDDTHHMMSS'. If you want to match all | |
517 articles that have been posted on April 1st in every year, you could | |
518 use `....0401.........' as a match string, for instance. (Note that | |
519 the date is kept in its original time zone, so this will match | |
520 articles that were posted when it was April 1st where the article was | |
521 posted from. Time zones are such wholesome fun for the whole family, | |
522 eh?"))) | |
523 (widget-put widget :args `(,item | |
524 (repeat :inline t | |
525 :indent 0 | |
526 :tag ,tag | |
527 :doc ,doc | |
528 :format "%t:\n%h%v%i\n\n" | |
529 ,group)))) | |
530 widget) | |
531 | |
532 (defvar gnus-custom-scores) | |
533 (defvar gnus-custom-score-alist) | |
534 | |
535 (defun gnus-score-customize (file) | |
536 "Customize score file FILE." | |
537 (interactive (list gnus-current-score-file)) | |
538 (let ((scores (gnus-score-load file)) | |
539 (types (mapcar (lambda (entry) | |
540 `(group :format "%v%h\n" | |
541 :doc ,(nth 2 entry) | |
542 (const :format "" ,(nth 0 entry)) | |
543 ,(nth 1 entry))) | |
544 gnus-score-parameters))) | |
545 ;; Ready. | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
546 (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
547 (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
17493 | 548 (gnus-custom-mode) |
549 (make-local-variable 'gnus-custom-score-alist) | |
550 (setq gnus-custom-score-alist scores) | |
551 (widget-insert "Customize the ") | |
552 (widget-create 'info-link | |
553 :help-echo "Push me to learn more." | |
554 :tag "score entries" | |
555 "(gnus)Score File Format") | |
556 (widget-insert " for\n\t") | |
557 (widget-insert file) | |
558 (widget-insert "\nand press ") | |
559 (widget-create 'push-button | |
560 :tag "done" | |
561 :help-echo "Push me when done customizing." | |
562 :action 'gnus-score-customize-done) | |
563 (widget-insert ".\n | |
564 Check the [ ] for the entries you want to apply to this score file, then | |
565 edit the value to suit your taste. Don't forget to mark the checkbox, | |
566 if you do all your changes will be lost. ") | |
567 (widget-create 'push-button | |
568 :action (lambda (&rest ignore) | |
569 (require 'gnus-audio) | |
570 (gnus-audio-play "Evil_Laugh.au")) | |
571 "Bhahahah!") | |
572 (widget-insert "\n\n") | |
573 (make-local-variable 'gnus-custom-scores) | |
574 (setq gnus-custom-scores | |
575 (widget-create 'group | |
576 :value scores | |
577 `(checklist :inline t | |
578 :greedy t | |
579 (gnus-score-string :tag "From") | |
580 (gnus-score-string :tag "Subject") | |
581 (gnus-score-string :tag "References") | |
582 (gnus-score-string :tag "Xref") | |
583 (gnus-score-string :tag "Message-ID") | |
584 (gnus-score-integer :tag "Lines") | |
585 (gnus-score-integer :tag "Chars") | |
586 (gnus-score-date :tag "Date") | |
587 (gnus-score-string :tag "Head" | |
588 :doc "\ | |
589 Match all headers in the article. | |
590 | |
591 Using one of `Head', `Body', `All' will slow down scoring considerable. | |
592 ") | |
593 (gnus-score-string :tag "Body" | |
594 :doc "\ | |
595 Match the body sans header of the article. | |
596 | |
597 Using one of `Head', `Body', `All' will slow down scoring considerable. | |
598 ") | |
599 (gnus-score-string :tag "All" | |
600 :doc "\ | |
601 Match the entire article, including both headers and body. | |
602 | |
603 Using one of `Head', `Body', `All' will slow down scoring | |
604 considerable. | |
605 ") | |
606 (gnus-score-string :tag | |
607 "Followup" | |
608 :doc "\ | |
609 Score all followups to the specified authors. | |
610 | |
611 This entry is somewhat special, in that it will match the `From:' | |
612 header, and affect the score of not only the matching articles, but | |
613 also all followups to the matching articles. This allows you | |
614 e.g. increase the score of followups to your own articles, or decrease | |
615 the score of followups to the articles of some known trouble-maker. | |
616 ") | |
617 (gnus-score-string :tag "Thread" | |
618 :doc "\ | |
619 Add a score entry on all articles that are part of a thread. | |
620 | |
621 This match key works along the same lines as the `Followup' match key. | |
622 If you say that you want to score on a (sub-)thread that is started by | |
623 an article with a `Message-ID' X, then you add a `thread' match. This | |
624 will add a new `thread' match for each article that has X in its | |
625 `References' header. (These new `thread' matches will use the | |
626 `Message-ID's of these matching articles.) This will ensure that you | |
627 can raise/lower the score of an entire thread, even though some | |
628 articles in the thread may not have complete `References' headers. | |
629 Note that using this may lead to undeterministic scores of the | |
630 articles in the thread. | |
631 ") | |
632 ,@types) | |
633 '(repeat :inline t | |
634 :tag "Unknown entries" | |
635 sexp))) | |
636 (use-local-map widget-keymap) | |
637 (widget-setup))) | |
638 | |
639 (defun gnus-score-customize-done (&rest ignore) | |
640 "Reset the score alist with the present value." | |
641 (let ((alist gnus-custom-score-alist) | |
642 (value (widget-value gnus-custom-scores))) | |
643 (setcar alist (car value)) | |
644 (setcdr alist (cdr value)) | |
645 (gnus-score-set 'touched '(t) alist)) | |
646 (bury-buffer)) | |
647 | |
648 ;;; The End: | |
649 | |
650 (provide 'gnus-cus) | |
651 | |
652 ;;; gnus-cus.el ends here |