Commit | Line | Data |
---|---|---|
eec82323 LMI |
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) | |
6748645f | 54 | (gnus-run-hooks 'gnus-custom-mode-hook)) |
eec82323 LMI |
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") "\ | |
6748645f LMI |
158 | An arbitrary comment on the group.") |
159 | ||
160 | (visible (const :tag "Permanently visible" t) "\ | |
161 | Always display this group, even when there are no unread articles | |
162 | in it..")) | |
eec82323 LMI |
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 | ||
6748645f | 173 | (defun gnus-group-customize (group) |
eec82323 LMI |
174 | "Edit the group on the current line." |
175 | (interactive (list (gnus-group-group-name))) | |
6748645f | 176 | (let (info |
eec82323 LMI |
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. | |
6748645f LMI |
188 | (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
189 | (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) | |
eec82323 LMI |
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 | ||
6748645f | 289 | (files (repeat :inline t :tag "Files" file) "\ |
eec82323 LMI |
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 | ||
6748645f | 294 | (exclude-files (repeat :inline t :tag "Exclude-files" file) "\ |
eec82323 LMI |
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. | |
6748645f LMI |
546 | (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
547 | (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) | |
eec82323 LMI |
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 |