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