(elisp): Change order of arguments to makeinfo.
[bpt/emacs.git] / lisp / gnus / gnus-start.el
CommitLineData
eec82323 1;;; gnus-start.el --- startup functions for Gnus
23f87bed 2;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
16409b0b 3;; Free Software Foundation, Inc.
eec82323 4
6748645f 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
eec82323
LMI
6;; Keywords: news
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
24
25;;; Commentary:
26
27;;; Code:
28
29(require 'gnus)
30(require 'gnus-win)
31(require 'gnus-int)
32(require 'gnus-spec)
33(require 'gnus-range)
34(require 'gnus-util)
23f87bed
MB
35(autoload 'message-make-date "message")
36(autoload 'gnus-agent-read-servers-validate "gnus-agent")
37(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
cb75201b 38(eval-when-compile (require 'cl))
eec82323
LMI
39
40(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
41 "Your `.newsrc' file.
42`.newsrc-SERVER' will be used instead if that exists."
43 :group 'gnus-start
44 :type 'file)
45
23f87bed
MB
46(defcustom gnus-backup-startup-file 'never
47 "Whether to create backup files.
48This variable takes the same values as the `version-control'
49variable."
a08b59c9 50 :version "21.4"
23f87bed
MB
51 :group 'gnus-start
52 :type '(choice (const :tag "Never" never)
53 (const :tag "If existing" nil)
54 (other :tag "Always" t)))
55
56(defcustom gnus-save-startup-file-via-temp-buffer t
57 "Whether to write the startup file contents to a buffer then save
58the buffer or write directly to the file. The buffer is faster
59because all of the contents are written at once. The direct write
60uses considerably less memory."
a08b59c9 61 :version "21.4"
23f87bed
MB
62 :group 'gnus-start
63 :type '(choice (const :tag "Write via buffer" t)
64 (const :tag "Write directly to file" nil)))
65
eec82323 66(defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
83be5c8c
RS
67 "Your Gnus Emacs-Lisp startup file name.
68If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
eec82323
LMI
69 :group 'gnus-start
70 :type 'file)
71
72(defcustom gnus-site-init-file
cb75201b 73 (condition-case nil
83be5c8c
RS
74 (concat (file-name-directory
75 (directory-file-name installation-directory))
76 "site-lisp/gnus-init")
cb75201b 77 (error nil))
16409b0b 78 "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
83be5c8c 79If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
eec82323 80 :group 'gnus-start
83be5c8c 81 :type '(choice file (const nil)))
eec82323
LMI
82
83(defcustom gnus-default-subscribed-newsgroups nil
83be5c8c
RS
84 "List of newsgroups to subscribe, when a user runs Gnus the first time.
85The value should be a list of strings.
86If it is t, Gnus will not do anything special the first time it is
eec82323
LMI
87started; it'll just use the normal newsgroups subscription methods."
88 :group 'gnus-start
83be5c8c 89 :type '(choice (repeat string) (const :tag "Nothing special" t)))
eec82323
LMI
90
91(defcustom gnus-use-dribble-file t
92 "*Non-nil means that Gnus will use a dribble file to store user updates.
93If Emacs should crash without saving the .newsrc files, complete
94information can be restored from the dribble file."
95 :group 'gnus-dribble-file
96 :type 'boolean)
97
98(defcustom gnus-dribble-directory nil
99 "*The directory where dribble files will be saved.
100If this variable is nil, the directory where the .newsrc files are
101saved will be used."
102 :group 'gnus-dribble-file
103 :type '(choice directory (const nil)))
104
a8151ef7 105(defcustom gnus-check-new-newsgroups 'ask-server
6748645f 106 "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup.
eec82323
LMI
107This normally finds new newsgroups by comparing the active groups the
108servers have already reported with those Gnus already knows, either alive
109or killed.
110
6748645f 111When any of the following are true, `gnus-find-new-newsgroups' will instead
eec82323
LMI
112ask the servers (primary, secondary, and archive servers) to list new
113groups since the last time it checked:
114 1. This variable is `ask-server'.
115 2. This variable is a list of select methods (see below).
116 3. `gnus-read-active-file' is nil or `some'.
6748645f 117 4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
eec82323
LMI
118
119Thus, if this variable is `ask-server' or a list of select methods or
120`gnus-read-active-file' is nil or `some', then the killed list is no
121longer necessary, so you could safely set `gnus-save-killed-list' to nil.
122
123This variable can be a list of select methods which Gnus will query with
124the `ask-server' method in addition to the primary, secondary, and archive
125servers.
126
127Eg.
128 (setq gnus-check-new-newsgroups
129 '((nntp \"some.server\") (nntp \"other.server\")))
130
131If this variable is nil, then you have to tell Gnus explicitly to
132check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
133 :group 'gnus-start
134 :type '(choice (const :tag "no" nil)
135 (const :tag "by brute force" t)
136 (const :tag "ask servers" ask-server)
137 (repeat :menu-tag "ask additional servers"
138 :tag "ask additional servers"
139 :value ((nntp ""))
140 (sexp :format "%v"))))
141
142(defcustom gnus-check-bogus-newsgroups nil
143 "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
144If this variable is nil, then you have to tell Gnus explicitly to
145check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]."
146 :group 'gnus-start-server
147 :type 'boolean)
148
a8151ef7 149(defcustom gnus-read-active-file 'some
eec82323
LMI
150 "*Non-nil means that Gnus will read the entire active file at startup.
151If this variable is nil, Gnus will only know about the groups in your
152`.newsrc' file.
153
154If this variable is `some', Gnus will try to only read the relevant
155parts of the active file from the server. Not all servers support
156this, and it might be quite slow with other servers, but this should
157generally be faster than both the t and nil value.
158
159If you set this variable to nil or `some', you probably still want to
160be told about new newsgroups that arrive. To do that, set
161`gnus-check-new-newsgroups' to `ask-server'. This may not work
162properly with all servers."
163 :group 'gnus-start-server
164 :type '(choice (const nil)
165 (const some)
166 (const t)))
167
16409b0b
GM
168(defconst gnus-level-subscribed 5
169 "Groups with levels less than or equal to this variable are subscribed.")
eec82323 170
16409b0b
GM
171(defconst gnus-level-unsubscribed 7
172 "Groups with levels less than or equal to this variable are unsubscribed.
eec82323 173Groups with levels less than `gnus-level-subscribed', which should be
16409b0b 174less than this variable, are subscribed.")
eec82323 175
16409b0b
GM
176(defconst gnus-level-zombie 8
177 "Groups with this level are zombie groups.")
eec82323 178
16409b0b
GM
179(defconst gnus-level-killed 9
180 "Groups with this level are killed.")
eec82323
LMI
181
182(defcustom gnus-level-default-subscribed 3
183 "*New subscribed groups will be subscribed at this level."
184 :group 'gnus-group-levels
185 :type 'integer)
186
187(defcustom gnus-level-default-unsubscribed 6
188 "*New unsubscribed groups will be unsubscribed at this level."
189 :group 'gnus-group-levels
190 :type 'integer)
191
192(defcustom gnus-activate-level (1+ gnus-level-subscribed)
193 "*Groups higher than this level won't be activated on startup.
194Setting this variable to something low might save lots of time when
195you have many groups that you aren't interested in."
196 :group 'gnus-group-levels
197 :type 'integer)
198
199(defcustom gnus-activate-foreign-newsgroups 4
200 "*If nil, Gnus will not check foreign newsgroups at startup.
201If it is non-nil, it should be a number between one and nine. Foreign
202newsgroups that have a level lower or equal to this number will be
203activated on startup. For instance, if you want to active all
204subscribed newsgroups, but not the rest, you'd set this variable to
205`gnus-level-subscribed'.
206
207If you subscribe to lots of newsgroups from different servers, startup
208might take a while. By setting this variable to nil, you'll save time,
209but you won't be told how many unread articles there are in the
210groups."
211 :group 'gnus-group-levels
6748645f
LMI
212 :type '(choice integer
213 (const :tag "none" nil)))
eec82323 214
16409b0b
GM
215(defcustom gnus-read-newsrc-file t
216 "*Non-nil means that Gnus will read the `.newsrc' file.
217Gnus always reads its own startup file, which is called
218\".newsrc.eld\". The file called \".newsrc\" is in a format that can
219be readily understood by other newsreaders. If you don't plan on
220using other newsreaders, set this variable to nil to save some time on
221entry."
0e5f03c1 222 :version "21.1"
16409b0b
GM
223 :group 'gnus-newsrc
224 :type 'boolean)
225
eec82323
LMI
226(defcustom gnus-save-newsrc-file t
227 "*Non-nil means that Gnus will save the `.newsrc' file.
228Gnus always saves its own startup file, which is called
229\".newsrc.eld\". The file called \".newsrc\" is in a format that can
230be readily understood by other newsreaders. If you don't plan on
231using other newsreaders, set this variable to nil to save some time on
232exit."
233 :group 'gnus-newsrc
234 :type 'boolean)
235
236(defcustom gnus-save-killed-list t
237 "*If non-nil, save the list of killed groups to the startup file.
238If you set this variable to nil, you'll save both time (when starting
239and quitting) and space (both memory and disk), but it will also mean
240that Gnus has no record of which groups are new and which are old, so
241the automatic new newsgroups subscription methods become meaningless.
242
243You should always set `gnus-check-new-newsgroups' to `ask-server' or
244nil if you set this variable to nil.
245
246This variable can also be a regexp. In that case, all groups that do
247not match this regexp will be removed before saving the list."
248 :group 'gnus-newsrc
23f87bed
MB
249 :type '(radio (sexp :format "Non-nil\n"
250 :match (lambda (widget value)
251 (and value (not (stringp value))))
252 :value t)
253 (const nil)
254 (regexp :format "%t: %v\n" :size 0)))
eec82323
LMI
255
256(defcustom gnus-ignored-newsgroups
16409b0b
GM
257 (mapconcat 'identity
258 '("^to\\." ; not "real" groups
23f87bed 259 "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
16409b0b
GM
260 "^[\"][]\"[#'()]" ; bogus characters
261 )
262 "\\|")
6748645f 263 "*A regexp to match uninteresting newsgroups in the active file.
eec82323
LMI
264Any lines in the active file matching this regular expression are
265removed from the newsgroup list before anything else is done to it,
266thus making them effectively non-existent."
267 :group 'gnus-group-new
268 :type 'regexp)
269
270(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
23f87bed 271 "*Function(s) called with a group name when new group is detected.
eec82323
LMI
272A few pre-made functions are supplied: `gnus-subscribe-randomly'
273inserts new groups at the beginning of the list of groups;
274`gnus-subscribe-alphabetically' inserts new groups in strict
275alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
276in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
277for your decision; `gnus-subscribe-killed' kills all new groups;
16409b0b
GM
278`gnus-subscribe-zombies' will make all new groups into zombies;
279`gnus-subscribe-topics' will enter groups into the topics that
280claim them."
eec82323
LMI
281 :group 'gnus-group-new
282 :type '(radio (function-item gnus-subscribe-randomly)
283 (function-item gnus-subscribe-alphabetically)
284 (function-item gnus-subscribe-hierarchically)
285 (function-item gnus-subscribe-interactively)
286 (function-item gnus-subscribe-killed)
287 (function-item gnus-subscribe-zombies)
16409b0b 288 (function-item gnus-subscribe-topics)
23f87bed
MB
289 function
290 (repeat function)))
291
292(defcustom gnus-subscribe-newsgroup-hooks nil
293 "*Hooks run after you subscribe to a new group.
294The hooks will be called with new group's name as argument."
295 :group 'gnus-group-new
296 :type 'hook)
eec82323 297
eec82323
LMI
298(defcustom gnus-subscribe-options-newsgroup-method
299 'gnus-subscribe-alphabetically
23f87bed 300 "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
eec82323
LMI
301If, for instance, you want to subscribe to all newsgroups in the
302\"no\" and \"alt\" hierarchies, you'd put the following in your
303.newsrc file:
304
305options -n no.all alt.all
306
307Gnus will the subscribe all new newsgroups in these hierarchies with
308the subscription method in this variable."
309 :group 'gnus-group-new
310 :type '(radio (function-item gnus-subscribe-randomly)
311 (function-item gnus-subscribe-alphabetically)
312 (function-item gnus-subscribe-hierarchically)
313 (function-item gnus-subscribe-interactively)
314 (function-item gnus-subscribe-killed)
315 (function-item gnus-subscribe-zombies)
23f87bed
MB
316 (function-item gnus-subscribe-topics)
317 function
318 (repeat function)))
eec82323
LMI
319
320(defcustom gnus-subscribe-hierarchical-interactive nil
321 "*If non-nil, Gnus will offer to subscribe hierarchically.
322When a new hierarchy appears, Gnus will ask the user:
323
324'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
325
326If the user pressed `d', Gnus will descend the hierarchy, `y' will
327subscribe to all newsgroups in the hierarchy and `s' will skip this
328hierarchy in its entirety."
329 :group 'gnus-group-new
330 :type 'boolean)
331
332(defcustom gnus-auto-subscribed-groups
23f87bed 333 "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
eec82323
LMI
334 "*All new groups that match this regexp will be subscribed automatically.
335Note that this variable only deals with new groups. It has no effect
336whatsoever on old groups.
337
338New groups that match this regexp will not be handled by
339`gnus-subscribe-newsgroup-method'. Instead, they will
340be subscribed using `gnus-subscribe-options-newsgroup-method'."
341 :group 'gnus-group-new
342 :type 'regexp)
343
344(defcustom gnus-options-subscribe nil
345 "*All new groups matching this regexp will be subscribed unconditionally.
346Note that this variable deals only with new newsgroups. This variable
347does not affect old newsgroups.
348
349New groups that match this regexp will not be handled by
350`gnus-subscribe-newsgroup-method'. Instead, they will
351be subscribed using `gnus-subscribe-options-newsgroup-method'."
352 :group 'gnus-group-new
353 :type '(choice regexp
354 (const :tag "none" nil)))
355
356(defcustom gnus-options-not-subscribe nil
357 "*All new groups matching this regexp will be ignored.
358Note that this variable deals only with new newsgroups. This variable
359does not affect old (already subscribed) newsgroups."
360 :group 'gnus-group-new
361 :type '(choice regexp
362 (const :tag "none" nil)))
363
364(defcustom gnus-modtime-botch nil
365 "*Non-nil means .newsrc should be deleted prior to save.
366Its use is due to the bogus appearance that .newsrc was modified on
367disc."
368 :group 'gnus-newsrc
369 :type 'boolean)
370
371(defcustom gnus-check-bogus-groups-hook nil
372 "A hook run after removing bogus groups."
373 :group 'gnus-start-server
374 :type 'hook)
375
376(defcustom gnus-startup-hook nil
377 "A hook called at startup.
378This hook is called after Gnus is connected to the NNTP server."
379 :group 'gnus-start
380 :type 'hook)
381
6748645f
LMI
382(defcustom gnus-before-startup-hook nil
383 "A hook called at before startup.
384This hook is called as the first thing when Gnus is started."
385 :group 'gnus-start
386 :type 'hook)
387
eec82323
LMI
388(defcustom gnus-started-hook nil
389 "A hook called as the last thing after startup."
390 :group 'gnus-start
391 :type 'hook)
392
23f87bed
MB
393(defcustom gnus-setup-news-hook
394 '(gnus-fixup-nnimap-unread-after-getting-new-news)
6748645f
LMI
395 "A hook after reading the .newsrc file, but before generating the buffer."
396 :group 'gnus-start
397 :type 'hook)
398
23f87bed
MB
399(defcustom gnus-get-top-new-news-hook nil
400 "A hook run just before Gnus checks for new news globally."
401 :group 'gnus-group-new
402 :type 'hook)
403
eec82323
LMI
404(defcustom gnus-get-new-news-hook nil
405 "A hook run just before Gnus checks for new news."
406 :group 'gnus-group-new
407 :type 'hook)
408
409(defcustom gnus-after-getting-new-news-hook
23f87bed
MB
410 '(gnus-display-time-event-handler
411 gnus-fixup-nnimap-unread-after-getting-new-news)
16409b0b 412 "*A hook run after Gnus checks for new news when Gnus is already running."
eec82323
LMI
413 :group 'gnus-group-new
414 :type 'hook)
415
23f87bed
MB
416(defcustom gnus-read-newsrc-el-hook nil
417 "A hook called after reading the newsrc.eld? file."
418 :group 'gnus-newsrc
419 :type 'hook)
420
eec82323
LMI
421(defcustom gnus-save-newsrc-hook nil
422 "A hook called before saving any of the newsrc files."
423 :group 'gnus-newsrc
424 :type 'hook)
425
426(defcustom gnus-save-quick-newsrc-hook nil
427 "A hook called just before saving the quick newsrc file.
428Can be used to turn version control on or off."
429 :group 'gnus-newsrc
430 :type 'hook)
431
432(defcustom gnus-save-standard-newsrc-hook nil
433 "A hook called just before saving the standard newsrc file.
434Can be used to turn version control on or off."
435 :group 'gnus-newsrc
436 :type 'hook)
437
23f87bed
MB
438(defcustom gnus-group-mode-hook nil
439 "Hook for Gnus group mode."
440 :group 'gnus-group-various
441 :options '(gnus-topic-mode)
442 :type 'hook)
443
6748645f 444(defcustom gnus-always-read-dribble-file nil
16409b0b 445 "Unconditionally read the dribble file."
6748645f
LMI
446 :group 'gnus-newsrc
447 :type 'boolean)
448
2d2820a4
GM
449;;; Internal variables
450
39d74434
SZ
451(defvar gnus-ding-file-coding-system mm-universal-coding-system
452 "Coding system for ding file.")
eec82323
LMI
453
454(defvar gnus-newsrc-file-version nil)
455(defvar gnus-override-subscribe-method nil)
456(defvar gnus-dribble-buffer nil)
457(defvar gnus-newsrc-options nil
458 "Options line in the .newsrc file.")
459
460(defvar gnus-newsrc-options-n nil
461 "List of regexps representing groups to be subscribed/ignored unconditionally.")
462
463(defvar gnus-newsrc-last-checked-date nil
464 "Date Gnus last asked server for new newsgroups.")
465
466(defvar gnus-current-startup-file nil
467 "Startup file for the current host.")
468
469;; Byte-compiler warning.
470(defvar gnus-group-line-format)
471
472;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
473(defvar gnus-init-inhibit nil)
474(defun gnus-read-init-file (&optional inhibit-next)
475 ;; Don't load .gnus if the -q option was used.
476 (when init-file-user
477 (if gnus-init-inhibit
478 (setq gnus-init-inhibit nil)
479 (setq gnus-init-inhibit inhibit-next)
39d74434
SZ
480 (dolist (file (list gnus-site-init-file gnus-init-file))
481 (when (and file
482 (locate-library file))
483 (if (or debug-on-error debug-on-quit)
484 (load file nil t)
485 (condition-case var
486 (load file nil t)
487 (error
23f87bed 488 (error "Error in %s: %s" file (cadr var))))))))))
eec82323
LMI
489
490;; For subscribing new newsgroup
491
492(defun gnus-subscribe-hierarchical-interactive (groups)
493 (let ((groups (sort groups 'string<))
494 prefixes prefix start ans group starts)
495 (while groups
496 (setq prefixes (list "^"))
497 (while (and groups prefixes)
498 (while (not (string-match (car prefixes) (car groups)))
499 (setq prefixes (cdr prefixes)))
500 (setq prefix (car prefixes))
501 (setq start (1- (length prefix)))
502 (if (and (string-match "[^\\.]\\." (car groups) start)
503 (cdr groups)
504 (setq prefix
505 (concat "^" (substring (car groups) 0 (match-end 0))))
506 (string-match prefix (cadr groups)))
507 (progn
508 (push prefix prefixes)
509 (message "Descend hierarchy %s? ([y]nsq): "
510 (substring prefix 1 (1- (length prefix))))
6748645f
LMI
511 (while (not (memq (setq ans (read-char-exclusive))
512 '(?y ?\n ?\r ?n ?s ?q)))
eec82323
LMI
513 (ding)
514 (message "Descend hierarchy %s? ([y]nsq): "
515 (substring prefix 1 (1- (length prefix)))))
516 (cond ((= ans ?n)
517 (while (and groups
518 (string-match prefix
519 (setq group (car groups))))
520 (push group gnus-killed-list)
521 (gnus-sethash group group gnus-killed-hashtb)
522 (setq groups (cdr groups)))
523 (setq starts (cdr starts)))
524 ((= ans ?s)
525 (while (and groups
526 (string-match prefix
527 (setq group (car groups))))
528 (gnus-sethash group group gnus-killed-hashtb)
529 (gnus-subscribe-alphabetically (car groups))
530 (setq groups (cdr groups)))
531 (setq starts (cdr starts)))
532 ((= ans ?q)
533 (while groups
534 (setq group (car groups))
535 (push group gnus-killed-list)
536 (gnus-sethash group group gnus-killed-hashtb)
537 (setq groups (cdr groups))))
538 (t nil)))
539 (message "Subscribe %s? ([n]yq)" (car groups))
6748645f
LMI
540 (while (not (memq (setq ans (read-char-exclusive))
541 '(?y ?\n ?\r ?q ?n)))
eec82323
LMI
542 (ding)
543 (message "Subscribe %s? ([n]yq)" (car groups)))
544 (setq group (car groups))
545 (cond ((= ans ?y)
546 (gnus-subscribe-alphabetically (car groups))
547 (gnus-sethash group group gnus-killed-hashtb))
548 ((= ans ?q)
549 (while groups
550 (setq group (car groups))
551 (push group gnus-killed-list)
552 (gnus-sethash group group gnus-killed-hashtb)
553 (setq groups (cdr groups))))
554 (t
555 (push group gnus-killed-list)
556 (gnus-sethash group group gnus-killed-hashtb)))
557 (setq groups (cdr groups)))))))
558
559(defun gnus-subscribe-randomly (newsgroup)
560 "Subscribe new NEWSGROUP by making it the first newsgroup."
561 (gnus-subscribe-newsgroup newsgroup))
562
563(defun gnus-subscribe-alphabetically (newgroup)
23f87bed 564 "Subscribe new NEWGROUP and insert it in alphabetical order."
eec82323
LMI
565 (let ((groups (cdr gnus-newsrc-alist))
566 before)
567 (while (and (not before) groups)
568 (if (string< newgroup (caar groups))
569 (setq before (caar groups))
570 (setq groups (cdr groups))))
571 (gnus-subscribe-newsgroup newgroup before)))
572
573(defun gnus-subscribe-hierarchically (newgroup)
23f87bed 574 "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
eec82323
LMI
575 ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
576 (save-excursion
577 (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
23f87bed
MB
578 (prog1
579 (let ((groupkey newgroup) before)
580 (while (and (not before) groupkey)
581 (goto-char (point-min))
582 (let ((groupkey-re
583 (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
584 (while (and (re-search-forward groupkey-re nil t)
585 (progn
586 (setq before (match-string 1))
587 (string< before newgroup)))))
588 ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
589 (setq groupkey
590 (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
591 (substring groupkey (match-beginning 1) (match-end 1)))))
592 (gnus-subscribe-newsgroup newgroup before))
593 (kill-buffer (current-buffer)))))
eec82323
LMI
594
595(defun gnus-subscribe-interactively (group)
596 "Subscribe the new GROUP interactively.
597It is inserted in hierarchical newsgroup order if subscribed. If not,
598it is killed."
599 (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
600 (gnus-subscribe-hierarchically group)
601 (push group gnus-killed-list)))
602
603(defun gnus-subscribe-zombies (group)
604 "Make the new GROUP into a zombie group."
605 (push group gnus-zombie-list))
606
607(defun gnus-subscribe-killed (group)
608 "Make the new GROUP a killed group."
609 (push group gnus-killed-list))
610
611(defun gnus-subscribe-newsgroup (newsgroup &optional next)
612 "Subscribe new NEWSGROUP.
613If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
614the first newsgroup."
615 (save-excursion
616 (goto-char (point-min))
617 ;; We subscribe the group by changing its level to `subscribed'.
618 (gnus-group-change-level
619 newsgroup gnus-level-default-subscribed
620 gnus-level-killed (gnus-gethash (or next "dummy.group")
621 gnus-newsrc-hashtb))
23f87bed
MB
622 (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
623 (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
624 t))
eec82323
LMI
625
626(defun gnus-read-active-file-p ()
627 "Say whether the active file has been read from `gnus-select-method'."
628 (memq gnus-select-method gnus-have-read-active-file))
629
630;;; General various misc type functions.
631
632;; Silence byte-compiler.
23f87bed
MB
633(eval-when-compile
634 (defvar gnus-current-headers)
635 (defvar gnus-thread-indent-array)
636 (defvar gnus-newsgroup-name)
637 (defvar gnus-newsgroup-headers)
638 (defvar gnus-group-list-mode)
639 (defvar gnus-group-mark-positions)
640 (defvar gnus-newsgroup-data)
641 (defvar gnus-newsgroup-unreads)
642 (defvar nnoo-state-alist)
643 (defvar gnus-current-select-method)
644 (defvar mail-sources)
645 (defvar nnmail-scan-directory-mail-source-once)
646 (defvar nnmail-split-history)
647 (defvar nnmail-spool-file))
648
649(defun gnus-close-all-servers ()
650 "Close all servers."
651 (interactive)
652 (dolist (server gnus-opened-servers)
653 (gnus-close-server (car server))))
6748645f 654
eec82323
LMI
655(defun gnus-clear-system ()
656 "Clear all variables and buffers."
657 ;; Clear Gnus variables.
23f87bed 658 (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
eec82323
LMI
659 (while variables
660 (set (car variables) nil)
661 (setq variables (cdr variables))))
662 ;; Clear other internal variables.
663 (setq gnus-list-of-killed-groups nil
664 gnus-have-read-active-file nil
23f87bed
MB
665 gnus-agent-covered-methods nil
666 gnus-server-method-cache nil
eec82323
LMI
667 gnus-newsrc-alist nil
668 gnus-newsrc-hashtb nil
669 gnus-killed-list nil
670 gnus-zombie-list nil
671 gnus-killed-hashtb nil
672 gnus-active-hashtb nil
673 gnus-moderated-hashtb nil
674 gnus-description-hashtb nil
675 gnus-current-headers nil
676 gnus-thread-indent-array nil
677 gnus-newsgroup-headers nil
678 gnus-newsgroup-name nil
679 gnus-server-alist nil
680 gnus-group-list-mode nil
681 gnus-opened-servers nil
682 gnus-group-mark-positions nil
683 gnus-newsgroup-data nil
684 gnus-newsgroup-unreads nil
685 nnoo-state-alist nil
6748645f 686 gnus-current-select-method nil
16409b0b 687 nnmail-split-history nil
6748645f 688 gnus-ephemeral-servers nil)
eec82323
LMI
689 (gnus-shutdown 'gnus)
690 ;; Kill the startup file.
691 (and gnus-current-startup-file
692 (get-file-buffer gnus-current-startup-file)
693 (kill-buffer (get-file-buffer gnus-current-startup-file)))
694 ;; Clear the dribble buffer.
695 (gnus-dribble-clear)
696 ;; Kill global KILL file buffer.
697 (when (get-file-buffer (gnus-newsgroup-kill-file nil))
698 (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
699 (gnus-kill-buffer nntp-server-buffer)
700 ;; Kill Gnus buffers.
23f87bed
MB
701 (dolist (buffer (gnus-buffers))
702 (gnus-kill-buffer buffer))
eec82323
LMI
703 ;; Remove Gnus frames.
704 (gnus-kill-gnus-frames))
705
706(defun gnus-no-server-1 (&optional arg slave)
707 "Read network news.
708If ARG is a positive number, Gnus will use that as the
709startup level. If ARG is nil, Gnus will be started at level 2.
710If ARG is non-nil and not a positive number, Gnus will
711prompt the user for the name of an NNTP server to use.
712As opposed to `gnus', this command will not connect to the local server."
713 (interactive "P")
714 (let ((val (or arg (1- gnus-level-default-subscribed))))
715 (gnus val t slave)
716 (make-local-variable 'gnus-group-use-permanent-levels)
717 (setq gnus-group-use-permanent-levels val)))
718
719(defun gnus-1 (&optional arg dont-connect slave)
720 "Read network news.
721If ARG is non-nil and a positive number, Gnus will use that as the
722startup level. If ARG is non-nil and not a positive number, Gnus will
723prompt the user for the name of an NNTP server to use."
724 (interactive "P")
725
6748645f 726 (if (gnus-alive-p)
eec82323
LMI
727 (progn
728 (switch-to-buffer gnus-group-buffer)
729 (gnus-group-get-new-news
730 (and (numberp arg)
731 (> arg 0)
732 (max (car gnus-group-list-mode) arg))))
733
eec82323 734 (gnus-clear-system)
6748645f
LMI
735 (gnus-splash)
736 (gnus-run-hooks 'gnus-before-startup-hook)
eec82323 737 (nnheader-init-server-buffer)
eec82323 738 (setq gnus-slave slave)
a8151ef7 739 (gnus-read-init-file)
23f87bed
MB
740 (if gnus-agent
741 (gnus-agentize))
eec82323 742
6748645f 743 (when gnus-simple-splash
eec82323 744 (setq gnus-simple-splash nil)
6748645f 745 (cond
4ddf0e64 746 ((featurep 'xemacs)
6748645f 747 (gnus-xmas-splash))
7d188d3d 748 ((and window-system
6748645f
LMI
749 (= (frame-height) (1+ (window-height))))
750 (gnus-x-splash))))
eec82323
LMI
751
752 (let ((level (and (numberp arg) (> arg 0) arg))
753 did-connect)
754 (unwind-protect
755 (progn
756 (unless dont-connect
757 (setq did-connect
758 (gnus-start-news-server (and arg (not level))))))
759 (if (and (not dont-connect)
760 (not did-connect))
761 (gnus-group-quit)
6748645f 762 (gnus-run-hooks 'gnus-startup-hook)
eec82323
LMI
763 ;; NNTP server is successfully open.
764
765 ;; Find the current startup file name.
766 (setq gnus-current-startup-file
767 (gnus-make-newsrc-file gnus-startup-file))
768
769 ;; Read the dribble file.
770 (when (or gnus-slave gnus-use-dribble-file)
771 (gnus-dribble-read-file))
772
773 ;; Allow using GroupLens predictions.
774 (when gnus-use-grouplens
775 (bbb-login)
776 (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
777
778 ;; Do the actual startup.
23f87bed
MB
779 (if gnus-agent
780 (gnus-request-create-group "queue" '(nndraft "")))
781 (gnus-request-create-group "drafts" '(nndraft ""))
eec82323 782 (gnus-setup-news nil level dont-connect)
6748645f
LMI
783 (gnus-run-hooks 'gnus-setup-news-hook)
784 (gnus-start-draft-setup)
eec82323
LMI
785 ;; Generate the group buffer.
786 (gnus-group-list-groups level)
787 (gnus-group-first-unread-group)
788 (gnus-configure-windows 'group)
789 (gnus-group-set-mode-line)
6748645f
LMI
790 (gnus-run-hooks 'gnus-started-hook))))))
791
792(defun gnus-start-draft-setup ()
793 "Make sure the draft group exists."
794 (gnus-request-create-group "drafts" '(nndraft ""))
795 (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb)
796 (let ((gnus-level-default-subscribed 1))
797 (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))
798 (gnus-group-set-parameter
799 "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
eec82323 800
eec82323
LMI
801\f
802;;;
803;;; Dribble file
804;;;
805
806(defvar gnus-dribble-ignore nil)
807(defvar gnus-dribble-eval-file nil)
808
809(defun gnus-dribble-file-name ()
810 "Return the dribble file for the current .newsrc."
811 (concat
812 (if gnus-dribble-directory
813 (concat (file-name-as-directory gnus-dribble-directory)
814 (file-name-nondirectory gnus-current-startup-file))
815 gnus-current-startup-file)
816 "-dribble"))
817
818(defun gnus-dribble-enter (string)
819 "Enter STRING into the dribble buffer."
820 (when (and (not gnus-dribble-ignore)
821 gnus-dribble-buffer
822 (buffer-name gnus-dribble-buffer))
823 (let ((obuf (current-buffer)))
824 (set-buffer gnus-dribble-buffer)
825 (goto-char (point-max))
826 (insert string "\n")
23f87bed
MB
827 ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
828 ;; It causes problems with both XEmacs and Emacs 21, and doesn't
829 ;; seem to be of much value. (FIXME: remove this after we make sure
830 ;; it's not needed).
831 ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
eec82323 832 (bury-buffer gnus-dribble-buffer)
6748645f
LMI
833 (save-excursion
834 (set-buffer gnus-group-buffer)
835 (gnus-group-set-mode-line))
eec82323
LMI
836 (set-buffer obuf))))
837
838(defun gnus-dribble-touch ()
839 "Touch the dribble buffer."
840 (gnus-dribble-enter ""))
841
842(defun gnus-dribble-read-file ()
843 "Read the dribble file from disk."
844 (let ((dribble-file (gnus-dribble-file-name)))
845 (save-excursion
846 (set-buffer (setq gnus-dribble-buffer
6748645f 847 (gnus-get-buffer-create
eec82323 848 (file-name-nondirectory dribble-file))))
eec82323
LMI
849 (erase-buffer)
850 (setq buffer-file-name dribble-file)
851 (auto-save-mode t)
16409b0b 852 (buffer-disable-undo)
eec82323
LMI
853 (bury-buffer (current-buffer))
854 (set-buffer-modified-p nil)
855 (let ((auto (make-auto-save-file-name))
856 (gnus-dribble-ignore t)
23f87bed 857 (purpose nil)
eec82323
LMI
858 modes)
859 (when (or (file-exists-p auto) (file-exists-p dribble-file))
860 ;; Load whichever file is newest -- the auto save file
861 ;; or the "real" file.
862 (if (file-newer-than-file-p auto dribble-file)
863 (nnheader-insert-file-contents auto)
864 (nnheader-insert-file-contents dribble-file))
865 (unless (zerop (buffer-size))
866 (set-buffer-modified-p t))
867 ;; Set the file modes to reflect the .newsrc file modes.
868 (save-buffer)
869 (when (and (file-exists-p gnus-current-startup-file)
a8151ef7 870 (file-exists-p dribble-file)
eec82323
LMI
871 (setq modes (file-modes gnus-current-startup-file)))
872 (set-file-modes dribble-file modes))
23f87bed
MB
873 (goto-char (point-min))
874 (when (search-forward "Gnus was exited on purpose" nil t)
875 (setq purpose t))
eec82323 876 ;; Possibly eval the file later.
6748645f
LMI
877 (when (or gnus-always-read-dribble-file
878 (gnus-y-or-n-p
23f87bed
MB
879 (if purpose
880 "Gnus exited on purpose without saving; read auto-save file anyway? "
881 "Gnus auto-save file exists. Do you want to read it? ")))
eec82323
LMI
882 (setq gnus-dribble-eval-file t)))))))
883
884(defun gnus-dribble-eval-file ()
885 (when gnus-dribble-eval-file
886 (setq gnus-dribble-eval-file nil)
887 (save-excursion
888 (let ((gnus-dribble-ignore t))
889 (set-buffer gnus-dribble-buffer)
890 (eval-buffer (current-buffer))))))
891
892(defun gnus-dribble-delete-file ()
893 (when (file-exists-p (gnus-dribble-file-name))
894 (delete-file (gnus-dribble-file-name)))
895 (when gnus-dribble-buffer
896 (save-excursion
897 (set-buffer gnus-dribble-buffer)
898 (let ((auto (make-auto-save-file-name)))
899 (when (file-exists-p auto)
900 (delete-file auto))
901 (erase-buffer)
902 (set-buffer-modified-p nil)))))
903
904(defun gnus-dribble-save ()
905 (when (and gnus-dribble-buffer
906 (buffer-name gnus-dribble-buffer))
907 (save-excursion
908 (set-buffer gnus-dribble-buffer)
909 (save-buffer))))
910
911(defun gnus-dribble-clear ()
912 (when (gnus-buffer-exists-p gnus-dribble-buffer)
913 (save-excursion
914 (set-buffer gnus-dribble-buffer)
915 (erase-buffer)
916 (set-buffer-modified-p nil)
917 (setq buffer-saved-size (buffer-size)))))
918
919\f
920;;;
921;;; Active & Newsrc File Handling
922;;;
923
924(defun gnus-setup-news (&optional rawfile level dont-connect)
925 "Setup news information.
926If RAWFILE is non-nil, the .newsrc file will also be read.
927If LEVEL is non-nil, the news will be set up at level LEVEL."
16409b0b
GM
928 (require 'nnmail)
929 (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))
930 ;; Binding this variable will inhibit multiple fetchings
931 ;; of the same mail source.
932 (nnmail-fetched-sources (list t)))
eec82323
LMI
933
934 (when init
935 ;; Clear some variables to re-initialize news information.
936 (setq gnus-newsrc-alist nil
937 gnus-active-hashtb nil)
938 ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
939 (gnus-read-newsrc-file rawfile))
940
6748645f
LMI
941 ;; Make sure the archive server is available to all and sundry.
942 (when gnus-message-archive-method
23f87bed
MB
943 (unless (assoc "archive" gnus-server-alist)
944 (push `("archive"
945 nnfolder
946 "archive"
947 (nnfolder-directory
948 ,(nnheader-concat message-directory "archive"))
949 (nnfolder-active-file
950 ,(nnheader-concat message-directory "archive/active"))
951 (nnfolder-get-new-mail nil)
952 (nnfolder-inhibit-expiry t))
953 gnus-server-alist)))
eec82323
LMI
954
955 ;; If we don't read the complete active file, we fill in the
956 ;; hashtb here.
957 (when (or (null gnus-read-active-file)
958 (eq gnus-read-active-file 'some))
959 (gnus-update-active-hashtb-from-killed))
960
23f87bed
MB
961 ;; Validate agent covered methods now that gnus-server-alist has
962 ;; been initialized.
963 ;; NOTE: This is here for one purpose only. By validating the
964 ;; agentized server's, it converts the old 5.10.3, and earlier,
965 ;; format to the current format. That enables the agent code
966 ;; within gnus-read-active-file to function correctly.
967 (if gnus-agent
968 (gnus-agent-read-servers-validate))
969
eec82323
LMI
970 ;; Read the active file and create `gnus-active-hashtb'.
971 ;; If `gnus-read-active-file' is nil, then we just create an empty
972 ;; hash table. The partial filling out of the hash table will be
973 ;; done in `gnus-get-unread-articles'.
974 (and gnus-read-active-file
975 (not level)
a8151ef7 976 (gnus-read-active-file nil dont-connect))
eec82323
LMI
977
978 (unless gnus-active-hashtb
979 (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
980
981 ;; Initialize the cache.
982 (when gnus-use-cache
983 (gnus-cache-open))
984
985 ;; Possibly eval the dribble file.
986 (and init
987 (or gnus-use-dribble-file gnus-slave)
988 (gnus-dribble-eval-file))
989
990 ;; Slave Gnusii should then clear the dribble buffer.
991 (when (and init gnus-slave)
992 (gnus-dribble-clear))
993
994 (gnus-update-format-specifications)
995
996 ;; See whether we need to read the description file.
997 (when (and (boundp 'gnus-group-line-format)
23f87bed 998 (stringp gnus-group-line-format)
a8151ef7
LMI
999 (let ((case-fold-search nil))
1000 (string-match "%[-,0-9]*D" gnus-group-line-format))
eec82323
LMI
1001 (not gnus-description-hashtb)
1002 (not dont-connect)
1003 gnus-read-active-file)
1004 (gnus-read-all-descriptions-files))
1005
1006 ;; Find new newsgroups and treat them.
1007 (when (and init gnus-check-new-newsgroups (not level)
1008 (gnus-check-server gnus-select-method)
6748645f
LMI
1009 (not gnus-slave)
1010 gnus-plugged)
eec82323
LMI
1011 (gnus-find-new-newsgroups))
1012
23f87bed
MB
1013 ;; Check and remove bogus newsgroups.
1014 (when (and init gnus-check-bogus-newsgroups
1015 gnus-read-active-file (not level)
1016 (gnus-server-opened gnus-select-method))
1017 (gnus-check-bogus-newsgroups))
1018
eec82323
LMI
1019 ;; We might read in new NoCeM messages here.
1020 (when (and gnus-use-nocem
1021 (not level)
1022 (not dont-connect))
1023 (gnus-nocem-scan-groups))
1024
1025 ;; Read any slave files.
1026 (gnus-master-read-slave-newsrc)
1027
1028 ;; Find the number of unread articles in each non-dead group.
1029 (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
23f87bed
MB
1030 (gnus-get-unread-articles level))))
1031
1032(defun gnus-call-subscribe-functions (method group)
1033 "Call METHOD to subscribe GROUP.
1034If no function returns `non-nil', call `gnus-subscribe-zombies'."
1035 (unless (cond
1036 ((functionp method)
1037 (funcall method group))
1038 ((listp method)
1039 (catch 'found
1040 (dolist (func method)
1041 (if (funcall func group)
1042 (throw 'found t)))
1043 nil))
1044 (t nil))
1045 (gnus-subscribe-zombies group)))
eec82323
LMI
1046
1047(defun gnus-find-new-newsgroups (&optional arg)
1048 "Search for new newsgroups and add them.
16409b0b 1049Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'.
eec82323 1050The `-n' option line from .newsrc is respected.
6748645f
LMI
1051
1052With 1 C-u, use the `ask-server' method to query the server for new
1053groups.
1054With 2 C-u's, use most complete method possible to query the server
1055for new groups, and subscribe the new groups as zombies."
1056 (interactive "p")
1057 (let* ((gnus-subscribe-newsgroup-method
1058 gnus-subscribe-newsgroup-method)
1059 (check (cond
16409b0b
GM
1060 ((or (and (= (or arg 1) 4)
1061 (not (listp gnus-check-new-newsgroups)))
1062 (null gnus-read-active-file)
1063 (eq gnus-read-active-file 'some))
1064 'ask-server)
1065 ((= (or arg 1) 16)
1066 (setq gnus-subscribe-newsgroup-method
1067 'gnus-subscribe-zombies)
1068 t)
1069 (t gnus-check-new-newsgroups))))
eec82323
LMI
1070 (unless (gnus-check-first-time-used)
1071 (if (or (consp check)
1072 (eq check 'ask-server))
1073 ;; Ask the server for new groups.
1074 (gnus-ask-server-for-new-groups)
1075 ;; Go through the active hashtb and look for new groups.
1076 (let ((groups 0)
1077 group new-newsgroups)
1078 (gnus-message 5 "Looking for new newsgroups...")
1079 (unless gnus-have-read-active-file
1080 (gnus-read-active-file))
7c972da0 1081 (setq gnus-newsrc-last-checked-date (message-make-date))
eec82323
LMI
1082 (unless gnus-killed-hashtb
1083 (gnus-make-hashtable-from-killed))
1084 ;; Go though every newsgroup in `gnus-active-hashtb' and compare
1085 ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
1086 (mapatoms
1087 (lambda (sym)
1088 (if (or (null (setq group (symbol-name sym)))
1089 (not (boundp sym))
1090 (null (symbol-value sym))
1091 (gnus-gethash group gnus-killed-hashtb)
1092 (gnus-gethash group gnus-newsrc-hashtb))
1093 ()
1094 (let ((do-sub (gnus-matches-options-n group)))
1095 (cond
1096 ((eq do-sub 'subscribe)
1097 (setq groups (1+ groups))
1098 (gnus-sethash group group gnus-killed-hashtb)
23f87bed
MB
1099 (gnus-call-subscribe-functions
1100 gnus-subscribe-options-newsgroup-method group))
eec82323
LMI
1101 ((eq do-sub 'ignore)
1102 nil)
1103 (t
1104 (setq groups (1+ groups))
1105 (gnus-sethash group group gnus-killed-hashtb)
1106 (if gnus-subscribe-hierarchical-interactive
1107 (push group new-newsgroups)
23f87bed
MB
1108 (gnus-call-subscribe-functions
1109 gnus-subscribe-newsgroup-method group)))))))
eec82323
LMI
1110 gnus-active-hashtb)
1111 (when new-newsgroups
1112 (gnus-subscribe-hierarchical-interactive new-newsgroups))
1113 (if (> groups 0)
1114 (gnus-message 5 "%d new newsgroup%s arrived."
1115 groups (if (> groups 1) "s have" " has"))
1116 (gnus-message 5 "No new newsgroups.")))))))
1117
1118(defun gnus-matches-options-n (group)
1119 ;; Returns `subscribe' if the group is to be unconditionally
1120 ;; subscribed, `ignore' if it is to be ignored, and nil if there is
1121 ;; no match for the group.
1122
1123 ;; First we check the two user variables.
1124 (cond
1125 ((and gnus-options-subscribe
1126 (string-match gnus-options-subscribe group))
1127 'subscribe)
1128 ((and gnus-auto-subscribed-groups
1129 (string-match gnus-auto-subscribed-groups group))
1130 'subscribe)
1131 ((and gnus-options-not-subscribe
1132 (string-match gnus-options-not-subscribe group))
1133 'ignore)
1134 ;; Then we go through the list that was retrieved from the .newsrc
1135 ;; file. This list has elements on the form
1136 ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list
1137 ;; is in the reverse order of the options line) is returned.
1138 (t
1139 (let ((regs gnus-newsrc-options-n))
1140 (while (and regs
1141 (not (string-match (caar regs) group)))
1142 (setq regs (cdr regs)))
1143 (and regs (cdar regs))))))
1144
1145(defun gnus-ask-server-for-new-groups ()
7c972da0
GM
1146 (let* ((new-date (message-make-date))
1147 (date (or gnus-newsrc-last-checked-date new-date))
eec82323
LMI
1148 (methods (cons gnus-select-method
1149 (nconc
1150 (when (gnus-archive-server-wanted-p)
1151 (list "archive"))
1152 (append
1153 (and (consp gnus-check-new-newsgroups)
1154 gnus-check-new-newsgroups)
1155 gnus-secondary-select-methods))))
1156 (groups 0)
eec82323
LMI
1157 group new-newsgroups got-new method hashtb
1158 gnus-override-subscribe-method)
6748645f
LMI
1159 (unless gnus-killed-hashtb
1160 (gnus-make-hashtable-from-killed))
eec82323
LMI
1161 ;; Go through both primary and secondary select methods and
1162 ;; request new newsgroups.
1163 (while (setq method (gnus-server-get-method nil (pop methods)))
6748645f
LMI
1164 (setq new-newsgroups nil
1165 gnus-override-subscribe-method method)
eec82323
LMI
1166 (when (and (gnus-check-server method)
1167 (gnus-request-newgroups date method))
1168 (save-excursion
6748645f
LMI
1169 (setq got-new t
1170 hashtb (gnus-make-hashtable 100))
eec82323
LMI
1171 (set-buffer nntp-server-buffer)
1172 ;; Enter all the new groups into a hashtable.
1173 (gnus-active-to-gnus-format method hashtb 'ignore))
1174 ;; Now all new groups from `method' are in `hashtb'.
1175 (mapatoms
1176 (lambda (group-sym)
1177 (if (or (null (setq group (symbol-name group-sym)))
1178 (not (boundp group-sym))
1179 (null (symbol-value group-sym))
1180 (gnus-gethash group gnus-newsrc-hashtb)
1181 (member group gnus-zombie-list)
1182 (member group gnus-killed-list))
1183 ;; The group is already known.
1184 ()
1185 ;; Make this group active.
1186 (when (symbol-value group-sym)
1187 (gnus-set-active group (symbol-value group-sym)))
1188 ;; Check whether we want it or not.
1189 (let ((do-sub (gnus-matches-options-n group)))
1190 (cond
1191 ((eq do-sub 'subscribe)
1192 (incf groups)
1193 (gnus-sethash group group gnus-killed-hashtb)
23f87bed
MB
1194 (gnus-call-subscribe-functions
1195 gnus-subscribe-options-newsgroup-method group))
eec82323
LMI
1196 ((eq do-sub 'ignore)
1197 nil)
1198 (t
1199 (incf groups)
1200 (gnus-sethash group group gnus-killed-hashtb)
1201 (if gnus-subscribe-hierarchical-interactive
1202 (push group new-newsgroups)
23f87bed
MB
1203 (gnus-call-subscribe-functions
1204 gnus-subscribe-newsgroup-method group)))))))
eec82323
LMI
1205 hashtb))
1206 (when new-newsgroups
1207 (gnus-subscribe-hierarchical-interactive new-newsgroups)))
16409b0b
GM
1208 (if (> groups 0)
1209 (gnus-message 5 "%d new newsgroup%s arrived"
1210 groups (if (> groups 1) "s have" " has"))
1211 (gnus-message 5 "No new newsgroups"))
eec82323
LMI
1212 (when got-new
1213 (setq gnus-newsrc-last-checked-date new-date))
1214 got-new))
1215
1216(defun gnus-check-first-time-used ()
16409b0b
GM
1217 (catch 'ended
1218 ;; First check if any of the following files exist. If they do,
1219 ;; it's not the first time the user has used Gnus.
23f87bed 1220 (dolist (file (list (concat gnus-current-startup-file ".el")
16409b0b 1221 (concat gnus-current-startup-file ".eld")
16409b0b
GM
1222 (concat gnus-startup-file ".el")
1223 (concat gnus-startup-file ".eld")))
1224 (when (file-exists-p file)
1225 (throw 'ended nil)))
eec82323
LMI
1226 (gnus-message 6 "First time user; subscribing you to default groups")
1227 (unless (gnus-read-active-file-p)
a8151ef7
LMI
1228 (let ((gnus-read-active-file t))
1229 (gnus-read-active-file)))
7c972da0 1230 (setq gnus-newsrc-last-checked-date (message-make-date))
16409b0b
GM
1231 ;; Subscribe to the default newsgroups.
1232 (let ((groups (or gnus-default-subscribed-newsgroups
1233 gnus-backup-default-subscribed-newsgroups))
eec82323 1234 group)
23f87bed
MB
1235 (if (eq groups t)
1236 ;; If t, we subscribe (or not) all groups as if they were new.
1237 (mapatoms
1238 (lambda (sym)
1239 (when (setq group (symbol-name sym))
1240 (let ((do-sub (gnus-matches-options-n group)))
1241 (cond
1242 ((eq do-sub 'subscribe)
1243 (gnus-sethash group group gnus-killed-hashtb)
1244 (gnus-call-subscribe-functions
1245 gnus-subscribe-options-newsgroup-method group))
1246 ((eq do-sub 'ignore)
1247 nil)
1248 (t
1249 (push group gnus-killed-list))))))
1250 gnus-active-hashtb)
16409b0b
GM
1251 (dolist (group groups)
1252 ;; Only subscribe the default groups that are activated.
1253 (when (gnus-active group)
eec82323 1254 (gnus-group-change-level
16409b0b 1255 group gnus-level-default-subscribed gnus-level-killed)))
d6e0f298
KH
1256 (save-excursion
1257 (set-buffer gnus-group-buffer)
23f87bed
MB
1258 ;; Don't error if the group already exists. This happens when a
1259 ;; first-time user types 'F'. -- didier
1260 (gnus-group-make-help-group t))
eec82323
LMI
1261 (when gnus-novice-user
1262 (gnus-message 7 "`A k' to list killed groups"))))))
1263
16409b0b 1264(defun gnus-subscribe-group (group &optional previous method)
23f87bed 1265 "Subscribe GROUP and put it after PREVIOUS."
eec82323
LMI
1266 (gnus-group-change-level
1267 (if method
1268 (list t group gnus-level-default-subscribed nil nil method)
1269 group)
16409b0b
GM
1270 gnus-level-default-subscribed gnus-level-killed previous t)
1271 t)
eec82323
LMI
1272
1273;; `gnus-group-change-level' is the fundamental function for changing
1274;; subscription levels of newsgroups. This might mean just changing
1275;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
1276;; again, which subscribes/unsubscribes a group, which is equally
1277;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and
1278;; from 8-9 to 1-7 means that you remove the group from the list of
1279;; killed (or zombie) groups and add them to the (kinda) subscribed
1280;; groups. And last but not least, moving from 8 to 9 and 9 to 8,
1281;; which is trivial.
1282;; ENTRY can either be a string (newsgroup name) or a list (if
1283;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
1284;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
1285;; entries.
1286;; LEVEL is the new level of the group, OLDLEVEL is the old level and
1287;; PREVIOUS is the group (in hashtb entry format) to insert this group
1288;; after.
1289(defun gnus-group-change-level (entry level &optional oldlevel
1290 previous fromkilled)
1291 (let (group info active num)
1292 ;; Glean what info we can from the arguments
1293 (if (consp entry)
1294 (if fromkilled (setq group (nth 1 entry))
1295 (setq group (car (nth 2 entry))))
1296 (setq group entry))
1297 (when (and (stringp entry)
1298 oldlevel
1299 (< oldlevel gnus-level-zombie))
1300 (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
1301 (if (and (not oldlevel)
1302 (consp entry))
1303 (setq oldlevel (gnus-info-level (nth 2 entry)))
6748645f 1304 (setq oldlevel (or oldlevel gnus-level-killed)))
eec82323
LMI
1305 (when (stringp previous)
1306 (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
1307
1308 (if (and (>= oldlevel gnus-level-zombie)
1309 (gnus-gethash group gnus-newsrc-hashtb))
1310 ;; We are trying to subscribe a group that is already
1311 ;; subscribed.
1312 () ; Do nothing.
1313
1314 (unless (gnus-ephemeral-group-p group)
1315 (gnus-dribble-enter
1316 (format "(gnus-group-change-level %S %S %S %S %S)"
1317 group level oldlevel (car (nth 2 previous)) fromkilled)))
1318
1319 ;; Then we remove the newgroup from any old structures, if needed.
1320 ;; If the group was killed, we remove it from the killed or zombie
1321 ;; list. If not, and it is in fact going to be killed, we remove
1322 ;; it from the newsrc hash table and assoc.
1323 (cond
1324 ((>= oldlevel gnus-level-zombie)
23f87bed
MB
1325 ;; oldlevel could be wrong.
1326 (setq gnus-zombie-list (delete group gnus-zombie-list))
1327 (setq gnus-killed-list (delete group gnus-killed-list)))
eec82323
LMI
1328 (t
1329 (when (and (>= level gnus-level-zombie)
1330 entry)
1331 (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
1332 (when (nth 3 entry)
1333 (setcdr (gnus-gethash (car (nth 3 entry))
1334 gnus-newsrc-hashtb)
1335 (cdr entry)))
1336 (setcdr (cdr entry) (cdddr entry)))))
1337
1338 ;; Finally we enter (if needed) the list where it is supposed to
1339 ;; go, and change the subscription level. If it is to be killed,
1340 ;; we enter it into the killed or zombie list.
1341 (cond
1342 ((>= level gnus-level-zombie)
1343 ;; Remove from the hash table.
1344 (gnus-sethash group nil gnus-newsrc-hashtb)
1345 ;; We do not enter foreign groups into the list of dead
1346 ;; groups.
1347 (unless (gnus-group-foreign-p group)
1348 (if (= level gnus-level-zombie)
1349 (push group gnus-zombie-list)
23f87bed
MB
1350 (if (= oldlevel gnus-level-killed)
1351 ;; Remove from active hashtb.
1352 (unintern group gnus-active-hashtb)
1353 ;; Don't add it into killed-list if it was killed.
1354 (push group gnus-killed-list)))))
eec82323
LMI
1355 (t
1356 ;; If the list is to be entered into the newsrc assoc, and
1357 ;; it was killed, we have to create an entry in the newsrc
1358 ;; hashtb format and fix the pointers in the newsrc assoc.
1359 (if (< oldlevel gnus-level-zombie)
1360 ;; It was alive, and it is going to stay alive, so we
1361 ;; just change the level and don't change any pointers or
1362 ;; hash table entries.
1363 (setcar (cdaddr entry) level)
1364 (if (listp entry)
1365 (setq info (cdr entry)
1366 num (car entry))
1367 (setq active (gnus-active group))
1368 (setq num
1369 (if active (- (1+ (cdr active)) (car active)) t))
16409b0b
GM
1370 ;; Shorten the select method if possible, if we need to
1371 ;; store it at all (native groups).
1372 (let ((method (gnus-method-simplify
1373 (or gnus-override-subscribe-method
1374 (gnus-group-method group)))))
1375 (if method
1376 (setq info (list group level nil nil method))
1377 (setq info (list group level nil)))))
eec82323
LMI
1378 (unless previous
1379 (setq previous
1380 (let ((p gnus-newsrc-alist))
1381 (while (cddr p)
1382 (setq p (cdr p)))
1383 p)))
1384 (setq entry (cons info (cddr previous)))
1385 (if (cdr previous)
1386 (progn
1387 (setcdr (cdr previous) entry)
1388 (gnus-sethash group (cons num (cdr previous))
1389 gnus-newsrc-hashtb))
1390 (setcdr previous entry)
1391 (gnus-sethash group (cons num previous)
1392 gnus-newsrc-hashtb))
1393 (when (cdr entry)
1394 (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))
1395 (gnus-dribble-enter
1396 (format
1397 "(gnus-group-set-info '%S)" info)))))
1398 (when gnus-group-change-level-function
a8151ef7
LMI
1399 (funcall gnus-group-change-level-function
1400 group level oldlevel previous)))))
eec82323
LMI
1401
1402(defun gnus-kill-newsgroup (newsgroup)
1403 "Obsolete function. Kills a newsgroup."
1404 (gnus-group-change-level
1405 (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
1406
1407(defun gnus-check-bogus-newsgroups (&optional confirm)
1408 "Remove bogus newsgroups.
1409If CONFIRM is non-nil, the user has to confirm the deletion of every
1410newsgroup."
1411 (let ((newsrc (cdr gnus-newsrc-alist))
1412 bogus group entry info)
1413 (gnus-message 5 "Checking bogus newsgroups...")
1414 (unless (gnus-read-active-file-p)
1415 (gnus-read-active-file t))
1416 (when (gnus-read-active-file-p)
1417 ;; Find all bogus newsgroup that are subscribed.
1418 (while newsrc
1419 (setq info (pop newsrc)
1420 group (gnus-info-group info))
1421 (unless (or (gnus-active group) ; Active
23f87bed
MB
1422 (and (gnus-info-method info)
1423 (not (gnus-secondary-method-p
1424 (gnus-info-method info))))) ; Foreign
eec82323
LMI
1425 ;; Found a bogus newsgroup.
1426 (push group bogus)))
1427 (if confirm
1428 (map-y-or-n-p
1429 "Remove bogus group %s? "
1430 (lambda (group)
1431 ;; Remove all bogus subscribed groups by first killing them, and
1432 ;; then removing them from the list of killed groups.
1433 (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
1434 (gnus-group-change-level entry gnus-level-killed)
1435 (setq gnus-killed-list (delete group gnus-killed-list))))
1436 bogus '("group" "groups" "remove"))
1437 (while (setq group (pop bogus))
1438 ;; Remove all bogus subscribed groups by first killing them, and
1439 ;; then removing them from the list of killed groups.
1440 (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
1441 (gnus-group-change-level entry gnus-level-killed)
1442 (setq gnus-killed-list (delete group gnus-killed-list)))))
1443 ;; Then we remove all bogus groups from the list of killed and
1444 ;; zombie groups. They are removed without confirmation.
1445 (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
1446 killed)
1447 (while dead-lists
1448 (setq killed (symbol-value (car dead-lists)))
1449 (while killed
1450 (unless (gnus-active (setq group (pop killed)))
1451 ;; The group is bogus.
1452 ;; !!!Slow as hell.
1453 (set (car dead-lists)
1454 (delete group (symbol-value (car dead-lists))))))
1455 (setq dead-lists (cdr dead-lists))))
6748645f 1456 (gnus-run-hooks 'gnus-check-bogus-groups-hook)
eec82323
LMI
1457 (gnus-message 5 "Checking bogus newsgroups...done"))))
1458
1459(defun gnus-check-duplicate-killed-groups ()
1460 "Remove duplicates from the list of killed groups."
1461 (interactive)
1462 (let ((killed gnus-killed-list))
1463 (while killed
1464 (gnus-message 9 "%d" (length killed))
1465 (setcdr killed (delete (car killed) (cdr killed)))
1466 (setq killed (cdr killed)))))
1467
1468;; We want to inline a function from gnus-cache, so we cheat here:
1469(eval-when-compile
1470 (defvar gnus-cache-active-hashtb)
1471 (defun gnus-cache-possibly-alter-active (group active)
1472 "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
1473 (when gnus-cache-active-hashtb
1474 (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
a8151ef7
LMI
1475 (when cache-active
1476 (when (< (car cache-active) (car active))
1477 (setcar active (car cache-active)))
1478 (when (> (cdr cache-active) (cdr active))
1479 (setcdr active (cdr cache-active))))))))
eec82323
LMI
1480
1481(defun gnus-activate-group (group &optional scan dont-check method)
531e5812
MB
1482 "Check whether a group has been activated or not.
1483If SCAN, request a scan of that group as well."
eec82323
LMI
1484 (let ((method (or method (inline (gnus-find-method-for-group group))))
1485 active)
1486 (and (inline (gnus-check-server method))
1487 ;; We escape all bugs and quit here to make it possible to
1488 ;; continue if a group is so out-there that it reports bugs
1489 ;; and stuff.
1490 (progn
1491 (and scan
1492 (gnus-check-backend-function 'request-scan (car method))
1493 (gnus-request-scan group method))
1494 t)
23f87bed 1495 (if (or debug-on-error debug-on-quit)
eec82323 1496 (inline (gnus-request-group group dont-check method))
23f87bed
MB
1497 (condition-case nil
1498 (inline (gnus-request-group group dont-check method))
1499 ;;(error nil)
1500 (quit
1501 (message "Quit activating %s" group)
1502 nil)))
1503 (unless dont-check
1504 (setq active (gnus-parse-active))
1505 ;; If there are no articles in the group, the GROUP
1506 ;; command may have responded with the `(0 . 0)'. We
1507 ;; ignore this if we already have an active entry
1508 ;; for the group.
1509 (if (and (zerop (car active))
1510 (zerop (cdr active))
1511 (gnus-active group))
1512 (gnus-active group)
1513
1514 (gnus-set-active group active)
1515 ;; Return the new active info.
1516 active)))))
eec82323
LMI
1517
1518(defun gnus-get-unread-articles-in-group (info active &optional update)
1519 (when active
1520 ;; Allow the backend to update the info in the group.
1521 (when (and update
1522 (gnus-request-update-info
1523 info (inline (gnus-find-method-for-group
1524 (gnus-info-group info)))))
1525 (gnus-activate-group (gnus-info-group info) nil t))
6748645f 1526
eec82323
LMI
1527 (let* ((range (gnus-info-read info))
1528 (num 0))
1529 ;; If a cache is present, we may have to alter the active info.
1530 (when (and gnus-use-cache info)
1531 (inline (gnus-cache-possibly-alter-active
1532 (gnus-info-group info) active)))
23f87bed
MB
1533
1534 ;; If the agent is enabled, we may have to alter the active info.
1535 (when (and gnus-agent info)
1536 (gnus-agent-possibly-alter-active
1537 (gnus-info-group info) active))
1538
eec82323
LMI
1539 ;; Modify the list of read articles according to what articles
1540 ;; are available; then tally the unread articles and add the
1541 ;; number to the group hash table entry.
1542 (cond
1543 ((zerop (cdr active))
1544 (setq num 0))
1545 ((not range)
1546 (setq num (- (1+ (cdr active)) (car active))))
1547 ((not (listp (cdr range)))
1548 ;; Fix a single (num . num) range according to the
1549 ;; active hash table.
1550 ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
1551 (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
1552 (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
1553 ;; Compute number of unread articles.
1554 (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
1555 (t
1556 ;; The read list is a list of ranges. Fix them according to
1557 ;; the active hash table.
1558 ;; First peel off any elements that are below the lower
1559 ;; active limit.
1560 (while (and (cdr range)
1561 (>= (car active)
1562 (or (and (atom (cadr range)) (cadr range))
1563 (caadr range))))
1564 (if (numberp (car range))
1565 (setcar range
1566 (cons (car range)
1567 (or (and (numberp (cadr range))
1568 (cadr range))
1569 (cdadr range))))
1570 (setcdr (car range)
1571 (or (and (numberp (nth 1 range)) (nth 1 range))
1572 (cdadr range))))
1573 (setcdr range (cddr range)))
1574 ;; Adjust the first element to be the same as the lower limit.
1575 (when (and (not (atom (car range)))
1576 (< (cdar range) (car active)))
1577 (setcdr (car range) (1- (car active))))
1578 ;; Then we want to peel off any elements that are higher
1579 ;; than the upper active limit.
1580 (let ((srange range))
16409b0b 1581 ;; Go past all valid elements.
eec82323
LMI
1582 (while (and (cdr srange)
1583 (<= (or (and (atom (cadr srange))
1584 (cadr srange))
1585 (caadr srange))
1586 (cdr active)))
1587 (setq srange (cdr srange)))
1588 (when (cdr srange)
16409b0b 1589 ;; Nuke all remaining invalid elements.
eec82323
LMI
1590 (setcdr srange nil))
1591
1592 ;; Adjust the final element.
1593 (when (and (not (atom (car srange)))
1594 (> (cdar srange) (cdr active)))
1595 (setcdr (car srange) (cdr active))))
1596 ;; Compute the number of unread articles.
1597 (while range
1598 (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
1599 (cdar range)))
1600 (or (and (atom (car range)) (car range))
1601 (caar range)))))
1602 (setq range (cdr range)))
1603 (setq num (max 0 (- (cdr active) num)))))
1604 ;; Set the number of unread articles.
23f87bed
MB
1605 (when (and info
1606 (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb))
eec82323
LMI
1607 (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
1608 num)))
1609
1610;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
1611;; and compute how many unread articles there are in each group.
1612(defun gnus-get-unread-articles (&optional level)
23f87bed 1613 (setq gnus-server-method-cache nil)
eec82323
LMI
1614 (let* ((newsrc (cdr gnus-newsrc-alist))
1615 (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
1616 (foreign-level
1617 (min
1618 (cond ((and gnus-activate-foreign-newsgroups
1619 (not (numberp gnus-activate-foreign-newsgroups)))
1620 (1+ gnus-level-subscribed))
1621 ((numberp gnus-activate-foreign-newsgroups)
1622 gnus-activate-foreign-newsgroups)
1623 (t 0))
1624 level))
23f87bed
MB
1625 (methods-cache nil)
1626 (type-cache nil)
1627 scanned-methods info group active method retrieve-groups cmethod
1628 method-type)
1629 (gnus-message 6 "Checking new news...")
eec82323
LMI
1630
1631 (while newsrc
1632 (setq active (gnus-active (setq group (gnus-info-group
1633 (setq info (pop newsrc))))))
1634
1635 ;; Check newsgroups. If the user doesn't want to check them, or
1636 ;; they can't be checked (for instance, if the news server can't
1637 ;; be reached) we just set the number of unread articles in this
1638 ;; newsgroup to t. This means that Gnus thinks that there are
1639 ;; unread articles, but it has no idea how many.
16409b0b
GM
1640
1641 ;; To be more explicit:
1642 ;; >0 for an active group with messages
1643 ;; 0 for an active group with no unread messages
1644 ;; nil for non-foreign groups that the user has requested not be checked
1645 ;; t for unchecked foreign groups or bogus groups, or groups that can't
1646 ;; be checked, for one reason or other.
23f87bed
MB
1647 (when (setq method (gnus-info-method info))
1648 (if (setq cmethod (assoc method methods-cache))
1649 (setq method (cdr cmethod))
1650 (setq cmethod (inline (gnus-server-get-method nil method)))
1651 (push (cons method cmethod) methods-cache)
1652 (setq method cmethod)))
1653 (when (and method
1654 (not (setq method-type (cdr (assoc method type-cache)))))
1655 (setq method-type
1656 (cond
1657 ((gnus-secondary-method-p method)
1658 'secondary)
1659 ((inline (gnus-server-equal gnus-select-method method))
1660 'primary)
1661 (t
1662 'foreign)))
1663 (push (cons method method-type) type-cache))
1664 (if (and method
1665 (eq method-type 'foreign))
eec82323 1666 ;; These groups are foreign. Check the level.
16409b0b 1667 (when (and (<= (gnus-info-level info) foreign-level)
23f87bed 1668 (setq active (gnus-activate-group group 'scan)))
6748645f 1669 ;; Let the Gnus agent save the active file.
23f87bed 1670 (when (and gnus-agent active (gnus-online method))
6748645f
LMI
1671 (gnus-agent-save-group-info
1672 method (gnus-group-real-name group) active))
eec82323
LMI
1673 (unless (inline (gnus-virtual-group-p group))
1674 (inline (gnus-close-group group)))
1675 (when (fboundp (intern (concat (symbol-name (car method))
1676 "-request-update-info")))
1677 (inline (gnus-request-update-info info method))))
1678 ;; These groups are native or secondary.
16409b0b
GM
1679 (cond
1680 ;; We don't want these groups.
1681 ((> (gnus-info-level info) level)
1682 (setq active 'ignore))
1683 ;; Activate groups.
1684 ((not gnus-read-active-file)
1685 (if (gnus-check-backend-function 'retrieve-groups group)
1686 ;; if server support gnus-retrieve-groups we push
1687 ;; the group onto retrievegroups for later checking
23f87bed
MB
1688 (if (assoc method retrieve-groups)
1689 (setcdr (assoc method retrieve-groups)
1690 (cons group (cdr (assoc method retrieve-groups))))
1691 (push (list method group) retrieve-groups))
16409b0b
GM
1692 ;; hack: `nnmail-get-new-mail' changes the mail-source depending
1693 ;; on the group, so we must perform a scan for every group
1694 ;; if the users has any directory mail sources.
1695 ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
1696 ;; for it scan all spool files even when the groups are
1697 ;; not required.
1698 (if (and
1699 (or nnmail-scan-directory-mail-source-once
1700 (null (assq 'directory
1701 (or mail-sources
1702 (if (listp nnmail-spool-file)
1703 nnmail-spool-file
1704 (list nnmail-spool-file))))))
1705 (member method scanned-methods))
1706 (setq active (gnus-activate-group group))
1707 (setq active (gnus-activate-group group 'scan))
1708 (push method scanned-methods))
23f87bed
MB
1709 (when active
1710 (gnus-close-group group))))))
eec82323
LMI
1711
1712 ;; Get the number of unread articles in the group.
16409b0b
GM
1713 (cond
1714 ((eq active 'ignore)
1715 ;; Don't do anything.
1716 )
1717 (active
1718 (inline (gnus-get-unread-articles-in-group info active t)))
1719 (t
eec82323
LMI
1720 ;; The group couldn't be reached, so we nix out the number of
1721 ;; unread articles and stuff.
1722 (gnus-set-active group nil)
16409b0b 1723 (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
23f87bed
MB
1724 (when tmp
1725 (setcar tmp t))))))
16409b0b
GM
1726
1727 ;; iterate through groups on methods which support gnus-retrieve-groups
1728 ;; and fetch a partial active file and use it to find new news.
23f87bed
MB
1729 (dolist (rg retrieve-groups)
1730 (let ((method (or (car rg) gnus-select-method))
1731 (groups (cdr rg)))
16409b0b 1732 (when (gnus-check-server method)
23f87bed
MB
1733 ;; Request that the backend scan its incoming messages.
1734 (when (gnus-check-backend-function 'request-scan (car method))
1735 (gnus-request-scan nil method))
1736 (gnus-read-active-file-2
1737 (mapcar (lambda (group) (gnus-group-real-name group)) groups)
1738 method)
1739 (dolist (group groups)
1740 (cond
1741 ((setq active (gnus-active (gnus-info-group
1742 (setq info (gnus-get-info group)))))
1743 (inline (gnus-get-unread-articles-in-group info active t)))
1744 (t
1745 ;; The group couldn't be reached, so we nix out the number of
1746 ;; unread articles and stuff.
1747 (gnus-set-active group nil)
1748 (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))
1749
1750 (gnus-message 6 "Checking new news...done")))
eec82323
LMI
1751
1752;; Create a hash table out of the newsrc alist. The `car's of the
1753;; alist elements are used as keys.
1754(defun gnus-make-hashtable-from-newsrc-alist ()
1755 (let ((alist gnus-newsrc-alist)
1756 (ohashtb gnus-newsrc-hashtb)
1757 prev)
1758 (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
1759 (setq alist
1760 (setq prev (setq gnus-newsrc-alist
1761 (if (equal (caar gnus-newsrc-alist)
1762 "dummy.group")
1763 gnus-newsrc-alist
1764 (cons (list "dummy.group" 0 nil) alist)))))
1765 (while alist
1766 (gnus-sethash
1767 (caar alist)
1768 ;; Preserve number of unread articles in groups.
1769 (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
1770 prev)
1771 gnus-newsrc-hashtb)
1772 (setq prev alist
1773 alist (cdr alist)))))
1774
1775(defun gnus-make-hashtable-from-killed ()
1776 "Create a hash table from the killed and zombie lists."
1777 (let ((lists '(gnus-killed-list gnus-zombie-list))
1778 list)
1779 (setq gnus-killed-hashtb
1780 (gnus-make-hashtable
1781 (+ (length gnus-killed-list) (length gnus-zombie-list))))
1782 (while lists
1783 (setq list (symbol-value (pop lists)))
1784 (while list
1785 (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
1786
1787(defun gnus-parse-active ()
1788 "Parse active info in the nntp server buffer."
1789 (save-excursion
1790 (set-buffer nntp-server-buffer)
1791 (goto-char (point-min))
1792 ;; Parse the result we got from `gnus-request-group'.
1793 (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
1794 (goto-char (match-beginning 1))
1795 (cons (read (current-buffer))
1796 (read (current-buffer))))))
1797
1798(defun gnus-make-articles-unread (group articles)
1799 "Mark ARTICLES in GROUP as unread."
1800 (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
1801 (gnus-gethash (gnus-group-real-name group)
1802 gnus-newsrc-hashtb))))
1803 (ranges (gnus-info-read info))
1804 news article)
1805 (while articles
1806 (when (gnus-member-of-range
1807 (setq article (pop articles)) ranges)
1808 (push article news)))
1809 (when news
23f87bed 1810 ;; Enter this list into the group info.
eec82323
LMI
1811 (gnus-info-set-read
1812 info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
23f87bed
MB
1813
1814 ;; Set the number of unread articles in gnus-newsrc-hashtb.
1815 (gnus-get-unread-articles-in-group info (gnus-active group))
1816
1817 ;; Insert the change into the group buffer and the dribble file.
1818 (gnus-group-update-group group t))))
1819
1820(defun gnus-make-ascending-articles-unread (group articles)
1821 "Mark ascending ARTICLES in GROUP as unread."
1822 (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb)
1823 (gnus-gethash (gnus-group-real-name group)
1824 gnus-newsrc-hashtb)))
1825 (info (nth 2 entry))
1826 (ranges (gnus-info-read info))
1827 (r ranges)
1828 modified)
1829
1830 (while articles
1831 (let ((article (pop articles))) ; get the next article to remove from ranges
1832 (while (let ((range (car ranges))) ; note the current range
1833 (if (atom range) ; single value range
1834 (cond ((not range)
1835 ;; the articles extend past the end of the ranges
1836 ;; OK - I'm done
1837 (setq articles nil))
1838 ((< range article)
1839 ;; this range preceeds the article. Leave the range unmodified.
1840 (pop ranges)
1841 ranges)
1842 ((= range article)
1843 ;; this range exactly matches the article; REMOVE THE RANGE.
1844 ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end.
1845 (setcar ranges (cadr ranges))
1846 (setcdr ranges (cddr ranges))
1847 (setq modified (if (car ranges) t 'remove-null))
1848 nil))
1849 (let ((min (car range))
1850 (max (cdr range)))
1851 ;; I have a min/max range to consider
1852 (cond ((> min max) ; invalid range introduced by splitter
1853 (setcar ranges (cadr ranges))
1854 (setcdr ranges (cddr ranges))
1855 (setq modified (if (car ranges) t 'remove-null))
1856 ranges)
1857 ((= min max)
1858 ;; replace min/max range with a single-value range
1859 (setcar ranges min)
1860 ranges)
1861 ((< max article)
1862 ;; this range preceeds the article. Leave the range unmodified.
1863 (pop ranges)
1864 ranges)
1865 ((< article min)
1866 ;; this article preceeds the range. Return null to move to the
1867 ;; next article
1868 nil)
1869 (t
1870 ;; this article splits the range into two parts
1871 (setcdr ranges (cons (cons (1+ article) max) (cdr ranges)))
1872 (setcdr range (1- article))
1873 (setq modified t)
1874 ranges))))))))
1875
1876 (when modified
1877 (when (eq modified 'remove-null)
1878 (setq r (delq nil r)))
1879 ;; Enter this list into the group info.
1880 (gnus-info-set-read info r)
1881
1882 ;; Set the number of unread articles in gnus-newsrc-hashtb.
1883 (gnus-get-unread-articles-in-group info (gnus-active group))
1884
1885 ;; Insert the change into the group buffer and the dribble file.
eec82323
LMI
1886 (gnus-group-update-group group t))))
1887
1888;; Enter all dead groups into the hashtb.
1889(defun gnus-update-active-hashtb-from-killed ()
1890 (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
1891 (lists (list gnus-killed-list gnus-zombie-list))
1892 killed)
1893 (while lists
1894 (setq killed (car lists))
1895 (while killed
1896 (gnus-sethash (car killed) nil hashtb)
1897 (setq killed (cdr killed)))
1898 (setq lists (cdr lists)))))
1899
1900(defun gnus-get-killed-groups ()
1901 "Go through the active hashtb and mark all unknown groups as killed."
1902 ;; First make sure active file has been read.
1903 (unless (gnus-read-active-file-p)
1904 (let ((gnus-read-active-file t))
1905 (gnus-read-active-file)))
1906 (unless gnus-killed-hashtb
1907 (gnus-make-hashtable-from-killed))
1908 ;; Go through all newsgroups that are known to Gnus - enlarge kill list.
1909 (mapatoms
1910 (lambda (sym)
1911 (let ((groups 0)
1912 (group (symbol-name sym)))
1913 (if (or (null group)
1914 (gnus-gethash group gnus-killed-hashtb)
1915 (gnus-gethash group gnus-newsrc-hashtb))
1916 ()
1917 (let ((do-sub (gnus-matches-options-n group)))
1918 (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
1919 ()
1920 (setq groups (1+ groups))
1921 (push group gnus-killed-list)
1922 (gnus-sethash group group gnus-killed-hashtb))))))
1923 gnus-active-hashtb)
1924 (gnus-dribble-touch))
1925
1926;; Get the active file(s) from the backend(s).
a8151ef7 1927(defun gnus-read-active-file (&optional force not-native)
eec82323
LMI
1928 (gnus-group-set-mode-line)
1929 (let ((methods
16409b0b
GM
1930 (mapcar
1931 (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m))
1932 (append
1933 (if (and (not not-native)
1934 (gnus-check-server gnus-select-method))
1935 ;; The native server is available.
1936 (cons gnus-select-method gnus-secondary-select-methods)
1937 ;; The native server is down, so we just do the
1938 ;; secondary ones.
1939 gnus-secondary-select-methods)
1940 ;; Also read from the archive server.
1941 (when (gnus-archive-server-wanted-p)
1942 (list "archive")))))
1943 method)
eec82323
LMI
1944 (setq gnus-have-read-active-file nil)
1945 (save-excursion
1946 (set-buffer nntp-server-buffer)
16409b0b
GM
1947 (while (setq method (pop methods))
1948 ;; Only do each method once, in case the methods appear more
1949 ;; than once in this list.
1950 (unless (member method methods)
23f87bed 1951 (if (or debug-on-error debug-on-quit)
16409b0b 1952 (gnus-read-active-file-1 method force)
23f87bed
MB
1953 (condition-case ()
1954 (gnus-read-active-file-1 method force)
1955 ;; We catch C-g so that we can continue past servers
1956 ;; that do not respond.
1957 (quit
1958 (message "Quit reading the active file")
1959 nil))))))))
16409b0b
GM
1960
1961(defun gnus-read-active-file-1 (method force)
1962 (let (where mesg)
1963 (setq where (nth 1 method)
1964 mesg (format "Reading active file%s via %s..."
1965 (if (and where (not (zerop (length where))))
1966 (concat " from " where) "")
1967 (car method)))
1968 (gnus-message 5 mesg)
1969 (when (gnus-check-server method)
1970 ;; Request that the backend scan its incoming messages.
1971 (when (gnus-check-backend-function 'request-scan (car method))
1972 (gnus-request-scan nil method))
1973 (cond
1974 ((and (eq gnus-read-active-file 'some)
1975 (gnus-check-backend-function 'retrieve-groups (car method))
1976 (not force))
1977 (let ((newsrc (cdr gnus-newsrc-alist))
1978 (gmethod (gnus-server-get-method nil method))
1979 groups info)
1980 (while (setq info (pop newsrc))
1981 (when (inline
1982 (gnus-server-equal
1983 (inline
1984 (gnus-find-method-for-group
1985 (gnus-info-group info) info))
1986 gmethod))
1987 (push (gnus-group-real-name (gnus-info-group info))
1988 groups)))
1989 (gnus-read-active-file-2 groups method)))
1990 ((null method)
1991 t)
1992 (t
1993 (if (not (gnus-request-list method))
1994 (unless (equal method gnus-message-archive-method)
1995 (gnus-error 1 "Cannot read active file from %s server"
1996 (car method)))
eec82323 1997 (gnus-message 5 mesg)
16409b0b
GM
1998 (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
1999 ;; We mark this active file as read.
2000 (push method gnus-have-read-active-file)
2001 (gnus-message 5 "%sdone" mesg)))))))
2002
2003(defun gnus-read-active-file-2 (groups method)
23f87bed 2004 "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'."
16409b0b
GM
2005 (when groups
2006 (save-excursion
2007 (set-buffer nntp-server-buffer)
2008 (gnus-check-server method)
2009 (let ((list-type (gnus-retrieve-groups groups method)))
2010 (cond ((not list-type)
2011 (gnus-error
2012 1.2 "Cannot read partial active file from %s server."
2013 (car method)))
2014 ((eq list-type 'active)
2015 (gnus-active-to-gnus-format method gnus-active-hashtb nil t))
2016 (t
2017 (gnus-groups-to-gnus-format method gnus-active-hashtb t)))))))
eec82323
LMI
2018
2019;; Read an active file and place the results in `gnus-active-hashtb'.
6748645f
LMI
2020(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors
2021 real-active)
eec82323
LMI
2022 (unless method
2023 (setq method gnus-select-method))
2024 (let ((cur (current-buffer))
2025 (hashtb (or hashtb
2026 (if (and gnus-active-hashtb
2027 (not (equal method gnus-select-method)))
2028 gnus-active-hashtb
2029 (setq gnus-active-hashtb
2030 (if (equal method gnus-select-method)
2031 (gnus-make-hashtable
2032 (count-lines (point-min) (point-max)))
2033 (gnus-make-hashtable 4096)))))))
a8151ef7 2034 ;; Delete unnecessary lines.
eec82323 2035 (goto-char (point-min))
16409b0b
GM
2036 (cond
2037 ((string= gnus-ignored-newsgroups "")
2038 (delete-matching-lines "^to\\."))
2039 (t
2040 (delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups))))
2041
2042 (goto-char (point-min))
2043 (unless (re-search-forward "[\\\"]" nil t)
2044 ;; Make the group names readable as a lisp expression even if they
2045 ;; contain special characters.
2046 (goto-char (point-max))
2047 (while (re-search-backward "[][';?()#]" nil t)
2048 (insert ?\\)))
eec82323 2049
6748645f 2050 ;; Let the Gnus agent save the active file.
23f87bed 2051 (when (and gnus-agent real-active (gnus-online method))
6748645f
LMI
2052 (gnus-agent-save-active method))
2053
eec82323
LMI
2054 ;; If these are groups from a foreign select method, we insert the
2055 ;; group prefix in front of the group names.
a8151ef7
LMI
2056 (when (not (gnus-server-equal
2057 (gnus-server-get-method nil method)
2058 (gnus-server-get-method nil gnus-select-method)))
2059 (let ((prefix (gnus-group-prefixed-name "" method)))
2060 (goto-char (point-min))
2061 (while (and (not (eobp))
16409b0b
GM
2062 (progn
2063 (when (= (following-char) ?\")
2064 (forward-char 1))
2065 (insert prefix)
2066 (zerop (forward-line 1)))))))
eec82323
LMI
2067 ;; Store the active file in a hash table.
2068 (goto-char (point-min))
2069 (let (group max min)
2070 (while (not (eobp))
23f87bed 2071 (condition-case ()
eec82323
LMI
2072 (progn
2073 (narrow-to-region (point) (gnus-point-at-eol))
2074 ;; group gets set to a symbol interned in the hash table
2075 ;; (what a hack!!) - jwz
2076 (setq group (let ((obarray hashtb)) (read cur)))
16409b0b
GM
2077 ;; ### The extended group name scheme makes
2078 ;; the previous optimization strategy sort of pointless...
2079 (when (stringp group)
2080 (setq group (intern group hashtb)))
eec82323
LMI
2081 (if (and (numberp (setq max (read cur)))
2082 (numberp (setq min (read cur)))
2083 (progn
2084 (skip-chars-forward " \t")
2085 (not
16409b0b
GM
2086 (or (eq (char-after) ?=)
2087 (eq (char-after) ?x)
2088 (eq (char-after) ?j)))))
eec82323
LMI
2089 (progn
2090 (set group (cons min max))
2091 ;; if group is moderated, stick in moderation table
16409b0b 2092 (when (eq (char-after) ?m)
eec82323
LMI
2093 (unless gnus-moderated-hashtb
2094 (setq gnus-moderated-hashtb (gnus-make-hashtable)))
2095 (gnus-sethash (symbol-name group) t
2096 gnus-moderated-hashtb)))
2097 (set group nil)))
2098 (error
2099 (and group
2100 (symbolp group)
2101 (set group nil))
2102 (unless ignore-errors
16409b0b 2103 (gnus-message 3 "Warning - invalid active: %s"
eec82323
LMI
2104 (buffer-substring
2105 (gnus-point-at-bol) (gnus-point-at-eol))))))
2106 (widen)
2107 (forward-line 1)))))
2108
6748645f 2109(defun gnus-groups-to-gnus-format (method &optional hashtb real-active)
eec82323
LMI
2110 ;; Parse a "groups" active file.
2111 (let ((cur (current-buffer))
2112 (hashtb (or hashtb
2113 (if (and method gnus-active-hashtb)
2114 gnus-active-hashtb
2115 (setq gnus-active-hashtb
2116 (gnus-make-hashtable
2117 (count-lines (point-min) (point-max)))))))
2118 (prefix (and method
2119 (not (gnus-server-equal
2120 (gnus-server-get-method nil method)
2121 (gnus-server-get-method nil gnus-select-method)))
2122 (gnus-group-prefixed-name "" method))))
2123
6748645f 2124 ;; Let the Gnus agent save the active file.
16409b0b
GM
2125 (if (and gnus-agent
2126 real-active
23f87bed 2127 (gnus-online method)
16409b0b
GM
2128 (gnus-agent-method-p method))
2129 (progn
2130 (gnus-agent-save-groups method)
2131 (gnus-active-to-gnus-format method hashtb nil real-active))
2132
2133 (goto-char (point-min))
2134 ;; We split this into to separate loops, one with the prefix
2135 ;; and one without to speed the reading up somewhat.
2136 (if prefix
2137 (let (min max opoint group)
2138 (while (not (eobp))
2139 (condition-case ()
2140 (progn
2141 (read cur) (read cur)
2142 (setq min (read cur)
2143 max (read cur)
2144 opoint (point))
2145 (skip-chars-forward " \t")
2146 (insert prefix)
2147 (goto-char opoint)
2148 (set (let ((obarray hashtb)) (read cur))
2149 (cons min max)))
2150 (error (and group (symbolp group) (set group nil))))
2151 (forward-line 1)))
2152 (let (min max group)
eec82323
LMI
2153 (while (not (eobp))
2154 (condition-case ()
16409b0b 2155 (when (eq (char-after) ?2)
eec82323
LMI
2156 (read cur) (read cur)
2157 (setq min (read cur)
16409b0b
GM
2158 max (read cur))
2159 (set (setq group (let ((obarray hashtb)) (read cur)))
eec82323
LMI
2160 (cons min max)))
2161 (error (and group (symbolp group) (set group nil))))
16409b0b 2162 (forward-line 1)))))))
eec82323
LMI
2163
2164(defun gnus-read-newsrc-file (&optional force)
2165 "Read startup file.
2166If FORCE is non-nil, the .newsrc file is read."
2167 ;; Reset variables that might be defined in the .newsrc.eld file.
23f87bed 2168 (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
eec82323
LMI
2169 (while variables
2170 (set (car variables) nil)
2171 (setq variables (cdr variables))))
2172 (let* ((newsrc-file gnus-current-startup-file)
2173 (quick-file (concat newsrc-file ".el")))
2174 (save-excursion
2175 ;; We always load the .newsrc.eld file. If always contains
2176 ;; much information that can not be gotten from the .newsrc
2177 ;; file (ticked articles, killed groups, foreign methods, etc.)
2178 (gnus-read-newsrc-el-file quick-file)
2179
16409b0b
GM
2180 (when (and gnus-read-newsrc-file
2181 (file-exists-p gnus-current-startup-file)
eec82323
LMI
2182 (or force
2183 (and (file-newer-than-file-p newsrc-file quick-file)
2184 (file-newer-than-file-p newsrc-file
2185 (concat quick-file "d")))
2186 (not gnus-newsrc-alist)))
2187 ;; We read the .newsrc file. Note that if there if a
2188 ;; .newsrc.eld file exists, it has already been read, and
2189 ;; the `gnus-newsrc-hashtb' has been created. While reading
2190 ;; the .newsrc file, Gnus will only use the information it
2191 ;; can find there for changing the data already read -
2192 ;; i. e., reading the .newsrc file will not trash the data
2193 ;; already read (except for read articles).
2194 (save-excursion
2195 (gnus-message 5 "Reading %s..." newsrc-file)
2196 (set-buffer (nnheader-find-file-noselect newsrc-file))
16409b0b 2197 (buffer-disable-undo)
eec82323
LMI
2198 (gnus-newsrc-to-gnus-format)
2199 (kill-buffer (current-buffer))
2200 (gnus-message 5 "Reading %s...done" newsrc-file)))
2201
2202 ;; Convert old to new.
2203 (gnus-convert-old-newsrc))))
2204
2205(defun gnus-convert-old-newsrc ()
2206 "Convert old newsrc into the new format, if needed."
2207 (let ((fcv (and gnus-newsrc-file-version
2208 (gnus-continuum-version gnus-newsrc-file-version))))
2209 (cond
2210 ;; No .newsrc.eld file was loaded.
2211 ((null fcv) nil)
2212 ;; Gnus 5 .newsrc.eld was loaded.
2213 ((< fcv (gnus-continuum-version "September Gnus v0.1"))
2214 (gnus-convert-old-ticks)))))
2215
2216(defun gnus-convert-old-ticks ()
2217 (let ((newsrc (cdr gnus-newsrc-alist))
2218 marks info dormant ticked)
2219 (while (setq info (pop newsrc))
2220 (when (setq marks (gnus-info-marks info))
2221 (setq dormant (cdr (assq 'dormant marks))
2222 ticked (cdr (assq 'tick marks)))
2223 (when (or dormant ticked)
2224 (gnus-info-set-read
2225 info
2226 (gnus-add-to-range
2227 (gnus-info-read info)
2228 (nconc (gnus-uncompress-range dormant)
2229 (gnus-uncompress-range ticked)))))))))
2230
23f87bed
MB
2231(defun gnus-load (file)
2232 "Load FILE, but in such a way that read errors can be reported."
2233 (with-temp-buffer
2234 (insert-file-contents file)
2235 (while (not (eobp))
2236 (condition-case type
2237 (let ((form (read (current-buffer))))
2238 (eval form))
2239 (error
2240 (unless (eq (car type) 'end-of-file)
2241 (let ((error (format "Error in %s line %d" file
2242 (count-lines (point-min) (point)))))
2243 (ding)
2244 (unless (gnus-yes-or-no-p (concat error "; continue? "))
2245 (error "%s" error)))))))))
2246
eec82323
LMI
2247(defun gnus-read-newsrc-el-file (file)
2248 (let ((ding-file (concat file "d")))
23f87bed
MB
2249 (when (file-exists-p ding-file)
2250 ;; We always, always read the .eld file.
2251 (gnus-message 5 "Reading %s..." ding-file)
2252 (let (gnus-newsrc-assoc)
2253 (let ((coding-system-for-read gnus-ding-file-coding-system))
2254 (gnus-load ding-file))
2255 ;; Older versions of `gnus-format-specs' are no longer valid
2256 ;; in Oort Gnus 0.01.
2257 (let ((version
2258 (and gnus-newsrc-file-version
2259 (gnus-continuum-version gnus-newsrc-file-version))))
2260 (when (or (not version)
2261 (< version 5.090009))
2262 (setq gnus-format-specs gnus-default-format-specs)))
2263 (when gnus-newsrc-assoc
2264 (setq gnus-newsrc-alist gnus-newsrc-assoc))))
eec82323
LMI
2265 (gnus-make-hashtable-from-newsrc-alist)
2266 (when (file-newer-than-file-p file ding-file)
2267 ;; Old format quick file
2268 (gnus-message 5 "Reading %s..." file)
2269 ;; The .el file is newer than the .eld file, so we read that one
2270 ;; as well.
23f87bed
MB
2271 (gnus-read-old-newsrc-el-file file)))
2272 (gnus-run-hooks 'gnus-read-newsrc-el-hook))
eec82323
LMI
2273
2274;; Parse the old-style quick startup file
2275(defun gnus-read-old-newsrc-el-file (file)
2276 (let (newsrc killed marked group m info)
2277 (prog1
2278 (let ((gnus-killed-assoc nil)
2279 gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
2280 (prog1
2281 (ignore-errors
2282 (load file t t t))
2283 (setq newsrc gnus-newsrc-assoc
2284 killed gnus-killed-assoc
2285 marked gnus-marked-assoc)))
2286 (setq gnus-newsrc-alist nil)
2287 (while (setq group (pop newsrc))
2288 (if (setq info (gnus-get-info (car group)))
2289 (progn
2290 (gnus-info-set-read info (cddr group))
2291 (gnus-info-set-level
2292 info (if (nth 1 group) gnus-level-default-subscribed
2293 gnus-level-default-unsubscribed))
2294 (push info gnus-newsrc-alist))
2295 (push (setq info
2296 (list (car group)
2297 (if (nth 1 group) gnus-level-default-subscribed
2298 gnus-level-default-unsubscribed)
2299 (cddr group)))
2300 gnus-newsrc-alist))
2301 ;; Copy marks into info.
2302 (when (setq m (assoc (car group) marked))
2303 (unless (nthcdr 3 info)
2304 (nconc info (list nil)))
2305 (gnus-info-set-marks
2306 info (list (cons 'tick (gnus-compress-sequence
2307 (sort (cdr m) '<) t))))))
2308 (setq newsrc killed)
2309 (while newsrc
2310 (setcar newsrc (caar newsrc))
2311 (setq newsrc (cdr newsrc)))
2312 (setq gnus-killed-list killed))
2313 ;; The .el file version of this variable does not begin with
2314 ;; "options", while the .eld version does, so we just add it if it
2315 ;; isn't there.
2316 (when
2317 gnus-newsrc-options
2318 (when (not (string-match "^ *options" gnus-newsrc-options))
2319 (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
2320 (when (not (string-match "\n$" gnus-newsrc-options))
2321 (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
2322 ;; Finally, if we read some options lines, we parse them.
2323 (unless (string= gnus-newsrc-options "")
2324 (gnus-newsrc-parse-options gnus-newsrc-options)))
2325
2326 (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
2327 (gnus-make-hashtable-from-newsrc-alist)))
2328
2329(defun gnus-make-newsrc-file (file)
2330 "Make server dependent file name by catenating FILE and server host name."
2331 (let* ((file (expand-file-name file nil))
2332 (real-file (concat file "-" (nth 1 gnus-select-method))))
2333 (if (or (file-exists-p real-file)
2334 (file-exists-p (concat real-file ".el"))
2335 (file-exists-p (concat real-file ".eld")))
6748645f
LMI
2336 real-file
2337 file)))
eec82323
LMI
2338
2339(defun gnus-newsrc-to-gnus-format ()
2340 (setq gnus-newsrc-options "")
2341 (setq gnus-newsrc-options-n nil)
2342
2343 (unless gnus-active-hashtb
2344 (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
2345 (let ((buf (current-buffer))
2346 (already-read (> (length gnus-newsrc-alist) 1))
2347 group subscribed options-symbol newsrc Options-symbol
2348 symbol reads num1)
2349 (goto-char (point-min))
2350 ;; We intern the symbol `options' in the active hashtb so that we
2351 ;; can `eq' against it later.
2352 (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
2353 (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
2354
2355 (while (not (eobp))
2356 ;; We first read the first word on the line by narrowing and
2357 ;; then reading into `gnus-active-hashtb'. Most groups will
2358 ;; already exist in that hashtb, so this will save some string
2359 ;; space.
2360 (narrow-to-region
2361 (point)
2362 (progn (skip-chars-forward "^ \t!:\n") (point)))
2363 (goto-char (point-min))
2364 (setq symbol
2365 (and (/= (point-min) (point-max))
2366 (let ((obarray gnus-active-hashtb)) (read buf))))
2367 (widen)
2368 ;; Now, the symbol we have read is either `options' or a group
2369 ;; name. If it is an options line, we just add it to a string.
2370 (cond
2371 ((or (eq symbol options-symbol)
2372 (eq symbol Options-symbol))
2373 (setq gnus-newsrc-options
2374 ;; This concating is quite inefficient, but since our
2375 ;; thorough studies show that approx 99.37% of all
2376 ;; .newsrc files only contain a single options line, we
2377 ;; don't give a damn, frankly, my dear.
2378 (concat gnus-newsrc-options
2379 (buffer-substring
2380 (gnus-point-at-bol)
2381 ;; Options may continue on the next line.
2382 (or (and (re-search-forward "^[^ \t]" nil 'move)
2383 (progn (beginning-of-line) (point)))
2384 (point)))))
2385 (forward-line -1))
2386 (symbol
2387 ;; Group names can be just numbers.
2388 (when (numberp symbol)
2389 (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
2390 (unless (boundp symbol)
2391 (set symbol nil))
2392 ;; It was a group name.
16409b0b 2393 (setq subscribed (eq (char-after) ?:)
eec82323
LMI
2394 group (symbol-name symbol)
2395 reads nil)
2396 (if (eolp)
2397 ;; If the line ends here, this is clearly a buggy line, so
23f87bed 2398 ;; we put point a the beginning of line and let the cond
eec82323
LMI
2399 ;; below do the error handling.
2400 (beginning-of-line)
2401 ;; We skip to the beginning of the ranges.
2402 (skip-chars-forward "!: \t"))
2403 ;; We are now at the beginning of the list of read articles.
2404 ;; We read them range by range.
2405 (while
2406 (cond
2407 ((looking-at "[0-9]+")
2408 ;; We narrow and read a number instead of buffer-substring/
2409 ;; string-to-int because it's faster. narrow/widen is
2410 ;; faster than save-restriction/narrow, and save-restriction
2411 ;; produces a garbage object.
2412 (setq num1 (progn
2413 (narrow-to-region (match-beginning 0) (match-end 0))
2414 (read buf)))
2415 (widen)
2416 ;; If the next character is a dash, then this is a range.
16409b0b 2417 (if (eq (char-after) ?-)
eec82323
LMI
2418 (progn
2419 ;; We read the upper bound of the range.
2420 (forward-char 1)
2421 (if (not (looking-at "[0-9]+"))
2422 ;; This is a buggy line, by we pretend that
2423 ;; it's kinda OK. Perhaps the user should be
2424 ;; dinged?
2425 (push num1 reads)
2426 (push
2427 (cons num1
2428 (progn
2429 (narrow-to-region (match-beginning 0)
2430 (match-end 0))
2431 (read buf)))
2432 reads)
2433 (widen)))
2434 ;; It was just a simple number, so we add it to the
2435 ;; list of ranges.
2436 (push num1 reads))
2437 ;; If the next char in ?\n, then we have reached the end
2438 ;; of the line and return nil.
16409b0b
GM
2439 (not (eq (char-after) ?\n)))
2440 ((eq (char-after) ?\n)
eec82323
LMI
2441 ;; End of line, so we end.
2442 nil)
2443 (t
2444 ;; Not numbers and not eol, so this might be a buggy
2445 ;; line...
2446 (unless (eobp)
2447 ;; If it was eob instead of ?\n, we allow it.
2448 ;; The line was buggy.
2449 (setq group nil)
2450 (gnus-error 3.1 "Mangled line: %s"
2451 (buffer-substring (gnus-point-at-bol)
2452 (gnus-point-at-eol))))
2453 nil))
16409b0b 2454 ;; Skip past ", ". Spaces are invalid in these ranges, but
eec82323
LMI
2455 ;; we allow them, because it's a common mistake to put a
2456 ;; space after the comma.
2457 (skip-chars-forward ", "))
2458
2459 ;; We have already read .newsrc.eld, so we gently update the
2460 ;; data in the hash table with the information we have just
2461 ;; read.
2462 (when group
2463 (let ((info (gnus-get-info group))
2464 level)
2465 (if info
2466 ;; There is an entry for this file in the alist.
2467 (progn
2468 (gnus-info-set-read info (nreverse reads))
2469 ;; We update the level very gently. In fact, we
2470 ;; only change it if there's been a status change
2471 ;; from subscribed to unsubscribed, or vice versa.
2472 (setq level (gnus-info-level info))
2473 (cond ((and (<= level gnus-level-subscribed)
2474 (not subscribed))
2475 (setq level (if reads
2476 gnus-level-default-unsubscribed
2477 (1+ gnus-level-default-unsubscribed))))
2478 ((and (> level gnus-level-subscribed) subscribed)
2479 (setq level gnus-level-default-subscribed)))
2480 (gnus-info-set-level info level))
2481 ;; This is a new group.
2482 (setq info (list group
2483 (if subscribed
2484 gnus-level-default-subscribed
2485 (if reads
2486 (1+ gnus-level-subscribed)
2487 gnus-level-default-unsubscribed))
2488 (nreverse reads))))
2489 (push info newsrc)))))
2490 (forward-line 1))
2491
2492 (setq newsrc (nreverse newsrc))
2493
2494 (if (not already-read)
2495 ()
2496 ;; We now have two newsrc lists - `newsrc', which is what we
2497 ;; have read from .newsrc, and `gnus-newsrc-alist', which is
2498 ;; what we've read from .newsrc.eld. We have to merge these
2499 ;; lists. We do this by "attaching" any (foreign) groups in the
2500 ;; gnus-newsrc-alist to the (native) group that precedes them.
2501 (let ((rc (cdr gnus-newsrc-alist))
2502 (prev gnus-newsrc-alist)
2503 entry mentry)
2504 (while rc
2505 (or (null (nth 4 (car rc))) ; It's a native group.
2506 (assoc (caar rc) newsrc) ; It's already in the alist.
2507 (if (setq entry (assoc (caar prev) newsrc))
2508 (setcdr (setq mentry (memq entry newsrc))
2509 (cons (car rc) (cdr mentry)))
2510 (push (car rc) newsrc)))
2511 (setq prev rc
2512 rc (cdr rc)))))
2513
2514 (setq gnus-newsrc-alist newsrc)
2515 ;; We make the newsrc hashtb.
2516 (gnus-make-hashtable-from-newsrc-alist)
2517
2518 ;; Finally, if we read some options lines, we parse them.
2519 (unless (string= gnus-newsrc-options "")
2520 (gnus-newsrc-parse-options gnus-newsrc-options))))
2521
2522;; Parse options lines to find "options -n !all rec.all" and stuff.
2523;; The return value will be a list on the form
2524;; ((regexp1 . ignore)
2525;; (regexp2 . subscribe)...)
2526;; When handling new newsgroups, groups that match a `ignore' regexp
2527;; will be ignored, and groups that match a `subscribe' regexp will be
2528;; subscribed. A line like
2529;; options -n !all rec.all
2530;; will lead to a list that looks like
2531;; (("^rec\\..+" . subscribe)
2532;; ("^.+" . ignore))
2533;; So all "rec.*" groups will be subscribed, while all the other
2534;; groups will be ignored. Note that "options -n !all rec.all" is very
2535;; different from "options -n rec.all !all".
2536(defun gnus-newsrc-parse-options (options)
2537 (let (out eol)
2538 (save-excursion
2539 (gnus-set-work-buffer)
2540 (insert (regexp-quote options))
2541 ;; First we treat all continuation lines.
2542 (goto-char (point-min))
2543 (while (re-search-forward "\n[ \t]+" nil t)
2544 (replace-match " " t t))
2545 ;; Then we transform all "all"s into ".+"s.
2546 (goto-char (point-min))
2547 (while (re-search-forward "\\ball\\b" nil t)
2548 (replace-match ".+" t t))
2549 (goto-char (point-min))
2550 ;; We remove all other options than the "-n" ones.
2551 (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
2552 (replace-match " ")
2553 (forward-char -1))
2554 (goto-char (point-min))
2555
2556 ;; We are only interested in "options -n" lines - we
2557 ;; ignore the other option lines.
2558 (while (re-search-forward "[ \t]-n" nil t)
2559 (setq eol
2560 (or (save-excursion
2561 (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
2562 (- (point) 2)))
2563 (gnus-point-at-eol)))
2564 ;; Search for all "words"...
2565 (while (re-search-forward "[^ \t,\n]+" eol t)
16409b0b 2566 (if (eq (char-after (match-beginning 0)) ?!)
eec82323
LMI
2567 ;; If the word begins with a bang (!), this is a "not"
2568 ;; spec. We put this spec (minus the bang) and the
2569 ;; symbol `ignore' into the list.
2570 (push (cons (concat
2571 "^" (buffer-substring
2572 (1+ (match-beginning 0))
6748645f
LMI
2573 (match-end 0))
2574 "\\($\\|\\.\\)")
eec82323
LMI
2575 'ignore)
2576 out)
2577 ;; There was no bang, so this is a "yes" spec.
6748645f 2578 (push (cons (concat "^" (match-string 0) "\\($\\|\\.\\)")
eec82323
LMI
2579 'subscribe)
2580 out))))
2581
2582 (setq gnus-newsrc-options-n out))))
2583
23f87bed
MB
2584(eval-and-compile
2585 (defalias 'gnus-long-file-names
2586 (if (fboundp 'msdos-long-file-names)
2587 'msdos-long-file-names
2588 (lambda () t))))
2589
eec82323
LMI
2590(defun gnus-save-newsrc-file (&optional force)
2591 "Save .newsrc file."
2592 ;; Note: We cannot save .newsrc file if all newsgroups are removed
2593 ;; from the variable gnus-newsrc-alist.
2594 (when (and (or gnus-newsrc-alist gnus-killed-list)
2595 gnus-current-startup-file)
2596 (save-excursion
2597 (if (and (or gnus-use-dribble-file gnus-slave)
2598 (not force)
2599 (or (not gnus-dribble-buffer)
2600 (not (buffer-name gnus-dribble-buffer))
2601 (zerop (save-excursion
2602 (set-buffer gnus-dribble-buffer)
2603 (buffer-size)))))
2604 (gnus-message 4 "(No changes need to be saved)")
6748645f 2605 (gnus-run-hooks 'gnus-save-newsrc-hook)
eec82323
LMI
2606 (if gnus-slave
2607 (gnus-slave-save-newsrc)
2608 ;; Save .newsrc.
2609 (when gnus-save-newsrc-file
2610 (gnus-message 8 "Saving %s..." gnus-current-startup-file)
2611 (gnus-gnus-to-newsrc-format)
2612 (gnus-message 8 "Saving %s...done" gnus-current-startup-file))
2613 ;; Save .newsrc.eld.
6748645f 2614 (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
eec82323 2615 (make-local-variable 'version-control)
23f87bed 2616 (setq version-control gnus-backup-startup-file)
eec82323
LMI
2617 (setq buffer-file-name
2618 (concat gnus-current-startup-file ".eld"))
2619 (setq default-directory (file-name-directory buffer-file-name))
16409b0b 2620 (buffer-disable-undo)
eec82323 2621 (erase-buffer)
23f87bed
MB
2622 (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
2623
2624 (if gnus-save-startup-file-via-temp-buffer
2625 (let ((coding-system-for-write gnus-ding-file-coding-system)
2626 (standard-output (current-buffer)))
2627 (gnus-gnus-to-quick-newsrc-format)
2628 (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
2629 (save-buffer))
2630 (let ((coding-system-for-write gnus-ding-file-coding-system)
2631 (version-control gnus-backup-startup-file)
2632 (startup-file (concat gnus-current-startup-file ".eld"))
2633 (working-dir (file-name-directory gnus-current-startup-file))
2634 working-file
2635 (i -1))
2636 ;; Generate the name of a non-existent file.
2637 (while (progn (setq working-file
2638 (format
2639 (if (and (eq system-type 'ms-dos)
2640 (not (gnus-long-file-names)))
2641 "%s#%d.tm#" ; MSDOS limits files to 8+3
2642 (if (memq system-type '(vax-vms axp-vms))
2643 "%s$tmp$%d"
2644 "%s#tmp#%d"))
2645 working-dir (setq i (1+ i))))
2646 (file-exists-p working-file)))
2647
2648 (unwind-protect
2649 (progn
2650 (gnus-with-output-to-file working-file
2651 (gnus-gnus-to-quick-newsrc-format)
2652 (gnus-run-hooks 'gnus-save-quick-newsrc-hook))
2653
2654 ;; These bindings will mislead the current buffer
2655 ;; into thinking that it is visiting the startup
2656 ;; file.
2657 (let ((buffer-backed-up nil)
2658 (buffer-file-name startup-file)
2659 (file-precious-flag t)
2660 (setmodes (file-modes startup-file)))
2661 ;; Backup the current version of the startup file.
2662 (backup-buffer)
2663
2664 ;; Replace the existing startup file with the temp file.
2665 (rename-file working-file startup-file t)
2666 (set-file-modes startup-file setmodes)))
2667 (condition-case nil
2668 (delete-file working-file)
2669 (file-error nil)))))
2670
2671 (gnus-kill-buffer (current-buffer))
eec82323
LMI
2672 (gnus-message
2673 5 "Saving %s.eld...done" gnus-current-startup-file))
2674 (gnus-dribble-delete-file)
2675 (gnus-group-set-mode-line)))))
2676
23f87bed
MB
2677(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables)
2678 "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format."
2679 (princ ";; -*- emacs-lisp -*-\n")
2680 (if name
2681 (princ (format ";; %s\n" name))
2682 (princ ";; Gnus startup file.\n"))
16409b0b 2683
23f87bed
MB
2684 (unless minimal
2685 (princ "\
6748645f
LMI
2686;; Never delete this file -- if you want to force Gnus to read the
2687;; .newsrc file (if you have one), touch .newsrc instead.\n")
23f87bed
MB
2688 (princ "(setq gnus-newsrc-file-version ")
2689 (princ (gnus-prin1-to-string gnus-version))
2690 (princ ")\n"))
2691
2692 (let* ((print-quoted t)
2693 (print-readably t)
2694 (print-escape-multibyte nil)
2695 (print-escape-nonascii t)
2696 (print-length nil)
2697 (print-level nil)
2698 (print-escape-newlines t)
2699 (gnus-killed-list
eec82323
LMI
2700 (if (and gnus-save-killed-list
2701 (stringp gnus-save-killed-list))
2702 (gnus-strip-killed-list)
2703 gnus-killed-list))
2704 (variables
23f87bed
MB
2705 (or specific-variables
2706 (if gnus-save-killed-list gnus-variable-list
2707 ;; Remove the `gnus-killed-list' from the list of variables
2708 ;; to be saved, if required.
2709 (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
eec82323
LMI
2710 ;; Peel off the "dummy" group.
2711 (gnus-newsrc-alist (cdr gnus-newsrc-alist))
2712 variable)
2713 ;; Insert the variables into the file.
2714 (while variables
2715 (when (and (boundp (setq variable (pop variables)))
2716 (symbol-value variable))
23f87bed
MB
2717 (princ "(setq ")
2718 (princ (symbol-name variable))
2719 (princ " '")
2720 (prin1 (symbol-value variable))
2721 (princ ")\n")))))
eec82323
LMI
2722
2723(defun gnus-strip-killed-list ()
2724 "Return the killed list minus the groups that match `gnus-save-killed-list'."
2725 (let ((list gnus-killed-list)
2726 olist)
2727 (while list
6748645f 2728 (when (string-match gnus-save-killed-list (car list))
eec82323
LMI
2729 (push (car list) olist))
2730 (pop list))
2731 (nreverse olist)))
2732
2733(defun gnus-gnus-to-newsrc-format ()
2734 ;; Generate and save the .newsrc file.
2735 (save-excursion
2736 (set-buffer (create-file-buffer gnus-current-startup-file))
2737 (let ((newsrc (cdr gnus-newsrc-alist))
2738 (standard-output (current-buffer))
2739 info ranges range method)
2740 (setq buffer-file-name gnus-current-startup-file)
2741 (setq default-directory (file-name-directory buffer-file-name))
16409b0b 2742 (buffer-disable-undo)
eec82323
LMI
2743 (erase-buffer)
2744 ;; Write options.
2745 (when gnus-newsrc-options
2746 (insert gnus-newsrc-options))
2747 ;; Write subscribed and unsubscribed.
2748 (while (setq info (pop newsrc))
2749 ;; Don't write foreign groups to .newsrc.
2750 (when (or (null (setq method (gnus-info-method info)))
2751 (equal method "native")
2752 (inline (gnus-server-equal method gnus-select-method)))
2753 (insert (gnus-info-group info)
2754 (if (> (gnus-info-level info) gnus-level-subscribed)
2755 "!" ":"))
2756 (when (setq ranges (gnus-info-read info))
2757 (insert " ")
2758 (if (not (listp (cdr ranges)))
2759 (if (= (car ranges) (cdr ranges))
2760 (princ (car ranges))
2761 (princ (car ranges))
2762 (insert "-")
2763 (princ (cdr ranges)))
2764 (while (setq range (pop ranges))
2765 (if (or (atom range) (= (car range) (cdr range)))
2766 (princ (or (and (atom range) range) (car range)))
2767 (princ (car range))
2768 (insert "-")
2769 (princ (cdr range)))
2770 (when ranges
2771 (insert ",")))))
2772 (insert "\n")))
2773 (make-local-variable 'version-control)
2774 (setq version-control 'never)
2775 ;; It has been reported that sometime the modtime on the .newsrc
2776 ;; file seems to be off. We really do want to overwrite it, so
2777 ;; we clear the modtime here before saving. It's a bit odd,
2778 ;; though...
2779 ;; sometimes the modtime clear isn't sufficient. most brute force:
2780 ;; delete the silly thing entirely first. but this fails to provide
2781 ;; such niceties as .newsrc~ creation.
2782 (if gnus-modtime-botch
2783 (delete-file gnus-startup-file)
2784 (clear-visited-file-modtime))
6748645f 2785 (gnus-run-hooks 'gnus-save-standard-newsrc-hook)
eec82323
LMI
2786 (save-buffer)
2787 (kill-buffer (current-buffer)))))
2788
2789\f
2790;;;
2791;;; Slave functions.
2792;;;
2793
6748645f
LMI
2794(defvar gnus-slave-mode nil)
2795
2796(defun gnus-slave-mode ()
2797 "Minor mode for slave Gnusae."
2798 (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
2799 (gnus-run-hooks 'gnus-slave-mode-hook))
2800
eec82323
LMI
2801(defun gnus-slave-save-newsrc ()
2802 (save-excursion
2803 (set-buffer gnus-dribble-buffer)
2804 (let ((slave-name
3efe5554 2805 (mm-make-temp-file (concat gnus-current-startup-file "-slave-")))
eec82323
LMI
2806 (modes (ignore-errors
2807 (file-modes (concat gnus-current-startup-file ".eld")))))
2d2820a4 2808 (let ((coding-system-for-write gnus-ding-file-coding-system))
16409b0b 2809 (gnus-write-buffer slave-name))
eec82323 2810 (when modes
16409b0b 2811 (set-file-modes slave-name modes)))))
eec82323
LMI
2812
2813(defun gnus-master-read-slave-newsrc ()
2814 (let ((slave-files
2815 (directory-files
2816 (file-name-directory gnus-current-startup-file)
2817 t (concat
2818 "^" (regexp-quote
2819 (concat
2820 (file-name-nondirectory gnus-current-startup-file)
2821 "-slave-")))
2822 t))
2823 file)
2824 (if (not slave-files)
2825 () ; There are no slave files to read.
2826 (gnus-message 7 "Reading slave newsrcs...")
2827 (save-excursion
6748645f 2828 (set-buffer (gnus-get-buffer-create " *gnus slave*"))
eec82323
LMI
2829 (setq slave-files
2830 (sort (mapcar (lambda (file)
2831 (list (nth 5 (file-attributes file)) file))
2832 slave-files)
2833 (lambda (f1 f2)
2834 (or (< (caar f1) (caar f2))
2835 (< (nth 1 (car f1)) (nth 1 (car f2)))))))
2836 (while slave-files
2837 (erase-buffer)
2838 (setq file (nth 1 (car slave-files)))
16409b0b 2839 (nnheader-insert-file-contents file)
eec82323
LMI
2840 (when (condition-case ()
2841 (progn
2842 (eval-buffer (current-buffer))
2843 t)
2844 (error
2845 (gnus-error 3.2 "Possible error in %s" file)
2846 nil))
2847 (unless gnus-slave ; Slaves shouldn't delete these files.
2848 (ignore-errors
2849 (delete-file file))))
2850 (setq slave-files (cdr slave-files))))
2851 (gnus-dribble-touch)
2852 (gnus-message 7 "Reading slave newsrcs...done"))))
2853
2854\f
2855;;;
2856;;; Group description.
2857;;;
2858
2859(defun gnus-read-all-descriptions-files ()
2860 (let ((methods (cons gnus-select-method
2861 (nconc
2862 (when (gnus-archive-server-wanted-p)
2863 (list "archive"))
2864 gnus-secondary-select-methods))))
2865 (while methods
2866 (gnus-read-descriptions-file (car methods))
2867 (setq methods (cdr methods)))
2868 t))
2869
2870(defun gnus-read-descriptions-file (&optional method)
2871 (let ((method (or method gnus-select-method))
2872 group)
2873 (when (stringp method)
2874 (setq method (gnus-server-to-method method)))
2875 ;; We create the hashtable whether we manage to read the desc file
2876 ;; to avoid trying to re-read after a failed read.
2877 (unless gnus-description-hashtb
2878 (setq gnus-description-hashtb
2879 (gnus-make-hashtable (length gnus-active-hashtb))))
2880 ;; Mark this method's desc file as read.
2881 (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
2882 gnus-description-hashtb)
2883
2884 (gnus-message 5 "Reading descriptions file via %s..." (car method))
2885 (cond
16409b0b
GM
2886 ((null (gnus-get-function method 'request-list-newsgroups t))
2887 t)
eec82323
LMI
2888 ((not (gnus-check-server method))
2889 (gnus-message 1 "Couldn't open server")
2890 nil)
2891 ((not (gnus-request-list-newsgroups method))
2892 (gnus-message 1 "Couldn't read newsgroups descriptions")
2893 nil)
2894 (t
2895 (save-excursion
2896 (save-restriction
2897 (set-buffer nntp-server-buffer)
2898 (goto-char (point-min))
2899 (when (or (search-forward "\n.\n" nil t)
2900 (goto-char (point-max)))
2901 (beginning-of-line)
2902 (narrow-to-region (point-min) (point)))
2903 ;; If these are groups from a foreign select method, we insert the
2904 ;; group prefix in front of the group names.
2905 (and method (not (inline
2906 (gnus-server-equal
2907 (gnus-server-get-method nil method)
2908 (gnus-server-get-method
2909 nil gnus-select-method))))
2910 (let ((prefix (gnus-group-prefixed-name "" method)))
2911 (goto-char (point-min))
2912 (while (and (not (eobp))
2913 (progn (insert prefix)
2914 (zerop (forward-line 1)))))))
2915 (goto-char (point-min))
2916 (while (not (eobp))
2917 ;; If we get an error, we set group to 0, which is not a
2918 ;; symbol...
2919 (setq group
2920 (condition-case ()
2921 (let ((obarray gnus-description-hashtb))
2922 ;; Group is set to a symbol interned in this
2923 ;; hash table.
2924 (read nntp-server-buffer))
2925 (error 0)))
2926 (skip-chars-forward " \t")
2927 ;; ... which leads to this line being effectively ignored.
2928 (when (symbolp group)
23f87bed
MB
2929 (let* ((str (buffer-substring
2930 (point) (progn (end-of-line) (point))))
2931 (name (symbol-name group))
2932 (charset
2933 (or (gnus-group-name-charset method name)
2934 (gnus-parameter-charset name)
2935 gnus-default-charset)))
2936 ;; Fixme: Don't decode in unibyte mode.
2937 (when (and str charset (featurep 'mule))
2938 (setq str (mm-decode-coding-string str charset)))
0791fc56 2939 (set group str)))
eec82323
LMI
2940 (forward-line 1))))
2941 (gnus-message 5 "Reading descriptions file...done")
2942 t))))
2943
2944(defun gnus-group-get-description (group)
2945 "Get the description of a group by sending XGTITLE to the server."
2946 (when (gnus-request-group-description group)
2947 (save-excursion
2948 (set-buffer nntp-server-buffer)
2949 (goto-char (point-min))
2950 (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
2951 (match-string 1)))))
2952
2953;;;###autoload
2954(defun gnus-declare-backend (name &rest abilities)
23f87bed 2955 "Declare back end NAME with ABILITIES as a Gnus back end."
eec82323
LMI
2956 (setq gnus-valid-select-methods
2957 (nconc gnus-valid-select-methods
16409b0b
GM
2958 (list (apply 'list name abilities))))
2959 (gnus-redefine-select-method-widget))
eec82323
LMI
2960
2961(defun gnus-set-default-directory ()
2962 "Set the default directory in the current buffer to `gnus-default-directory'.
2963If this variable is nil, don't do anything."
2964 (setq default-directory
2965 (if (and gnus-default-directory
2966 (file-exists-p gnus-default-directory))
2967 (file-name-as-directory (expand-file-name gnus-default-directory))
2968 default-directory)))
2969
23f87bed
MB
2970(eval-and-compile
2971(defalias 'gnus-display-time-event-handler
2972 (if (gnus-boundp 'display-time-timer)
2973 'display-time-event-handler
2974 (lambda () "Does nothing as `display-time-timer' is not bound.
2975Would otherwise be an alias for `display-time-event-handler'." nil))))
2976
2977;;;###autoload
2978(defun gnus-fixup-nnimap-unread-after-getting-new-news ()
2979 (let (server group info)
2980 (mapatoms
2981 (lambda (sym)
2982 (when (and (setq group (symbol-name sym))
2983 (gnus-group-entry group)
2984 (setq info (symbol-value sym)))
2985 (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group)))
2986 gnus-newsrc-hashtb)))
2987 (if (boundp 'nnimap-mailbox-info)
2988 (symbol-value 'nnimap-mailbox-info)
2989 (make-vector 1 0)))))
2990
2991
eec82323
LMI
2992(provide 'gnus-start)
2993
ab5796a9 2994;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
eec82323 2995;;; gnus-start.el ends here
23f87bed
MB
2996
2997