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

   1 ;;; gnus-start.el --- startup functions for Gnus
   2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
   3 ;;        Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   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 2, or (at your option)
  13 ;; 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; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (require 'gnus)
  30 (require 'gnus-win)
  31 (require 'gnus-int)
  32 (require 'gnus-spec)
  33 (require 'gnus-range)
  34 (require 'gnus-util)
  35 (autoload 'message-make-date "message")
  36 (autoload 'gnus-agent-read-servers-validate "gnus-agent")
  37 (autoload 'gnus-agent-save-local "gnus-agent")
  38 (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
  39
  40 (eval-when-compile
  41   (require 'cl)
  42
  43   (defvar gnus-agent-covered-methods nil)
  44   (defvar gnus-agent-file-loading-local nil)
  45   (defvar gnus-agent-file-loading-cache nil))
  46
  47 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
  48   "Your `.newsrc' file.
  49 `.newsrc-SERVER' will be used instead if that exists."
  50   :group 'gnus-start
  51   :type 'file)
  52
  53 (defcustom gnus-backup-startup-file 'never
  54   "Whether to create backup files.
  55 This variable takes the same values as the `version-control'
  56 variable."
  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   :group 'gnus-start
  68   :type '(choice (const :tag "Write via buffer" t)
  69                  (const :tag "Write directly to file" nil)))
  70
  71 (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
  72   "Your Gnus Emacs-Lisp startup file name.
  73 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
  74   :group 'gnus-start
  75   :type 'file)
  76
  77 (defcustom gnus-site-init-file
  78   (condition-case nil
  79       (concat (file-name-directory
  80                (directory-file-name installation-directory))
  81               "site-lisp/gnus-init")
  82     (error nil))
  83   "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
  84 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
  85   :group 'gnus-start
  86   :type '(choice file (const nil)))
  87
  88 (defcustom gnus-default-subscribed-newsgroups nil
  89   "List of newsgroups to subscribe, when a user runs Gnus the first time.
  90 The value should be a list of strings.
  91 If it is t, Gnus will not do anything special the first time it is
  92 started; it'll just use the normal newsgroups subscription methods."
  93   :group 'gnus-start
  94   :type '(choice (repeat string) (const :tag "Nothing special" t)))
  95
  96 (defcustom gnus-use-dribble-file t
  97   "*Non-nil means that Gnus will use a dribble file to store user updates.
  98 If Emacs should crash without saving the .newsrc files, complete
  99 information can be restored from the dribble file."
 100   :group 'gnus-dribble-file
 101   :type 'boolean)
 102
 103 (defcustom gnus-dribble-directory nil
 104   "*The directory where dribble files will be saved.
 105 If this variable is nil, the directory where the .newsrc files are
 106 saved will be used."
 107   :group 'gnus-dribble-file
 108   :type '(choice directory (const nil)))
 109
 110 (defcustom gnus-check-new-newsgroups 'ask-server
 111   "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup.
 112 This normally finds new newsgroups by comparing the active groups the
 113 servers have already reported with those Gnus already knows, either alive
 114 or killed.
 115
 116 When any of the following are true, `gnus-find-new-newsgroups' will instead
 117 ask the servers (primary, secondary, and archive servers) to list new
 118 groups since the last time it checked:
 119   1. This variable is `ask-server'.
 120   2. This variable is a list of select methods (see below).
 121   3. `gnus-read-active-file' is nil or `some'.
 122   4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
 123
 124 Thus, if this variable is `ask-server' or a list of select methods or
 125 `gnus-read-active-file' is nil or `some', then the killed list is no
 126 longer necessary, so you could safely set `gnus-save-killed-list' to nil.
 127
 128 This variable can be a list of select methods which Gnus will query with
 129 the `ask-server' method in addition to the primary, secondary, and archive
 130 servers.
 131
 132 Eg.
 133   (setq gnus-check-new-newsgroups
 134         '((nntp \"some.server\") (nntp \"other.server\")))
 135
 136 If this variable is nil, then you have to tell Gnus explicitly to
 137 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
 138   :group 'gnus-start
 139   :type '(choice (const :tag "no" nil)
 140                  (const :tag "by brute force" t)
 141                  (const :tag "ask servers" ask-server)
 142                  (repeat :menu-tag "ask additional servers"
 143                          :tag "ask additional servers"
 144                          :value ((nntp ""))
 145                          (sexp :format "%v"))))
 146
 147 (defcustom gnus-check-bogus-newsgroups nil
 148   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
 149 If this variable is nil, then you have to tell Gnus explicitly to
 150 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]."
 151   :group 'gnus-start-server
 152   :type 'boolean)
 153
 154 (defcustom gnus-read-active-file 'some
 155   "*Non-nil means that Gnus will read the entire active file at startup.
 156 If this variable is nil, Gnus will only know about the groups in your
 157 `.newsrc' file.
 158
 159 If this variable is `some', Gnus will try to only read the relevant
 160 parts of the active file from the server.  Not all servers support
 161 this, and it might be quite slow with other servers, but this should
 162 generally be faster than both the t and nil value.
 163
 164 If you set this variable to nil or `some', you probably still want to
 165 be told about new newsgroups that arrive.  To do that, set
 166 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
 167 properly with all servers."
 168   :group 'gnus-start-server
 169   :type '(choice (const nil)
 170                  (const some)
 171                  (const t)))
 172
 173 (defconst gnus-level-subscribed 5
 174   "Groups with levels less than or equal to this variable are subscribed.")
 175
 176 (defconst gnus-level-unsubscribed 7
 177   "Groups with levels less than or equal to this variable are unsubscribed.
 178 Groups with levels less than `gnus-level-subscribed', which should be
 179 less than this variable, are subscribed.")
 180
 181 (defconst gnus-level-zombie 8
 182   "Groups with this level are zombie groups.")
 183
 184 (defconst gnus-level-killed 9
 185   "Groups with this level are killed.")
 186
 187 (defcustom gnus-level-default-subscribed 3
 188   "*New subscribed groups will be subscribed at this level."
 189   :group 'gnus-group-levels
 190   :type 'integer)
 191
 192 (defcustom gnus-level-default-unsubscribed 6
 193   "*New unsubscribed groups will be unsubscribed at this level."
 194   :group 'gnus-group-levels
 195   :type 'integer)
 196
 197 (defcustom gnus-activate-level (1+ gnus-level-subscribed)
 198   "*Groups higher than this level won't be activated on startup.
 199 Setting this variable to something low might save lots of time when
 200 you have many groups that you aren't interested in."
 201   :group 'gnus-group-levels
 202   :type 'integer)
 203
 204 (defcustom gnus-activate-foreign-newsgroups 4
 205   "*If nil, Gnus will not check foreign newsgroups at startup.
 206 If it is non-nil, it should be a number between one and nine.  Foreign
 207 newsgroups that have a level lower or equal to this number will be
 208 activated on startup.  For instance, if you want to active all
 209 subscribed newsgroups, but not the rest, you'd set this variable to
 210 `gnus-level-subscribed'.
 211
 212 If you subscribe to lots of newsgroups from different servers, startup
 213 might take a while.  By setting this variable to nil, you'll save time,
 214 but you won't be told how many unread articles there are in the
 215 groups."
 216   :group 'gnus-group-levels
 217   :type '(choice integer
 218                  (const :tag "none" nil)))
 219
 220 (defcustom gnus-read-newsrc-file t
 221   "*Non-nil means that Gnus will read the `.newsrc' file.
 222 Gnus always reads its own startup file, which is called
 223 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 224 be readily understood by other newsreaders.  If you don't plan on
 225 using other newsreaders, set this variable to nil to save some time on
 226 entry."
 227   :version "21.1"
 228   :group 'gnus-newsrc
 229   :type 'boolean)
 230
 231 (defcustom gnus-save-newsrc-file t
 232   "*Non-nil means that Gnus will save the `.newsrc' file.
 233 Gnus always saves its own startup file, which is called
 234 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 235 be readily understood by other newsreaders.  If you don't plan on
 236 using other newsreaders, set this variable to nil to save some time on
 237 exit."
 238   :group 'gnus-newsrc
 239   :type 'boolean)
 240
 241 (defcustom gnus-save-killed-list t
 242   "*If non-nil, save the list of killed groups to the startup file.
 243 If you set this variable to nil, you'll save both time (when starting
 244 and quitting) and space (both memory and disk), but it will also mean
 245 that Gnus has no record of which groups are new and which are old, so
 246 the automatic new newsgroups subscription methods become meaningless.
 247
 248 You should always set `gnus-check-new-newsgroups' to `ask-server' or
 249 nil if you set this variable to nil.
 250
 251 This variable can also be a regexp.  In that case, all groups that do
 252 not match this regexp will be removed before saving the list."
 253   :group 'gnus-newsrc
 254   :type '(radio (sexp :format "Non-nil\n"
 255                       :match (lambda (widget value)
 256                                (and value (not (stringp value))))
 257                       :value t)
 258                 (const nil)
 259                 (regexp :format "%t: %v\n" :size 0)))
 260
 261 (defcustom gnus-ignored-newsgroups
 262   (mapconcat 'identity
 263              '("^to\\."                 ; not "real" groups
 264                "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
 265                "^[\"][]\"[#'()]"        ; bogus characters
 266                )
 267              "\\|")
 268   "*A regexp to match uninteresting newsgroups in the active file.
 269 Any lines in the active file matching this regular expression are
 270 removed from the newsgroup list before anything else is done to it,
 271 thus making them effectively non-existent."
 272   :group 'gnus-group-new
 273   :type 'regexp)
 274
 275 (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
 276   "*Function(s) called with a group name when new group is detected.
 277 A few pre-made functions are supplied: `gnus-subscribe-randomly'
 278 inserts new groups at the beginning of the list of groups;
 279 `gnus-subscribe-alphabetically' inserts new groups in strict
 280 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
 281 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
 282 for your decision; `gnus-subscribe-killed' kills all new groups;
 283 `gnus-subscribe-zombies' will make all new groups into zombies;
 284 `gnus-subscribe-topics' will enter groups into the topics that
 285 claim them."
 286   :group 'gnus-group-new
 287   :type '(radio (function-item gnus-subscribe-randomly)
 288                 (function-item gnus-subscribe-alphabetically)
 289                 (function-item gnus-subscribe-hierarchically)
 290                 (function-item gnus-subscribe-interactively)
 291                 (function-item gnus-subscribe-killed)
 292                 (function-item gnus-subscribe-zombies)
 293                 (function-item gnus-subscribe-topics)
 294                 function
 295                 (repeat function)))
 296
 297 (defcustom gnus-subscribe-newsgroup-hooks nil
 298   "*Hooks run after you subscribe to a new group.
 299 The hooks will be called with new group's name as argument."
 300   :group 'gnus-group-new
 301   :type 'hook)
 302
 303 (defcustom gnus-subscribe-options-newsgroup-method
 304   'gnus-subscribe-alphabetically
 305   "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
 306 If, for instance, you want to subscribe to all newsgroups in the
 307 \"no\" and \"alt\" hierarchies, you'd put the following in your
 308 .newsrc file:
 309
 310 options -n no.all alt.all
 311
 312 Gnus will the subscribe all new newsgroups in these hierarchies with
 313 the subscription method in this variable."
 314   :group 'gnus-group-new
 315   :type '(radio (function-item gnus-subscribe-randomly)
 316                 (function-item gnus-subscribe-alphabetically)
 317                 (function-item gnus-subscribe-hierarchically)
 318                 (function-item gnus-subscribe-interactively)
 319                 (function-item gnus-subscribe-killed)
 320                 (function-item gnus-subscribe-zombies)
 321                 (function-item gnus-subscribe-topics)
 322                 function
 323                 (repeat function)))
 324
 325 (defcustom gnus-subscribe-hierarchical-interactive nil
 326   "*If non-nil, Gnus will offer to subscribe hierarchically.
 327 When a new hierarchy appears, Gnus will ask the user:
 328
 329 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
 330
 331 If the user pressed `d', Gnus will descend the hierarchy, `y' will
 332 subscribe to all newsgroups in the hierarchy and `s' will skip this
 333 hierarchy in its entirety."
 334   :group 'gnus-group-new
 335   :type 'boolean)
 336
 337 (defcustom gnus-auto-subscribed-groups
 338   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
 339   "*All new groups that match this regexp will be subscribed automatically.
 340 Note that this variable only deals with new groups.  It has no effect
 341 whatsoever on old groups.
 342
 343 New groups that match this regexp will not be handled by
 344 `gnus-subscribe-newsgroup-method'.  Instead, they will
 345 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 346   :group 'gnus-group-new
 347   :type 'regexp)
 348
 349 (defcustom gnus-options-subscribe nil
 350   "*All new groups matching this regexp will be subscribed unconditionally.
 351 Note that this variable deals only with new newsgroups.  This variable
 352 does not affect old newsgroups.
 353
 354 New groups that match this regexp will not be handled by
 355 `gnus-subscribe-newsgroup-method'.  Instead, they will
 356 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 357   :group 'gnus-group-new
 358   :type '(choice regexp
 359                  (const :tag "none" nil)))
 360
 361 (defcustom gnus-options-not-subscribe nil
 362   "*All new groups matching this regexp will be ignored.
 363 Note that this variable deals only with new newsgroups.  This variable
 364 does not affect old (already subscribed) newsgroups."
 365   :group 'gnus-group-new
 366   :type '(choice regexp
 367                  (const :tag "none" nil)))
 368
 369 (defcustom gnus-modtime-botch nil
 370   "*Non-nil means .newsrc should be deleted prior to save.
 371 Its use is due to the bogus appearance that .newsrc was modified on
 372 disc."
 373   :group 'gnus-newsrc
 374   :type 'boolean)
 375
 376 (defcustom gnus-check-bogus-groups-hook nil
 377   "A hook run after removing bogus groups."
 378   :group 'gnus-start-server
 379   :type 'hook)
 380
 381 (defcustom gnus-startup-hook nil
 382   "A hook called at startup.
 383 This hook is called after Gnus is connected to the NNTP server."
 384   :group 'gnus-start
 385   :type 'hook)
 386
 387 (defcustom gnus-before-startup-hook nil
 388   "A hook called at before startup.
 389 This hook is called as the first thing when Gnus is started."
 390   :group 'gnus-start
 391   :type 'hook)
 392
 393 (defcustom gnus-started-hook nil
 394   "A hook called as the last thing after startup."
 395   :group 'gnus-start
 396   :type 'hook)
 397
 398 (defcustom gnus-setup-news-hook
 399   '(gnus-fixup-nnimap-unread-after-getting-new-news)
 400   "A hook after reading the .newsrc file, but before generating the buffer."
 401   :group 'gnus-start
 402   :type 'hook)
 403
 404 (defcustom gnus-get-top-new-news-hook nil
 405   "A hook run just before Gnus checks for new news globally."
 406   :group 'gnus-group-new
 407   :type 'hook)
 408
 409 (defcustom gnus-get-new-news-hook nil
 410   "A hook run just before Gnus checks for new news."
 411   :group 'gnus-group-new
 412   :type 'hook)
 413
 414 (defcustom gnus-after-getting-new-news-hook
 415   '(gnus-display-time-event-handler
 416     gnus-fixup-nnimap-unread-after-getting-new-news)
 417   "*A hook run after Gnus checks for new news when Gnus is already running."
 418   :group 'gnus-group-new
 419   :type 'hook)
 420
 421 (defcustom gnus-read-newsrc-el-hook nil
 422   "A hook called after reading the newsrc.eld? file."
 423   :group 'gnus-newsrc
 424   :type 'hook)
 425
 426 (defcustom gnus-save-newsrc-hook nil
 427   "A hook called before saving any of the newsrc files."
 428   :group 'gnus-newsrc
 429   :type 'hook)
 430
 431 (defcustom gnus-save-quick-newsrc-hook nil
 432   "A hook called just before saving the quick newsrc file.
 433 Can be used to turn version control on or off."
 434   :group 'gnus-newsrc
 435   :type 'hook)
 436
 437 (defcustom gnus-save-standard-newsrc-hook nil
 438   "A hook called just before saving the standard newsrc file.
 439 Can be used to turn version control on or off."
 440   :group 'gnus-newsrc
 441   :type 'hook)
 442
 443 (defcustom gnus-group-mode-hook nil
 444   "Hook for Gnus group mode."
 445   :group 'gnus-group-various
 446   :options '(gnus-topic-mode)
 447   :type 'hook)
 448
 449 (defcustom gnus-always-read-dribble-file nil
 450   "Unconditionally read the dribble file."
 451   :group 'gnus-newsrc
 452   :type 'boolean)
 453
 454 ;;; Internal variables
 455
 456 (defvar gnus-ding-file-coding-system mm-universal-coding-system
 457   "Coding system for ding file.")
 458
 459 (defvar gnus-newsrc-file-version nil)
 460 (defvar gnus-override-subscribe-method nil)
 461 (defvar gnus-dribble-buffer nil)
 462 (defvar gnus-newsrc-options nil
 463   "Options line in the .newsrc file.")
 464
 465 (defvar gnus-newsrc-options-n nil
 466   "List of regexps representing groups to be subscribed/ignored unconditionally.")
 467
 468 (defvar gnus-newsrc-last-checked-date nil
 469   "Date Gnus last asked server for new newsgroups.")
 470
 471 (defvar gnus-current-startup-file nil
 472   "Startup file for the current host.")
 473
 474 ;; Byte-compiler warning.
 475 (defvar gnus-group-line-format)
 476
 477 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
 478 (defvar gnus-init-inhibit nil)
 479 (defun gnus-read-init-file (&optional inhibit-next)
 480   ;; Don't load .gnus if the -q option was used.
 481   (when init-file-user
 482     (if gnus-init-inhibit
 483         (setq gnus-init-inhibit nil)
 484       (setq gnus-init-inhibit inhibit-next)
 485       (dolist (file (list gnus-site-init-file gnus-init-file))
 486         (when (and file
 487                    (locate-library file))
 488           (if (or debug-on-error debug-on-quit)
 489               (load file nil t)
 490             (condition-case var
 491                 (load file nil t)
 492               (error
 493                (error "Error in %s: %s" file (cadr var))))))))))
 494
 495 ;; For subscribing new newsgroup
 496
 497 (defun gnus-subscribe-hierarchical-interactive (groups)
 498   (let ((groups (sort groups 'string<))
 499         prefixes prefix start ans group starts real-group)
 500     (while groups
 501       (setq prefixes (list "^"))
 502       (while (and groups prefixes)
 503         (while (not (string-match (car prefixes)
 504                                   (gnus-group-real-name (car groups))))
 505           (setq prefixes (cdr prefixes)))
 506         (setq prefix (car prefixes))
 507         (setq start (1- (length prefix)))
 508         (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups))
 509                                start)
 510                  (cdr groups)
 511                  (setq prefix
 512                        (concat "^" (substring
 513                                     (gnus-group-real-name (car groups))
 514                                     0 (match-end 0))))
 515                  (string-match prefix (gnus-group-real-name (cadr groups))))
 516             (progn
 517               (push prefix prefixes)
 518               (message "Descend hierarchy %s? ([y]nsq): "
 519                        (substring prefix 1 (1- (length prefix))))
 520               (while (not (memq (setq ans (read-char-exclusive))
 521                                 '(?y ?\n ?\r ?n ?s ?q)))
 522                 (ding)
 523                 (message "Descend hierarchy %s? ([y]nsq): "
 524                          (substring prefix 1 (1- (length prefix)))))
 525               (cond ((= ans ?n)
 526                      (while (and groups
 527                                  (setq group (car groups)
 528                                        real-group (gnus-group-real-name group))
 529                                  (string-match prefix real-group))
 530                        (push group gnus-killed-list)
 531                        (gnus-sethash group group gnus-killed-hashtb)
 532                        (setq groups (cdr groups)))
 533                      (setq starts (cdr starts)))
 534                     ((= ans ?s)
 535                      (while (and groups
 536                                  (setq group (car groups)
 537                                        real-group (gnus-group-real-name group))
 538                                  (string-match prefix real-group))
 539                        (gnus-sethash group group gnus-killed-hashtb)
 540                        (gnus-subscribe-alphabetically (car groups))
 541                        (setq groups (cdr groups)))
 542                      (setq starts (cdr starts)))
 543                     ((= ans ?q)
 544                      (while groups
 545                        (setq group (car groups))
 546                        (push group gnus-killed-list)
 547                        (gnus-sethash group group gnus-killed-hashtb)
 548                        (setq groups (cdr groups))))
 549                     (t nil)))
 550           (message "Subscribe %s? ([n]yq)" (car groups))
 551           (while (not (memq (setq ans (read-char-exclusive))
 552                             '(?y ?\n ?\r ?q ?n)))
 553             (ding)
 554             (message "Subscribe %s? ([n]yq)" (car groups)))
 555           (setq group (car groups))
 556           (cond ((= ans ?y)
 557                  (gnus-subscribe-alphabetically (car groups))
 558                  (gnus-sethash group group gnus-killed-hashtb))
 559                 ((= ans ?q)
 560                  (while groups
 561                    (setq group (car groups))
 562                    (push group gnus-killed-list)
 563                    (gnus-sethash group group gnus-killed-hashtb)
 564                    (setq groups (cdr groups))))
 565                 (t
 566                  (push group gnus-killed-list)
 567                  (gnus-sethash group group gnus-killed-hashtb)))
 568           (setq groups (cdr groups)))))))
 569
 570 (defun gnus-subscribe-randomly (newsgroup)
 571   "Subscribe new NEWSGROUP by making it the first newsgroup."
 572   (gnus-subscribe-newsgroup newsgroup))
 573
 574 (defun gnus-subscribe-alphabetically (newgroup)
 575   "Subscribe new NEWGROUP and insert it in alphabetical order."
 576   (let ((groups (cdr gnus-newsrc-alist))
 577         before)
 578     (while (and (not before) groups)
 579       (if (string< newgroup (caar groups))
 580           (setq before (caar groups))
 581         (setq groups (cdr groups))))
 582     (gnus-subscribe-newsgroup newgroup before)))
 583
 584 (defun gnus-subscribe-hierarchically (newgroup)
 585   "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
 586   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
 587   (save-excursion
 588     (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
 589     (prog1
 590         (let ((groupkey newgroup) before)
 591           (while (and (not before) groupkey)
 592             (goto-char (point-min))
 593             (let ((groupkey-re
 594                    (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
 595               (while (and (re-search-forward groupkey-re nil t)
 596                           (progn
 597                             (setq before (match-string 1))
 598                             (string< before newgroup)))))
 599             ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
 600             (setq groupkey
 601                   (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
 602                     (substring groupkey (match-beginning 1) (match-end 1)))))
 603           (gnus-subscribe-newsgroup newgroup before))
 604       (kill-buffer (current-buffer)))))
 605
 606 (defun gnus-subscribe-interactively (group)
 607   "Subscribe the new GROUP interactively.
 608 It is inserted in hierarchical newsgroup order if subscribed.  If not,
 609 it is killed."
 610   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
 611       (gnus-subscribe-hierarchically group)
 612     (push group gnus-killed-list)))
 613
 614 (defun gnus-subscribe-zombies (group)
 615   "Make the new GROUP into a zombie group."
 616   (push group gnus-zombie-list))
 617
 618 (defun gnus-subscribe-killed (group)
 619   "Make the new GROUP a killed group."
 620   (push group gnus-killed-list))
 621
 622 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
 623   "Subscribe new NEWSGROUP.
 624 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
 625 the first newsgroup."
 626   (save-excursion
 627     (goto-char (point-min))
 628     ;; We subscribe the group by changing its level to `subscribed'.
 629     (gnus-group-change-level
 630      newsgroup gnus-level-default-subscribed
 631      gnus-level-killed (gnus-group-entry (or next "dummy.group")))
 632     (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
 633     (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
 634     t))
 635
 636 (defun gnus-read-active-file-p ()
 637   "Say whether the active file has been read from `gnus-select-method'."
 638   (memq gnus-select-method gnus-have-read-active-file))
 639
 640 ;;; General various misc type functions.
 641
 642 ;; Silence byte-compiler.
 643 (eval-when-compile
 644   (defvar gnus-current-headers)
 645   (defvar gnus-thread-indent-array)
 646   (defvar gnus-newsgroup-name)
 647   (defvar gnus-newsgroup-headers)
 648   (defvar gnus-group-list-mode)
 649   (defvar gnus-group-mark-positions)
 650   (defvar gnus-newsgroup-data)
 651   (defvar gnus-newsgroup-unreads)
 652   (defvar nnoo-state-alist)
 653   (defvar gnus-current-select-method)
 654   (defvar mail-sources)
 655   (defvar nnmail-scan-directory-mail-source-once)
 656   (defvar nnmail-split-history)
 657   (defvar nnmail-spool-file))
 658
 659 (defun gnus-close-all-servers ()
 660   "Close all servers."
 661   (interactive)
 662   (dolist (server gnus-opened-servers)
 663     (gnus-close-server (car server))))
 664
 665 (defun gnus-clear-system ()
 666   "Clear all variables and buffers."
 667   ;; Clear Gnus variables.
 668   (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
 669     (while variables
 670       (set (car variables) nil)
 671       (setq variables (cdr variables))))
 672   ;; Clear other internal variables.
 673   (setq gnus-list-of-killed-groups nil
 674         gnus-have-read-active-file nil
 675         gnus-agent-covered-methods nil
 676         gnus-agent-file-loading-local nil
 677         gnus-agent-file-loading-cache nil
 678         gnus-server-method-cache nil
 679         gnus-newsrc-alist nil
 680         gnus-newsrc-hashtb nil
 681         gnus-killed-list nil
 682         gnus-zombie-list nil
 683         gnus-killed-hashtb nil
 684         gnus-active-hashtb nil
 685         gnus-moderated-hashtb nil
 686         gnus-description-hashtb nil
 687         gnus-current-headers nil
 688         gnus-thread-indent-array nil
 689         gnus-newsgroup-headers nil
 690         gnus-newsgroup-name nil
 691         gnus-server-alist nil
 692         gnus-group-list-mode nil
 693         gnus-opened-servers nil
 694         gnus-group-mark-positions nil
 695         gnus-newsgroup-data nil
 696         gnus-newsgroup-unreads nil
 697         nnoo-state-alist nil
 698         gnus-current-select-method nil
 699         nnmail-split-history nil
 700         gnus-ephemeral-servers nil)
 701   (gnus-shutdown 'gnus)
 702   ;; Kill the startup file.
 703   (and gnus-current-startup-file
 704        (get-file-buffer gnus-current-startup-file)
 705        (kill-buffer (get-file-buffer gnus-current-startup-file)))
 706   ;; Clear the dribble buffer.
 707   (gnus-dribble-clear)
 708   ;; Kill global KILL file buffer.
 709   (when (get-file-buffer (gnus-newsgroup-kill-file nil))
 710     (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
 711   (gnus-kill-buffer nntp-server-buffer)
 712   ;; Kill Gnus buffers.
 713   (dolist (buffer (gnus-buffers))
 714     (gnus-kill-buffer buffer))
 715   ;; Remove Gnus frames.
 716   (gnus-kill-gnus-frames))
 717
 718 (defun gnus-no-server-1 (&optional arg slave)
 719   "Read network news.
 720 If ARG is a positive number, Gnus will use that as the
 721 startup level.  If ARG is nil, Gnus will be started at level 2.
 722 If ARG is non-nil and not a positive number, Gnus will
 723 prompt the user for the name of an NNTP server to use.
 724 As opposed to `gnus', this command will not connect to the local server."
 725   (interactive "P")
 726   (let ((val (or arg (1- gnus-level-default-subscribed))))
 727     (gnus val t slave)
 728     (make-local-variable 'gnus-group-use-permanent-levels)
 729     (setq gnus-group-use-permanent-levels val)))
 730
 731 (defun gnus-1 (&optional arg dont-connect slave)
 732   "Read network news.
 733 If ARG is non-nil and a positive number, Gnus will use that as the
 734 startup level.  If ARG is non-nil and not a positive number, Gnus will
 735 prompt the user for the name of an NNTP server to use."
 736   (interactive "P")
 737
 738   (if (gnus-alive-p)
 739       (progn
 740         (switch-to-buffer gnus-group-buffer)
 741         (gnus-group-get-new-news
 742          (and (numberp arg)
 743               (> arg 0)
 744               (max (car gnus-group-list-mode) arg))))
 745
 746     (gnus-clear-system)
 747     (gnus-splash)
 748     (gnus-run-hooks 'gnus-before-startup-hook)
 749     (nnheader-init-server-buffer)
 750     (setq gnus-slave slave)
 751     (gnus-read-init-file)
 752     (if gnus-agent
 753         (gnus-agentize))
 754
 755     (when gnus-simple-splash
 756       (setq gnus-simple-splash nil)
 757       (cond
 758        ((featurep 'xemacs)
 759         (gnus-xmas-splash))
 760        ((and window-system
 761              (= (frame-height) (1+ (window-height))))
 762         (gnus-x-splash))))
 763
 764     (let ((level (and (numberp arg) (> arg 0) arg))
 765           did-connect)
 766       (unwind-protect
 767           (progn
 768             (unless dont-connect
 769               (setq did-connect
 770                     (gnus-start-news-server (and arg (not level))))))
 771         (if (and (not dont-connect)
 772                  (not did-connect))
 773             (gnus-group-quit)
 774           (gnus-run-hooks 'gnus-startup-hook)
 775           ;; NNTP server is successfully open.
 776
 777           ;; Find the current startup file name.
 778           (setq gnus-current-startup-file
 779                 (gnus-make-newsrc-file gnus-startup-file))
 780
 781           ;; Read the dribble file.
 782           (when (or gnus-slave gnus-use-dribble-file)
 783             (gnus-dribble-read-file))
 784
 785           ;; Do the actual startup.
 786           (if gnus-agent
 787               (gnus-request-create-group "queue" '(nndraft "")))
 788           (gnus-request-create-group "drafts" '(nndraft ""))
 789           (gnus-setup-news nil level dont-connect)
 790           (gnus-run-hooks 'gnus-setup-news-hook)
 791           (gnus-start-draft-setup)
 792           ;; Generate the group buffer.
 793           (gnus-group-list-groups level)
 794           (gnus-group-first-unread-group)
 795           (gnus-configure-windows 'group)
 796           (gnus-group-set-mode-line)
 797           (gnus-run-hooks 'gnus-started-hook))))))
 798
 799 (defun gnus-start-draft-setup ()
 800   "Make sure the draft group exists."
 801   (gnus-request-create-group "drafts" '(nndraft ""))
 802   (unless (gnus-group-entry "nndraft:drafts")
 803     (let ((gnus-level-default-subscribed 1))
 804       (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))
 805     (gnus-group-set-parameter
 806      "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
 807
 808 \f
 809 ;;;
 810 ;;; Dribble file
 811 ;;;
 812
 813 (defvar gnus-dribble-ignore nil)
 814 (defvar gnus-dribble-eval-file nil)
 815
 816 (defun gnus-dribble-file-name ()
 817   "Return the dribble file for the current .newsrc."
 818   (concat
 819    (if gnus-dribble-directory
 820        (concat (file-name-as-directory gnus-dribble-directory)
 821                (file-name-nondirectory gnus-current-startup-file))
 822      gnus-current-startup-file)
 823    "-dribble"))
 824
 825 (defun gnus-dribble-enter (string)
 826   "Enter STRING into the dribble buffer."
 827   (when (and (not gnus-dribble-ignore)
 828              gnus-dribble-buffer
 829              (buffer-name gnus-dribble-buffer))
 830     (let ((obuf (current-buffer)))
 831       (set-buffer gnus-dribble-buffer)
 832       (goto-char (point-max))
 833       (insert string "\n")
 834       ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
 835       ;; It causes problems with both XEmacs and Emacs 21, and doesn't
 836       ;; seem to be of much value. (FIXME: remove this after we make sure
 837       ;; it's not needed).
 838       ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
 839       (bury-buffer gnus-dribble-buffer)
 840       (save-excursion
 841         (set-buffer gnus-group-buffer)
 842         (gnus-group-set-mode-line))
 843       (set-buffer obuf))))
 844
 845 (defun gnus-dribble-touch ()
 846   "Touch the dribble buffer."
 847   (gnus-dribble-enter ""))
 848
 849 (defun gnus-dribble-read-file ()
 850   "Read the dribble file from disk."
 851   (let ((dribble-file (gnus-dribble-file-name)))
 852     (save-excursion
 853       (set-buffer (setq gnus-dribble-buffer
 854                         (gnus-get-buffer-create
 855                          (file-name-nondirectory dribble-file))))
 856       (erase-buffer)
 857       (setq buffer-file-name dribble-file)
 858       (auto-save-mode t)
 859       (buffer-disable-undo)
 860       (bury-buffer (current-buffer))
 861       (set-buffer-modified-p nil)
 862       (let ((auto (make-auto-save-file-name))
 863             (gnus-dribble-ignore t)
 864             (purpose nil)
 865             modes)
 866         (when (or (file-exists-p auto) (file-exists-p dribble-file))
 867           ;; Load whichever file is newest -- the auto save file
 868           ;; or the "real" file.
 869           (if (file-newer-than-file-p auto dribble-file)
 870               (nnheader-insert-file-contents auto)
 871             (nnheader-insert-file-contents dribble-file))
 872           (unless (zerop (buffer-size))
 873             (set-buffer-modified-p t))
 874           ;; Set the file modes to reflect the .newsrc file modes.
 875           (save-buffer)
 876           (when (and (file-exists-p gnus-current-startup-file)
 877                      (file-exists-p dribble-file)
 878                      (setq modes (file-modes gnus-current-startup-file)))
 879             (gnus-set-file-modes dribble-file modes))
 880           (goto-char (point-min))
 881           (when (search-forward "Gnus was exited on purpose" nil t)
 882             (setq purpose t))
 883           ;; Possibly eval the file later.
 884           (when (or gnus-always-read-dribble-file
 885                     (gnus-y-or-n-p
 886                      (if purpose
 887                          "Gnus exited on purpose without saving; read auto-save file anyway? "
 888                      "Gnus auto-save file exists.  Do you want to read it? ")))
 889             (setq gnus-dribble-eval-file t)))))))
 890
 891 (defun gnus-dribble-eval-file ()
 892   (when gnus-dribble-eval-file
 893     (setq gnus-dribble-eval-file nil)
 894     (save-excursion
 895       (let ((gnus-dribble-ignore t))
 896         (set-buffer gnus-dribble-buffer)
 897         (eval-buffer (current-buffer))))))
 898
 899 (defun gnus-dribble-delete-file ()
 900   (when (file-exists-p (gnus-dribble-file-name))
 901     (delete-file (gnus-dribble-file-name)))
 902   (when gnus-dribble-buffer
 903     (save-excursion
 904       (set-buffer gnus-dribble-buffer)
 905       (let ((auto (make-auto-save-file-name)))
 906         (when (file-exists-p auto)
 907           (delete-file auto))
 908         (erase-buffer)
 909         (set-buffer-modified-p nil)))))
 910
 911 (defun gnus-dribble-save ()
 912   (when (and gnus-dribble-buffer
 913              (buffer-name gnus-dribble-buffer))
 914     (save-excursion
 915       (set-buffer gnus-dribble-buffer)
 916       (save-buffer))))
 917
 918 (defun gnus-dribble-clear ()
 919   (when (gnus-buffer-exists-p gnus-dribble-buffer)
 920     (save-excursion
 921       (set-buffer gnus-dribble-buffer)
 922       (erase-buffer)
 923       (set-buffer-modified-p nil)
 924       (setq buffer-saved-size (buffer-size)))))
 925
 926 \f
 927 ;;;
 928 ;;; Active & Newsrc File Handling
 929 ;;;
 930
 931 (defun gnus-setup-news (&optional rawfile level dont-connect)
 932   "Setup news information.
 933 If RAWFILE is non-nil, the .newsrc file will also be read.
 934 If LEVEL is non-nil, the news will be set up at level LEVEL."
 935   (require 'nnmail)
 936   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))
 937         ;; Binding this variable will inhibit multiple fetchings
 938         ;; of the same mail source.
 939         (nnmail-fetched-sources (list t)))
 940
 941     (when init
 942       ;; Clear some variables to re-initialize news information.
 943       (setq gnus-newsrc-alist nil
 944             gnus-active-hashtb nil)
 945       ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
 946       (gnus-read-newsrc-file rawfile))
 947
 948     ;; Make sure the archive server is available to all and sundry.
 949     (when gnus-message-archive-method
 950       (unless (assoc "archive" gnus-server-alist)
 951         (push `("archive"
 952                 nnfolder
 953                 "archive"
 954                 (nnfolder-directory
 955                  ,(nnheader-concat message-directory "archive"))
 956                 (nnfolder-active-file
 957                  ,(nnheader-concat message-directory "archive/active"))
 958                 (nnfolder-get-new-mail nil)
 959                 (nnfolder-inhibit-expiry t))
 960               gnus-server-alist)))
 961
 962     ;; If we don't read the complete active file, we fill in the
 963     ;; hashtb here.
 964     (when (or (null gnus-read-active-file)
 965               (eq gnus-read-active-file 'some))
 966       (gnus-update-active-hashtb-from-killed))
 967
 968     ;; Validate agent covered methods now that gnus-server-alist has
 969     ;; been initialized.
 970     ;; NOTE: This is here for one purpose only.  By validating the
 971     ;; agentized server's, it converts the old 5.10.3, and earlier,
 972     ;; format to the current format.  That enables the agent code
 973     ;; within gnus-read-active-file to function correctly.
 974     (if gnus-agent
 975         (gnus-agent-read-servers-validate))
 976
 977     ;; Read the active file and create `gnus-active-hashtb'.
 978     ;; If `gnus-read-active-file' is nil, then we just create an empty
 979     ;; hash table.  The partial filling out of the hash table will be
 980     ;; done in `gnus-get-unread-articles'.
 981     (and gnus-read-active-file
 982          (not level)
 983          (gnus-read-active-file nil dont-connect))
 984
 985     (unless gnus-active-hashtb
 986       (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
 987
 988     ;; Initialize the cache.
 989     (when gnus-use-cache
 990       (gnus-cache-open))
 991
 992     ;; Possibly eval the dribble file.
 993     (and init
 994          (or gnus-use-dribble-file gnus-slave)
 995          (gnus-dribble-eval-file))
 996
 997     ;; Slave Gnusii should then clear the dribble buffer.
 998     (when (and init gnus-slave)
 999       (gnus-dribble-clear))
1000
1001     (gnus-update-format-specifications)
1002
1003     ;; See whether we need to read the description file.
1004     (when (and (boundp 'gnus-group-line-format)
1005                (stringp gnus-group-line-format)
1006                (let ((case-fold-search nil))
1007                  (string-match "%[-,0-9]*D" gnus-group-line-format))
1008                (not gnus-description-hashtb)
1009                (not dont-connect)
1010                gnus-read-active-file)
1011       (gnus-read-all-descriptions-files))
1012
1013     ;; Find new newsgroups and treat them.
1014     (when (and init gnus-check-new-newsgroups (not level)
1015                (gnus-check-server gnus-select-method)
1016                (not gnus-slave)
1017                gnus-plugged)
1018       (gnus-find-new-newsgroups))
1019
1020     ;; Check and remove bogus newsgroups.
1021     (when (and init gnus-check-bogus-newsgroups
1022                gnus-read-active-file (not level)
1023                (gnus-server-opened gnus-select-method))
1024       (gnus-check-bogus-newsgroups))
1025
1026     ;; We might read in new NoCeM messages here.
1027     (when (and gnus-use-nocem
1028                (not level)
1029                (not dont-connect))
1030       (gnus-nocem-scan-groups))
1031
1032     ;; Read any slave files.
1033     (gnus-master-read-slave-newsrc)
1034
1035     ;; Find the number of unread articles in each non-dead group.
1036     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
1037       (gnus-get-unread-articles level))))
1038
1039 (defun gnus-call-subscribe-functions (method group)
1040   "Call METHOD to subscribe GROUP.
1041 If no function returns `non-nil', call `gnus-subscribe-zombies'."
1042   (unless (cond
1043            ((functionp method)
1044             (funcall method group))
1045            ((listp method)
1046             (catch 'found
1047               (dolist (func method)
1048                 (if (funcall func group)
1049                     (throw 'found t)))
1050               nil))
1051            (t nil))
1052     (gnus-subscribe-zombies group)))
1053
1054 (defun gnus-find-new-newsgroups (&optional arg)
1055   "Search for new newsgroups and add them.
1056 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'.
1057 The `-n' option line from .newsrc is respected.
1058
1059 With 1 C-u, use the `ask-server' method to query the server for new
1060 groups.
1061 With 2 C-u's, use most complete method possible to query the server
1062 for new groups, and subscribe the new groups as zombies."
1063   (interactive "p")
1064   (let* ((gnus-subscribe-newsgroup-method
1065           gnus-subscribe-newsgroup-method)
1066          (check (cond
1067                  ((or (and (= (or arg 1) 4)
1068                            (not (listp gnus-check-new-newsgroups)))
1069                       (null gnus-read-active-file)
1070                       (eq gnus-read-active-file 'some))
1071                   'ask-server)
1072                  ((= (or arg 1) 16)
1073                   (setq gnus-subscribe-newsgroup-method
1074                         'gnus-subscribe-zombies)
1075                   t)
1076                  (t gnus-check-new-newsgroups))))
1077     (unless (gnus-check-first-time-used)
1078       (if (or (consp check)
1079               (eq check 'ask-server))
1080           ;; Ask the server for new groups.
1081           (gnus-ask-server-for-new-groups)
1082         ;; Go through the active hashtb and look for new groups.
1083         (let ((groups 0)
1084               group new-newsgroups)
1085           (gnus-message 5 "Looking for new newsgroups...")
1086           (unless gnus-have-read-active-file
1087             (gnus-read-active-file))
1088           (setq gnus-newsrc-last-checked-date (message-make-date))
1089           (unless gnus-killed-hashtb
1090             (gnus-make-hashtable-from-killed))
1091           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
1092           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
1093           (mapatoms
1094            (lambda (sym)
1095              (if (or (null (setq group (symbol-name sym)))
1096                      (not (boundp sym))
1097                      (null (symbol-value sym))
1098                      (gnus-gethash group gnus-killed-hashtb)
1099                      (gnus-gethash group gnus-newsrc-hashtb))
1100                  ()
1101                (let ((do-sub (gnus-matches-options-n group)))
1102                  (cond
1103                   ((eq do-sub 'subscribe)
1104                    (setq groups (1+ groups))
1105                    (gnus-sethash group group gnus-killed-hashtb)
1106                    (gnus-call-subscribe-functions
1107                     gnus-subscribe-options-newsgroup-method group))
1108                   ((eq do-sub 'ignore)
1109                    nil)
1110                   (t
1111                    (setq groups (1+ groups))
1112                    (gnus-sethash group group gnus-killed-hashtb)
1113                    (if gnus-subscribe-hierarchical-interactive
1114                        (push group new-newsgroups)
1115                      (gnus-call-subscribe-functions
1116                       gnus-subscribe-newsgroup-method group)))))))
1117            gnus-active-hashtb)
1118           (when new-newsgroups
1119             (gnus-subscribe-hierarchical-interactive new-newsgroups))
1120           (if (> groups 0)
1121               (gnus-message 5 "%d new newsgroup%s arrived."
1122                             groups (if (> groups 1) "s have" " has"))
1123             (gnus-message 5 "No new newsgroups.")))))))
1124
1125 (defun gnus-matches-options-n (group)
1126   ;; Returns `subscribe' if the group is to be unconditionally
1127   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
1128   ;; no match for the group.
1129
1130   ;; First we check the two user variables.
1131   (cond
1132    ((and gnus-options-subscribe
1133          (string-match gnus-options-subscribe group))
1134     'subscribe)
1135    ((and gnus-auto-subscribed-groups
1136          (string-match gnus-auto-subscribed-groups group))
1137     'subscribe)
1138    ((and gnus-options-not-subscribe
1139          (string-match gnus-options-not-subscribe group))
1140     'ignore)
1141    ;; Then we go through the list that was retrieved from the .newsrc
1142    ;; file.  This list has elements on the form
1143    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
1144    ;; is in the reverse order of the options line) is returned.
1145    (t
1146     (let ((regs gnus-newsrc-options-n))
1147       (while (and regs
1148                   (not (string-match (caar regs) group)))
1149         (setq regs (cdr regs)))
1150       (and regs (cdar regs))))))
1151
1152 (defun gnus-ask-server-for-new-groups ()
1153   (let* ((new-date (message-make-date))
1154          (date (or gnus-newsrc-last-checked-date new-date))
1155          (methods (cons gnus-select-method
1156                         (nconc
1157                          (when (gnus-archive-server-wanted-p)
1158                            (list "archive"))
1159                          (append
1160                           (and (consp gnus-check-new-newsgroups)
1161                                gnus-check-new-newsgroups)
1162                           gnus-secondary-select-methods))))
1163          (groups 0)
1164          group new-newsgroups got-new method hashtb
1165          gnus-override-subscribe-method)
1166     (unless gnus-killed-hashtb
1167       (gnus-make-hashtable-from-killed))
1168     ;; Go through both primary and secondary select methods and
1169     ;; request new newsgroups.
1170     (while (setq method (gnus-server-get-method nil (pop methods)))
1171       (setq new-newsgroups nil
1172             gnus-override-subscribe-method method)
1173       (when (and (gnus-check-server method)
1174                  (gnus-request-newgroups date method))
1175         (save-excursion
1176           (setq got-new t
1177                 hashtb (gnus-make-hashtable 100))
1178           (set-buffer nntp-server-buffer)
1179           ;; Enter all the new groups into a hashtable.
1180           (gnus-active-to-gnus-format method hashtb 'ignore))
1181         ;; Now all new groups from `method' are in `hashtb'.
1182         (mapatoms
1183          (lambda (group-sym)
1184            (if (or (null (setq group (symbol-name group-sym)))
1185                    (not (boundp group-sym))
1186                    (null (symbol-value group-sym))
1187                    (gnus-gethash group gnus-newsrc-hashtb)
1188                    (member group gnus-zombie-list)
1189                    (member group gnus-killed-list))
1190                ;; The group is already known.
1191                ()
1192              ;; Make this group active.
1193              (when (symbol-value group-sym)
1194                (gnus-set-active group (symbol-value group-sym)))
1195              ;; Check whether we want it or not.
1196              (let ((do-sub (gnus-matches-options-n group)))
1197                (cond
1198                 ((eq do-sub 'subscribe)
1199                  (incf groups)
1200                  (gnus-sethash group group gnus-killed-hashtb)
1201                  (gnus-call-subscribe-functions
1202                   gnus-subscribe-options-newsgroup-method group))
1203                 ((eq do-sub 'ignore)
1204                  nil)
1205                 (t
1206                  (incf groups)
1207                  (gnus-sethash group group gnus-killed-hashtb)
1208                  (if gnus-subscribe-hierarchical-interactive
1209                      (push group new-newsgroups)
1210                    (gnus-call-subscribe-functions
1211                     gnus-subscribe-newsgroup-method group)))))))
1212          hashtb))
1213       (when new-newsgroups
1214         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
1215     (if (> groups 0)
1216         (gnus-message 5 "%d new newsgroup%s arrived"
1217                       groups (if (> groups 1) "s have" " has"))
1218       (gnus-message 5 "No new newsgroups"))
1219     (when got-new
1220       (setq gnus-newsrc-last-checked-date new-date))
1221     got-new))
1222
1223 (defun gnus-check-first-time-used ()
1224   (catch 'ended
1225     ;; First check if any of the following files exist.  If they do,
1226     ;; it's not the first time the user has used Gnus.
1227     (dolist (file (list (concat gnus-current-startup-file ".el")
1228                         (concat gnus-current-startup-file ".eld")
1229                         (concat gnus-startup-file ".el")
1230                         (concat gnus-startup-file ".eld")))
1231       (when (file-exists-p file)
1232         (throw 'ended nil)))
1233     (gnus-message 6 "First time user; subscribing you to default groups")
1234     (unless (gnus-read-active-file-p)
1235       (let ((gnus-read-active-file t))
1236         (gnus-read-active-file)))
1237     (setq gnus-newsrc-last-checked-date (message-make-date))
1238     ;; Subscribe to the default newsgroups.
1239     (let ((groups (or gnus-default-subscribed-newsgroups
1240                       gnus-backup-default-subscribed-newsgroups))
1241           group)
1242       (if (eq groups t)
1243           ;; If t, we subscribe (or not) all groups as if they were new.
1244           (mapatoms
1245            (lambda (sym)
1246              (when (setq group (symbol-name sym))
1247                (let ((do-sub (gnus-matches-options-n group)))
1248                  (cond
1249                   ((eq do-sub 'subscribe)
1250                    (gnus-sethash group group gnus-killed-hashtb)
1251                    (gnus-call-subscribe-functions
1252                     gnus-subscribe-options-newsgroup-method group))
1253                   ((eq do-sub 'ignore)
1254                    nil)
1255                   (t
1256                    (push group gnus-killed-list))))))
1257            gnus-active-hashtb)
1258         (dolist (group groups)
1259           ;; Only subscribe the default groups that are activated.
1260           (when (gnus-active group)
1261             (gnus-group-change-level
1262              group gnus-level-default-subscribed gnus-level-killed)))
1263         (save-excursion
1264           (set-buffer gnus-group-buffer)
1265           ;; Don't error if the group already exists. This happens when a
1266           ;; first-time user types 'F'. -- didier
1267           (gnus-group-make-help-group t))
1268         (when gnus-novice-user
1269           (gnus-message 7 "`A k' to list killed groups"))))))
1270
1271 (defun gnus-subscribe-group (group &optional previous method)
1272   "Subscribe GROUP and put it after PREVIOUS."
1273   (gnus-group-change-level
1274    (if method
1275        (list t group gnus-level-default-subscribed nil nil method)
1276      group)
1277    gnus-level-default-subscribed gnus-level-killed previous t)
1278   t)
1279
1280 ;; `gnus-group-change-level' is the fundamental function for changing
1281 ;; subscription levels of newsgroups.  This might mean just changing
1282 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
1283 ;; again, which subscribes/unsubscribes a group, which is equally
1284 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
1285 ;; from 8-9 to 1-7 means that you remove the group from the list of
1286 ;; killed (or zombie) groups and add them to the (kinda) subscribed
1287 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
1288 ;; which is trivial.
1289 ;; ENTRY can either be a string (newsgroup name) or a list (if
1290 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
1291 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
1292 ;; entries.
1293 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
1294 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
1295 ;; after.
1296 (defun gnus-group-change-level (entry level &optional oldlevel
1297                                       previous fromkilled)
1298   (let (group info active num)
1299     ;; Glean what info we can from the arguments
1300     (if (consp entry)
1301         (if fromkilled (setq group (nth 1 entry))
1302           (setq group (car (nth 2 entry))))
1303       (setq group entry))
1304     (when (and (stringp entry)
1305                oldlevel
1306                (< oldlevel gnus-level-zombie))
1307       (setq entry (gnus-group-entry entry)))
1308     (if (and (not oldlevel)
1309              (consp entry))
1310         (setq oldlevel (gnus-info-level (nth 2 entry)))
1311       (setq oldlevel (or oldlevel gnus-level-killed)))
1312     (when (stringp previous)
1313       (setq previous (gnus-group-entry previous)))
1314
1315     (if (and (>= oldlevel gnus-level-zombie)
1316              (gnus-group-entry group))
1317         ;; We are trying to subscribe a group that is already
1318         ;; subscribed.
1319         ()                              ; Do nothing.
1320
1321       (unless (gnus-ephemeral-group-p group)
1322         (gnus-dribble-enter
1323          (format "(gnus-group-change-level %S %S %S %S %S)"
1324                  group level oldlevel (car (nth 2 previous)) fromkilled)))
1325
1326       ;; Then we remove the newgroup from any old structures, if needed.
1327       ;; If the group was killed, we remove it from the killed or zombie
1328       ;; list.  If not, and it is in fact going to be killed, we remove
1329       ;; it from the newsrc hash table and assoc.
1330       (cond
1331        ((>= oldlevel gnus-level-zombie)
1332         ;; oldlevel could be wrong.
1333         (setq gnus-zombie-list (delete group gnus-zombie-list))
1334         (setq gnus-killed-list (delete group gnus-killed-list)))
1335        (t
1336         (when (and (>= level gnus-level-zombie)
1337                    entry)
1338           (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
1339           (when (nth 3 entry)
1340             (setcdr (gnus-group-entry (car (nth 3 entry)))
1341                     (cdr entry)))
1342           (setcdr (cdr entry) (cdddr entry)))))
1343
1344       ;; Finally we enter (if needed) the list where it is supposed to
1345       ;; go, and change the subscription level.  If it is to be killed,
1346       ;; we enter it into the killed or zombie list.
1347       (cond
1348        ((>= level gnus-level-zombie)
1349         ;; Remove from the hash table.
1350         (gnus-sethash group nil gnus-newsrc-hashtb)
1351         ;; We do not enter foreign groups into the list of dead
1352         ;; groups.
1353         (unless (gnus-group-foreign-p group)
1354           (if (= level gnus-level-zombie)
1355               (push group gnus-zombie-list)
1356             (if (= oldlevel gnus-level-killed)
1357                 ;; Remove from active hashtb.
1358                 (unintern group gnus-active-hashtb)
1359               ;; Don't add it into killed-list if it was killed.
1360               (push group gnus-killed-list)))))
1361        (t
1362         ;; If the list is to be entered into the newsrc assoc, and
1363         ;; it was killed, we have to create an entry in the newsrc
1364         ;; hashtb format and fix the pointers in the newsrc assoc.
1365         (if (< oldlevel gnus-level-zombie)
1366             ;; It was alive, and it is going to stay alive, so we
1367             ;; just change the level and don't change any pointers or
1368             ;; hash table entries.
1369             (setcar (cdaddr entry) level)
1370           (if (listp entry)
1371               (setq info (cdr entry)
1372                     num (car entry))
1373             (setq active (gnus-active group))
1374             (setq num
1375                   (if active (- (1+ (cdr active)) (car active)) t))
1376             ;; Shorten the select method if possible, if we need to
1377             ;; store it at all (native groups).
1378             (let ((method (gnus-method-simplify
1379                            (or gnus-override-subscribe-method
1380                                (gnus-group-method group)))))
1381               (if method
1382                   (setq info (list group level nil nil method))
1383                 (setq info (list group level nil)))))
1384           (unless previous
1385             (setq previous
1386                   (let ((p gnus-newsrc-alist))
1387                     (while (cddr p)
1388                       (setq p (cdr p)))
1389                     p)))
1390           (setq entry (cons info (cddr previous)))
1391           (if (cdr previous)
1392               (progn
1393                 (setcdr (cdr previous) entry)
1394                 (gnus-sethash group (cons num (cdr previous))
1395                               gnus-newsrc-hashtb))
1396             (setcdr previous entry)
1397             (gnus-sethash group (cons num previous)
1398                           gnus-newsrc-hashtb))
1399           (when (cdr entry)
1400             (setcdr (gnus-group-entry (caadr entry)) entry))
1401           (gnus-dribble-enter
1402            (format
1403             "(gnus-group-set-info '%S)" info)))))
1404       (when gnus-group-change-level-function
1405         (funcall gnus-group-change-level-function
1406                  group level oldlevel previous)))))
1407
1408 (defun gnus-kill-newsgroup (newsgroup)
1409   "Obsolete function.  Kills a newsgroup."
1410   (gnus-group-change-level
1411    (gnus-group-entry newsgroup) gnus-level-killed))
1412
1413 (defun gnus-check-bogus-newsgroups (&optional confirm)
1414   "Remove bogus newsgroups.
1415 If CONFIRM is non-nil, the user has to confirm the deletion of every
1416 newsgroup."
1417   (let ((newsrc (cdr gnus-newsrc-alist))
1418         bogus group entry info)
1419     (gnus-message 5 "Checking bogus newsgroups...")
1420     (unless (gnus-read-active-file-p)
1421       (gnus-read-active-file t))
1422     (when (gnus-read-active-file-p)
1423       ;; Find all bogus newsgroup that are subscribed.
1424       (while newsrc
1425         (setq info (pop newsrc)
1426               group (gnus-info-group info))
1427         (unless (or (gnus-active group) ; Active
1428                     (and (gnus-info-method info)
1429                          (not (gnus-secondary-method-p
1430                                (gnus-info-method info))))) ; Foreign
1431           ;; Found a bogus newsgroup.
1432           (push group bogus)))
1433       (if confirm
1434           (map-y-or-n-p
1435            "Remove bogus group %s? "
1436            (lambda (group)
1437              ;; Remove all bogus subscribed groups by first killing them, and
1438              ;; then removing them from the list of killed groups.
1439              (when (setq entry (gnus-group-entry group))
1440                (gnus-group-change-level entry gnus-level-killed)
1441                (setq gnus-killed-list (delete group gnus-killed-list))))
1442            bogus '("group" "groups" "remove"))
1443         (while (setq group (pop bogus))
1444           ;; Remove all bogus subscribed groups by first killing them, and
1445           ;; then removing them from the list of killed groups.
1446           (when (setq entry (gnus-group-entry group))
1447             (gnus-group-change-level entry gnus-level-killed)
1448             (setq gnus-killed-list (delete group gnus-killed-list)))))
1449       ;; Then we remove all bogus groups from the list of killed and
1450       ;; zombie groups.  They are removed without confirmation.
1451       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
1452             killed)
1453         (while dead-lists
1454           (setq killed (symbol-value (car dead-lists)))
1455           (while killed
1456             (unless (gnus-active (setq group (pop killed)))
1457               ;; The group is bogus.
1458               ;; !!!Slow as hell.
1459               (set (car dead-lists)
1460                    (delete group (symbol-value (car dead-lists))))))
1461           (setq dead-lists (cdr dead-lists))))
1462       (gnus-run-hooks 'gnus-check-bogus-groups-hook)
1463       (gnus-message 5 "Checking bogus newsgroups...done"))))
1464
1465 (defun gnus-check-duplicate-killed-groups ()
1466   "Remove duplicates from the list of killed groups."
1467   (interactive)
1468   (let ((killed gnus-killed-list))
1469     (while killed
1470       (gnus-message 9 "%d" (length killed))
1471       (setcdr killed (delete (car killed) (cdr killed)))
1472       (setq killed (cdr killed)))))
1473
1474 ;; We want to inline a function from gnus-cache, so we cheat here:
1475 (eval-when-compile
1476   (defvar gnus-cache-active-hashtb)
1477   (defun gnus-cache-possibly-alter-active (group active)
1478     "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
1479     (when gnus-cache-active-hashtb
1480       (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
1481         (when cache-active
1482     &nb