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

   1 ;;; gnus-start.el --- startup functions for Gnus
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  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 3 of the License, or
  14 ;; (at your option) any later version.
  15
  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.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'gnus)
  29 (require 'gnus-win)
  30 (require 'gnus-int)
  31 (require 'gnus-spec)
  32 (require 'gnus-range)
  33 (require 'gnus-util)
  34 (autoload 'message-make-date "message")
  35 (autoload 'gnus-agent-read-servers-validate "gnus-agent")
  36 (autoload 'gnus-agent-save-local "gnus-agent")
  37 (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
  38
  39 (eval-when-compile
  40   (require 'cl))
  41
  42 (defvar gnus-agent-covered-methods)
  43 (defvar gnus-agent-file-loading-local)
  44 (defvar gnus-agent-file-loading-cache)
  45
  46 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
  47   "Your `.newsrc' file.
  48 `.newsrc-SERVER' will be used instead if that exists."
  49   :group 'gnus-start
  50   :type 'file)
  51
  52 (defcustom gnus-backup-startup-file 'never
  53   "Control use of version numbers for backups of `gnus-startup-file'.
  54 This variable takes the same values as the `version-control'
  55 variable."
  56   :version "22.1"
  57   :group 'gnus-start
  58   :type '(choice (const :tag "Never" never)
  59                  (const :tag "If existing" nil)
  60                  (other :tag "Always" t)))
  61
  62 (defcustom gnus-save-startup-file-via-temp-buffer t
  63   "Whether to write the startup file contents to a buffer then save
  64 the buffer or write directly to the file.  The buffer is faster
  65 because all of the contents are written at once.  The direct write
  66 uses considerably less memory."
  67   :version "22.1"
  68   :group 'gnus-start
  69   :type '(choice (const :tag "Write via buffer" t)
  70                  (const :tag "Write directly to file" nil)))
  71
  72 (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
  73   "Your Gnus Emacs-Lisp startup file name.
  74 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
  75   :group 'gnus-start
  76   :type 'file)
  77
  78 (defcustom gnus-site-init-file
  79   (condition-case nil
  80       (concat (file-name-directory
  81                (directory-file-name installation-directory))
  82               "site-lisp/gnus-init")
  83     (error nil))
  84   "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
  85 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
  86   :group 'gnus-start
  87   :type '(choice file (const nil)))
  88
  89 (defcustom gnus-default-subscribed-newsgroups nil
  90   "List of newsgroups to subscribe, when a user runs Gnus the first time.
  91 The value should be a list of strings.
  92 If it is t, Gnus will not do anything special the first time it is
  93 started; it'll just use the normal newsgroups subscription methods."
  94   :group 'gnus-start
  95   :type '(choice (repeat string) (const :tag "Nothing special" t)))
  96
  97 (defcustom gnus-use-dribble-file t
  98   "*Non-nil means that Gnus will use a dribble file to store user updates.
  99 If Emacs should crash without saving the .newsrc files, complete
 100 information can be restored from the dribble file."
 101   :group 'gnus-dribble-file
 102   :type 'boolean)
 103
 104 (defcustom gnus-dribble-directory nil
 105   "*The directory where dribble files will be saved.
 106 If this variable is nil, the directory where the .newsrc files are
 107 saved will be used."
 108   :group 'gnus-dribble-file
 109   :type '(choice directory (const nil)))
 110
 111 (defcustom gnus-check-new-newsgroups 'ask-server
 112   "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup.
 113 This normally finds new newsgroups by comparing the active groups the
 114 servers have already reported with those Gnus already knows, either alive
 115 or killed.
 116
 117 When any of the following are true, `gnus-find-new-newsgroups' will instead
 118 ask the servers (primary, secondary, and archive servers) to list new
 119 groups since the last time it checked:
 120   1. This variable is `ask-server'.
 121   2. This variable is a list of select methods (see below).
 122   3. `gnus-read-active-file' is nil or `some'.
 123   4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
 124
 125 Thus, if this variable is `ask-server' or a list of select methods or
 126 `gnus-read-active-file' is nil or `some', then the killed list is no
 127 longer necessary, so you could safely set `gnus-save-killed-list' to nil.
 128
 129 This variable can be a list of select methods which Gnus will query with
 130 the `ask-server' method in addition to the primary, secondary, and archive
 131 servers.
 132
 133 Eg.
 134   (setq gnus-check-new-newsgroups
 135         '((nntp \"some.server\") (nntp \"other.server\")))
 136
 137 If this variable is nil, then you have to tell Gnus explicitly to
 138 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
 139   :group 'gnus-start
 140   :type '(choice (const :tag "no" nil)
 141                  (const :tag "by brute force" t)
 142                  (const :tag "ask servers" ask-server)
 143                  (repeat :menu-tag "ask additional servers"
 144                          :tag "ask additional servers"
 145                          :value ((nntp ""))
 146                          (sexp :format "%v"))))
 147
 148 (defcustom gnus-check-bogus-newsgroups nil
 149   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
 150 If this variable is nil, then you have to tell Gnus explicitly to
 151 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]."
 152   :group 'gnus-start-server
 153   :type 'boolean)
 154
 155 (defcustom gnus-read-active-file 'some
 156   "*Non-nil means that Gnus will read the entire active file at startup.
 157 If this variable is nil, Gnus will only know about the groups in your
 158 `.newsrc' file.
 159
 160 If this variable is `some', Gnus will try to only read the relevant
 161 parts of the active file from the server.  Not all servers support
 162 this, and it might be quite slow with other servers, but this should
 163 generally be faster than both the t and nil value.
 164
 165 If you set this variable to nil or `some', you probably still want to
 166 be told about new newsgroups that arrive.  To do that, set
 167 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
 168 properly with all servers."
 169   :group 'gnus-start-server
 170   :type '(choice (const nil)
 171                  (const some)
 172                  (const t)))
 173
 174 (defconst gnus-level-subscribed 5
 175   "Groups with levels less than or equal to this variable are subscribed.")
 176
 177 (defconst gnus-level-unsubscribed 7
 178   "Groups with levels less than or equal to this variable are unsubscribed.
 179
 180 Groups with levels less than `gnus-level-subscribed', which
 181 should be less than this variable, are subscribed.  Groups with
 182 levels from `gnus-level-subscribed' (exclusive) upto this
 183 variable (inclusive) are unsubscribed.  See also
 184 `gnus-level-zombie', `gnus-level-killed' and the Info node `(gnus)Group
 185 Levels' for details.")
 186
 187 (defconst gnus-level-zombie 8
 188   "Groups with this level are zombie groups.")
 189
 190 (defconst gnus-level-killed 9
 191   "Groups with this level are killed.")
 192
 193 (defcustom gnus-level-default-subscribed 3
 194   "*New subscribed groups will be subscribed at this level."
 195   :group 'gnus-group-levels
 196   :type 'integer)
 197
 198 (defcustom gnus-level-default-unsubscribed 6
 199   "*New unsubscribed groups will be unsubscribed at this level."
 200   :group 'gnus-group-levels
 201   :type 'integer)
 202
 203 (defcustom gnus-activate-level (1+ gnus-level-subscribed)
 204   "*Groups higher than this level won't be activated on startup.
 205 Setting this variable to something low might save lots of time when
 206 you have many groups that you aren't interested in."
 207   :group 'gnus-group-levels
 208   :type 'integer)
 209
 210 (defcustom gnus-activate-foreign-newsgroups 4
 211   "*If nil, Gnus will not check foreign newsgroups at startup.
 212 If it is non-nil, it should be a number between one and nine.  Foreign
 213 newsgroups that have a level lower or equal to this number will be
 214 activated on startup.  For instance, if you want to active all
 215 subscribed newsgroups, but not the rest, you'd set this variable to
 216 `gnus-level-subscribed'.
 217
 218 If you subscribe to lots of newsgroups from different servers, startup
 219 might take a while.  By setting this variable to nil, you'll save time,
 220 but you won't be told how many unread articles there are in the
 221 groups."
 222   :group 'gnus-group-levels
 223   :type '(choice integer
 224                  (const :tag "none" nil)))
 225
 226 (defcustom gnus-read-newsrc-file t
 227   "*Non-nil means that Gnus will read the `.newsrc' file.
 228 Gnus always reads its own startup file, which is called
 229 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 230 be readily understood by other newsreaders.  If you don't plan on
 231 using other newsreaders, set this variable to nil to save some time on
 232 entry."
 233   :version "21.1"
 234   :group 'gnus-newsrc
 235   :type 'boolean)
 236
 237 (defcustom gnus-save-newsrc-file t
 238   "*Non-nil means that Gnus will save the `.newsrc' file.
 239 Gnus always saves its own startup file, which is called
 240 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 241 be readily understood by other newsreaders.  If you don't plan on
 242 using other newsreaders, set this variable to nil to save some time on
 243 exit."
 244   :group 'gnus-newsrc
 245   :type 'boolean)
 246
 247 (defcustom gnus-save-killed-list t
 248   "*If non-nil, save the list of killed groups to the startup file.
 249 If you set this variable to nil, you'll save both time (when starting
 250 and quitting) and space (both memory and disk), but it will also mean
 251 that Gnus has no record of which groups are new and which are old, so
 252 the automatic new newsgroups subscription methods become meaningless.
 253
 254 You should always set `gnus-check-new-newsgroups' to `ask-server' or
 255 nil if you set this variable to nil.
 256
 257 This variable can also be a regexp.  In that case, all groups that do
 258 not match this regexp will be removed before saving the list."
 259   :group 'gnus-newsrc
 260   :type '(radio (sexp :format "Non-nil\n"
 261                       :match (lambda (widget value)
 262                                (and value (not (stringp value))))
 263                       :value t)
 264                 (const nil)
 265                 regexp))
 266
 267 (defcustom gnus-ignored-newsgroups
 268   (mapconcat 'identity
 269              '("^to\\."                 ; not "real" groups
 270                "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
 271                "^[\"][]\"[#'()]"        ; bogus characters
 272                )
 273              "\\|")
 274   "*A regexp to match uninteresting newsgroups in the active file.
 275 Any lines in the active file matching this regular expression are
 276 removed from the newsgroup list before anything else is done to it,
 277 thus making them effectively non-existent."
 278   :group 'gnus-group-new
 279   :type 'regexp)
 280
 281 (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
 282   "*Function(s) called with a group name when new group is detected.
 283 A few pre-made functions are supplied: `gnus-subscribe-randomly'
 284 inserts new groups at the beginning of the list of groups;
 285 `gnus-subscribe-alphabetically' inserts new groups in strict
 286 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
 287 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
 288 for your decision; `gnus-subscribe-killed' kills all new groups;
 289 `gnus-subscribe-zombies' will make all new groups into zombies;
 290 `gnus-subscribe-topics' will enter groups into the topics that
 291 claim them."
 292   :group 'gnus-group-new
 293   :type '(radio (function-item gnus-subscribe-randomly)
 294                 (function-item gnus-subscribe-alphabetically)
 295                 (function-item gnus-subscribe-hierarchically)
 296                 (function-item gnus-subscribe-interactively)
 297                 (function-item gnus-subscribe-killed)
 298                 (function-item gnus-subscribe-zombies)
 299                 (function-item gnus-subscribe-topics)
 300                 function
 301                 (repeat function)))
 302
 303 (defcustom gnus-subscribe-newsgroup-hooks nil
 304   "*Hooks run after you subscribe to a new group.
 305 The hooks will be called with new group's name as argument."
 306   :version "22.1"
 307   :group 'gnus-group-new
 308   :type 'hook)
 309
 310 (defcustom gnus-subscribe-options-newsgroup-method
 311   'gnus-subscribe-alphabetically
 312   "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
 313 If, for instance, you want to subscribe to all newsgroups in the
 314 \"no\" and \"alt\" hierarchies, you'd put the following in your
 315 .newsrc file:
 316
 317 options -n no.all alt.all
 318
 319 Gnus will then subscribe all new newsgroups in these hierarchies
 320 with the subscription method in this variable."
 321   :group 'gnus-group-new
 322   :type '(radio (function-item gnus-subscribe-randomly)
 323                 (function-item gnus-subscribe-alphabetically)
 324                 (function-item gnus-subscribe-hierarchically)
 325                 (function-item gnus-subscribe-interactively)
 326                 (function-item gnus-subscribe-killed)
 327                 (function-item gnus-subscribe-zombies)
 328                 (function-item gnus-subscribe-topics)
 329                 function
 330                 (repeat function)))
 331
 332 (defcustom gnus-subscribe-hierarchical-interactive nil
 333   "*If non-nil, Gnus will offer to subscribe hierarchically.
 334 When a new hierarchy appears, Gnus will ask the user:
 335
 336 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
 337
 338 If the user pressed `d', Gnus will descend the hierarchy, `y' will
 339 subscribe to all newsgroups in the hierarchy and `s' will skip this
 340 hierarchy in its entirety."
 341   :group 'gnus-group-new
 342   :type 'boolean)
 343
 344 (defcustom gnus-auto-subscribed-groups
 345   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
 346   "*All new groups that match this regexp will be subscribed automatically.
 347 Note that this variable only deals with new groups.  It has no effect
 348 whatsoever on old groups.
 349
 350 New groups that match this regexp will not be handled by
 351 `gnus-subscribe-newsgroup-method'.  Instead, they will
 352 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 353   :group 'gnus-group-new
 354   :type 'regexp)
 355
 356 (defcustom gnus-options-subscribe nil
 357   "*All new groups matching this regexp will be subscribed unconditionally.
 358 Note that this variable deals only with new newsgroups.  This variable
 359 does not affect old newsgroups.
 360
 361 New groups that match this regexp will not be handled by
 362 `gnus-subscribe-newsgroup-method'.  Instead, they will
 363 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 364   :group 'gnus-group-new
 365   :type '(choice regexp
 366                  (const :tag "none" nil)))
 367
 368 (defcustom gnus-options-not-subscribe nil
 369   "*All new groups matching this regexp will be ignored.
 370 Note that this variable deals only with new newsgroups.  This variable
 371 does not affect old (already subscribed) newsgroups."
 372   :group 'gnus-group-new
 373   :type '(choice regexp
 374                  (const :tag "none" nil)))
 375
 376 (defcustom gnus-modtime-botch nil
 377   "*Non-nil means .newsrc should be deleted prior to save.
 378 Its use is due to the bogus appearance that .newsrc was modified on
 379 disc."
 380   :group 'gnus-newsrc
 381   :type 'boolean)
 382
 383 (defcustom gnus-check-bogus-groups-hook nil
 384   "A hook run after removing bogus groups."
 385   :group 'gnus-start-server
 386   :type 'hook)
 387
 388 (defcustom gnus-startup-hook nil
 389   "A hook called at startup.
 390 This hook is called after Gnus is connected to the NNTP server."
 391   :group 'gnus-start
 392   :type 'hook)
 393
 394 (defcustom gnus-before-startup-hook nil
 395   "A hook called before startup.
 396 This hook is called as the first thing when Gnus is started."
 397   :group 'gnus-start
 398   :type 'hook)
 399
 400 (defcustom gnus-started-hook nil
 401   "A hook called as the last thing after startup."
 402   :group 'gnus-start
 403   :type 'hook)
 404
 405 (defcustom gnus-setup-news-hook
 406   '(gnus-fixup-nnimap-unread-after-getting-new-news)
 407   "A hook after reading the .newsrc file, but before generating the buffer."
 408   :group 'gnus-start
 409   :type 'hook)
 410
 411 (defcustom gnus-get-top-new-news-hook nil
 412   "A hook run just before Gnus checks for new news globally."
 413   :version "22.1"
 414   :group 'gnus-group-new
 415   :type 'hook)
 416
 417 (defcustom gnus-get-new-news-hook nil
 418   "A hook run just before Gnus checks for new news."
 419   :group 'gnus-group-new
 420   :type 'hook)
 421
 422 (defcustom gnus-after-getting-new-news-hook
 423   '(gnus-display-time-event-handler
 424     gnus-fixup-nnimap-unread-after-getting-new-news)
 425   "*A hook run after Gnus checks for new news when Gnus is already running."
 426   :group 'gnus-group-new
 427   :type 'hook)
 428
 429 (defcustom gnus-read-newsrc-el-hook nil
 430   "A hook called after reading the newsrc.eld? file."
 431   :group 'gnus-newsrc
 432   :type 'hook)
 433
 434 (defcustom gnus-save-newsrc-hook nil
 435   "A hook called before saving any of the newsrc files."
 436   :group 'gnus-newsrc
 437   :type 'hook)
 438
 439 (defcustom gnus-save-quick-newsrc-hook nil
 440   "A hook called just before saving the quick newsrc file.
 441 Can be used to turn version control on or off."
 442   :group 'gnus-newsrc
 443   :type 'hook)
 444
 445 (defcustom gnus-save-standard-newsrc-hook nil
 446   "A hook called just before saving the standard newsrc file.
 447 Can be used to turn version control on or off."
 448   :group 'gnus-newsrc
 449   :type 'hook)
 450
 451 (defcustom gnus-group-mode-hook nil
 452   "Hook for Gnus group mode."
 453   :group 'gnus-group-various
 454   :options '(gnus-topic-mode)
 455   :type 'hook)
 456
 457 (defcustom gnus-always-read-dribble-file nil
 458   "Unconditionally read the dribble file."
 459   :group 'gnus-newsrc
 460   :type 'boolean)
 461
 462 ;;; Internal variables
 463
 464 ;; Fixme: deal with old emacs-mule when mm-universal-coding-system is
 465 ;; utf-8-emacs.
 466 (defvar gnus-ding-file-coding-system mm-universal-coding-system
 467   "Coding system for ding file.")
 468
 469 (defvar gnus-newsrc-file-version nil)
 470 (defvar gnus-override-subscribe-method nil)
 471 (defvar gnus-dribble-buffer nil)
 472 (defvar gnus-newsrc-options nil
 473   "Options line in the .newsrc file.")
 474
 475 (defvar gnus-newsrc-options-n nil
 476   "List of regexps representing groups to be subscribed/ignored unconditionally.")
 477
 478 (defvar gnus-newsrc-last-checked-date nil
 479   "Date Gnus last asked server for new newsgroups.")
 480
 481 (defvar gnus-current-startup-file nil
 482   "Startup file for the current host.")
 483
 484 ;; Byte-compiler warning.
 485 (defvar gnus-group-line-format)
 486
 487 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
 488 (defvar gnus-init-inhibit nil)
 489 (defun gnus-read-init-file (&optional inhibit-next)
 490   ;; Don't load .gnus if the -q option was used.
 491   (when init-file-user
 492     (if gnus-init-inhibit
 493         (setq gnus-init-inhibit nil)
 494       (setq gnus-init-inhibit inhibit-next)
 495       (dolist (file (list gnus-site-init-file gnus-init-file))
 496         (when (and file
 497                    (locate-library file))
 498           (if (or debug-on-error debug-on-quit)
 499               (load file nil t)
 500             (condition-case var
 501                 (load file nil t)
 502               (error
 503                (error "Error in %s: %s" file (cadr var))))))))))
 504
 505 ;; For subscribing new newsgroup
 506
 507 (defun gnus-subscribe-hierarchical-interactive (groups)
 508   (let ((groups (sort groups 'string<))
 509         prefixes prefix start ans group starts real-group)
 510     (while groups
 511       (setq prefixes (list "^"))
 512       (while (and groups prefixes)
 513         (while (not (string-match (car prefixes)
 514                                   (gnus-group-real-name (car groups))))
 515           (setq prefixes (cdr prefixes)))
 516         (setq prefix (car prefixes))
 517         (setq start (1- (length prefix)))
 518         (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups))
 519                                start)
 520                  (cdr groups)
 521                  (setq prefix
 522                        (concat "^" (substring
 523                                     (gnus-group-real-name (car groups))
 524                                     0 (match-end 0))))
 525                  (string-match prefix (gnus-group-real-name (cadr groups))))
 526             (progn
 527               (push prefix prefixes)
 528               (message "Descend hierarchy %s? ([y]nsq): "
 529                        (substring prefix 1 (1- (length prefix))))
 530               (while (not (memq (setq ans (read-char-exclusive))
 531                                 '(?y ?\n ?\r ?n ?s ?q)))
 532                 (ding)
 533                 (message "Descend hierarchy %s? ([y]nsq): "
 534                          (substring prefix 1 (1- (length prefix)))))
 535               (cond ((= ans ?n)
 536                      (while (and groups
 537                                  (setq group (car groups)
 538                                        real-group (gnus-group-real-name group))
 539                                  (string-match prefix real-group))
 540                        (push group gnus-killed-list)
 541                        (gnus-sethash group group gnus-killed-hashtb)
 542                        (setq groups (cdr groups)))
 543                      (setq starts (cdr starts)))
 544                     ((= ans ?s)
 545                      (while (and groups
 546                                  (setq group (car groups)
 547                                        real-group (gnus-group-real-name group))
 548                                  (string-match prefix real-group))
 549                        (gnus-sethash group group gnus-killed-hashtb)
 550                        (gnus-subscribe-alphabetically (car groups))
 551                        (setq groups (cdr groups)))
 552                      (setq starts (cdr starts)))
 553                     ((= ans ?q)
 554                      (while groups
 555                        (setq group (car groups))
 556                        (push group gnus-killed-list)
 557                        (gnus-sethash group group gnus-killed-hashtb)
 558                        (setq groups (cdr groups))))
 559                     (t nil)))
 560           (message "Subscribe %s? ([n]yq)" (car groups))
 561           (while (not (memq (setq ans (read-char-exclusive))
 562                             '(?y ?\n ?\r ?q ?n)))
 563             (ding)
 564             (message "Subscribe %s? ([n]yq)" (car groups)))
 565           (setq group (car groups))
 566           (cond ((= ans ?y)
 567                  (gnus-subscribe-alphabetically (car groups))
 568                  (gnus-sethash group group gnus-killed-hashtb))
 569                 ((= ans ?q)
 570                  (while groups
 571                    (setq group (car groups))
 572                    (push group gnus-killed-list)
 573                    (gnus-sethash group group gnus-killed-hashtb)
 574                    (setq groups (cdr groups))))
 575                 (t
 576                  (push group gnus-killed-list)
 577                  (gnus-sethash group group gnus-killed-hashtb)))
 578           (setq groups (cdr groups)))))))
 579
 580 (defun gnus-subscribe-randomly (newsgroup)
 581   "Subscribe new NEWSGROUP by making it the first newsgroup."
 582   (gnus-subscribe-newsgroup newsgroup))
 583
 584 (defun gnus-subscribe-alphabetically (newgroup)
 585   "Subscribe new NEWGROUP and insert it in alphabetical order."
 586   (let ((groups (cdr gnus-newsrc-alist))
 587         before)
 588     (while (and (not before) groups)
 589       (if (string< newgroup (caar groups))
 590           (setq before (caar groups))
 591         (setq groups (cdr groups))))
 592     (gnus-subscribe-newsgroup newgroup before)))
 593
 594 (defun gnus-subscribe-hierarchically (newgroup)
 595   "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
 596   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
 597   (save-excursion
 598     (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
 599     (prog1
 600         (let ((groupkey newgroup) before)
 601           (while (and (not before) groupkey)
 602             (goto-char (point-min))
 603             (let ((groupkey-re
 604                    (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
 605               (while (and (re-search-forward groupkey-re nil t)
 606                           (progn
 607                             (setq before (match-string 1))
 608                             (string< before newgroup)))))
 609             ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
 610             (setq groupkey
 611                   (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
 612                     (substring groupkey (match-beginning 1) (match-end 1)))))
 613           (gnus-subscribe-newsgroup newgroup before))
 614       (kill-buffer (current-buffer)))))
 615
 616 (defun gnus-subscribe-interactively (group)
 617   "Subscribe the new GROUP interactively.
 618 It is inserted in hierarchical newsgroup order if subscribed.  If not,
 619 it is killed."
 620   (if (gnus-y-or-n-p (format "Subscribe new newsgroup %s? " group))
 621       (gnus-subscribe-hierarchically group)
 622     (push group gnus-killed-list)))
 623
 624 (defun gnus-subscribe-zombies (group)
 625   "Make the new GROUP into a zombie group."
 626   (push group gnus-zombie-list))
 627
 628 (defun gnus-subscribe-killed (group)
 629   "Make the new GROUP a killed group."
 630   (push group gnus-killed-list))
 631
 632 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
 633   "Subscribe new NEWSGROUP.
 634 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
 635 the first newsgroup."
 636   (save-excursion
 637     (goto-char (point-min))
 638     ;; We subscribe the group by changing its level to `subscribed'.
 639     (gnus-group-change-level
 640      newsgroup gnus-level-default-subscribed
 641      gnus-level-killed (gnus-group-entry (or next "dummy.group")))