1 |
;;; gnus-cus.el --- customization commands for Gnus |
;;; gnus-cus.el --- customization commands for Gnus |
2 |
;; |
;; |
3 |
;; Copyright (C) 1996,1999, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004 |
4 |
|
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Per Abrahamsen <abraham@dina.kvl.dk> |
;; Author: Per Abrahamsen <abraham@dina.kvl.dk> |
7 |
;; Keywords: news |
;; Keywords: news |
28 |
;;; Code: |
;;; Code: |
29 |
|
|
30 |
(require 'wid-edit) |
(require 'wid-edit) |
31 |
|
(require 'gnus) |
32 |
|
(require 'gnus-agent) |
33 |
(require 'gnus-score) |
(require 'gnus-score) |
34 |
(require 'gnus-topic) |
(require 'gnus-topic) |
35 |
|
(require 'gnus-art) |
36 |
|
|
37 |
;;; Widgets: |
;;; Widgets: |
38 |
|
|
|
;; There should be special validation for this. |
|
|
(define-widget 'gnus-email-address 'string |
|
|
"An email address") |
|
|
|
|
39 |
(defun gnus-custom-mode () |
(defun gnus-custom-mode () |
40 |
"Major mode for editing Gnus customization buffers. |
"Major mode for editing Gnus customization buffers. |
41 |
|
|
72 |
;;; Group Customization: |
;;; Group Customization: |
73 |
|
|
74 |
(defconst gnus-group-parameters |
(defconst gnus-group-parameters |
75 |
'((to-address (gnus-email-address :tag "To Address") "\ |
'((extra-aliases (choice |
|
This will be used when doing followups and posts. |
|
|
|
|
|
This is primarily useful in mail groups that represent closed |
|
|
mailing lists--mailing lists where it's expected that everybody that |
|
|
writes to the mailing list is subscribed to it. Since using this |
|
|
parameter ensures that the mail only goes to the mailing list itself, |
|
|
it means that members won't receive two copies of your followups. |
|
|
|
|
|
Using `to-address' will actually work whether the group is foreign or |
|
|
not. Let's say there's a group on the server that is called |
|
|
`fa.4ad-l'. This is a real newsgroup, but the server has gotten the |
|
|
articles from a mail-to-news gateway. Posting directly to this group |
|
|
is therefore impossible--you have to send mail to the mailing list |
|
|
address instead. |
|
|
|
|
|
The gnus-group-split mail splitting mechanism will behave as if this |
|
|
address was listed in gnus-group-split Addresses (see below).") |
|
|
|
|
|
(to-list (gnus-email-address :tag "To List") "\ |
|
|
This address will be used when doing a `a' in the group. |
|
|
|
|
|
It is totally ignored when doing a followup--except that if it is |
|
|
present in a news group, you'll get mail group semantics when doing |
|
|
`f'. |
|
|
|
|
|
The gnus-group-split mail splitting mechanism will behave as if this |
|
|
address was listed in gnus-group-split Addresses (see below).") |
|
|
|
|
|
(extra-aliases (choice |
|
76 |
:tag "Extra Aliases" |
:tag "Extra Aliases" |
77 |
(list |
(list |
78 |
:tag "List" |
:tag "List" |
139 |
`gcc' header (this symbol takes precedence over any default `Gcc' |
`gcc' header (this symbol takes precedence over any default `Gcc' |
140 |
rules as described later).") |
rules as described later).") |
141 |
|
|
|
(banner (choice :tag "Banner" |
|
|
:value nil |
|
|
(const :tag "Remove signature" signature) |
|
|
(symbol :tag "Item in `gnus-article-banner-alist'" none) |
|
|
regexp |
|
|
(const :tag "None" nil)) "\ |
|
|
If non-nil, specify how to remove `banners' from articles. |
|
|
|
|
|
Symbol `signature' means to remove signatures delimited by |
|
|
`gnus-signature-separator'. Any other symbol is used to look up a |
|
|
regular expression to match the banner in `gnus-article-banner-alist'. |
|
|
A string is used as a regular expression to match the banner |
|
|
directly.") |
|
|
|
|
|
(auto-expire (const :tag "Automatic Expire" t) "\ |
|
|
All articles that are read will be marked as expirable.") |
|
|
|
|
|
(total-expire (const :tag "Total Expire" t) "\ |
|
|
All read articles will be put through the expiry process |
|
|
|
|
|
This happens even if they are not marked as expirable. |
|
|
Use with caution.") |
|
|
|
|
142 |
(expiry-wait (choice :tag "Expire Wait" |
(expiry-wait (choice :tag "Expire Wait" |
143 |
:value never |
:value never |
144 |
(const never) |
(const never) |
153 |
`immediate'.") |
`immediate'.") |
154 |
|
|
155 |
(expiry-target (choice :tag "Expiry Target" |
(expiry-target (choice :tag "Expiry Target" |
156 |
:value delete |
:value delete |
157 |
(const delete) |
(const delete) |
158 |
(function :format "%v" nnmail-) |
(function :format "%v" nnmail-) |
159 |
string) "\ |
string) "\ |
160 |
Where expired messages end up. |
Where expired messages end up. |
161 |
|
|
162 |
Overrides `nnmail-expiry-target', which see.") |
Overrides `nnmail-expiry-target'.") |
163 |
|
|
164 |
(score-file (file :tag "Score File") "\ |
(score-file (file :tag "Score File") "\ |
165 |
Make the specified file into the current score file. |
Make the specified file into the current score file. |
180 |
(display (choice :tag "Display" |
(display (choice :tag "Display" |
181 |
:value default |
:value default |
182 |
(const all) |
(const all) |
183 |
(const default)) "\ |
(integer) |
184 |
|
(const default) |
185 |
|
(sexp :tag "Other")) "\ |
186 |
Which articles to display on entering the group. |
Which articles to display on entering the group. |
187 |
|
|
188 |
`all' |
`all' |
189 |
Display all articles, both read and unread. |
Display all articles, both read and unread. |
190 |
|
|
191 |
|
`integer' |
192 |
|
Display the last NUMBER articles in the group. This is the same as |
193 |
|
entering the group with C-u NUMBER. |
194 |
|
|
195 |
`default' |
`default' |
196 |
Display the default visible articles, which normally includes |
Display the default visible articles, which normally includes |
197 |
unread and ticked articles.") |
unread and ticked articles. |
198 |
|
|
199 |
|
`Other' |
200 |
|
Display the articles that satisfy the S-expression. The S-expression |
201 |
|
should be in an array form.") |
202 |
|
|
203 |
(comment (string :tag "Comment") "\ |
(comment (string :tag "Comment") "\ |
204 |
An arbitrary comment on the group.") |
An arbitrary comment on the group.") |
205 |
|
|
206 |
(visible (const :tag "Permanently visible" t) "\ |
(visible (const :tag "Permanently visible" t) "\ |
207 |
Always display this group, even when there are no unread articles |
Always display this group, even when there are no unread articles in it.") |
|
in it..") |
|
|
|
|
|
(charset (symbol :tag "Charset") "\ |
|
|
The default charset to use in the group.") |
|
|
|
|
|
(ignored-charsets |
|
|
(choice :tag "Ignored charsets" |
|
|
:value nil |
|
|
(repeat (symbol))) "\ |
|
|
List of charsets that should be ignored. |
|
|
|
|
|
When these charsets are used in the \"charset\" parameter, the |
|
|
default charset will be used instead.") |
|
208 |
|
|
209 |
(highlight-words |
(highlight-words |
210 |
(choice :tag "Highlight words" |
(choice :tag "Highlight words" |
215 |
(symbol :tag "Face" |
(symbol :tag "Face" |
216 |
gnus-emphasis-highlight-words)))) |
gnus-emphasis-highlight-words)))) |
217 |
"highlight regexps. |
"highlight regexps. |
218 |
See gnus-emphasis-alist.") |
See `gnus-emphasis-alist'.") |
219 |
|
|
220 |
(posting-style |
(posting-style |
221 |
(choice :tag "Posting style" |
(choice :tag "Posting style" |
222 |
:value nil |
:value nil |
223 |
(repeat (list |
(repeat (list |
224 |
(choice :tag "Type" |
(choice :tag "Type" |
225 |
:value nil |
:value nil |
226 |
(const signature) |
(const signature) |
227 |
(const signature-file) |
(const signature-file) |
228 |
(const organization) |
(const organization) |
229 |
(const address) |
(const address) |
230 |
(const name) |
(const name) |
231 |
(const body)) |
(const body)) |
232 |
(string :format "%v")))) |
(string :format "%v")))) |
233 |
"post style. |
"post style. |
234 |
See gnus-posting-styles.")) |
See `gnus-posting-styles'.")) |
235 |
"Alist of valid group or topic parameters. |
"Alist of valid group or topic parameters. |
236 |
|
|
237 |
Each entry has the form (NAME TYPE DOC), where NAME is the parameter |
Each entry has the form (NAME TYPE DOC), where NAME is the parameter |
240 |
|
|
241 |
(defconst gnus-extra-topic-parameters |
(defconst gnus-extra-topic-parameters |
242 |
'((subscribe (regexp :tag "Subscribe") "\ |
'((subscribe (regexp :tag "Subscribe") "\ |
243 |
If `gnus-subscribe-newsgroup-method' is set to |
If `gnus-subscribe-newsgroup-method' or |
244 |
|
`gnus-subscribe-options-newsgroup-method' is set to |
245 |
`gnus-subscribe-topics', new groups that matches this regexp will |
`gnus-subscribe-topics', new groups that matches this regexp will |
246 |
automatically be subscribed to this topic")) |
automatically be subscribed to this topic") |
247 |
|
(subscribe-level (integer :tag "Subscribe Level" :value 1) "\ |
248 |
|
If this topic parameter is set, when new groups are subscribed |
249 |
|
automatically under this topic (via the `subscribe' topic parameter) |
250 |
|
assign this level to the group, rather than the default level |
251 |
|
set in `gnus-level-default-subscribed'")) |
252 |
"Alist of topic parameters that are not also group parameters. |
"Alist of topic parameters that are not also group parameters. |
253 |
|
|
254 |
Each entry has the form (NAME TYPE DOC), where NAME is the parameter |
Each entry has the form (NAME TYPE DOC), where NAME is the parameter |
263 |
Each entry has the form (NAME TYPE DOC), where NAME is the parameter |
Each entry has the form (NAME TYPE DOC), where NAME is the parameter |
264 |
itself (a symbol), TYPE is the parameters type (a sexp widget), and |
itself (a symbol), TYPE is the parameters type (a sexp widget), and |
265 |
DOC is a documentation string for the parameter.") |
DOC is a documentation string for the parameter.") |
266 |
|
|
267 |
|
(eval-and-compile |
268 |
|
(defconst gnus-agent-parameters |
269 |
|
'((agent-predicate |
270 |
|
(sexp :tag "Selection Predicate" :value false) |
271 |
|
"Predicate used to automatically select articles for downloading." |
272 |
|
gnus-agent-cat-predicate) |
273 |
|
(agent-score |
274 |
|
(choice :tag "Score File" :value nil |
275 |
|
(const file :tag "Use group's score files") |
276 |
|
(repeat (list (string :format "%v" :tag "File name")))) |
277 |
|
"Which score files to use when using score to select articles to fetch. |
278 |
|
|
279 |
|
`nil' |
280 |
|
All articles will be scored to zero (0). |
281 |
|
|
282 |
|
`file' |
283 |
|
The group's score files will be used to score the articles. |
284 |
|
|
285 |
|
`List' |
286 |
|
A list of score file names." |
287 |
|
gnus-agent-cat-score-file) |
288 |
|
(agent-short-article |
289 |
|
(integer :tag "Max Length of Short Article" :value "") |
290 |
|
"The SHORT predicate will evaluate to true when the article is |
291 |
|
shorter than this length." gnus-agent-cat-length-when-short) |
292 |
|
(agent-long-article |
293 |
|
(integer :tag "Min Length of Long Article" :value "") |
294 |
|
"The LONG predicate will evaluate to true when the article is |
295 |
|
longer than this length." gnus-agent-cat-length-when-long) |
296 |
|
(agent-low-score |
297 |
|
(integer :tag "Low Score Limit" :value "") |
298 |
|
"The LOW predicate will evaluate to true when the article scores |
299 |
|
lower than this limit." gnus-agent-cat-low-score) |
300 |
|
(agent-high-score |
301 |
|
(integer :tag "High Score Limit" :value "") |
302 |
|
"The HIGH predicate will evaluate to true when the article scores |
303 |
|
higher than this limit." gnus-agent-cat-high-score) |
304 |
|
(agent-days-until-old |
305 |
|
(integer :tag "Days Until Old" :value "") |
306 |
|
"The OLD predicate will evaluate to true when the fetched article |
307 |
|
has been stored locally for at least this many days." |
308 |
|
gnus-agent-cat-days-until-old) |
309 |
|
(agent-enable-expiration |
310 |
|
(radio :tag "Expire in this Group or Topic" :value nil |
311 |
|
(const :format "Enable " ENABLE) |
312 |
|
(const :format "Disable " DISABLE)) |
313 |
|
"\nEnable, or disable, agent expiration in this group or topic." |
314 |
|
gnus-agent-cat-enable-expiration) |
315 |
|
(agent-enable-undownloaded-faces |
316 |
|
(boolean :tag "Enable Agent Faces") |
317 |
|
"Have the summary buffer use the agent's undownloaded faces. |
318 |
|
These faces, when enabled, act as a warning that an article has not |
319 |
|
been fetched into either the agent nor the cache. This is of most use |
320 |
|
to users who use the agent as a cache (i.e. they only operate on |
321 |
|
articles that have been downloaded). Leave disabled to display normal |
322 |
|
article faces even when the article hasn't been downloaded." |
323 |
|
gnus-agent-cat-enable-undownloaded-faces)) |
324 |
|
"Alist of group parameters that are not also topic parameters. |
325 |
|
|
326 |
|
Each entry has the form (NAME TYPE DOC ACCESSOR), where NAME is the |
327 |
|
parameter itself (a symbol), TYPE is the parameters type (a sexp |
328 |
|
widget), DOC is a documentation string for the parameter, and ACCESSOR |
329 |
|
is a function (symbol) that extracts the current value from the |
330 |
|
category.")) |
331 |
|
|
332 |
(defvar gnus-custom-params) |
(defvar gnus-custom-params) |
333 |
(defvar gnus-custom-method) |
(defvar gnus-custom-method) |
334 |
(defvar gnus-custom-group) |
(defvar gnus-custom-group) |
343 |
:doc ,(nth 2 entry) |
:doc ,(nth 2 entry) |
344 |
(const :format "" ,(nth 0 entry)) |
(const :format "" ,(nth 0 entry)) |
345 |
,(nth 1 entry))) |
,(nth 1 entry))) |
346 |
(append gnus-group-parameters |
(append (reverse gnus-group-parameters-more) |
347 |
|
gnus-group-parameters |
348 |
(if group |
(if group |
349 |
gnus-extra-group-parameters |
gnus-extra-group-parameters |
350 |
gnus-extra-topic-parameters))))) |
gnus-extra-topic-parameters)))) |
351 |
|
(agent (mapcar (lambda (entry) |
352 |
|
(let ((type (nth 1 entry)) |
353 |
|
vcons) |
354 |
|
(if (listp type) |
355 |
|
(setq type (copy-sequence type))) |
356 |
|
|
357 |
|
(setq vcons (cdr (memq :value type))) |
358 |
|
|
359 |
|
(if (symbolp (car vcons)) |
360 |
|
(condition-case nil |
361 |
|
(setcar vcons (symbol-value (car vcons))) |
362 |
|
(error))) |
363 |
|
`(cons :format "%v%h\n" |
364 |
|
:doc ,(nth 2 entry) |
365 |
|
(const :format "" ,(nth 0 entry)) |
366 |
|
,type))) |
367 |
|
(if gnus-agent |
368 |
|
gnus-agent-parameters)))) |
369 |
(unless (or group topic) |
(unless (or group topic) |
370 |
(error "No group on current line")) |
(error "No group on current line")) |
371 |
(when (and group topic) |
(when (and group topic) |
372 |
(error "Both a group and topic on current line")) |
(error "Both a group an topic on current line")) |
373 |
(unless (or topic (setq info (gnus-get-info group))) |
(unless (or topic (setq info (gnus-get-info group))) |
374 |
(error "Killed group; can't be edited")) |
(error "Killed group; can't be edited")) |
375 |
;; Ready. |
;; Ready. |
376 |
(kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
(gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
377 |
(switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
(switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) |
378 |
(gnus-custom-mode) |
(gnus-custom-mode) |
379 |
(make-local-variable 'gnus-custom-group) |
(make-local-variable 'gnus-custom-group) |
400 |
:action 'gnus-group-customize-done) |
:action 'gnus-group-customize-done) |
401 |
(widget-insert ".\n\n") |
(widget-insert ".\n\n") |
402 |
(make-local-variable 'gnus-custom-params) |
(make-local-variable 'gnus-custom-params) |
403 |
(setq gnus-custom-params |
|
404 |
(widget-create 'group |
(let ((values (if group |
405 |
:value (if group |
(gnus-info-params info) |
406 |
(gnus-info-params info) |
(gnus-topic-parameters topic)))) |
407 |
(gnus-topic-parameters topic)) |
|
408 |
`(set :inline t |
;; The parameters in values may contain duplicates. This is |
409 |
:greedy t |
;; normally OK as assq returns the first. However, right here |
410 |
:tag "Parameters" |
;; every duplicate ends up being displayed. So, rather than |
411 |
:format "%t:\n%h%v" |
;; display them, remove them from the list. |
412 |
:doc "\ |
|
413 |
|
(let ((tmp (setq values (gnus-copy-sequence values))) |
414 |
|
elem) |
415 |
|
(while (cdr tmp) |
416 |
|
(while (setq elem (assq (caar tmp) (cdr tmp))) |
417 |
|
(delq elem tmp)) |
418 |
|
(setq tmp (cdr tmp)))) |
419 |
|
|
420 |
|
(setq gnus-custom-params |
421 |
|
(apply 'widget-create 'group |
422 |
|
:value values |
423 |
|
(delq nil |
424 |
|
(list `(set :inline t |
425 |
|
:greedy t |
426 |
|
:tag "Parameters" |
427 |
|
:format "%t:\n%h%v" |
428 |
|
:doc "\ |
429 |
These special parameters are recognized by Gnus. |
These special parameters are recognized by Gnus. |
430 |
Check the [ ] for the parameters you want to apply to this group or |
Check the [ ] for the parameters you want to apply to this group or |
431 |
to the groups in this topic, then edit the value to suit your taste." |
to the groups in this topic, then edit the value to suit your taste." |
432 |
,@types) |
,@types) |
433 |
'(repeat :inline t |
(when gnus-agent |
434 |
:tag "Variables" |
`(set :inline t |
435 |
:format "%t:\n%h%v%i\n\n" |
:greedy t |
436 |
:doc "\ |
:tag "Agent Parameters" |
437 |
|
:format "%t:\n%h%v" |
438 |
|
:doc "\ These agent parameters are |
439 |
|
recognized by Gnus. They control article selection and expiration for |
440 |
|
use in the unplugged cache. Check the [ ] for the parameters you want |
441 |
|
to apply to this group or to the groups in this topic, then edit the |
442 |
|
value to suit your taste. |
443 |
|
|
444 |
|
For those interested, group parameters override topic parameters while |
445 |
|
topic parameters override agent category parameters. Underlying |
446 |
|
category parameters are the customizable variables." ,@agent)) |
447 |
|
'(repeat :inline t |
448 |
|
:tag "Variables" |
449 |
|
:format "%t:\n%h%v%i\n\n" |
450 |
|
:doc "\ |
451 |
Set variables local to the group you are entering. |
Set variables local to the group you are entering. |
452 |
|
|
453 |
If you want to turn threading off in `news.answers', you could put |
If you want to turn threading off in `news.answers', you could put |
460 |
put something like `(dummy-variable (ding))' in the parameters of that |
put something like `(dummy-variable (ding))' in the parameters of that |
461 |
group. `dummy-variable' will be set to the result of the `(ding)' |
group. `dummy-variable' will be set to the result of the `(ding)' |
462 |
form, but who cares?" |
form, but who cares?" |
463 |
(list :format "%v" :value (nil nil) |
(list :format "%v" :value (nil nil) |
464 |
(symbol :tag "Variable") |
(symbol :tag "Variable") |
465 |
(sexp :tag |
(sexp :tag |
466 |
"Value"))) |
"Value"))) |
467 |
|
|
468 |
'(repeat :inline t |
'(repeat :inline t |
469 |
:tag "Unknown entries" |
:tag "Unknown entries" |
470 |
sexp))) |
sexp)))))) |
471 |
(when group |
(when group |
472 |
(widget-insert "\n\nYou can also edit the ") |
(widget-insert "\n\nYou can also edit the ") |
473 |
(widget-create 'info-link |
(widget-create 'info-link |
767 |
(defvar gnus-custom-score-alist) |
(defvar gnus-custom-score-alist) |
768 |
|
|
769 |
(defun gnus-score-customize (file) |
(defun gnus-score-customize (file) |
770 |
"Customize score file FILE." |
"Customize score file FILE. |
771 |
|
When called interactively, FILE defaults to the current score file. |
772 |
|
This can be changed using the `\\[gnus-score-change-score-file]' command." |
773 |
(interactive (list gnus-current-score-file)) |
(interactive (list gnus-current-score-file)) |
774 |
|
(unless file |
775 |
|
(error (format "No score file for %s" |
776 |
|
(gnus-group-decoded-name gnus-newsgroup-name)))) |
777 |
(let ((scores (gnus-score-load file)) |
(let ((scores (gnus-score-load file)) |
778 |
(types (mapcar (lambda (entry) |
(types (mapcar (lambda (entry) |
779 |
`(group :format "%v%h\n" |
`(group :format "%v%h\n" |
885 |
(gnus-score-set 'touched '(t) alist)) |
(gnus-score-set 'touched '(t) alist)) |
886 |
(bury-buffer)) |
(bury-buffer)) |
887 |
|
|
888 |
|
(eval-when-compile |
889 |
|
(defvar category-fields nil) |
890 |
|
(defvar gnus-agent-cat-name) |
891 |
|
(defvar gnus-agent-cat-score-file) |
892 |
|
(defvar gnus-agent-cat-length-when-short) |
893 |
|
(defvar gnus-agent-cat-length-when-long) |
894 |
|
(defvar gnus-agent-cat-low-score) |
895 |
|
(defvar gnus-agent-cat-high-score) |
896 |
|
(defvar gnus-agent-cat-enable-expiration) |
897 |
|
(defvar gnus-agent-cat-days-until-old) |
898 |
|
(defvar gnus-agent-cat-predicate) |
899 |
|
(defvar gnus-agent-cat-groups) |
900 |
|
(defvar gnus-agent-cat-enable-undownloaded-faces) |
901 |
|
) |
902 |
|
|
903 |
|
(defun gnus-trim-whitespace (s) |
904 |
|
(when (string-match "\\`[ \n\t]+" s) |
905 |
|
(setq s (substring s (match-end 0)))) |
906 |
|
(when (string-match "[ \n\t]+\\'" s) |
907 |
|
(setq s (substring s 0 (match-beginning 0)))) |
908 |
|
s) |
909 |
|
|
910 |
|
(defmacro gnus-agent-cat-prepare-category-field (parameter) |
911 |
|
(let* ((entry (assq parameter gnus-agent-parameters)) |
912 |
|
(field (nth 3 entry))) |
913 |
|
`(let* ((type (copy-sequence |
914 |
|
(nth 1 (assq ',parameter gnus-agent-parameters)))) |
915 |
|
(val (,field info)) |
916 |
|
(deflt (if (,field defaults) |
917 |
|
(concat " [" (gnus-trim-whitespace |
918 |
|
(gnus-pp-to-string (,field defaults))) |
919 |
|
"]"))) |
920 |
|
symb) |
921 |
|
|
922 |
|
(if (eq (car type) 'radio) |
923 |
|
(let* ((rtype (nreverse type)) |
924 |
|
(rt rtype)) |
925 |
|
(while (listp (or (cadr rt) 'not-list)) |
926 |
|
(setq rt (cdr rt))) |
927 |
|
|
928 |
|
(setcdr rt (cons '(const :format "Inherit " nil) (cdr rt))) |
929 |
|
(setq type (nreverse rtype)))) |
930 |
|
|
931 |
|
(if deflt |
932 |
|
(let ((tag (cdr (memq :tag type)))) |
933 |
|
(when (string-match "\n" deflt) |
934 |
|
(while (progn (setq deflt (replace-match "\n " t t |
935 |
|
deflt)) |
936 |
|
(string-match "\n" deflt (match-end 0)))) |
937 |
|
(setq deflt (concat "\n" deflt))) |
938 |
|
|
939 |
|
(setcar tag (concat (car tag) deflt)))) |
940 |
|
|
941 |
|
(widget-insert "\n") |
942 |
|
|
943 |
|
(setq val (if val |
944 |
|
(widget-create type :value val) |
945 |
|
(widget-create type)) |
946 |
|
symb (set (make-local-variable ',field) val)) |
947 |
|
|
948 |
|
(widget-put symb :default val) |
949 |
|
(widget-put symb :accessor ',field) |
950 |
|
(push symb category-fields)))) |
951 |
|
|
952 |
|
(defun gnus-agent-customize-category (category) |
953 |
|
"Edit the CATEGORY." |
954 |
|
(interactive (list (gnus-category-name))) |
955 |
|
(let ((info (assq category gnus-category-alist)) |
956 |
|
(defaults (list nil '(agent-predicate . false) |
957 |
|
(cons 'agent-enable-expiration |
958 |
|
gnus-agent-enable-expiration) |
959 |
|
'(agent-days-until-old . 7) |
960 |
|
(cons 'agent-length-when-short |
961 |
|
gnus-agent-short-article) |
962 |
|
(cons 'agent-length-when-long gnus-agent-long-article) |
963 |
|
(cons 'agent-low-score gnus-agent-low-score) |
964 |
|
(cons 'agent-high-score gnus-agent-high-score)))) |
965 |
|
|
966 |
|
(let ((old (get-buffer "*Gnus Agent Category Customize*"))) |
967 |
|
(when old |
968 |
|
(gnus-kill-buffer old))) |
969 |
|
(switch-to-buffer (gnus-get-buffer-create |
970 |
|
"*Gnus Agent Category Customize*")) |
971 |
|
|
972 |
|
(let ((inhibit-read-only t)) |
973 |
|
(gnus-custom-mode) |
974 |
|
(buffer-disable-undo) |
975 |
|
|
976 |
|
(let* ((name (gnus-agent-cat-name info))) |
977 |
|
(widget-insert "Customize the Agent Category '") |
978 |
|
(widget-insert (symbol-name name)) |
979 |
|
(widget-insert "' and press ") |
980 |
|
(widget-create |
981 |
|
'push-button |
982 |
|
:notify |
983 |
|
'(lambda (&rest ignore) |
984 |
|
(let* ((info (assq gnus-agent-cat-name gnus-category-alist)) |
985 |
|
(widgets category-fields)) |
986 |
|
(while widgets |
987 |
|
(let* ((widget (pop widgets)) |
988 |
|
(value (condition-case nil (widget-value widget) (error)))) |
989 |
|
(eval `(setf (,(widget-get widget :accessor) ',info) |
990 |
|
',value))))) |
991 |
|
(gnus-category-write) |
992 |
|
(gnus-kill-buffer (current-buffer)) |
993 |
|
(when (get-buffer gnus-category-buffer) |
994 |
|
(switch-to-buffer (get-buffer gnus-category-buffer)) |
995 |
|
(gnus-category-list))) |
996 |
|
"Done") |
997 |
|
(widget-insert |
998 |
|
"\n Note: Empty fields default to the customizable global\ |
999 |
|
variables.\n\n") |
1000 |
|
|
1001 |
|
(set (make-local-variable 'gnus-agent-cat-name) |
1002 |
|
name)) |
1003 |
|
|
1004 |
|
(set (make-local-variable 'category-fields) nil) |
1005 |
|
(gnus-agent-cat-prepare-category-field agent-predicate) |
1006 |
|
|
1007 |
|
(gnus-agent-cat-prepare-category-field agent-score) |
1008 |
|
(gnus-agent-cat-prepare-category-field agent-short-article) |
1009 |
|
(gnus-agent-cat-prepare-category-field agent-long-article) |
1010 |
|
(gnus-agent-cat-prepare-category-field agent-low-score) |
1011 |
|
(gnus-agent-cat-prepare-category-field agent-high-score) |
1012 |
|
|
1013 |
|
;; The group list is NOT handled with |
1014 |
|
;; gnus-agent-cat-prepare-category-field as I don't want the |
1015 |
|
;; group list to appear when customizing a topic. |
1016 |
|
(widget-insert "\n") |
1017 |
|
|
1018 |
|
(let ((symb |
1019 |
|
(set |
1020 |
|
(make-local-variable 'gnus-agent-cat-groups) |
1021 |
|
(widget-create |
1022 |
|
`(choice |
1023 |
|
:format "%[Select Member Groups%]\n%v" :value ignore |
1024 |
|
(const :menu-tag "do not change" :tag "" :value ignore) |
1025 |
|
(checklist :entry-format "%b %v" |
1026 |
|
:menu-tag "display group selectors" |
1027 |
|
:greedy t |
1028 |
|
:value |
1029 |
|
,(delq nil |
1030 |
|
(mapcar |
1031 |
|
(lambda (newsrc) |
1032 |
|
(car (member |
1033 |
|
(gnus-info-group newsrc) |
1034 |
|
(gnus-agent-cat-groups info)))) |
1035 |
|
(cdr gnus-newsrc-alist))) |
1036 |
|
,@(mapcar (lambda (newsrc) |
1037 |
|
`(const ,(gnus-info-group newsrc))) |
1038 |
|
(cdr gnus-newsrc-alist)))))))) |
1039 |
|
|
1040 |
|
(widget-put symb :default (gnus-agent-cat-groups info)) |
1041 |
|
(widget-put symb :accessor 'gnus-agent-cat-groups) |
1042 |
|
(push symb category-fields)) |
1043 |
|
|
1044 |
|
(widget-insert "\nExpiration Settings ") |
1045 |
|
|
1046 |
|
(gnus-agent-cat-prepare-category-field agent-enable-expiration) |
1047 |
|
(gnus-agent-cat-prepare-category-field agent-days-until-old) |
1048 |
|
|
1049 |
|
(widget-insert "\nVisual Settings ") |
1050 |
|
|
1051 |
|
(gnus-agent-cat-prepare-category-field agent-enable-undownloaded-faces) |
1052 |
|
|
1053 |
|
(use-local-map widget-keymap) |
1054 |
|
(widget-setup) |
1055 |
|
(buffer-enable-undo)))) |
1056 |
|
|
1057 |
;;; The End: |
;;; The End: |
1058 |
|
|
1059 |
(provide 'gnus-cus) |
(provide 'gnus-cus) |