1 ;;; gnus-cus.el --- customization commands for Gnus
3 ;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
6 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
39 (defvar gnus-custom-map
40 (let ((map (make-keymap)))
41 (set-keymap-parent map widget-keymap)
43 (define-key map [mouse-1] 'widget-move-and-invoke)
45 "Keymap for editing Gnus customization buffers.")
47 (defun gnus-custom-mode ()
48 "Major mode for editing Gnus customization buffers.
50 The following commands are available:
52 \\[widget-forward] Move to next button or editable field.
53 \\[widget-backward] Move to previous button or editable field.
54 \\[widget-button-click] Activate button under the mouse pointer.
55 \\[widget-button-press] Activate button under point.
57 Entry to this mode calls the value of `gnus-custom-mode-hook'
58 if that value is non-nil."
59 (kill-all-local-variables)
60 (setq major-mode 'gnus-custom-mode
61 mode-name "Gnus Customize")
62 (use-local-map gnus-custom-map)
64 (when (and (facep 'custom-button-face)
65 (facep 'custom-button-pressed-face))
66 (set (make-local-variable 'widget-button-face)
68 (set (make-local-variable 'widget-button-pressed-face)
69 'custom-button-pressed-face)
70 (set (make-local-variable 'widget-mouse-face)
71 'custom-button-pressed-face))
72 (when (and (boundp 'custom-raised-buttons)
73 (symbol-value 'custom-raised-buttons))
74 (set (make-local-variable 'widget-push-button-prefix) "")
75 (set (make-local-variable 'widget-push-button-suffix) "")
76 (set (make-local-variable 'widget-link-prefix) "")
77 (set (make-local-variable 'widget-link-suffix) ""))
78 (gnus-run-mode-hooks 'gnus-custom-mode-hook))
80 ;;; Group Customization:
82 (defconst gnus-group-parameters
83 '((extra-aliases (choice
89 (gnus-email-address :tag "Address")))
90 (gnus-email-address :tag "Address")) "\
91 Store messages posted from or to this address in this group.
93 You must be using gnus-group-split for this to work. The VALUE of the
94 nnmail-split-fancy SPLIT generated for this group will match these
97 (split-regexp (regexp :tag "gnus-group-split Regular Expression") "\
98 Like gnus-group-split Address, but expects a regular expression.")
100 (split-exclude (list :tag "gnus-group-split Restricts"
102 :inline t (regexp :tag "Restrict"))) "\
103 Regular expression that cancels gnus-group-split matches.
105 Each entry is added to the nnmail-split-fancy SPLIT as a separate
108 (split-spec (choice :tag "gnus-group-split Overrider"
109 (sexp :tag "Fancy Split")
110 (const :tag "Catch All" catch-all)
111 (const :tag "Ignore" nil)) "\
112 Override all other gnus-group-split fields.
114 In `Fancy Split', you can enter any nnmail-split-fancy SPLIT. Note
115 that the name of this group won't be automatically assumed, you have
116 to add it to the SPLITs yourself. This means you can use such splits
117 to split messages to other groups too.
119 If you select `Catch All', this group will get postings for any
120 messages not matched in any other group. It overrides the variable
121 gnus-group-split-default-catch-all-group.
123 Selecting `Ignore' forces no SPLIT to be generated for this group,
124 disabling all other gnus-group-split fields.")
126 (broken-reply-to (const :tag "Broken Reply To" t) "\
127 Ignore `Reply-To' headers in this group.
129 That can be useful if you're reading a mailing list group where the
130 listserv has inserted `Reply-To' headers that point back to the
131 listserv itself. This is broken behavior. So there!")
133 (to-group (string :tag "To Group") "\
134 All posts will be sent to the specified group.")
136 (gcc-self (choice :tag "GCC"
138 (const :tag "To current group" t)
140 (string :format "%v" :hide-front-space t)) "\
141 Specify default value for GCC header.
143 If this symbol is present in the group parameter list and set to t,
144 new composed messages will be `Gcc''d to the current group. If it is
145 present and set to `none', no `Gcc:' header will be generated, if it
146 is present and a string, this string will be inserted literally as a
147 `gcc' header (this symbol takes precedence over any default `Gcc'
148 rules as described later).")
150 (expiry-wait (choice :tag "Expire Wait"
154 (number :hide-front-space t
158 Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function'
159 when expiring expirable messages. The value can either be a number of
160 days (not necessarily an integer) or the symbols `never' or
163 (expiry-target (choice :tag "Expiry Target"
166 (function :format "%v" nnmail-)
168 Where expired messages end up.
170 Overrides `nnmail-expiry-target'.")
172 (score-file (file :tag "Score File") "\
173 Make the specified file into the current score file.
174 This means that all score commands you issue will end up in this file.")
176 (adapt-file (file :tag "Adapt File") "\
177 Make the specified file into the current adaptive file.
178 All adaptive score entries will be put into this file.")
180 (admin-address (gnus-email-address :tag "Admin Address") "\
181 Administration address for a mailing list.
183 When unsubscribing to a mailing list you should never send the
184 unsubscription notice to the mailing list itself. Instead, you'd
185 send messages to the administrative address. This parameter allows
186 you to put the admin address somewhere convenient.")
188 (display (choice :tag "Display"
193 (sexp :tag "Other")) "\
194 Which articles to display on entering the group.
197 Display all articles, both read and unread.
200 Display the last NUMBER articles in the group. This is the same as
201 entering the group with C-u NUMBER.
204 Display the default visible articles, which normally includes
205 unread and ticked articles.
208 Display the articles that satisfy the S-expression. The S-expression
209 should be in an array form.")
211 (comment (string :tag "Comment") "\
212 An arbitrary comment on the group.")
214 (visible (const :tag "Permanently visible" t) "\
215 Always display this group, even when there are no unread articles in it.")
218 (choice :tag "Highlight words"
220 (repeat (list (regexp :tag "Highlight regexp")
221 (number :tag "Group for entire word" 0)
222 (number :tag "Group for displayed part" 0)
224 gnus-emphasis-highlight-words))))
226 See `gnus-emphasis-alist'.")
229 (choice :tag "Posting style"
235 (const signature-file)
240 (string :format "%v"))))
242 See `gnus-posting-styles'."))
243 "Alist of valid group or topic parameters.
245 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
246 itself (a symbol), TYPE is the parameters type (a sexp widget), and
247 DOC is a documentation string for the parameter.")
249 (defconst gnus-extra-topic-parameters
250 '((subscribe (regexp :tag "Subscribe") "\
251 If `gnus-subscribe-newsgroup-method' or
252 `gnus-subscribe-options-newsgroup-method' is set to
253 `gnus-subscribe-topics', new groups that matches this regexp will
254 automatically be subscribed to this topic")
255 (subscribe-level (integer :tag "Subscribe Level" :value 1) "\
256 If this topic parameter is set, when new groups are subscribed
257 automatically under this topic (via the `subscribe' topic parameter)
258 assign this level to the group, rather than the default level
259 set in `gnus-level-default-subscribed'"))
260 "Alist of topic parameters that are not also group parameters.
262 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
263 itself (a symbol), TYPE is the parameters type (a sexp widget), and
264 DOC is a documentation string for the parameter.")
266 (defconst gnus-extra-group-parameters
267 '((uidvalidity (string :tag "IMAP uidvalidity") "\
268 Server-assigned value attached to IMAP groups, used to maintain consistency."))
269 "Alist of group parameters that are not also topic parameters.
271 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
272 itself (a symbol), TYPE is the parameters type (a sexp widget), and
273 DOC is a documentation string for the parameter.")
276 (defconst gnus-agent-parameters
278 (sexp :tag "Selection Predicate" :value false)
279 "Predicate used to automatically select articles for downloading."
280 gnus-agent-cat-predicate)
282 (choice :tag "Score File" :value nil
283 (const file :tag "Use group's score files")
284 (repeat (list (string :format "%v" :tag "File name"))))
285 "Which score files to use when using score to select articles to fetch.
288 All articles will be scored to zero (0).
291 The group's score files will be used to score the articles.
294 A list of score file names."
295 gnus-agent-cat-score-file)
297 (integer :tag "Max Length of Short Article" :value "")
298 "The SHORT predicate will evaluate to true when the article is
299 shorter than this length." gnus-agent-cat-length-when-short)
301 (integer :tag "Min Length of Long Article" :value "")
302 "The LONG predicate will evaluate to true when the article is
303 longer than this length." gnus-agent-cat-length-when-long)
305 (integer :tag "Low Score Limit" :value "")
306 "The LOW predicate will evaluate to true when the article scores
307 lower than this limit." gnus-agent-cat-low-score)
309 (integer :tag "High Score Limit" :value "")
310 "The HIGH predicate will evaluate to true when the article scores
311 higher than this limit." gnus-agent-cat-high-score)
312 (agent-days-until-old
313 (integer :tag "Days Until Old" :value "")
314 "The OLD predicate will evaluate to true when the fetched article
315 has been stored locally for at least this many days."
316 gnus-agent-cat-days-until-old)
317 (agent-enable-expiration
318 (radio :tag "Expire in this Group or Topic" :value nil
319 (const :format "Enable " ENABLE)
320 (const :format "Disable " DISABLE))
321 "\nEnable, or disable, agent expiration in this group or topic."
322 gnus-agent-cat-enable-expiration)
323 (agent-enable-undownloaded-faces
324 (boolean :tag "Enable Agent Faces")
325 "Have the summary buffer use the agent's undownloaded faces.
326 These faces, when enabled, act as a warning that an article has not
327 been fetched into either the agent nor the cache. This is of most use
328 to users who use the agent as a cache (i.e. they only operate on
329 articles that have been downloaded). Leave disabled to display normal
330 article faces even when the article hasn't been downloaded."
331 gnus-agent-cat-enable-undownloaded-faces))
332 "Alist of group parameters that are not also topic parameters.
334 Each entry has the form (NAME TYPE DOC ACCESSOR), where NAME is the
335 parameter itself (a symbol), TYPE is the parameters type (a sexp
336 widget), DOC is a documentation string for the parameter, and ACCESSOR
337 is a function (symbol) that extracts the current value from the
340 (defvar gnus-custom-params)
341 (defvar gnus-custom-method)
342 (defvar gnus-custom-group)
343 (defvar gnus-custom-topic)
345 (defun gnus-group-customize (group &optional topic)
346 "Edit the group or topic on the current line."
347 (interactive (list (gnus-group-group-name) (gnus-group-topic-name)))
349 (types (mapcar (lambda (entry)
350 `(cons :format "%v%h\n"
352 (const :format "" ,(nth 0 entry))
354 (append (reverse gnus-group-parameters-more)
355 gnus-group-parameters
357 gnus-extra-group-parameters
358 gnus-extra-topic-parameters))))
359 (agent (mapcar (lambda (entry)
360 (let ((type (nth 1 entry))
363 (setq type (copy-sequence type)))
365 (setq vcons (cdr (memq :value type)))
367 (if (symbolp (car vcons))
369 (setcar vcons (symbol-value (car vcons)))
371 `(cons :format "%v%h\n"
373 (const :format "" ,(nth 0 entry))
376 gnus-agent-parameters))))
377 (unless (or group topic)
378 (error "No group on current line"))
379 (when (and group topic)
380 (error "Both a group an topic on current line"))
381 (unless (or topic (setq info (gnus-get-info group)))
382 (error "Killed group; can't be edited"))
384 (gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
385 (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
387 (make-local-variable 'gnus-custom-group)
388 (setq gnus-custom-group group)
389 (make-local-variable 'gnus-custom-topic)
390 (setq gnus-custom-topic topic)
391 (buffer-disable-undo)
392 (widget-insert "Customize the ")
394 (widget-create 'info-link
395 :help-echo "Push me to learn more."
396 :tag "group parameters"
397 "(gnus)Group Parameters")
398 (widget-create 'info-link
399 :help-echo "Push me to learn more."
400 :tag "topic parameters"
401 "(gnus)Topic Parameters"))
402 (widget-insert " for <")
403 (widget-insert (gnus-group-decoded-name (or group topic)))
404 (widget-insert "> and press ")
405 (widget-create 'push-button
407 :help-echo "Push me when done customizing."
408 :action 'gnus-group-customize-done)
409 (widget-insert ".\n\n")
410 (make-local-variable 'gnus-custom-params)
412 (let ((values (if group
413 (gnus-info-params info)
414 (gnus-topic-parameters topic))))
416 ;; The parameters in values may contain duplicates. This is
417 ;; normally OK as assq returns the first. However, right here
418 ;; every duplicate ends up being displayed. So, rather than
419 ;; display them, remove them from the list.
421 (let ((tmp (setq values (gnus-copy-sequence values)))
424 (while (setq elem (assq (caar tmp) (cdr tmp)))
426 (setq tmp (cdr tmp))))
428 (setq gnus-custom-params
429 (apply 'widget-create 'group
432 (list `(set :inline t
437 These special parameters are recognized by Gnus.
438 Check the [ ] for the parameters you want to apply to this group or
439 to the groups in this topic, then edit the value to suit your taste."
444 :tag "Agent Parameters"