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

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