cgit.sxemacs.org Git - gnus/blob - lisp/gnus-cus.el

   1 ;;; gnus-cus.el --- customization commands for Gnus
   2
   3 ;; Copyright (C) 1996, 1999-2015 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 3 of the License, or
  13 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'wid-edit)
  28 (require 'gnus)
  29 (require 'gnus-agent)
  30 (require 'gnus-score)
  31 (require 'gnus-topic)
  32 (require 'gnus-art)
  33
  34 ;;; Widgets:
  35
  36 (define-derived-mode gnus-custom-mode fundamental-mode "Gnus Customize"
  37   "Major mode for editing Gnus customization buffers.
  38
  39 The following commands are available:
  40
  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.
  45
  46 Entry to this mode calls the value of `gnus-custom-mode-hook'
  47 if that value is non-nil."
  48   (use-local-map widget-keymap)
  49   ;; Emacs stuff:
  50   (when (and (facep 'custom-button-face)
  51              (facep 'custom-button-pressed-face))
  52     (set (make-local-variable 'widget-button-face)
  53          'custom-button-face)
  54     (set (make-local-variable 'widget-button-pressed-face)
  55          'custom-button-pressed-face)
  56     (set (make-local-variable 'widget-mouse-face)
  57          'custom-button-pressed-face))
  58   (when (and (boundp 'custom-raised-buttons)
  59              (symbol-value 'custom-raised-buttons))
  60     (set (make-local-variable 'widget-push-button-prefix) "")
  61     (set (make-local-variable 'widget-push-button-suffix) "")
  62     (set (make-local-variable 'widget-link-prefix) "")
  63     (set (make-local-variable 'widget-link-suffix) "")))
  64
  65 ;;; Group Customization:
  66
  67 (defconst gnus-group-parameters
  68   '((extra-aliases (choice
  69                     :tag "Extra Aliases"
  70                     (list
  71                      :tag "List"
  72                      (editable-list
  73                       :inline t
  74                       (gnus-email-address :tag "Address")))
  75                     (gnus-email-address :tag "Address")) "\
  76 Store messages posted from or to this address in this group.
  77
  78 You must be using gnus-group-split for this to work.  The VALUE of the
  79 nnmail-split-fancy SPLIT generated for this group will match these
  80 addresses.")
  81
  82     (split-regexp (regexp :tag "gnus-group-split Regular Expression") "\
  83 Like gnus-group-split Address, but expects a regular expression.")
  84
  85     (split-exclude (list :tag "gnus-group-split Restricts"
  86                          (editable-list
  87                           :inline t (regexp :tag "Restrict"))) "\
  88 Regular expression that cancels gnus-group-split matches.
  89
  90 Each entry is added to the nnmail-split-fancy SPLIT as a separate
  91 RESTRICT clause.")
  92
  93     (split-spec (choice :tag "gnus-group-split Overrider"
  94                         (sexp :tag "Fancy Split")
  95                         (const :tag "Catch All" catch-all)
  96                         (const :tag "Ignore" nil)) "\
  97 Override all other gnus-group-split fields.
  98
  99 In `Fancy Split', you can enter any nnmail-split-fancy SPLIT.  Note
 100 that the name of this group won't be automatically assumed, you have
 101 to add it to the SPLITs yourself.  This means you can use such splits
 102 to split messages to other groups too.
 103
 104 If you select `Catch All', this group will get postings for any
 105 messages not matched in any other group.  It overrides the variable
 106 gnus-group-split-default-catch-all-group.
 107
 108 Selecting `Ignore' forces no SPLIT to be generated for this group,
 109 disabling all other gnus-group-split fields.")
 110
 111     (broken-reply-to (const :tag "Broken Reply To" t) "\
 112 Ignore `Reply-To' headers in this group.
 113
 114 That can be useful if you're reading a mailing list group where the
 115 listserv has inserted `Reply-To' headers that point back to the
 116 listserv itself.  This is broken behavior.  So there!")
 117
 118     (to-group (string :tag "To Group") "\
 119 All posts will be sent to the specified group.")
 120
 121     (gcc-self (choice :tag  "GCC"
 122                       :value t
 123                       (const :tag "To current group" t)
 124                       (const none)
 125                       (string :format "%v" :hide-front-space t)) "\
 126 Specify default value for GCC header.
 127
 128 If this symbol is present in the group parameter list and set to t,
 129 new composed messages will be `Gcc''d to the current group.  If it is
 130 present and set to `none', no `Gcc:' header will be generated, if it
 131 is present and a string, this string will be inserted literally as a
 132 `gcc' header (this symbol takes precedence over any default `Gcc'
 133 rules as described later).")
 134
 135     (expiry-wait (choice :tag  "Expire Wait"
 136                          :value never
 137                          (const never)
 138                          (const immediate)
 139                          (number :hide-front-space t
 140                                  :format "%v")) "\
 141 When to expire.
 142
 143 Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function'
 144 when expiring expirable messages.  The value can either be a number of
 145 days (not necessarily an integer) or the symbols `never' or
 146 `immediate'.")
 147
 148     (expiry-target (choice :tag "Expiry Target"
 149                            :value delete
 150                            (const delete)
 151                            (function :format "%v" nnmail-)
 152                            string) "\
 153 Where expired messages end up.
 154
 155 Overrides `nnmail-expiry-target'.")
 156
 157     (score-file (file :tag "Score File") "\
 158 Make the specified file into the current score file.
 159 This means that all score commands you issue will end up in this file.")
 160
 161     (adapt-file (file :tag "Adapt File") "\
 162 Make the specified file into the current adaptive file.
 163 All adaptive score entries will be put into this file.")
 164
 165     (admin-address (gnus-email-address :tag "Admin Address") "\
 166 Administration address for a mailing list.
 167
 168 When unsubscribing to a mailing list you should never send the
 169 unsubscription notice to the mailing list itself.  Instead, you'd
 170 send messages to the administrative address.  This parameter allows
 171 you to put the admin address somewhere convenient.")
 172
 173     (display (choice :tag "Display"
 174                      :value default
 175                      (const all)
 176                      (integer)
 177                      (const default)
 178                      (sexp  :tag "Other")) "\
 179 Which articles to display on entering the group.
 180
 181 `all'
 182      Display all articles, both read and unread.
 183
 184 `integer'
 185      Display the last NUMBER articles in the group.  This is the same as
 186      entering the group with C-u NUMBER.
 187
 188 `default'
 189      Display the default visible articles, which normally includes
 190      unread and ticked articles.
 191
 192 `Other'
 193      Display the articles that satisfy the S-expression. The S-expression
 194      should be in an array form.")
 195
 196     (comment (string :tag  "Comment") "\
 197 An arbitrary comment on the group.")
 198
 199     (visible (const :tag "Permanently visible" t) "\
 200 Always display this group, even when there are no unread articles in it.")
 201
 202     (highlight-words
 203      (choice :tag "Highlight words"
 204              :value nil
 205              (repeat (list (regexp :tag "Highlight regexp")
 206                            (number :tag "Group for entire word" 0)
 207                            (number :tag "Group for displayed part" 0)
 208                            (symbol :tag "Face"
 209                                    gnus-emphasis-highlight-words))))
 210      "highlight regexps.
 211 See `gnus-emphasis-alist'.")
 212
 213     (posting-style
 214      (choice :tag "Posting style"
 215              :value nil
 216              (repeat (list
 217                       (choice :tag "Type"
 218                               :value nil
 219                               (const signature)
 220                               (const signature-file)
 221                               (const organization)
 222                               (const address)
 223                               (const x-face-file)
 224                               (const name)
 225                               (const body)
 226                               (symbol)
 227                               (string :tag "Header"))
 228                       (string :format "%v"))))
 229      "post style.
 230 See `gnus-posting-styles'."))
 231   "Alist of valid group or topic parameters.
 232
 233 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
 234 itself (a symbol), TYPE is the parameters type (a sexp widget), and
 235 DOC is a documentation string for the parameter.")
 236
 237 (defconst gnus-extra-topic-parameters
 238   '((subscribe (regexp :tag "Subscribe") "\
 239 If `gnus-subscribe-newsgroup-method' or
 240 `gnus-subscribe-options-newsgroup-method' is set to
 241 `gnus-subscribe-topics', new groups that matches this regexp will
 242 automatically be subscribed to this topic")
 243     (subscribe-level (integer :tag "Subscribe Level" :value 1) "\
 244 If this topic parameter is set, when new groups are subscribed
 245 automatically under this topic (via the `subscribe' topic parameter)
 246 assign this level to the group, rather than the default level
 247 set in `gnus-level-default-subscribed'"))
 248   "Alist of topic parameters that are not also group parameters.
 249
 250 Each entry has the form (NAME TYPE DOC), where NAME is the parameter
 251 itself (a symbol), TYPE is the parameters type (a sexp widget), and
 252 DOC is a documentation string for the parameter.")
 253
 254 (defconst gnus-extra-group-parameters
 255   '((uidvalidity (string :tag "IMAP uidvalidity") "\