*** 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 (defun gnus-no-server-1 (&optional arg slave)
510   "Read network news.
511 If ARG is a positive number, Gnus will use that as the
512 startup level.  If ARG is nil, Gnus will be started at level 2.
513 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 As opposed to `gnus', this command will not connect to the local server."
516   (interactive "P")
517   (let ((val (or arg (1- gnus-level-default-subscribed))))
518     (gnus val t slave)
519     (make-local-variable 'gnus-group-use-permanent-levels)
520     (setq gnus-group-use-permanent-levels val)))
521
522 (defun gnus-1 (&optional arg dont-connect slave)
523   "Read network news.
524 If ARG is non-nil and a positive number, Gnus will use that as the
525 startup level.  If ARG is non-nil and not a positive number, Gnus will
526 prompt the user for the name of an NNTP server to use."
527   (interactive "P")
528
529   (if (and (get-buffer gnus-group-buffer)
530            (save-excursion
531              (set-buffer gnus-group-buffer)
532              (eq major-mode 'gnus-group-mode)))
533       (progn
534         (switch-to-buffer gnus-group-buffer)
535         (gnus-group-get-new-news))
536
537     (gnus-splash)
538     (gnus-clear-system)
539     (nnheader-init-server-buffer)
540     (gnus-read-init-file)
541     (setq gnus-slave slave)
542
543     (when (string-match "xemacs" (emacs-version))
544       (gnus-splash))
545
546     (let ((level (and (numberp arg) (> arg 0) arg))
547           did-connect)
548       (unwind-protect
549           (progn
550             (or dont-connect
551                 (setq did-connect
552                       (gnus-start-news-server (and arg (not level))))))
553         (if (and (not dont-connect)
554                  (not did-connect))
555             (gnus-group-quit)
556           (run-hooks 'gnus-startup-hook)
557           ;; NNTP server is successfully open.
558
559           ;; Find the current startup file name.
560           (setq gnus-current-startup-file
561                 (gnus-make-newsrc-file gnus-startup-file))
562
563           ;; Read the dribble file.
564           (when (or gnus-slave gnus-use-dribble-file)
565             (gnus-dribble-read-file))
566
567           ;; Allow using GroupLens predictions.
568           (when gnus-use-grouplens
569             (bbb-login)
570             (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
571
572           ;; Do the actual startup.
573           (gnus-setup-news nil level dont-connect)
574           ;; Generate the group buffer.
575           (gnus-group-list-groups level)
576           (gnus-group-first-unread-group)
577           (gnus-configure-windows 'group)
578           (gnus-group-set-mode-line))))))
579
580 ;;;###autoload
581 (defun gnus-unload ()
582   "Unload all Gnus features."
583   (interactive)
584   (or (boundp 'load-history)
585       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
586   (let ((history load-history)
587         feature)
588     (while history
589       (and (string-match "^\\(gnus\\|nn\\)" (caar history))
590            (setq feature (cdr (assq 'provide (car history))))
591            (unload-feature feature 'force))
592       (setq history (cdr history)))))
593
594 \f
595 ;;;
596 ;;; Dribble file
597 ;;;
598
599 (defvar gnus-dribble-ignore nil)
600 (defvar gnus-dribble-eval-file nil)
601
602 (defun gnus-dribble-file-name ()
603   "Return the dribble file for the current .newsrc."
604   (concat
605    (if gnus-dribble-directory
606        (concat (file-name-as-directory gnus-dribble-directory)
607                (file-name-nondirectory gnus-current-startup-file))
608      gnus-current-startup-file)
609    "-dribble"))
610
611 (defun gnus-dribble-enter (string)
612   "Enter STRING into the dribble buffer."
613   (if (and (not gnus-dribble-ignore)
614            gnus-dribble-buffer
615            (buffer-name gnus-dribble-buffer))
616       (let ((obuf (current-buffer)))
617         (set-buffer gnus-dribble-buffer)
618         (insert string "\n")
619         (set-window-point (get-buffer-window (current-buffer)) (point-max))
620         (bury-buffer gnus-dribble-buffer)
621         (set-buffer obuf))))
622
623 (defun gnus-dribble-read-file ()
624   "Read the dribble file from disk."
625   (let ((dribble-file (gnus-dribble-file-name)))
626     (save-excursion
627       (set-buffer (setq gnus-dribble-buffer
628                         (get-buffer-create
629                          (file-name-nondirectory dribble-file))))
630       (gnus-add-current-to-buffer-list)
631       (erase-buffer)
632       (setq buffer-file-name dribble-file)
633       (auto-save-mode t)
634       (buffer-disable-undo (current-buffer))
635       (bury-buffer (current-buffer))
636       (set-buffer-modified-p nil)
637       (let ((auto (make-auto-save-file-name))
638             (gnus-dribble-ignore t)
639             modes)
640         (when (or (file-exists-p auto) (file-exists-p dribble-file))
641           ;; Load whichever file is newest -- the auto save file
642           ;; or the "real" file.
643           (if (file-newer-than-file-p auto dribble-file)
644               (insert-file-contents auto)
645             (insert-file-contents dribble-file))
646           (unless (zerop (buffer-size))
647             (set-buffer-modified-p t))
648           ;; Set the file modes to reflect the .newsrc file modes.
649           (save-buffer)
650           (when (and (file-exists-p gnus-current-startup-file)
651                      (setq modes (file-modes gnus-current-startup-file)))
652             (set-file-modes dribble-file modes))
653           ;; Possibly eval the file later.
654           (when (gnus-y-or-n-p
655                  "Auto-save file exists.  Do you want to read it? ")
656             (setq gnus-dribble-eval-file t)))))))
657
658 (defun gnus-dribble-eval-file ()
659   (when gnus-dribble-eval-file
660     (setq gnus-dribble-eval-file nil)
661     (save-excursion
662       (let ((gnus-dribble-ignore t))
663         (set-buffer gnus-dribble-buffer)
664         (eval-buffer (current-buffer))))))
665
666 (defun gnus-dribble-delete-file ()
667   (when (file-exists-p (gnus-dribble-file-name))
668     (delete-file (gnus-dribble-file-name)))
669   (when gnus-dribble-buffer
670     (save-excursion
671       (set-buffer gnus-dribble-buffer)
672       (let ((auto (make-auto-save-file-name)))
673         (if (file-exists-p auto)
674             (delete-file auto))
675         (erase-buffer)
676         (set-buffer-modified-p nil)))))
677
678 (defun gnus-dribble-save ()
679   (when (and gnus-dribble-buffer
680              (buffer-name gnus-dribble-buffer))
681     (save-excursion
682       (set-buffer gnus-dribble-buffer)
683       (save-buffer))))
684
685 (defun gnus-dribble-clear ()
686   (when (gnus-buffer-exists-p gnus-dribble-buffer)
687     (save-excursion
688       (set-buffer gnus-dribble-buffer)
689       (erase-buffer)
690       (set-buffer-modified-p nil)
691       (setq buffer-saved-size (buffer-size)))))
692
693 \f
694 ;;;
695 ;;; Active & Newsrc File Handling
696 ;;;
697
698 (defun gnus-setup-news (&optional rawfile level dont-connect)
699   "Setup news information.
700 If RAWFILE is non-nil, the .newsrc file will also be read.
701 If LEVEL is non-nil, the news will be set up at level LEVEL."
702   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
703
704     (when init 
705       ;; Clear some variables to re-initialize news information.
706       (setq gnus-newsrc-alist nil
707             gnus-active-hashtb nil)
708       ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
709       (gnus-read-newsrc-file rawfile))
710
711     (when (and (not (assoc "archive" gnus-server-alist))
712                (gnus-archive-server-wanted-p))
713       (push (cons "archive" gnus-message-archive-method)
714             gnus-server-alist))
715
716     ;; If we don't read the complete active file, we fill in the
717     ;; hashtb here.
718     (if (or (null gnus-read-active-file)
719             (eq gnus-read-active-file 'some))
720         (gnus-update-active-hashtb-from-killed))
721
722     ;; Read the active file and create `gnus-active-hashtb'.
723     ;; If `gnus-read-active-file' is nil, then we just create an empty
724     ;; hash table.  The partial filling out of the hash table will be
725     ;; done in `gnus-get-unread-articles'.
726     (and gnus-read-active-file
727          (not level)
728          (gnus-read-active-file))
729
730     (or gnus-active-hashtb
731         (setq gnus-active-hashtb (make-vector 4095 0)))
732
733     ;; Initialize the cache.
734     (when gnus-use-cache
735       (gnus-cache-open))
736
737     ;; Possibly eval the dribble file.
738     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
739
740     ;; Slave Gnusii should then clear the dribble buffer.
741     (when (and init gnus-slave)
742       (gnus-dribble-clear))
743
744     (gnus-update-format-specifications)
745
746     ;; See whether we need to read the description file.
747     (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
748              (not gnus-description-hashtb)
749              (not dont-connect)
750              gnus-read-active-file)
751         (gnus-read-all-descriptions-files))
752
753     ;; Find new newsgroups and treat them.
754     (if (and init gnus-check-new-newsgroups (not level)
755              (gnus-check-server gnus-select-method))
756         (gnus-find-new-newsgroups))
757
758     ;; We might read in new NoCeM messages here.
759     (when (and gnus-use-nocem 
760                (not level)
761                (not dont-connect))
762       (gnus-nocem-scan-groups))
763
764     ;; Find the number of unread articles in each non-dead group.
765     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
766       (gnus-get-unread-articles level))
767
768     (if (and init gnus-check-bogus-newsgroups
769              gnus-read-active-file (not level)
770              (gnus-server-opened gnus-select-method))
771         (gnus-check-bogus-newsgroups))))
772
773 (defun gnus-find-new-newsgroups (&optional arg)
774   "Search for new newsgroups and add them.
775 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
776 The `-n' option line from .newsrc is respected.
777 If ARG (the prefix), use the `ask-server' method to query
778 the server for new groups."
779   (interactive "P")
780   (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
781                        (null gnus-read-active-file)
782                        (eq gnus-read-active-file 'some))
783                    'ask-server gnus-check-new-newsgroups)))
784     (unless (gnus-check-first-time-used)
785       (if (or (consp check)
786               (eq check 'ask-server))
787           ;; Ask the server for new groups.
788           (gnus-ask-server-for-new-groups)
789         ;; Go through the active hashtb and look for new groups.
790         (let ((groups 0)
791               group new-newsgroups)
792           (gnus-message 5 "Looking for new newsgroups...")
793           (unless gnus-have-read-active-file
794             (gnus-read-active-file))
795           (setq gnus-newsrc-last-checked-date (current-time-string))
796           (unless gnus-killed-hashtb
797             (gnus-make-hashtable-from-killed))
798           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
799           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
800           (mapatoms
801            (lambda (sym)
802              (if (or (null (setq group (symbol-name sym)))
803                      (not (boundp sym))
804                      (null (symbol-value sym))
805                      (gnus-gethash group gnus-killed-hashtb)
806                      (gnus-gethash group gnus-newsrc-hashtb))
807                  ()
808                (let ((do-sub (gnus-matches-options-n group)))
809                  (cond
810                   ((eq do-sub 'subscribe)
811                    (setq groups (1+ groups))
812                    (gnus-sethash group group gnus-killed-hashtb)
813                    (funcall gnus-subscribe-options-newsgroup-method group))
814                   ((eq do-sub 'ignore)
815                    nil)
816                   (t
817                    (setq groups (1+ groups))
818                    (gnus-sethash group group gnus-killed-hashtb)
819                    (if gnus-subscribe-hierarchical-interactive
820                        (setq new-newsgroups (cons group new-newsgroups))
821                      (funcall gnus-subscribe-newsgroup-method group)))))))
822            gnus-active-hashtb)
823           (when new-newsgroups
824             (gnus-subscribe-hierarchical-interactive new-newsgroups))
825           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
826           (if (> groups 0)
827               (gnus-message 6 "%d new newsgroup%s arrived."
828                             groups (if (> groups 1) "s have" " has"))
829             (gnus-message 6 "No new newsgroups.")))))))
830
831 (defun gnus-matches-options-n (group)
832   ;; Returns `subscribe' if the group is to be unconditionally
833   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
834   ;; no match for the group.
835
836   ;; First we check the two user variables.
837   (cond
838    ((and gnus-options-subscribe
839          (string-match gnus-options-subscribe group))
840     'subscribe)
841    ((and gnus-auto-subscribed-groups
842          (string-match gnus-auto-subscribed-groups group))
843     'subscribe)
844    ((and gnus-options-not-subscribe
845          (string-match gnus-options-not-subscribe group))
846     'ignore)
847    ;; Then we go through the list that was retrieved from the .newsrc
848    ;; file.  This list has elements on the form
849    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
850    ;; is in the reverse order of the options line) is returned.
851    (t
852     (let ((regs gnus-newsrc-options-n))
853       (while (and regs
854                   (not (string-match (caar regs) group)))
855         (setq regs (cdr regs)))
856       (and regs (cdar regs))))))
857
858 (defun gnus-ask-server-for-new-groups ()
859   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
860          (methods (cons gnus-select-method
861                         (nconc
862                          (when (gnus-archive-server-wanted-p)
863                            (list "archive"))
864                          (append
865                           (and (consp gnus-check-new-newsgroups)
866                                gnus-check-new-newsgroups)
867                           gnus-secondary-select-methods))))
868          (groups 0)
869          (new-date (current-time-string))
870          group new-newsgroups got-new method hashtb
871          gnus-override-subscribe-method)
872     ;; Go through both primary and secondary select methods and
873     ;; request new newsgroups.
874     (while (setq method (gnus-server-get-method nil (pop methods)))
875       (setq new-newsgroups nil)
876       (setq gnus-override-subscribe-method method)
877       (when (and (gnus-check-server method)
878                  (gnus-request-newgroups date method))
879         (save-excursion
880           (setq got-new t)
881           (setq hashtb (gnus-make-hashtable 100))
882           (set-buffer nntp-server-buffer)
883           ;; Enter all the new groups into a hashtable.
884           (gnus-active-to-gnus-format method hashtb 'ignore))
885         ;; Now all new groups from `method' are in `hashtb'.
886         (mapatoms
887          (lambda (group-sym)
888            (if (or (null (setq group (symbol-name group-sym)))
889                    (not (boundp group-sym))
890                    (null (symbol-value group-sym))
891                    (gnus-gethash group gnus-newsrc-hashtb)
892                    (member group gnus-zombie-list)
893                    (member group gnus-killed-list))
894                ;; The group is already known.
895                ()
896              ;; Make this group active.
897              (when (symbol-value group-sym)
898                (gnus-set-active group (symbol-value group-sym)))
899              ;; Check whether we want it or not.
900              (let ((do-sub (gnus-matches-options-n group)))
901                (cond
902                 ((eq do-sub 'subscribe)
903                  (incf groups)
904                  (gnus-sethash group group gnus-killed-hashtb)
905                  (funcall gnus-subscribe-options-newsgroup-method group))
906                 ((eq do-sub 'ignore)
907                  nil)
908                 (t
909                  (incf groups)
910                  (gnus-sethash group group gnus-killed-hashtb)
911                  (if gnus-subscribe-hierarchical-interactive
912                      (push group new-newsgroups)
913                    (funcall gnus-subscribe-newsgroup-method group)))))))
914          hashtb))
915       (when new-newsgroups
916         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
917     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
918     (when (> groups 0)
919       (gnus-message 6 "%d new newsgroup%s arrived."
920                     groups (if (> groups 1) "s have" " has")))
921     (and got-new (setq gnus-newsrc-last-checked-date new-date))
922     got-new))
923
924 (defun gnus-check-first-time-used ()
925   (if (or (> (length gnus-newsrc-alist) 1)
926           (file-exists-p gnus-startup-file)
927           (file-exists-p (concat gnus-startup-file ".el"))
928           (file-exists-p (concat gnus-startup-file ".eld")))
929       nil
930     (gnus-message 6 "First time user; subscribing you to default groups")
931     (unless (gnus-read-active-file-p)
932       (gnus-read-active-file))
933     (setq gnus-newsrc-last-checked-date (current-time-string))
934     (let ((groups gnus-default-subscribed-newsgroups)
935           group)
936       (if (eq groups t)
937           nil
938         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
939         (mapatoms
940          (lambda (sym)
941            (if (null (setq group (symbol-name sym)))
942                ()
943              (let ((do-sub (gnus-matches-options-n group)))
944                (cond
945                 ((eq do-sub 'subscribe)
946                  (gnus-sethash group group gnus-killed-hashtb)
947                  (funcall gnus-subscribe-options-newsgroup-method group))
948                 ((eq do-sub 'ignore)
949                  nil)
950                 (t
951                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
952          gnus-active-hashtb)
953         (while groups
954           (if (gnus-active (car groups))
955               (gnus-group-change-level
956                (car groups) gnus-level-default-subscribed gnus-level-killed))
957           (setq groups (cdr groups)))
958         (gnus-group-make-help-group)
959         (and gnus-novice-user
960              (gnus-message 7 "`A k' to list killed groups"))))))
961
962 (defun gnus-subscribe-group (group previous &optional method)
963   (gnus-group-change-level
964    (if method
965        (list t group gnus-level-default-subscribed nil nil method)
966      group)
967    gnus-level-default-subscribed gnus-level-killed previous t))
968
969 ;; `gnus-group-change-level' is the fundamental function for changing
970 ;; subscription levels of newsgroups.  This might mean just changing
971 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
972 ;; again, which subscribes/unsubscribes a group, which is equally
973 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
974 ;; from 8-9 to 1-7 means that you remove the group from the list of
975 ;; killed (or zombie) groups and add them to the (kinda) subscribed
976 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
977 ;; which is trivial.
978 ;; ENTRY can either be a string (newsgroup name) or a list (if
979 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
980 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
981 ;; entries.
982 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
983 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
984 ;; after.
985 (defun gnus-group-change-level (entry level &optional oldlevel
986                                       previous fromkilled)
987   (let (group info active num)
988     ;; Glean what info we can from the arguments
989     (if (consp entry)
990         (if fromkilled (setq group (nth 1 entry))
991           (setq group (car (nth 2 entry))))
992       (setq group entry))
993     (if (and (stringp entry)
994              oldlevel
995              (< oldlevel gnus-level-zombie))
996         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
997     (if (and (not oldlevel)
998              (consp entry))
999         (setq oldlevel (gnus-info-level (nth 2 entry)))
1000       (setq oldlevel (or oldlevel 9)))
1001     (if (stringp previous)
1002         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
1003
1004     (if (and (>= oldlevel gnus-level-zombie)
1005              (gnus-gethash group gnus-newsrc-hashtb))
1006         ;; We are trying to subscribe a group that is already
1007         ;; subscribed.
1008         ()                              ; Do nothing.
1009
1010       (or (gnus-ephemeral-group-p group)
1011           (gnus-dribble-enter
1012            (format "(gnus-group-change-level %S %S %S %S %S)"
1013                    group level oldlevel (car (nth 2 previous)) fromkilled)))
1014
1015       ;; Then we remove the newgroup from any old structures, if needed.
1016       ;; If the group was killed, we remove it from the killed or zombie
1017       ;; list.  If not, and it is in fact going to be killed, we remove
1018       ;; it from the newsrc hash table and assoc.
1019       (cond
1020        ((>= oldlevel gnus-level-zombie)
1021         (if (= oldlevel gnus-level-zombie)
1022             (setq gnus-zombie-list (delete group gnus-zombie-list))
1023           (setq gnus-killed-list (delete group gnus-killed-list))))
1024        (t
1025         (if (and (>= level gnus-level-zombie)
1026                  entry)
1027             (progn
1028               (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
1029               (if (nth 3 entry)
1030                   (setcdr (gnus-gethash (car (nth 3 entry))
1031                                         gnus-newsrc-hashtb)
1032                           (cdr entry)))
1033               (setcdr (cdr entry) (cdddr entry))))))
1034
1035       ;; Finally we enter (if needed) the list where it is supposed to
1036       ;; go, and change the subscription level.  If it is to be killed,
1037       ;; we enter it into the killed or zombie list.
1038       (cond 
1039        ((>= level gnus-level-zombie)
1040         ;; Remove from the hash table.
1041         (gnus-sethash group nil gnus-newsrc-hashtb)
1042         ;; We do not enter foreign groups into the list of dead
1043         ;; groups.
1044         (unless (gnus-group-foreign-p group)
1045           (if (= level gnus-level-zombie)
1046               (setq gnus-zombie-list (cons group gnus-zombie-list))
1047             (setq gnus-killed-list (cons group gnus-killed-list)))))
1048        (t
1049         ;; If the list is to be entered into the newsrc assoc, and
1050         ;; it was killed, we have to create an entry in the newsrc
1051         ;; hashtb format and fix the pointers in the newsrc assoc.
1052         (if (< oldlevel gnus-level-zombie)
1053             ;; It was alive, and it is going to stay alive, so we
1054             ;; just change the level and don't change any pointers or
1055             ;; hash table entries.
1056             (setcar (cdaddr entry) level)
1057           (if (listp entry)
1058               (setq info (cdr entry)
1059                     num (car entry))
1060             (setq active (gnus-active group))
1061             (setq num
1062                   (if active (- (1+ (cdr active)) (car active)) t))
1063             ;; Check whether the group is foreign.  If so, the
1064             ;; foreign select method has to be entered into the
1065             ;; info.
1066             (let ((method (or gnus-override-subscribe-method
1067                               (gnus-group-method group))))
1068               (if (eq method gnus-select-method)
1069                   (setq info (list group level nil))
1070                 (setq info (list group level nil nil method)))))
1071           (unless previous
1072             (setq previous
1073                   (let ((p gnus-newsrc-alist))
1074                     (while (cddr p)
1075                       (setq p (cdr p)))
1076                     p)))
1077           (setq entry (cons info (cddr previous)))
1078           (if (cdr previous)
1079               (progn
1080                 (setcdr (cdr previous) entry)
1081                 (gnus-sethash group (cons num (cdr previous))
1082                               gnus-newsrc-hashtb))
1083             (setcdr previous entry)
1084             (gnus-sethash group (cons num previous)
1085                           gnus-newsrc-hashtb))
1086           (when (cdr entry)
1087             (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)))))
1088       (when gnus-group-change-level-function
1089         (funcall gnus-group-change-level-function group level oldlevel)))))
1090
1091 (defun gnus-kill-newsgroup (newsgroup)
1092   "Obsolete function.  Kills a newsgroup."
1093   (gnus-group-change-level
1094    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
1095
1096 (defun gnus-check-bogus-newsgroups (&optional confirm)
1097   "Remove bogus newsgroups.
1098 If CONFIRM is non-nil, the user has to confirm the deletion of every
1099 newsgroup."
1100   (let ((newsrc (cdr gnus-newsrc-alist))
1101         bogus group entry info)
1102     (gnus-message 5 "Checking bogus newsgroups...")
1103     (unless (gnus-read-active-file-p)
1104       (gnus-read-active-file))
1105     (when (gnus-read-active-file-p)
1106       ;; Find all bogus newsgroup that are subscribed.
1107       (while newsrc
1108         (setq info (pop newsrc)
1109               group (gnus-info-group info))
1110         (unless (or (gnus-active group) ; Active
1111                     (gnus-info-method info) ; Foreign
1112                     (and confirm
1113                          (not (gnus-y-or-n-p
1114                                (format "Remove bogus newsgroup: %s " group)))))
1115           ;; Found a bogus newsgroup.
1116           (push group bogus)))
1117       ;; Remove all bogus subscribed groups by first killing them, and
1118       ;; then removing them from the list of killed groups.
1119       (while bogus
1120         (when (setq entry (gnus-gethash (setq group (pop bogus))
1121                                         gnus-newsrc-hashtb))
1122           (gnus-group-change-level entry gnus-level-killed)
1123           (setq gnus-killed-list (delete group gnus-killed-list))))
1124       ;; Then we remove all bogus groups from the list of killed and
1125       ;; zombie groups.  They are removed without confirmation.
1126       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
1127             killed)
1128         (while dead-lists
1129           (setq killed (symbol-value (car dead-lists)))
1130           (while killed
1131             (unless (gnus-active (setq group (pop killed)))
1132               ;; The group is bogus.
1133               ;; !!!Slow as hell.
1134               (set (car dead-lists)
1135                    (delete group (symbol-value (car dead-lists))))))
1136           (setq dead-lists (cdr dead-lists))))
1137       (run-hooks 'gnus-check-bogus-groups-hook)
1138       (gnus-message 5 "Checking bogus newsgroups...done"))))
1139
1140 (defun gnus-check-duplicate-killed-groups ()
1141   "Remove duplicates from the list of killed groups."
1142   (interactive)
1143   (let ((killed gnus-killed-list))
1144     (while killed
1145       (gnus-message 9 "%d" (length killed))
1146       (setcdr killed (delete (car killed) (cdr killed)))
1147       (setq killed (cdr killed)))))
1148
1149 ;; We want to inline a function from gnus-cache, so we cheat here:
1150 (eval-when-compile
1151   (defvar gnus-cache-active-hashtb)
1152   (defun gnus-cache-possibly-alter-active (group active)
1153     "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
1154     (when gnus-cache-active-hashtb
1155       (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
1156         (and cache-active 
1157              (< (car cache-active) (car active))
1158              (setcar active (car cache-active)))
1159         (and cache-active
1160              (> (cdr cache-active) (cdr active))
1161              (setcdr active (cdr cache-active)))))))
1162
1163 (defun gnus-get-unread-articles-in-group (info active &optional update)
1164   (when active
1165     ;; Allow the backend to update the info in the group.
1166     (when (and update 
1167                (gnus-request-update-info
1168                 info (gnus-find-method-for-group (gnus-info-group info))))
1169       (gnus-activate-group (gnus-info-group info) nil t))
1170     (let* ((range (gnus-info-read info))
1171            (num 0))
1172       ;; If a cache is present, we may have to alter the active info.
1173       (when (and gnus-use-cache info)
1174         (inline (gnus-cache-possibly-alter-active 
1175                  (gnus-info-group info) active)))
1176       ;; Modify the list of read articles according to what articles
1177       ;; are available; then tally the unread articles and add the
1178       ;; number to the group hash table entry.
1179       (cond
1180        ((zerop (cdr active))
1181         (setq num 0))
1182        ((not range)
1183         (setq num (- (1+ (cdr active)) (car active))))
1184        ((not (listp (cdr range)))
1185         ;; Fix a single (num . num) range according to the
1186         ;; active hash table.
1187         ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
1188         (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
1189         (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
1190         ;; Compute number of unread articles.
1191         (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
1192        (t
1193         ;; The read list is a list of ranges.  Fix them according to
1194         ;; the active hash table.
1195         ;; First peel off any elements that are below the lower
1196         ;; active limit.
1197         (while (and (cdr range)
1198                     (>= (car active)
1199                         (or (and (atom (cadr range)) (cadr range))
1200                             (caadr range))))
1201           (if (numberp (car range))
1202               (setcar range
1203                       (cons (car range)
1204                             (or (and (numberp (cadr range))
1205                                      (cadr range))
1206                                 (cdadr range))))
1207             (setcdr (car range)
1208                     (or (and (numberp (nth 1 range)) (nth 1 range))
1209                         (cdadr range))))
1210           (setcdr range (cddr range)))
1211         ;; Adjust the first element to be the same as the lower limit.
1212         (if (and (not (atom (car range)))
1213                  (< (cdar range) (car active)))
1214             (setcdr (car range) (1- (car active))))
1215         ;; Then we want to peel off any elements that are higher
1216         ;; than the upper active limit.
1217         (let ((srange range))
1218           ;; Go past all legal elements.
1219           (while (and (cdr srange)
1220                       (<= (or (and (atom (cadr srange))
1221                                    (cadr srange))
1222                               (caadr srange)) (cdr active)))
1223             (setq srange (cdr srange)))
1224           (if (cdr srange)
1225               ;; Nuke all remaining illegal elements.
1226               (setcdr srange nil))
1227
1228           ;; Adjust the final element.
1229           (if (and (not (atom (car srange)))
1230                    (> (cdar srange) (cdr active)))
1231               (setcdr (car srange) (cdr active))))
1232         ;; Compute the number of unread articles.
1233         (while range
1234           (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
1235                                       (cdar range)))
1236                               (or (and (atom (car range)) (car range))
1237                                   (caar range)))))
1238           (setq range (cdr range)))
1239         (setq num (max 0 (- (cdr active) num)))))
1240       ;; Set the number of unread articles.
1241       (when info
1242         (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
1243       num)))
1244
1245 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
1246 ;; and compute how many unread articles there are in each group.
1247 (defun gnus-get-unread-articles (&optional level)
1248   (let* ((newsrc (cdr gnus-newsrc-alist))
1249          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
1250          (foreign-level
1251           (min
1252            (cond ((and gnus-activate-foreign-newsgroups
1253                        (not (numberp gnus-activate-foreign-newsgroups)))
1254                   (1+ gnus-level-subscribed))
1255                  ((numberp gnus-activate-foreign-newsgroups)
1256                   gnus-activate-foreign-newsgroups)
1257                  (t 0))
1258            level))
1259          info group active method)
1260     (gnus-message 5 "Checking new news...")
1261
1262     (while newsrc
1263       (setq active (gnus-active (setq group (gnus-info-group
1264                                              (setq info (pop newsrc))))))
1265
1266       ;; Check newsgroups.  If the user doesn't want to check them, or
1267       ;; they can't be checked (for instance, if the news server can't
1268       ;; be reached) we just set the number of unread articles in this
1269       ;; newsgroup to t.  This means that Gnus thinks that there are
1270       ;; unread articles, but it has no idea how many.
1271       (if (and (setq method (gnus-info-method info))
1272                (not (gnus-server-equal
1273                      gnus-select-method
1274                      (setq method (gnus-server-get-method nil method))))
1275                (not (gnus-secondary-method-p method)))
1276           ;; These groups are foreign.  Check the level.
1277           (when (<= (gnus-info-level info) foreign-level)
1278             (setq active (gnus-activate-group group 'scan))
1279             (unless (inline (gnus-virtual-group-p group))
1280               (inline (gnus-close-group group)))
1281             (when (fboundp (intern (concat (symbol-name (car method))
1282                                            "-request-update-info")))
1283               (inline (gnus-request-update-info info method))))
1284         ;; These groups are native or secondary.
1285         (when (and (<= (gnus-info-level info) level)
1286                    (not gnus-read-active-file))
1287           (setq active (gnus-activate-group group 'scan))
1288           (inline (gnus-close-group group))))
1289
1290       ;; Get the number of unread articles in the group.
1291       (if active
1292           (inline (gnus-get-unread-articles-in-group info active))
1293         ;; The group couldn't be reached, so we nix out the number of
1294         ;; unread articles and stuff.
1295         (gnus-set-active group nil)
1296         (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
1297
1298     (gnus-message 5 "Checking new news...done")))
1299
1300 ;; Create a hash table out of the newsrc alist.  The `car's of the
1301 ;; alist elements are used as keys.
1302 (defun gnus-make-hashtable-from-newsrc-alist ()
1303   (let ((alist gnus-newsrc-alist)
1304         (ohashtb gnus-newsrc-hashtb)
1305         prev)
1306     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
1307     (setq alist
1308           (setq prev (setq gnus-newsrc-alist
1309                            (if (equal (caar gnus-newsrc-alist)
1310                                       "dummy.group")
1311                                gnus-newsrc-alist
1312                              (cons (list "dummy.group" 0 nil) alist)))))
1313     (while alist
1314       (gnus-sethash
1315        (caar alist)
1316        (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
1317              prev)
1318        gnus-newsrc-hashtb)
1319       (setq prev alist
1320             alist (cdr alist)))))
1321
1322 (defun gnus-make-hashtable-from-killed ()
1323   "Create a hash table from the killed and zombie lists."
1324   (let ((lists '(gnus-killed-list gnus-zombie-list))
1325         list)
1326     (setq gnus-killed-hashtb
1327           (gnus-make-hashtable
1328            (+ (length gnus-killed-list) (length gnus-zombie-list))))
1329     (while (setq list (pop lists))
1330       (setq list (symbol-value list))
1331       (while list
1332         (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
1333
1334 (defun gnus-activate-group (group &optional scan dont-check method)
1335   ;; Check whether a group has been activated or not.
1336   ;; If SCAN, request a scan of that group as well.
1337   (let ((method (or method (gnus-find-method-for-group group)))
1338         active)
1339     (and (gnus-check-server method)
1340          ;; We escape all bugs and quit here to make it possible to
1341          ;; continue if a group is so out-there that it reports bugs
1342          ;; and stuff.
1343          (progn
1344            (and scan
1345                 (gnus-check-backend-function 'request-scan (car method))
1346                 (gnus-request-scan group method))
1347            t)
1348          (condition-case ()
1349              (gnus-request-group group dont-check method)
1350         ;   (error nil)
1351            (quit nil))
1352          (save-excursion
1353            (set-buffer nntp-server-buffer)
1354            (goto-char (point-min))
1355            ;; Parse the result we got from `gnus-request-group'.
1356            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
1357                 (progn
1358                   (goto-char (match-beginning 1))
1359                   (gnus-set-active
1360                    group (setq active (cons (read (current-buffer))
1361                                             (read (current-buffer)))))
1362                   ;; Return the new active info.
1363                   active))))))
1364
1365 (defun gnus-update-read-articles (group unread)
1366   "Update the list of read and ticked articles in GROUP using the
1367 UNREAD and TICKED lists.
1368 Note: UNSELECTED has to be sorted over `<'.
1369 Returns whether the updating was successful."
1370   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
1371          (entry (gnus-gethash group gnus-newsrc-hashtb))
1372          (info (nth 2 entry))
1373          (prev 1)
1374          (unread (sort (copy-sequence unread) '<))
1375          read)
1376     (if (or (not info) (not active))
1377         ;; There is no info on this group if it was, in fact,
1378         ;; killed.  Gnus stores no information on killed groups, so
1379         ;; there's nothing to be done.
1380         ;; One could store the information somewhere temporarily,
1381         ;; perhaps...  Hmmm...
1382         ()
1383       ;; Remove any negative articles numbers.
1384       (while (and unread (< (car unread) 0))
1385         (setq unread (cdr unread)))
1386       ;; Remove any expired article numbers
1387       (while (and unread (< (car unread) (car active)))
1388         (setq unread (cdr unread)))
1389       ;; Compute the ranges of read articles by looking at the list of
1390       ;; unread articles.
1391       (while unread
1392         (if (/= (car unread) prev)
1393             (setq read (cons (if (= prev (1- (car unread))) prev
1394                                (cons prev (1- (car unread)))) read)))
1395         (setq prev (1+ (car unread)))
1396         (setq unread (cdr unread)))
1397       (when (<= prev (cdr active))
1398         (setq read (cons (cons prev (cdr active)) read)))
1399       ;; Enter this list into the group info.
1400       (gnus-info-set-read
1401        info (if (> (length read) 1) (nreverse read) read))
1402       ;; Set the number of unread articles in gnus-newsrc-hashtb.
1403       (gnus-get-unread-articles-in-group info (gnus-active group))
1404       t)))
1405
1406 (defun gnus-make-articles-unread (group articles)
1407   "Mark ARTICLES in GROUP as unread."
1408   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
1409                           (gnus-gethash (gnus-group-real-name group)
1410                                         gnus-newsrc-hashtb))))
1411          (ranges (gnus-info-read info))
1412          news article)
1413     (while articles
1414       (when (gnus-member-of-range
1415              (setq article (pop articles)) ranges)
1416         (setq news (cons article news))))
1417     (when news
1418       (gnus-info-set-read
1419        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
1420       (gnus-group-update-group group t))))
1421
1422 ;; Enter all dead groups into the hashtb.
1423 (defun gnus-update-active-hashtb-from-killed ()
1424   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
1425         (lists (list gnus-killed-list gnus-zombie-list))
1426         killed)
1427     (while lists
1428       (setq killed (car lists))
1429       (while killed
1430         (gnus-sethash (car killed) nil hashtb)
1431         (setq killed (cdr killed)))
1432       (setq lists (cdr lists)))))
1433
1434 (defun gnus-get-killed-groups ()
1435   "Go through the active hashtb and mark all unknown groups as killed."
1436   ;; First make sure active file has been read.
1437   (unless (gnus-read-active-file-p)
1438     (let ((gnus-read-active-file t))
1439       (gnus-read-active-file)))
1440   (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
1441   ;; Go through all newsgroups that are known to Gnus - enlarge kill list.
1442   (mapatoms
1443    (lambda (sym)
1444      (let ((groups 0)
1445            (group (symbol-name sym)))
1446        (if (or (null group)
1447                (gnus-gethash group gnus-killed-hashtb)
1448                (gnus-gethash group gnus-newsrc-hashtb))
1449            ()
1450          (let ((do-sub (gnus-matches-options-n group)))
1451            (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
1452                ()
1453              (setq groups (1+ groups))
1454              (setq gnus-killed-list
1455                    (cons group gnus-killed-list))
1456              (gnus-sethash group group gnus-killed-hashtb))))))
1457    gnus-active-hashtb))
1458
1459 ;; Get the active file(s) from the backend(s).
1460 (defun gnus-read-active-file ()
1461   (gnus-group-set-mode-line)
1462   (let ((methods 
1463          (append
1464           (if (gnus-check-server gnus-select-method)
1465               ;; The native server is available.
1466               (cons gnus-select-method gnus-secondary-select-methods)
1467             ;; The native server is down, so we just do the
1468             ;; secondary ones.
1469             gnus-secondary-select-methods)
1470           ;; Also read from the archive server.
1471           (when (gnus-archive-server-wanted-p)
1472             (list "archive"))))
1473         list-type)
1474     (setq gnus-have-read-active-file nil)
1475     (save-excursion
1476       (set-buffer nntp-server-buffer)
1477       (while methods
1478         (let* ((method (if (stringp (car methods))
1479                            (gnus-server-get-method nil (car methods))
1480                          (car methods)))
1481                (where (nth 1 method))
1482                (mesg (format "Reading active file%s via %s..."
1483                              (if (and where (not (zerop (length where))))
1484                                  (concat " from " where) "")
1485                              (car method))))
1486           (gnus-message 5 mesg)
1487           (when (gnus-check-server method)
1488             ;; Request that the backend scan its incoming messages.
1489             (and (gnus-check-backend-function 'request-scan (car method))
1490                  (gnus-request-scan nil method))
1491             (cond
1492              ((and (eq gnus-read-active-file 'some)
1493                    (gnus-check-backend-function 'retrieve-groups (car method)))
1494               (let ((newsrc (cdr gnus-newsrc-alist))
1495                     (gmethod (gnus-server-get-method nil method))
1496                     groups info)
1497                 (while (setq info (pop newsrc))
1498                   (when (gnus-server-equal
1499                          (gnus-find-method-for-group 
1500                           (gnus-info-group info) info)
1501                          gmethod)
1502                     (push (gnus-group-real-name (gnus-info-group info)) 
1503                           groups)))
1504                 (when groups
1505                   (gnus-check-server method)
1506                   (setq list-type (gnus-retrieve-groups groups method))
1507                   (cond
1508                    ((not list-type)
1509                     (gnus-error
1510                      1.2 "Cannot read partial active file from %s server."
1511                      (car method)))
1512                    ((eq list-type 'active)
1513                     (gnus-active-to-gnus-format method gnus-active-hashtb))
1514                    (t
1515                     (gnus-groups-to-gnus-format method gnus-active-hashtb))))))
1516              (t
1517               (if (not (gnus-request-list method))
1518                   (unless (equal method gnus-message-archive-method)
1519                     (gnus-error 1 "Cannot read active file from %s server."
1520                                 (car method)))
1521                 (gnus-message 5 mesg)
1522                 (gnus-active-to-gnus-format method gnus-active-hashtb)
1523                 ;; We mark this active file as read.
1524                 (push method gnus-have-read-active-file)
1525                 (gnus-message 5 "%sdone" mesg))))))
1526         (setq methods (cdr methods))))))
1527
1528 ;; Read an active file and place the results in `gnus-active-hashtb'.
1529 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
1530   (unless method
1531     (setq method gnus-select-method))
1532   (let ((cur (current-buffer))
1533         (hashtb (or hashtb
1534                     (if (and gnus-active-hashtb
1535                              (not (equal method gnus-select-method)))
1536                         gnus-active-hashtb
1537                       (setq gnus-active-hashtb
1538                             (if (equal method gnus-select-method)
1539                                 (gnus-make-hashtable
1540                                  (count-lines (point-min) (point-max)))
1541                               (gnus-make-hashtable 4096)))))))
1542     ;; Delete unnecessary lines.
1543     (goto-char (point-min))
1544     (while (search-forward "\nto." nil t)
1545       (delete-region (1+ (match-beginning 0))
1546                      (progn (forward-line 1) (point))))
1547     (or (string= gnus-ignored-newsgroups "")
1548         (progn
1549           (goto-char (point-min))
1550           (delete-matching-lines gnus-ignored-newsgroups)))
1551     ;; Make the group names readable as a lisp expression even if they
1552     ;; contain special characters.
1553     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
1554     (goto-char (point-max))
1555     (while (re-search-backward "[][';?()#]" nil t)
1556       (insert ?\\))
1557     ;; If these are groups from a foreign select method, we insert the
1558     ;; group prefix in front of the group names.
1559     (and method (not (gnus-server-equal
1560                       (gnus-server-get-method nil method)
1561                       (gnus-server-get-method nil gnus-select-method)))
1562          (let ((prefix (gnus-group-prefixed-name "" method)))
1563            (goto-char (point-min))
1564            (while (and (not (eobp))
1565                        (progn (insert prefix)
1566                               (zerop (forward-line 1)))))))
1567     ;; Store the active file in a hash table.
1568     (goto-char (point-min))
1569     (if (string-match "%[oO]" gnus-group-line-format)
1570         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
1571         ;; If we want information on moderated groups, we use this
1572         ;; loop...
1573         (let* ((mod-hashtb (make-vector 7 0))
1574                (m (intern "m" mod-hashtb))
1575                group max min)
1576           (while (not (eobp))
1577             (condition-case nil
1578                 (progn
1579                   (narrow-to-region (point) (gnus-point-at-eol))
1580                   (setq group (let ((obarray hashtb)) (read cur)))
1581                   (if (and (numberp (setq max (read cur)))
1582                            (numberp (setq min (read cur)))
1583                            (progn
1584                              (skip-chars-forward " \t")
1585                              (not
1586                               (or (= (following-char) ?=)
1587                                   (= (following-char) ?x)
1588                                   (= (following-char) ?j)))))
1589                       (set group (cons min max))
1590                     (set group nil))
1591                   ;; Enter moderated groups into a list.
1592                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
1593                       (setq gnus-moderated-list
1594                             (cons (symbol-name group) gnus-moderated-list))))
1595               (error
1596                (and group
1597                     (symbolp group)
1598                     (set group nil))))
1599             (widen)
1600             (forward-line 1)))
1601       ;; And if we do not care about moderation, we use this loop,
1602       ;; which is faster.
1603       (let (group max min)
1604         (while (not (eobp))
1605           (condition-case ()
1606               (progn
1607                 (narrow-to-region (point) (gnus-point-at-eol))
1608                 ;; group gets set to a symbol interned in the hash table
1609                 ;; (what a hack!!) - jwz
1610                 (setq group (let ((obarray hashtb)) (read cur)))
1611                 (if (and (numberp (setq max (read cur)))
1612                          (numberp (setq min (read cur)))
1613                          (progn
1614                            (skip-chars-forward " \t")
1615                            (not
1616                             (or (= (following-char) ?=)
1617                                 (= (following-char) ?x)
1618                                 (= (following-char) ?j)))))
1619                     (set group (cons min max))
1620                   (set group nil)))
1621             (error
1622              (progn
1623                (and group
1624                     (symbolp group)
1625                     (set group nil))
1626                (or ignore-errors
1627                    (gnus-message 3 "Warning - illegal active: %s"
1628                                  (buffer-substring
1629                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
1630           (widen)
1631           (forward-line 1))))))
1632
1633 (defun gnus-groups-to-gnus-format (method &optional hashtb)
1634   ;; Parse a "groups" active file.
1635   (let ((cur (current-buffer))
1636         (hashtb (or hashtb
1637                     (if (and method gnus-active-hashtb)
1638                         gnus-active-hashtb
1639                       (setq gnus-active-hashtb
1640                             (gnus-make-hashtable
1641                              (count-lines (point-min) (point-max)))))))
1642         (prefix (and method
1643                      (not (gnus-server-equal
1644                            (gnus-server-get-method nil method)
1645                            (gnus-server-get-method nil gnus-select-method)))
1646                      (gnus-group-prefixed-name "" method))))
1647
1648     (goto-char (point-min))
1649     ;; We split this into to separate loops, one with the prefix
1650     ;; and one without to speed the reading up somewhat.
1651     (if prefix
1652         (let (min max opoint group)
1653           (while (not (eobp))
1654             (condition-case ()
1655                 (progn
1656                   (read cur) (read cur)
1657                   (setq min (read cur)
1658                         max (read cur)
1659                         opoint (point))
1660                   (skip-chars-forward " \t")
1661                   (insert prefix)
1662                   (goto-char opoint)
1663                   (set (let ((obarray hashtb)) (read cur))
1664                        (cons min max)))
1665               (error (and group (symbolp group) (set group nil))))
1666             (forward-line 1)))
1667       (let (min max group)
1668         (while (not (eobp))
1669           (condition-case ()
1670               (if (= (following-char) ?2)
1671                   (progn
1672                     (read cur) (read cur)
1673                     (setq min (read cur)
1674                           max (read cur))
1675                     (set (setq group (let ((obarray hashtb)) (read cur)))
1676                          (cons min max))))
1677             (error (and group (symbolp group) (set group nil))))
1678           (forward-line 1))))))
1679
1680 (defun gnus-read-newsrc-file (&optional force)
1681   "Read startup file.
1682 If FORCE is non-nil, the .newsrc file is read."
1683   ;; Reset variables that might be defined in the .newsrc.eld file.
1684   (let ((variables gnus-variable-list))
1685     (while variables
1686       (set (car variables) nil)
1687       (setq variables (cdr variables))))
1688   (let* ((newsrc-file gnus-current-startup-file)
1689          (quick-file (concat newsrc-file ".el")))
1690     (save-excursion
1691       ;; We always load the .newsrc.eld file.  If always contains
1692       ;; much information that can not be gotten from the .newsrc
1693       ;; file (ticked articles, killed groups, foreign methods, etc.)
1694       (gnus-read-newsrc-el-file quick-file)
1695
1696       (if (and (file-exists-p gnus-current-startup-file)
1697                (or force
1698                    (and (file-newer-than-file-p newsrc-file quick-file)
1699                         (file-newer-than-file-p newsrc-file
1700                                                 (concat quick-file "d")))
1701                    (not gnus-newsrc-alist)))
1702           ;; We read the .newsrc file.  Note that if there if a
1703           ;; .newsrc.eld file exists, it has already been read, and
1704           ;; the `gnus-newsrc-hashtb' has been created.  While reading
1705           ;; the .newsrc file, Gnus will only use the information it
1706           ;; can find there for changing the data already read -
1707           ;; ie. reading the .newsrc file will not trash the data
1708           ;; already read (except for read articles).
1709           (save-excursion
1710             (gnus-message 5 "Reading %s..." newsrc-file)
1711             (set-buffer (find-file-noselect newsrc-file))
1712             (buffer-disable-undo (current-buffer))
1713             (gnus-newsrc-to-gnus-format)
1714             (kill-buffer (current-buffer))
1715             (gnus-message 5 "Reading %s...done" newsrc-file)))
1716
1717       ;; Read any slave files.
1718       (unless gnus-slave
1719         (gnus-master-read-slave-newsrc))
1720       
1721       ;; Convert old to new.
1722       (gnus-convert-old-newsrc))))
1723
1724 (defun gnus-convert-old-newsrc ()
1725   "Convert old newsrc into the new format, if needed."
1726   (let ((fcv (and gnus-newsrc-file-version
1727                   (gnus-continuum-version gnus-newsrc-file-version))))
1728     (cond
1729      ;; No .newsrc.eld file was loaded.
1730      ((null fcv) nil)
1731      ;; Gnus 5 .newsrc.eld was loaded.
1732      ((< fcv (gnus-continuum-version "September Gnus v0.1"))
1733       (gnus-convert-old-ticks)))))
1734
1735 (defun gnus-convert-old-ticks ()
1736   (let ((newsrc (cdr gnus-newsrc-alist))
1737         marks info dormant ticked)
1738     (while (setq info (pop newsrc))
1739       (when (setq marks (gnus-info-marks info))
1740         (setq dormant (cdr (assq 'dormant marks))
1741               ticked (cdr (assq 'tick marks)))
1742         (when (or dormant ticked)
1743           (gnus-info-set-read
1744            info
1745            (gnus-add-to-range
1746             (gnus-info-read info)
1747             (nconc (gnus-uncompress-range dormant)
1748                    (gnus-uncompress-range ticked)))))))))
1749
1750 (defun gnus-read-newsrc-el-file (file)
1751   (let ((ding-file (concat file "d")))
1752     ;; We always, always read the .eld file.
1753     (gnus-message 5 "Reading %s..." ding-file)
1754     (let (gnus-newsrc-assoc)
1755       (condition-case nil
1756           (load ding-file t t t)
1757         (error
1758          (gnus-error 1 "Error in %s" ding-file)))
1759       (when gnus-newsrc-assoc
1760         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
1761     (gnus-make-hashtable-from-newsrc-alist)
1762     (when (file-newer-than-file-p file ding-file)
1763       ;; Old format quick file
1764       (gnus-message 5 "Reading %s..." file)
1765       ;; The .el file is newer than the .eld file, so we read that one
1766       ;; as well.
1767       (gnus-read-old-newsrc-el-file file))))
1768
1769 ;; Parse the old-style quick startup file
1770 (defun gnus-read-old-newsrc-el-file (file)
1771   (let (newsrc killed marked group m info)
1772     (prog1
1773         (let ((gnus-killed-assoc nil)
1774               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
1775           (prog1
1776               (condition-case nil
1777                   (load file t t t)
1778                 (error nil))
1779             (setq newsrc gnus-newsrc-assoc
1780                   killed gnus-killed-assoc
1781                   marked gnus-marked-assoc)))
1782       (setq gnus-newsrc-alist nil)
1783       (while (setq group (pop newsrc))
1784         (if (setq info (gnus-get-info (car group)))
1785             (progn
1786               (gnus-info-set-read info (cddr group))
1787               (gnus-info-set-level
1788                info (if (nth 1 group) gnus-level-default-subscribed
1789                       gnus-level-default-unsubscribed))
1790               (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
1791           (push (setq info
1792                       (list (car group)
1793                             (if (nth 1 group) gnus-level-default-subscribed
1794                               gnus-level-default-unsubscribed)
1795                             (cddr group)))
1796                 gnus-newsrc-alist))
1797         ;; Copy marks into info.
1798         (when (setq m (assoc (car group) marked))
1799           (unless (nthcdr 3 info)
1800             (nconc info (list nil)))
1801           (gnus-info-set-marks
1802            info (list (cons 'tick (gnus-compress-sequence 
1803                                    (sort (cdr m) '<) t))))))
1804       (setq newsrc killed)
1805       (while newsrc
1806         (setcar newsrc (caar newsrc))
1807         (setq newsrc (cdr newsrc)))
1808       (setq gnus-killed-list killed))
1809     ;; The .el file version of this variable does not begin with
1810     ;; "options", while the .eld version does, so we just add it if it
1811     ;; isn't there.
1812     (and
1813      gnus-newsrc-options
1814      (progn
1815        (and (not (string-match "^ *options" gnus-newsrc-options))
1816             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
1817        (and (not (string-match "\n$" gnus-newsrc-options))
1818             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
1819        ;; Finally, if we read some options lines, we parse them.
1820        (or (string= gnus-newsrc-options "")
1821            (gnus-newsrc-parse-options gnus-newsrc-options))))
1822
1823     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
1824     (gnus-make-hashtable-from-newsrc-alist)))
1825
1826 (defun gnus-make-newsrc-file (file)
1827   "Make server dependent file name by catenating FILE and server host name."
1828   (let* ((file (expand-file-name file nil))
1829          (real-file (concat file "-" (nth 1 gnus-select-method))))
1830     (if (or (file-exists-p real-file)
1831             (file-exists-p (concat real-file ".el"))
1832             (file-exists-p (concat real-file ".eld")))
1833         real-file file)))
1834
1835 (defun gnus-newsrc-to-gnus-format ()
1836   (setq gnus-newsrc-options "")
1837   (setq gnus-newsrc-options-n nil)
1838
1839   (or gnus-active-hashtb
1840       (setq gnus-active-hashtb (make-vector 4095 0)))
1841   (let ((buf (current-buffer))
1842         (already-read (> (length gnus-newsrc-alist) 1))
1843         group subscribed options-symbol newsrc Options-symbol
1844         symbol reads num1)
1845     (goto-char (point-min))
1846     ;; We intern the symbol `options' in the active hashtb so that we
1847     ;; can `eq' against it later.
1848     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
1849     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
1850
1851     (while (not (eobp))
1852       ;; We first read the first word on the line by narrowing and
1853       ;; then reading into `gnus-active-hashtb'.  Most groups will
1854       ;; already exist in that hashtb, so this will save some string
1855       ;; space.
1856       (narrow-to-region
1857        (point)
1858        (progn (skip-chars-forward "^ \t!:\n") (point)))
1859       (goto-char (point-min))
1860       (setq symbol
1861             (and (/= (point-min) (point-max))
1862                  (let ((obarray gnus-active-hashtb)) (read buf))))
1863       (widen)
1864       ;; Now, the symbol we have read is either `options' or a group
1865       ;; name.  If it is an options line, we just add it to a string.
1866       (cond
1867        ((or (eq symbol options-symbol)
1868             (eq symbol Options-symbol))
1869         (setq gnus-newsrc-options
1870               ;; This concating is quite inefficient, but since our
1871               ;; thorough studies show that approx 99.37% of all
1872               ;; .newsrc files only contain a single options line, we
1873               ;; don't give a damn, frankly, my dear.
1874               (concat gnus-newsrc-options
1875                       (buffer-substring
1876                        (gnus-point-at-bol)
1877                        ;; Options may continue on the next line.
1878                        (or (and (re-search-forward "^[^ \t]" nil 'move)
1879                                 (progn (beginning-of-line) (point)))
1880                            (point)))))
1881         (forward-line -1))
1882        (symbol
1883         ;; Group names can be just numbers.  
1884         (when (numberp symbol) 
1885           (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
1886         (or (boundp symbol) (set symbol nil))
1887         ;; It was a group name.
1888         (setq subscribed (= (following-char) ?:)
1889               group (symbol-name symbol)
1890               reads nil)
1891         (if (eolp)
1892             ;; If the line ends here, this is clearly a buggy line, so
1893             ;; we put point a the beginning of line and let the cond
1894             ;; below do the error handling.
1895             (beginning-of-line)
1896           ;; We skip to the beginning of the ranges.
1897           (skip-chars-forward "!: \t"))
1898         ;; We are now at the beginning of the list of read articles.
1899         ;; We read them range by range.
1900         (while
1901             (cond
1902              ((looking-at "[0-9]+")
1903               ;; We narrow and read a number instead of buffer-substring/
1904               ;; string-to-int because it's faster.  narrow/widen is
1905               ;; faster than save-restriction/narrow, and save-restriction
1906               ;; produces a garbage object.
1907               (setq num1 (progn
1908                            (narrow-to-region (match-beginning 0) (match-end 0))
1909                            (read buf)))
1910               (widen)
1911               ;; If the next character is a dash, then this is a range.
1912               (if (= (following-char) ?-)
1913                   (progn
1914                     ;; We read the upper bound of the range.
1915                     (forward-char 1)
1916                     (if (not (looking-at "[0-9]+"))
1917                         ;; This is a buggy line, by we pretend that
1918                         ;; it's kinda OK.  Perhaps the user should be
1919                         ;; dinged?
1920                         (setq reads (cons num1 reads))
1921                       (setq reads
1922                             (cons
1923                              (cons num1
1924                                    (progn
1925                                      (narrow-to-region (match-beginning 0)
1926                                                        (match-end 0))
1927                                      (read buf)))
1928                              reads))
1929                       (widen)))
1930                 ;; It was just a simple number, so we add it to the
1931                 ;; list of ranges.
1932                 (setq reads (cons num1 reads)))
1933               ;; If the next char in ?\n, then we have reached the end
1934               ;; of the line and return nil.
1935               (/= (following-char) ?\n))
1936              ((= (following-char) ?\n)
1937               ;; End of line, so we end.
1938               nil)
1939              (t
1940               ;; Not numbers and not eol, so this might be a buggy
1941               ;; line...
1942               (or (eobp)
1943                   ;; If it was eob instead of ?\n, we allow it.
1944                   (progn
1945                     ;; The line was buggy.
1946                     (setq group nil)
1947                     (gnus-error 3.1 "Mangled line: %s"
1948                                 (buffer-substring (gnus-point-at-bol)
1949                                                   (gnus-point-at-eol)))))
1950               nil))
1951           ;; Skip past ", ".  Spaces are illegal in these ranges, but
1952           ;; we allow them, because it's a common mistake to put a
1953           ;; space after the comma.
1954           (skip-chars-forward ", "))
1955
1956         ;; We have already read .newsrc.eld, so we gently update the
1957         ;; data in the hash table with the information we have just
1958         ;; read.
1959         (when group
1960           (let ((info (gnus-get-info group))
1961                 level)
1962             (if info
1963                 ;; There is an entry for this file in the alist.
1964                 (progn
1965                   (gnus-info-set-read info (nreverse reads))
1966                   ;; We update the level very gently.  In fact, we
1967                   ;; only change it if there's been a status change
1968                   ;; from subscribed to unsubscribed, or vice versa.
1969                   (setq level (gnus-info-level info))
1970                   (cond ((and (<= level gnus-level-subscribed)
1971                               (not subscribed))
1972                          (setq level (if reads
1973                                          gnus-level-default-unsubscribed
1974                                        (1+ gnus-level-default-unsubscribed))))
1975                         ((and (> level gnus-level-subscribed) subscribed)
1976                          (setq level gnus-level-default-subscribed)))
1977                   (gnus-info-set-level info level))
1978               ;; This is a new group.
1979               (setq info (list group
1980                                (if subscribed
1981                                    gnus-level-default-subscribed
1982                                  (if reads
1983                                      (1+ gnus-level-subscribed)
1984                                    gnus-level-default-unsubscribed))
1985                                (nreverse reads))))
1986             (setq newsrc (cons info newsrc))))))
1987       (forward-line 1))
1988
1989     (setq newsrc (nreverse newsrc))
1990
1991     (if (not already-read)
1992         ()
1993       ;; We now have two newsrc lists - `newsrc', which is what we
1994       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
1995       ;; what we've read from .newsrc.eld.  We have to merge these
1996       ;; lists.  We do this by "attaching" any (foreign) groups in the
1997       ;; gnus-newsrc-alist to the (native) group that precedes them.
1998       (let ((rc (cdr gnus-newsrc-alist))
1999             (prev gnus-newsrc-alist)
2000             entry mentry)
2001         (while rc
2002           (or (null (nth 4 (car rc)))   ; It's a native group.
2003               (assoc (caar rc) newsrc) ; It's already in the alist.
2004               (if (setq entry (assoc (caar prev) newsrc))
2005                   (setcdr (setq mentry (memq entry newsrc))
2006                           (cons (car rc) (cdr mentry)))
2007                 (setq newsrc (cons (car rc) newsrc))))
2008           (setq prev rc
2009                 rc (cdr rc)))))
2010
2011     (setq gnus-newsrc-alist newsrc)
2012     ;; We make the newsrc hashtb.
2013     (gnus-make-hashtable-from-newsrc-alist)
2014
2015     ;; Finally, if we read some options lines, we parse them.
2016     (or (string= gnus-newsrc-options "")
2017         (gnus-newsrc-parse-options gnus-newsrc-options))))
2018
2019 ;; Parse options lines to find "options -n !all rec.all" and stuff.
2020 ;; The return value will be a list on the form
2021 ;; ((regexp1 . ignore)
2022 ;;  (regexp2 . subscribe)...)
2023 ;; When handling new newsgroups, groups that match a `ignore' regexp
2024 ;; will be ignored, and groups that match a `subscribe' regexp will be
2025 ;; subscribed.  A line like
2026 ;; options -n !all rec.all
2027 ;; will lead to a list that looks like
2028 ;; (("^rec\\..+" . subscribe)
2029 ;;  ("^.+" . ignore))
2030 ;; So all "rec.*" groups will be subscribed, while all the other
2031 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
2032 ;; different from "options -n rec.all !all".
2033 (defun gnus-newsrc-parse-options (options)
2034   (let (out eol)
2035     (save-excursion
2036       (gnus-set-work-buffer)
2037       (insert (regexp-quote options))
2038       ;; First we treat all continuation lines.
2039       (goto-char (point-min))
2040       (while (re-search-forward "\n[ \t]+" nil t)
2041         (replace-match " " t t))
2042       ;; Then we transform all "all"s into ".+"s.
2043       (goto-char (point-min))
2044       (while (re-search-forward "\\ball\\b" nil t)
2045         (replace-match ".+" t t))
2046       (goto-char (point-min))
2047       ;; We remove all other options than the "-n" ones.
2048       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
2049         (replace-match " ")
2050         (forward-char -1))
2051       (goto-char (point-min))
2052
2053       ;; We are only interested in "options -n" lines - we
2054       ;; ignore the other option lines.
2055       (while (re-search-forward "[ \t]-n" nil t)
2056         (setq eol
2057               (or (save-excursion
2058                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
2059                          (- (point) 2)))
2060                   (gnus-point-at-eol)))
2061         ;; Search for all "words"...
2062         (while (re-search-forward "[^ \t,\n]+" eol t)
2063           (if (= (char-after (match-beginning 0)) ?!)
2064               ;; If the word begins with a bang (!), this is a "not"
2065               ;; spec.  We put this spec (minus the bang) and the
2066               ;; symbol `ignore' into the list.
2067               (setq out (cons (cons (concat
2068                                      "^" (buffer-substring
2069                                           (1+ (match-beginning 0))
2070                                           (match-end 0)))
2071                                     'ignore) out))
2072             ;; There was no bang, so this is a "yes" spec.
2073             (setq out (cons (cons (concat "^" (match-string 0))
2074                                   'subscribe) out)))))
2075
2076       (setq gnus-newsrc-options-n out))))
2077
2078 (defun gnus-save-newsrc-file (&optional force)
2079   "Save .newsrc file."
2080   ;; Note: We cannot save .newsrc file if all newsgroups are removed
2081   ;; from the variable gnus-newsrc-alist.
2082   (when (and (or gnus-newsrc-alist gnus-killed-list)
2083              gnus-current-startup-file)
2084     (save-excursion
2085       (if (and (or gnus-use-dribble-file gnus-slave)
2086                (not force)
2087                (or (not gnus-dribble-buffer)
2088                    (not (buffer-name gnus-dribble-buffer))
2089                    (zerop (save-excursion
2090                             (set-buffer gnus-dribble-buffer)
2091                             (buffer-size)))))
2092           (gnus-message 4 "(No changes need to be saved)")
2093         (run-hooks 'gnus-save-newsrc-hook)
2094         (if gnus-slave
2095             (gnus-slave-save-newsrc)
2096           ;; Save .newsrc.
2097           (when gnus-save-newsrc-file
2098             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
2099             (gnus-gnus-to-newsrc-format)
2100             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
2101           ;; Save .newsrc.eld.
2102           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
2103           (make-local-variable 'version-control)
2104           (setq version-control 'never)
2105           (setq buffer-file-name
2106                 (concat gnus-current-startup-file ".eld"))
2107           (setq default-directory (file-name-directory buffer-file-name))
2108           (gnus-add-current-to-buffer-list)
2109           (buffer-disable-undo (current-buffer))
2110           (erase-buffer)
2111           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
2112           (gnus-gnus-to-quick-newsrc-format)
2113           (run-hooks 'gnus-save-quick-newsrc-hook)
2114           (save-buffer)
2115           (kill-buffer (current-buffer))
2116           (gnus-message
2117            5 "Saving %s.eld...done" gnus-current-startup-file))
2118         (gnus-dribble-delete-file)
2119         (gnus-group-set-mode-line)))))
2120
2121 (defun gnus-gnus-to-quick-newsrc-format ()
2122   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
2123   (insert ";; Gnus startup file.\n")
2124   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
2125   (insert ";; to read .newsrc.\n")
2126   (insert "(setq gnus-newsrc-file-version "
2127           (prin1-to-string gnus-version) ")\n")
2128   (let ((variables
2129          (if gnus-save-killed-list gnus-variable-list
2130            ;; Remove the `gnus-killed-list' from the list of variables
2131            ;; to be saved, if required.
2132            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
2133         ;; Peel off the "dummy" group.
2134         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
2135         variable)
2136     ;; Insert the variables into the file.
2137     (while variables
2138       (when (and (boundp (setq variable (pop variables)))
2139                  (symbol-value variable))
2140         (insert "(setq " (symbol-name variable) " '")
2141         (prin1 (symbol-value variable) (current-buffer))
2142         (insert ")\n")))))
2143
2144 (defun gnus-gnus-to-newsrc-format ()
2145   ;; Generate and save the .newsrc file.
2146   (save-excursion
2147     (set-buffer (create-file-buffer gnus-current-startup-file))
2148     (let ((newsrc (cdr gnus-newsrc-alist))
2149           (standard-output (current-buffer))
2150           info ranges range method)
2151       (setq buffer-file-name gnus-current-startup-file)
2152       (setq default-directory (file-name-directory buffer-file-name))
2153       (buffer-disable-undo (current-buffer))
2154       (erase-buffer)
2155       ;; Write options.
2156       (if gnus-newsrc-options (insert gnus-newsrc-options))
2157       ;; Write subscribed and unsubscribed.
2158       (while (setq info (pop newsrc))
2159         ;; Don't write foreign groups to .newsrc.
2160         (when (or (null (setq method (gnus-info-method info)))
2161                   (equal method "native")
2162                   (gnus-server-equal method gnus-select-method))
2163           (insert (gnus-info-group info)
2164                   (if (> (gnus-info-level info) gnus-level-subscribed)
2165                       "!" ":"))
2166           (when (setq ranges (gnus-info-read info))
2167             (insert " ")
2168             (if (not (listp (cdr ranges)))
2169                 (if (= (car ranges) (cdr ranges))
2170                     (princ (car ranges))
2171                   (princ (car ranges))
2172                   (insert "-")
2173                   (princ (cdr ranges)))
2174               (while (setq range (pop ranges))
2175                 (if (or (atom range) (= (car range) (cdr range)))
2176                     (princ (or (and (atom range) range) (car range)))
2177                   (princ (car range))
2178                   (insert "-")
2179                   (princ (cdr range)))
2180                 (if ranges (insert ",")))))
2181           (insert "\n")))
2182       (make-local-variable 'version-control)
2183       (setq version-control 'never)
2184       ;; It has been reported that sometime the modtime on the .newsrc
2185       ;; file seems to be off.  We really do want to overwrite it, so
2186       ;; we clear the modtime here before saving.  It's a bit odd,
2187       ;; though...
2188       ;; sometimes the modtime clear isn't sufficient.  most brute force:
2189       ;; delete the silly thing entirely first.  but this fails to provide
2190       ;; such niceties as .newsrc~ creation.
2191       (if gnus-modtime-botch
2192           (delete-file gnus-startup-file)
2193         (clear-visited-file-modtime))
2194       (run-hooks 'gnus-save-standard-newsrc-hook)
2195       (save-buffer)
2196       (kill-buffer (current-buffer)))))
2197
2198 \f
2199 ;;;
2200 ;;; Slave functions.
2201 ;;;
2202
2203 (defun gnus-slave-save-newsrc ()
2204   (save-excursion
2205     (set-buffer gnus-dribble-buffer)
2206     (let ((slave-name
2207            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
2208       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
2209
2210 (defun gnus-master-read-slave-newsrc ()
2211   (let ((slave-files
2212          (directory-files
2213           (file-name-directory gnus-current-startup-file)
2214           t (concat
2215              "^" (regexp-quote
2216                   (concat
2217                    (file-name-nondirectory gnus-current-startup-file)
2218                    "-slave-")))
2219           t))
2220         file)
2221     (if (not slave-files)
2222         ()                              ; There are no slave files to read.
2223       (gnus-message 7 "Reading slave newsrcs...")
2224       (save-excursion
2225         (set-buffer (get-buffer-create " *gnus slave*"))
2226         (buffer-disable-undo (current-buffer))
2227         (setq slave-files
2228               (sort (mapcar (lambda (file)
2229                               (list (nth 5 (file-attributes file)) file))
2230                             slave-files)
2231                     (lambda (f1 f2)
2232                       (or (< (caar f1) (caar f2))
2233                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
2234         (while slave-files
2235           (erase-buffer)
2236           (setq file (nth 1 (car slave-files)))
2237           (insert-file-contents file)
2238           (if (condition-case ()
2239                   (progn
2240                     (eval-buffer (current-buffer))
2241                     t)
2242                 (error
2243                  (gnus-error 3.2 "Possible error in %s" file)
2244                  nil))
2245               (or gnus-slave ; Slaves shouldn't delete these files.
2246                   (condition-case ()
2247                       (delete-file file)
2248                     (error nil))))
2249           (setq slave-files (cdr slave-files))))
2250       (gnus-message 7 "Reading slave newsrcs...done"))))
2251
2252 \f
2253 ;;;
2254 ;;; Group description.
2255 ;;;
2256
2257 (defun gnus-read-all-descriptions-files ()
2258   (let ((methods (cons gnus-select-method 
2259                        (nconc
2260                         (when (gnus-archive-server-wanted-p)
2261                           (list "archive"))
2262                         gnus-secondary-select-methods))))
2263     (while methods
2264       (gnus-read-descriptions-file (car methods))
2265       (setq methods (cdr methods)))
2266     t))
2267
2268 (defun gnus-read-descriptions-file (&optional method)
2269   (let ((method (or method gnus-select-method))
2270         group)
2271     (when (stringp method)
2272       (setq method (gnus-server-to-method method)))
2273     ;; We create the hashtable whether we manage to read the desc file
2274     ;; to avoid trying to re-read after a failed read.
2275     (or gnus-description-hashtb
2276         (setq gnus-description-hashtb
2277               (gnus-make-hashtable (length gnus-active-hashtb))))
2278     ;; Mark this method's desc file as read.
2279     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
2280                   gnus-description-hashtb)
2281
2282     (gnus-message 5 "Reading descriptions file via %s..." (car method))
2283     (cond
2284      ((not (gnus-check-server method))
2285       (gnus-message 1 "Couldn't open server")
2286       nil)
2287      ((not (gnus-request-list-newsgroups method))
2288       (gnus-message 1 "Couldn't read newsgroups descriptions")
2289       nil)
2290      (t
2291       (save-excursion
2292         (save-restriction
2293           (set-buffer nntp-server-buffer)
2294           (goto-char (point-min))
2295           (when (or (search-forward "\n.\n" nil t)
2296                     (goto-char (point-max)))
2297             (beginning-of-line)
2298             (narrow-to-region (point-min) (point)))
2299           ;; If these are groups from a foreign select method, we insert the
2300           ;; group prefix in front of the group names.
2301           (and method (not (gnus-server-equal
2302                             (gnus-server-get-method nil method)
2303                             (gnus-server-get-method nil gnus-select-method)))
2304                (let ((prefix (gnus-group-prefixed-name "" method)))
2305                  (goto-char (point-min))
2306                  (while (and (not (eobp))
2307                              (progn (insert prefix)
2308                                     (zerop (forward-line 1)))))))
2309           (goto-char (point-min))
2310           (while (not (eobp))
2311             ;; If we get an error, we set group to 0, which is not a
2312             ;; symbol...
2313             (setq group
2314                   (condition-case ()
2315                       (let ((obarray gnus-description-hashtb))
2316                         ;; Group is set to a symbol interned in this
2317                         ;; hash table.
2318                         (read nntp-server-buffer))
2319                     (error 0)))
2320             (skip-chars-forward " \t")
2321             ;; ...  which leads to this line being effectively ignored.
2322             (and (symbolp group)
2323                  (set group (buffer-substring
2324                              (point) (progn (end-of-line) (point)))))
2325             (forward-line 1))))
2326       (gnus-message 5 "Reading descriptions file...done")
2327       t))))
2328
2329 (defun gnus-group-get-description (group)
2330   "Get the description of a group by sending XGTITLE to the server."
2331   (when (gnus-request-group-description group)
2332     (save-excursion
2333       (set-buffer nntp-server-buffer)
2334       (goto-char (point-min))
2335       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
2336         (match-string 1)))))
2337
2338 (provide 'gnus-start)
2339
2340 ;;; gnus-start.el ends here