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
   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-init-file (nnheader-concat gnus-home-directory ".gnus")
  45   "Your Gnus Emacs-Lisp startup file name.
  46 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
  47   :group 'gnus-start
  48   :type 'file)
  49
  50 (defcustom gnus-site-init-file
  51   (condition-case nil
  52       (concat (file-name-directory
  53                (directory-file-name installation-directory))
  54               "site-lisp/gnus-init")
  55     (error nil))
  56   "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
  57 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
  58   :group 'gnus-start
  59   :type '(choice file (const nil)))
  60
  61 (defcustom gnus-default-subscribed-newsgroups nil
  62   "List of newsgroups to subscribe, when a user runs Gnus the first time.
  63 The value should be a list of strings.
  64 If it is t, Gnus will not do anything special the first time it is
  65 started; it'll just use the normal newsgroups subscription methods."
  66   :group 'gnus-start
  67   :type '(choice (repeat string) (const :tag "Nothing special" t)))
  68
  69 (defcustom gnus-use-dribble-file t
  70   "*Non-nil means that Gnus will use a dribble file to store user updates.
  71 If Emacs should crash without saving the .newsrc files, complete
  72 information can be restored from the dribble file."
  73   :group 'gnus-dribble-file
  74   :type 'boolean)
  75
  76 (defcustom gnus-dribble-directory nil
  77   "*The directory where dribble files will be saved.
  78 If this variable is nil, the directory where the .newsrc files are
  79 saved will be used."
  80   :group 'gnus-dribble-file
  81   :type '(choice directory (const nil)))
  82
  83 (defcustom gnus-check-new-newsgroups 'ask-server
  84   "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup.
  85 This normally finds new newsgroups by comparing the active groups the
  86 servers have already reported with those Gnus already knows, either alive
  87 or killed.
  88
  89 When any of the following are true, `gnus-find-new-newsgroups' will instead
  90 ask the servers (primary, secondary, and archive servers) to list new
  91 groups since the last time it checked:
  92   1. This variable is `ask-server'.
  93   2. This variable is a list of select methods (see below).
  94   3. `gnus-read-active-file' is nil or `some'.
  95   4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
  96
  97 Thus, if this variable is `ask-server' or a list of select methods or
  98 `gnus-read-active-file' is nil or `some', then the killed list is no
  99 longer necessary, so you could safely set `gnus-save-killed-list' to nil.
 100
 101 This variable can be a list of select methods which Gnus will query with
 102 the `ask-server' method in addition to the primary, secondary, and archive
 103 servers.
 104
 105 Eg.
 106   (setq gnus-check-new-newsgroups
 107         '((nntp \"some.server\") (nntp \"other.server\")))
 108
 109 If this variable is nil, then you have to tell Gnus explicitly to
 110 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
 111   :group 'gnus-start
 112   :type '(choice (const :tag "no" nil)
 113                  (const :tag "by brute force" t)
 114                  (const :tag "ask servers" ask-server)
 115                  (repeat :menu-tag "ask additional servers"
 116                          :tag "ask additional servers"
 117                          :value ((nntp ""))
 118                          (sexp :format "%v"))))
 119
 120 (defcustom gnus-check-bogus-newsgroups nil
 121   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
 122 If this variable is nil, then you have to tell Gnus explicitly to
 123 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]."
 124   :group 'gnus-start-server
 125   :type 'boolean)
 126
 127 (defcustom gnus-read-active-file 'some
 128   "*Non-nil means that Gnus will read the entire active file at startup.
 129 If this variable is nil, Gnus will only know about the groups in your
 130 `.newsrc' file.
 131
 132 If this variable is `some', Gnus will try to only read the relevant
 133 parts of the active file from the server.  Not all servers support
 134 this, and it might be quite slow with other servers, but this should
 135 generally be faster than both the t and nil value.
 136
 137 If you set this variable to nil or `some', you probably still want to
 138 be told about new newsgroups that arrive.  To do that, set
 139 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
 140 properly with all servers."
 141   :group 'gnus-start-server
 142   :type '(choice (const nil)
 143                  (const some)
 144                  (const t)))
 145
 146 (defconst gnus-level-subscribed 5
 147   "Groups with levels less than or equal to this variable are subscribed.")
 148
 149 (defconst gnus-level-unsubscribed 7
 150   "Groups with levels less than or equal to this variable are unsubscribed.
 151 Groups with levels less than `gnus-level-subscribed', which should be
 152 less than this variable, are subscribed.")
 153
 154 (defconst gnus-level-zombie 8
 155   "Groups with this level are zombie groups.")
 156
 157 (defconst gnus-level-killed 9
 158   "Groups with this level are killed.")
 159
 160 (defcustom gnus-level-default-subscribed 3
 161   "*New subscribed groups will be subscribed at this level."
 162   :group 'gnus-group-levels
 163   :type 'integer)
 164
 165 (defcustom gnus-level-default-unsubscribed 6
 166   "*New unsubscribed groups will be unsubscribed at this level."
 167   :group 'gnus-group-levels
 168   :type 'integer)
 169
 170 (defcustom gnus-activate-level (1+ gnus-level-subscribed)
 171   "*Groups higher than this level won't be activated on startup.
 172 Setting this variable to something low might save lots of time when
 173 you have many groups that you aren't interested in."
 174   :group 'gnus-group-levels
 175   :type 'integer)
 176
 177 (defcustom gnus-activate-foreign-newsgroups 4
 178   "*If nil, Gnus will not check foreign newsgroups at startup.
 179 If it is non-nil, it should be a number between one and nine.  Foreign
 180 newsgroups that have a level lower or equal to this number will be
 181 activated on startup.  For instance, if you want to active all
 182 subscribed newsgroups, but not the rest, you'd set this variable to
 183 `gnus-level-subscribed'.
 184
 185 If you subscribe to lots of newsgroups from different servers, startup
 186 might take a while.  By setting this variable to nil, you'll save time,
 187 but you won't be told how many unread articles there are in the
 188 groups."
 189   :group 'gnus-group-levels
 190   :type '(choice integer
 191                  (const :tag "none" nil)))
 192
 193 (defcustom gnus-read-newsrc-file t
 194   "*Non-nil means that Gnus will read the `.newsrc' file.
 195 Gnus always reads its own startup file, which is called
 196 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 197 be readily understood by other newsreaders.  If you don't plan on
 198 using other newsreaders, set this variable to nil to save some time on
 199 entry."
 200   :version "21.1"
 201   :group 'gnus-newsrc
 202   :type 'boolean)
 203
 204 (defcustom gnus-save-newsrc-file t
 205   "*Non-nil means that Gnus will save the `.newsrc' file.
 206 Gnus always saves its own startup file, which is called
 207 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
 208 be readily understood by other newsreaders.  If you don't plan on
 209 using other newsreaders, set this variable to nil to save some time on
 210 exit."
 211   :group 'gnus-newsrc
 212   :type 'boolean)
 213
 214 (defcustom gnus-save-killed-list t
 215   "*If non-nil, save the list of killed groups to the startup file.
 216 If you set this variable to nil, you'll save both time (when starting
 217 and quitting) and space (both memory and disk), but it will also mean
 218 that Gnus has no record of which groups are new and which are old, so
 219 the automatic new newsgroups subscription methods become meaningless.
 220
 221 You should always set `gnus-check-new-newsgroups' to `ask-server' or
 222 nil if you set this variable to nil.
 223
 224 This variable can also be a regexp.  In that case, all groups that do
 225 not match this regexp will be removed before saving the list."
 226   :group 'gnus-newsrc
 227   :type 'boolean)
 228
 229 (defcustom gnus-ignored-newsgroups
 230   (mapconcat 'identity
 231              '("^to\\."                 ; not "real" groups
 232                "^[0-9. \t]+ "           ; all digits in name
 233                "^[\"][]\"[#'()]"        ; bogus characters
 234                )
 235              "\\|")
 236   "*A regexp to match uninteresting newsgroups in the active file.
 237 Any lines in the active file matching this regular expression are
 238 removed from the newsgroup list before anything else is done to it,
 239 thus making them effectively non-existent."
 240   :group 'gnus-group-new
 241   :type 'regexp)
 242
 243 (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
 244   "*Function(s) called with a group name when new group is detected.
 245 A few pre-made functions are supplied: `gnus-subscribe-randomly'
 246 inserts new groups at the beginning of the list of groups;
 247 `gnus-subscribe-alphabetically' inserts new groups in strict
 248 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
 249 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
 250 for your decision; `gnus-subscribe-killed' kills all new groups;
 251 `gnus-subscribe-zombies' will make all new groups into zombies;
 252 `gnus-subscribe-topics' will enter groups into the topics that
 253 claim them."
 254   :group 'gnus-group-new
 255   :type '(radio (function-item gnus-subscribe-randomly)
 256                 (function-item gnus-subscribe-alphabetically)
 257                 (function-item gnus-subscribe-hierarchically)
 258                 (function-item gnus-subscribe-interactively)
 259                 (function-item gnus-subscribe-killed)
 260                 (function-item gnus-subscribe-zombies)
 261                 (function-item gnus-subscribe-topics)
 262                 function
 263                 (repeat function)))
 264
 265 (defcustom gnus-subscribe-options-newsgroup-method
 266   'gnus-subscribe-alphabetically
 267   "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
 268 If, for instance, you want to subscribe to all newsgroups in the
 269 \"no\" and \"alt\" hierarchies, you'd put the following in your
 270 .newsrc file:
 271
 272 options -n no.all alt.all
 273
 274 Gnus will the subscribe all new newsgroups in these hierarchies with
 275 the subscription method in this variable."
 276   :group 'gnus-group-new
 277   :type '(radio (function-item gnus-subscribe-randomly)
 278                 (function-item gnus-subscribe-alphabetically)
 279                 (function-item gnus-subscribe-hierarchically)
 280                 (function-item gnus-subscribe-interactively)
 281                 (function-item gnus-subscribe-killed)
 282                 (function-item gnus-subscribe-zombies)
 283                 (function-item gnus-subscribe-topics)
 284                 function
 285                 (repeat function)))
 286
 287 (defcustom gnus-subscribe-hierarchical-interactive nil
 288   "*If non-nil, Gnus will offer to subscribe hierarchically.
 289 When a new hierarchy appears, Gnus will ask the user:
 290
 291 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
 292
 293 If the user pressed `d', Gnus will descend the hierarchy, `y' will
 294 subscribe to all newsgroups in the hierarchy and `s' will skip this
 295 hierarchy in its entirety."
 296   :group 'gnus-group-new
 297   :type 'boolean)
 298
 299 (defcustom gnus-auto-subscribed-groups
 300   "nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
 301   "*All new groups that match this regexp will be subscribed automatically.
 302 Note that this variable only deals with new groups.  It has no effect
 303 whatsoever on old groups.
 304
 305 New groups that match this regexp will not be handled by
 306 `gnus-subscribe-newsgroup-method'.  Instead, they will
 307 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 308   :group 'gnus-group-new
 309   :type 'regexp)
 310
 311 (defcustom gnus-options-subscribe nil
 312   "*All new groups matching this regexp will be subscribed unconditionally.
 313 Note that this variable deals only with new newsgroups.  This variable
 314 does not affect old newsgroups.
 315
 316 New groups that match this regexp will not be handled by
 317 `gnus-subscribe-newsgroup-method'.  Instead, they will
 318 be subscribed using `gnus-subscribe-options-newsgroup-method'."
 319   :group 'gnus-group-new
 320   :type '(choice regexp
 321                  (const :tag "none" nil)))
 322
 323 (defcustom gnus-options-not-subscribe nil
 324   "*All new groups matching this regexp will be ignored.
 325 Note that this variable deals only with new newsgroups.  This variable
 326 does not affect old (already subscribed) newsgroups."
 327   :group 'gnus-group-new
 328   :type '(choice regexp
 329                  (const :tag "none" nil)))
 330
 331 (defcustom gnus-modtime-botch nil
 332   "*Non-nil means .newsrc should be deleted prior to save.
 333 Its use is due to the bogus appearance that .newsrc was modified on
 334 disc."
 335   :group 'gnus-newsrc
 336   :type 'boolean)
 337
 338 (defcustom gnus-check-bogus-groups-hook nil
 339   "A hook run after removing bogus groups."
 340   :group 'gnus-start-server
 341   :type 'hook)
 342
 343 (defcustom gnus-startup-hook nil
 344   "A hook called at startup.
 345 This hook is called after Gnus is connected to the NNTP server."
 346   :group 'gnus-start
 347   :type 'hook)
 348
 349 (defcustom gnus-before-startup-hook nil
 350   "A hook called at before startup.
 351 This hook is called as the first thing when Gnus is started."
 352   :group 'gnus-start
 353   :type 'hook)
 354
 355 (defcustom gnus-started-hook nil
 356   "A hook called as the last thing after startup."
 357   :group 'gnus-start
 358   :type 'hook)
 359
 360 (defcustom gnus-setup-news-hook nil
 361   "A hook after reading the .newsrc file, but before generating the buffer."
 362   :group 'gnus-start
 363   :type 'hook)
 364
 365 (defcustom gnus-get-new-news-hook nil
 366   "A hook run just before Gnus checks for new news."
 367   :group 'gnus-group-new
 368   :type 'hook)
 369
 370 (defcustom gnus-after-getting-new-news-hook
 371   '(gnus-display-time-event-handler)
 372   "*A hook run after Gnus checks for new news when Gnus is already running."
 373   :group 'gnus-group-new
 374   :type 'hook)
 375
 376 (defcustom gnus-save-newsrc-hook nil
 377   "A hook called before saving any of the newsrc files."
 378   :group 'gnus-newsrc
 379   :type 'hook)
 380
 381 (defcustom gnus-save-quick-newsrc-hook nil
 382   "A hook called just before saving the quick newsrc file.
 383 Can be used to turn version control on or off."
 384   :group 'gnus-newsrc
 385   :type 'hook)
 386
 387 (defcustom gnus-save-standard-newsrc-hook nil
 388   "A hook called just before saving the standard newsrc file.
 389 Can be used to turn version control on or off."
 390   :group 'gnus-newsrc
 391   :type 'hook)
 392
 393 (defcustom gnus-always-read-dribble-file nil
 394   "Unconditionally read the dribble file."
 395   :group 'gnus-newsrc
 396   :type 'boolean)
 397
 398 (defvar gnus-startup-file-coding-system 'binary
 399   "*Coding system for startup file.")
 400
 401 ;;; Internal variables
 402
 403 (defvar gnus-newsrc-file-version nil)
 404 (defvar gnus-override-subscribe-method nil)
 405 (defvar gnus-dribble-buffer nil)
 406 (defvar gnus-newsrc-options nil
 407   "Options line in the .newsrc file.")
 408
 409 (defvar gnus-newsrc-options-n nil
 410   "List of regexps representing groups to be subscribed/ignored unconditionally.")
 411
 412 (defvar gnus-newsrc-last-checked-date nil
 413   "Date Gnus last asked server for new newsgroups.")
 414
 415 (defvar gnus-current-startup-file nil
 416   "Startup file for the current host.")
 417
 418 ;; Byte-compiler warning.
 419 (defvar gnus-group-line-format)
 420
 421 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
 422 (defvar gnus-init-inhibit nil)
 423 (defun gnus-read-init-file (&optional inhibit-next)
 424   ;; Don't load .gnus if the -q option was used.
 425   (when init-file-user
 426     (if gnus-init-inhibit
 427         (setq gnus-init-inhibit nil)
 428       (setq gnus-init-inhibit inhibit-next)
 429       (let ((files (list gnus-site-init-file gnus-init-file))
 430             file)
 431         (while files
 432           (and (setq file (pop files))
 433                (or (and (file-exists-p file)
 434                         ;; Don't try to load a directory.
 435                         (not (file-directory-p file)))
 436                    (file-exists-p (concat file ".el"))
 437                    (file-exists-p (concat file ".elc")))
 438                (condition-case var
 439                    (let ((coding-system-for-read
 440                           gnus-startup-file-coding-system))
 441                      (load file nil t))
 442                  (error
 443                   (error "Error in %s: %s" file var)))))))))
 444
 445 ;; For subscribing new newsgroup
 446
 447 (defun gnus-subscribe-hierarchical-interactive (groups)
 448   (let ((groups (sort groups 'string<))
 449         prefixes prefix start ans group starts)
 450     (while groups
 451       (setq prefixes (list "^"))
 452       (while (and groups prefixes)
 453         (while (not (string-match (car prefixes) (car groups)))
 454           (setq prefixes (cdr prefixes)))
 455         (setq prefix (car prefixes))
 456         (setq start (1- (length prefix)))
 457         (if (and (string-match "[^\\.]\\." (car groups) start)
 458                  (cdr groups)
 459                  (setq prefix
 460                        (concat "^" (substring (car groups) 0 (match-end 0))))
 461                  (string-match prefix (cadr groups)))
 462             (progn
 463               (push prefix prefixes)
 464               (message "Descend hierarchy %s? ([y]nsq): "
 465                        (substring prefix 1 (1- (length prefix))))
 466               (while (not (memq (setq ans (read-char-exclusive))
 467                                 '(?y ?\n ?\r ?n ?s ?q)))
 468                 (ding)
 469                 (message "Descend hierarchy %s? ([y]nsq): "
 470                          (substring prefix 1 (1- (length prefix)))))
 471               (cond ((= ans ?n)
 472                      (while (and groups
 473                                  (string-match prefix
 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                      (setq starts (cdr starts)))
 479                     ((= ans ?s)
 480                      (while (and groups
 481                                  (string-match prefix
 482                                                (setq group (car groups))))
 483                        (gnus-sethash group group gnus-killed-hashtb)
 484                        (gnus-subscribe-alphabetically (car groups))
 485                        (setq groups (cdr groups)))
 486                      (setq starts (cdr starts)))
 487                     ((= ans ?q)
 488                      (while groups
 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                     (t nil)))
 494           (message "Subscribe %s? ([n]yq)" (car groups))
 495           (while (not (memq (setq ans (read-char-exclusive))
 496                             '(?y ?\n ?\r ?q ?n)))
 497             (ding)
 498             (message "Subscribe %s? ([n]yq)" (car groups)))
 499           (setq group (car groups))
 500           (cond ((= ans ?y)
 501                  (gnus-subscribe-alphabetically (car groups))
 502                  (gnus-sethash group group gnus-killed-hashtb))
 503                 ((= ans ?q)
 504                  (while groups
 505                    (setq group (car groups))
 506                    (push group gnus-killed-list)
 507                    (gnus-sethash group group gnus-killed-hashtb)
 508                    (setq groups (cdr groups))))
 509                 (t
 510                  (push group gnus-killed-list)
 511                  (gnus-sethash group group gnus-killed-hashtb)))
 512           (setq groups (cdr groups)))))))
 513
 514 (defun gnus-subscribe-randomly (newsgroup)
 515   "Subscribe new NEWSGROUP by making it the first newsgroup."
 516   (gnus-subscribe-newsgroup newsgroup))
 517
 518 (defun gnus-subscribe-alphabetically (newgroup)
 519   "Subscribe new NEWSGROUP and insert it in alphabetical order."
 520   (let ((groups (cdr gnus-newsrc-alist))
 521         before)
 522     (while (and (not before) groups)
 523       (if (string< newgroup (caar groups))
 524           (setq before (caar groups))
 525         (setq groups (cdr groups))))
 526     (gnus-subscribe-newsgroup newgroup before)))
 527
 528 (defun gnus-subscribe-hierarchically (newgroup)
 529   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
 530   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
 531   (save-excursion
 532     (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
 533     (prog1
 534         (let ((groupkey newgroup) before)
 535           (while (and (not before) groupkey)
 536             (goto-char (point-min))
 537             (let ((groupkey-re
 538                    (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
 539               (while (and (re-search-forward groupkey-re nil t)
 540                           (progn
 541                             (setq before (match-string 1))
 542                             (string< before newgroup)))))
 543             ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
 544             (setq groupkey
 545                   (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
 546                     (substring groupkey (match-beginning 1) (match-end 1)))))
 547           (gnus-subscribe-newsgroup newgroup before))
 548       (kill-buffer (current-buffer)))))
 549
 550 (defun gnus-subscribe-interactively (group)
 551   "Subscribe the new GROUP interactively.
 552 It is inserted in hierarchical newsgroup order if subscribed.  If not,
 553 it