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