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

   1 ;;; gnus-start.el --- startup functions for Gnus
   2
   3 ;; Copyright (C) 1996-2015 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 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'gnus)
  28 (require 'gnus-win)
  29 (require 'gnus-int)
  30 (require 'gnus-spec)
  31 (require 'gnus-range)
  32 (require 'gnus-util)
  33 (require 'gnus-cloud)
  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-use-dribble-file t
  90   "*Non-nil means that Gnus will use a dribble file to store user updates.
  91 If Emacs should crash without saving the .newsrc files, complete
  92 information can be restored from the dribble file."
  93   :group 'gnus-dribble-file
  94   :type 'boolean)
  95
  96 (defcustom gnus-dribble-directory nil
  97   "*The directory where dribble files will be saved.
  98 If this variable is nil, the directory where the .newsrc files are
  99 saved will be used."
 100   :group 'gnus-dribble-file
 101   :type '(choice directory (const nil)))
 102
 103 (defcustom gnus-check-new-newsgroups 'ask-server
 104   "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup.
 105 This normally finds new newsgroups by comparing the active groups the
 106 servers have already reported with those Gnus already knows, either alive
 107 or killed.
 108
 109 When any of the following are true, `gnus-find-new-newsgroups' will instead
 110 ask the servers (primary, secondary, and archive servers) to list new
 111 groups since the last time it checked:
 112   1. This variable is `ask-server'.
 113   2. This variable is a list of select methods (see below).
 114   3. Option `gnus-read-active-file' is nil or `some'.
 115   4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
 116
 117 Thus, if this variable is `ask-server' or a list of select methods or
 118 `gnus-read-active-file' is nil or `some', then the killed list is no
 119 longer necessary, so you could safely set `gnus-save-killed-list' to nil.
 120
 121 This variable can be a list of select methods which Gnus will query with
 122 the `ask-server' method in addition to the primary, secondary, and archive
 123 servers.
 124
 125 E.g.:
 126   (setq gnus-check-new-newsgroups
 127         '((nntp \"some.server\") (nntp \"other.server\")))
 128
 129 If this variable is nil, then you have to tell Gnus explicitly to
 130 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
 131   :group 'gnus-start
 132   :type '(choice (const :tag "no" nil)
 133                  (const :tag "by brute force" t)
 134                  (const :tag "ask servers" ask-server)
 135                  (repeat :menu-tag "ask additional servers"
 136                          :tag "ask additional servers"
 137                          :value ((nntp ""))
 138                          (sexp :format "%v"))))
 139
 140 (defcustom gnus-check-bogus-newsgroups nil
 141   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
 142 If this variable is nil, then you have to tell Gnus explicitly to
 143 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]."
 144   :group 'gnus-start-server
 145   :type 'boolean)
 146
 147 (defcustom gnus-read-active-file 'some
 148   "*Non-nil means that Gnus will read the entire active file at startup.
 149 If this variable is nil, Gnus will only know about the groups in your
 150 `.newsrc' file.
 151
 152 If this variable is `some', Gnus will try to only read the relevant
 153 parts of the active file from the server.  Not all servers support
 154 this, and it might be quite slow with other servers, but this should
 155 generally be faster than both the t and nil value.
 156
 157 If you set this variable to nil or `some', you probably still want to
 158 be told about new newsgroups that arrive.  To do that, set
 159 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
 160 properly with all servers."
 161   :group 'gnus-start-server
 162   :type '(choice (const nil)
 163                  (const some)
 164                  (const t)))
 165
 166 (defconst gnus-level-subscribed 5
 167   "Groups with levels less than or equal to this variable are subscribed.")
 168
 169 (defconst gnus-level-unsubscribed 7
 170   "Groups with levels less than or equal to this variable are unsubscribed.
 171
 172 Groups with levels less than `gnus-level-subscribed', which
 173 should be less than this variable, are subscribed.  Groups with
 174 levels from `gnus-level-subscribed' (exclusive) upto this
 175 variable (inclusive) are unsubscribed.  See also
 176 `gnus-level-zombie', `gnus-level-killed' and the Info node `(gnus)Group
 177 Levels' for details.")
 178
 179 (defconst gnus-level-zombie 8
 180   "Groups with this level are zombie groups.")
 181
 182 (defconst gnus-level-killed 9
 183   "Groups with this level are killed.")
 184
 185 (defcustom gnus-level-default-subscribed 3
 186   "*New subscribed groups will be subscribed at this level."
 187   :group 'gnus-group-levels
 188   :type 'integer)
 189
 190 (defcustom gnus-level-default-unsubscribed 6
 191   "*New unsubscribed groups will be unsubscribed at this level."
 192   :group 'gnus-group-levels
 193   :type 'integer)
 194
 195 (defcustom gnus-activate-level (1+ gnus-level-subscribed)
 196   "*Groups higher than this level won't be activated on startup.
 197 Setting this variable to something low might save lots of time when
 198 you have many groups that you aren't interested in."
 199   :group 'gnus-group-levels
 200   :type 'integer)
 201
 202 (defcustom gnus-activate-foreign-newsgroups 4
 203   "*If nil, Gnus will not check foreign newsgroups at startup.
 204 If it is non-nil, it should be a number between one and nine.  Foreign
 205 newsgroups that have a level lower or equal to this number will be
 206 activated on startup.  For instance, if you want to active all
 207 subscribed newsgroups, but not the rest, you'd set this variable to
 208 `gnus-level-subscribed'.
 209
 210 If you subscribe to lots of newsgroups from different servers, startup
 211 might take a while.  By setting this variable to nil, you'll save time,
 212 but you won't be told how many unread articles there are in the
 213 groups."
 214   :group 'gnus-group-levels
 215   :type '(choice integer
 216                  (const :tag "none" nil)))
 217
 218 (defcustom gnus-read-newsrc-file t
 219   "*Non-nil means that Gnus will read the `.newsrc' file.
 220 Gnus always reads its own startup file, which is called
 221 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 222 be readily understood by other newsreaders.  If you don't plan on
 223 using other newsreaders, set this variable to nil to save some time on
 224 entry."
 225   :version "21.1"
 226   :group 'gnus-newsrc
 227   :type 'boolean)
 228
 229 (defcustom gnus-save-newsrc-file t
 230   "*Non-nil means that Gnus will save the `.newsrc' file.
 231 Gnus always saves its own startup file, which is called
 232 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 233 be readily understood by other newsreaders.  If you don't plan on
 234 using other newsreaders, set this variable to nil to save some time on
 235 exit."
 236   :group 'gnus-newsrc
 237   :type 'boolean)
 238
 239 (defcustom gnus-save-killed-list t
 240   "*If non-nil, save the list of killed groups to the startup file.
 241 If you set this variable to nil, you'll save both time (when starting
 242 and quitting) and space (both memory and disk), but it will also mean
 243 that Gnus has no record of which groups are new and which are old, so
 244 the automatic new newsgroups subscription methods become meaningless.
 245
 246 You should always set `gnus-check-new-newsgroups' to `ask-server' or
 247 nil if you set this variable to nil.
 248
 249 This variable can also be a regexp.  In that case, all groups that do
 250 not match this regexp will be removed before saving the list."
 251   :group 'gnus-newsrc
 252   :type '(radio (sexp :format "Non-nil\n"
 253                       :match (lambda (widget value)
 254                                (and value (not (stringp value))))
 255                       :value t)
 256                 (const nil)
 257                 regexp))
 258
 259 (defcustom gnus-ignored-newsgroups
 260   (mapconcat 'identity
 261              '("^to\\."                 ; not "real" groups
 262                "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
 263                "^[\"][\"#'()]"  ; bogus characters
 264                )
 265              "\\|")
 266   "*A regexp to match uninteresting newsgroups in the active file.
 267 Any lines in the active file matching this regular expression are
 268 removed from the newsgroup list before anything else is done to it,
 269 thus making them effectively non-existent."
 270   :group 'gnus-group-new
 271   :type 'regexp)
 272
 273 (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
 274   "*Function(s) called with a group name when new group is detected.
 275 A few pre-made functions are supplied: `gnus-subscribe-randomly'
 276 inserts new groups at the beginning of the list of groups;
 277 `gnus-subscribe-alphabetically' inserts new groups in strict
 278 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
 279 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
 280 for your decision; `gnus-subscribe-killed' kills all new groups;
 281 `gnus-subscribe-zombies' will make all new groups into zombies;
 282 `gnus-subscribe-topics' will enter groups into the topics that
 283 claim them."
 284   :group 'gnus-group-new
 285   :type '(radio (function-item gnus-subscribe-randomly)
 286                 (function-item gnus-subscribe-alphabetically)
 287                 (function-item gnus-subscribe-hierarchically)
 288                 (function-item gnus-subscribe-interactively)
 289                 (function-item gnus-subscribe-killed)
 290                 (function-item gnus-subscribe-zombies)
 291                 (function-item gnus-subscribe-topics)
 292                 function
 293                 (repeat function)))
 294
 295 (define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks
 296   'gnus-subscribe-newsgroup-functions "24.3")
 297 (defcustom gnus-subscribe-newsgroup-functions nil
 298   "*Hooks run after you subscribe to a new group.
 299 The hooks will be called with new group's name as argument."
 300   :version "22.1"
 301   :group 'gnus-group-new
 302   :type 'hook)
 303
 304 (defcustom gnus-subscribe-options-newsgroup-method
 305   'gnus-subscribe-alphabetically
 306   "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
 307 If, for instance, you want to subscribe to all newsgroups in the
 308 \"no\" and \"alt\" hierarchies, you'd put the following in your
 309 .newsrc file:
 310
 311 options -n no.all alt.all
 312
 313 Gnus will then subscribe all new newsgroups in these hierarchies
 314 with the subscription method in this variable."
 315   :group 'gnus-group-new
 316   :type '(radio (function-item gnus-subscribe-randomly)
 317                 (function-item gnus-subscribe-alphabetically)
 318                 (function-item gnus-subscribe-hierarchically)
 319                 (function-item gnus-subscribe-interactively)
 320                 (function-item gnus-subscribe-killed)
 321                 (function-item gnus-subscribe-zombies)
 322                 (function-item gnus-subscribe-topics)
 323                 function
 324                 (repeat function)))
 325
 326 (defcustom gnus-subscribe-hierarchical-interactive nil
 327   "*If non-nil, Gnus will offer to subscribe hierarchically.
 328 When a new hierarchy appears, Gnus will ask the user:
 329
 330 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
 331
 332 If the user pressed `d', Gnus will descend the hierarchy, `y' will
 333 subscribe to all newsgroups in the hierarchy and `s' will skip this
 334 hierarchy in its entirety."
 335   :group 'gnus-group-new
 336   :type 'boolean)
 337
 338 (defcustom gnus-auto-subscribed-categories '(mail post-mail)
 339   "*New groups from methods of these categories will be subscribed automatically.
 340 Note that this variable only deals with new groups.  It has no
 341 effect whatsoever on old groups.  The default is to automatically
 342 subscribe all groups from mail-like backends."
 343   :version "24.1"
 344   :group 'gnus-group-new
 345   :type '(repeat symbol))
 346
 347 (defcustom gnus-auto-subscribed-groups
 348   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir\\|^nnimap"
 349   "*All new groups that match this regexp will be subscribed automatically.
 350 Note that this variable only deals with new groups.  It has no effect
 351 whatsoever on old groups.
 352
 353 New groups that match this regexp will not be handled by
 354 `gnus-subscribe-newsgroup-method'.  Instead, they will
 355 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 356   :group 'gnus-group-new
 357   :type 'regexp)
 358
 359 (defcustom gnus-options-subscribe nil
 360   "*All new groups matching this regexp will be subscribed unconditionally.
 361 Note that this variable deals only with new newsgroups.  This variable
 362 does not affect old newsgroups.
 363
 364 New groups that match this regexp will not be handled by
 365 `gnus-subscribe-newsgroup-method'.  Instead, they will
 366 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 367   :group 'gnus-group-new
 368   :type '(choice regexp
 369                  (const :tag "none" nil)))
 370
 371 (defcustom gnus-options-not-subscribe nil
 372   "*All new groups matching this regexp will be ignored.
 373 Note that this variable deals only with new newsgroups.  This variable
 374 does not affect old (already subscribed) newsgroups."
 375   :group 'gnus-group-new
 376   :type '(choice regexp
 377                  (const :tag "none" nil)))
 378
 379 (defcustom gnus-modtime-botch nil
 380   "*Non-nil means .newsrc should be deleted prior to save.
 381 Its use is due to the bogus appearance that .newsrc was modified on
 382 disc."
 383   :group 'gnus-newsrc
 384   :type 'boolean)
 385
 386 (defcustom gnus-check-bogus-groups-hook nil
 387   "A hook run after removing bogus groups."
 388   :group 'gnus-start-server
 389   :type 'hook)
 390
 391 (defcustom gnus-startup-hook nil
 392   "A hook called at startup.
 393 This hook is called after Gnus is connected to the NNTP server."
 394   :group 'gnus-start
 395   :type 'hook)
 396
 397 (defcustom gnus-before-startup-hook nil
 398   "A hook called before startup.
 399 This hook is called as the first thing when Gnus is started.
 400 See also `gnus-before-resume-hook'."
 401   :group 'gnus-start
 402   :type 'hook)
 403
 404 (defcustom gnus-before-resume-hook nil
 405   "A hook called before resuming Gnus after suspend.
 406 This hook is called as the first thing when Gnus is resumed after a suspend.
 407 See also `gnus-before-startup-hook'."
 408   :version "24.4"
 409   :group 'gnus-start
 410   :type 'hook)
 411
 412 (defcustom gnus-started-hook nil
 413   "A hook called as the last thing after startup."
 414   :group 'gnus-start
 415   :type 'hook)
 416
 417 (defcustom gnus-setup-news-hook nil
 418   "A hook after reading the .newsrc file, but before generating the buffer."
 419   :group 'gnus-start
 420   :type 'hook)
 421
 422 (defcustom gnus-get-top-new-news-hook nil
 423   "A hook run just before Gnus checks for new news globally."
 424   :version "22.1"
 425   :group 'gnus-group-new
 426   :type 'hook)
 427
 428 (defcustom gnus-get-new-news-hook nil
 429   "A hook run just before Gnus checks for new news."
 430   :group 'gnus-group-new
 431   :type 'hook)
 432
 433 (defcustom gnus-after-getting-new-news-hook
 434   '(gnus-display-time-event-handler)
 435   "*A hook run after Gnus checks for new news when Gnus is already running."
 436   :version "24.1"
 437   :group 'gnus-group-new
 438   :type 'hook)
 439
 440 (defcustom gnus-read-newsrc-el-hook nil
 441   "A hook called after reading the newsrc.eld? file."
 442   :group 'gnus-newsrc
 443   :type 'hook)
 444
 445 (defcustom gnus-save-newsrc-hook nil
 446   "A hook called before saving any of the newsrc files."
 447   :group 'gnus-newsrc
 448   :type 'hook)
 449
 450 (defcustom gnus-save-quick-newsrc-hook nil
 451   "A hook called just before saving the quick newsrc file.
 452 Can be used to turn version control on or off."
 453   :group 'gnus-newsrc
 454   :type 'hook)
 455
 456 (defcustom gnus-save-standard-newsrc-hook nil
 457   "A hook called just before saving the standard newsrc file.
 458 Can be used to turn version control on or off."
 459   :group 'gnus-newsrc
 460   :type 'hook)
 461
 462 (defcustom gnus-group-mode-hook nil
 463   "Hook for Gnus group mode."
 464   :group 'gnus-group-various
 465   :options '(gnus-topic-mode)
 466   :type 'hook)
 467
 468 (defcustom gnus-always-read-dribble-file nil
 469   "Unconditionally read the dribble file."
 470   :group 'gnus-newsrc
 471   :type 'boolean)
 472
 473 ;;; Internal variables
 474
 475 ;; Fixme: deal with old emacs-mule when mm-universal-coding-system is
 476 ;; utf-8-emacs.
 477 (defvar gnus-ding-file-coding-system mm-universal-coding-system
 478   "Coding system for ding file.")
 479
 480 (defvar gnus-newsrc-file-version nil)
 481 (defvar gnus-override-subscribe-method nil)
 482 (defvar gnus-dribble-buffer nil)
 483 (defvar gnus-newsrc-options nil
 484   "Options line in the .newsrc file.")
 485
 486 (defvar gnus-newsrc-options-n nil
 487   "List of regexps representing groups to be subscribed/ignored unconditionally.")
 488
 489 (defvar gnus-newsrc-last-checked-date nil
 490   "Date Gnus last asked server for new newsgroups.")
 491
 492 (defvar gnus-current-startup-file nil
 493   "Startup file for the current host.")
 494
 495 ;; Byte-compiler warning.
 496 (defvar gnus-group-line-format)
 497
 498 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
 499 (defvar gnus-init-inhibit nil)
 500 (defun gnus-read-init-file (&optional inhibit-next)
 501   ;; Don't load .gnus if the -q option was used.
 502   (when init-file-user
 503     (if gnus-init-inhibit
 504         (setq gnus-init-inhibit nil)
 505       (setq gnus-init-inhibit inhibit-next)
 506       (dolist (file (list gnus-site-init-file gnus-init-file))
 507         (when (and file
 508                    (locate-library file))
 509           (if (or debug-on-error debug-on-quit)
 510               (load file nil t)
 511             (condition-case var
 512                 (load file nil t)
 513               (error
 514                (error "Error in %s: %s" file (cadr var))))))))))
 515
 516 ;; For subscribing new newsgroup
 517
 518 (defun gnus-subscribe-hierarchical-interactive (groups)
 519   (let ((groups (sort groups 'string<))
 520         prefixes prefix start ans group starts real-group)
 521     (while groups
 522       (setq prefixes (list "^"))
 523       (while (and groups prefixes)
 524         (while (not (string-match (car prefixes)
 525                                   (gnus-group-real-name (car groups))))
 526           (setq prefixes (cdr prefixes)))
 527         (setq prefix (car prefixes))
 528         (setq start (1- (length prefix)))
 529         (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups))
 530                                start)
 531                  (cdr groups)
 532                  (setq prefix
 533                        (concat "^" (substring
 534                                     (gnus-group-real-name (car groups))
 535                                     0 (match-end 0))))
 536                  (string-match prefix (gnus-group-real-name (cadr groups))))
 537             (progn
 538               (push prefix prefixes)
 539               (message "Descend hierarchy %s? ([y]nsq): "
 540                        (substring prefix 1 (1- (length prefix))))
 541               (while (not (memq (setq ans (read-char-exclusive))
 542                                 '(?y ?\n ?\r ?n ?s ?q)))
 543                 (ding)
 544                 (message "Descend hierarchy %s? ([y]nsq): "
 545                          (substring prefix 1 (1- (length prefix)))))
 546               (cond ((= ans ?n)
 547                      (while (and groups
 548                                  (setq group (car groups)
 549                                        real-group (gnus-group-real-name group))
 550                                  (string-match prefix real-group))
 551                        (push group gnus-killed-list)
 552                        (gnus-sethash group group gnus-killed-hashtb)
 553                        (setq groups (cdr groups)))
 554                      (setq starts (cdr starts)))
 555                     ((= ans ?s)
 556                      (while (and groups
 557                                  (setq group (car groups)
 558                                        real-group (gnus-group-real-name group))
 559                                  (string-match prefix real-group))
 560                        (gnus-sethash group group gnus-killed-hashtb)
 561                        (gnus-subscribe-alphabetically (car groups))
 562                        (setq groups (cdr groups)))
 563                      (setq starts (cdr starts)))
 564                     ((= ans ?q)
 565                      (while groups
 566                        (setq group (car groups))
 567                        (push group gnus-killed-list)
 568                        (gnus-sethash group group gnus-killed-hashtb)
 569                        (setq groups (cdr groups))))
 570                     (t nil)))
 571           (message "Subscribe %s? ([n]yq)" (car groups))
 572           (while (not (memq (setq ans (read-char-exclusive))
 573                             '(?y ?\n ?\r ?q ?n)))
 574             (ding)
 575             (message "Subscribe %s? ([n]yq)" (car groups)))
 576           (setq group (car groups))
 577           (cond ((= ans ?y)
 578                  (gnus-subscribe-alphabetically (car groups))
 579                  (gnus-sethash group group gnus-killed-hashtb))
 580                 ((= ans ?q)
 581                  (while groups
 582                    (setq group (car groups))
 583                    (push group gnus-killed-list)
 584                    (gnus-sethash group group gnus-killed-hashtb)
 585                    (setq groups (cdr groups))))
 586                 (t
 587                  (push group gnus-killed-list)
 588                  (gnus-sethash group group gnus-killed-hashtb)))
 589           (setq groups (cdr groups)))))))
 590
 591 (defun gnus-subscribe-randomly (newsgroup)
 592   "Subscribe new NEWSGROUP by making it the first newsgroup."
 593   (gnus-subscribe-newsgroup newsgroup))
 594
 595 (defun gnus-subscribe-alphabetically (newgroup)
 596   "Subscribe new NEWGROUP and insert it in alphabetical order."
 597   (let ((groups (cdr gnus-newsrc-alist))
 598         before)
 599     (while (and (not before) groups)
 600       (if (string< newgroup (caar groups))
 601           (setq before (caar groups))
 602         (setq groups (cdr groups))))
 603     (gnus-subscribe-newsgroup newgroup before)))
 604
 605 (defun gnus-subscribe-hierarchically (newgroup)
 606   "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
 607   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
 608   (with-current-buffer (nnheader-find-file-noselect gnus-current-startup-file)
 609     (prog1
 610         (let ((groupkey newgroup) before)
 611           (while (and (not before) groupkey)
 612             (goto-char (point-min))
 613             (let ((groupkey-re
 614                    (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
 615               (while (and (re-search-forward groupkey-re nil t)
 616                           (progn
 617                             (setq before (match-string 1))
 618                             (string< before newgroup)))))
 619             ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
 620             (setq groupkey
 621                   (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
 622                     (substring groupkey (match-beginning 1) (match-end 1)))))
 623           (gnus-subscribe-newsgroup newgroup before))
 624       (kill-buffer (current-buffer)))))
 625
 626 (defun gnus-subscribe-interactively (group)
 627   "Subscribe the new GROUP interactively.
 628 It is inserted in hierarchical newsgroup order if subscribed.  If not,
 629 it is killed."
 630   (if (gnus-y-or-n-p (format "Subscribe new newsgroup %s? " group))
 631       (gnus-subscribe-hierarchically group)
 632     (push group gnus-killed-list)))
 633
 634 (defun gnus-subscribe-zombies (group)
 635   "Make the new GROUP into a zombie group."
 636   (push group gnus-zombie-list))
 637
 638 (defun gnus-subscribe-killed (group)
 639   "Make the new GROUP a killed group."
 640   (push group gnus-killed-list))
 641
 642 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
 643   "Subscribe new NEWSGROUP.
 644 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
 645 the first newsgroup."
 646   (save-excursion
 647     (goto-char (point-min))
 648     ;; We subscribe the group by changing its level to `subscribed'.
 649     (gnus-group-change-level
 650      newsgroup gnus-level-default-subscribed
 651      gnus-level-killed (gnus-group-entry (or next "dummy.group")))
 652     (gnus-request-update-group-status newsgroup 'subscribe)
 653     (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
 654     (run-hook-with-args 'gnus-subscribe-newsgroup-functions newsgroup)
 655     t))
 656
 657 (defun gnus-read-active-file-p ()
 658   "Say whether the active file has been read from `gnus-select-method'."
 659   (memq gnus-select-method gnus-have-read-active-file))
 660
 661 ;;; General various misc type functions.
 662
 663 ;; Silence byte-compiler.
 664 (defvar gnus-current-headers)
 665 (defvar gnus-thread-indent-array)
 666 (defvar gnus-newsgroup-name)
 667 (defvar gnus-newsgroup-headers)
 668 (defvar gnus-group-list-mode)
 669 (defvar gnus-group-mark-positions)
 670 (defvar gnus-newsgroup-data)
 671 (defvar gnus-newsgroup-unreads)
 672 (defvar nnoo-state-alist)
 673 (defvar gnus-current-select-method)
 674 (defvar mail-sources)
 675 (defvar nnmail-scan-directory-mail-source-once)
 676 (defvar nnmail-split-history)
 677 (defvar nnmail-spool-file)
 678
 679 (defun gnus-close-all-servers ()
 680   "Close all servers."
 681   (interactive)
 682   (dolist (server gnus-opened-servers)
 683     (gnus-close-server (car server))))
 684
 685 (defun gnus-clear-system ()
 686   "Clear all variables and buffers."
 687   ;; Clear Gnus variables.
 688   (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
 689     (while variables
 690       (set (car variables) nil)
 691       (setq variables (cdr variables))))
 692   ;; Clear other internal variables.
 693   (setq gnus-list-of-killed-groups nil
 694         gnus-have-read-active-file nil
 695         gnus-agent-covered-methods nil
 696         gnus-agent-file-loading-local nil
 697         gnus-agent-file-loading-cache nil
 698         gnus-server-method-cache nil
 699         gnus-newsrc-alist nil
 700         gnus-newsrc-hashtb nil
 701         gnus-killed-list nil
 702         gnus-zombie-list nil
 703         gnus-killed-hashtb nil
 704         gnus-active-hashtb nil
 705         gnus-moderated-hashtb nil
 706         gnus-description-hashtb nil
 707         gnus-current-headers nil
 708         gnus-thread-indent-array nil
 709         gnus-newsgroup-headers nil
 710         gnus-newsgroup-name nil
 711         gnus-server-alist nil
 712         gnus-group-list-mode nil
 713         gnus-opened-servers nil
 714         gnus-group-mark-positions nil
 715         gnus-newsgroup-data nil
 716         gnus-newsgroup-unreads nil
 717         nnoo-state-alist nil
 718         gnus-current-select-method nil
 719         nnmail-split-history nil
 720         gnus-extended-servers nil
 721         gnus-ephemeral-servers nil)
 722   (gnus-shutdown 'gnus)
 723   ;; Kill the startup file.
 724   (and gnus-current-startup-file
 725        (get-file-buffer gnus-current-startup-file)
 726        (kill-buffer (get-file-buffer gnus-current-startup-file)))
 727   ;; Clear the dribble buffer.
 728   (gnus-dribble-clear)
 729   ;; Kill global KILL file buffer.
 730   (when (get-file-buffer (gnus-newsgroup-kill-file nil))
 731     (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
 732   (gnus-kill-buffer nntp-server-buffer)
 733   ;; Kill Gnus buffers.
 734   (dolist (buffer (gnus-buffers))
 735     (gnus-kill-buffer buffer))
 736   ;; Remove Gnus frames.
 737   (gnus-kill-gnus-frames))
 738
 739 (defun gnus-no-server-1 (&optional arg slave)
 740   "Read network news.
 741 If ARG is a positive number, Gnus will use that as the startup
 742 level.  If ARG is nil, Gnus will be started at level 2
 743 \(`gnus-level-default-subscribed' minus one).  If ARG is non-nil
 744 and not a positive number, Gnus will prompt the user for the name
 745 of an NNTP server to use.  As opposed to \\[gnus], this command
 746 will not connect to the local server."
 747   (interactive "P")
 748   (let ((val (or arg (1- gnus-level-default-subscribed))))
 749     (gnus val t slave)
 750     (make-local-variable 'gnus-group-use-permanent-levels)
 751     (setq gnus-group-use-permanent-levels val)))
 752
 753 (defun gnus-1 (&optional arg dont-connect slave)
 754   "Read network news.
 755 If ARG is non-nil and a positive number, Gnus will use that as the
 756 startup level.  If ARG is non-nil and not a positive number, Gnus will
 757 prompt the user for the name of an NNTP server to use."
 758   (interactive "P")
 759
 760   (if (gnus-alive-p)
 761       (progn
 762         (gnus-run-hooks 'gnus-before-resume-hook)
 763         (switch-to-buffer gnus-group-buffer)
 764         (gnus-group-get-new-news
 765          (and (numberp arg)
 766               (> arg 0)
 767               (max (car gnus-group-list-mode) arg))))
 768
 769     (gnus-clear-system)
 770     (gnus-splash)
 771     (gnus-run-hooks 'gnus-before-startup-hook)
 772     (nnheader-init-server-buffer)
 773     (setq gnus-slave slave)
 774     (gnus-read-init-file)
 775
 776     ;; Add "native" to gnus-predefined-server-alist just to have a
 777     ;; name for the native select method.
 778     (when gnus-select-method
 779       (add-to-list 'gnus-predefined-server-alist
 780                    (cons "native" gnus-select-method)))
 781
 782     (if gnus-agent
 783         (gnus-agentize))
 784
 785     (let ((level (and (numberp arg) (> arg 0) arg))
 786           did-connect)
 787       (unwind-protect
 788           (progn
 789             (unless dont-connect
 790               (setq did-connect
 791                     (gnus-start-news-server (and arg (not level))))))
 792         (if (and (not dont-connect)
 793                  (not did-connect))
 794             ;; Couldn't connect to the server, so bail out.
 795             (gnus-group-quit)
 796           (gnus-run-hooks 'gnus-startup-hook)
 797           ;; Find the current startup file name.
 798           (setq gnus-current-startup-file
 799                 (gnus-make-newsrc-file gnus-startup-file))
 800
 801           ;; Read the dribble file.
 802           (when (or gnus-slave gnus-use-dribble-file)
 803             (gnus-dribble-read-file))
 804
 805           ;; Do the actual startup.
 806           (gnus-setup-news nil level dont-connect)
 807           (gnus-run-hooks 'gnus-setup-news-hook)
 808           (when gnus-agent
 809             (gnus-request-create-group "queue" '(nndraft "")))
 810           (gnus-start-draft-setup)
 811           ;; Generate the group buffer.
 812           (gnus-group-list-groups level)
 813           (gnus-group-first-unread-group)
 814           (gnus-configure-windows 'group)
 815           (gnus-group-set-mode-line)
 816           (gnus-run-hooks 'gnus-started-hook))))))
 817
 818 (defun gnus-start-draft-setup ()
 819   "Make sure the draft group exists."
 820   (interactive)
 821   (gnus-request-create-group "drafts" '(nndraft ""))
 822   (unless (gnus-group-entry "nndraft:drafts")
 823     (let ((gnus-level-default-subscribed 1))
 824       (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))
 825     (setcar (gnus-group-entry "nndraft:drafts") 0))
 826   (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t)
 827                  '((gnus-draft-mode)))
 828     (gnus-group-set-parameter
 829      "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
 830
 831 \f
 832 ;;;
 833 ;;; Dribble file
 834 ;;;
 835
 836 (defvar gnus-dribble-ignore nil)
 837 (defvar gnus-dribble-eval-file nil)
 838
 839 (defun gnus-dribble-file-name ()
 840   "Return the dribble file for the current .newsrc."
 841   (concat
 842    (if gnus-dribble-directory
 843        (concat (file-name-as-directory gnus-dribble-directory)
 844                (file-name-nondirectory gnus-current-startup-file))
 845      gnus-current-startup-file)
 846    "-dribble"))
 847
 848 (defun gnus-dribble-enter (string &optional regexp)
 849   "Enter STRING into the dribble buffer.
 850 If REGEXP is given, lines that match it will be deleted."
 851   (when (and (not gnus-dribble-ignore)
 852              gnus-dribble-buffer
 853              (buffer-name gnus-dribble-buffer))
 854     (let ((obuf (current-buffer)))
 855       (set-buffer gnus-dribble-buffer)
 856       (when regexp
 857         (goto-char (point-min))
 858         (let (end)
 859           (while (re-search-forward regexp nil t)
 860             (unless (bolp) (forward-line 1))
 861             (setq end (point))
 862             (goto-char (match-beginning 0))
 863             (delete-region (point-at-bol) end))))
 864       (goto-char (point-max))
 865       (insert string "\n")
 866       ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
 867       ;; It causes problems with both XEmacs and Emacs 21, and doesn't
 868       ;; seem to be of much value. (FIXME: remove this after we make sure
 869       ;; it's not needed).
 870       ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
 871       (bury-buffer gnus-dribble-buffer)
 872       (with-current-buffer gnus-group-buffer
 873         (gnus-group-set-mode-line))
 874       (set-buffer obuf))))
 875
 876 (defun gnus-dribble-touch ()
 877   "Touch the dribble buffer."
 878   (gnus-dribble-enter ""))
 879
 880 (defun gnus-dribble-read-file ()
 881   "Read the dribble file from disk."
 882   (let ((dribble-file (gnus-dribble-file-name)))
 883     (unless (file-exists-p (file-name-directory dribble-file))
 884       (make-directory (file-name-directory dribble-file) t))
 885     (with-current-buffer (setq gnus-dribble-buffer
 886                                (gnus-get-buffer-create
 887                                 (file-name-nondirectory dribble-file)))
 888       (set (make-local-variable 'file-precious-flag) t)
 889       (setq buffer-save-without-query t)
 890       (erase-buffer)
 891       (setq buffer-file-name dribble-file)
 892       ;; The buffer may be shrunk a lot when deleting old entries.
 893       ;; It caused the auto-saving to stop.
 894       (if (featurep 'emacs)
 895           (set (make-local-variable 'auto-save-include-big-deletions) t)
 896         (set (make-local-variable 'disable-auto-save-when-buffer-shrinks) nil))
 897       (auto-save-mode t)
 898       (buffer-disable-undo)
 899       (bury-buffer (current-buffer))
 900       (set-buffer-modified-p nil)
 901       (let ((auto (make-auto-save-file-name))
 902             (gnus-dribble-ignore t)
 903             (purpose nil)
 904             modes)
 905         (when (or (file-exists-p auto) (file-exists-p dribble-file))
 906           ;; Load whichever file is newest -- the auto save file
 907           ;; or the "real" file.
 908           (if (file-newer-than-file-p auto dribble-file)
 909               (nnheader-insert-file-contents auto)
 910             (nnheader-insert-file-contents dribble-file))
 911           (unless (zerop (buffer-size))
 912             (set-buffer-modified-p t))
 913           ;; Set the file modes to reflect the .newsrc file modes.
 914           (save-buffer)
 915           (when (and (file-exists-p gnus-current-startup-file)
 916                      (file-exists-p dribble-file)
 917                      (setq modes (file-modes gnus-current-startup-file)))
 918             (gnus-set-file-modes dribble-file modes))
 919           (goto-char (point-min))
 920           (when (search-forward "Gnus was exited on purpose" nil t)
 921             (setq purpose t))
 922           ;; Possibly eval the file later.
 923           (when (or gnus-always-read-dribble-file
 924                     (gnus-y-or-n-p
 925                      (if purpose
 926                          "Gnus exited on purpose without saving; read auto-save file anyway? "
 927                      "Gnus auto-save file exists.  Do you want to read it? ")))
 928             (setq gnus-dribble-eval-file t)))))))
 929
 930 (defun gnus-dribble-eval-file ()
 931   (when gnus-dribble-eval-file
 932     (setq gnus-dribble-eval-file nil)
 933     (save-excursion
 934       (let ((gnus-dribble-ignore t))
 935         (set-buffer gnus-dribble-buffer)
 936         (eval-buffer (current-buffer))))))
 937
 938 (defun gnus-dribble-delete-file ()
 939   (when (file-exists-p (gnus-dribble-file-name))
 940     (delete-file (gnus-dribble-file-name)))
 941   (when gnus-dribble-buffer
 942     (with-current-buffer gnus-dribble-buffer
 943       (let ((auto (make-auto-save-file-name)))
 944         (when (file-exists-p auto)
 945           (delete-file auto))
 946         (erase-buffer)
 947         (set-buffer-modified-p nil)))))
 948
 949 (defun gnus-dribble-save ()
 950   (when (and gnus-dribble-buffer
 951              (buffer-name gnus-dribble-buffer))
 952     (with-current-buffer gnus-dribble-buffer
 953       (when (> (buffer-size) 0)
 954         (save-buffer)))))
 955
 956 (defun gnus-dribble-clear ()
 957   (when (gnus-buffer-exists-p gnus-dribble-buffer)
 958     (with-current-buffer gnus-dribble-buffer
 959       (erase-buffer)
 960       (set-buffer-modified-p nil)
 961       (setq buffer-saved-size (buffer-size)))))
 962
 963 \f
 964 ;;;
 965 ;;; Active & Newsrc File Handling
 966 ;;;
 967
 968 (defun gnus-setup-news (&optional rawfile level dont-connect)
 969   "Setup news information.
 970 If RAWFILE is non-nil, the .newsrc file will also be read.
 971 If LEVEL is non-nil, the news will be set up at level LEVEL."
 972   (require 'nnmail)
 973   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))
 974         ;; Binding this variable will inhibit multiple fetchings
 975         ;; of the same mail source.
 976         (nnmail-fetched-sources (list t)))
 977
 978     (when init
 979       ;; Clear some variables to re-initialize news information.
 980       (setq gnus-newsrc-alist nil
 981             gnus-active-hashtb nil)
 982       ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
 983       (gnus-read-newsrc-file rawfile))
 984
 985     ;; Make sure the archive server is available to all and sundry.
 986     (let ((method (or (and (stringp gnus-message-archive-method)
 987                            (gnus-server-to-method
 988                             gnus-message-archive-method))
 989                       gnus-message-archive-method)))
 990       ;; Check whether the archive method is writable.
 991       (unless (or (not method)
 992                   (stringp method)
 993                   (memq 'respool (assoc (format "%s" (car method))
 994                                         gnus-valid-select-methods)))
 995         (setq method "archive")) ;; The default.
 996       (when (stringp method)
 997         (setq method `(nnfolder
 998                        ,method
 999                        (nnfolder-directory
1000                         ,(nnheader-concat message-directory method))
1001                        (nnfolder-active-file
1002                         ,(nnheader-concat message-directory
1003                                           (concat method "/active")))
1004                        (nnfolder-get-new-mail nil)
1005                        (nnfolder-inhibit-expiry t))))
1006       (if (assoc "archive" gnus-server-alist)
1007           (when gnus-update-message-archive-method
1008             (if method
1009                 (setcdr (assoc "archive" gnus-server-alist) method)
1010               (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)
1011                                             gnus-server-alist))))
1012         (when method
1013           (push (cons "archive" method) gnus-server-alist))))
1014
1015     ;; If we don't read the complete active file, we fill in the
1016     ;; hashtb here.
1017     (when (or (null gnus-read-active-file)
1018               (eq gnus-read-active-file 'some))
1019       (gnus-update-active-hashtb-from-killed))
1020     (unless gnus-active-hashtb
1021       (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
1022     ;; Initialize the cache.
1023     (when gnus-use-cache
1024       (gnus-cache-open))
1025
1026     ;; Possibly eval the dribble file.
1027     (and init
1028          (or gnus-use-dribble-file gnus-slave)
1029          (gnus-dribble-eval-file))
1030
1031     ;; Slave Gnusii should then clear the dribble buffer.
1032     (when (and init gnus-slave)
1033       (gnus-dribble-clear))
1034
1035     (gnus-update-format-specifications)
1036
1037     ;; See whether we need to read the description file.
1038     (when (and (boundp 'gnus-group-line-format)
1039                (stringp gnus-group-line-format)
1040                (let ((case-fold-search nil))
1041                  (string-match "%[-,0-9]*D" gnus-group-line-format))
1042                (not gnus-description-hashtb)
1043                (not dont-connect)
1044                gnus-read-active-file)
1045       (gnus-read-all-descriptions-files))
1046
1047     ;; Find new newsgroups and treat them.
1048     (when (and init gnus-check-new-newsgroups (not level)
1049                (gnus-check-server gnus-select-method)
1050                (not gnus-slave)
1051                gnus-plugged)
1052       (gnus-find-new-newsgroups))
1053
1054     ;; Check and remove bogus newsgroups.
1055     (when (and init gnus-check-bogus-newsgroups
1056                gnus-read-active-file (not level)
1057                (gnus-server-opened gnus-select-method))
1058       (gnus-check-bogus-newsgroups))
1059
1060     ;; Read any slave files.
1061     (gnus-master-read-slave-newsrc)
1062
1063     ;; Find the number of unread articles in each non-dead group.
1064     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
1065       (gnus-get-unread-articles level dont-connect))))
1066
1067 (defun gnus-call-subscribe-functions (method group)
1068   "Call METHOD to subscribe GROUP.
1069 If no function returns `non-nil', call `gnus-subscribe-zombies'."
1070   (unless (cond
1071            ((functionp method)
1072             (funcall method group))
1073            ((listp method)
1074             (catch 'found
1075               (dolist (func method)
1076                 (if (funcall func group)
1077                     (throw 'found t)))
1078               nil))
1079            (t nil))
1080     (gnus-subscribe-zombies group)))
1081
1082 (defun gnus-find-new-newsgroups (&optional arg)
1083   "Search for new newsgroups and add them.
1084 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'.
1085 The `-n' option line from .newsrc is respected.
1086
1087 With 1 C-u, use the `ask-server' method to query the server for new
1088 groups.
1089 With 2 C-u's, use most complete method possible to query the server
1090 for new groups, and subscribe the new groups as zombies."
1091   (interactive "p")
1092   (let* ((gnus-subscribe-newsgroup-method
1093           gnus-subscribe-newsgroup-method)
1094          (check (cond
1095                  ((or (and (= (or arg 1) 4)
1096                            (not (listp gnus-check-new-newsgroups)))
1097                       (null gnus-read-active-file)
1098                       (eq gnus-read-active-file 'some))
1099                   'ask-server)
1100                  ((= (or arg 1) 16)
1101                   (setq gnus-subscribe-newsgroup-method
1102                         'gnus-subscribe-zombies)
1103                   t)
1104                  (t gnus-check-new-newsgroups))))
1105     (if (or (consp check)
1106             (eq check 'ask-server))
1107         ;; Ask the server for new groups.
1108         (gnus-ask-server-for-new-groups)
1109       ;; Go through the active hashtb and look for new groups.
1110       (let ((groups 0)
1111             group new-newsgroups)
1112         (gnus-message 5 "Looking for new newsgroups...")
1113         (unless gnus-have-read-active-file
1114           (gnus-read-active-file))
1115         (setq gnus-newsrc-last-checked-date (message-make-date))
1116         (unless gnus-killed-hashtb
1117           (gnus-make-hashtable-from-killed))
1118         ;; Go though every newsgroup in `gnus-active-hashtb' and compare
1119         ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
1120         (mapatoms
1121          (lambda (sym)
1122            (if (or (null (setq group (symbol-name sym)))
1123                    (not (boundp sym))
1124                    (null (symbol-value sym))
1125                    (gnus-gethash group gnus-killed-hashtb)
1126                    (gnus-gethash group gnus-newsrc-hashtb))
1127                ()
1128              (let ((do-sub (gnus-matches-options-n group)))
1129                (cond
1130                 ((eq do-sub 'subscribe)
1131                  (setq groups (1+ groups))
1132                  (gnus-sethash group group gnus-killed-hashtb)
1133                  (gnus-call-subscribe-functions
1134                   gnus-subscribe-options-newsgroup-method group))
1135                 ((eq do-sub 'ignore)
1136                  nil)
1137                 (t
1138                  (setq groups (1+ groups))
1139                  (gnus-sethash group group gnus-killed-hashtb)
1140                  (if gnus-subscribe-hierarchical-interactive
1141                      (push group new-newsgroups)
1142                    (gnus-call-subscribe-functions
1143                     gnus-subscribe-newsgroup-method group)))))))
1144          gnus-active-hashtb)
1145         (when new-newsgroups
1146           (gnus-subscribe-hierarchical-interactive new-newsgroups))
1147         (if (> groups 0)
1148             (gnus-message 5 "%d new newsgroup%s arrived."
1149                           groups (if (> groups 1) "s have" " has"))
1150           (gnus-message 5 "No new newsgroups."))
1151         groups))))
1152
1153 (defun gnus-matches-options-n (group)
1154   ;; Returns `subscribe' if the group is to be unconditionally
1155   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
1156   ;; no match for the group.
1157
1158   ;; First we check the two user variables.
1159   (cond
1160    ((and gnus-options-subscribe
1161          (string-match gnus-options-subscribe group))
1162     'subscribe)
1163    ((let ((do-subscribe nil))
1164       (dolist (category gnus-auto-subscribed-categories)
1165         (when (gnus-member-of-valid category group)
1166           (setq do-subscribe t)))
1167       do-subscribe)
1168     'subscribe)
1169    ((and gnus-auto-subscribed-groups
1170          (string-match gnus-auto-subscribed-groups group))
1171     'subscribe)
1172    ((and gnus-options-not-subscribe
1173          (string-match gnus-options-not-subscribe group))
1174     'ignore)
1175    ;; Then we go through the list that was retrieved from the .newsrc
1176    ;; file.  This list has elements on the form
1177    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
1178    ;; is in the reverse order of the options line) is returned.
1179    (t
1180     (let ((regs gnus-newsrc-options-n))
1181       (while (and regs
1182                   (not (string-match (caar regs) group)))
1183         (setq regs (cdr regs)))
1184       (and regs (cdar regs))))))
1185
1186 (defun gnus-ask-server-for-new-groups ()
1187   (let* ((new-date (message-make-date))
1188          (date (or gnus-newsrc-last-checked-date new-date))
1189          (methods (cons gnus-select-method
1190                         (nconc
1191                          (when (gnus-archive-server-wanted-p)
1192                            (list "archive"))
1193                          (append
1194                           (and (consp gnus-check-new-newsgroups)
1195                                gnus-check-new-newsgroups)
1196                           gnus-secondary-select-methods))))
1197          (groups 0)
1198          group new-newsgroups got-new method hashtb
1199          gnus-override-subscribe-method)
1200     (unless gnus-killed-hashtb
1201       (gnus-make-hashtable-from-killed))
1202     ;; Go through both primary and secondary select methods and
1203     ;; request new newsgroups.
1204     (while (setq method (gnus-server-get-method nil (pop methods)))
1205       (setq new-newsgroups nil
1206             gnus-override-subscribe-method method)
1207       (when (and (gnus-check-server method)
1208                  (gnus-request-newgroups date method))
1209         (save-excursion
1210           (setq got-new t
1211                 hashtb (gnus-make-hashtable 100))
1212           (set-buffer nntp-server-buffer)
1213           ;; Enter all the new groups into a hashtable.
1214           (gnus-active-to-gnus-format method hashtb 'ignore))
1215         ;; Now all new groups from `method' are in `hashtb'.
1216         (mapatoms
1217          (lambda (group-sym)
1218            (if (or (null (setq group (symbol-name group-sym)))
1219                    (not (boundp group-sym))
1220                    (null (symbol-value group-sym))
1221                    (gnus-gethash group gnus-newsrc-hashtb)
1222                    (member group gnus-zombie-list)
1223                    (member group gnus-killed-list))
1224                ;; The group is already known.
1225                ()
1226              ;; Make this group active.
1227              (when (symbol-value group-sym)
1228                (gnus-set-active group (symbol-value group-sym)))
1229              ;; Check whether we want it or not.
1230              (let ((do-sub (gnus-matches-options-n group)))
1231                (cond
1232                 ((eq do-sub 'subscribe)
1233                  (incf groups)
1234                  (gnus-sethash group group gnus-killed-hashtb)
1235                  (gnus-call-subscribe-functions
1236                   gnus-subscribe-options-newsgroup-method group))
1237                 ((eq do-sub 'ignore)
1238                  nil)
1239                 (t
1240                  (incf groups)
1241                  (gnus-sethash group group gnus-killed-hashtb)
1242                  (if gnus-subscribe-hierarchical-interactive
1243                      (push group new-newsgroups)
1244                    (gnus-call-subscribe-functions
1245                     gnus-subscribe-newsgroup-method group)))))))
1246          hashtb))
1247       (when new-newsgroups
1248         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
1249     (if (> groups 0)
1250         (gnus-message 5 "%d new newsgroup%s arrived"
1251                       groups (if (> groups 1) "s have" " has"))
1252       (gnus-message 5 "No new newsgroups"))
1253     (when got-new
1254       (setq gnus-newsrc-last-checked-date new-date))
1255     new-newsgroups))
1256
1257 (defun gnus-subscribe-group (group &optional previous method)
1258   "Subscribe GROUP and put it after PREVIOUS."
1259   (gnus-group-change-level
1260    (if method
1261        (list t group gnus-level-default-subscribed nil nil method)
1262      group)
1263    gnus-level-default-subscribed gnus-level-killed previous t)
1264   t)
1265
1266 ;; `gnus-group-change-level' is the fundamental function for changing
1267 ;; subscription levels of newsgroups.  This might mean just changing
1268 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
1269 ;; again, which subscribes/unsubscribes a group, which is equally
1270 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
1271 ;; from 8-9 to 1-7 means that you remove the group from the list of
1272 ;; killed (or zombie) groups and add them to the (kinda) subscribed
1273 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
1274 ;; which is trivial.
1275 ;; ENTRY can either be a string (newsgroup name) or a list (if
1276 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
1277 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
1278 ;; entries.
1279 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
1280 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
1281 ;; after.
1282 (defun gnus-group-change-level (entry level &optional oldlevel
1283                                       previous fromkilled)
1284   (let (group info active num)
1285     ;; Glean what info we can from the arguments
1286     (if (consp entry)
1287         (if fromkilled (setq group (nth 1 entry))
1288           (setq group (car (nth 2 entry))))
1289       (setq group entry))
1290     (when (and (stringp entry)
1291                oldlevel
1292                (< oldlevel gnus-level-zombie))
1293       (setq entry (gnus-group-entry entry)))
1294     (if (and (not oldlevel)
1295              (consp entry))
1296         (setq oldlevel (gnus-info-level (nth 2 entry)))
1297       (setq oldlevel (or oldlevel gnus-level-killed)))
1298     (when (stringp previous)
1299       (setq previous (gnus-group-entry previous)))
1300
1301     (if (and (>= oldlevel gnus-level-zombie)
1302              (gnus-group-entry group))
1303         ;; We are trying to subscribe a group that is already
1304         ;; subscribed.
1305         ()                              ; Do nothing.
1306
1307       (unless (gnus-ephemeral-group-p group)
1308         (gnus-dribble-enter
1309          (format "(gnus-group-change-level %S %S %S %S %S)"
1310                  group level oldlevel (car (nth 2 previous)) fromkilled)))
1311
1312       ;; Then we remove the newgroup from any old structures, if needed.
1313       ;; If the group was killed, we remove it from the killed or zombie
1314       ;; list.  If not, and it is in fact going to be killed, we remove
1315       ;; it from the newsrc hash table and assoc.
1316       (cond
1317        ((>= oldlevel gnus-level-zombie)
1318         ;; oldlevel could be wrong.
1319         (setq gnus-zombie-list (delete group gnus-zombie-list))
1320         (setq gnus-killed-list (delete group gnus-killed-list)))
1321        (t
1322         (when (and (>= level gnus-level-zombie)
1323                    entry)
1324           (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
1325           (when (nth 3 entry)
1326             (setcdr (gnus-group-entry (car (nth 3 entry)))
1327                     (cdr entry)))
1328           (setcdr (cdr entry) (cdddr entry)))))
1329
1330       ;; Finally we enter (if needed) the list where it is supposed to
1331       ;; go, and change the subscription level.  If it is to be killed,
1332       ;; we enter it into the killed or zombie list.
1333       (cond
1334        ((>= level gnus-level-zombie)
1335         ;; Remove from the hash table.
1336         (gnus-sethash group nil gnus-newsrc-hashtb)
1337         (if (= level gnus-level-zombie)
1338             (push group gnus-zombie-list)
1339           (if (= oldlevel gnus-level-killed)
1340               ;; Remove from active hashtb.
1341               (unintern group gnus-active-hashtb)
1342             ;; Don't add it into killed-list if it was killed.
1343             (push group gnus-killed-list))))
1344        (t
1345         ;; If the list is to be entered into the newsrc assoc, and
1346         ;; it was killed, we have to create an entry in the newsrc
1347         ;; hashtb format and fix the pointers in the newsrc assoc.
1348         (if (< oldlevel gnus-level-zombie)
1349             ;; It was alive, and it is going to stay alive, so we
1350             ;; just change the level and don't change any pointers or
1351             ;; hash table entries.
1352             (setcar (cdaddr entry) level)
1353           (if (listp entry)
1354               (setq info (cdr entry)
1355                     num (car entry))
1356             (setq active (gnus-active group))
1357             (setq num
1358                   (if active (- (1+ (cdr active)) (car active)) t))
1359             ;; Shorten the select method if possible, if we need to
1360             ;; store it at all (native groups).
1361             (let ((method (gnus-method-simplify
1362                            (or gnus-override-subscribe-method
1363                                (gnus-group-method group)))))
1364               (if method
1365                   (setq info (list group level nil nil method))
1366                 (setq info (list group level nil)))))
1367           (unless previous
1368             (setq previous
1369                   (let ((p gnus-newsrc-alist))
1370                     (while (cddr p)
1371                       (setq p (cdr p)))
1372                     p)))
1373           (setq entry (cons info (cddr previous)))
1374           (if (cdr previous)
1375               (progn
1376                 (setcdr (cdr previous) entry)
1377                 (gnus-sethash group (cons num (cdr previous))
1378                               gnus-newsrc-hashtb))
1379             (setcdr previous entry)
1380             (gnus-sethash group (cons num previous)
1381                           gnus-newsrc-hashtb))
1382           (when (cdr entry)
1383             (setcdr (gnus-group-entry (caadr entry)) entry))
1384           (gnus-dribble-enter
1385            (format "(gnus-group-set-info '%S)" info)
1386            (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))))
1387       (when gnus-group-change-level-function
1388         (funcall gnus-group-change-level-function
1389                  group level oldlevel previous)))))
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"))))
1442
1443 (defun gnus-check-duplicate-killed-groups ()
1444   "Remove duplicates from the list of killed groups."
1445   (interactive)
1446   (let ((killed gnus-killed-list))
1447     (while killed
1448       (gnus-message 9 "%d" (length killed))
1449       (setcdr killed (delete (car killed) (cdr killed)))
1450       (setq killed (cdr killed)))))
1451
1452 ;; We want to inline a function from gnus-cache, so we cheat here:
1453 (defvar gnus-cache-active-hashtb)
1454 (eval-when-compile
1455   (defun gnus-cache-possibly-alter-active (group active)
1456     "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
1457     (when gnus-cache-active-hashtb
1458       (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
1459         (when cache-active
1460           (when (< (car cache-active) (car active))
1461             (setcar active (car cache-active)))
1462           (when (> (cdr cache-active) (cdr active))
1463             (setcdr active (cdr cache-active))))))))
1464
1465 (defun gnus-activate-group (group &optional scan dont-check method
1466                                   dont-sub-check)
1467   "Check whether a group has been activated or not.
1468 If SCAN, request a scan of that group as well.  If METHOD, use
1469 that select method instead of determining the method based on the
1470 group name.  If DONT-CHECK, don't check whether the group
1471 actually exists.  If DONT-SUB-CHECK or DONT-CHECK, don't let the
1472 backend check whether the group actually exists."
1473   (let ((method (or method (inline (gnus-find-method-for-group group))))
1474         active)
1475     (and (inline (gnus-check-server method))
1476          ;; We escape all bugs and quit here to make it possible to
1477          ;; continue if a group is so out-there that it reports bugs
1478          ;; and stuff.
1479          (progn
1480            (and scan
1481                 (gnus-check-backend-function 'request-scan (car method))
1482                 (gnus-request-scan group method))
1483            t)
1484          (if (or debug-on-error debug-on-quit)
1485              (inline (gnus-request-group group (or dont-sub-check dont-check)
1486                                          method
1487                                          (gnus-get-info group)))
1488            (condition-case nil
1489                (inline (gnus-request-group group (or dont-sub-check dont-check)
1490                                            method
1491                                            (gnus-get-info group)))
1492              (quit
1493               (if debug-on-quit
1494                   (debug "Quit")
1495                 (message "Quit activating %s" group))
1496               nil)))
1497          (unless dont-check
1498            (setq active (gnus-parse-active))
1499            ;; If there are no articles in the group, the GROUP
1500            ;; command may have responded with the `(0 . 0)'.  We
1501            ;; ignore this if we already have an active entry
1502            ;; for the group.
1503            (if (and (zerop (or (car active) 0))
1504                     (zerop (or (cdr active) 0))
1505                     (gnus-active group))
1506                (gnus-active group)
1507
1508              ;; If a cache is present, we may have to alter the active info.
1509              (when gnus-use-cache
1510                (inline (gnus-cache-possibly-alter-active
1511                         group active)))
1512
1513              ;; If the agent is enabled, we may have to alter the active info.
1514              (when gnus-agent
1515                (gnus-agent-possibly-alter-active group active))
1516
1517              (gnus-set-active group active)
1518              ;; Return the new active info.
1519              active)))))
1520
1521 (defun gnus-get-unread-articles-in-group (info active &optional update)
1522   (when (and info active)
1523     ;; Allow the backend to update the info in the group.
1524     (when (and update
1525                (gnus-request-update-info
1526                 info (inline (gnus-find-method-for-group
1527                               (gnus-info-group info)))))
1528       (gnus-activate-group (gnus-info-group info) nil t))
1529
1530     (let* ((range (gnus-info-read info))
1531            (num 0))
1532
1533       ;; These checks are present in gnus-activate-group but skipped
1534       ;; due to setting dont-check in the preceding call.
1535
1536       ;; If a cache is present, we may have to alter the active info.
1537       (when (and gnus-use-cache info)
1538         (inline (gnus-cache-possibly-alter-active
1539                  (gnus-info-group info) active)))
1540
1541       ;; If the agent is enabled, we may have to alter the active info.
1542       (when (and gnus-agent info)
1543         (gnus-agent-possibly-alter-active (gnus-info-group info) active info))
1544
1545       ;; Modify the list of read articles according to what articles
1546       ;; are available; then tally the unread articles and add the
1547       ;; number to the group hash table entry.
1548       (cond
1549        ((zerop (cdr active))
1550         (setq num 0))
1551        ((not range)
1552         (setq num (- (1+ (cdr active)) (car active))))
1553        ((not (listp (cdr range)))
1554         ;; Fix a single (num . num) range according to the
1555         ;; active hash table.
1556         ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
1557         (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
1558         (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
1559         ;; Compute number of unread articles.
1560         (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
1561        (t
1562         ;; The read list is a list of ranges.  Fix them according to
1563         ;; the active hash table.
1564         ;; First peel off any elements that are below the lower
1565         ;; active limit.
1566         (while (and (cdr range)
1567                     (>= (car active)
1568                         (or (and (atom (cadr range)) (cadr range))
1569                             (caadr range))))
1570           (if (numberp (car range))
1571               (setcar range
1572                       (cons (car range)
1573                             (or (and (numberp (cadr range))
1574                                      (cadr range))
1575                                 (cdadr range))))
1576             (setcdr (car range)
1577                     (or (and (numberp (nth 1 range)) (nth 1 range))
1578                         (cdadr range))))
1579           (setcdr range (cddr range)))
1580         ;; Adjust the first element to be the same as the lower limit.
1581         (when (and (not (atom (car range)))
1582                    (< (cdar range) (car active)))
1583           (setcdr (car range) (1- (car active))))
1584         ;; Then we want to peel off any elements that are higher
1585         ;; than the upper active limit.
1586         (let ((srange range))
1587           ;; Go past all valid elements.
1588           (while (and (cdr srange)
1589                       (<= (or (and (atom (cadr srange))
1590                                    (cadr srange))
1591                               (caadr srange))
1592                           (cdr active)))
1593             (setq srange (cdr srange)))
1594           (when (cdr srange)
1595             ;; Nuke all remaining invalid elements.
1596             (setcdr srange nil))
1597
1598           ;; Adjust the final element.
1599           (when (and (not (atom (car srange)))
1600                      (> (cdar srange) (cdr active)))
1601             (setcdr (car srange) (cdr active))))
1602         ;; Compute the number of unread articles.
1603         (while range
1604           (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
1605                                       (cdar range)))
1606                               (or (and (atom (car range)) (car range))
1607                                   (caar range)))))
1608           (setq range (cdr range)))
1609         (setq num (max 0 (- (cdr active) num)))))
1610       ;; Set the number of unread articles.
1611       (when (and info
1612                  (gnus-group-entry (gnus-info-group info)))
1613         (setcar (gnus-group-entry (gnus-info-group info)) num))
1614       num)))
1615
1616 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
1617 ;; and compute how many unread articles there are in each group.
1618 (defun gnus-get-unread-articles (&optional level dont-connect one-level)
1619   (setq gnus-server-method-cache nil)
1620   (require 'gnus-agent)
1621   (let* ((newsrc (cdr gnus-newsrc-alist))
1622          (alevel (or level gnus-activate-level (1+ gnus-level-subscribed)))
1623          (foreign-level
1624           (or
1625            level
1626            (min
1627             (cond ((and gnus-activate-foreign-newsgroups
1628                         (not (numberp gnus-activate-foreign-newsgroups)))
1629                    (1+ gnus-level-subscribed))
1630                   ((numberp gnus-activate-foreign-newsgroups)
1631                    gnus-activate-foreign-newsgroups)
1632                   (t 0))
1633             alevel)))
1634          (methods-cache nil)
1635          (type-cache nil)
1636          (gnus-agent-article-local-times 0)
1637          (archive-method (gnus-server-to-method "archive"))
1638          infos info group active method cmethod
1639          method-type method-group-list entry)
1640     (gnus-message 6 "Checking new news...")
1641
1642     (while newsrc
1643       (setq active (gnus-active (setq group (gnus-info-group
1644                                              (setq info (pop newsrc))))))
1645       ;; First go through all the groups, see what select methods they
1646       ;; belong to, and then collect them into lists per unique select
1647       ;; method.
1648       (if (not (setq method (gnus-info-method info)))
1649           (setq method gnus-select-method)
1650         ;; There may be several similar methods.  Possibly extend the
1651         ;; method.
1652         (if (setq cmethod (assoc method methods-cache))
1653             (setq method (cdr cmethod))
1654           (setq cmethod (if (stringp method)
1655                             (gnus-server-to-method method)
1656                           (inline (gnus-find-method-for-group
1657                                    (gnus-info-group info) info))))
1658           (push (cons method cmethod) methods-cache)
1659           (setq method cmethod)))
1660       (setq method-group-list (assoc method type-cache))
1661       (unless method-group-list
1662         (setq method-type
1663               (cond
1664                ((or (gnus-secondary-method-p method)
1665                     (and (gnus-archive-server-wanted-p)
1666                          (gnus-methods-equal-p archive-method method)))
1667                 'secondary)
1668                ((inline (gnus-server-equal gnus-select-method method))
1669                 'primary)
1670                (t
1671                 'foreign)))
1672         (push (setq method-group-list (list method method-type nil nil))
1673               type-cache))
1674       ;; Only add groups that need updating.
1675       (if (funcall (if one-level #'= #'<=) (gnus-info-level info)
1676               (if (eq (cadr method-group-list) 'foreign)
1677                   foreign-level
1678                 alevel))
1679           (setcar (nthcdr 2 method-group-list)
1680                   (cons info (nth 2 method-group-list)))
1681         ;; The group is inactive, so we nix out the number of unread articles.
1682         ;; It leads `(gnus-group-unread group)' to return t.  See also
1683         ;; `gnus-group-prepare-flat'.
1684         (unless active
1685           (when (setq entry (gnus-group-entry group))
1686             (setcar entry t)))))
1687
1688     ;; Sort the methods based so that the primary and secondary
1689     ;; methods come first.  This is done for legacy reasons to try to
1690     ;; ensure that side-effect behavior doesn't change from previous
1691     ;; Gnus versions.
1692     (setq type-cache
1693           (sort (nreverse type-cache)
1694                 (lambda (c1 c2)
1695                   (< (gnus-method-rank (cadr c1) (car c1))
1696                      (gnus-method-rank (cadr c2) (car c2))))))
1697     ;; Go through the list of servers and possibly extend methods that
1698     ;; aren't equal (and that need extension; i.e., they are async).
1699     (let ((methods nil))
1700       (dolist (elem type-cache)
1701         (destructuring-bind (method method-type infos dummy) elem
1702           (let ((gnus-opened-servers methods))
1703             (when (and (gnus-similar-server-opened method)
1704                        (gnus-check-backend-function
1705                         'retrieve-group-data-early (car method)))
1706               (setq method (gnus-server-extend-method
1707                             (gnus-info-group (car infos))
1708                             method))
1709               (setcar elem method))
1710             (push (list method 'ok) methods)))))
1711
1712     ;; If we have primary/secondary select methods, but no groups from
1713     ;; them, we still want to issue a retrieval request from them.
1714     (unless dont-connect
1715       (dolist (method (cons gnus-select-method
1716                             gnus-secondary-select-methods))
1717         (when (and (not (assoc method type-cache))
1718                    (gnus-check-backend-function 'request-list (car method)))
1719           (with-current-buffer nntp-server-buffer
1720             (gnus-read-active-file-1 method nil)))))
1721
1722     ;; Clear out all the early methods.
1723     (dolist (elem type-cache)
1724       (destructuring-bind (method method-type infos dummy) elem
1725         (when (and method
1726                    infos
1727                    (gnus-check-backend-function
1728                     'retrieve-group-data-early (car method))
1729                    (not (gnus-method-denied-p method)))
1730           (when (ignore-errors (gnus-get-function method 'open-server))
1731             (unless (gnus-server-opened method)
1732               (gnus-open-server method))
1733             (when (gnus-server-opened method)
1734               ;; Just mark this server as "cleared".
1735               (gnus-retrieve-group-data-early method nil))))))
1736
1737     ;; Start early async retrieval of data.
1738     (let ((done-methods nil)
1739           sanity-spec)
1740       (dolist (elem type-cache)
1741         (destructuring-bind (method method-type infos dummy) elem
1742           (setq sanity-spec (list (car method) (cadr method)))
1743           (when (and method infos
1744                      (not (gnus-method-denied-p method)))
1745             ;; If the open-server method doesn't exist, then the method
1746             ;; itself doesn't exist, so we ignore it.
1747             (if (not (ignore-errors (gnus-get-function method 'open-server)))
1748                 (setq type-cache (delq elem type-cache))
1749               (unless (gnus-server-opened method)
1750                 (gnus-open-server method))
1751               (when (and
1752                      ;; This is a sanity check, so that we never
1753                      ;; attempt to start two async requests to the
1754                      ;; same server, because that will fail.  This
1755                      ;; should never happen, since the methods should
1756                      ;; be unique at this point, but apparently it
1757                      ;; does happen in the wild with some setups.
1758                      (not (member sanity-spec done-methods))
1759                      (gnus-server-opened method)
1760                      (gnus-check-backend-function
1761                       'retrieve-group-data-early (car method)))
1762                 (push sanity-spec done-methods)
1763                 (when (gnus-check-backend-function 'request-scan (car method))
1764                   (gnus-request-scan nil method))
1765                 ;; Store the token we get back from -early so that we
1766                 ;; can pass it to -finish later.
1767                 (setcar (nthcdr 3 elem)
1768                         (gnus-retrieve-group-data-early method infos))))))))
1769
1770     ;; Do the rest of the retrieval.
1771     (dolist (elem type-cache)
1772       (destructuring-bind (method method-type infos early-data) elem
1773         (when (and method infos
1774                    (not (gnus-method-denied-p method)))
1775           (let ((updatep (gnus-check-backend-function
1776                           'request-update-info (car method))))
1777             ;; See if any of the groups from this method require updating.
1778             (gnus-read-active-for-groups method infos early-data)
1779             (dolist (info infos)
1780               (inline (gnus-get-unread-articles-in-group
1781                        info (gnus-active (gnus-info-group info))
1782                        updatep)))))))
1783     (gnus-message 6 "Checking new news...done")))
1784
1785<