1 ;;; gnus-cus.el --- customization commands for Gnus
3 ;; Copyright (C) 1996, 1999-2011 Free Software Foundation, Inc.
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
8 ;; This file is part of GNU Emacs.
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 3 of the License, or
13 ;; (at your option) any later version.
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
36 (defun gnus-custom-mode ()
37 "Major mode for editing Gnus customization buffers.
39 The following commands are available:
41 \\[widget-forward] Move to next button or editable field.
42 \\[widget-backward] Move to previous button or editable field.
43 \\[widget-button-click] Activate button under the mouse pointer.
44 \\[widget-button-press] Activate button under point.
46 Entry to this mode calls the value of `gnus-custom-mode-hook'
47 if that value is non-nil."
48 (kill-all-local-variables)
49 (setq major-mode 'gnus-custom-mode
50 mode-name "Gnus Customize")
51 (use-local-map widget-keymap)
53 (when (and (facep 'custom-button-face)
54 (facep 'custom-button-pressed-face))
55 (set (make-local-variable 'widget-button-face)
57 (set (make-local-variable 'widget-button-pressed-face)
58 'custom-button-pressed-face)
59 (set (make-local-variable 'widget-mouse-face)
60 'custom-button-pressed-face))
61 (when (and (boundp 'custom-raised-buttons)
62 (symbol-value 'custom-raised-buttons))
63 (set (make-local-variable 'widget-push-button-prefix) "")
64 (set (make-local-variable 'widget-push-button-suffix) "")
65 (set (make-local-variable 'widget-link-prefix) "")
66 (set (make-local-variable 'widget-link-suffix) ""))
67 (gnus-run-mode-hooks 'gnus-custom-mode-hook))
69 ;;; Group Customization:
71 (defconst gnus-group-parameters
72 '((extra-aliases (choice
78 (gnus-email-address :tag "Address")))
79 (gnus-email-address :tag "Address")) "\
80 Store messages posted from or to this address in this group.
82 You must be using gnus-group-split for this to work. The VALUE of the
83 nnmail-split-fancy SPLIT generated for this group will match these
86 (split-regexp (regexp :tag "gnus-group-split Regular Expression") "\
87 Like gnus-group-split Address, but expects a regular expression.")
89 (split-exclude (list :tag "gnus-group-split Restricts"
91 :inline t (regexp :tag "Restrict"))) "\
92 Regular expression that cancels gnus-group-split matches.
94 Each entry is added to the nnmail-split-fancy SPLIT as a separate
97 (split-spec (choice :tag "gnus-group-split Overrider"
98 (sexp :tag "Fancy Split")
99 (const :tag "Catch All" catch-all)
100 (const :tag "Ignore" nil)) "\
101 Override all other gnus-group-split fields.
103 In `Fancy Split', you can enter any nnmail-split-fancy SPLIT. Note
104 that the name of this group won't be automatically assumed, you have
105 to add it to the SPLITs yourself. This means you can use such splits
106 to split messages to other groups too.
108 If you select `Catch All', this group will get postings for any
109 messages not matched in any other group. It overrides the variable
110 gnus-group-split-default-catch-all-group.
112 Selecting `Ignore' forces no SPLIT to be generated for this group,
113 disabling all other gnus-group-split fields.")
115 (broken-reply-to (const :tag "Broken Reply To" t) "\
116 Ignore `Reply-To' headers in this group.
118 That can be useful if you're reading a mailing list group where the
119 listserv has inserted `Reply-To' headers that point back to the
120 listserv itself. This is broken behavior. So there!")
122 (to-group (string :tag "To Group") "\
123 All posts will be sent to the specified group.")
125 (gcc-self (choice :tag "GCC"
127 (const :tag "To current group" t)
129 (string :format "%v" :hide-front-space t)) "\
130 Specify default value for GCC header.
132 If this symbol is present in the group parameter list and set to t,
133 new composed messages will be `Gcc''d to the current group. If it is
134 present and set to `none', no `Gcc:' header will be generated, if it
135 is present and a string, this string will be inserted literally as a
136 `gcc' header (this symbol takes precedence over any default `Gcc'
137 rules as described later).")
139 (expiry-wait (choice :tag "Expire Wait"
143 (number :hide-front-space t
147 Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function'
148 when expiring expirable messages. The value can either be a number of
149 days (not necessarily an integer) or the symbols `never' or
152 (expiry-target (choice :tag "Expiry Target"
155 (function :format "%v" nnmail-)
157 Where expired messages end up.
159 Overrides `nnmail-expiry-target'.")
161 (score-file (file :tag "Score File") "\
162 Make the specified file into the current score file.
163 This means that all score commands you issue will end up in this file.")
165 (adapt-file (file :tag "Adapt File") "\
166 Make the specified file into the current adaptive file.
167 All adaptive score entries will be put into this file.")
169 (admin-address (gnus-email-address :tag "Admin Address") "\
170 Administration address for a mailing list.
172 When unsubscribing to a mailing list you should never send the
173 unsubscription notice to the mailing list itself. Instead, you'd
174 send messages to the administrative address. This parameter allows
175 you to put the admin address somewhere convenient.")
177 (display (choice :tag "Display"
182 (sexp :tag "Other")) "\
183 Which articles to display on entering the group.
186 Display all articles, both read and unread.
189 Display the last NUMBER articles in the group. This is the same as
190 entering the group with C-u NUMBER.
193 Display the default visible articles, which normally includes
194 unread and ticked articles.
197 Display the articles that satisfy the S-expression. The S-expression
198 should be in an array form.")
200 (comment (string :tag "Comment") "\
201 An arbitrary comment on the group.")
203 (visible (const :tag "Permanently visible" t) "\
204 Always display this group, even when there are no unread articles in it.")
207 (choice :tag "Highlight words"
209 (repeat (list (regexp :tag "Highlight regexp")
210 (number :tag "Group for entire word" 0)
211 (number :tag "Group for displayed part" 0)
213 gnus-emphasis-highlight-words))))
215 See `gnus-emphasis-alist'.")
218 (choice :tag "Posting style"
224 (const signature-file)
231 (string :tag "Header"))
232 (string :format "%v"))))
234 See `gnus-posting-styles'."))
235 "Alist of valid group or topic parameters.
237 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
238 itself (a symbol), TYPE is the parameters type (a sexp widget), and
239 DOC is a documentation string for the parameter.")
241 (defconst gnus-extra-topic-parameters
242 '((subscribe (regexp :tag "Subscribe") "\
243 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
246 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.
254 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
255 itself (a symbol), TYPE is the parameters type (a sexp widget), and
256 DOC is a documentation string for the parameter.")
258 (defconst gnus-extra-group-parameters
259 '((uidvalidity (string :tag "IMAP uidvalidity") "\
260 Server-assigned value attached to IMAP groups, used to maintain consistency."))
261 "Alist of group parameters that are not also topic parameters.
263 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
265 DOC is a documentation string for the parameter.")
268 (defconst gnus-agent-parameters
270 (sexp :tag "Selection Predicate" :value false)
271 "Predicate used to automatically select articles for downloading."
272 gnus-agent-cat-predicate)
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.
280 All articles will be scored to zero (0).
283 The group's score files will be used to score the articles.
286 A list of score file names."
287 gnus-agent-cat-score-file)
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)
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)
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)
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.
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
332 (defvar gnus-custom-params)
333 (defvar gnus-custom-method)
334 (defvar gnus-custom-group)
335 (defvar gnus-custom-topic)
337 (defun gnus-group-customize (group &optional topic)
338 "Edit the group or topic on the current line."
339 (interactive (list (gnus-group-group-name) (gnus-group-topic-name)))
341 (types (mapcar (lambda (entry)
342 `(cons :format "%v%h\n"
344 (const :format "" ,(nth 0 entry))
346 (append (reverse gnus-group-parameters-more)
347 gnus-group-parameters
349 gnus-extra-group-parameters
350 gnus-extra-topic-parameters))))
351 (agent (mapcar (lambda (entry)
352 (let ((type (nth 1 entry))
355 (setq type (copy-sequence type)))
357 (setq vcons (cdr (memq :value type)))
359 (if (symbolp (car vcons))
361 (setcar vcons (symbol-value (car vcons)))