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

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