*** empty log message ***
[gnus] / lisp / gnus-start.el
1 ;;; gnus-start.el --- startup functions for Gnus
2 ;; Copyright (C) 1996 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-load)
29 (require 'gnus)
30 (require 'gnus-win)
31 (require 'gnus-int)
32 (require 'gnus-spec)
33 (require 'gnus-range)
34 (require 'message)
35
36 (defvar gnus-secondary-servers nil
37   "*List of NNTP servers that the user can choose between interactively.
38 To make Gnus query you for a server, you have to give `gnus' a
39 non-numeric prefix - `C-u M-x gnus', in short.")
40
41 (defvar gnus-nntp-server nil
42   "*The name of the host running the NNTP server.
43 This variable is semi-obsolete.  Use the `gnus-select-method'
44 variable instead.")
45
46 (defvar gnus-startup-file "~/.newsrc"
47   "*Your `.newsrc' file.
48 `.newsrc-SERVER' will be used instead if that exists.")
49
50 (defvar gnus-init-file "~/.gnus"
51   "*Your Gnus elisp startup file.
52 If a file with the .el or .elc suffixes exist, it will be read
53 instead.")
54
55 (defvar gnus-default-subscribed-newsgroups nil
56   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
57 It should be a list of strings.
58 If it is `t', Gnus will not do anything special the first time it is
59 started; it'll just use the normal newsgroups subscription methods.")
60
61 (defvar gnus-use-dribble-file t
62   "*Non-nil means that Gnus will use a dribble file to store user updates.
63 If Emacs should crash without saving the .newsrc files, complete
64 information can be restored from the dribble file.")
65
66 (defvar gnus-dribble-directory nil
67   "*The directory where dribble files will be saved.
68 If this variable is nil, the directory where the .newsrc files are
69 saved will be used.")
70
71 (defvar gnus-check-new-newsgroups t
72   "*Non-nil means that Gnus will run gnus-find-new-newsgroups at startup.
73 This normally finds new newsgroups by comparing the active groups the
74 servers have already reported with those Gnus already knows, either alive
75 or killed.
76
77 When any of the following are true, gnus-find-new-newsgroups will instead
78 ask the servers (primary, secondary, and archive servers) to list new
79 groups since the last time it checked:
80   1. This variable is `ask-server'.
81   2. This variable is a list of select methods (see below).
82   3. `gnus-read-active-file' is nil or `some'.
83   4. A prefix argument is given to gnus-find-new-newsgroups interactively.
84
85 Thus, if this variable is `ask-server' or a list of select methods or
86 `gnus-read-active-file' is nil or `some', then the killed list is no
87 longer necessary, so you could safely set `gnus-save-killed-list' to nil.
88
89 This variable can be a list of select methods which Gnus will query with
90 the `ask-server' method in addition to the primary, secondary, and archive
91 servers.
92
93 Eg.
94   (setq gnus-check-new-newsgroups
95         '((nntp \"some.server\") (nntp \"other.server\")))
96
97 If this variable is nil, then you have to tell Gnus explicitly to
98 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
99
100 (defvar gnus-check-bogus-newsgroups nil
101   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
102 If this variable is nil, then you have to tell Gnus explicitly to
103 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
104
105 (defvar gnus-read-active-file t
106   "*Non-nil means that Gnus will read the entire active file at startup.
107 If this variable is nil, Gnus will only know about the groups in your
108 `.newsrc' file.
109
110 If this variable is `some', Gnus will try to only read the relevant
111 parts of the active file from the server.  Not all servers support
112 this, and it might be quite slow with other servers, but this should
113 generally be faster than both the t and nil value.
114
115 If you set this variable to nil or `some', you probably still want to
116 be told about new newsgroups that arrive.  To do that, set
117 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
118 properly with all servers.")
119
120 (defvar gnus-level-subscribed 5
121   "*Groups with levels less than or equal to this variable are subscribed.")
122
123 (defvar gnus-level-unsubscribed 7
124   "*Groups with levels less than or equal to this variable are unsubscribed.
125 Groups with levels less than `gnus-level-subscribed', which should be
126 less than this variable, are subscribed.")
127
128 (defvar gnus-level-zombie 8
129   "*Groups with this level are zombie groups.")
130
131 (defvar gnus-level-killed 9
132   "*Groups with this level are killed.")
133
134 (defvar gnus-level-default-subscribed 3
135   "*New subscribed groups will be subscribed at this level.")
136
137 (defvar gnus-level-default-unsubscribed 6
138   "*New unsubscribed groups will be unsubscribed at this level.")
139
140 (defvar gnus-activate-level (1+ gnus-level-subscribed)
141   "*Groups higher than this level won't be activated on startup.
142 Setting this variable to something log might save lots of time when
143 you have many groups that you aren't interested in.")
144
145 (defvar gnus-activate-foreign-newsgroups 4
146   "*If nil, Gnus will not check foreign newsgroups at startup.
147 If it is non-nil, it should be a number between one and nine.  Foreign
148 newsgroups that have a level lower or equal to this number will be
149 activated on startup.  For instance, if you want to active all
150 subscribed newsgroups, but not the rest, you'd set this variable to
151 `gnus-level-subscribed'.
152
153 If you subscribe to lots of newsgroups from different servers, startup
154 might take a while.  By setting this variable to nil, you'll save time,
155 but you won't be told how many unread articles there are in the
156 groups.")
157
158 (defvar gnus-save-newsrc-file t
159   "*Non-nil means that Gnus will save the `.newsrc' file.
160 Gnus always saves its own startup file, which is called
161 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
162 be readily understood by other newsreaders.  If you don't plan on
163 using other newsreaders, set this variable to nil to save some time on
164 exit.")
165
166 (defvar gnus-save-killed-list t
167   "*If non-nil, save the list of killed groups to the startup file.
168 If you set this variable to nil, you'll save both time (when starting
169 and quitting) and space (both memory and disk), but it will also mean
170 that Gnus has no record of which groups are new and which are old, so
171 the automatic new newsgroups subscription methods become meaningless.
172
173 You should always set `gnus-check-new-newsgroups' to `ask-server' or
174 nil if you set this variable to nil.")
175
176 (defvar gnus-ignored-newsgroups
177   (purecopy (mapconcat 'identity
178                        '("^to\\."       ; not "real" groups
179                          "^[0-9. \t]+ " ; all digits in name
180                          "[][\"#'()]"   ; bogus characters
181                          )
182                        "\\|"))
183   "*A regexp to match uninteresting newsgroups in the active file.
184 Any lines in the active file matching this regular expression are
185 removed from the newsgroup list before anything else is done to it,
186 thus making them effectively non-existent.")
187
188 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
189   "*Function called with a group name when new group is detected.
190 A few pre-made functions are supplied: `gnus-subscribe-randomly'
191 inserts new groups at the beginning of the list of groups;
192 `gnus-subscribe-alphabetically' inserts new groups in strict
193 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
194 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
195 for your decision; `gnus-subscribe-killed' kills all new groups;
196 `gnus-subscribe-zombies' will make all new groups into zombies.")
197
198 ;; Suggested by a bug report by Hallvard B Furuseth.
199 ;; <h.b.furuseth@usit.uio.no>.
200 (defvar gnus-subscribe-options-newsgroup-method
201   (function gnus-subscribe-alphabetically)
202   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
203 If, for instance, you want to subscribe to all newsgroups in the
204 \"no\" and \"alt\" hierarchies, you'd put the following in your
205 .newsrc file:
206
207 options -n no.all alt.all
208
209 Gnus will the subscribe all new newsgroups in these hierarchies with
210 the subscription method in this variable.")
211
212 (defvar gnus-subscribe-hierarchical-interactive nil
213   "*If non-nil, Gnus will offer to subscribe hierarchically.
214 When a new hierarchy appears, Gnus will ask the user:
215
216 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
217
218 If the user pressed `d', Gnus will descend the hierarchy, `y' will
219 subscribe to all newsgroups in the hierarchy and `s' will skip this
220 hierarchy in its entirety.")
221
222 (defvar gnus-auto-subscribed-groups
223   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
224   "*All new groups that match this regexp will be subscribed automatically.
225 Note that this variable only deals with new groups.  It has no effect
226 whatsoever on old groups.
227
228 New groups that match this regexp will not be handled by
229 `gnus-subscribe-newsgroup-method'.  Instead, they will
230 be subscribed using `gnus-subscribe-options-newsgroup-method'.")
231
232 (defvar gnus-options-subscribe nil
233   "*All new groups matching this regexp will be subscribed unconditionally.
234 Note that this variable deals only with new newsgroups.  This variable
235 does not affect old newsgroups.
236
237 New groups that match this regexp will not be handled by
238 `gnus-subscribe-newsgroup-method'.  Instead, they will
239 be subscribed using `gnus-subscribe-options-newsgroup-method'.")
240
241 (defvar gnus-options-not-subscribe nil
242   "*All new groups matching this regexp will be ignored.
243 Note that this variable deals only with new newsgroups.  This variable
244 does not affect old (already subscribed) newsgroups.")
245
246 (defvar gnus-modtime-botch nil
247   "*Non-nil means .newsrc should be deleted prior to save.  
248 Its use is due to the bogus appearance that .newsrc was modified on
249 disc.")
250
251 (defvar gnus-check-bogus-groups-hook nil
252   "A hook run after removing bogus groups.")
253
254 (defvar gnus-startup-hook nil
255   "*A hook called at startup.
256 This hook is called after Gnus is connected to the NNTP server.")
257
258 (defvar gnus-get-new-news-hook nil
259   "*A hook run just before Gnus checks for new news.")
260
261 (defvar gnus-after-getting-new-news-hook nil
262   "*A hook run after Gnus checks for new news.")
263
264 (defvar gnus-save-newsrc-hook nil
265   "*A hook called before saving any of the newsrc files.")
266
267 (defvar gnus-save-quick-newsrc-hook nil
268   "*A hook called just before saving the quick newsrc file.
269 Can be used to turn version control on or off.")
270
271 (defvar gnus-save-standard-newsrc-hook nil
272   "*A hook called just before saving the standard newsrc file.
273 Can be used to turn version control on or off.")
274
275 ;;; Internal variables
276
277 (defvar gnus-newsrc-file-version nil)
278 (defvar gnus-override-subscribe-method nil)
279 (defvar gnus-dribble-buffer nil)
280 (defvar gnus-newsrc-options nil
281   "Options line in the .newsrc file.")
282
283 (defvar gnus-newsrc-options-n nil
284   "List of regexps representing groups to be subscribed/ignored unconditionally.")
285
286 (defvar gnus-newsrc-last-checked-date nil
287   "Date Gnus last asked server for new newsgroups.")
288
289 (defvar gnus-current-startup-file nil
290   "Startup file for the current host.")
291
292 ;; Byte-compiler warning.
293 (defvar gnus-group-line-format)
294
295 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
296 (defvar gnus-init-inhibit nil)
297 (defun gnus-read-init-file (&optional inhibit-next)
298   (if gnus-init-inhibit
299       (setq gnus-init-inhibit nil)
300     (setq gnus-init-inhibit inhibit-next)
301     (and gnus-init-file
302          (or (and (file-exists-p gnus-init-file)
303                   ;; Don't try to load a directory.
304                   (not (file-directory-p gnus-init-file)))
305              (file-exists-p (concat gnus-init-file ".el"))
306              (file-exists-p (concat gnus-init-file ".elc")))
307          (condition-case var
308              (load gnus-init-file nil t)
309            (error
310             (error "Error in %s: %s" gnus-init-file var))))))
311
312 ;; For subscribing new newsgroup
313
314 (defun gnus-subscribe-hierarchical-interactive (groups)
315   (let ((groups (sort groups 'string<))
316         prefixes prefix start ans group starts)
317     (while groups
318       (setq prefixes (list "^"))
319       (while (and groups prefixes)
320         (while (not (string-match (car prefixes) (car groups)))
321           (setq prefixes (cdr prefixes)))
322         (setq prefix (car prefixes))
323         (setq start (1- (length prefix)))
324         (if (and (string-match "[^\\.]\\." (car groups) start)
325                  (cdr groups)
326                  (setq prefix
327                        (concat "^" (substring (car groups) 0 (match-end 0))))
328                  (string-match prefix (cadr groups)))
329             (progn
330               (setq prefixes (cons prefix prefixes))
331               (message "Descend hierarchy %s? ([y]nsq): "
332                        (substring prefix 1 (1- (length prefix))))
333               (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q)))
334                 (ding)
335                 (message "Descend hierarchy %s? ([y]nsq): "
336                          (substring prefix 1 (1- (length prefix)))))
337               (cond ((= ans ?n)
338                      (while (and groups
339                                  (string-match prefix
340                                                (setq group (car groups))))
341                        (setq gnus-killed-list
342                              (cons group gnus-killed-list))
343                        (gnus-sethash group group gnus-killed-hashtb)
344                        (setq groups (cdr groups)))
345                      (setq starts (cdr starts)))
346                     ((= ans ?s)
347                      (while (and groups
348                                  (string-match prefix
349                                                (setq group (car groups))))
350                        (gnus-sethash group group gnus-killed-hashtb)
351                        (gnus-subscribe-alphabetically (car groups))
352                        (setq groups (cdr groups)))
353                      (setq starts (cdr starts)))
354                     ((= ans ?q)
355                      (while groups
356                        (setq group (car groups))
357                        (setq gnus-killed-list (cons group gnus-killed-list))
358                        (gnus-sethash group group gnus-killed-hashtb)
359                        (setq groups (cdr groups))))
360                     (t nil)))
361           (message "Subscribe %s? ([n]yq)" (car groups))
362           (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n)))
363             (ding)
364             (message "Subscribe %s? ([n]yq)" (car groups)))
365           (setq group (car groups))
366           (cond ((= ans ?y)
367                  (gnus-subscribe-alphabetically (car groups))
368                  (gnus-sethash group group gnus-killed-hashtb))
369                 ((= ans ?q)
370                  (while groups
371                    (setq group (car groups))
372                    (setq gnus-killed-list (cons group gnus-killed-list))
373                    (gnus-sethash group group gnus-killed-hashtb)
374                    (setq groups (cdr groups))))
375                 (t
376                  (setq gnus-killed-list (cons group gnus-killed-list))
377                  (gnus-sethash group group gnus-killed-hashtb)))
378           (setq groups (cdr groups)))))))
379
380 (defun gnus-subscribe-randomly (newsgroup)
381   "Subscribe new NEWSGROUP by making it the first newsgroup."
382   (gnus-subscribe-newsgroup newsgroup))
383
384 (defun gnus-subscribe-alphabetically (newgroup)
385   "Subscribe new NEWSGROUP and insert it in alphabetical order."
386   (let ((groups (cdr gnus-newsrc-alist))
387         before)
388     (while (and (not before) groups)
389       (if (string< newgroup (caar groups))
390           (setq before (caar groups))
391         (setq groups (cdr groups))))
392     (gnus-subscribe-newsgroup newgroup before)))
393
394 (defun gnus-subscribe-hierarchically (newgroup)
395   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
396   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
397   (save-excursion
398     (set-buffer (find-file-noselect gnus-current-startup-file))
399     (let ((groupkey newgroup)
400           before)
401       (while (and (not before) groupkey)
402         (goto-char (point-min))
403         (let ((groupkey-re
404                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
405           (while (and (re-search-forward groupkey-re nil t)
406                       (progn
407                         (setq before (match-string 1))
408                         (string< before newgroup)))))
409         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
410         (setq groupkey
411               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
412                   (substring groupkey (match-beginning 1) (match-end 1)))))
413       (gnus-subscribe-newsgroup newgroup before))
414     (kill-buffer (current-buffer))))
415
416 (defun gnus-subscribe-interactively (group)
417   "Subscribe the new GROUP interactively.
418 It is inserted in hierarchical newsgroup order if subscribed.  If not,
419 it is killed."
420   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
421       (gnus-subscribe-hierarchically group)
422     (push group gnus-killed-list)))
423
424 (defun gnus-subscribe-zombies (group)
425   "Make the new GROUP into a zombie group."
426   (push group gnus-zombie-list))
427
428 (defun gnus-subscribe-killed (group)
429   "Make the new GROUP a killed group."
430   (push group gnus-killed-list))
431
432 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
433   "Subscribe new NEWSGROUP.
434 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
435 the first newsgroup."
436   (save-excursion
437     (goto-char (point-min))
438     ;; We subscribe the group by changing its level to `subscribed'.
439     (gnus-group-change-level
440      newsgroup gnus-level-default-subscribed
441      gnus-level-killed (gnus-gethash (or next "dummy.group")
442                                      gnus-newsrc-hashtb))
443     (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)))
444
445 (defun gnus-read-active-file-p ()
446   "Say whether the active file has been read from `gnus-select-method'."
447   (memq gnus-select-method gnus-have-read-active-file))
448
449 ;;; General various misc type functions.
450
451 ;; Silence byte-compiler.
452 (defvar gnus-current-headers)
453 (defvar gnus-thread-indent-array)
454 (defvar gnus-newsgroup-name)
455 (defvar gnus-newsgroup-headers)
456 (defvar gnus-group-list-mode)
457 (defvar gnus-group-mark-positions)
458 (defvar gnus-newsgroup-data)
459 (defvar gnus-newsgroup-unreads)
460 (defvar nnoo-state-alist)
461 (defvar gnus-current-select-method)
462 (defun gnus-clear-system ()
463   "Clear all variables and buffers."
464   ;; Clear Gnus variables.
465   (let ((variables gnus-variable-list))
466     (while variables
467       (set (car variables) nil)
468       (setq variables (cdr variables))))
469   ;; Clear other internal variables.
470   (setq gnus-list-of-killed-groups nil
471         gnus-have-read-active-file nil
472         gnus-newsrc-alist nil
473         gnus-newsrc-hashtb nil
474         gnus-killed-list nil
475         gnus-zombie-list nil
476         gnus-killed-hashtb nil
477         gnus-active-hashtb nil
478         gnus-moderated-list nil
479         gnus-description-hashtb nil
480         gnus-current-headers nil
481         gnus-thread-indent-array nil
482         gnus-newsgroup-headers nil
483         gnus-newsgroup-name nil
484         gnus-server-alist nil
485         gnus-group-list-mode nil
486         gnus-opened-servers nil
487         gnus-group-mark-positions nil
488         gnus-newsgroup-data nil
489         gnus-newsgroup-unreads nil
490         nnoo-state-alist nil
491         gnus-current-select-method nil)
492   (gnus-shutdown 'gnus)
493   ;; Kill the startup file.
494   (and gnus-current-startup-file
495        (get-file-buffer gnus-current-startup-file)
496        (kill-buffer (get-file-buffer gnus-current-startup-file)))
497   ;; Clear the dribble buffer.
498   (gnus-dribble-clear)
499   ;; Kill global KILL file buffer.
500   (when (get-file-buffer (gnus-newsgroup-kill-file nil))
501     (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
502   (gnus-kill-buffer nntp-server-buffer)
503   ;; Kill Gnus buffers.
504   (while gnus-buffer-list
505     (gnus-kill-buffer (pop gnus-buffer-list)))
506   ;; Remove Gnus frames.
507   (gnus-kill-gnus-frames))
508
509 ;;;###autoload
510 (defun gnus-1 (&optional arg dont-connect slave)
511   "Read network news.
512 If ARG is non-nil and a positive number, Gnus will use that as the
513 startup level.  If ARG is non-nil and not a positive number, Gnus will
514 prompt the user for the name of an NNTP server to use."
515   (interactive "P")
516
517   (if (and (get-buffer gnus-group-buffer)
518            (save-excursion
519              (set-buffer gnus-group-buffer)
520              (eq major-mode 'gnus-group-mode)))
521       (progn
522         (switch-to-buffer gnus-group-buffer)
523         (gnus-group-get-new-news))
524
525     (gnus-splash)
526     (gnus-clear-system)
527     (nnheader-init-server-buffer)
528     (gnus-read-init-file)
529     (setq gnus-slave slave)
530
531     (when (string-match "xemacs" (emacs-version))
532       (gnus-splash))
533
534     (let ((level (and (numberp arg) (> arg 0) arg))
535           did-connect)
536       (unwind-protect
537           (progn
538             (or dont-connect
539                 (setq did-connect
540                       (gnus-start-news-server (and arg (not level))))))
541         (if (and (not dont-connect)
542                  (not did-connect))
543             (gnus-group-quit)
544           (run-hooks 'gnus-startup-hook)
545           ;; NNTP server is successfully open.
546
547           ;; Find the current startup file name.
548           (setq gnus-current-startup-file
549                 (gnus-make-newsrc-file gnus-startup-file))
550
551           ;; Read the dribble file.
552           (when (or gnus-slave gnus-use-dribble-file)
553             (gnus-dribble-read-file))
554
555           ;; Allow using GroupLens predictions.
556           (when gnus-use-grouplens
557             (bbb-login)
558             (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
559
560           ;; Do the actual startup.
561           (gnus-setup-news nil level dont-connect)
562           ;; Generate the group buffer.
563           (gnus-group-list-groups level)
564           (gnus-group-first-unread-group)
565           (gnus-configure-windows 'group)
566           (gnus-group-set-mode-line))))))
567
568 ;;;###autoload
569 (defun gnus-unload ()
570   "Unload all Gnus features."
571   (interactive)
572   (or (boundp 'load-history)
573       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
574   (let ((history load-history)
575         feature)
576     (while history
577       (and (string-match "^\\(gnus\\|nn\\)" (caar history))
578            (setq feature (cdr (assq 'provide (car history))))
579            (unload-feature feature 'force))
580       (setq history (cdr history)))))
581
582 \f
583 ;;;
584 ;;; Dribble file
585 ;;;
586
587 (defvar gnus-dribble-ignore nil)
588 (defvar gnus-dribble-eval-file nil)
589
590 (defun gnus-dribble-file-name ()
591   "Return the dribble file for the current .newsrc."
592   (concat
593    (if gnus-dribble-directory
594        (concat (file-name-as-directory gnus-dribble-directory)
595                (file-name-nondirectory gnus-current-startup-file))
596      gnus-current-startup-file)
597    "-dribble"))
598
599 (defun gnus-dribble-enter (string)
600   "Enter STRING into the dribble buffer."
601   (if (and (not gnus-dribble-ignore)
602            gnus-dribble-buffer
603            (buffer-name gnus-dribble-buffer))
604       (let ((obuf (current-buffer)))
605         (set-buffer gnus-dribble-buffer)
606         (insert string "\n")
607         (set-window-point (get-buffer-window (current-buffer)) (point-max))
608         (bury-buffer gnus-dribble-buffer)
609         (set-buffer obuf))))
610
611 (defun gnus-dribble-read-file ()
612   "Read the dribble file from disk."
613   (let ((dribble-file (gnus-dribble-file-name)))
614     (save-excursion
615       (set-buffer (setq gnus-dribble-buffer
616                         (get-buffer-create
617                          (file-name-nondirectory dribble-file))))
618       (gnus-add-current-to-buffer-list)
619       (erase-buffer)
620       (setq buffer-file-name dribble-file)
621       (auto-save-mode t)
622       (buffer-disable-undo (current-buffer))
623       (bury-buffer (current-buffer))
624       (set-buffer-modified-p nil)
625       (let ((auto (make-auto-save-file-name))
626             (gnus-dribble-ignore t)
627             modes)
628         (when (or (file-exists-p auto) (file-exists-p dribble-file))
629           ;; Load whichever file is newest -- the auto save file
630           ;; or the "real" file.
631           (if (file-newer-than-file-p auto dribble-file)
632               (insert-file-contents auto)
633             (insert-file-contents dribble-file))
634           (unless (zerop (buffer-size))
635             (set-buffer-modified-p t))
636           ;; Set the file modes to reflect the .newsrc file modes.
637           (save-buffer)
638           (when (and (file-exists-p gnus-current-startup-file)
639                      (setq modes (file-modes gnus-current-startup-file)))
640             (set-file-modes dribble-file modes))
641           ;; Possibly eval the file later.
642           (when (gnus-y-or-n-p
643                  "Auto-save file exists.  Do you want to read it? ")
644             (setq gnus-dribble-eval-file t)))))))
645
646 (defun gnus-dribble-eval-file ()
647   (when gnus-dribble-eval-file
648     (setq gnus-dribble-eval-file nil)
649     (save-excursion
650       (let ((gnus-dribble-ignore t))
651         (set-buffer gnus-dribble-buffer)
652         (eval-buffer (current-buffer))))))
653
654 (defun gnus-dribble-delete-file ()
655   (when (file-exists-p (gnus-dribble-file-name))
656     (delete-file (gnus-dribble-file-name)))
657   (when gnus-dribble-buffer
658     (save-excursion
659       (set-buffer gnus-dribble-buffer)
660       (let ((auto (make-auto-save-file-name)))
661         (if (file-exists-p auto)
662             (delete-file auto))
663         (erase-buffer)
664         (set-buffer-modified-p nil)))))
665
666 (defun gnus-dribble-save ()
667   (when (and gnus-dribble-buffer
668              (buffer-name gnus-dribble-buffer))
669     (save-excursion
670       (set-buffer gnus-dribble-buffer)
671       (save-buffer))))
672
673 (defun gnus-dribble-clear ()
674   (when (gnus-buffer-exists-p gnus-dribble-buffer)
675     (save-excursion
676       (set-buffer gnus-dribble-buffer)
677       (erase-buffer)
678       (set-buffer-modified-p nil)
679       (setq buffer-saved-size (buffer-size)))))
680
681 \f
682 ;;;
683 ;;; Active & Newsrc File Handling
684 ;;;
685
686 (defun gnus-setup-news (&optional rawfile level dont-connect)
687   "Setup news information.
688 If RAWFILE is non-nil, the .newsrc file will also be read.
689 If LEVEL is non-nil, the news will be set up at level LEVEL."
690   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
691
692     (when init 
693       ;; Clear some variables to re-initialize news information.
694       (setq gnus-newsrc-alist nil
695             gnus-active-hashtb nil)
696       ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
697       (gnus-read-newsrc-file rawfile))
698
699     (when (and (not (assoc "archive" gnus-server-alist))
700                (gnus-archive-server-wanted-p))
701       (push (cons "archive" gnus-message-archive-method)
702             gnus-server-alist))
703
704     ;; If we don't read the complete active file, we fill in the
705     ;; hashtb here.
706     (if (or (null gnus-read-active-file)
707             (eq gnus-read-active-file 'some))
708         (gnus-update-active-hashtb-from-killed))
709
710     ;; Read the active file and create `gnus-active-hashtb'.
711     ;; If `gnus-read-active-file' is nil, then we just create an empty
712     ;; hash table.  The partial filling out of the hash table will be
713     ;; done in `gnus-get-unread-articles'.
714     (and gnus-read-active-file
715          (not level)
716          (gnus-read-active-file))
717
718     (or gnus-active-hashtb
719         (setq gnus-active-hashtb (make-vector 4095 0)))
720
721     ;; Initialize the cache.
722     (when gnus-use-cache
723       (gnus-cache-open))
724
725     ;; Possibly eval the dribble file.
726     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
727
728     ;; Slave Gnusii should then clear the dribble buffer.
729     (when (and init gnus-slave)
730       (gnus-dribble-clear))
731
732     (gnus-update-format-specifications)
733
734     ;; See whether we need to read the description file.
735     (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
736              (not gnus-description-hashtb)
737              (not dont-connect)
738              gnus-read-active-file)
739         (gnus-read-all-descriptions-files))
740
741     ;; Find new newsgroups and treat them.
742     (if (and init gnus-check-new-newsgroups (not level)
743              (gnus-check-server gnus-select-method))
744         (gnus-find-new-newsgroups))
745
746     ;; We might read in new NoCeM messages here.
747     (when (and gnus-use-nocem 
748                (not level)
749                (not dont-connect))
750       (gnus-nocem-scan-groups))
751
752     ;; Find the number of unread articles in each non-dead group.
753     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
754       (gnus-get-unread-articles level))
755
756     (if (and init gnus-check-bogus-newsgroups
757              gnus-read-active-file (not level)
758              (gnus-server-opened gnus-select-method))
759         (gnus-check-bogus-newsgroups))))
760
761 (defun gnus-find-new-newsgroups (&optional arg)
762   "Search for new newsgroups and add them.
763 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
764 The `-n' option line from .newsrc is respected.
765 If ARG (the prefix), use the `ask-server' method to query
766 the server for new groups."
767   (interactive "P")
768   (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
769                        (null gnus-read-active-file)
770                        (eq gnus-read-active-file 'some))
771                    'ask-server gnus-check-new-newsgroups)))
772     (unless (gnus-check-first-time-used)
773       (if (or (consp check)
774               (eq check 'ask-server))
775           ;; Ask the server for new groups.
776           (gnus-ask-server-for-new-groups)
777         ;; Go through the active hashtb and look for new groups.
778         (let ((groups 0)
779               group new-newsgroups)
780           (gnus-message 5 "Looking for new newsgroups...")
781           (unless gnus-have-read-active-file
782             (gnus-read-active-file))
783           (setq gnus-newsrc-last-checked-date (current-time-string))
784           (unless gnus-killed-hashtb
785             (gnus-make-hashtable-from-killed))
786           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
787           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
788           (mapatoms
789            (lambda (sym)
790              (if (or (null (setq group (symbol-name sym)))
791                      (not (boundp sym))
792                      (null (symbol-value sym))
793                      (gnus-gethash group gnus-killed-hashtb)
794                      (gnus-gethash group gnus-newsrc-hashtb))
795                  ()
796                (let ((do-sub (gnus-matches-options-n group)))
797                  (cond
798                   ((eq do-sub 'subscribe)
799                    (setq groups (1+ groups))
800                    (gnus-sethash group group gnus-killed-hashtb)
801                    (funcall gnus-subscribe-options-newsgroup-method group))
802                   ((eq do-sub 'ignore)
803                    nil)
804                   (t
805                    (setq groups (1+ groups))
806                    (gnus-sethash group group gnus-killed-hashtb)
807                    (if gnus-subscribe-hierarchical-interactive
808                        (setq new-newsgroups (cons group new-newsgroups))
809                      (funcall gnus-subscribe-newsgroup-method group)))))))
810            gnus-active-hashtb)
811           (when new-newsgroups
812             (gnus-subscribe-hierarchical-interactive new-newsgroups))
813           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
814           (if (> groups 0)
815               (gnus-message 6 "%d new newsgroup%s arrived."
816                             groups (if (> groups 1) "s have" " has"))
817             (gnus-message 6 "No new newsgroups.")))))))
818
819 (defun gnus-matches-options-n (group)
820   ;; Returns `subscribe' if the group is to be unconditionally
821   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
822   ;; no match for the group.
823
824   ;; First we check the two user variables.
825   (cond
826    ((and gnus-options-subscribe
827          (string-match gnus-options-subscribe group))
828     'subscribe)
829    ((and gnus-auto-subscribed-groups
830          (string-match gnus-auto-subscribed-groups group))
831     'subscribe)
832    ((and gnus-options-not-subscribe
833          (string-match gnus-options-not-subscribe group))
834     'ignore)
835    ;; Then we go through the list that was retrieved from the .newsrc
836    ;; file.  This list has elements on the form
837    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
838    ;; is in the reverse order of the options line) is returned.
839    (t
840     (let ((regs gnus-newsrc-options-n))
841       (while (and regs
842                   (not (string-match (caar regs) group)))
843         (setq regs (cdr regs)))
844       (and regs (cdar regs))))))
845
846 (defun gnus-ask-server-for-new-groups ()
847   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
848          (methods (cons gnus-select-method
849                         (nconc
850                          (when (gnus-archive-server-wanted-p)
851                            (list "archive"))
852                          (append
853                           (and (consp gnus-check-new-newsgroups)
854                                gnus-check-new-newsgroups)
855                           gnus-secondary-select-methods))))
856          (groups 0)
857          (new-date (current-time-string))
858          group new-newsgroups got-new method hashtb
859          gnus-override-subscribe-method)
860     ;; Go through both primary and secondary select methods and
861     ;; request new newsgroups.
862     (while (setq method (gnus-server-get-method nil (pop methods)))
863       (setq new-newsgroups nil)
864       (setq gnus-override-subscribe-method method)
865       (when (and (gnus-check-server method)
866                  (gnus-request-newgroups date method))
867         (save-excursion
868           (setq got-new t)
869           (setq hashtb (gnus-make-hashtable 100))
870           (set-buffer nntp-server-buffer)
871           ;; Enter all the new groups into a hashtable.
872           (gnus-active-to-gnus-format method hashtb 'ignore))
873         ;; Now all new groups from `method' are in `hashtb'.
874         (mapatoms
875          (lambda (group-sym)
876            (if (or (null (setq group (symbol-name group-sym)))
877                    (not (boundp group-sym))
878                    (null (symbol-value group-sym))
879                    (gnus-gethash group gnus-newsrc-hashtb)
880                    (member group gnus-zombie-list)
881                    (member group gnus-killed-list))
882                ;; The group is already known.
883                ()
884              ;; Make this group active.
885              (when (symbol-value group-sym)
886                (gnus-set-active group (symbol-value group-sym)))
887              ;; Check whether we want it or not.
888              (let ((do-sub (gnus-matches-options-n group)))
889                (cond
890                 ((eq do-sub 'subscribe)
891                  (incf groups)
892                  (gnus-sethash group group gnus-killed-hashtb)
893                  (funcall gnus-subscribe-options-newsgroup-method group))
894                 ((eq do-sub 'ignore)
895                  nil)
896                 (t
897                  (incf groups)
898                  (gnus-sethash group group gnus-killed-hashtb)
899                  (if gnus-subscribe-hierarchical-interactive
900                      (push group new-newsgroups)
901                    (funcall gnus-subscribe-newsgroup-method group)))))))
902          hashtb))
903       (when new-newsgroups
904         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
905     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
906     (when (> groups 0)
907       (gnus-message 6 "%d new newsgroup%s arrived."
908                     groups (if (> groups 1) "s have" " has")))
909     (and got-new (setq gnus-newsrc-last-checked-date new-date))
910     got-new))
911
912 (defun gnus-check-first-time-used ()
913   (if (or (> (length gnus-newsrc-alist) 1)
914           (file-exists-p gnus-startup-file)
915           (file-exists-p (concat gnus-startup-file ".el"))
916           (file-exists-p (concat gnus-startup-file ".eld")))
917       nil
918     (gnus-message 6 "First time user; subscribing you to default groups")
919     (unless (gnus-read-active-file-p)
920       (gnus-read-active-file))
921     (setq gnus-newsrc-last-checked-date (current-time-string))
922     (let ((groups gnus-default-subscribed-newsgroups)
923           group)
924       (if (eq groups t)
925           nil
926         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
927         (mapatoms
928          (lambda (sym)
929            (if (null (setq group (symbol-name sym)))
930                ()
931              (let ((do-sub (gnus-matches-options-n group)))
932                (cond
933                 ((eq do-sub 'subscribe)
934                  (gnus-sethash group group gnus-killed-hashtb)
935                  (funcall gnus-subscribe-options-newsgroup-method group))
936                 ((eq do-sub 'ignore)
937                  nil)
938                 (t
939                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
940          gnus-active-hashtb)
941         (while groups
942           (if (gnus-active (car groups))
943               (gnus-group-change-level
944                (car groups) gnus-level-default-subscribed gnus-level-killed))
945           (setq groups (cdr groups)))
946         (gnus-group-make-help-group)
947         (and gnus-novice-user
948              (gnus-message 7 "`A k' to list killed groups"))))))
949
950 (defun gnus-subscribe-group (group previous &optional method)
951   (gnus-group-change-level
952    (if method
953        (list t group gnus-level-default-subscribed nil nil method)
954      group)
955    gnus-level-default-subscribed gnus-level-killed previous t))
956
957 ;; `gnus-group-change-level' is the fundamental function for changing
958 ;; subscription levels of newsgroups.  This might mean just changing
959 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
960 ;; again, which subscribes/unsubscribes a group, which is equally
961 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
962 ;; from 8-9 to 1-7 means that you remove the group from the list of
963 ;; killed (or zombie) groups and add them to the (kinda) subscribed
964 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
965 ;; which is trivial.
966 ;; ENTRY can either be a string (newsgroup name) or a list (if
967 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
968 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
969 ;; entries.
970 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
971 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
972 ;; after.
973 (defun gnus-group-change-level (entry level &optional oldlevel
974                                       previous fromkilled)
975   (let (group info active num)
976     ;; Glean what info we can from the arguments
977     (if (consp entry)
978         (if fromkilled (setq group (nth 1 entry))
979           (setq group (car (nth 2 entry))))
980       (setq group entry))
981     (if (and (stringp entry)
982              oldlevel
983              (< oldlevel gnus-level-zombie))
984         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
985     (if (and (not oldlevel)
986              (consp entry))
987         (setq oldlevel (gnus-info-level (nth 2 entry)))
988       (setq oldlevel (or oldlevel 9)))
989     (if (stringp previous)
990         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
991
992     (if (and (>= oldlevel gnus-level-zombie)
993              (gnus-gethash group gnus-newsrc-hashtb))
994         ;; We are trying to subscribe a group that is already
995         ;; subscribed.
996         ()                              ; Do nothing.
997
998       (or (gnus-ephemeral-group-p group)
999           (gnus-dribble-enter
1000            (format "(gnus-group-change-level %S %S %S %S %S)"
1001                    group level oldlevel (car (nth 2 previous)) fromkilled)))
1002
1003       ;; Then we remove the newgroup from any old structures, if needed.
1004       ;; If the group was killed, we remove it from the killed or zombie
1005       ;; list.  If not, and it is in fact going to be killed, we remove
1006       ;; it from the newsrc hash table and assoc.
1007       (cond
1008        ((>= oldlevel gnus-level-zombie)
1009         (if (= oldlevel gnus-level-zombie)
1010             (setq gnus-zombie-list (delete group gnus-zombie-list))
1011           (setq gnus-killed-list (delete group gnus-killed-list))))
1012        (t
1013         (if (and (>= level gnus-level-zombie)
1014                  entry)
1015             (progn
1016               (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
1017               (if (nth 3 entry)
1018                   (setcdr (gnus-gethash (car (nth 3 entry))
1019                                         gnus-newsrc-hashtb)
1020                           (cdr entry)))
1021               (setcdr (cdr entry) (cdddr entry))))))
1022
1023       ;; Finally we enter (if needed) the list where it is supposed to
1024       ;; go, and change the subscription level.  If it is to be killed,
1025       ;; we enter it into the killed or zombie list.
1026       (cond 
1027        ((>= level gnus-level-zombie)
1028         ;; Remove from the hash table.
1029         (gnus-sethash group nil gnus-newsrc-hashtb)
1030         ;; We do not enter foreign groups into the list of dead
1031         ;; groups.
1032         (unless (gnus-group-foreign-p group)
1033           (if (= level gnus-level-zombie)
1034               (setq gnus-zombie-list (cons group gnus-zombie-list))
1035             (setq gnus-killed-list (cons group gnus-killed-list)))))
1036        (t
1037         ;; If the list is to be entered into the newsrc assoc, and
1038         ;; it was killed, we have to create an entry in the newsrc
1039         ;; hashtb format and fix the pointers in the newsrc assoc.
1040         (if (< oldlevel gnus-level-zombie)
1041             ;; It was alive, and it is going to stay alive, so we
1042             ;; just change the level and don't change any pointers or
1043             ;; hash table entries.
1044             (setcar (cdaddr entry) level)
1045           (if (listp entry)
1046               (setq info (cdr entry)
1047                     num (car entry))
1048             (setq active (gnus-active group))
1049             (setq num
1050                   (if active (- (1+ (cdr active)) (car active)) t))
1051             ;; Check whether the group is foreign.  If so, the
1052             ;; foreign select method has to be entered into the
1053             ;; info.
1054             (let ((method (or gnus-override-subscribe-method
1055                               (gnus-group-method group))))
1056               (if (eq method gnus-select-method)
1057                   (setq info (list group level nil))
1058                 (setq info (list group level nil nil method)))))
1059           (unless previous
1060             (setq previous
1061                   (let ((p gnus-newsrc-alist))
1062                     (while (cddr p)
1063                       (setq p (cdr p)))
1064                     p)))
1065           (setq entry (cons info (cddr previous)))
1066           (if (cdr previous)
1067               (progn
1068                 (setcdr (cdr previous) entry)
1069                 (gnus-sethash group (cons num (cdr previous))
1070                               gnus-newsrc-hashtb))
1071             (setcdr previous entry)
1072             (gnus-sethash group (cons num previous)
1073                           gnus-newsrc-hashtb))
1074           (when (cdr entry)
1075             (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)))))
1076       (when gnus-group-change-level-function
1077         (funcall gnus-group-change-level-function group level oldlevel)))))
1078
1079 (defun gnus-kill-newsgroup (newsgroup)
1080   "Obsolete function.  Kills a newsgroup."
1081   (gnus-group-change-level
1082    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
1083
1084 (defun gnus-check-bogus-newsgroups (&optional confirm)
1085   "Remove bogus newsgroups.
1086 If CONFIRM is non-nil, the user has to confirm the deletion of every
1087 newsgroup."
1088   (let ((newsrc (cdr gnus-newsrc-alist))
1089         bogus group entry info)
1090     (gnus-message 5 "Checking bogus newsgroups...")
1091     (unless (gnus-read-active-file-p)
1092       (gnus-read-active-file))
1093     (when (gnus-read-active-file-p)
1094       ;; Find all bogus newsgroup that are subscribed.
1095       (while newsrc
1096         (setq info (pop newsrc)
1097               group (gnus-info-group info))
1098         (unless (or (gnus-active group) ; Active
1099                     (gnus-info-method info) ; Foreign
1100                     (and confirm
1101                          (not (gnus-y-or-n-p
1102                                (format "Remove bogus newsgroup: %s " group)))))
1103           ;; Found a bogus newsgroup.
1104           (push group bogus)))
1105       ;; Remove all bogus subscribed groups by first killing them, and
1106       ;; then removing them from the list of killed groups.
1107       (while bogus
1108         (when (setq entry (gnus-gethash (setq group (pop bogus))
1109                                         gnus-newsrc-hashtb))
1110           (gnus-group-change-level entry gnus-level-killed)
1111           (setq gnus-killed-list (delete group gnus-killed-list))))
1112       ;; Then we remove all bogus groups from the list of killed and
1113       ;; zombie groups.  They are removed without confirmation.
1114       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
1115             killed)
1116         (while dead-lists
1117           (setq killed (symbol-value (car dead-lists)))
1118           (while killed
1119             (unless (gnus-active (setq group (pop killed)))
1120               ;; The group is bogus.
1121               ;; !!!Slow as hell.
1122               (set (car dead-lists)
1123                    (delete group (symbol-value (car dead-lists))))))
1124           (setq dead-lists (cdr dead-lists))))
1125       (run-hooks 'gnus-check-bogus-groups-hook)
1126       (gnus-message 5 "Checking bogus newsgroups...done"))))
1127
1128 (defun gnus-check-duplicate-killed-groups ()
1129   "Remove duplicates from the list of killed groups."
1130   (interactive)
1131   (let ((killed gnus-killed-list))
1132     (while killed
1133       (gnus-message 9 "%d" (length killed))
1134       (setcdr killed (delete (car killed) (cdr killed)))
1135       (setq killed (cdr killed)))))
1136
1137 ;; We want to inline a function from gnus-cache, so we cheat here:
1138 (eval-when-compile
1139   (defvar gnus-cache-active-hashtb)
1140   (defun gnus-cache-possibly-alter-active (group active)
1141     "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
1142     (when gnus-cache-active-hashtb
1143       (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
1144         (and cache-active 
1145              (< (car cache-active) (car active))
1146              (setcar active (car cache-active)))
1147         (and cache-active
1148              (> (cdr cache-active) (cdr active))
1149              (setcdr active (cdr cache-active)))))))
1150
1151 (defun gnus-get-unread-articles-in-group (info active &optional update)
1152   (when active
1153     ;; Allow the backend to update the info in the group.
1154     (when (and update 
1155                (gnus-request-update-info
1156                 info (gnus-find-method-for-group (gnus-info-group info))))
1157       (gnus-activate-group (gnus-info-group info) nil t))
1158     (let* ((range (gnus-info-read info))
1159            (num 0))
1160       ;; If a cache is present, we may have to alter the active info.
1161       (when (and gnus-use-cache info)
1162         (inline (gnus-cache-possibly-alter-active 
1163                  (gnus-info-group info) active)))
1164       ;; Modify the list of read articles according to what articles
1165       ;; are available; then tally the unread articles and add the
1166       ;; number to the group hash table entry.
1167       (cond
1168        ((zerop (cdr active))
1169         (setq num 0))
1170        ((not range)
1171         (setq num (- (1+ (cdr active)) (car active))))
1172        ((not (listp (cdr range)))
1173         ;; Fix a single (num . num) range according to the
1174         ;; active hash table.
1175         ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
1176         (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
1177         (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
1178         ;; Compute number of unread articles.
1179         (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
1180        (t
1181         ;; The read list is a list of ranges.  Fix them according to
1182         ;; the active hash table.
1183         ;; First peel off any elements that are below the lower
1184         ;; active limit.
1185         (while (and (cdr range)
1186                     (>= (car active)
1187                         (or (and (atom (cadr range)) (cadr range))
1188                             (caadr range))))
1189           (if (numberp (car range))
1190               (setcar range
1191                       (cons (car range)
1192                             (or (and (numberp (cadr range))
1193                                      (cadr range))
1194                                 (cdadr range))))
1195             (setcdr (car range)
1196                     (or (and (numberp (nth 1 range)) (nth 1 range))
1197                         (cdadr range))))
1198           (setcdr range (cddr range)))
1199         ;; Adjust the first element to be the same as the lower limit.
1200         (if (and (not (atom (car range)))
1201                  (< (cdar range) (car active)))
1202             (setcdr (car range) (1- (car active))))
1203         ;; Then we want to peel off any elements that are higher
1204         ;; than the upper active limit.
1205         (let ((srange range))
1206           ;; Go past all legal elements.
1207           (while (and (cdr srange)
1208                       (<= (or (and (atom (cadr srange))
1209                                    (cadr srange))
1210                               (caadr srange)) (cdr active)))
1211             (setq srange (cdr srange)))
1212           (if (cdr srange)
1213               ;; Nuke all remaining illegal elements.
1214               (setcdr srange nil))
1215
1216           ;; Adjust the final element.
1217           (if (and (not (atom (car srange)))
1218                    (> (cdar srange) (cdr active)))
1219               (setcdr (car srange) (cdr active))))
1220         ;; Compute the number of unread articles.
1221         (while range
1222           (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
1223                                       (cdar range)))
1224                               (or (and (atom (car range)) (car range))
1225                                   (caar range)))))
1226           (setq range (cdr range)))
1227         (setq num (max 0 (- (cdr active) num)))))
1228       ;; Set the number of unread articles.
1229       (when info
1230         (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
1231       num)))
1232
1233 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
1234 ;; and compute how many unread articles there are in each group.
1235 (defun gnus-get-unread-articles (&optional level)
1236   (let* ((newsrc (cdr gnus-newsrc-alist))
1237          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
1238          (foreign-level
1239           (min
1240            (cond ((and gnus-activate-foreign-newsgroups
1241                        (not (numberp gnus-activate-foreign-newsgroups)))
1242                   (1+ gnus-level-subscribed))
1243                  ((numberp gnus-activate-foreign-newsgroups)
1244                   gnus-activate-foreign-newsgroups)
1245                  (t 0))
1246            level))
1247          info group active method)
1248     (gnus-message 5 "Checking new news...")
1249
1250     (while newsrc
1251       (setq active (gnus-active (setq group (gnus-info-group
1252                                              (setq info (pop newsrc))))))
1253
1254       ;; Check newsgroups.  If the user doesn't want to check them, or
1255       ;; they can't be checked (for instance, if the news server can't
1256       ;; be reached) we just set the number of unread articles in this
1257       ;; newsgroup to t.  This means that Gnus thinks that there are
1258       ;; unread articles, but it has no idea how many.
1259       (if (and (setq method (gnus-info-method info))
1260                (not (gnus-server-equal
1261                      gnus-select-method
1262                      (setq method (gnus-server-get-method nil method))))
1263                (not (gnus-secondary-method-p method)))
1264           ;; These groups are foreign.  Check the level.
1265           (when (<= (gnus-info-level info) foreign-level)
1266             (setq active (gnus-activate-group group 'scan))
1267             (unless (inline (gnus-virtual-group-p group))
1268               (inline (gnus-close-group group)))
1269             (when (fboundp (intern (concat (symbol-name (car method))
1270                                            "-request-update-info")))
1271               (inline (gnus-request-update-info info method))))
1272         ;; These groups are native or secondary.
1273         (when (and (<= (gnus-info-level info) level)
1274                    (not gnus-read-active-file))
1275           (setq active (gnus-activate-group group 'scan))
1276           (inline (gnus-close-group group))))
1277
1278       ;; Get the number of unread articles in the group.
1279       (if active
1280           (inline (gnus-get-unread-articles-in-group info active))
1281         ;; The group couldn't be reached, so we nix out the number of
1282         ;; unread articles and stuff.
1283         (gnus-set-active group nil)
1284         (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
1285
1286     (gnus-message 5 "Checking new news...done")))
1287
1288 ;; Create a hash table out of the newsrc alist.  The `car's of the
1289 ;; alist elements are used as keys.
1290 (defun gnus-make-hashtable-from-newsrc-alist ()
1291   (let ((alist gnus-newsrc-alist)
1292         (ohashtb gnus-newsrc-hashtb)
1293         prev)
1294     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
1295     (setq alist
1296           (setq prev (setq gnus-newsrc-alist
1297                            (if (equal (caar gnus-newsrc-alist)
1298                                       "dummy.group")
1299                                gnus-newsrc-alist
1300                              (cons (list "dummy.group" 0 nil) alist)))))
1301     (while alist
1302       (gnus-sethash
1303        (caar alist)
1304        (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
1305              prev)
1306        gnus-newsrc-hashtb)
1307       (setq prev alist
1308             alist (cdr alist)))))
1309
1310 (defun gnus-make-hashtable-from-killed ()
1311   "Create a hash table from the killed and zombie lists."
1312   (let ((lists '(gnus-killed-list gnus-zombie-list))
1313         list)
1314     (setq gnus-killed-hashtb
1315           (gnus-make-hashtable
1316            (+ (length gnus-killed-list) (length gnus-zombie-list))))
1317     (while (setq list (pop lists))
1318       (setq list (symbol-value list))
1319       (while list
1320         (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
1321
1322 (defun gnus-activate-group (group &optional scan dont-check method)
1323   ;; Check whether a group has been activated or not.
1324   ;; If SCAN, request a scan of that group as well.
1325   (let ((method (or method (gnus-find-method-for-group group)))
1326         active)
1327     (and (gnus-check-server method)
1328          ;; We escape all bugs and quit here to make it possible to
1329          ;; continue if a group is so out-there that it reports bugs
1330          ;; and stuff.
1331          (progn
1332            (and scan
1333                 (gnus-check-backend-function 'request-scan (car method))
1334                 (gnus-request-scan group method))
1335            t)
1336          (condition-case ()
1337              (gnus-request-group group dont-check method)
1338         ;   (error nil)
1339            (quit nil))
1340          (save-excursion
1341            (set-buffer nntp-server-buffer)
1342            (goto-char (point-min))
1343            ;; Parse the result we got from `gnus-request-group'.
1344            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
1345                 (progn
1346                   (goto-char (match-beginning 1))
1347                   (gnus-set-active
1348                    group (setq active (cons (read (current-buffer))
1349                                             (read (current-buffer)))))
1350                   ;; Return the new active info.
1351                   active))))))
1352
1353 (defun gnus-update-read-articles (group unread)
1354   "Update the list of read and ticked articles in GROUP using the
1355 UNREAD and TICKED lists.
1356 Note: UNSELECTED has to be sorted over `<'.
1357 Returns whether the updating was successful."
1358   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
1359          (entry (gnus-gethash group gnus-newsrc-hashtb))
1360          (info (nth 2 entry))
1361          (prev 1)
1362          (unread (sort (copy-sequence unread) '<))
1363          read)
1364     (if (or (not info) (not active))
1365         ;; There is no info on this group if it was, in fact,
1366         ;; killed.  Gnus stores no information on killed groups, so
1367         ;; there's nothing to be done.
1368         ;; One could store the information somewhere temporarily,
1369         ;; perhaps...  Hmmm...
1370         ()
1371       ;; Remove any negative articles numbers.
1372       (while (and unread (< (car unread) 0))
1373         (setq unread (cdr unread)))
1374       ;; Remove any expired article numbers
1375       (while (and unread (< (car unread) (car active)))
1376         (setq unread (cdr unread)))
1377       ;; Compute the ranges of read articles by looking at the list of
1378       ;; unread articles.
1379       (while unread
1380         (if (/= (car unread) prev)
1381             (setq read (cons (if (= prev (1- (car unread))) prev
1382                                (cons prev (1- (car unread)))) read)))
1383         (setq prev (1+ (car unread)))
1384         (setq unread (cdr unread)))
1385       (when (<= prev (cdr active))
1386         (setq read (cons (cons prev (cdr active)) read)))
1387       ;; Enter this list into the group info.
1388       (gnus-info-set-read
1389        info (if (> (length read) 1) (nreverse read) read))
1390       ;; Set the number of unread articles in gnus-newsrc-hashtb.
1391       (gnus-get-unread-articles-in-group info (gnus-active group))
1392       t)))
1393
1394 (defun gnus-make-articles-unread (group articles)
1395   "Mark ARTICLES in GROUP as unread."
1396   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
1397                           (gnus-gethash (gnus-group-real-name group)
1398                                         gnus-newsrc-hashtb))))
1399          (ranges (gnus-info-read info))
1400          news article)
1401     (while articles
1402       (when (gnus-member-of-range
1403              (setq article (pop articles)) ranges)
1404         (setq news (cons article news))))
1405     (when news
1406       (gnus-info-set-read
1407        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
1408       (gnus-group-update-group group t))))
1409
1410 ;; Enter all dead groups into the hashtb.
1411 (defun gnus-update-active-hashtb-from-killed ()
1412   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
1413         (lists (list gnus-killed-list gnus-zombie-list))
1414         killed)
1415     (while lists
1416       (setq killed (car lists))
1417       (while killed
1418         (gnus-sethash (car killed) nil hashtb)
1419         (setq killed (cdr killed)))
1420       (setq lists (cdr lists)))))
1421
1422 (defun gnus-get-killed-groups ()
1423   "Go through the active hashtb and mark all unknown groups as killed."
1424   ;; First make sure active file has been read.
1425   (unless (gnus-read-active-file-p)
1426     (let ((gnus-read-active-file t))
1427       (gnus-read-active-file)))
1428   (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
1429   ;; Go through all newsgroups that are known to Gnus - enlarge kill list.
1430   (mapatoms
1431    (lambda (sym)
1432      (let ((groups 0)
1433            (group (symbol-name sym)))
1434        (if (or (null group)
1435                (gnus-gethash group gnus-killed-hashtb)
1436                (gnus-gethash group gnus-newsrc-hashtb))
1437            ()
1438          (let ((do-sub (gnus-matches-options-n group)))
1439            (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
1440                ()
1441              (setq groups (1+ groups))
1442              (setq gnus-killed-list
1443                    (cons group gnus-killed-list))
1444              (gnus-sethash group group gnus-killed-hashtb))))))
1445    gnus-active-hashtb))
1446
1447 ;; Get the active file(s) from the backend(s).
1448 (defun gnus-read-active-file ()
1449   (gnus-group-set-mode-line)
1450   (let ((methods 
1451          (append
1452           (if (gnus-check-server gnus-select-method)
1453               ;; The native server is available.
1454               (cons gnus-select-method gnus-secondary-select-methods)
1455             ;; The native server is down, so we just do the
1456             ;; secondary ones.
1457             gnus-secondary-select-methods)
1458           ;; Also read from the archive server.
1459           (when (gnus-archive-server-wanted-p)
1460             (list "archive"))))
1461         list-type)
1462     (setq gnus-have-read-active-file nil)
1463     (save-excursion
1464       (set-buffer nntp-server-buffer)
1465       (while methods
1466         (let* ((method (if (stringp (car methods))
1467                            (gnus-server-get-method nil (car methods))
1468                          (car methods)))
1469                (where (nth 1 method))
1470                (mesg (format "Reading active file%s via %s..."
1471                              (if (and where (not (zerop (length where))))
1472                                  (concat " from " where) "")
1473                              (car method))))
1474           (gnus-message 5 mesg)
1475           (when (gnus-check-server method)
1476             ;; Request that the backend scan its incoming messages.
1477             (and (gnus-check-backend-function 'request-scan (car method))
1478                  (gnus-request-scan nil method))
1479             (cond
1480              ((and (eq gnus-read-active-file 'some)
1481                    (gnus-check-backend-function 'retrieve-groups (car method)))
1482               (let ((newsrc (cdr gnus-newsrc-alist))
1483                     (gmethod (gnus-server-get-method nil method))
1484                     groups info)
1485                 (while (setq info (pop newsrc))
1486                   (when (gnus-server-equal
1487                          (gnus-find-method-for-group 
1488                           (gnus-info-group info) info)
1489                          gmethod)
1490                     (push (gnus-group-real-name (gnus-info-group info)) 
1491                           groups)))
1492                 (when groups
1493                   (gnus-check-server method)
1494                   (setq list-type (gnus-retrieve-groups groups method))
1495                   (cond
1496                    ((not list-type)
1497                     (gnus-error
1498                      1.2 "Cannot read partial active file from %s server."
1499                      (car method)))
1500                    ((eq list-type 'active)
1501                     (gnus-active-to-gnus-format method gnus-active-hashtb))
1502                    (t
1503                     (gnus-groups-to-gnus-format method gnus-active-hashtb))))))
1504              (t
1505               (if (not (gnus-request-list method))
1506                   (unless (equal method gnus-message-archive-method)
1507                     (gnus-error 1 "Cannot read active file from %s server."
1508                                 (car method)))
1509                 (gnus-message 5 mesg)
1510                 (gnus-active-to-gnus-format method gnus-active-hashtb)
1511                 ;; We mark this active file as read.
1512                 (push method gnus-have-read-active-file)
1513                 (gnus-message 5 "%sdone" mesg))))))
1514         (setq methods (cdr methods))))))
1515
1516 ;; Read an active file and place the results in `gnus-active-hashtb'.
1517 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
1518   (unless method
1519     (setq method gnus-select-method))
1520   (let ((cur (current-buffer))
1521         (hashtb (or hashtb
1522                     (if (and gnus-active-hashtb
1523                              (not (equal method gnus-select-method)))
1524                         gnus-active-hashtb
1525                       (setq gnus-active-hashtb
1526                             (if (equal method gnus-select-method)
1527                                 (gnus-make-hashtable
1528                                  (count-lines (point-min) (point-max)))
1529                               (gnus-make-hashtable 4096)))))))
1530     ;; Delete unnecessary lines.
1531     (goto-char (point-min))
1532     (while (search-forward "\nto." nil t)
1533       (delete-region (1+ (match-beginning 0))
1534                      (progn (forward-line 1) (point))))
1535     (or (string= gnus-ignored-newsgroups "")
1536         (progn
1537           (goto-char (point-min))
1538           (delete-matching-lines gnus-ignored-newsgroups)))
1539     ;; Make the group names readable as a lisp expression even if they
1540     ;; contain special characters.
1541     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
1542     (goto-char (point-max))
1543     (while (re-search-backward "[][';?()#]" nil t)
1544       (insert ?\\))
1545     ;; If these are groups from a foreign select method, we insert the
1546     ;; group prefix in front of the group names.
1547     (and method (not (gnus-server-equal
1548                       (gnus-server-get-method nil method)
1549                       (gnus-server-get-method nil gnus-select-method)))
1550          (let ((prefix (gnus-group-prefixed-name "" method)))
1551            (goto-char (point-min))
1552            (while (and (not (eobp))
1553                        (progn (insert prefix)
1554                               (zerop (forward-line 1)))))))
1555     ;; Store the active file in a hash table.
1556     (goto-char (point-min))
1557     (if (string-match "%[oO]" gnus-group-line-format)
1558         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
1559         ;; If we want information on moderated groups, we use this
1560         ;; loop...
1561         (let* ((mod-hashtb (make-vector 7 0))
1562                (m (intern "m" mod-hashtb))
1563                group max min)
1564           (while (not (eobp))
1565             (condition-case nil
1566                 (progn
1567                   (narrow-to-region (point) (gnus-point-at-eol))
1568                   (setq group (let ((obarray hashtb)) (read cur)))
1569                   (if (and (numberp (setq max (read cur)))
1570                            (numberp (setq min (read cur)))
1571                            (progn
1572                              (skip-chars-forward " \t")
1573                              (not
1574                               (or (= (following-char) ?=)
1575                                   (= (following-char) ?x)
1576                                   (= (following-char) ?j)))))
1577                       (set group (cons min max))
1578                     (set group nil))
1579                   ;; Enter moderated groups into a list.
1580                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
1581                       (setq gnus-moderated-list
1582                             (cons (symbol-name group) gnus-moderated-list))))
1583               (error
1584                (and group
1585                     (symbolp group)
1586                     (set group nil))))
1587             (widen)
1588             (forward-line 1)))
1589       ;; And if we do not care about moderation, we use this loop,
1590       ;; which is faster.
1591       (let (group max min)
1592         (while (not (eobp))
1593           (condition-case ()
1594               (progn
1595                 (narrow-to-region (point) (gnus-point-at-eol))
1596                 ;; group gets set to a symbol interned in the hash table
1597                 ;; (what a hack!!) - jwz
1598                 (setq group (let ((obarray hashtb)) (read cur)))
1599                 (if (and (numberp (setq max (read cur)))
1600                          (numberp (setq min (read cur)))
1601                          (progn
1602                            (skip-chars-forward " \t")
1603                            (not
1604                             (or (= (following-char) ?=)
1605                                 (= (following-char) ?x)
1606                                 (= (following-char) ?j)))))
1607                     (set group (cons min max))
1608                   (set group nil)))
1609             (error
1610              (progn
1611                (and group
1612                     (symbolp group)
1613                     (set group nil))
1614                (or ignore-errors
1615                    (gnus-message 3 "Warning - illegal active: %s"
1616                                  (buffer-substring
1617                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
1618           (widen)
1619           (forward-line 1))))))
1620
1621 (defun gnus-groups-to-gnus-format (method &optional hashtb)
1622   ;; Parse a "groups" active file.
1623   (let ((cur (current-buffer))
1624         (hashtb (or hashtb
1625                     (if (and method gnus-active-hashtb)
1626                         gnus-active-hashtb
1627                       (setq gnus-active-hashtb
1628                             (gnus-make-hashtable
1629                              (count-lines (point-min) (point-max)))))))
1630         (prefix (and method
1631                      (not (gnus-server-equal
1632                            (gnus-server-get-method nil method)
1633                            (gnus-server-get-method nil gnus-select-method)))
1634                      (gnus-group-prefixed-name "" method))))
1635
1636     (goto-char (point-min))
1637     ;; We split this into to separate loops, one with the prefix
1638     ;; and one without to speed the reading up somewhat.
1639     (if prefix
1640         (let (min max opoint group)
1641           (while (not (eobp))
1642             (condition-case ()
1643                 (progn
1644                   (read cur) (read cur)
1645                   (setq min (read cur)
1646                         max (read cur)
1647                         opoint (point))
1648                   (skip-chars-forward " \t")
1649                   (insert prefix)
1650                   (goto-char opoint)
1651                   (set (let ((obarray hashtb)) (read cur))
1652                        (cons min max)))
1653               (error (and group (symbolp group) (set group nil))))
1654             (forward-line 1)))
1655       (let (min max group)
1656         (while (not (eobp))
1657           (condition-case ()
1658               (if (= (following-char) ?2)
1659                   (progn
1660                     (read cur) (read cur)
1661                     (setq min (read cur)
1662                           max (read cur))
1663                     (set (setq group (let ((obarray hashtb)) (read cur)))
1664                          (cons min max))))
1665             (error (and group (symbolp group) (set group nil))))
1666           (forward-line 1))))))
1667
1668 (defun gnus-read-newsrc-file (&optional force)
1669   "Read startup file.
1670 If FORCE is non-nil, the .newsrc file is read."
1671   ;; Reset variables that might be defined in the .newsrc.eld file.
1672   (let ((variables gnus-variable-list))
1673     (while variables
1674       (set (car variables) nil)
1675       (setq variables (cdr variables))))
1676   (let* ((newsrc-file gnus-current-startup-file)
1677          (quick-file (concat newsrc-file ".el")))
1678     (save-excursion
1679       ;; We always load the .newsrc.eld file.  If always contains
1680       ;; much information that can not be gotten from the .newsrc
1681       ;; file (ticked articles, killed groups, foreign methods, etc.)
1682       (gnus-read-newsrc-el-file quick-file)
1683
1684       (if (and (file-exists-p gnus-current-startup-file)
1685                (or force
1686                    (and (file-newer-than-file-p newsrc-file quick-file)
1687                         (file-newer-than-file-p newsrc-file
1688                                                 (concat quick-file "d")))
1689                    (not gnus-newsrc-alist)))
1690           ;; We read the .newsrc file.  Note that if there if a
1691           ;; .newsrc.eld file exists, it has already been read, and
1692           ;; the `gnus-newsrc-hashtb' has been created.  While reading
1693           ;; the .newsrc file, Gnus will only use the information it
1694           ;; can find there for changing the data already read -
1695           ;; ie. reading the .newsrc file will not trash the data
1696           ;; already read (except for read articles).
1697           (save-excursion
1698             (gnus-message 5 "Reading %s..." newsrc-file)
1699             (set-buffer (find-file-noselect newsrc-file))
1700             (buffer-disable-undo (current-buffer))
1701             (gnus-newsrc-to-gnus-format)
1702             (kill-buffer (current-buffer))
1703             (gnus-message 5 "Reading %s...done" newsrc-file)))
1704
1705       ;; Read any slave files.
1706       (unless gnus-slave
1707         (gnus-master-read-slave-newsrc))
1708       
1709       ;; Convert old to new.
1710       (gnus-convert-old-newsrc))))
1711
1712 (defun gnus-convert-old-newsrc ()
1713   "Convert old newsrc into the new format, if needed."
1714   (let ((fcv (and gnus-newsrc-file-version
1715                   (gnus-continuum-version gnus-newsrc-file-version))))
1716     (cond
1717      ;; No .newsrc.eld file was loaded.
1718      ((null fcv) nil)
1719      ;; Gnus 5 .newsrc.eld was loaded.
1720      ((< fcv (gnus-continuum-version "September Gnus v0.1"))
1721       (gnus-convert-old-ticks)))))
1722
1723 (defun gnus-convert-old-ticks ()
1724   (let ((newsrc (cdr gnus-newsrc-alist))
1725         marks info dormant ticked)
1726     (while (setq info (pop newsrc))
1727       (when (setq marks (gnus-info-marks info))
1728         (setq dormant (cdr (assq 'dormant marks))
1729               ticked (cdr (assq 'tick marks)))
1730         (when (or dormant ticked)
1731           (gnus-info-set-read
1732            info
1733            (gnus-add-to-range
1734             (gnus-info-read info)
1735             (nconc (gnus-uncompress-range dormant)
1736                    (gnus-uncompress-range ticked)))))))))
1737
1738 (defun gnus-read-newsrc-el-file (file)
1739   (let ((ding-file (concat file "d")))
1740     ;; We always, always read the .eld file.
1741     (gnus-message 5 "Reading %s..." ding-file)
1742     (let (gnus-newsrc-assoc)
1743       (condition-case nil
1744           (load ding-file t t t)
1745         (error
1746          (gnus-error 1 "Error in %s" ding-file)))
1747       (when gnus-newsrc-assoc
1748         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
1749     (gnus-make-hashtable-from-newsrc-alist)
1750     (when (file-newer-than-file-p file ding-file)
1751       ;; Old format quick file
1752       (gnus-message 5 "Reading %s..." file)
1753       ;; The .el file is newer than the .eld file, so we read that one
1754       ;; as well.
1755       (gnus-read-old-newsrc-el-file file))))
1756
1757 ;; Parse the old-style quick startup file
1758 (defun gnus-read-old-newsrc-el-file (file)
1759   (let (newsrc killed marked group m info)
1760     (prog1
1761         (let ((gnus-killed-assoc nil)
1762               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
1763           (prog1
1764               (condition-case nil
1765                   (load file t t t)
1766                 (error nil))
1767             (setq newsrc gnus-newsrc-assoc
1768                   killed gnus-killed-assoc
1769                   marked gnus-marked-assoc)))
1770       (setq gnus-newsrc-alist nil)
1771       (while (setq group (pop newsrc))
1772         (if (setq info (gnus-get-info (car group)))
1773             (progn
1774               (gnus-info-set-read info (cddr group))
1775               (gnus-info-set-level
1776                info (if (nth 1 group) gnus-level-default-subscribed
1777                       gnus-level-default-unsubscribed))
1778               (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
1779           (push (setq info
1780                       (list (car group)
1781                             (if (nth 1 group) gnus-level-default-subscribed
1782                               gnus-level-default-unsubscribed)
1783                             (cddr group)))
1784                 gnus-newsrc-alist))
1785         ;; Copy marks into info.
1786         (when (setq m (assoc (car group) marked))
1787           (unless (nthcdr 3 info)
1788             (nconc info (list nil)))
1789           (gnus-info-set-marks
1790            info (list (cons 'tick (gnus-compress-sequence 
1791                                    (sort (cdr m) '<) t))))))
1792       (setq newsrc killed)
1793       (while newsrc
1794         (setcar newsrc (caar newsrc))
1795         (setq newsrc (cdr newsrc)))
1796       (setq gnus-killed-list killed))
1797     ;; The .el file version of this variable does not begin with
1798     ;; "options", while the .eld version does, so we just add it if it
1799     ;; isn't there.
1800     (and
1801      gnus-newsrc-options
1802      (progn
1803        (and (not (string-match "^ *options" gnus-newsrc-options))
1804             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
1805        (and (not (string-match "\n$" gnus-newsrc-options))
1806             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
1807        ;; Finally, if we read some options lines, we parse them.
1808        (or (string= gnus-newsrc-options "")
1809            (gnus-newsrc-parse-options gnus-newsrc-options))))
1810
1811     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
1812     (gnus-make-hashtable-from-newsrc-alist)))
1813
1814 (defun gnus-make-newsrc-file (file)
1815   "Make server dependent file name by catenating FILE and server host name."
1816   (let* ((file (expand-file-name file nil))
1817          (real-file (concat file "-" (nth 1 gnus-select-method))))
1818     (if (or (file-exists-p real-file)
1819             (file-exists-p (concat real-file ".el"))
1820             (file-exists-p (concat real-file ".eld")))
1821         real-file file)))
1822
1823 (defun gnus-newsrc-to-gnus-format ()
1824   (setq gnus-newsrc-options "")
1825   (setq gnus-newsrc-options-n nil)
1826
1827   (or gnus-active-hashtb
1828       (setq gnus-active-hashtb (make-vector 4095 0)))
1829   (let ((buf (current-buffer))
1830         (already-read (> (length gnus-newsrc-alist) 1))
1831         group subscribed options-symbol newsrc Options-symbol
1832         symbol reads num1)
1833     (goto-char (point-min))
1834     ;; We intern the symbol `options' in the active hashtb so that we
1835     ;; can `eq' against it later.
1836     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
1837     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
1838
1839     (while (not (eobp))
1840       ;; We first read the first word on the line by narrowing and
1841       ;; then reading into `gnus-active-hashtb'.  Most groups will
1842       ;; already exist in that hashtb, so this will save some string
1843       ;; space.
1844       (narrow-to-region
1845        (point)
1846        (progn (skip-chars-forward "^ \t!:\n") (point)))
1847       (goto-char (point-min))
1848       (setq symbol
1849             (and (/= (point-min) (point-max))
1850                  (let ((obarray gnus-active-hashtb)) (read buf))))
1851       (widen)
1852       ;; Now, the symbol we have read is either `options' or a group
1853       ;; name.  If it is an options line, we just add it to a string.
1854       (cond
1855        ((or (eq symbol options-symbol)
1856             (eq symbol Options-symbol))
1857         (setq gnus-newsrc-options
1858               ;; This concating is quite inefficient, but since our
1859               ;; thorough studies show that approx 99.37% of all
1860               ;; .newsrc files only contain a single options line, we
1861               ;; don't give a damn, frankly, my dear.
1862               (concat gnus-newsrc-options
1863                       (buffer-substring
1864                        (gnus-point-at-bol)
1865                        ;; Options may continue on the next line.
1866                        (or (and (re-search-forward "^[^ \t]" nil 'move)
1867                                 (progn (beginning-of-line) (point)))
1868                            (point)))))
1869         (forward-line -1))
1870        (symbol
1871         ;; Group names can be just numbers.  
1872         (when (numberp symbol) 
1873           (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
1874         (or (boundp symbol) (set symbol nil))
1875         ;; It was a group name.
1876         (setq subscribed (= (following-char) ?:)
1877               group (symbol-name symbol)
1878               reads nil)
1879         (if (eolp)
1880             ;; If the line ends here, this is clearly a buggy line, so
1881             ;; we put point a the beginning of line and let the cond
1882             ;; below do the error handling.
1883             (beginning-of-line)
1884           ;; We skip to the beginning of the ranges.
1885           (skip-chars-forward "!: \t"))
1886         ;; We are now at the beginning of the list of read articles.
1887         ;; We read them range by range.
1888         (while
1889             (cond
1890              ((looking-at "[0-9]+")
1891               ;; We narrow and read a number instead of buffer-substring/
1892               ;; string-to-int because it's faster.  narrow/widen is
1893               ;; faster than save-restriction/narrow, and save-restriction
1894               ;; produces a garbage object.
1895               (setq num1 (progn
1896                            (narrow-to-region (match-beginning 0) (match-end 0))
1897                            (read buf)))
1898               (widen)
1899               ;; If the next character is a dash, then this is a range.
1900               (if (= (following-char) ?-)
1901                   (progn
1902                     ;; We read the upper bound of the range.
1903                     (forward-char 1)
1904                     (if (not (looking-at "[0-9]+"))
1905                         ;; This is a buggy line, by we pretend that
1906                         ;; it's kinda OK.  Perhaps the user should be
1907                         ;; dinged?
1908                         (setq reads (cons num1 reads))
1909                       (setq reads
1910                             (cons
1911                              (cons num1
1912                                    (progn
1913                                      (narrow-to-region (match-beginning 0)
1914                                                        (match-end 0))
1915                                      (read buf)))
1916                              reads))
1917                       (widen)))
1918                 ;; It was just a simple number, so we add it to the
1919                 ;; list of ranges.
1920                 (setq reads (cons num1 reads)))
1921               ;; If the next char in ?\n, then we have reached the end
1922               ;; of the line and return nil.
1923               (/= (following-char) ?\n))
1924              ((= (following-char) ?\n)
1925               ;; End of line, so we end.
1926               nil)
1927              (t
1928               ;; Not numbers and not eol, so this might be a buggy
1929               ;; line...
1930               (or (eobp)
1931                   ;; If it was eob instead of ?\n, we allow it.
1932                   (progn
1933                     ;; The line was buggy.
1934                     (setq group nil)
1935                     (gnus-error 3.1 "Mangled line: %s"
1936                                 (buffer-substring (gnus-point-at-bol)
1937                                                   (gnus-point-at-eol)))))
1938               nil))
1939           ;; Skip past ", ".  Spaces are illegal in these ranges, but
1940           ;; we allow them, because it's a common mistake to put a
1941           ;; space after the comma.
1942           (skip-chars-forward ", "))
1943
1944         ;; We have already read .newsrc.eld, so we gently update the
1945         ;; data in the hash table with the information we have just
1946         ;; read.
1947         (when group
1948           (let ((info (gnus-get-info group))
1949                 level)
1950             (if info
1951                 ;; There is an entry for this file in the alist.
1952                 (progn
1953                   (gnus-info-set-read info (nreverse reads))
1954                   ;; We update the level very gently.  In fact, we
1955                   ;; only change it if there's been a status change
1956                   ;; from subscribed to unsubscribed, or vice versa.
1957                   (setq level (gnus-info-level info))
1958                   (cond ((and (<= level gnus-level-subscribed)
1959                               (not subscribed))
1960                          (setq level (if reads
1961                                          gnus-level-default-unsubscribed
1962                                        (1+ gnus-level-default-unsubscribed))))
1963                         ((and (> level gnus-level-subscribed) subscribed)
1964                          (setq level gnus-level-default-subscribed)))
1965                   (gnus-info-set-level info level))
1966               ;; This is a new group.
1967               (setq info (list group
1968                                (if subscribed
1969                                    gnus-level-default-subscribed
1970                                  (if reads
1971                                      (1+ gnus-level-subscribed)
1972                                    gnus-level-default-unsubscribed))
1973                                (nreverse reads))))
1974             (setq newsrc (cons info newsrc))))))
1975       (forward-line 1))
1976
1977     (setq newsrc (nreverse newsrc))
1978
1979     (if (not already-read)
1980         ()
1981       ;; We now have two newsrc lists - `newsrc', which is what we
1982       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
1983       ;; what we've read from .newsrc.eld.  We have to merge these
1984       ;; lists.  We do this by "attaching" any (foreign) groups in the
1985       ;; gnus-newsrc-alist to the (native) group that precedes them.
1986       (let ((rc (cdr gnus-newsrc-alist))
1987             (prev gnus-newsrc-alist)
1988             entry mentry)
1989         (while rc
1990           (or (null (nth 4 (car rc)))   ; It's a native group.
1991               (assoc (caar rc) newsrc) ; It's already in the alist.
1992               (if (setq entry (assoc (caar prev) newsrc))
1993                   (setcdr (setq mentry (memq entry newsrc))
1994                           (cons (car rc) (cdr mentry)))
1995                 (setq newsrc (cons (car rc) newsrc))))
1996           (setq prev rc
1997                 rc (cdr rc)))))
1998
1999     (setq gnus-newsrc-alist newsrc)
2000     ;; We make the newsrc hashtb.
2001     (gnus-make-hashtable-from-newsrc-alist)
2002
2003     ;; Finally, if we read some options lines, we parse them.
2004     (or (string= gnus-newsrc-options "")
2005         (gnus-newsrc-parse-options gnus-newsrc-options))))
2006
2007 ;; Parse options lines to find "options -n !all rec.all" and stuff.
2008 ;; The return value will be a list on the form
2009 ;; ((regexp1 . ignore)
2010 ;;  (regexp2 . subscribe)...)
2011 ;; When handling new newsgroups, groups that match a `ignore' regexp
2012 ;; will be ignored, and groups that match a `subscribe' regexp will be
2013 ;; subscribed.  A line like
2014 ;; options -n !all rec.all
2015 ;; will lead to a list that looks like
2016 ;; (("^rec\\..+" . subscribe)
2017 ;;  ("^.+" . ignore))
2018 ;; So all "rec.*" groups will be subscribed, while all the other
2019 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
2020 ;; different from "options -n rec.all !all".
2021 (defun gnus-newsrc-parse-options (options)
2022   (let (out eol)
2023     (save-excursion
2024       (gnus-set-work-buffer)
2025       (insert (regexp-quote options))
2026       ;; First we treat all continuation lines.
2027       (goto-char (point-min))
2028       (while (re-search-forward "\n[ \t]+" nil t)
2029         (replace-match " " t t))
2030       ;; Then we transform all "all"s into ".+"s.
2031       (goto-char (point-min))
2032       (while (re-search-forward "\\ball\\b" nil t)
2033         (replace-match ".+" t t))
2034       (goto-char (point-min))
2035       ;; We remove all other options than the "-n" ones.
2036       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
2037         (replace-match " ")
2038         (forward-char -1))
2039       (goto-char (point-min))
2040
2041       ;; We are only interested in "options -n" lines - we
2042       ;; ignore the other option lines.
2043       (while (re-search-forward "[ \t]-n" nil t)
2044         (setq eol
2045               (or (save-excursion
2046                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
2047                          (- (point) 2)))
2048                   (gnus-point-at-eol)))
2049         ;; Search for all "words"...
2050         (while (re-search-forward "[^ \t,\n]+" eol t)
2051           (if (= (char-after (match-beginning 0)) ?!)
2052               ;; If the word begins with a bang (!), this is a "not"
2053               ;; spec.  We put this spec (minus the bang) and the
2054               ;; symbol `ignore' into the list.
2055               (setq out (cons (cons (concat
2056                                      "^" (buffer-substring
2057                                           (1+ (match-beginning 0))
2058                                           (match-end 0)))
2059                                     'ignore) out))
2060             ;; There was no bang, so this is a "yes" spec.
2061             (setq out (cons (cons (concat "^" (match-string 0))
2062                                   'subscribe) out)))))
2063
2064       (setq gnus-newsrc-options-n out))))
2065
2066 (defun gnus-save-newsrc-file (&optional force)
2067   "Save .newsrc file."
2068   ;; Note: We cannot save .newsrc file if all newsgroups are removed
2069   ;; from the variable gnus-newsrc-alist.
2070   (when (and (or gnus-newsrc-alist gnus-killed-list)
2071              gnus-current-startup-file)
2072     (save-excursion
2073       (if (and (or gnus-use-dribble-file gnus-slave)
2074                (not force)
2075                (or (not gnus-dribble-buffer)
2076                    (not (buffer-name gnus-dribble-buffer))
2077                    (zerop (save-excursion
2078                             (set-buffer gnus-dribble-buffer)
2079                             (buffer-size)))))
2080           (gnus-message 4 "(No changes need to be saved)")
2081         (run-hooks 'gnus-save-newsrc-hook)
2082         (if gnus-slave
2083             (gnus-slave-save-newsrc)
2084           ;; Save .newsrc.
2085           (when gnus-save-newsrc-file
2086             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
2087             (gnus-gnus-to-newsrc-format)
2088             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
2089           ;; Save .newsrc.eld.
2090           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
2091           (make-local-variable 'version-control)
2092           (setq version-control 'never)
2093           (setq buffer-file-name
2094                 (concat gnus-current-startup-file ".eld"))
2095           (setq default-directory (file-name-directory buffer-file-name))
2096           (gnus-add-current-to-buffer-list)
2097           (buffer-disable-undo (current-buffer))
2098           (erase-buffer)
2099           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
2100           (gnus-gnus-to-quick-newsrc-format)
2101           (run-hooks 'gnus-save-quick-newsrc-hook)
2102           (save-buffer)
2103           (kill-buffer (current-buffer))
2104           (gnus-message
2105            5 "Saving %s.eld...done" gnus-current-startup-file))
2106         (gnus-dribble-delete-file)
2107         (gnus-group-set-mode-line)))))
2108
2109 (defun gnus-gnus-to-quick-newsrc-format ()
2110   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
2111   (insert ";; Gnus startup file.\n")
2112   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
2113   (insert ";; to read .newsrc.\n")
2114   (insert "(setq gnus-newsrc-file-version "
2115           (prin1-to-string gnus-version) ")\n")
2116   (let ((variables
2117          (if gnus-save-killed-list gnus-variable-list
2118            ;; Remove the `gnus-killed-list' from the list of variables
2119            ;; to be saved, if required.
2120            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
2121         ;; Peel off the "dummy" group.
2122         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
2123         variable)
2124     ;; Insert the variables into the file.
2125     (while variables
2126       (when (and (boundp (setq variable (pop variables)))
2127                  (symbol-value variable))
2128         (insert "(setq " (symbol-name variable) " '")
2129         (prin1 (symbol-value variable) (current-buffer))
2130         (insert ")\n")))))
2131
2132 (defun gnus-gnus-to-newsrc-format ()
2133   ;; Generate and save the .newsrc file.
2134   (save-excursion
2135     (set-buffer (create-file-buffer gnus-current-startup-file))
2136     (let ((newsrc (cdr gnus-newsrc-alist))
2137           (standard-output (current-buffer))
2138           info ranges range method)
2139       (setq buffer-file-name gnus-current-startup-file)
2140       (setq default-directory (file-name-directory buffer-file-name))
2141       (buffer-disable-undo (current-buffer))
2142       (erase-buffer)
2143       ;; Write options.
2144       (if gnus-newsrc-options (insert gnus-newsrc-options))
2145       ;; Write subscribed and unsubscribed.
2146       (while (setq info (pop newsrc))
2147         ;; Don't write foreign groups to .newsrc.
2148         (when (or (null (setq method (gnus-info-method info)))
2149                   (equal method "native")
2150                   (gnus-server-equal method gnus-select-method))
2151           (insert (gnus-info-group info)
2152                   (if (> (gnus-info-level info) gnus-level-subscribed)
2153                       "!" ":"))
2154           (when (setq ranges (gnus-info-read info))
2155             (insert " ")
2156             (if (not (listp (cdr ranges)))
2157                 (if (= (car ranges) (cdr ranges))
2158                     (princ (car ranges))
2159                   (princ (car ranges))
2160                   (insert "-")
2161                   (princ (cdr ranges)))
2162               (while (setq range (pop ranges))
2163                 (if (or (atom range) (= (car range) (cdr range)))
2164                     (princ (or (and (atom range) range) (car range)))
2165                   (princ (car range))
2166                   (insert "-")
2167                   (princ (cdr range)))
2168                 (if ranges (insert ",")))))
2169           (insert "\n")))
2170       (make-local-variable 'version-control)
2171       (setq version-control 'never)
2172       ;; It has been reported that sometime the modtime on the .newsrc
2173       ;; file seems to be off.  We really do want to overwrite it, so
2174       ;; we clear the modtime here before saving.  It's a bit odd,
2175       ;; though...
2176       ;; sometimes the modtime clear isn't sufficient.  most brute force:
2177       ;; delete the silly thing entirely first.  but this fails to provide
2178       ;; such niceties as .newsrc~ creation.
2179       (if gnus-modtime-botch
2180           (delete-file gnus-startup-file)
2181         (clear-visited-file-modtime))
2182       (run-hooks 'gnus-save-standard-newsrc-hook)
2183       (save-buffer)
2184       (kill-buffer (current-buffer)))))
2185
2186 \f
2187 ;;;
2188 ;;; Slave functions.
2189 ;;;
2190
2191 (defun gnus-slave-save-newsrc ()
2192   (save-excursion
2193     (set-buffer gnus-dribble-buffer)
2194     (let ((slave-name
2195            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
2196       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
2197
2198 (defun gnus-master-read-slave-newsrc ()
2199   (let ((slave-files
2200          (directory-files
2201           (file-name-directory gnus-current-startup-file)
2202           t (concat
2203              "^" (regexp-quote
2204                   (concat
2205                    (file-name-nondirectory gnus-current-startup-file)
2206                    "-slave-")))
2207           t))
2208         file)
2209     (if (not slave-files)
2210         ()                              ; There are no slave files to read.
2211       (gnus-message 7 "Reading slave newsrcs...")
2212       (save-excursion
2213         (set-buffer (get-buffer-create " *gnus slave*"))
2214         (buffer-disable-undo (current-buffer))
2215         (setq slave-files
2216               (sort (mapcar (lambda (file)
2217                               (list (nth 5 (file-attributes file)) file))
2218                             slave-files)
2219                     (lambda (f1 f2)
2220                       (or (< (caar f1) (caar f2))
2221                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
2222         (while slave-files
2223           (erase-buffer)
2224           (setq file (nth 1 (car slave-files)))
2225           (insert-file-contents file)
2226           (if (condition-case ()
2227                   (progn
2228                     (eval-buffer (current-buffer))
2229                     t)
2230                 (error
2231                  (gnus-error 3.2 "Possible error in %s" file)
2232                  nil))
2233               (or gnus-slave ; Slaves shouldn't delete these files.
2234                   (condition-case ()
2235                       (delete-file file)
2236                     (error nil))))
2237           (setq slave-files (cdr slave-files))))
2238       (gnus-message 7 "Reading slave newsrcs...done"))))
2239
2240 \f
2241 ;;;
2242 ;;; Group description.
2243 ;;;
2244
2245 (defun gnus-read-all-descriptions-files ()
2246   (let ((methods (cons gnus-select-method 
2247                        (nconc
2248                         (when (gnus-archive-server-wanted-p)
2249                           (list "archive"))
2250                         gnus-secondary-select-methods))))
2251     (while methods
2252       (gnus-read-descriptions-file (car methods))
2253       (setq methods (cdr methods)))
2254     t))
2255
2256 (defun gnus-read-descriptions-file (&optional method)
2257   (let ((method (or method gnus-select-method))
2258         group)
2259     (when (stringp method)
2260       (setq method (gnus-server-to-method method)))
2261     ;; We create the hashtable whether we manage to read the desc file
2262     ;; to avoid trying to re-read after a failed read.
2263     (or gnus-description-hashtb
2264         (setq gnus-description-hashtb
2265               (gnus-make-hashtable (length gnus-active-hashtb))))
2266     ;; Mark this method's desc file as read.
2267     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
2268                   gnus-description-hashtb)
2269
2270     (gnus-message 5 "Reading descriptions file via %s..." (car method))
2271     (cond
2272      ((not (gnus-check-server method))
2273       (gnus-message 1 "Couldn't open server")
2274       nil)
2275      ((not (gnus-request-list-newsgroups method))
2276       (gnus-message 1 "Couldn't read newsgroups descriptions")
2277       nil)
2278      (t
2279       (save-excursion
2280         (save-restriction
2281           (set-buffer nntp-server-buffer)
2282           (goto-char (point-min))
2283           (when (or (search-forward "\n.\n" nil t)
2284                     (goto-char (point-max)))
2285             (beginning-of-line)
2286             (narrow-to-region (point-min) (point)))
2287           ;; If these are groups from a foreign select method, we insert the
2288           ;; group prefix in front of the group names.
2289           (and method (not (gnus-server-equal
2290                             (gnus-server-get-method nil method)
2291                             (gnus-server-get-method nil gnus-select-method)))
2292                (let ((prefix (gnus-group-prefixed-name "" method)))
2293                  (goto-char (point-min))
2294                  (while (and (not (eobp))
2295                              (progn (insert prefix)
2296                                     (zerop (forward-line 1)))))))
2297           (goto-char (point-min))
2298           (while (not (eobp))
2299             ;; If we get an error, we set group to 0, which is not a
2300             ;; symbol...
2301             (setq group
2302                   (condition-case ()
2303                       (let ((obarray gnus-description-hashtb))
2304                         ;; Group is set to a symbol interned in this
2305                         ;; hash table.
2306                         (read nntp-server-buffer))
2307                     (error 0)))
2308             (skip-chars-forward " \t")
2309             ;; ...  which leads to this line being effectively ignored.
2310             (and (symbolp group)
2311                  (set group (buffer-substring
2312                              (point) (progn (end-of-line) (point)))))
2313             (forward-line 1))))
2314       (gnus-message 5 "Reading descriptions file...done")
2315       t))))
2316
2317 (defun gnus-group-get-description (group)
2318   "Get the description of a group by sending XGTITLE to the server."
2319   (when (gnus-request-group-description group)
2320     (save-excursion
2321       (set-buffer nntp-server-buffer)
2322       (goto-char (point-min))
2323       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
2324         (match-string 1)))))
2325
2326 (provide 'gnus-start)
2327
2328 ;;; gnus-start.el ends here