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 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 2, or (at your option)
  14 ;; 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; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (require 'gnus)
  31 (require 'gnus-win)
  32 (require 'gnus-int)
  33 (require 'gnus-spec)
  34 (require 'gnus-range)
  35 (require 'gnus-util)
  36 (autoload 'message-make-date "message")
  37 (autoload 'gnus-agent-read-servers-validate "gnus-agent")
  38 (autoload 'gnus-agent-save-local "gnus-agent")
  39 (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
  40
  41 (eval-when-compile
  42   (require 'cl)
  43
  44   (defvar gnus-agent-covered-methods nil)
  45   (defvar gnus-agent-file-loading-local nil)
  46   (defvar gnus-agent-file-loading-cache nil))
  47
  48 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
  49   "Your `.newsrc' file.
  50 `.newsrc-SERVER' will be used instead if that exists."
  51   :group 'gnus-start
  52   :type 'file)
  53
  54 (defcustom gnus-backup-startup-file 'never
  55   "Whether to create backup files.
  56 This variable takes the same values as the `version-control'
  57 variable."
  58   :version "22.1"
  59   :group 'gnus-start
  60   :type '(choice (const :tag "Never" never)
  61                  (const :tag "If existing" nil)
  62                  (other :tag "Always" t)))
  63
  64 (defcustom gnus-save-startup-file-via-temp-buffer t
  65   "Whether to write the startup file contents to a buffer then save
  66 the buffer or write directly to the file.  The buffer is faster
  67 because all of the contents are written at once.  The direct write
  68 uses considerably less memory."
  69   :version "22.1"
  70   :group 'gnus-start
  71   :type '(choice (const :tag "Write via buffer" t)
  72                  (const :tag "Write directly to file" nil)))
  73
  74 (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
  75   "Your Gnus Emacs-Lisp startup file name.
  76 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
  77   :group 'gnus-start
  78   :type 'file)
  79
  80 (defcustom gnus-site-init-file
  81   (condition-case nil
  82       (concat (file-name-directory
  83                (directory-file-name installation-directory))
  84               "site-lisp/gnus-init")
  85     (error nil))
  86   "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
  87 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
  88   :group 'gnus-start
  89   :type '(choice file (const nil)))
  90
  91 (defcustom gnus-default-subscribed-newsgroups nil
  92   "List of newsgroups to subscribe, when a user runs Gnus the first time.
  93 The value should be a list of strings.
  94 If it is t, Gnus will not do anything special the first time it is
  95 started; it'll just use the normal newsgroups subscription methods."
  96   :group 'gnus-start
  97   :type '(choice (repeat string) (const :tag "Nothing special" t)))
  98
  99 (defcustom gnus-use-dribble-file t
 100   "*Non-nil means that Gnus will use a dribble file to store user updates.
 101 If Emacs should crash without saving the .newsrc files, complete
 102 information can be restored from the dribble file."
 103   :group 'gnus-dribble-file
 104   :type 'boolean)
 105
 106 (defcustom gnus-dribble-directory nil
 107   "*The directory where dribble files will be saved.
 108 If this variable is nil, the directory where the .newsrc files are
 109 saved will be used."
 110   :group 'gnus-dribble-file
 111   :type '(choice directory (const nil)))
 112
 113 (defcustom gnus-check-new-newsgroups 'ask-server
 114   "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup.
 115 This normally finds new newsgroups by comparing the active groups the
 116 servers have already reported with those Gnus already knows, either alive
 117 or killed.
 118
 119 When any of the following are true, `gnus-find-new-newsgroups' will instead
 120 ask the servers (primary, secondary, and archive servers) to list new
 121 groups since the last time it checked:
 122   1. This variable is `ask-server'.
 123   2. This variable is a list of select methods (see below).
 124   3. `gnus-read-active-file' is nil or `some'.
 125   4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
 126
 127 Thus, if this variable is `ask-server' or a list of select methods or
 128 `gnus-read-active-file' is nil or `some', then the killed list is no
 129 longer necessary, so you could safely set `gnus-save-killed-list' to nil.
 130
 131 This variable can be a list of select methods which Gnus will query with
 132 the `ask-server' method in addition to the primary, secondary, and archive
 133 servers.
 134
 135 Eg.
 136   (setq gnus-check-new-newsgroups
 137         '((nntp \"some.server\") (nntp \"other.server\")))
 138
 139 If this variable is nil, then you have to tell Gnus explicitly to
 140 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
 141   :group 'gnus-start
 142   :type '(choice (const :tag "no" nil)
 143                  (const :tag "by brute force" t)
 144                  (const :tag "ask servers" ask-server)
 145                  (repeat :menu-tag "ask additional servers"
 146                          :tag "ask additional servers"
 147                          :value ((nntp ""))
 148                          (sexp :format "%v"))))
 149
 150 (defcustom gnus-check-bogus-newsgroups nil
 151   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
 152 If this variable is nil, then you have to tell Gnus explicitly to
 153 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]."
 154   :group 'gnus-start-server
 155   :type 'boolean)
 156
 157 (defcustom gnus-read-active-file 'some
 158   "*Non-nil means that Gnus will read the entire active file at startup.
 159 If this variable is nil, Gnus will only know about the groups in your
 160 `.newsrc' file.
 161
 162 If this variable is `some', Gnus will try to only read the relevant
 163 parts of the active file from the server.  Not all servers support
 164 this, and it might be quite slow with other servers, but this should
 165 generally be faster than both the t and nil value.
 166
 167 If you set this variable to nil or `some', you probably still want to
 168 be told about new newsgroups that arrive.  To do that, set
 169 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
 170 properly with all servers."
 171   :group 'gnus-start-server
 172   :type '(choice (const nil)
 173                  (const some)
 174                  (const t)))
 175
 176 (defconst gnus-level-subscribed 5
 177   "Groups with levels less than or equal to this variable are subscribed.")
 178
 179 (defconst gnus-level-unsubscribed 7
 180   "Groups with levels less than or equal to this variable are unsubscribed.
 181 Groups with levels less than `gnus-level-subscribed', which should be
 182 less than this variable, are subscribed.")
 183
 184 (defconst gnus-level-zombie 8
 185   "Groups with this level are zombie groups.")
 186
 187 (defconst gnus-level-killed 9
 188   "Groups with this level are killed.")
 189
 190 (defcustom gnus-level-default-subscribed 3
 191   "*New subscribed groups will be subscribed at this level."
 192   :group 'gnus-group-levels
 193   :type 'integer)
 194
 195 (defcustom gnus-level-default-unsubscribed 6
 196   "*New unsubscribed groups will be unsubscribed at this level."
 197   :group 'gnus-group-levels
 198   :type 'integer)
 199
 200 (defcustom gnus-activate-level (1+ gnus-level-subscribed)
 201   "*Groups higher than this level won't be activated on startup.
 202 Setting this variable to something low might save lots of time when
 203 you have many groups that you aren't interested in."
 204   :group 'gnus-group-levels
 205   :type 'integer)
 206
 207 (defcustom gnus-activate-foreign-newsgroups 4
 208   "*If nil, Gnus will not check foreign newsgroups at startup.
 209 If it is non-nil, it should be a number between one and nine.  Foreign
 210 newsgroups that have a level lower or equal to this number will be
 211 activated on startup.  For instance, if you want to active all
 212 subscribed newsgroups, but not the rest, you'd set this variable to
 213 `gnus-level-subscribed'.
 214
 215 If you subscribe to lots of newsgroups from different servers, startup
 216 might take a while.  By setting this variable to nil, you'll save time,
 217 but you won't be told how many unread articles there are in the
 218 groups."
 219   :group 'gnus-group-levels
 220   :type '(choice integer
 221                  (const :tag "none" nil)))
 222
 223 (defcustom gnus-read-newsrc-file t
 224   "*Non-nil means that Gnus will read the `.newsrc' file.
 225 Gnus always reads its own startup file, which is called
 226 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 227 be readily understood by other newsreaders.  If you don't plan on
 228 using other newsreaders, set this variable to nil to save some time on
 229 entry."
 230   :version "21.1"
 231   :group 'gnus-newsrc
 232   :type 'boolean)
 233
 234 (defcustom gnus-save-newsrc-file t
 235   "*Non-nil means that Gnus will save the `.newsrc' file.
 236 Gnus always saves its own startup file, which is called
 237 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 238 be readily understood by other newsreaders.  If you don't plan on
 239 using other newsreaders, set this variable to nil to save some time on
 240 exit."
 241   :group 'gnus-newsrc
 242   :type 'boolean)
 243
 244 (defcustom gnus-save-killed-list t
 245   "*If non-nil, save the list of killed groups to the startup file.
 246 If you set this variable to nil, you'll save both time (when starting
 247 and quitting) and space (both memory and disk), but it will also mean
 248 that Gnus has no record of which groups are new and which are old, so
 249 the automatic new newsgroups subscription methods become meaningless.
 250
 251 You should always set `gnus-check-new-newsgroups' to `ask-server' or
 252 nil if you set this variable to nil.
 253
 254 This variable can also be a regexp.  In that case, all groups that do
 255 not match this regexp will be removed before saving the list."
 256   :group 'gnus-newsrc
 257   :type '(radio (sexp :format "Non-nil\n"
 258                       :match (lambda (widget value)
 259                                (and value (not (stringp value))))
 260                       :value t)
 261                 (const nil)
 262                 regexp))
 263
 264 (defcustom gnus-ignored-newsgroups
 265   (mapconcat 'identity
 266              '("^to\\."                 ; not "real" groups
 267                "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
 268                "^[\"][]\"[#'()]"        ; bogus characters
 269                )
 270              "\\|")
 271   "*A regexp to match uninteresting newsgroups in the active file.
 272 Any lines in the active file matching this regular expression are
 273 removed from the newsgroup list before anything else is done to it,
 274 thus making them effectively non-existent."
 275   :group 'gnus-group-new
 276   :type 'regexp)
 277
 278 (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
 279   "*Function(s) called with a group name when new group is detected.
 280 A few pre-made functions are supplied: `gnus-subscribe-randomly'
 281 inserts new groups at the beginning of the list of groups;
 282 `gnus-subscribe-alphabetically' inserts new groups in strict
 283 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
 284 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
 285 for your decision; `gnus-subscribe-killed' kills all new groups;
 286 `gnus-subscribe-zombies' will make all new groups into zombies;
 287 `gnus-subscribe-topics' will enter groups into the topics that
 288 claim them."
 289   :group 'gnus-group-new
 290   :type '(radio (function-item gnus-subscribe-randomly)
 291                 (function-item gnus-subscribe-alphabetically)
 292                 (function-item gnus-subscribe-hierarchically)
 293                 (function-item gnus-subscribe-interactively)
 294                 (function-item gnus-subscribe-killed)
 295                 (function-item gnus-subscribe-zombies)
 296                 (function-item gnus-subscribe-topics)
 297                 function
 298                 (repeat function)))
 299
 300 (defcustom gnus-subscribe-newsgroup-hooks nil
 301   "*Hooks run after you subscribe to a new group.
 302 The hooks will be called with new group's name as argument."
 303   :version "22.1"
 304   :group 'gnus-group-new
 305   :type 'hook)
 306
 307 (defcustom gnus-subscribe-options-newsgroup-method
 308   'gnus-subscribe-alphabetically
 309   "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
 310 If, for instance, you want to subscribe to all newsgroups in the
 311 \"no\" and \"alt\" hierarchies, you'd put the following in your
 312 .newsrc file:
 313
 314 options -n no.all alt.all
 315
 316 Gnus will the subscribe all new newsgroups in these hierarchies with
 317 the subscription method in this variable."
 318   :group 'gnus-group-new
 319   :type '(radio (function-item gnus-subscribe-randomly)
 320                 (function-item gnus-subscribe-alphabetically)
 321                 (function-item gnus-subscribe-hierarchically)
 322                 (function-item gnus-subscribe-interactively)
 323                 (function-item gnus-subscribe-killed)
 324                 (function-item gnus-subscribe-zombies)
 325                 (function-item gnus-subscribe-topics)
 326                 function
 327                 (repeat function)))
 328
 329 (defcustom gnus-subscribe-hierarchical-interactive nil
 330   "*If non-nil, Gnus will offer to subscribe hierarchically.
 331 When a new hierarchy appears, Gnus will ask the user:
 332
 333 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
 334
 335 If the user pressed `d', Gnus will descend the hierarchy, `y' will
 336 subscribe to all newsgroups in the hierarchy and `s' will skip this
 337 hierarchy in its entirety."
 338   :group 'gnus-group-new
 339   :type 'boolean)
 340
 341 (defcustom gnus-auto-subscribed-groups
 342   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
 343   "*All new groups that match this regexp will be subscribed automatically.
 344 Note that this variable only deals with new groups.  It has no effect
 345 whatsoever on old groups.
 346
 347 New groups that match this regexp will not be handled by
 348 `gnus-subscribe-newsgroup-method'.  Instead, they will
 349 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 350   :group 'gnus-group-new
 351   :type 'regexp)
 352
 353 (defcustom gnus-options-subscribe nil
 354   "*All new groups matching this regexp will be subscribed unconditionally.
 355 Note that this variable deals only with new newsgroups.  This variable
 356 does not affect old newsgroups.
 357
 358 New groups that match this regexp will not be handled by
 359 `gnus-subscribe-newsgroup-method'.  Instead, they will
 360 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 361   :group 'gnus-group-new
 362   :type '(choice regexp
 363                  (const :tag "none" nil)))
 364
 365 (defcustom gnus-options-not-subscribe nil
 366   "*All new groups matching this regexp will be ignored.
 367 Note that this variable deals only with new newsgroups.  This variable
 368 does not affect old (already subscribed) newsgroups."
 369   :group 'gnus-group-new
 370   :type '(choice regexp
 371                  (const :tag "none" nil)))
 372
 373 (defcustom gnus-modtime-botch nil
 374   "*Non-nil means .newsrc should be deleted prior to save.
 375 Its use is due to the bogus appearance that .newsrc was modified on
 376 disc."
 377   :group 'gnus-newsrc
 378   :type 'boolean)
 379
 380 (defcustom gnus-check-bogus-groups-hook nil
 381   "A hook run after removing bogus groups."
 382   :group 'gnus-start-server
 383   :type 'hook)
 384
 385 (defcustom gnus-startup-hook nil
 386   "A hook called at startup.
 387 This hook is called after Gnus is connected to the NNTP server."
 388   :group 'gnus-start
 389   :type 'hook)
 390
 391 (defcustom gnus-before-startup-hook nil
 392   "A hook called at before startup.
 393 This hook is called as the first thing when Gnus is started."
 394   :group 'gnus-start
 395   :type 'hook)
 396
 397 (defcustom gnus-started-hook nil
 398   "A hook called as the last thing after startup."
 399   :group 'gnus-start
 400   :type 'hook)
 401
 402 (defcustom gnus-setup-news-hook
 403   '(gnus-fixup-nnimap-unread-after-getting-new-news)
 404   "A hook after reading the .newsrc file, but before generating the buffer."
 405   :group 'gnus-start
 406   :type 'hook)
 407
 408 (defcustom gnus-get-top-new-news-hook nil
 409   "A hook run just before Gnus checks for new news globally."
 410   :version "22.1"
 411   :group 'gnus-group-new
 412   :type 'hook)
 413
 414 (defcustom gnus-get-new-news-hook nil
 415   "A hook run just before Gnus checks for new news."
 416   :group 'gnus-group-new
 417   :type 'hook)
 418
 419 (defcustom gnus-after-getting-new-news-hook
 420   '(gnus-display-time-event-handler
 421     gnus-fixup-nnimap-unread-after-getting-new-news)
 422   "*A hook run after Gnus checks for new news when Gnus is already running."
 423   :group 'gnus-group-new
 424   :type 'hook)
 425
 426 (defcustom gnus-read-newsrc-el-hook nil
 427   "A hook called after reading the newsrc.eld? file."
 428   :group 'gnus-newsrc
 429   :type 'hook)
 430
 431 (defcustom gnus-save-newsrc-hook nil
 432   "A hook called before saving any of the newsrc files."
 433   :group 'gnus-newsrc
 434   :type 'hook)
 435
 436 (defcustom gnus-save-quick-newsrc-hook nil
 437   "A hook called just before saving the quick newsrc file.
 438 Can be used to turn version control on or off."
 439   :group 'gnus-newsrc
 440   :type 'hook)
 441
 442 (defcustom gnus-save-standard-newsrc-hook nil
 443   "A hook called just before saving the standard newsrc file.
 444 Can be used to turn version control on or off."
 445   :group 'gnus-newsrc
 446   :type 'hook)
 447
 448 (defcustom gnus-group-mode-hook nil
 449   "Hook for Gnus group mode."
 450   :group 'gnus-group-various
 451   :options '(gnus-topic-mode)
 452   :type 'hook)
 453
 454 (defcustom gnus-always-read-dribble-file nil
 455   "Unconditionally read the dribble file."
 456   :group 'gnus-newsrc
 457   :type 'boolean)
 458
 459 ;;; Internal variables
 460
 461 (defvar gnus-ding-file-coding-system mm-universal-coding-system
 462   "Coding system for ding file.")
 463
 464 (defvar gnus-newsrc-file-version nil)
 465 (defvar gnus-override-subscribe-method nil)
 466 (defvar gnus-dribble-buffer nil)
 467 (defvar gnus-newsrc-options nil
 468   "Options line in the .newsrc file.")
 469
 470 (defvar gnus-newsrc-options-n nil
 471   "List of regexps representing groups to be subscribed/ignored unconditionally.")
 472
 473 (defvar gnus-newsrc-last-checked-date nil
 474   "Date Gnus last asked server for new newsgroups.")
 475
 476 (defvar gnus-current-startup-file nil
 477   "Startup file for the current host.")
 478
 479 ;; Byte-compiler warning.
 480 (defvar gnus-group-line-format)
 481
 482 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
 483 (defvar gnus-init-inhibit nil)
 484 (defun gnus-read-init-file (&optional inhibit-next)
 485   ;; Don't load .gnus if the -q option was used.
 486   (when init-file-user
 487     (if gnus-init-inhibit
 488         (setq gnus-init-inhibit nil)
 489       (setq gnus-init-inhibit inhibit-next)
 490       (dolist (file (list gnus-site-init-file gnus-init-file))
 491         (when (and file
 492                    (locate-library file))
 493           (if (or debug-on-error debug-on-quit)
 494               (load file nil t)
 495             (condition-case var
 496                 (load file nil t)
 497               (error
 498                (error "Error in %s: %s" file (cadr var))))))))))
 499
 500 ;; For subscribing new newsgroup
 501
 502 (defun gnus-subscribe-hierarchical-interactive (groups)
 503   (let ((groups (sort groups 'string<))
 504         prefixes prefix start ans group starts real-group)
 505     (while groups
 506       (setq prefixes (list "^"))
 507       (while (and groups prefixes)
 508         (while (not (string-match (car prefixes)
 509                                   (gnus-group-real-name (car groups))))
 510           (setq prefixes (cdr prefixes)))
 511         (setq prefix (car prefixes))
 512         (setq start (1- (length prefix)))
 513         (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups))
 514                                start)
 515                  (cdr groups)
 516                  (setq prefix
 517                        (concat "^" (substring
 518                                     (gnus-group-real-name (car groups))
 519                                     0 (match-end 0))))
 520                  (string-match prefix (gnus-group-real-name (cadr groups))))
 521             (progn
 522               (push prefix prefixes)
 523               (message "Descend hierarchy %s? ([y]nsq): "
 524                        (substring prefix 1 (1- (length prefix))))
 525               (while (not (memq (setq ans (read-char-exclusive))
 526                                 '(?y ?\n ?\r ?n ?s ?q)))
 527                 (ding)
 528                 (message "Descend hierarchy %s? ([y]nsq): "
 529                          (substring prefix 1 (1- (length prefix)))))
 530               (cond ((= ans ?n)
 531                      (while (and groups
 532                                  (setq group (car groups)
 533                                        real-group (gnus-group-real-name group))
 534                                  (string-match prefix real-group))
 535                        (push group gnus-killed-list)
 536                        (gnus-sethash group group gnus-killed-hashtb)
 537                        (setq groups (cdr groups)))
 538                      (setq starts (cdr starts)))
 539                     ((= ans ?s)
 540                      (while (and groups
 541                                  (setq group (car groups)
 542                                        real-group (gnus-group-real-name group))
 543                                  (string-match prefix real-group))
 544                        (gnus-sethash group group gnus-killed-hashtb)
 545                        (gnus-subscribe-alphabetically (car groups))
 546                        (setq groups (cdr groups)))
 547                      (setq starts (cdr starts)))
 548                     ((= ans ?q)
 549                      (while groups
 550                        (setq group (car groups))
 551                        (push group gnus-killed-list)
 552                        (gnus-sethash group group gnus-killed-hashtb)
 553                        (setq groups (cdr groups))))
 554                     (t nil)))
 555           (message "Subscribe %s? ([n]yq)" (car groups))
 556           (while (not (memq (setq ans (read-char-exclusive))
 557                             '(?y ?\n ?\r ?q ?n)))
 558             (ding)
 559             (message "Subscribe %s? ([n]yq)" (car groups)))
 560           (setq group (car groups))
 561           (cond ((= ans ?y)
 562                  (gnus-subscribe-alphabetically (car groups))
 563                  (gnus-sethash group group gnus-killed-hashtb))
 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
 571                  (push group gnus-killed-list)
 572                  (gnus-sethash group group gnus-killed-hashtb)))
 573           (setq groups (cdr groups)))))))
 574
 575 (defun gnus-subscribe-randomly (newsgroup)
 576   "Subscribe new NEWSGROUP by making it the first newsgroup."
 577   (gnus-subscribe-newsgroup newsgroup))
 578
 579 (defun gnus-subscribe-alphabetically (newgroup)
 580   "Subscribe new NEWGROUP and insert it in alphabetical order."
 581   (let ((groups (cdr gnus-newsrc-alist))
 582         before)
 583     (while (and (not before) groups)
 584       (if (string< newgroup (caar groups))
 585           (setq before (caar groups))
 586         (setq groups (cdr groups))))
 587     (gnus-subscribe-newsgroup newgroup before)))
 588
 589 (defun gnus-subscribe-hierarchically (newgroup)
 590   "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
 591   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
 592   (save-excursion
 593     (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
 594     (prog1
 595         (let ((groupkey newgroup) before)
 596           (while (and (not before) groupkey)
 597             (goto-char (point-min))
 598             (let ((groupkey-re
 599                    (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
 600               (while (and (re-search-forward groupkey-re nil t)
 601                           (progn
 602                             (setq before (match-string 1))
 603                             (string< before newgroup)))))
 604             ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
 605             (setq groupkey
 606                   (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
 607                     (substring groupkey (match-beginning 1) (match-end 1)))))
 608           (gnus-subscribe-newsgroup newgroup before))
 609       (kill-buffer (current-buffer)))))
 610
 611 (defun gnus-subscribe-interactively (group)
 612   "Subscribe the new GROUP interactively.
 613 It is inserted in hierarchical newsgroup order if subscribed.  If not,
 614 it is killed."
 615   (if (gnus-y-or-n-p (format "Subscribe new newsgroup %s? " group))
 616       (gnus-subscribe-hierarchically group)
 617     (push group gnus-killed-list)))
 618
 619 (defun gnus-subscribe-zombies (group)
 620   "Make the new GROUP into a zombie group."
 621   (push group gnus-zombie-list))
 622
 623 (defun gnus-subscribe-killed (group)
 624   "Make the new GROUP a killed group."
 625   (push group gnus-killed-list))
 626
 627 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
 628   "Subscribe new NEWSGROUP.
 629 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
 630 the first newsgroup."
 631   (save-excursion
 632     (goto-char (point-min))
 633     ;; We subscribe the group by changing its level to `subscribed'.
 634     (gnus-group-change-level
 635      newsgroup gnus-level-default-subscribed
 636      gnus-level-killed (gnus-group-entry (or next "dummy.group")))
 637     (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
 638     (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
 639     t))
 640
 641 (defun gnus-read-active-file-p ()
 642   "Say whether the active file has been read from `gnus-select-method'."
 643   (memq gnus-select-method gnus-have-read-active-file))
 644
 645 ;;; General various misc type functions.
 646
 647 ;; Silence byte-compiler.
 648 (eval-when-compile
 649   (defvar gnus-current-headers)
 650   (defvar gnus-thread-indent-array)
 651   (defvar gnus-newsgroup-name)
 652   (defvar gnus-newsgroup-headers)
 653   (defvar gnus-group-list-mode)
 654   (defvar gnus-group-mark-positions)
 655   (defvar gnus-newsgroup-data)
 656   (defvar gnus-newsgroup-unreads)
 657   (defvar nnoo-state-alist)
 658   (defvar gnus-current-select-method)
 659   (defvar mail-sources)
 660   (defvar nnmail-scan-directory-mail-source-once)
 661   (defvar nnmail-split-history)
 662   (defvar nnmail-spool-file))
 663
 664 (defun gnus-close-all-servers ()
 665   "Close all servers."
 666   (interactive)
 667   (dolist (server gnus-opened-servers)
 668     (gnus-close-server (car server))))
 669
 670 (defun gnus-clear-system ()
 671   "Clear all variables and buffers."
 672   ;; Clear Gnus variables.
 673   (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
 674     (while variables
 675       (set (car variables) nil)
 676       (setq variables (cdr variables))))
 677   ;; Clear other internal variables.
 678   (setq gnus-list-of-killed-groups nil
 679         gnus-have-read-active-file nil
 680         gnus-agent-covered-methods nil
 681         gnus-agent-file-loading-local nil
 682         gnus-agent-file-loading-cache nil
 683         gnus-server-method-cache nil
 684         gnus-newsrc-alist nil
 685         gnus-newsrc-hashtb nil
 686         gnus-killed-list nil
 687         gnus-zombie-list nil
 688         gnus-killed-hashtb nil
 689         gnus-active-hashtb nil
 690         gnus-moderated-hashtb nil
 691         gnus-description-hashtb nil
 692         gnus-current-headers nil
 693         gnus-thread-indent-array nil
 694         gnus-newsgroup-headers nil
 695         gnus-newsgroup-name nil
 696         gnus-server-alist nil
 697         gnus-group-list-mode nil
 698         gnus-opened-servers nil
 699         gnus-group-mark-positions nil
 700         gnus-newsgroup-data nil
 701         gnus-newsgroup-unreads nil
 702         nnoo-state-alist nil
 703         gnus-current-select-method nil
 704         nnmail-split-history nil
 705         gnus-ephemeral-servers nil)
 706   (gnus-shutdown 'gnus)
 707   ;; Kill the startup file.
 708   (and gnus-current-startup-file
 709        (get-file-buffer gnus-current-startup-file)
 710        (kill-buffer (get-file-buffer gnus-current-startup-file)))
 711   ;; Clear the dribble buffer.
 712   (gnus-dribble-clear)
 713   ;; Kill global KILL file buffer.
 714   (when (get-file-buffer (gnus-newsgroup-kill-file nil))
 715     (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
 716   (gnus-kill-buffer nntp-server-buffer)
 717   ;; Kill Gnus buffers.
 718   (dolist (buffer (gnus-buffers))
 719     (gnus-kill-buffer buffer))
 720   ;; Remove Gnus frames.
 721   (gnus-kill-gnus-frames))
 722
 723 (defun gnus-no-server-1 (&optional arg slave)
 724   "Read network news.
 725 If ARG is a positive number, Gnus will use that as the startup
 726 level.  If ARG is nil, Gnus will be started at level 2
 727 \(`gnus-level-default-subscribed' minus one).  If ARG is non-nil
 728 and not a positive number, Gnus will prompt the user for the name
 729 of an NNTP server to use.  As opposed to \\[gnus], this command
 730 will not connect to the local server."
 731   (interactive "P")
 732   (let ((val (or arg (1- gnus-level-default-subscribed))))
 733     (gnus val t slave)
 734     (make-local-variable 'gnus-group-use-permanent-levels)
 735     (setq gnus-group-use-permanent-levels val)))
 736
 737 (defun gnus-1 (&optional arg dont-connect slave)
 738   "Read network news.
 739 If ARG is non-nil and a positive number, Gnus will use that as the
 740 startup level.  If ARG is non-nil and not a positive number, Gnus will
 741 prompt the user for the name of an NNTP server to use."
 742   (interactive "P")
 743
 744   (if (gnus-alive-p)
 745       (progn
 746         (switch-to-buffer gnus-group-buffer)
 747         (gnus-group-get-new-news
 748          (and (numberp arg)
 749               (> arg 0)
 750               (max (car gnus-group-list-mode) arg))))
 751
 752     (gnus-clear-system)
 753     (gnus-splash)
 754     (gnus-run-hooks 'gnus-before-startup-hook)
 755     (nnheader-init-server-buffer)
 756     (setq gnus-slave slave)
 757     (gnus-read-init-file)
 758
 759     ;; Add "native" to gnus-predefined-server-alist just to have a
 760     ;; name for the native select method.
 761     (when gnus-select-method
 762       (push (cons "native" gnus-select-method)
 763             gnus-predefined-server-alist))
 764
 765     (if gnus-agent
 766         (gnus-agentize))
 767
 768     (when gnus-simple-splash
 769       (setq gnus-simple-splash nil)
 770       (cond
 771        ((featurep 'xemacs)
 772         (gnus-xmas-splash))
 773        ((and window-system
 774              (= (frame-height) (1+ (window-height))))
 775         (gnus-x-splash))))
 776
 777     (let ((level (and (numberp arg) (> arg 0) arg))
 778           did-connect)
 779       (unwind-protect
 780           (progn
 781             (unless dont-connect
 782               (setq did-connect
 783                     (gnus-start-news-server (and arg (not level))))))
 784         (if (and (not dont-connect)
 785                  (not did-connect))
 786             (gnus-group-quit)
 787           (gnus-run-hooks 'gnus-startup-hook)
 788           ;; NNTP server is successfully open.
 789
 790           ;; Find the current startup file name.
 791           (setq gnus-current-startup-file
 792                 (gnus-make-newsrc-file gnus-startup-file))
 793
 794           ;; Read the dribble file.
 795           (when (or gnus-slave gnus-use-dribble-file)
 796             (gnus-dribble-read-file))
 797
 798           ;; Do the actual startup.
 799           (if gnus-agent
 800               (gnus-request-create-group "queue" '(nndraft "")))
 801           (gnus-request-create-group "drafts" '(nndraft ""))
 802           (gnus-setup-news nil level dont-connect)
 803           (gnus-run-hooks 'gnus-setup-news-hook)
 804           (gnus-start-draft-setup)
 805           ;; Generate the group buffer.
 806           (gnus-group-list-groups level)
 807           (gnus-group-first-unread-group)
 808           (gnus-configure-windows 'group)
 809           (gnus-group-set-mode-line)
 810           (gnus-run-hooks 'gnus-started-hook))))))
 811
 812 (defun gnus-start-draft-setup ()
 813   "Make sure the draft group exists."
 814   (gnus-request-create-group "drafts" '(nndraft ""))
 815   (unless (gnus-group-entry "nndraft:drafts")
 816     (let ((gnus-level-default-subscribed 1))
 817       (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))))
 818   (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t)
 819                  '((gnus-draft-mode)))
 820     (gnus-message 3 "Setting up drafts group")
 821     (gnus-group-set-parameter
 822      "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
 823
 824 \f
 825 ;;;
 826 ;;; Dribble file
 827 ;;;
 828
 829 (defvar gnus-dribble-ignore nil)
 830 (defvar gnus-dribble-eval-file nil)
 831
 832 (defun gnus-dribble-file-name ()
 833   "Return the dribble file for the current .newsrc."
 834   (concat
 835    (if gnus-dribble-directory
 836        (concat (file-name-as-directory gnus-dribble-directory)
 837                (file-name-nondirectory gnus-current-startup-file))
 838      gnus-current-startup-file)
 839    "-dribble"))
 840
 841 (defun gnus-dribble-enter (string)
 842   "Enter STRING into the dribble buffer."
 843   (when (and (not gnus-dribble-ignore)
 844              gnus-dribble-buffer
 845              (buffer-name gnus-dribble-buffer))
 846     (let ((obuf (current-buffer)))
 847       (set-buffer gnus-dribble-buffer)
 848       (goto-char (point-max))
 849       (insert string "\n")
 850       ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
 851       ;; It causes problems with both XEmacs and Emacs 21, and doesn't
 852       ;; seem to be of much value. (FIXME: remove this after we make sure
 853       ;; it's not needed).
 854       ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
 855       (bury-buffer gnus-dribble-buffer)
 856       (save-excursion
 857         (set-buffer gnus-group-buffer)
 858         (gnus-group-set-mode-line))
 859       (set-buffer obuf))))
 860
 861 (defun gnus-dribble-touch ()
 862   "Touch the dribble buffer."
 863   (gnus-dribble-enter ""))
 864
 865 (defun gnus-dribble-read-file ()
 866   "Read the dribble file from disk."
 867   (let ((dribble-file (gnus-dribble-file-name)))
 868     (save-excursion
 869       (set-buffer (setq gnus-dribble-buffer
 870                         (gnus-get-buffer-create
 871                          (file-name-nondirectory dribble-file))))
 872       (set (make-local-variable 'file-precious-flag) t)
 873       (erase-buffer)
 874       (setq buffer-file-name dribble-file)
 875       (auto-save-mode t)
 876       (buffer-disable-undo)
 877       (bury-buffer (current-buffer))
 878       (set-buffer-modified-p nil)
 879       (let ((auto (make-auto-save-file-name))
 880             (gnus-dribble-ignore t)
 881             (purpose nil)
 882             modes)
 883         (when (or (file-exists-p auto) (file-exists-p dribble-file))
 884           ;; Load whichever file is newest -- the auto save file
 885           ;; or the "real" file.
 886           (if (file-newer-than-file-p auto dribble-file)
 887               (nnheader-insert-file-contents auto)
 888             (nnheader-insert-file-contents dribble-file))
 889           (unless (zerop (buffer-size))
 890             (set-buffer-modified-p t))
 891           ;; Set the file modes to reflect the .newsrc file modes.
 892           (save-buffer)
 893           (when (and (file-exists-p gnus-current-startup-file)
 894                      (file-exists-p dribble-file)
 895                      (setq modes (file-modes gnus-current-startup-file)))
 896             (gnus-set-file-modes dribble-file modes))
 897           (goto-char (point-min))
 898           (when (search-forward "Gnus was exited on purpose" nil t)
 899             (setq purpose t))
 900           ;; Possibly eval the file later.
 901           (when (or gnus-always-read-dribble-file
 902                     (gnus-y-or-n-p
 903                      (if purpose
 904                          "Gnus exited on purpose without saving; read auto-save file anyway? "
 905                      "Gnus auto-save file exists.  Do you want to read it? ")))
 906             (setq gnus-dribble-eval-file t)))))))
 907
 908 (defun gnus-dribble-eval-file ()
 909   (when gnus-dribble-eval-file
 910     (setq gnus-dribble-eval-file nil)
 911     (save-excursion
 912       (let ((gnus-dribble-ignore t))
 913         (set-buffer gnus-dribble-buffer)
 914         (eval-buffer (current-buffer))))))
 915
 916 (defun gnus-dribble-delete-file ()
 917   (when (file-exists-p (gnus-dribble-file-name))
 918     (delete-file (gnus-dribble-file-name)))
 919   (when gnus-dribble-buffer
 920     (save-excursion
 921       (set-buffer gnus-dribble-buffer)
 922       (let ((auto (make-auto-save-file-name)))
 923         (when (file-exists-p auto)
 924           (delete-file auto))
 925         (erase-buffer)
 926         (set-buffer-modified-p nil)))))
 927
 928 (defun gnus-dribble-save ()
 929   (when (and gnus-dribble-buffer
 930              (buffer-name gnus-dribble-buffer))
 931     (save-excursion
 932       (set-buffer gnus-dribble-buffer)
 933       (save-buffer))))
 934
 935 (defun gnus-dribble-clear ()
 936   (when (gnus-buffer-exists-p gnus-dribble-buffer)
 937     (save-excursion
 938       (set-buffer gnus-dribble-buffer)
 939       (erase-buffer)
 940       (set-buffer-modified-p nil)
 941       (setq buffer-saved-size (buffer-size)))))
 942
 943 \f
 944 ;;;
 945 ;;; Active & Newsrc File Handling
 946 ;;;
 947
 948 (defun gnus-setup-news (&optional rawfile level dont-connect)
 949   "Setup news information.
 950 If RAWFILE is non-nil, the .newsrc file will also be read.
 951 If LEVEL is non-nil, the news will be set up at level LEVEL."
 952   (require 'nnmail)
 953   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))
 954         ;; Binding this variable will inhibit multiple fetchings
 955         ;; of the same mail source.
 956         (nnmail-fetched-sources (list t)))
 957
 958     (when init
 959       ;; Clear some variables to re-initialize news information.
 960       (setq gnus-newsrc-alist nil
 961             gnus-active-hashtb nil)
 962       ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
 963       (gnus-read-newsrc-file rawfile))
 964
 965     ;; Make sure the archive server is available to all and sundry.
 966     (when gnus-message-archive-method
 967       (unless (assoc "archive" gnus-server-alist)
 968         (let ((method (or (and (stringp gnus-message-archive-method)
 969                                (gnus-server-to-method
 970                                 gnus-message-archive-method))
 971                           gnus-message-archive-method)))
 972           ;; Check whether the archive method is writable.
 973           (unless (or (stringp method)
 974                       (memq 'respool (assoc (format "%s" (car method))
 975                                             gnus-valid-select-methods)))
 976             (setq method "archive")) ;; The default.
 977           (push (if (stringp method)
 978                     `("archive"
 979                       nnfolder
 980                       ,method
 981                       (nnfolder-directory
 982                        ,(nnheader-concat message-directory method))
 983                       (nnfolder-active-file
 984                        ,(nnheader-concat message-directory
 985                                          (concat method "/active")))
 986                       (nnfolder-get-new-mail nil)
 987                       (nnfolder-inhibit-expiry t))
 988                   (cons "archive" method))
 989                 gnus-server-alist))))
 990
 991     ;; If we don't read the complete active file, we fill in the
 992     ;; hashtb here.
 993     (when (or (null gnus-read-active-file)
 994               (eq gnus-read-active-file 'some))
 995       (gnus-update-active-hashtb-from-killed))
 996