Mercurial > hg > xemacs-beta
comparison lisp/gnus/gnus-cus.el @ 108:360340f9fd5f r20-1b6
Import from CVS: tag r20-1b6
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:18:39 +0200 |
parents | 8ff55ebd4be9 |
children |
comparison
equal
deleted
inserted
replaced
107:523141596bda | 108:360340f9fd5f |
---|---|
29 (require 'wid-edit) | 29 (require 'wid-edit) |
30 (require 'gnus-score) | 30 (require 'gnus-score) |
31 | 31 |
32 ;;; Widgets: | 32 ;;; Widgets: |
33 | 33 |
34 ;; There should be special validation for this. | 34 ;; There should be special validation for this. |
35 (define-widget 'gnus-email-address 'string | 35 (define-widget 'gnus-email-address 'string |
36 "An email address") | 36 "An email address") |
37 | 37 |
38 (defun gnus-custom-mode () | 38 (defun gnus-custom-mode () |
39 "Major mode for editing Gnus customization buffers. | 39 "Major mode for editing Gnus customization buffers. |
57 | 57 |
58 (defconst gnus-group-parameters | 58 (defconst gnus-group-parameters |
59 '((to-address (gnus-email-address :tag "To Address") "\ | 59 '((to-address (gnus-email-address :tag "To Address") "\ |
60 This will be used when doing followups and posts. | 60 This will be used when doing followups and posts. |
61 | 61 |
62 This is primarily useful in mail groups that represent closed | 62 This is primarily useful in mail groups that represent closed |
63 mailing lists--mailing lists where it's expected that everybody that | 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 | 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, | 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. | 66 it means that members won't receive two copies of your followups. |
67 | 67 |
71 articles from a mail-to-news gateway. Posting directly to this group | 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 | 72 is therefore impossible--you have to send mail to the mailing list |
73 address instead.") | 73 address instead.") |
74 | 74 |
75 (to-list (gnus-email-address :tag "To List") "\ | 75 (to-list (gnus-email-address :tag "To List") "\ |
76 This address will be used when doing a `a' in the group. | 76 This address will be used when doing a `a' in the group. |
77 | 77 |
78 It is totally ignored when doing a followup--except that if it is | 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 | 79 present in a news group, you'll get mail group semantics when doing |
80 `f'.") | 80 `f'.") |
81 | 81 |
86 listserv has inserted `Reply-To' headers that point back to the | 86 listserv has inserted `Reply-To' headers that point back to the |
87 listserv itself. This is broken behavior. So there!") | 87 listserv itself. This is broken behavior. So there!") |
88 | 88 |
89 (to-group (string :tag "To Group") "\ | 89 (to-group (string :tag "To Group") "\ |
90 All posts will be send to the specified group.") | 90 All posts will be send to the specified group.") |
91 | 91 |
92 (gcc-self (choice :tag "GCC" | 92 (gcc-self (choice :tag "GCC" |
93 :value t | 93 :value t |
94 (const t) | 94 (const t) |
95 (const none) | 95 (const none) |
96 (string :format "%v" :hide-front-space t)) "\ | 96 (string :format "%v" :hide-front-space t)) "\ |
103 `gcc' header (this symbol takes precedence over any default `Gcc' | 103 `gcc' header (this symbol takes precedence over any default `Gcc' |
104 rules as described later).") | 104 rules as described later).") |
105 | 105 |
106 (auto-expire (const :tag "Automatic Expire" t) "\ | 106 (auto-expire (const :tag "Automatic Expire" t) "\ |
107 All articles that are read will be marked as expirable.") | 107 All articles that are read will be marked as expirable.") |
108 | 108 |
109 (total-expire (const :tag "Total Expire" t) "\ | 109 (total-expire (const :tag "Total Expire" t) "\ |
110 All read articles will be put through the expiry process | 110 All read articles will be put through the expiry process |
111 | 111 |
112 This happens even if they are not marked as expirable. | 112 This happens even if they are not marked as expirable. |
113 Use with caution.") | 113 Use with caution.") |
114 | 114 |
115 (expiry-wait (choice :tag "Expire Wait" | 115 (expiry-wait (choice :tag "Expire Wait" |
116 :value never | 116 :value never |
117 (const never) | 117 (const never) |
118 (const immediate) | 118 (const immediate) |
119 (number :hide-front-space t | 119 (number :hide-front-space t |
120 :format "%v")) "\ | 120 :format "%v")) "\ |
121 When to expire. | 121 When to expire. |
122 | 122 |
123 Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' | 123 Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' |
124 when expiring expirable messages. The value can either be a number of | 124 when expiring expirable messages. The value can either be a number of |
125 days (not necessarily an integer) or the symbols `never' or | 125 days (not necessarily an integer) or the symbols `never' or |
126 `immediate'.") | 126 `immediate'.") |
127 | 127 |
128 (score-file (file :tag "Score File") "\ | 128 (score-file (file :tag "Score File") "\ |
129 Make the specified file into the current 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.") | 130 This means that all score commands you issue will end up in this file.") |
131 | 131 |
132 (adapt-file (file :tag "Adapt File") "\ | 132 (adapt-file (file :tag "Adapt File") "\ |
133 Make the specified file into the current adaptive file. | 133 Make the specified file into the current adaptive file. |
134 All adaptive score entries will be put into this file.") | 134 All adaptive score entries will be put into this file.") |
135 | 135 |
136 (admin-address (gnus-email-address :tag "Admin Address") "\ | 136 (admin-address (gnus-email-address :tag "Admin Address") "\ |
137 Administration address for a mailing list. | 137 Administration address for a mailing list. |
138 | 138 |
143 | 143 |
144 (display (choice :tag "Display" | 144 (display (choice :tag "Display" |
145 :value default | 145 :value default |
146 (const all) | 146 (const all) |
147 (const default)) "\ | 147 (const default)) "\ |
148 Which articles to display on entering the group. | 148 Which articles to display on entering the group. |
149 | 149 |
150 `all' | 150 `all' |
151 Display all articles, both read and unread. | 151 Display all articles, both read and unread. |
152 | 152 |
153 `default' | 153 `default' |
154 Display the default visible articles, which normally includes | 154 Display the default visible articles, which normally includes |
155 unread and ticked articles.") | 155 unread and ticked articles.") |
156 | 156 |
157 (comment (string :tag "Comment") "\ | 157 (comment (string :tag "Comment") "\ |
158 An arbitrary comment on the group.")) | 158 An arbitrary comment on the group.")) |
159 "Alist of valid group parameters. | 159 "Alist of valid group parameters. |
160 | 160 |
161 Each entry has the form (NAME TYPE DOC), where NAME is the parameter | 161 Each entry has the form (NAME TYPE DOC), where NAME is the parameter |
162 itself (a symbol), TYPE is the parameters type (a sexp widget), and | 162 itself (a symbol), TYPE is the parameters type (a sexp widget), and |
163 DOC is a documentation string for the parameter.") | 163 DOC is a documentation string for the parameter.") |
164 | 164 |
215 ,@types) | 215 ,@types) |
216 '(repeat :inline t | 216 '(repeat :inline t |
217 :tag "Variables" | 217 :tag "Variables" |
218 :format "%t:\n%h%v%i\n\n" | 218 :format "%t:\n%h%v%i\n\n" |
219 :doc "\ | 219 :doc "\ |
220 Set variables local to the group you are entering. | 220 Set variables local to the group you are entering. |
221 | 221 |
222 If you want to turn threading off in `news.answers', you could put | 222 If you want to turn threading off in `news.answers', you could put |
223 `(gnus-show-threads nil)' in the group parameters of that group. | 223 `(gnus-show-threads nil)' in the group parameters of that group. |
224 `gnus-show-threads' will be made into a local variable in the summary | 224 `gnus-show-threads' will be made into a local variable in the summary |
225 buffer you enter, and the form `nil' will be `eval'ed there. | 225 buffer you enter, and the form `nil' will be `eval'ed there. |
231 form, but who cares?" | 231 form, but who cares?" |
232 (group :value (nil nil) | 232 (group :value (nil nil) |
233 (symbol :tag "Variable") | 233 (symbol :tag "Variable") |
234 (sexp :tag | 234 (sexp :tag |
235 "Value"))) | 235 "Value"))) |
236 | 236 |
237 '(repeat :inline t | 237 '(repeat :inline t |
238 :tag "Unknown entries" | 238 :tag "Unknown entries" |
239 sexp))) | 239 sexp))) |
240 (widget-insert "\n\nYou can also edit the ") | 240 (widget-insert "\n\nYou can also edit the ") |
241 (widget-create 'info-link | 241 (widget-create 'info-link |
242 :tag "select method" | 242 :tag "select method" |
243 :help-echo "Push me to learn more about select methods." | 243 :help-echo "Push me to learn more about select methods." |
244 "(gnus)Select Methods") | 244 "(gnus)Select Methods") |
245 (widget-insert " for the group.\n") | 245 (widget-insert " for the group.\n") |
246 (setq gnus-custom-method | 246 (setq gnus-custom-method |
247 (widget-create 'sexp | 247 (widget-create 'sexp |
248 :tag "Method" | 248 :tag "Method" |
249 :value (gnus-info-method info))) | 249 :value (gnus-info-method info))) |
250 (use-local-map widget-keymap) | 250 (use-local-map widget-keymap) |
251 (widget-setup))) | 251 (widget-setup))) |
252 | 252 |
253 (defun gnus-group-customize-done (&rest ignore) | 253 (defun gnus-group-customize-done (&rest ignore) |
254 "Apply changes and bury the buffer." | 254 "Apply changes and bury the buffer." |
255 (interactive) | 255 (interactive) |
256 (gnus-group-edit-group-done 'params gnus-custom-group | 256 (gnus-group-edit-group-done 'params gnus-custom-group |
257 (widget-value gnus-custom-params)) | 257 (widget-value gnus-custom-params)) |
258 (gnus-group-edit-group-done 'method gnus-custom-group | 258 (gnus-group-edit-group-done 'method gnus-custom-group |
259 (widget-value gnus-custom-method)) | 259 (widget-value gnus-custom-method)) |
260 (bury-buffer)) | 260 (bury-buffer)) |
261 | 261 |
262 ;;; Score Customization: | 262 ;;; Score Customization: |
263 | 263 |
264 (defconst gnus-score-parameters | 264 (defconst gnus-score-parameters |
265 '((mark (number :tag "Mark") "\ | 265 '((mark (number :tag "Mark") "\ |
266 The value of this entry should be a number. | 266 The value of this entry should be a number. |
267 Any articles with a score lower than this number will be marked as read.") | 267 Any articles with a score lower than this number will be marked as read.") |
268 | 268 |
269 (expunge (number :tag "Expunge") "\ | 269 (expunge (number :tag "Expunge") "\ |
270 The value of this entry should be a number. | 270 The value of this entry should be a number. |
271 Any articles with a score lower than this number will be removed from | 271 Any articles with a score lower than this number will be removed from |
272 the summary buffer.") | 272 the summary buffer.") |
273 | 273 |
274 (mark-and-expunge (number :tag "Mark-and-expunge") "\ | 274 (mark-and-expunge (number :tag "Mark-and-expunge") "\ |
275 The value of this entry should be a number. | 275 The value of this entry should be a number. |
276 Any articles with a score lower than this number will be marked as | 276 Any articles with a score lower than this number will be marked as |
277 read and removed from the summary buffer.") | 277 read and removed from the summary buffer.") |
278 | 278 |
279 (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\ | 279 (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\ |
280 The value of this entry should be a number. | 280 The value of this entry should be a number. |
281 All articles that belong to a thread that has a total score below this | 281 All articles that belong to a thread that has a total score below this |
282 number will be marked as read and removed from the summary buffer. | 282 number will be marked as read and removed from the summary buffer. |
283 `gnus-thread-score-function' says how to compute the total score | 283 `gnus-thread-score-function' says how to compute the total score |
284 for a thread.") | 284 for a thread.") |
285 | 285 |
286 (files (repeat :tag "Files" file) "\ | 286 (files (repeat :tag "Files" file) "\ |
287 The value of this entry should be any number of file names. | 287 The value of this entry should be any number of file names. |
288 These files are assumed to be score files as well, and will be loaded | 288 These files are assumed to be score files as well, and will be loaded |
289 the same way this one was.") | 289 the same way this one was.") |
290 | 290 |
291 (exclude-files (repeat :tag "Exclude-files" file) "\ | 291 (exclude-files (repeat :tag "Exclude-files" file) "\ |
292 The clue of this entry should be any number of files. | 292 The clue of this entry should be any number of files. |
293 These files will not be loaded, even though they would normally be so, | 293 These files will not be loaded, even though they would normally be so, |
294 for some reason or other.") | 294 for some reason or other.") |
295 | 295 |
296 (eval (sexp :tag "Eval" :value nil) "\ | 296 (eval (sexp :tag "Eval" :value nil) "\ |
297 The value of this entry will be `eval'el. | 297 The value of this entry will be `eval'el. |
298 This element will be ignored when handling global score files.") | 298 This element will be ignored when handling global score files.") |
299 | 299 |
300 (read-only (boolean :tag "Read-only" :value t) "\ | 300 (read-only (boolean :tag "Read-only" :value t) "\ |
301 Read-only score files will not be updated or saved. | 301 Read-only score files will not be updated or saved. |
302 Global score files should feature this atom.") | 302 Global score files should feature this atom.") |
303 | 303 |
304 (orphan (number :tag "Orphan") "\ | 304 (orphan (number :tag "Orphan") "\ |
305 The value of this entry should be a number. | 305 The value of this entry should be a number. |
306 Articles that do not have parents will get this number added to their | 306 Articles that do not have parents will get this number added to their |
307 scores. Imagine you follow some high-volume newsgroup, like | 307 scores. Imagine you follow some high-volume newsgroup, like |
308 `comp.lang.c'. Most likely you will only follow a few of the threads, | 308 `comp.lang.c'. Most likely you will only follow a few of the threads, |
309 also want to see any new threads. | 309 also want to see any new threads. |
310 | 310 |
321 | 321 |
322 I.e.---the orphan score atom is for high-volume groups where there | 322 I.e.---the orphan score atom is for high-volume groups where there |
323 exist a few interesting threads which can't be found automatically | 323 exist a few interesting threads which can't be found automatically |
324 by ordinary scoring rules.") | 324 by ordinary scoring rules.") |
325 | 325 |
326 (adapt (choice :tag "Adapt" | 326 (adapt (choice :tag "Adapt" |
327 (const t) | 327 (const t) |
328 (const ignore) | 328 (const ignore) |
329 (sexp :format "%v" | 329 (sexp :format "%v" |
330 :hide-front-space t)) "\ | 330 :hide-front-space t)) "\ |
331 This entry controls the adaptive scoring. | 331 This entry controls the adaptive scoring. |
332 If it is `t', the default adaptive scoring rules will be used. If it | 332 If it is `t', the default adaptive scoring rules will be used. If it |
333 is `ignore', no adaptive scoring will be performed on this group. If | 333 is `ignore', no adaptive scoring will be performed on this group. If |
334 it is a list, this list will be used as the adaptive scoring rules. | 334 it is a list, this list will be used as the adaptive scoring rules. |
335 If it isn't present, or is something other than `t' or `ignore', the | 335 If it isn't present, or is something other than `t' or `ignore', the |
336 default adaptive scoring rules will be used. If you want to use | 336 default adaptive scoring rules will be used. If you want to use |
354 Each VAR will be made buffer-local to the current summary buffer, | 354 Each VAR will be made buffer-local to the current summary buffer, |
355 and set to the value specified. This is a convenient, if somewhat | 355 and set to the value specified. This is a convenient, if somewhat |
356 strange, way of setting variables in some groups if you don't like | 356 strange, way of setting variables in some groups if you don't like |
357 hooks much.") | 357 hooks much.") |
358 (touched (sexp :format "Touched\n") "Internal variable.")) | 358 (touched (sexp :format "Touched\n") "Internal variable.")) |
359 "Alist of valid symbolic score parameters. | 359 "Alist of valid symbolic score parameters. |
360 | 360 |
361 Each entry has the form (NAME TYPE DOC), where NAME is the parameter | 361 Each entry has the form (NAME TYPE DOC), where NAME is the parameter |
362 itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a | 362 itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a |
363 documentation string for the parameter.") | 363 documentation string for the parameter.") |
364 | 364 |
393 (const :tag "Word" w) | 393 (const :tag "Word" w) |
394 (const :tag "Word (fixed case)" W) | 394 (const :tag "Word (fixed case)" W) |
395 (const :tag "default" nil))) | 395 (const :tag "default" nil))) |
396 (group `(group ,match ,score ,expire ,type)) | 396 (group `(group ,match ,score ,expire ,type)) |
397 (doc (concat (or (widget-get widget :doc) | 397 (doc (concat (or (widget-get widget :doc) |
398 (concat "Change score based on the " tag | 398 (concat "Change score based on the " tag |
399 " header.\n")) | 399 " header.\n")) |
400 " | 400 " |
401 You can have an arbitrary number of score entries for this header, | 401 You can have an arbitrary number of score entries for this header, |
402 each score entry has four elements: | 402 each score entry has four elements: |
403 | 403 |
404 1. The \"match element\". This should be the string to look for in the | 404 1. The \"match element\". This should be the string to look for in the |
405 header. | 405 header. |
406 | 406 |
407 2. The \"score element\". This number should be an integer in the | 407 2. The \"score element\". This number should be an integer in the |
408 neginf to posinf interval. This number is added to the score | 408 neginf to posinf interval. This number is added to the score |
409 of the article if the match is successful. If this element is | 409 of the article if the match is successful. If this element is |
410 not present, the `gnus-score-interactive-default-score' number | 410 not present, the `gnus-score-interactive-default-score' number |
459 (const =) | 459 (const =) |
460 (const >=) | 460 (const >=) |
461 (const <=))) | 461 (const <=))) |
462 (group `(group ,match ,score ,expire ,type)) | 462 (group `(group ,match ,score ,expire ,type)) |
463 (doc (concat (or (widget-get widget :doc) | 463 (doc (concat (or (widget-get widget :doc) |
464 (concat "Change score based on the " tag | 464 (concat "Change score based on the " tag |
465 " header."))))) | 465 " header."))))) |
466 (widget-put widget :args `(,item | 466 (widget-put widget :args `(,item |
467 (repeat :inline t | 467 (repeat :inline t |
468 :indent 0 | 468 :indent 0 |
469 :tag ,tag | 469 :tag ,tag |
495 (const before) | 495 (const before) |
496 (const at) | 496 (const at) |
497 (const after))) | 497 (const after))) |
498 (group `(group ,match ,score ,expire ,type)) | 498 (group `(group ,match ,score ,expire ,type)) |
499 (doc (concat (or (widget-get widget :doc) | 499 (doc (concat (or (widget-get widget :doc) |
500 (concat "Change score based on the " tag | 500 (concat "Change score based on the " tag |
501 " header.")) | 501 " header.")) |
502 " | 502 " |
503 For the Date header we have three kinda silly match types: `before', | 503 For the Date header we have three kinda silly match types: `before', |
504 `at' and `after'. I can't really imagine this ever being useful, but, | 504 `at' and `after'. I can't really imagine this ever being useful, but, |
505 like, it would feel kinda silly not to provide this function. Just in | 505 like, it would feel kinda silly not to provide this function. Just in |
641 (setcdr alist (cdr value)) | 641 (setcdr alist (cdr value)) |
642 (gnus-score-set 'touched '(t) alist)) | 642 (gnus-score-set 'touched '(t) alist)) |
643 (bury-buffer)) | 643 (bury-buffer)) |
644 | 644 |
645 ;;; The End: | 645 ;;; The End: |
646 | 646 |
647 (provide 'gnus-cus) | 647 (provide 'gnus-cus) |
648 | 648 |
649 ;;; gnus-cus.el ends here | 649 ;;; gnus-cus.el ends here |
650 | 650 |