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