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

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