*** empty log message ***
[gnus] / lisp / gnus.el
1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (eval '(run-hooks 'gnus-load-hook))
29
30 (require 'mail-utils)
31 (require 'timezone)
32 (require 'nnheader)
33
34 (eval-when-compile (require 'cl))
35
36 ;; Site dependent variables.  These variables should be defined in
37 ;; paths.el.
38
39 (defvar gnus-default-nntp-server nil
40   "Specify a default NNTP server.
41 This variable should be defined in paths.el, and should never be set
42 by the user.
43 If you want to change servers, you should use `gnus-select-method'.
44 See the documentation to that variable.")
45
46 (defconst gnus-backup-default-subscribed-newsgroups 
47   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
48   "Default default new newsgroups the first time Gnus is run.
49 Should be set in paths.el, and shouldn't be touched by the user.")
50
51 (defvar gnus-local-domain nil
52   "Local domain name without a host name.
53 The DOMAINNAME environment variable is used instead if it is defined.
54 If the `system-name' function returns the full Internet name, there is
55 no need to set this variable.")
56
57 (defvar gnus-local-organization nil
58   "String with a description of what organization (if any) the user belongs to.
59 The ORGANIZATION environment variable is used instead if it is defined.
60 If this variable contains a function, this function will be called
61 with the current newsgroup name as the argument.  The function should
62 return a string.
63
64 In any case, if the string (either in the variable, in the environment
65 variable, or returned by the function) is a file name, the contents of
66 this file will be used as the organization.")
67
68 (defvar gnus-use-generic-from nil
69   "If nil, the full host name will be the system name prepended to the domain name.
70 If this is a string, the full host name will be this string.
71 If this is non-nil, non-string, the domain name will be used as the
72 full host name.")
73
74 (defvar gnus-use-generic-path nil
75   "If nil, use the NNTP server name in the Path header.
76 If stringp, use this; if non-nil, use no host name (user name only).")
77
78
79 ;; Customization variables
80
81 ;; Don't touch this variable.
82 (defvar gnus-nntp-service "nntp"
83   "*NNTP service name (\"nntp\" or 119).
84 This is an obsolete variable, which is scarcely used.  If you use an
85 nntp server for your newsgroup and want to change the port number
86 used to 899, you would say something along these lines:
87
88  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
89
90 (defvar gnus-nntpserver-file "/etc/nntpserver"
91   "*A file with only the name of the nntp server in it.")
92
93 ;; This function is used to check both the environment variable
94 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
95 ;; an nntp server name default.
96 (defun gnus-getenv-nntpserver ()
97   (or (getenv "NNTPSERVER")
98       (and (file-readable-p gnus-nntpserver-file)
99            (save-excursion
100              (set-buffer (get-buffer-create " *gnus nntp*"))
101              (buffer-disable-undo (current-buffer))
102              (insert-file-contents gnus-nntpserver-file)
103              (let ((name (buffer-string)))
104                (prog1
105                    (if (string-match "^[ \t\n]*$" name)
106                        nil
107                      name)
108                  (kill-buffer (current-buffer))))))))
109                  
110 (defvar gnus-select-method 
111   (nconc
112    (list 'nntp (or (condition-case ()
113                        (gnus-getenv-nntpserver)
114                      (error nil))
115                    (if (and gnus-default-nntp-server
116                             (not (string= gnus-default-nntp-server "")))
117                        gnus-default-nntp-server)
118                    (system-name)))
119    (if (or (null gnus-nntp-service)
120            (equal gnus-nntp-service "nntp"))
121        nil 
122      (list gnus-nntp-service)))
123   "*Default method for selecting a newsgroup.
124 This variable should be a list, where the first element is how the
125 news is to be fetched, the second is the address. 
126
127 For instance, if you want to get your news via NNTP from
128 \"flab.flab.edu\", you could say:
129
130 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
131
132 If you want to use your local spool, say:
133
134 (setq gnus-select-method (list 'nnspool (system-name)))
135
136 If you use this variable, you must set `gnus-nntp-server' to nil.
137
138 There is a lot more to know about select methods and virtual servers -
139 see the manual for details.")
140
141 ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
142 (defvar gnus-post-method nil
143   "*Preferred method for posting USENET news.
144 If this variable is nil, Gnus will use the current method to decide
145 which method to use when posting.  If it is non-nil, it will override
146 the current method.  This method will not be used in mail groups and
147 the like, only in \"real\" newsgroups.
148
149 The value must be a valid method as discussed in the documentation of
150 `gnus-select-method'.")
151
152 (defvar gnus-refer-article-method nil
153   "*Preferred method for fetching an article by Message-ID.
154 If you are reading news from the local spool (with nnspool), fetching
155 articles by Message-ID is painfully slow.  By setting this method to an
156 nntp method, you might get acceptable results.
157
158 The value of this variable must be a valid select method as discussed
159 in the documentation of `gnus-select-method'")
160
161 (defvar gnus-secondary-select-methods nil
162   "*A list of secondary methods that will be used for reading news.
163 This is a list where each element is a complete select method (see
164 `gnus-select-method').  
165
166 If, for instance, you want to read your mail with the nnml backend,
167 you could set this variable:
168
169 (setq gnus-secondary-select-methods '((nnml \"\")))")
170
171 (defvar gnus-secondary-servers nil
172   "*List of NNTP servers that the user can choose between interactively.
173 To make Gnus query you for a server, you have to give `gnus' a
174 non-numeric prefix - `C-u M-x gnus', in short.")
175
176 (defvar gnus-nntp-server nil
177   "*The name of the host running the NNTP server.
178 This variable is semi-obsolete.  Use the `gnus-select-method'
179 variable instead.")
180
181 (defvar gnus-startup-file "~/.newsrc"
182   "*Your `.newsrc' file.
183 `.newsrc-SERVER' will be used instead if that exists.")
184
185 (defvar gnus-init-file "~/.gnus"
186   "*Your Gnus elisp startup file.
187 If a file with the .el or .elc suffixes exist, it will be read
188 instead.") 
189
190 (defvar gnus-group-faq-directory
191   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
192 ;    "/ftp@ftp.uu.net:/usenet/news.answers/"
193     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
194     "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
195     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
196 ;    "/ftp@ftp.Germany.EU.net:/pub/newsarchive/news.answers/"
197     "/ftp@ftp.sunet.se:/pub/usenet/"
198     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
199     "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
200     "/ftp@ftp.hk.super.net:/mirror/faqs/")
201   "*Directory where the group FAQs are stored.
202 This will most commonly be on a remote machine, and the file will be
203 fetched by ange-ftp.
204
205 This variable can also be a list of directories.  In that case, the
206 first element in the list will be used by default, and the others will
207 be used as backup sites.
208
209 Note that Gnus uses an aol machine as the default directory.  If this
210 feels fundamentally unclean, just think of it as a way to finally get
211 something of value back from them.
212
213 If the default site is too slow, try one of these:
214
215    North America: mirrors.aol.com                /pub/rtfm/usenet
216                   ftp.seas.gwu.edu               /pub/rtfm
217                   rtfm.mit.edu                   /pub/usenet/news.answers
218    Europe:        ftp.uni-paderborn.de           /pub/FAQ
219                   ftp.sunet.se                   /pub/usenet
220    Asia:          nctuccca.edu.tw                /USENET/FAQ
221                   hwarang.postech.ac.kr          /pub/usenet/news.answers
222                   ftp.hk.super.net               /mirror/faqs")
223
224 (defvar gnus-group-archive-directory
225   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" 
226   "*The address of the (ding) archives.")
227
228 (defvar gnus-group-recent-archive-directory
229   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
230   "*The address of the most recent (ding) articles.")
231
232 (defvar gnus-default-subscribed-newsgroups nil
233   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
234 It should be a list of strings.
235 If it is `t', Gnus will not do anything special the first time it is
236 started; it'll just use the normal newsgroups subscription methods.")
237
238 (defvar gnus-use-cross-reference t
239   "*Non-nil means that cross referenced articles will be marked as read.
240 If nil, ignore cross references.  If t, mark articles as read in
241 subscribed newsgroups.  If neither t nor nil, mark as read in all
242 newsgroups.") 
243
244 (defvar gnus-use-dribble-file t
245   "*Non-nil means that Gnus will use a dribble file to store user updates.
246 If Emacs should crash without saving the .newsrc files, complete
247 information can be restored from the dribble file.")
248
249 (defvar gnus-dribble-directory nil
250   "*The directory where dribble files will be saved.
251 If this variable is nil, the directory where the .newsrc files are
252 saved will be used.")
253
254 (defvar gnus-asynchronous nil
255   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
256
257 (defvar gnus-kill-summary-on-exit t
258   "*If non-nil, kill the summary buffer when you exit from it.
259 If nil, the summary will become a \"*Dead Summary*\" buffer, and
260 it will be killed sometime later.")
261
262 (defvar gnus-large-newsgroup 200
263   "*The number of articles which indicates a large newsgroup.
264 If the number of articles in a newsgroup is greater than this value,
265 confirmation is required for selecting the newsgroup.")
266
267 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
268 (defvar gnus-no-groups-message "No news is horrible news"
269   "*Message displayed by Gnus when no groups are available.")
270
271 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
272   "*Non-nil means that the default name of a file to save articles in is the group name.
273 If it's nil, the directory form of the group name is used instead.
274
275 If this variable is a list, and the list contains the element
276 `not-score', long file names will not be used for score files; if it
277 contains the element `not-save', long file names will not be used for
278 saving; and if it contains the element `not-kill', long file names
279 will not be used for kill files.")
280
281 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
282   "*Name of the directory articles will be saved in (default \"~/News\").
283 Initialized from the SAVEDIR environment variable.")
284
285 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
286   "*Name of the directory where kill files will be stored (default \"~/News\").
287 Initialized from the SAVEDIR environment variable.")
288
289 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
290   "*A function to save articles in your favorite format.
291 The function must be interactively callable (in other words, it must
292 be an Emacs command).
293
294 Gnus provides the following functions:
295
296 * gnus-summary-save-in-rmail (Rmail format)
297 * gnus-summary-save-in-mail (Unix mail format)
298 * gnus-summary-save-in-folder (MH folder)
299 * gnus-summary-save-in-file (article format).
300 * gnus-summary-save-in-vm (use VM's folder format).")
301
302 (defvar gnus-prompt-before-saving 'always
303   "*This variable says how much prompting is to be done when saving articles.
304 If it is nil, no prompting will be done, and the articles will be
305 saved to the default files.  If this variable is `always', each and
306 every article that is saved will be preceded by a prompt, even when
307 saving large batches of articles.  If this variable is neither nil not
308 `always', there the user will be prompted once for a file name for
309 each invocation of the saving commands.")
310
311 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
312   "*A function generating a file name to save articles in Rmail format.
313 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
314
315 (defvar gnus-mail-save-name (function gnus-plain-save-name)
316   "*A function generating a file name to save articles in Unix mail format.
317 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
318
319 (defvar gnus-folder-save-name (function gnus-folder-save-name)
320   "*A function generating a file name to save articles in MH folder.
321 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
322
323 (defvar gnus-file-save-name (function gnus-numeric-save-name)
324   "*A function generating a file name to save articles in article format.
325 The function is called with NEWSGROUP, HEADERS, and optional
326 LAST-FILE.")
327
328 (defvar gnus-split-methods 
329   '((gnus-article-archive-name))
330   "*Variable used to suggest where articles are to be saved.
331 For instance, if you would like to save articles related to Gnus in
332 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
333 you could set this variable to something like:
334
335  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
336    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
337
338 This variable is an alist where the where the key is the match and the
339 value is a list of possible files to save in if the match is non-nil.
340
341 If the match is a string, it is used as a regexp match on the
342 article.  If the match is a symbol, that symbol will be funcalled  
343 from the buffer of the article to be saved with the newsgroup as the
344 parameter.  If it is a list, it will be evaled in the same buffer.
345
346 If this form or function returns a string, this string will be used as
347 a possible file name; and if it returns a non-nil list, that list will
348 be used as possible file names.")
349
350 (defvar gnus-save-score nil
351   "*If non-nil, save group scoring info.")
352
353 (defvar gnus-use-adaptive-scoring nil
354   "*If non-nil, use some adaptive scoring scheme.")
355
356 (defvar gnus-use-cache nil
357   "*If nil, Gnus will ignore the article cache.
358 If `passive', it will allow entering (and reading) articles
359 explicitly entered into the cache.  If anything else, use the
360 cache to the full extent of the law.")
361
362 (defvar gnus-keep-backlog nil
363   "*If non-nil, Gnus will keep read articles for later re-retrieval.
364 If it is a number N, then Gnus will only keep the last N articles
365 read.  If it is neither nil nor a number, Gnus will keep all read
366 articles.  This is not a good idea.")
367
368 (defvar gnus-use-nocem nil
369   "*If non-nil, Gnus will read NoCeM cancel messages.")
370
371 (defvar gnus-use-demon nil
372   "If non-nil, Gnus might use some demons.")
373
374 (defvar gnus-use-scoring t
375   "*If non-nil, enable scoring.")
376
377 (defvar gnus-fetch-old-headers nil
378   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
379 If an unread article in the group refers to an older, already read (or
380 just marked as read) article, the old article will not normally be
381 displayed in the Summary buffer.  If this variable is non-nil, Gnus
382 will attempt to grab the headers to the old articles, and thereby
383 build complete threads.  If it has the value `some', only enough
384 headers to connect otherwise loose threads will be displayed.
385 This variable can also be a number.  In that case, no more than that
386 number of old headers will be fetched. 
387
388 The server has to support NOV for any of this to work.")
389
390 ;see gnus-cus.el
391 ;(defvar gnus-visual t
392 ;  "*If non-nil, will do various highlighting.
393 ;If nil, no mouse highlights (or any other highlights) will be
394 ;performed.  This might speed up Gnus some when generating large group
395 ;and summary buffers.")
396
397 (defvar gnus-novice-user t
398   "*Non-nil means that you are a usenet novice.
399 If non-nil, verbose messages may be displayed and confirmations may be
400 required.")
401
402 (defvar gnus-expert-user nil
403   "*Non-nil means that you will never be asked for confirmation about anything.
404 And that means *anything*.")
405
406 (defvar gnus-verbose 7
407   "*Integer that says how verbose Gnus should be.
408 The higher the number, the more messages Gnus will flash to say what
409 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
410 display most important messages; and at ten, Gnus will keep on
411 jabbering all the time.")
412
413 (defvar gnus-keep-same-level nil
414   "*Non-nil means that the next newsgroup after the current will be on the same level.
415 When you type, for instance, `n' after reading the last article in the
416 current newsgroup, you will go to the next newsgroup.  If this variable
417 is nil, the next newsgroup will be the next from the group
418 buffer. 
419 If this variable is non-nil, Gnus will either put you in the
420 next newsgroup with the same level, or, if no such newsgroup is
421 available, the next newsgroup with the lowest possible level higher
422 than the current level.
423 If this variable is `best', Gnus will make the next newsgroup the one
424 with the best level.")
425
426 (defvar gnus-summary-make-false-root 'adopt
427   "*nil means that Gnus won't gather loose threads.
428 If the root of a thread has expired or been read in a previous
429 session, the information necessary to build a complete thread has been
430 lost.  Instead of having many small sub-threads from this original thread
431 scattered all over the summary buffer, Gnus can gather them. 
432
433 If non-nil, Gnus will try to gather all loose sub-threads from an
434 original thread into one large thread.
435
436 If this variable is non-nil, it should be one of `none', `adopt',
437 `dummy' or `empty'.
438
439 If this variable is `none', Gnus will not make a false root, but just
440 present the sub-threads after another.
441 If this variable is `dummy', Gnus will create a dummy root that will
442 have all the sub-threads as children.
443 If this variable is `adopt', Gnus will make one of the \"children\"
444 the parent and mark all the step-children as such.
445 If this variable is `empty', the \"children\" are printed with empty
446 subject fields.  (Or rather, they will be printed with a string
447 given by the `gnus-summary-same-subject' variable.)")
448
449 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
450   "*A regexp to match subjects to be excluded from loose thread gathering.
451 As loose thread gathering is done on subjects only, that means that
452 there can be many false gatherings performed.  By rooting out certain
453 common subjects, gathering might become saner.")
454
455 (defvar gnus-summary-gather-subject-limit nil
456   "*Maximum length of subject comparisons when gathering loose threads.
457 Use nil to compare full subjects.  Setting this variable to a low
458 number will help gather threads that have been corrupted by
459 newsreaders chopping off subject lines, but it might also mean that
460 unrelated articles that have subject that happen to begin with the
461 same few characters will be incorrectly gathered.
462
463 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
464 comparing subjects.")
465
466 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
467 (defvar gnus-summary-same-subject ""
468   "*String indicating that the current article has the same subject as the previous.
469 This variable will only be used if the value of
470 `gnus-summary-make-false-root' is `empty'.")
471
472 (defvar gnus-summary-goto-unread t
473   "*If non-nil, marking commands will go to the next unread article.")
474
475 (defvar gnus-group-goto-unread t
476   "*If non-nil, movement commands will go to the next unread and subscribed group.")
477
478 (defvar gnus-check-new-newsgroups t
479   "*Non-nil means that Gnus will add new newsgroups at startup.
480 If this variable is `ask-server', Gnus will ask the server for new
481 groups since the last time it checked.  This means that the killed list
482 is no longer necessary, so you could set `gnus-save-killed-list' to
483 nil. 
484
485 A variant is to have this variable be a list of select methods.  Gnus
486 will then use the `ask-server' method on all these select methods to
487 query for new groups from all those servers.
488
489 Eg.
490   (setq gnus-check-new-newsgroups 
491         '((nntp \"some.server\") (nntp \"other.server\")))
492
493 If this variable is nil, then you have to tell Gnus explicitly to
494 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
495
496 (defvar gnus-check-bogus-newsgroups nil
497   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
498 If this variable is nil, then you have to tell Gnus explicitly to
499 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
500
501 (defvar gnus-read-active-file t
502   "*Non-nil means that Gnus will read the entire active file at startup.
503 If this variable is nil, Gnus will only know about the groups in your
504 `.newsrc' file.
505
506 If this variable is `some', Gnus will try to only read the relevant
507 parts of the active file from the server.  Not all servers support
508 this, and it might be quite slow with other servers, but this should
509 generally be faster than both the t and nil value.
510
511 If you set this variable to nil or `some', you probably still want to
512 be told about new newsgroups that arrive.  To do that, set
513 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
514 properly with all servers.")
515
516 (defvar gnus-level-subscribed 5
517   "*Groups with levels less than or equal to this variable are subscribed.")
518
519 (defvar gnus-level-unsubscribed 7
520   "*Groups with levels less than or equal to this variable are unsubscribed.
521 Groups with levels less than `gnus-level-subscribed', which should be
522 less than this variable, are subscribed.")
523
524 (defvar gnus-level-zombie 8
525   "*Groups with this level are zombie groups.")
526
527 (defvar gnus-level-killed 9
528   "*Groups with this level are killed.")
529
530 (defvar gnus-level-default-subscribed 3
531   "*New subscribed groups will be subscribed at this level.")
532
533 (defvar gnus-level-default-unsubscribed 6
534   "*New unsubscribed groups will be unsubscribed at this level.")
535
536 (defvar gnus-activate-level (1+ gnus-level-subscribed)
537   "*Groups higher than this level won't be activated on startup.
538 Setting this variable to something log might save lots of time when
539 you have many groups that you aren't interested in.")
540
541 (defvar gnus-activate-foreign-newsgroups 4
542   "*If nil, Gnus will not check foreign newsgroups at startup.
543 If it is non-nil, it should be a number between one and nine.  Foreign
544 newsgroups that have a level lower or equal to this number will be
545 activated on startup.  For instance, if you want to active all
546 subscribed newsgroups, but not the rest, you'd set this variable to 
547 `gnus-level-subscribed'.
548
549 If you subscribe to lots of newsgroups from different servers, startup
550 might take a while.  By setting this variable to nil, you'll save time,
551 but you won't be told how many unread articles there are in the
552 groups.")
553
554 (defvar gnus-save-newsrc-file t
555   "*Non-nil means that Gnus will save the `.newsrc' file.
556 Gnus always saves its own startup file, which is called
557 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
558 be readily understood by other newsreaders.  If you don't plan on
559 using other newsreaders, set this variable to nil to save some time on
560 exit.")
561
562 (defvar gnus-save-killed-list t
563   "*If non-nil, save the list of killed groups to the startup file.
564 This will save both time (when starting and quitting) and space (both
565 memory and disk), but it will also mean that Gnus has no record of
566 which groups are new and which are old, so the automatic new
567 newsgroups subscription methods become meaningless.  You should always
568 set `gnus-check-new-newsgroups' to `ask-server' or nil if you set this
569 variable to nil.")
570
571 (defvar gnus-interactive-catchup t
572   "*If non-nil, require your confirmation when catching up a group.")
573
574 (defvar gnus-interactive-post t
575   "*If non-nil, group name will be asked for when posting.")
576
577 (defvar gnus-interactive-exit t
578   "*If non-nil, require your confirmation when exiting Gnus.")
579
580 (defvar gnus-kill-killed t
581   "*If non-nil, Gnus will apply kill files to already killed articles.
582 If it is nil, Gnus will never apply kill files to articles that have
583 already been through the scoring process, which might very well save lots
584 of time.")
585
586 (defvar gnus-extract-address-components 'gnus-extract-address-components
587   "*Function for extracting address components from a From header.
588 Two pre-defined function exist: `gnus-extract-address-components',
589 which is the default, quite fast, and too simplistic solution, and
590 `mail-extract-address-components', which works much better, but is
591 slower.")
592
593 (defvar gnus-summary-default-score 0
594   "*Default article score level.
595 If this variable is nil, scoring will be disabled.")
596
597 (defvar gnus-summary-zcore-fuzz 0
598   "*Fuzziness factor for the zcore in the summary buffer.
599 Articles with scores closer than this to `gnus-summary-default-score'
600 will not be marked.")
601
602 (defvar gnus-simplify-subject-fuzzy-regexp nil
603   "*Strings to be removed when doing fuzzy matches.
604 This can either be a egular expression or list of regular expressions
605 that will be removed from subject strings if fuzzy subject
606 simplification is selected.")
607
608 (defvar gnus-permanently-visible-groups nil
609   "*Regexp to match groups that should always be listed in the group buffer.
610 This means that they will still be listed when there are no unread
611 articles in the groups.")
612
613 (defvar gnus-group-default-list-level gnus-level-subscribed
614   "*Default listing level. 
615 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
616
617 (defvar gnus-group-use-permanent-levels nil
618   "*If non-nil, once you set a level, Gnus will use this level.")
619
620 (defvar gnus-show-mime nil
621   "*If non-nil, do mime processing of articles.
622 The articles will simply be fed to the function given by
623 `gnus-show-mime-method'.")
624
625 (defvar gnus-strict-mime t
626   "*If nil, decode MIME header even if there is not Mime-Version field.")
627  
628 (defvar gnus-show-mime-method 'metamail-buffer
629   "*Function to process a MIME message.
630 The function is called from the article buffer.")
631
632 (defvar gnus-decode-encoded-word-method (lambda ())
633   "*Function to decode a MIME encoded-words.
634 The function is called from the article buffer.")
635  
636 (defvar gnus-show-threads t
637   "*If non-nil, display threads in summary mode.")
638
639 (defvar gnus-thread-hide-subtree nil
640   "*If non-nil, hide all threads initially.
641 If threads are hidden, you have to run the command
642 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
643 to expose hidden threads.")
644
645 (defvar gnus-thread-hide-killed t
646   "*If non-nil, hide killed threads automatically.")
647
648 (defvar gnus-thread-ignore-subject nil
649   "*If non-nil, ignore subjects and do all threading based on the Reference header.
650 If nil, which is the default, articles that have different subjects
651 from their parents will start separate threads.")
652
653 (defvar gnus-thread-operation-ignore-subject t
654   "*If non-nil, subjects will be ignored when doing thread commands.
655 This affects commands like `gnus-summary-kill-thread' and
656 `gnus-summary-lower-thread'.  
657
658 If this variable is nil, articles in the same thread with different
659 subjects will not be included in the operation in question.  If this
660 variable is `fuzzy', only articles that have subjects that are fuzzily
661 equal will be included.")
662
663 (defvar gnus-thread-indent-level 4
664   "*Number that says how much each sub-thread should be indented.")
665
666 (defvar gnus-ignored-newsgroups 
667   (purecopy (mapconcat 'identity
668                        '("^to\\."       ; not "real" groups
669                          "^[0-9. \t]+ " ; all digits in name
670                          "[][\"#'()]"   ; bogus characters
671                          )
672                        "\\|"))
673   "*A regexp to match uninteresting newsgroups in the active file.
674 Any lines in the active file matching this regular expression are
675 removed from the newsgroup list before anything else is done to it,
676 thus making them effectively non-existent.")
677
678 (defvar gnus-ignored-headers
679   "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:"
680   "*All headers that match this regexp will be hidden.
681 This variable can also be a list of regexps of headers to be ignored.
682 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
683
684 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Resent-"
685   "*All headers that do not match this regexp will be hidden.
686 This variable can also be a list of regexp of headers to remain visible.
687 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
688
689 (defvar gnus-sorted-header-list
690   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" 
691     "^Cc:" "^Date:" "^Organization:")
692   "*This variable is a list of regular expressions.
693 If it is non-nil, headers that match the regular expressions will
694 be placed first in the article buffer in the sequence specified by
695 this list.")
696
697 (defvar gnus-show-all-headers nil
698   "*If non-nil, don't hide any headers.")
699
700 (defvar gnus-save-all-headers t
701   "*If non-nil, don't remove any headers before saving.")
702
703 (defvar gnus-saved-headers gnus-visible-headers
704   "*Headers to keep if `gnus-save-all-headers' is nil.
705 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
706 If that variable is nil, however, all headers that match this regexp
707 will be kept while the rest will be deleted before saving.")
708
709 (defvar gnus-inhibit-startup-message nil
710   "*If non-nil, the startup message will not be displayed.")
711
712 (defvar gnus-signature-separator "^-- *$"
713   "Regexp matching signature separator.")
714
715 (defvar gnus-auto-extend-newsgroup t
716   "*If non-nil, extend newsgroup forward and backward when requested.")
717
718 (defvar gnus-auto-select-first t
719   "*If nil, don't select the first unread article when entering a group.
720 If this variable is `best', select the highest-scored unread article
721 in the group.  If neither nil nor `best', select the first unread
722 article.
723
724 If you want to prevent automatic selection of the first unread article
725 in some newsgroups, set the variable to nil in
726 `gnus-select-group-hook'.") 
727
728 (defvar gnus-auto-select-next t
729   "*If non-nil, offer to go to the next group from the end of the previous.
730 If the value is t and the next newsgroup is empty, Gnus will exit
731 summary mode and go back to group mode.  If the value is neither nil
732 nor t, Gnus will select the following unread newsgroup.  In
733 particular, if the value is the symbol `quietly', the next unread
734 newsgroup will be selected without any confirmation, and if it is
735 `almost-quietly', the next group will be selected without any
736 confirmation if you are located on the last article in the group.")
737
738 (defvar gnus-auto-select-same nil
739   "*If non-nil, select the next article with the same subject.")
740
741 (defvar gnus-summary-check-current nil
742   "*If non-nil, consider the current article when moving.
743 The \"unread\" movement commands will stay on the same line if the
744 current article is unread.")
745
746 (defvar gnus-auto-center-summary t
747   "*If non-nil, always center the current summary buffer.")
748
749 (defvar gnus-break-pages t
750   "*If non-nil, do page breaking on articles.
751 The page delimiter is specified by the `gnus-page-delimiter'
752 variable.")
753
754 (defvar gnus-page-delimiter "^\^L"
755   "*Regexp describing what to use as article page delimiters.
756 The default value is \"^\^L\", which is a form linefeed at the
757 beginning of a line.")
758
759 (defvar gnus-use-full-window t
760   "*If non-nil, use the entire Emacs screen.")
761
762 (defvar gnus-window-configuration nil
763   "Obsolete variable.  See `gnus-buffer-configuration'.")
764
765 (defvar gnus-buffer-configuration
766   '((group ([group 1.0 point] 
767             (if gnus-carpal [group-carpal 4])))
768     (summary ([summary 1.0 point]
769               (if gnus-carpal [summary-carpal 4])))
770     (article ([summary 0.25 point] 
771               (if gnus-carpal [summary-carpal 4]) 
772               [article 1.0]))
773     (server ([server 1.0 point]
774              (if gnus-carpal [server-carpal 2])))
775     (browse ([browse 1.0 point]
776              (if gnus-carpal [browse-carpal 2])))
777     (group-mail ([mail 1.0 point]))
778     (summary-mail ([mail 1.0 point]))
779     (summary-reply ([article 0.5]
780                     [mail 1.0 point]))
781     (info ([nil 1.0 point]))
782     (summary-faq ([summary 0.25]
783                   [faq 1.0 point]))
784     (edit-group ([group 0.5]
785                  [edit-group 1.0 point]))
786     (edit-server ([server 0.5]
787                   [edit-server 1.0 point]))
788     (edit-score ([summary 0.25]
789                  [edit-score 1.0 point]))
790     (post ([post 1.0 point]))
791     (reply ([article 0.5]
792             [mail 1.0 point]))
793     (mail-forward ([mail 1.0 point]))
794     (post-forward ([post 1.0 point]))
795     (reply-yank ([mail 1.0 point]))
796     (mail-bounce ([article 0.5]
797                   [mail 1.0 point]))
798     (draft ([draft 1.0 point]))
799     (pipe ([summary 0.25 point] 
800            (if gnus-carpal [summary-carpal 4]) 
801            ["*Shell Command Output*" 1.0]))
802     (followup ([article 0.5]
803                [post 1.0 point]))
804     (followup-yank ([post 1.0 point])))
805   "Window configuration for all possible Gnus buffers.
806 This variable is a list of lists.  Each of these lists has a NAME and
807 a RULE.  The NAMEs are commonsense names like `group', which names a
808 rule used when displaying the group buffer; `summary', which names a
809 rule for what happens when you enter a group and do not display an
810 article buffer; and so on.  See the value of this variable for a
811 complete list of NAMEs.
812
813 Each RULE is a list of vectors.  The first element in this vector is
814 the name of the buffer to be displayed; the second element is the
815 percentage of the screen this buffer is to occupy (a number in the
816 0.0-0.99 range); the optional third element is `point', which should
817 be present to denote which buffer point is to go to after making this
818 buffer configuration.")
819
820 (defvar gnus-window-to-buffer
821   '((group . gnus-group-buffer)
822     (summary . gnus-summary-buffer)
823     (article . gnus-article-buffer)
824     (server . gnus-server-buffer)
825     (browse . "*Gnus Browse Server*")
826     (edit-group . gnus-group-edit-buffer)
827     (edit-server . gnus-server-edit-buffer)
828     (group-carpal . gnus-carpal-group-buffer)
829     (summary-carpal . gnus-carpal-summary-buffer)
830     (server-carpal . gnus-carpal-server-buffer)
831     (browse-carpal . gnus-carpal-browse-buffer)
832     (edit-score . gnus-score-edit-buffer)
833     (mail . gnus-mail-buffer)
834     (post . gnus-post-news-buffer)
835     (faq . gnus-faq-buffer)
836     (draft . gnus-draft-buffer))
837   "Mapping from short symbols to buffer names or buffer variables.")
838
839 (defvar gnus-carpal nil
840   "*If non-nil, display clickable icons.")
841
842 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
843   "*Function called with a group name when new group is detected.
844 A few pre-made functions are supplied: `gnus-subscribe-randomly'
845 inserts new groups at the beginning of the list of groups;
846 `gnus-subscribe-alphabetically' inserts new groups in strict
847 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
848 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
849 for your decision; `gnus-subscribe-killed' kills all new groups.")
850
851 ;; Suggested by a bug report by Hallvard B Furuseth.
852 ;; <h.b.furuseth@usit.uio.no>. 
853 (defvar gnus-subscribe-options-newsgroup-method
854   (function gnus-subscribe-alphabetically)
855   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
856 If, for instance, you want to subscribe to all newsgroups in the
857 \"no\" and \"alt\" hierarchies, you'd put the following in your
858 .newsrc file:
859
860 options -n no.all alt.all
861
862 Gnus will the subscribe all new newsgroups in these hierarchies with
863 the subscription method in this variable.")
864
865 (defvar gnus-subscribe-hierarchical-interactive nil
866   "*If non-nil, Gnus will offer to subscribe hierarchically.
867 When a new hierarchy appears, Gnus will ask the user:
868
869 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
870
871 If the user pressed `d', Gnus will descend the hierarchy, `y' will
872 subscribe to all newsgroups in the hierarchy and `s' will skip this
873 hierarchy in its entirety.")
874
875 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
876   "*Function used for sorting the group buffer.
877 This function will be called with group info entries as the arguments
878 for the groups to be sorted.  Pre-made functions include
879 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
880 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
881 `gnus-group-sort-by-rank'.  
882
883 This variable can also be a list of sorting functions.  In that case,
884 the most significant sort function should be the last function in the
885 list.")
886
887 ;; Mark variables suggested by Thomas Michanek
888 ;; <Thomas.Michanek@telelogic.se>. 
889 (defvar gnus-unread-mark ? 
890   "*Mark used for unread articles.")
891 (defvar gnus-ticked-mark ?!
892   "*Mark used for ticked articles.")
893 (defvar gnus-dormant-mark ??
894   "*Mark used for dormant articles.")
895 (defvar gnus-del-mark ?r
896   "*Mark used for del'd articles.")
897 (defvar gnus-read-mark ?R
898   "*Mark used for read articles.")
899 (defvar gnus-expirable-mark ?E
900   "*Mark used for expirable articles.")
901 (defvar gnus-killed-mark ?K
902   "*Mark used for killed articles.")
903 (defvar gnus-souped-mark ?F
904   "*Mark used for killed articles.")
905 (defvar gnus-kill-file-mark ?X
906   "*Mark used for articles killed by kill files.")
907 (defvar gnus-low-score-mark ?Y
908   "*Mark used for articles with a low score.")
909 (defvar gnus-catchup-mark ?C
910   "*Mark used for articles that are caught up.")
911 (defvar gnus-replied-mark ?A
912   "*Mark used for articles that have been replied to.")
913 (defvar gnus-cached-mark ?*
914   "*Mark used for articles that are in the cache.")
915 (defvar gnus-saved-mark ?S
916   "*Mark used for articles that have been saved to.")
917 (defvar gnus-process-mark ?# 
918   "*Process mark.")
919 (defvar gnus-ancient-mark ?O
920   "*Mark used for ancient articles.")
921 (defvar gnus-canceled-mark ?G
922   "*Mark used for canceled articles.")
923 (defvar gnus-score-over-mark ?+
924   "*Score mark used for articles with high scores.")
925 (defvar gnus-score-below-mark ?-
926   "*Score mark used for articles with low scores.")
927 (defvar gnus-empty-thread-mark ? 
928   "*There is no thread under the article.")
929 (defvar gnus-not-empty-thread-mark ?=
930   "*There is a thread under the article.")
931
932 (defvar gnus-view-pseudo-asynchronously nil
933   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
934
935 (defvar gnus-view-pseudos nil
936   "*If `automatic', pseudo-articles will be viewed automatically.
937 If `not-confirm', pseudos will be viewed automatically, and the user
938 will not be asked to confirm the command.")
939
940 (defvar gnus-view-pseudos-separately t
941   "*If non-nil, one pseudo-article will be created for each file to be viewed.
942 If nil, all files that use the same viewing command will be given as a
943 list of parameters to that command.")
944
945 (defvar gnus-insert-pseudo-articles t
946   "*If non-nil, insert pseudo-articles when decoding articles.")
947
948 (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)\n"
949   "*Format of group lines.
950 It works along the same lines as a normal formatting string,
951 with some simple extensions.
952
953 %M    Only marked articles (character, \"*\" or \" \")
954 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
955 %L    Level of subscribedness (integer)
956 %N    Number of unread articles (integer)
957 %I    Number of dormant articles (integer)
958 %i    Number of ticked and dormant (integer)
959 %T    Number of ticked articles (integer)
960 %R    Number of read articles (integer)
961 %t    Total number of articles (integer)
962 %y    Number of unread, unticked articles (integer)
963 %G    Group name (string)
964 %g    Qualified group name (string)
965 %D    Group description (string)
966 %s    Select method (string)
967 %o    Moderated group (char, \"m\")
968 %p    Process mark (char)
969 %O    Moderated group (string, \"(m)\" or \"\")
970 %P    Topic indentation (string)
971 %n    Select from where (string)
972 %z    A string that look like `<%s:%n>' if a foreign select method is used
973 %u    User defined specifier.  The next character in the format string should
974       be a letter.  Gnus will call the function gnus-user-format-function-X,
975       where X is the letter following %u.  The function will be passed the
976       current header as argument.  The function should return a string, which
977       will be inserted into the buffer just like information from any other
978       group specifier.
979
980 Text between %( and %) will be highlighted with `gnus-mouse-face' when
981 the mouse point move inside the area.  There can only be one such area.
982
983 Note that this format specification is not always respected.  For
984 reasons of efficiency, when listing killed groups, this specification
985 is ignored altogether.  If the spec is changed considerably, your
986 output may end up looking strange when listing both alive and killed
987 groups.
988
989 If you use %o or %O, reading the active file will be slower and quite
990 a bit of extra memory will be used. %D will also worsen performance.
991 Also note that if you change the format specification to include any
992 of these specs, you must probably re-start Gnus to see them go into
993 effect.") 
994
995 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
996   "*The format specification of the lines in the summary buffer.
997
998 It works along the same lines as a normal formatting string,
999 with some simple extensions.
1000
1001 %N   Article number, left padded with spaces (string)
1002 %S   Subject (string)
1003 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1004 %n   Name of the poster (string)
1005 %a   Extracted name of the poster (string)
1006 %A   Extracted address of the poster (string)
1007 %F   Contents of the From: header (string)
1008 %x   Contents of the Xref: header (string)
1009 %D   Date of the article (string)
1010 %d   Date of the article (string) in DD-MMM format
1011 %M   Message-id of the article (string)
1012 %r   References of the article (string)
1013 %c   Number of characters in the article (integer)
1014 %L   Number of lines in the article (integer)
1015 %I   Indentation based on thread level (a string of spaces)
1016 %T   A string with two possible values: 80 spaces if the article
1017      is on thread level two or larger and 0 spaces on level one
1018 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1019 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1020 %[   Opening bracket (character, \"[\" or \"<\")
1021 %]   Closing bracket (character, \"]\" or \">\")
1022 %>   Spaces of length thread-level (string)
1023 %<   Spaces of length (- 20 thread-level) (string)
1024 %i   Article score (number)
1025 %z   Article zcore (character)
1026 %t   Number of articles under the current thread (number).
1027 %e   Whether the thread is empty or not (character).
1028 %u   User defined specifier.  The next character in the format string should
1029      be a letter.  Gnus will call the function gnus-user-format-function-X,
1030      where X is the letter following %u.  The function will be passed the
1031      current header as argument.  The function should return a string, which
1032      will be inserted into the summary just like information from any other
1033      summary specifier.
1034
1035 Text between %( and %) will be highlighted with `gnus-mouse-face'
1036 when the mouse point is placed inside the area.  There can only be one
1037 such area.
1038
1039 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1040 with care.  For reasons of efficiency, Gnus will compute what column
1041 these characters will end up in, and \"hard-code\" that.  This means that
1042 it is illegal to have these specs after a variable-length spec.  Well,
1043 you might not be arrested, but your summary buffer will look strange,
1044 which is bad enough.
1045
1046 The smart choice is to have these specs as for to the left as
1047 possible. 
1048
1049 This restriction may disappear in later versions of Gnus.")
1050
1051 (defvar gnus-summary-dummy-line-format 
1052   "*  %(:                          :%) %S\n"
1053   "*The format specification for the dummy roots in the summary buffer.
1054 It works along the same lines as a normal formatting string,
1055 with some simple extensions.
1056
1057 %S  The subject")
1058
1059 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
1060   "*The format specification for the summary mode line.
1061 It works along the same lines as a normal formatting string,
1062 with some simple extensions:
1063
1064 %G  Group name
1065 %p  Unprefixed group name
1066 %A  Current article number
1067 %V  Gnus version
1068 %U  Number of unread articles in the group
1069 %e  Number of unselected articles in the group
1070 %Z  A string with unread/unselected article counts
1071 %g  Shortish group name
1072 %S  Subject of the current article
1073 %u  User-defined spec
1074 %s  Current score file name
1075 %d  Number of dormant articles
1076 %r  Number of articles that have been marked as read in this session
1077 %E  Number of articles expunged by the score files")
1078
1079 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1080   "*The format specification for the article mode line.
1081 See `gnus-summary-mode-line-format' for a closer description.")
1082
1083 (defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
1084   "*The format specification for the group mode line.
1085 It works along the same lines as a normal formatting string,
1086 with some simple extensions:
1087
1088 %S   The native news server.
1089 %M   The native select method.")
1090
1091 (defvar gnus-valid-select-methods
1092   '(("nntp" post address prompt-address)
1093     ("nnspool" post)
1094     ("nnvirtual" post-mail virtual prompt-address) 
1095     ("nnmbox" mail respool) 
1096     ("nnml" mail respool)
1097     ("nnmh" mail respool) 
1098     ("nndir" post-mail prompt-address address)
1099     ("nneething" none prompt-address)
1100     ("nndoc" none prompt-address) 
1101     ("nnbabyl" mail respool) 
1102     ("nnkiboze" post virtual) 
1103     ("nnsoup" post-mail)
1104     ("nnfolder" mail respool))
1105   "An alist of valid select methods.
1106 The first element of each list lists should be a string with the name
1107 of the select method.  The other elements may be be the category of
1108 this method (ie. `post', `mail', `none' or whatever) or other
1109 properties that this method has (like being respoolable).
1110 If you implement a new select method, all you should have to change is
1111 this variable.  I think.")
1112
1113 (defvar gnus-updated-mode-lines '(group article summary)
1114   "*List of buffers that should update their mode lines.
1115 The list may contain the symbols `group', `article' and `summary'.  If
1116 the corresponding symbol is present, Gnus will keep that mode line
1117 updated with information that may be pertinent. 
1118 If this variable is nil, screen refresh may be quicker.")
1119
1120 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1121 (defvar gnus-mode-non-string-length nil
1122   "*Max length of mode-line non-string contents.
1123 If this is nil, Gnus will take space as is needed, leaving the rest
1124 of the modeline intact.")
1125
1126 ;see gnus-cus.el
1127 ;(defvar gnus-mouse-face 'highlight
1128 ;  "*Face used for mouse highlighting in Gnus.
1129 ;No mouse highlights will be done if `gnus-visual' is nil.")
1130
1131 (defvar gnus-summary-mark-below nil
1132   "*Mark all articles with a score below this variable as read.
1133 This variable is local to each summary buffer and usually set by the
1134 score file.")  
1135
1136 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
1137   "*List of functions used for sorting articles in the summary buffer.")
1138
1139 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1140   "*List of functions used for sorting threads in the summary buffer.
1141 By default, threads are sorted by article number.
1142
1143 Each function takes two threads and return non-nil if the first thread
1144 should be sorted before the other.  If you use more than one function,
1145 the primary sort function should be the last.
1146
1147 Ready-mady functions include `gnus-thread-sort-by-number',
1148 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1149 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1150 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1151
1152 (defvar gnus-thread-score-function '+
1153   "*Function used for calculating the total score of a thread.
1154
1155 The function is called with the scores of the article and each
1156 subthread and should then return the score of the thread.
1157
1158 Some functions you can use are `+', `max', or `min'.")
1159
1160 (defvar gnus-summary-expunge-below nil
1161   "All articles that have a score less than this variable will be expunged.")
1162
1163 (defvar gnus-thread-expunge-below nil
1164   "All threads that have a total score less than this variable will be expunged.
1165 See `gnus-thread-score-function' for en explanation of what a 
1166 \"thread score\" is.")
1167
1168 (defvar gnus-auto-subscribed-groups 
1169   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1170   "*All new groups that match this regexp will be subscribed automatically.
1171 Note that this variable only deals with new groups.  It has no effect
1172 whatsoever on old groups.")
1173
1174 (defvar gnus-options-subscribe nil
1175   "*All new groups matching this regexp will be subscribed unconditionally.
1176 Note that this variable deals only with new newsgroups.  This variable
1177 does not affect old newsgroups.")
1178
1179 (defvar gnus-options-not-subscribe nil
1180   "*All new groups matching this regexp will be ignored.
1181 Note that this variable deals only with new newsgroups.  This variable
1182 does not affect old (already subscribed) newsgroups.")
1183
1184 (defvar gnus-auto-expirable-newsgroups nil
1185   "*Groups in which to automatically mark read articles as expirable.
1186 If non-nil, this should be a regexp that should match all groups in
1187 which to perform auto-expiry.  This only makes sense for mail groups.")
1188
1189 (defvar gnus-total-expirable-newsgroups nil
1190   "*Groups in which to perform expiry of all read articles.
1191 Use with extreme caution.  All groups that match this regexp will be
1192 expiring - which means that all read articles will be deleted after
1193 (say) one week.  (This only goes for mail groups and the like, of
1194 course.)")
1195
1196 (defvar gnus-hidden-properties '(invisible t intangible t)
1197   "Property list to use for hiding text.")
1198
1199 (defvar gnus-modtime-botch nil
1200   "*Non-nil means .newsrc should be deleted prior to save.  Its use is
1201 due to the bogus appearance that .newsrc was modified on disc.")
1202
1203 ;; Hooks.
1204
1205 (defvar gnus-group-mode-hook nil
1206   "*A hook for Gnus group mode.")
1207
1208 (defvar gnus-summary-mode-hook nil
1209   "*A hook for Gnus summary mode.
1210 This hook is run before any variables are set in the summary buffer.")
1211
1212 (defvar gnus-article-mode-hook nil
1213   "*A hook for Gnus article mode.")
1214
1215 (defun gnus-summary-prepare-exit-hook nil
1216   "*A hook called when preparing to exit from the summary buffer.
1217 It calls `gnus-summary-expire-articles' by default.")
1218 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1219
1220 (defun gnus-summary-exit-hook nil
1221   "*A hook called on exit from the summary buffer.")
1222
1223 (defvar gnus-open-server-hook nil
1224   "*A hook called just before opening connection to the news server.")
1225
1226 (defvar gnus-load-hook nil
1227   "*A hook run while Gnus is loaded.")
1228
1229 (defvar gnus-startup-hook nil
1230   "*A hook called at startup.
1231 This hook is called after Gnus is connected to the NNTP server.")
1232
1233 (defvar gnus-get-new-news-hook nil
1234   "*A hook run just before Gnus checks for new news.")
1235
1236 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1237   "*A function that is called to generate the group buffer.
1238 The function is called with three arguments: The first is a number;
1239 all group with a level less or equal to that number should be listed,
1240 if the second is non-nil, empty groups should also be displayed.  If
1241 the third is non-nil, it is a number.  No groups with a level lower
1242 than this number should be displayed.
1243
1244 The only current function implemented is `gnus-group-prepare-flat'.")
1245
1246 (defvar gnus-group-prepare-hook nil
1247   "*A hook called after the group buffer has been generated.
1248 If you want to modify the group buffer, you can use this hook.")
1249
1250 (defvar gnus-summary-prepare-hook nil
1251   "*A hook called after the summary buffer has been generated.
1252 If you want to modify the summary buffer, you can use this hook.")
1253
1254 (defvar gnus-summary-generate-hook nil
1255   "*A hook run just before generating the summary buffer.
1256 This hook is commonly used to customize threading variables and the
1257 like.")
1258
1259 (defvar gnus-article-prepare-hook nil
1260   "*A hook called after an article has been prepared in the article buffer.
1261 If you want to run a special decoding program like nkf, use this hook.")
1262
1263 ;(defvar gnus-article-display-hook nil
1264 ;  "*A hook called after the article is displayed in the article buffer.
1265 ;The hook is designed to change the contents of the article
1266 ;buffer.  Typical functions that this hook may contain are
1267 ;`gnus-article-hide-headers' (hide selected headers),
1268 ;`gnus-article-maybe-highlight' (perform fancy article highlighting), 
1269 ;`gnus-article-hide-signature' (hide signature) and
1270 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1271 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1272 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1273 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1274
1275 (defvar gnus-article-x-face-command
1276   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1277   "String or function to be executed to display an X-Face header.
1278 If it is a string, the command will be executed in a sub-shell
1279 asynchronously.  The compressed face will be piped to this command.") 
1280
1281 (defvar gnus-article-x-face-too-ugly nil
1282   "Regexp matching posters whose face shouldn't be shown automatically.")
1283
1284 (defvar gnus-select-group-hook nil
1285   "*A hook called when a newsgroup is selected.
1286
1287 If you'd like to simplify subjects like the
1288 `gnus-summary-next-same-subject' command does, you can use the
1289 following hook:
1290
1291  (setq gnus-select-group-hook
1292       (list
1293         (lambda ()
1294           (mapcar (lambda (header)
1295                      (mail-header-set-subject
1296                       header
1297                       (gnus-simplify-subject
1298                        (mail-header-subject header) 're-only)))
1299                   gnus-newsgroup-headers))))")
1300
1301 (defvar gnus-select-article-hook
1302   '(gnus-summary-show-thread)
1303   "*A hook called when an article is selected.
1304 The default hook shows conversation thread subtrees of the selected
1305 article automatically using `gnus-summary-show-thread'.")
1306
1307 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1308   "*A hook called to apply kill files to a group.
1309 This hook is intended to apply a kill file to the selected newsgroup.
1310 The function `gnus-apply-kill-file' is called by default.
1311
1312 Since a general kill file is too heavy to use only for a few
1313 newsgroups, I recommend you to use a lighter hook function.  For
1314 example, if you'd like to apply a kill file to articles which contains
1315 a string `rmgroup' in subject in newsgroup `control', you can use the
1316 following hook:
1317
1318  (setq gnus-apply-kill-hook
1319       (list
1320         (lambda ()
1321           (cond ((string-match \"control\" gnus-newsgroup-name)
1322                  (gnus-kill \"Subject\" \"rmgroup\")
1323                  (gnus-expunge \"X\"))))))")
1324
1325 (defvar gnus-visual-mark-article-hook 
1326   (list 'gnus-highlight-selected-summary)
1327   "*Hook run after selecting an article in the summary buffer.
1328 It is meant to be used for highlighting the article in some way.  It
1329 is not run if `gnus-visual' is nil.")
1330
1331 (defun gnus-parse-headers-hook nil
1332   "*A hook called before parsing the headers.")
1333
1334 (defvar gnus-exit-group-hook nil
1335   "*A hook called when exiting (not quitting) summary mode.")
1336
1337 (defvar gnus-suspend-gnus-hook nil
1338   "*A hook called when suspending (not exiting) Gnus.")
1339
1340 (defvar gnus-exit-gnus-hook nil
1341   "*A hook called when exiting Gnus.")
1342
1343 (defvar gnus-save-newsrc-hook nil
1344   "*A hook called before saving any of the newsrc files.")
1345
1346 (defvar gnus-save-quick-newsrc-hook nil
1347   "*A hook called just before saving the quick newsrc file.
1348 Can be used to turn version control on or off.")
1349
1350 (defvar gnus-save-standard-newsrc-hook nil
1351   "*A hook called just before saving the standard newsrc file.
1352 Can be used to turn version control on or off.")
1353
1354 (defvar gnus-summary-update-hook 
1355   (list 'gnus-summary-highlight-line)
1356   "*A hook called when a summary line is changed.
1357 The hook will not be called if `gnus-visual' is nil.
1358
1359 The default function `gnus-summary-highlight-line' will
1360 highlight the line according to the `gnus-summary-highlight'
1361 variable.")
1362
1363 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1364   "*A hook called when an article is selected for the first time.
1365 The hook is intended to mark an article as read (or unread)
1366 automatically when it is selected.")
1367
1368 ;; Remove any hilit infestation.
1369 (add-hook 'gnus-startup-hook
1370           (lambda ()
1371             (remove-hook 'gnus-summary-prepare-hook
1372                          'hilit-rehighlight-buffer-quietly)
1373             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1374             (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
1375             (remove-hook 'gnus-article-prepare-hook
1376                          'hilit-rehighlight-buffer-quietly)))
1377
1378
1379 \f
1380 ;; Internal variables
1381
1382 ;; Avoid highlighting in kill files.
1383 (defvar gnus-summary-inhibit-highlight nil)
1384 (defvar gnus-newsgroup-selected-overlay nil)
1385
1386 (defvar gnus-inhibit-hiding nil)
1387 (defvar gnus-topic-indentation "")
1388 (defvar gnus-inhibit-limiting nil)
1389
1390 (defvar gnus-article-mode-map nil)
1391 (defvar gnus-dribble-buffer nil)
1392 (defvar gnus-headers-retrieved-by nil)
1393 (defvar gnus-article-reply nil)
1394 (defvar gnus-override-method nil)
1395 (defvar gnus-article-check-size nil)
1396
1397 (defvar gnus-nocem-hashtb nil)
1398
1399 (defvar gnus-current-score-file nil)
1400 (defvar gnus-newsgroup-adaptive-score-file nil)
1401 (defvar gnus-scores-exclude-files nil)
1402
1403 (defvar gnus-opened-servers nil)
1404
1405 (defvar gnus-current-move-group nil)
1406
1407 (defvar gnus-newsgroup-dependencies nil)
1408 (defvar gnus-newsgroup-async nil)
1409 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1410
1411 (defvar gnus-newsgroup-adaptive nil)
1412
1413 (defvar gnus-summary-display-table nil)
1414
1415 (defconst gnus-group-line-format-alist
1416   `((?M gnus-tmp-marked-mark ?c)
1417     (?S gnus-tmp-subscribed ?c)
1418     (?L gnus-tmp-level ?d)
1419     (?N gnus-tmp-number ?s)
1420     (?R gnus-tmp-number-of-read ?s)
1421     (?t gnus-tmp-number-total ?d)
1422     (?y gnus-tmp-number-of-unread ?s)
1423     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1424     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1425     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1426            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1427     (?g gnus-tmp-group ?s)
1428     (?G gnus-tmp-qualified-group ?s)
1429     (?c (gnus-group-short-name gnus-tmp-group) ?s)
1430     (?D gnus-tmp-newsgroup-description ?s)
1431     (?o gnus-tmp-moderated ?c)
1432     (?O gnus-tmp-moderated-string ?s)
1433     (?p gnus-tmp-process-marked ?c)
1434     (?s gnus-tmp-news-server ?s)
1435     (?n gnus-tmp-news-method ?s)
1436     (?P gnus-topic-indentation ?s)
1437     (?z gnus-tmp-news-method-string ?s)
1438     (?u gnus-tmp-user-defined ?s)))
1439
1440 (defconst gnus-summary-line-format-alist 
1441   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1442     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1443     (?s gnus-tmp-subject-or-nil ?s)
1444     (?n gnus-tmp-name ?s)
1445     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1446         ?s)
1447     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) 
1448             gnus-tmp-from) ?s)
1449     (?F gnus-tmp-from ?s)
1450     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1451     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1452     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1453     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1454     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1455     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1456     (?L gnus-tmp-lines ?d)
1457     (?I gnus-tmp-indentation ?s)
1458     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1459     (?R gnus-tmp-replied ?c)
1460     (?\[ gnus-tmp-opening-bracket ?c)
1461     (?\] gnus-tmp-closing-bracket ?c)
1462     (?\> (make-string gnus-tmp-level ? ) ?s)
1463     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1464     (?i gnus-tmp-score ?d)
1465     (?z gnus-tmp-score-char ?c)
1466     (?U gnus-tmp-unread ?c)
1467     (?t (gnus-summary-number-of-articles-in-thread 
1468          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1469         ?d)
1470     (?e (gnus-summary-number-of-articles-in-thread 
1471          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1472         ?c)
1473     (?u gnus-tmp-user-defined ?s))
1474   "An alist of format specifications that can appear in summary lines,
1475 and what variables they correspond with, along with the type of the
1476 variable (string, integer, character, etc).")
1477
1478 (defconst gnus-summary-dummy-line-format-alist
1479   (` ((?S gnus-tmp-subject ?s)
1480       (?N gnus-tmp-number ?d)
1481       (?u gnus-tmp-user-defined ?s))))
1482
1483 (defconst gnus-summary-mode-line-format-alist 
1484   (` ((?G gnus-tmp-group-name ?s)
1485       (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1486       (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1487       (?A gnus-tmp-article-number ?d)
1488       (?Z gnus-tmp-unread-and-unselected ?s)
1489       (?V gnus-version ?s)
1490       (?U gnus-tmp-unread ?d)
1491       (?S gnus-tmp-subject ?s)
1492       (?e gnus-tmp-unselected ?d)
1493       (?u gnus-tmp-user-defined ?s)
1494       (?d (length gnus-newsgroup-dormant) ?d)
1495       (?t (length gnus-newsgroup-marked) ?d)
1496       (?r (length gnus-newsgroup-reads) ?d)
1497       (?E gnus-newsgroup-expunged-tally ?d)
1498       (?s (gnus-current-score-file-nondirectory) ?s))))
1499
1500 (defconst gnus-article-mode-line-format-alist  
1501   gnus-summary-mode-line-format-alist)
1502
1503 (defconst gnus-group-mode-line-format-alist 
1504   (` ((?S gnus-tmp-news-server ?s)
1505       (?M gnus-tmp-news-method ?s)
1506       (?u gnus-tmp-user-defined ?s))))
1507
1508 (defvar gnus-have-read-active-file nil)
1509
1510 (defconst gnus-maintainer
1511   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1512   "The mail address of the Gnus maintainers.")
1513
1514 (defconst gnus-version "September Gnus v0.22"
1515   "Version number for this version of Gnus.")
1516
1517 (defvar gnus-info-nodes
1518   '((gnus-group-mode            "(gnus)The Group Buffer")
1519     (gnus-summary-mode          "(gnus)The Summary Buffer")
1520     (gnus-article-mode          "(gnus)The Article Buffer"))
1521   "Assoc list of major modes and related Info nodes.")
1522
1523 (defvar gnus-group-buffer "*Group*")
1524 (defvar gnus-summary-buffer "*Summary*")
1525 (defvar gnus-article-buffer "*Article*")
1526 (defvar gnus-server-buffer "*Server*")
1527
1528 (defvar gnus-work-buffer " *gnus work*")
1529
1530 (defvar gnus-original-article-buffer " *Original Article*")
1531 (defvar gnus-original-article nil)
1532
1533 (defvar gnus-buffer-list nil
1534   "Gnus buffers that should be killed on exit.")
1535
1536 (defvar gnus-server-alist nil
1537   "List of available servers.")
1538
1539 (defvar gnus-slave nil
1540   "Whether this Gnus is a slave or not.")
1541
1542 (defvar gnus-variable-list
1543   '(gnus-newsrc-options gnus-newsrc-options-n
1544     gnus-newsrc-last-checked-date 
1545     gnus-newsrc-alist gnus-server-alist
1546     gnus-killed-list gnus-zombie-list
1547     gnus-topic-topology gnus-topic-alist)
1548   "Gnus variables saved in the quick startup file.")
1549
1550 (defvar gnus-newsrc-options nil
1551   "Options line in the .newsrc file.")
1552
1553 (defvar gnus-newsrc-options-n nil
1554   "List of regexps representing groups to be subscribed/ignored unconditionally.") 
1555
1556 (defvar gnus-newsrc-last-checked-date nil
1557   "Date Gnus last asked server for new newsgroups.")
1558
1559 (defvar gnus-topic-topology nil
1560   "The complete topic hierarchy.")
1561
1562 (defvar gnus-topic-alist nil
1563   "The complete topic-group alist.")
1564
1565 (defvar gnus-newsrc-alist nil
1566   "Assoc list of read articles.
1567 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1568
1569 (defvar gnus-newsrc-hashtb nil
1570   "Hashtable of gnus-newsrc-alist.")
1571
1572 (defvar gnus-killed-list nil
1573   "List of killed newsgroups.")
1574
1575 (defvar gnus-killed-hashtb nil
1576   "Hash table equivalent of gnus-killed-list.")
1577
1578 (defvar gnus-zombie-list nil
1579   "List of almost dead newsgroups.")
1580
1581 (defvar gnus-description-hashtb nil
1582   "Descriptions of newsgroups.")
1583
1584 (defvar gnus-list-of-killed-groups nil
1585   "List of newsgroups that have recently been killed by the user.")
1586
1587 (defvar gnus-active-hashtb nil
1588   "Hashtable of active articles.")
1589
1590 (defvar gnus-moderated-list nil
1591   "List of moderated newsgroups.")
1592
1593 (defvar gnus-group-marked nil)
1594
1595 (defvar gnus-current-startup-file nil
1596   "Startup file for the current host.")
1597
1598 (defvar gnus-last-search-regexp nil
1599   "Default regexp for article search command.")
1600
1601 (defvar gnus-last-shell-command nil
1602   "Default shell command on article.")
1603
1604 (defvar gnus-current-select-method nil
1605   "The current method for selecting a newsgroup.")
1606
1607 (defvar gnus-group-list-mode nil)
1608
1609 (defvar gnus-article-internal-prepare-hook nil)
1610
1611 (defvar gnus-newsgroup-name nil)
1612 (defvar gnus-newsgroup-begin nil)
1613 (defvar gnus-newsgroup-end nil)
1614 (defvar gnus-newsgroup-last-rmail nil)
1615 (defvar gnus-newsgroup-last-mail nil)
1616 (defvar gnus-newsgroup-last-folder nil)
1617 (defvar gnus-newsgroup-last-file nil)
1618 (defvar gnus-newsgroup-auto-expire nil)
1619 (defvar gnus-newsgroup-active nil)
1620
1621 (defvar gnus-newsgroup-data nil)
1622 (defvar gnus-newsgroup-data-reverse nil)
1623 (defvar gnus-newsgroup-limit nil)
1624 (defvar gnus-newsgroup-limits nil)
1625
1626 (defvar gnus-newsgroup-unreads nil
1627   "List of unread articles in the current newsgroup.")
1628
1629 (defvar gnus-newsgroup-unselected nil
1630   "List of unselected unread articles in the current newsgroup.")
1631
1632 (defvar gnus-newsgroup-reads nil
1633   "Alist of read articles and article marks in the current newsgroup.")
1634
1635 (defvar gnus-newsgroup-expunged-tally nil)
1636
1637 (defvar gnus-newsgroup-marked nil
1638   "List of ticked articles in the current newsgroup (a subset of unread art).")
1639
1640 (defvar gnus-newsgroup-killed nil
1641   "List of ranges of articles that have been through the scoring process.")
1642
1643 (defvar gnus-newsgroup-cached nil
1644   "List of articles that come from the article cache.")
1645
1646 (defvar gnus-newsgroup-saved nil
1647   "List of articles that have been saved.")
1648
1649 (defvar gnus-newsgroup-kill-headers nil)
1650
1651 (defvar gnus-newsgroup-replied nil
1652   "List of articles that have been replied to in the current newsgroup.")
1653
1654 (defvar gnus-newsgroup-expirable nil
1655   "List of articles in the current newsgroup that can be expired.")
1656
1657 (defvar gnus-newsgroup-processable nil
1658   "List of articles in the current newsgroup that can be processed.")
1659
1660 (defvar gnus-newsgroup-bookmarks nil
1661   "List of articles in the current newsgroup that have bookmarks.")
1662
1663 (defvar gnus-newsgroup-dormant nil
1664   "List of dormant articles in the current newsgroup.")
1665
1666 (defvar gnus-newsgroup-scored nil
1667   "List of scored articles in the current newsgroup.")
1668
1669 (defvar gnus-newsgroup-headers nil
1670   "List of article headers in the current newsgroup.")
1671
1672 (defvar gnus-newsgroup-threads nil)
1673
1674 (defvar gnus-newsgroup-prepared nil
1675   "Whether the current group has been prepared properly.")
1676
1677 (defvar gnus-newsgroup-ancient nil
1678   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1679
1680 (defvar gnus-current-article nil)
1681 (defvar gnus-article-current nil)
1682 (defvar gnus-current-headers nil)
1683 (defvar gnus-have-all-headers nil)
1684 (defvar gnus-last-article nil)
1685 (defvar gnus-newsgroup-history nil)
1686 (defvar gnus-current-kill-article nil)
1687
1688 ;; Save window configuration.
1689 (defvar gnus-prev-winconf nil)
1690
1691 (defvar gnus-summary-mark-positions nil)
1692 (defvar gnus-group-mark-positions nil)
1693
1694 (defvar gnus-reffed-article-number nil)
1695
1696 ;;; Let the byte-compiler know that we know about this variable.
1697 (defvar rmail-default-rmail-file)
1698
1699 (defvar gnus-cache-removeable-articles nil)
1700
1701 (defvar gnus-dead-summary nil)
1702
1703 (defconst gnus-summary-local-variables 
1704   '(gnus-newsgroup-name 
1705     gnus-newsgroup-begin gnus-newsgroup-end 
1706     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail 
1707     gnus-newsgroup-last-folder gnus-newsgroup-last-file 
1708     gnus-newsgroup-auto-expire gnus-newsgroup-unreads 
1709     gnus-newsgroup-unselected gnus-newsgroup-marked
1710     gnus-newsgroup-reads gnus-newsgroup-saved
1711     gnus-newsgroup-replied gnus-newsgroup-expirable
1712     gnus-newsgroup-processable gnus-newsgroup-killed
1713     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1714     gnus-newsgroup-headers gnus-newsgroup-threads
1715     gnus-newsgroup-prepared
1716     gnus-current-article gnus-current-headers gnus-have-all-headers
1717     gnus-last-article gnus-article-internal-prepare-hook
1718     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1719     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1720     gnus-newsgroup-async
1721     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below 
1722     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1723     gnus-newsgroup-history gnus-newsgroup-ancient
1724     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1725     gnus-newsgroup-adaptive-score-file
1726     (gnus-newsgroup-expunged-tally . 0)
1727     gnus-cache-removeable-articles gnus-newsgroup-cached
1728     gnus-newsgroup-data gnus-newsgroup-data-reverse
1729     gnus-newsgroup-limit gnus-newsgroup-limits)
1730   "Variables that are buffer-local to the summary buffers.")
1731
1732 (defconst gnus-bug-message
1733   "Sending a bug report to the Gnus Towers.
1734 ========================================
1735
1736 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1737 be sent to the Gnus Bug Exterminators. 
1738
1739 At the bottom of the buffer you'll see lots of variable settings.
1740 Please do not delete those.  They will tell the Bug People what your
1741 environment is, so that it will be easier to locate the bugs.
1742
1743 If you have found a bug that makes Emacs go \"beep\", set
1744 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') 
1745 and include the backtrace in your bug report.
1746
1747 Please describe the bug in annoying, painstaking detail.
1748
1749 Thank you for your help in stamping out bugs.
1750 ")
1751
1752 ;;; End of variables.
1753
1754 ;; Define some autoload functions Gnus might use.
1755 (eval-and-compile
1756
1757   ;; This little mapcar goes through the list below and marks the
1758   ;; symbols in question as autoloaded functions.
1759   (mapcar 
1760    (lambda (package)
1761      (let ((interactive (nth 1 (memq ':interactive package))))
1762        (mapcar 
1763         (lambda (function)
1764           (let (keymap)
1765             (when (consp function)
1766               (setq keymap (car (memq 'keymap function)))
1767               (setq function (car function)))
1768             (autoload function (car package) nil interactive keymap)))
1769         (if (eq (nth 1 package) ':interactive)
1770             (cdddr package)
1771           (cdr package)))))
1772    '(("metamail" metamail-buffer)
1773      ("info" Info-goto-node)
1774      ("hexl" hexl-hex-string-to-integer)
1775      ("pp" pp pp-to-string pp-eval-expression)
1776      ("mail-extr" mail-extract-address-components)
1777      ("nnmail" nnmail-split-fancy nnmail-article-group)
1778      ("nnvirtual" nnvirtual-catchup-group)
1779      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1780       timezone-make-sortable-date timezone-make-time-string)
1781      ("sendmail" mail-position-on-field mail-setup)
1782      ("rmailout" rmail-output)
1783      ("rnewspost" news-mail-other-window news-reply-yank-original 
1784       news-caesar-buffer-body)
1785      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1786       rmail-show-message)
1787      ("gnus-soup" :interactive t
1788       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article 
1789       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1790      ("nnsoup" nnsoup-pack-replies)
1791      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder 
1792       gnus-Folder-save-name gnus-folder-save-name)
1793      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1794      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1795       gnus-server-make-menu-bar gnus-article-make-menu-bar
1796       gnus-browse-make-menu-bar gnus-highlight-selected-summary
1797       gnus-summary-highlight-line gnus-carpal-setup-buffer
1798       gnus-article-add-button gnus-insert-next-page-button
1799       gnus-insert-prev-page-button)
1800      ("gnus-vis" :interactive t
1801       gnus-article-push-button gnus-article-press-button 
1802       gnus-article-highlight gnus-article-highlight-some 
1803       gnus-article-hide gnus-article-hide-signature 
1804       gnus-article-highlight-headers gnus-article-highlight-signature 
1805       gnus-article-add-buttons gnus-article-add-buttons-to-head 
1806       gnus-article-next-button gnus-article-prev-button)
1807      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1808       gnus-demon-add-disconnection gnus-demon-add-handler
1809       gnus-demon-remove-handler)
1810      ("gnus-demon" :interactive t
1811       gnus-demon-init gnus-demon-cancel)
1812      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
1813      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1814      ("gnus-cite" :interactive t
1815       gnus-article-highlight-citation gnus-article-hide-citation-maybe 
1816       gnus-article-hide-citation)
1817      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal 
1818       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author 
1819       gnus-execute gnus-expunge)
1820      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
1821       gnus-cache-possibly-remove-articles gnus-cache-request-article
1822       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
1823       gnus-cache-enter-remove-article gnus-cached-article-p
1824       gnus-cache-open gnus-cache-close)
1825      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
1826       gnus-cache-remove-article)
1827      ("gnus-score" :interactive t
1828       gnus-summary-increase-score gnus-summary-lower-score
1829       gnus-score-flush-cache gnus-score-close 
1830       gnus-score-raise-same-subject-and-select 
1831       gnus-score-raise-same-subject gnus-score-default 
1832       gnus-score-raise-thread gnus-score-lower-same-subject-and-select 
1833       gnus-score-lower-same-subject gnus-score-lower-thread 
1834       gnus-possibly-score-headers)
1835      ("gnus-score" 
1836       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
1837       gnus-current-score-file-nondirectory gnus-score-adaptive
1838       gnus-score-find-trace gnus-score-file-name)
1839      ("gnus-edit" :interactive t gnus-score-customize)
1840      ("gnus-topic" :interactive t gnus-topic-mode)
1841      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
1842      ("gnus-uu" :interactive t
1843       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward 
1844       gnus-uu-mark-series gnus-uu-mark-region 
1845       gnus-uu-mark-by-regexp gnus-uu-mark-all 
1846       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu 
1847       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar 
1848       gnus-uu-decode-unshar-and-save gnus-uu-decode-save 
1849       gnus-uu-decode-binhex gnus-uu-decode-uu-view 
1850       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view 
1851       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view 
1852       gnus-uu-decode-binhex-view)
1853      ("gnus-msg" (gnus-summary-send-map keymap)
1854       gnus-mail-yank-original gnus-mail-send-and-exit
1855       gnus-sendmail-setup-mail gnus-article-mail 
1856       gnus-inews-message-id gnus-new-mail gnus-mail-reply)
1857      ("gnus-msg" :interactive t
1858       gnus-group-post-news gnus-group-mail gnus-summary-post-news
1859       gnus-summary-followup gnus-summary-followup-with-original
1860       gnus-summary-followup-and-reply
1861       gnus-summary-followup-and-reply-with-original
1862       gnus-summary-cancel-article gnus-summary-supersede-article
1863       gnus-post-news gnus-inews-news gnus-cancel-news
1864       gnus-summary-reply gnus-summary-reply-with-original
1865       gnus-summary-mail-forward gnus-summary-mail-other-window
1866       gnus-bug)
1867      ("gnus-vm" gnus-vm-mail-setup)
1868      ("gnus-vm" :interactive t gnus-summary-save-in-vm
1869       gnus-summary-save-article-vm gnus-yank-article))))
1870
1871 \f
1872
1873 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1874 ;; If you want the cursor to go somewhere else, set these two
1875 ;; functions in some startup hook to whatever you want.
1876 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
1877 (defalias 'gnus-group-position-point 'gnus-goto-colon)
1878
1879 ;;; Various macros and substs.
1880
1881 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
1882   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
1883   `(let ((GnusStartBufferWindow (selected-window)))
1884      (unwind-protect
1885          (progn
1886            (pop-to-buffer ,buffer)
1887            ,@forms)
1888        (select-window GnusStartBufferWindow))))
1889
1890 (defmacro gnus-gethash (string hashtable)
1891   "Get hash value of STRING in HASHTABLE."
1892   `(symbol-value (intern-soft ,string ,hashtable)))
1893
1894 (defmacro gnus-sethash (string value hashtable)
1895   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
1896   `(set (intern ,string ,hashtable) ,value))
1897
1898 (defmacro gnus-intern-safe (string hashtable)
1899   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
1900   `(let ((symbol (intern ,string ,hashtable)))
1901      (or (boundp symbol)
1902          (set symbol nil))
1903      symbol))
1904
1905 (defmacro gnus-group-unread (group)
1906   "Get the currently computed number of unread articles in GROUP."
1907   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
1908
1909 (defmacro gnus-active (group)
1910   "Get active info on GROUP."
1911   `(gnus-gethash ,group gnus-active-hashtb))
1912
1913 (defmacro gnus-set-active (group active)
1914   "Set GROUP's active info."
1915   `(gnus-sethash ,group ,active gnus-active-hashtb))
1916
1917 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
1918 ;;   function `substring' might cut on a middle of multi-octet
1919 ;;   character.
1920 (defun gnus-truncate-string (str width)
1921   (substring str 0 width))
1922
1923 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
1924 ;; to limit the length of a string.  This function is necessary since
1925 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
1926 (defsubst gnus-limit-string (str width)
1927   (if (> (length str) width)
1928       (substring str 0 width)
1929     str))
1930
1931 (defsubst gnus-simplify-subject-re (subject)
1932   "Remove \"Re:\" from subject lines."
1933   (if (string-match "^[Rr][Ee]: *" subject)
1934       (substring subject (match-end 0))
1935     subject))
1936
1937 (defsubst gnus-goto-char (point)
1938   (and point (goto-char point)))
1939
1940 (defmacro gnus-buffer-exists-p (buffer)
1941   `(and ,buffer
1942         (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
1943                  ,buffer)))
1944
1945 (defmacro gnus-kill-buffer (buffer)
1946   `(let ((buf ,buffer))
1947      (if (gnus-buffer-exists-p buf)
1948          (kill-buffer buf))))
1949
1950 (defsubst gnus-point-at-bol ()
1951   "Return point at the beginning of the line."
1952   (let ((p (point)))
1953     (beginning-of-line)
1954     (prog1
1955         (point)
1956       (goto-char p))))
1957
1958 (defsubst gnus-point-at-eol ()
1959   "Return point at the end of the line."
1960   (let ((p (point)))
1961     (end-of-line)
1962     (prog1
1963         (point)
1964       (goto-char p))))
1965
1966 ;; Delete the current line (and the next N lines.);
1967 (defmacro gnus-delete-line (&optional n)
1968   `(delete-region (progn (beginning-of-line) (point))
1969                   (progn (forward-line ,(or n 1)) (point))))
1970
1971 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
1972 (defvar gnus-init-inhibit nil)
1973 (defun gnus-read-init-file (&optional inhibit-next)
1974   (if gnus-init-inhibit
1975       (setq gnus-init-inhibit nil)
1976     (setq gnus-init-inhibit inhibit-next)
1977     (and gnus-init-file
1978          (or (and (file-exists-p gnus-init-file) 
1979                   ;; Don't try to load a directory.
1980                   (not (file-directory-p gnus-init-file)))
1981              (file-exists-p (concat gnus-init-file ".el"))
1982              (file-exists-p (concat gnus-init-file ".elc")))
1983          (load gnus-init-file nil t))))
1984
1985 ;; Info access macros.
1986
1987 (defmacro gnus-info-group (info)
1988   `(nth 0 ,info))
1989 (defmacro gnus-info-rank (info)
1990   `(nth 1 ,info))
1991 (defmacro gnus-info-read (info)
1992   `(nth 2 ,info))
1993 (defmacro gnus-info-marks (info)
1994   `(nth 3 ,info))
1995 (defmacro gnus-info-method (info)
1996   `(nth 4 ,info))
1997 (defmacro gnus-info-params (info)
1998   `(nth 5 ,info))
1999
2000 (defmacro gnus-info-level (info)
2001   `(let ((rank (gnus-info-rank ,info)))
2002      (if (consp rank)
2003          (car rank)
2004        rank)))
2005 (defmacro gnus-info-score (info)
2006   `(let ((rank (gnus-info-rank ,info)))
2007      (or (and (consp rank) (cdr rank)) 0)))
2008
2009 (defmacro gnus-info-set-group (info group)
2010   `(setcar ,info ,group))
2011 (defmacro gnus-info-set-rank (info rank)
2012   `(setcar (nthcdr 1 ,info) ,rank))
2013 (defmacro gnus-info-set-read (info read)
2014   `(setcar (nthcdr 2 ,info) ,read))
2015 (defmacro gnus-info-set-marks (info marks)
2016   `(setcar (nthcdr 3 ,info) ,marks))
2017 (defmacro gnus-info-set-method (info method)
2018   `(setcar (nthcdr 4 ,info) ,method))
2019 (defmacro gnus-info-set-params (info params)
2020   `(setcar (nthcdr 5 ,info) ,params))
2021
2022 (defmacro gnus-info-set-level (info level)
2023   `(let ((rank (cdr ,info)))
2024      (if (consp (car rank))
2025          (setcar (car rank) ,level)
2026        (setcar rank ,level))))
2027 (defmacro gnus-info-set-score (info score)
2028   `(let ((rank (cdr ,info)))
2029      (if (consp (car rank))
2030          (setcdr (car rank) ,score)
2031        (setcar rank (cons (car rank) ,score)))))
2032
2033 (defmacro gnus-get-info (group)
2034   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2035
2036 (defun gnus-byte-code (func)
2037   "Return a form that can be `eval'ed based on FUNC."
2038   (let ((fval (symbol-function func)))
2039     (if (byte-code-function-p fval)
2040         (let ((flist (append fval nil)))
2041           (setcar flist 'byte-code)
2042           flist)
2043       (cons 'progn (cdr (cdr fval))))))
2044
2045 ;;; Load the user startup file.
2046 ;; (eval '(gnus-read-init-file 'inhibit))
2047
2048 ;;; Load the compatability functions. 
2049
2050 (require 'gnus-cus)
2051 (require 'gnus-ems)
2052
2053 \f
2054
2055 ;; Format specs.  The chunks below are the machine-generated forms
2056 ;; that are to be evaled as the result of the default format strings.
2057 ;; We write them in here to get them byte-compiled.  That way the
2058 ;; default actions will be quite fast, while still retaining the full
2059 ;; flexibility of the user-defined format specs. 
2060
2061 ;; First we have lots of dummy defvars to let the compiler know these
2062 ;; are really dynamic variables.
2063
2064 (defvar gnus-tmp-unread)
2065 (defvar gnus-tmp-replied)
2066 (defvar gnus-tmp-score-char)
2067 (defvar gnus-tmp-indentation)
2068 (defvar gnus-tmp-opening-bracket)
2069 (defvar gnus-tmp-lines)
2070 (defvar gnus-tmp-name)
2071 (defvar gnus-tmp-closing-bracket)
2072 (defvar gnus-tmp-subject-or-nil)
2073 (defvar gnus-tmp-subject)
2074 (defvar gnus-tmp-marked)
2075 (defvar gnus-tmp-marked-mark)
2076 (defvar gnus-tmp-subscribed)
2077 (defvar gnus-tmp-process-marked)
2078 (defvar gnus-tmp-number-of-unread)
2079 (defvar gnus-tmp-group-name)
2080 (defvar gnus-tmp-group)
2081 (defvar gnus-tmp-article-number)
2082 (defvar gnus-tmp-unread-and-unselected)
2083 (defvar gnus-tmp-news-method)
2084 (defvar gnus-tmp-news-server)
2085 (defvar gnus-tmp-article-number)
2086 (defvar gnus-mouse-face)
2087 (defvar gnus-mouse-face-prop)
2088
2089 (defun gnus-summary-line-format-spec ()
2090   (insert gnus-tmp-unread gnus-tmp-replied 
2091           gnus-tmp-score-char gnus-tmp-indentation)
2092   (put-text-property
2093    (point)
2094    (progn
2095      (insert 
2096       gnus-tmp-opening-bracket 
2097       (format "%4d: %-20s" 
2098               gnus-tmp-lines 
2099               (if (> (length gnus-tmp-name) 20) 
2100                   (substring gnus-tmp-name 0 20) 
2101                 gnus-tmp-name))
2102       gnus-tmp-closing-bracket)
2103      (point))
2104    gnus-mouse-face-prop gnus-mouse-face)
2105   (insert " " gnus-tmp-subject-or-nil "\n"))
2106
2107 (defvar gnus-summary-line-format-spec 
2108   (gnus-byte-code 'gnus-summary-line-format-spec))
2109
2110 (defun gnus-summary-dummy-line-format-spec ()
2111   (insert "*  ")
2112   (put-text-property
2113    (point)
2114    (progn
2115      (insert ":                          :")
2116      (point))
2117    gnus-mouse-face-prop gnus-mouse-face)
2118   (insert " " gnus-tmp-subject "\n"))
2119
2120 (defvar gnus-summary-dummy-line-format-spec 
2121   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2122
2123 (defun gnus-group-line-format-spec ()
2124   (insert gnus-tmp-marked-mark gnus-tmp-subscribed 
2125           gnus-tmp-process-marked
2126           gnus-topic-indentation
2127           (format "%5s: " gnus-tmp-number-of-unread))
2128   (put-text-property 
2129    (point)
2130    (progn
2131      (insert gnus-tmp-group "\n")
2132      (1- (point)))
2133    gnus-mouse-face-prop gnus-mouse-face))
2134 (defvar gnus-group-line-format-spec 
2135   (gnus-byte-code 'gnus-group-line-format-spec))
2136
2137 (defvar gnus-old-specs 
2138   '((group . "%M%S%p%5y: %(%g%)\n")
2139     (summary-dummy . "*  :                          : %S\n")
2140     (summary . "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n")))
2141
2142 (defvar gnus-article-mode-line-format-spec nil)
2143 (defvar gnus-summary-mode-line-format-spec nil)
2144 (defvar gnus-group-mode-line-format-spec nil)
2145
2146 ;;; Phew.  All that gruft is over, fortunately.  
2147
2148 \f
2149 ;;;
2150 ;;; Gnus Utility Functions
2151 ;;;
2152
2153 (defun gnus-extract-address-components (from)
2154   (let (name address)
2155     ;; First find the address - the thing with the @ in it.  This may
2156     ;; not be accurate in mail addresses, but does the trick most of
2157     ;; the time in news messages.
2158     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2159         (setq address (substring from (match-beginning 0) (match-end 0))))
2160     ;; Then we check whether the "name <address>" format is used.
2161     (and address
2162          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2163          ;; Linear white space is not required.
2164          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2165          (and (setq name (substring from 0 (match-beginning 0)))
2166               ;; Strip any quotes from the name.
2167               (string-match "\".*\"" name)
2168               (setq name (substring name 1 (1- (match-end 0))))))
2169     ;; If not, then "address (name)" is used.
2170     (or name
2171         (and (string-match "(.+)" from)
2172              (setq name (substring from (1+ (match-beginning 0)) 
2173                                    (1- (match-end 0)))))
2174         (and (string-match "()" from)
2175              (setq name address))
2176         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2177         ;; XOVER might not support folded From headers.
2178         (and (string-match "(.*" from)
2179              (setq name (substring from (1+ (match-beginning 0)) 
2180                                    (match-end 0)))))
2181     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2182     (list (or name from) (or address from))))
2183
2184 (defun gnus-fetch-field (field)
2185   "Return the value of the header FIELD of current article."
2186   (save-excursion
2187     (save-restriction
2188       (let ((case-fold-search t))
2189         (gnus-narrow-to-headers)
2190         (mail-fetch-field field)))))
2191
2192 (defun gnus-goto-colon ()
2193   (beginning-of-line)
2194   (search-forward ":" (gnus-point-at-eol) t))
2195
2196 (defun gnus-narrow-to-headers ()
2197   "Narrow to the head of an article."
2198   (widen)
2199   (narrow-to-region
2200    (goto-char (point-min))
2201    (if (search-forward "\n\n" nil t)
2202        (1- (point))
2203      (point-max)))
2204   (goto-char (point-min)))
2205
2206 ;;;###autoload
2207 (defun gnus-update-format (var)
2208   "Update the format specification near point."
2209   (interactive
2210    (list
2211     (save-excursion
2212       (eval-defun nil)
2213       ;; Find the end of the current word.
2214       (re-search-forward "[ \t\n]" nil t)
2215       ;; Search backward.
2216       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2217         (match-string 1)))))
2218   (set
2219    (intern (format "%s-spec" var))
2220    (gnus-parse-format (symbol-value (intern var))
2221                       (symbol-value (intern (format "%s-alist" var)))
2222                       (not (string-match "mode" var))))
2223   (pop-to-buffer "*Gnus Format*")
2224   (erase-buffer)
2225   (lisp-interaction-mode)
2226   (insert (pp-to-string (symbol-value (intern (format "%s-spec" var))))))
2227
2228
2229 (defun gnus-update-format-specifications (&optional force)
2230   (gnus-make-thread-indent-array)
2231
2232   (when force
2233     (setq gnus-old-specs nil))
2234
2235   (let ((formats '(summary summary-dummy group 
2236                            summary-mode group-mode article-mode))
2237         old-format new-format)
2238     (while formats
2239       (setq new-format (symbol-value
2240                         (intern (format "gnus-%s-line-format" (car formats)))))
2241       (or (and (setq old-format (cdr (assq (car formats) gnus-old-specs)))
2242                (equal old-format new-format))
2243           (set (intern (format "gnus-%s-line-format-spec" (car formats)))
2244                (if (not (stringp new-format)) new-format
2245                  (gnus-parse-format
2246                   new-format
2247                   (symbol-value 
2248                    (intern (format "gnus-%s-line-format-alist"
2249                                    (if (eq (car formats) 'article-mode)
2250                                        'summary-mode (car formats)))))
2251                   (not (string-match "mode$" (symbol-name (car formats))))))))
2252       (setq gnus-old-specs (cons (cons (car formats) new-format)
2253                                  (delq (assq (car formats) gnus-old-specs)
2254                                        gnus-old-specs)))
2255       (setq formats (cdr formats))))
2256       
2257   (gnus-update-group-mark-positions)
2258   (gnus-update-summary-mark-positions)
2259
2260   (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
2261            (not gnus-description-hashtb)
2262            gnus-read-active-file)
2263       (gnus-read-all-descriptions-files)))
2264
2265 (defun gnus-update-summary-mark-positions ()
2266   (save-excursion
2267     (let ((gnus-replied-mark 129)
2268           (gnus-score-below-mark 130)
2269           (gnus-score-over-mark 130)
2270           (thread nil)
2271           (gnus-visual nil)
2272           pos)
2273       (gnus-set-work-buffer)
2274       (gnus-summary-insert-line 
2275        [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2276       (goto-char (point-min))
2277       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2278                                          (- (point) 2)))))
2279       (goto-char (point-min))
2280       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
2281                                           (- (point) 2))) pos))
2282       (goto-char (point-min))
2283       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
2284                                         (- (point) 2))) pos))
2285       (setq gnus-summary-mark-positions pos))))
2286
2287 (defun gnus-update-group-mark-positions ()
2288   (save-excursion
2289     (let ((gnus-process-mark 128)
2290           (gnus-group-marked '("dummy.group")))
2291       (gnus-set-active "dummy.group" '(0 . 0))
2292       (gnus-set-work-buffer)
2293       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2294       (goto-char (point-min))
2295       (setq gnus-group-mark-positions
2296             (list (cons 'process (and (search-forward "\200" nil t)
2297                                       (- (point) 2))))))))
2298
2299 (defvar gnus-mouse-face-0 'highlight)
2300 (defvar gnus-mouse-face-1 'highlight)
2301 (defvar gnus-mouse-face-2 'highlight)
2302 (defvar gnus-mouse-face-3 'highlight)
2303 (defvar gnus-mouse-face-4 'highlight)
2304
2305 (defun gnus-mouse-face-function (form type)
2306   `(put-text-property
2307     (point) (progn ,@form (point))
2308     gnus-mouse-face-prop 
2309     ,(if (equal type 0)
2310          'gnus-mouse-face
2311        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2312
2313 (defvar gnus-face-0 'bold)
2314 (defvar gnus-face-1 'italic)
2315 (defvar gnus-face-2 'bold-italic)
2316 (defvar gnus-face-3 'bold)
2317 (defvar gnus-face-4 'bold)
2318
2319 (defun gnus-face-face-function (form type)
2320   `(put-text-property
2321     (point) (progn ,@form (point))
2322     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2323
2324 (defun gnus-max-width-function (el max-width)
2325   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2326   (if (symbolp el)
2327       `(if (> (length ,el) ,max-width)
2328            (substring ,el 0 ,max-width)
2329          ,el)
2330     `(let ((val (eval ,el)))
2331        (if (numberp val)
2332            (setq val (int-to-string val)))
2333        (if (> (length val) ,max-width)
2334            (substring val 0 ,max-width))
2335        val)))
2336
2337 (defun gnus-parse-format (format spec-alist &optional insert)
2338   ;; This function parses the FORMAT string with the help of the
2339   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2340   ;; string.  If the FORMAT string contains the specifiers %( and %)
2341   ;; the text between them will have the mouse-face text property.
2342   (if (string-match 
2343        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2344        format)
2345       (gnus-parse-complex-format format spec-alist)
2346     ;; This is a simple format.
2347     (gnus-parse-simple-format format spec-alist insert)))
2348
2349 (defun gnus-parse-complex-format (format spec-alist)
2350   (save-excursion
2351     (gnus-set-work-buffer)
2352     (insert format)
2353     (goto-char (point-min))
2354     (while (re-search-forward "\"" nil t)
2355       (replace-match "\\\"" nil t))
2356     (goto-char (point-min))
2357     (insert "(\"")
2358     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2359       (let ((number (if (match-beginning 1)
2360                         (match-string 1) "0"))
2361             (delim (aref (match-string 2) 0)))
2362         (if (or (= delim ?\() (= delim ?\{))
2363             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2364                                    " " number " \""))
2365           (replace-match "\")\""))))
2366     (goto-char (point-max))
2367     (insert "\")")
2368     (goto-char (point-min))
2369     (let ((form (read (current-buffer))))
2370       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2371
2372 (defun gnus-complex-form-to-spec (form spec-alist)
2373   (delq nil
2374         (mapcar
2375          (lambda (sform)
2376            (if (stringp sform)
2377                (gnus-parse-simple-format sform spec-alist t)
2378              (funcall (intern (format "gnus-%s-face-function"
2379                                       (car sform)))
2380                       (gnus-complex-form-to-spec 
2381                        (cdr (cdr sform)) spec-alist)
2382                       (nth 1 sform))))
2383          form)))
2384     
2385 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2386   ;; This function parses the FORMAT string with the help of the
2387   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2388   ;; string.  
2389   (let ((max-width 0)
2390         spec flist fstring newspec elem beg result dontinsert)
2391     (save-excursion
2392       (gnus-set-work-buffer)
2393       (insert format)
2394       (goto-char (point-min))
2395       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2396                                 nil t)
2397         (if (= (setq spec (string-to-char (match-string 2))) ?%)
2398               (setq newspec "%"
2399                     beg (1+ (match-beginning 0)))
2400           ;; First check if there are any specs that look anything like
2401           ;; "%12,12A", ie. with a "max width specification".  These have
2402           ;; to be treated specially.
2403           (if (setq beg (match-beginning 1))
2404               (setq max-width 
2405                     (string-to-int 
2406                      (buffer-substring 
2407                       (1+ (match-beginning 1)) (match-end 1))))
2408             (setq max-width 0)
2409             (setq beg (match-beginning 2)))
2410           ;; Find the specification from `spec-alist'.
2411           (unless (setq elem (cdr (assq spec spec-alist)))
2412             (setq elem '("*" ?s)))
2413           ;; Treat user defined format specifiers specially.
2414           (when (eq (car elem) 'gnus-tmp-user-defined)
2415             (setq elem
2416                   (list 
2417                    (list (intern (concat "gnus-user-format-function-"
2418                                          (match-string 3)))
2419                          'gnus-tmp-header) ?s))
2420             (delete-region (match-beginning 3) (match-end 3)))
2421           (if (not (zerop max-width))
2422               (let ((el (car elem)))
2423                 (cond ((= (car (cdr elem)) ?c) 
2424                        (setq el (list 'char-to-string el)))
2425                       ((= (car (cdr elem)) ?d)
2426                        (numberp el) (setq el (list 'int-to-string el))))
2427                 (setq flist (cons (gnus-max-width-function el max-width)
2428                                   flist))
2429                 (setq newspec ?s))
2430             (setq flist (cons (car elem) flist)))
2431           (setq newspec (car (cdr elem))))
2432         ;; Remove the old specification (and possibly a ",12" string).
2433         (delete-region beg (match-end 2))
2434         ;; Insert the new specification.
2435         (goto-char beg)
2436         (insert newspec))
2437       (setq fstring (buffer-substring 1 (point-max))))
2438     ;; Do some postprocessing to increase efficiency.
2439     (setq 
2440      result
2441      (cond 
2442       ;; Emptyness.
2443       ((string= fstring "")
2444        nil)
2445       ;; Not a format string.
2446       ((not (string-match "%" fstring))
2447        (list fstring))
2448       ;; A format string with just a single string spec.
2449       ((string= fstring "%s")
2450        (list (car flist)))
2451       ;; A single character.
2452       ((string= fstring "%c")
2453        (list (car flist)))
2454       ;; A single number.
2455       ((string= fstring "%d")
2456        (setq dontinsert)
2457        (if insert
2458            (list `(princ ,(car flist)))
2459          (list `(int-to-string ,(car flist)))))
2460       ;; Just lots of chars and strings.
2461       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2462        (nreverse flist))
2463       ;; A single string spec at the beginning of the spec.
2464       ((string-match "\\`%[sc][^%]+\\'" fstring)
2465        (list (car flist) (substring fstring 2)))
2466       ;; A single string spec in the middle of the spec.
2467       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2468        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2469       ;; A single string spec in the end of the spec.
2470       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2471        (list (match-string 1 fstring) (car flist)))
2472       ;; A more complex spec.
2473       (t
2474        (list (cons 'format (cons fstring (nreverse flist)))))))
2475
2476     (if insert
2477         (when result
2478           (if dontinsert
2479               result
2480             (cons 'insert result)))
2481       (or (car result) ""))))
2482
2483 (defun gnus-eval-format (format &optional alist props)
2484   "Eval the format variable FORMAT, using ALIST.
2485 If INSERT, insert the result."
2486   (let ((form (gnus-parse-format format alist props)))
2487     (if props
2488         (add-text-properties (point) (progn (eval form) (point)) props)
2489       (eval form))))
2490
2491 (defun gnus-remove-text-with-property (prop)
2492   "Delete all text in the current buffer with text property PROP."
2493   (save-excursion
2494     (goto-char (point-min))
2495     (while (not (eobp))
2496       (when (get-text-property (point) prop)
2497         (delete-char 1))
2498       (goto-char (next-single-property-change (point) prop nil (point-max))))))
2499
2500 (defun gnus-set-work-buffer ()
2501   (if (get-buffer gnus-work-buffer)
2502       (progn
2503         (set-buffer gnus-work-buffer)
2504         (erase-buffer))
2505     (set-buffer (get-buffer-create gnus-work-buffer))
2506     (kill-all-local-variables)
2507     (buffer-disable-undo (current-buffer))
2508     (gnus-add-current-to-buffer-list)))
2509
2510 ;; Article file names when saving.
2511
2512 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2513   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2514 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2515 Otherwise, it is like ~/News/news/group/num."
2516   (let ((default
2517           (expand-file-name
2518            (concat (if (gnus-use-long-file-name 'not-save)
2519                        (gnus-capitalize-newsgroup newsgroup)
2520                      (gnus-newsgroup-directory-form newsgroup))
2521                    "/" (int-to-string (mail-header-number headers)))
2522            (or gnus-article-save-directory "~/News"))))
2523     (if (and last-file
2524              (string-equal (file-name-directory default)
2525                            (file-name-directory last-file))
2526              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2527         default
2528       (or last-file default))))
2529
2530 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2531   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2532 If variable `gnus-use-long-file-name' is non-nil, it is
2533 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2534   (let ((default
2535           (expand-file-name
2536            (concat (if (gnus-use-long-file-name 'not-save)
2537                        newsgroup
2538                      (gnus-newsgroup-directory-form newsgroup))
2539                    "/" (int-to-string (mail-header-number headers)))
2540            (or gnus-article-save-directory "~/News"))))
2541     (if (and last-file
2542              (string-equal (file-name-directory default)
2543                            (file-name-directory last-file))
2544              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2545         default
2546       (or last-file default))))
2547
2548 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2549   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2550 If variable `gnus-use-long-file-name' is non-nil, it is
2551 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2552   (or last-file
2553       (expand-file-name
2554        (if (gnus-use-long-file-name 'not-save)
2555            (gnus-capitalize-newsgroup newsgroup)
2556          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2557        (or gnus-article-save-directory "~/News"))))
2558
2559 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2560   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2561 If variable `gnus-use-long-file-name' is non-nil, it is
2562 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2563   (or last-file
2564       (expand-file-name
2565        (if (gnus-use-long-file-name 'not-save)
2566            newsgroup
2567          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2568        (or gnus-article-save-directory "~/News"))))
2569
2570 ;; For subscribing new newsgroup
2571
2572 (defun gnus-subscribe-hierarchical-interactive (groups)
2573   (let ((groups (sort groups 'string<))
2574         prefixes prefix start ans group starts)
2575     (while groups
2576       (setq prefixes (list "^"))
2577       (while (and groups prefixes)
2578         (while (not (string-match (car prefixes) (car groups)))
2579           (setq prefixes (cdr prefixes)))
2580         (setq prefix (car prefixes))
2581         (setq start (1- (length prefix)))
2582         (if (and (string-match "[^\\.]\\." (car groups) start)
2583                  (cdr groups)
2584                  (setq prefix 
2585                        (concat "^" (substring (car groups) 0 (match-end 0))))
2586                  (string-match prefix (car (cdr groups))))
2587             (progn
2588               (setq prefixes (cons prefix prefixes))
2589               (message "Descend hierarchy %s? ([y]nsq): " 
2590                        (substring prefix 1 (1- (length prefix))))
2591               (setq ans (read-char))
2592               (cond ((= ans ?n)
2593                      (while (and groups 
2594                                  (string-match prefix 
2595                                                (setq group (car groups))))
2596                        (setq gnus-killed-list 
2597                              (cons group gnus-killed-list))
2598                        (gnus-sethash group group gnus-killed-hashtb)
2599                        (setq groups (cdr groups)))
2600                      (setq starts (cdr starts)))
2601                     ((= ans ?s)
2602                      (while (and groups 
2603                                  (string-match prefix 
2604                                                (setq group (car groups))))
2605                        (gnus-sethash group group gnus-killed-hashtb)
2606                        (gnus-subscribe-alphabetically (car groups))
2607                        (setq groups (cdr groups)))
2608                      (setq starts (cdr starts)))
2609                     ((= ans ?q)
2610                      (while groups
2611                        (setq group (car groups))
2612                        (setq gnus-killed-list (cons group gnus-killed-list))
2613                        (gnus-sethash group group gnus-killed-hashtb)
2614                        (setq groups (cdr groups))))
2615                     (t nil)))
2616           (message "Subscribe %s? ([n]yq)" (car groups))
2617           (setq ans (read-char))
2618           (setq group (car groups))
2619           (cond ((= ans ?y)
2620                  (gnus-subscribe-alphabetically (car groups))
2621                  (gnus-sethash group group gnus-killed-hashtb))
2622                 ((= ans ?q)
2623                  (while groups
2624                    (setq group (car groups))
2625                    (setq gnus-killed-list (cons group gnus-killed-list))
2626                    (gnus-sethash group group gnus-killed-hashtb)
2627                    (setq groups (cdr groups))))
2628                 (t 
2629                  (setq gnus-killed-list (cons group gnus-killed-list))
2630                  (gnus-sethash group group gnus-killed-hashtb)))
2631           (setq groups (cdr groups)))))))
2632
2633 (defun gnus-subscribe-randomly (newsgroup)
2634   "Subscribe new NEWSGROUP by making it the first newsgroup."
2635   (gnus-subscribe-newsgroup newsgroup))
2636
2637 (defun gnus-subscribe-alphabetically (newgroup)
2638   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2639   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2640   (let ((groups (cdr gnus-newsrc-alist))
2641         before)
2642     (while (and (not before) groups)
2643       (if (string< newgroup (car (car groups)))
2644           (setq before (car (car groups)))
2645         (setq groups (cdr groups))))
2646     (gnus-subscribe-newsgroup newgroup before)))
2647
2648 (defun gnus-subscribe-hierarchically (newgroup)
2649   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2650   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2651   (save-excursion
2652     (set-buffer (find-file-noselect gnus-current-startup-file))
2653     (let ((groupkey newgroup)
2654           before)
2655       (while (and (not before) groupkey)
2656         (goto-char (point-min))
2657         (let ((groupkey-re
2658                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2659           (while (and (re-search-forward groupkey-re nil t)
2660                       (progn
2661                         (setq before (match-string 1))
2662                         (string< before newgroup)))))
2663         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2664         (setq groupkey
2665               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2666                   (substring groupkey (match-beginning 1) (match-end 1)))))
2667       (gnus-subscribe-newsgroup newgroup before))))
2668
2669 (defun gnus-subscribe-interactively (group)
2670   "Subscribe the new GROUP interactively.
2671 It is inserted in hierarchical newsgroup order if subscribed.  If not,
2672 it is killed."
2673   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
2674       (gnus-subscribe-hierarchically group)
2675     (push group gnus-killed-list)))
2676
2677 (defun gnus-subscribe-zombies (group)
2678   "Make the new GROUP into a zombie group."
2679   (push group gnus-zombie-list))
2680
2681 (defun gnus-subscribe-killed (group)
2682   "Make the new GROUP a killed group."
2683   (push group gnus-killed-list))
2684
2685 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2686   "Subscribe new NEWSGROUP.
2687 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
2688 the first newsgroup."
2689   ;; We subscribe the group by changing its level to `subscribed'.
2690   (gnus-group-change-level 
2691    newsgroup gnus-level-default-subscribed
2692    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2693   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2694
2695 ;; For directories
2696
2697 (defun gnus-newsgroup-directory-form (newsgroup)
2698   "Make hierarchical directory name from NEWSGROUP name."
2699   (let ((newsgroup (gnus-newsgroup-saveable-name newsgroup))
2700         (len (length newsgroup))
2701         idx)
2702     ;; If this is a foreign group, we don't want to translate the
2703     ;; entire name.  
2704     (if (setq idx (string-match ":" newsgroup))
2705         (aset newsgroup idx ?/)
2706       (setq idx 0))
2707     ;; Replace all occurrences of `.' with `/'.
2708     (while (< idx len)
2709       (if (= (aref newsgroup idx) ?.)
2710           (aset newsgroup idx ?/))
2711       (setq idx (1+ idx)))
2712     newsgroup))
2713
2714 (defun gnus-newsgroup-saveable-name (group)
2715   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2716   ;; with dots.
2717   (gnus-replace-chars-in-string group ?/ ?.))
2718
2719 (defun gnus-make-directory (dir)
2720   "Make DIRECTORY recursively."
2721   ;; Why don't we use `(make-directory dir 'parents)'? That's just one
2722   ;; of the many mysteries of the universe.
2723   (let* ((dir (expand-file-name dir default-directory))
2724          dirs err)
2725     (if (string-match "/$" dir)
2726         (setq dir (substring dir 0 (match-beginning 0))))
2727     ;; First go down the path until we find a directory that exists.
2728     (while (not (file-exists-p dir))
2729       (setq dirs (cons dir dirs))
2730       (string-match "/[^/]+$" dir)
2731       (setq dir (substring dir 0 (match-beginning 0))))
2732     ;; Then create all the subdirs.
2733     (while (and dirs (not err))
2734       (condition-case ()
2735           (make-directory (car dirs))
2736         (error (setq err t)))
2737       (setq dirs (cdr dirs)))
2738     ;; We return whether we were successful or not. 
2739     (not dirs)))
2740
2741 (defun gnus-capitalize-newsgroup (newsgroup)
2742   "Capitalize NEWSGROUP name."
2743   (and (not (zerop (length newsgroup)))
2744        (concat (char-to-string (upcase (aref newsgroup 0)))
2745                (substring newsgroup 1))))
2746
2747 ;; Var
2748
2749 (defun gnus-simplify-subject (subject &optional re-only)
2750   "Remove `Re:' and words in parentheses.
2751 If optional argument RE-ONLY is non-nil, strip `Re:' only."
2752   (let ((case-fold-search t))           ;Ignore case.
2753     ;; Remove `Re:' and `Re^N:'.
2754     (if (string-match "^re:[ \t]*" subject)
2755         (setq subject (substring subject (match-end 0))))
2756     ;; Remove words in parentheses from end.
2757     (or re-only
2758         (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2759           (setq subject (substring subject 0 (match-beginning 0)))))
2760     ;; Return subject string.
2761     subject))
2762
2763 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2764 ;; all whitespace.
2765 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2766 (defun gnus-simplify-buffer-fuzzy ()
2767   (goto-char (point-min))
2768   (while (or
2769           (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
2770           (looking-at "^[[].*:[ \t].*[]]$"))
2771     (goto-char (point-min))
2772     (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2773                               nil t)
2774       (replace-match "" t t))
2775     (goto-char (point-min))
2776     (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
2777       (goto-char (match-end 0))
2778       (delete-char -1)
2779       (delete-region 
2780        (progn (goto-char (match-beginning 0)))
2781        (re-search-forward ":"))))
2782   (goto-char (point-min))
2783   (while (re-search-forward "[ \t\n]*([^()]*)[ \t]*$" nil t)
2784     (replace-match "" t t))
2785   (goto-char (point-min))
2786   (while (re-search-forward "[ \t]+" nil t)
2787     (replace-match " " t t))
2788   (goto-char (point-min))
2789   (while (re-search-forward "[ \t]+$" nil t)
2790     (replace-match "" t t))
2791   (goto-char (point-min))
2792   (while (re-search-forward "^[ \t]+" nil t)
2793     (replace-match "" t t))
2794   (goto-char (point-min))
2795   (if gnus-simplify-subject-fuzzy-regexp
2796       (if (listp gnus-simplify-subject-fuzzy-regexp)
2797           (let ((list gnus-simplify-subject-fuzzy-regexp))
2798             (while list
2799               (goto-char (point-min))
2800               (while (re-search-forward (car list) nil t)
2801                 (replace-match "" t t))
2802               (setq list (cdr list))))
2803         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
2804           (replace-match "" t t)))))
2805
2806 (defun gnus-simplify-subject-fuzzy (subject)
2807   "Siplify a subject string fuzzily."
2808   (let ((case-fold-search t))
2809     (save-excursion
2810       (gnus-set-work-buffer)
2811       (insert subject)
2812       (inline (gnus-simplify-buffer-fuzzy))
2813       (buffer-string))))
2814
2815 ;; Add the current buffer to the list of buffers to be killed on exit. 
2816 (defun gnus-add-current-to-buffer-list ()
2817   (or (memq (current-buffer) gnus-buffer-list)
2818       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
2819
2820 (defun gnus-string> (s1 s2)
2821   (not (or (string< s1 s2)
2822            (string= s1 s2))))
2823
2824 ;; Functions accessing headers.
2825 ;; Functions are more convenient than macros in some cases.
2826
2827 (defun gnus-header-number (header)
2828   (mail-header-number header))
2829
2830 (defun gnus-header-subject (header)
2831   (mail-header-subject header))
2832
2833 (defun gnus-header-from (header)
2834   (mail-header-from header))
2835
2836 (defun gnus-header-xref (header)
2837   (mail-header-xref header))
2838
2839 (defun gnus-header-lines (header)
2840   (mail-header-lines header))
2841
2842 (defun gnus-header-date (header)
2843   (mail-header-date header))
2844
2845 (defun gnus-header-id (header)
2846   (mail-header-id header))
2847
2848 (defun gnus-header-message-id (header)
2849   (mail-header-id header))
2850
2851 (defun gnus-header-chars (header)
2852   (mail-header-chars header))
2853
2854 (defun gnus-header-references (header)
2855   (mail-header-references header))
2856
2857 ;;; General various misc type functions.
2858
2859 (defun gnus-clear-system ()
2860   "Clear all variables and buffers."
2861   ;; Clear Gnus variables.
2862   (let ((variables gnus-variable-list))
2863     (while variables
2864       (set (car variables) nil)
2865       (setq variables (cdr variables))))
2866   ;; Clear other internal variables.
2867   (setq gnus-list-of-killed-groups nil
2868         gnus-have-read-active-file nil
2869         gnus-newsrc-alist nil
2870         gnus-newsrc-hashtb nil
2871         gnus-killed-list nil
2872         gnus-zombie-list nil
2873         gnus-killed-hashtb nil
2874         gnus-active-hashtb nil
2875         gnus-moderated-list nil
2876         gnus-description-hashtb nil
2877         gnus-newsgroup-headers nil
2878         gnus-newsgroup-name nil
2879         gnus-server-alist nil
2880         gnus-opened-servers nil
2881         gnus-current-select-method nil)
2882   ;; Reset any score variables.
2883   (and gnus-use-scoring (gnus-score-close))
2884   ;; Kill the startup file.
2885   (and gnus-current-startup-file
2886        (get-file-buffer gnus-current-startup-file)
2887        (kill-buffer (get-file-buffer gnus-current-startup-file)))
2888   ;; Save any cache buffers.
2889   (and gnus-use-cache (gnus-cache-save-buffers))
2890   ;; Clear the dribble buffer.
2891   (gnus-dribble-clear)
2892   ;; Close down NoCeM.
2893   (and gnus-use-nocem (gnus-nocem-close))
2894   ;; Shut down the demons.
2895   (and gnus-use-demon (gnus-demon-cancel))
2896   ;; Kill global KILL file buffer.
2897   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
2898       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
2899   (gnus-kill-buffer nntp-server-buffer)
2900   ;; Backlog.
2901   (and gnus-keep-backlog (gnus-backlog-shutdown))
2902   ;; Kill Gnus buffers.
2903   (while gnus-buffer-list
2904     (gnus-kill-buffer (car gnus-buffer-list))
2905     (setq gnus-buffer-list (cdr gnus-buffer-list))))
2906
2907 (defun gnus-windows-old-to-new (setting)
2908   ;; First we take care of the really, really old Gnus 3 actions.
2909   (if (symbolp setting)
2910       (setq setting 
2911             (cond ((memq setting '(SelectArticle))
2912                    'article)
2913                   ((memq setting '(SelectSubject ExpandSubject))
2914                    'summary)
2915                   ((memq setting '(SelectNewsgroup ExitNewsgroup))
2916                    'group)
2917                   (t setting))))
2918   (if (or (listp setting)
2919           (not (and gnus-window-configuration
2920                     (memq setting '(group summary article)))))
2921       setting
2922     (let* ((setting (if (eq setting 'group) 
2923                         (if (assq 'newsgroup gnus-window-configuration)
2924                             'newsgroup
2925                           'newsgroups) setting))
2926            (elem (car (cdr (assq setting gnus-window-configuration))))
2927            (total (apply '+ elem))
2928            (types '(group summary article))
2929            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
2930            (i 0)
2931            perc
2932            out)
2933       (while (< i 3)
2934         (or (not (numberp (nth i elem)))
2935             (zerop (nth i elem))
2936             (progn
2937               (setq perc  (/ (* 1.0 (nth 0 elem)) total))
2938               (setq out (cons (if (eq pbuf (nth i types))
2939                                   (vector (nth i types) perc 'point)
2940                                 (vector (nth i types) perc))
2941                               out))))
2942         (setq i (1+ i)))
2943       (list (nreverse out)))))
2944            
2945 (defun gnus-add-configuration (conf)
2946   (setq gnus-buffer-configuration 
2947         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
2948                          gnus-buffer-configuration))))
2949
2950 (defun gnus-configure-windows (setting &optional force)
2951   (setq setting (gnus-windows-old-to-new setting))
2952   (let ((r (if (symbolp setting)
2953                (cdr (assq setting gnus-buffer-configuration))
2954              setting))
2955         (in-buf (current-buffer))
2956         rule val w height hor ohor heights sub jump-buffer
2957         rel total to-buf all-visible)
2958     (or r (error "No such setting: %s" setting))
2959
2960     (if (and (not force) (setq all-visible (gnus-all-windows-visible-p r)))
2961         ;; All the windows mentioned are already visible, so we just
2962         ;; put point in the assigned buffer, and do not touch the
2963         ;; winconf. 
2964         (select-window (get-buffer-window all-visible t))
2965          
2966
2967       ;; Either remove all windows or just remove all Gnus windows.
2968       (if gnus-use-full-window
2969           (delete-other-windows)
2970         (gnus-remove-some-windows)
2971         (switch-to-buffer nntp-server-buffer))
2972
2973       (while r
2974         (setq hor (car r)
2975               ohor nil)
2976
2977         ;; We have to do the (possible) horizontal splitting before the
2978         ;; vertical. 
2979         (if (and (listp (car hor)) 
2980                  (eq (car (car hor)) 'horizontal))
2981             (progn
2982               (split-window 
2983                nil
2984                (if (integerp (nth 1 (car hor)))
2985                    (nth 1 (car hor))
2986                  (- (frame-width) (floor (* (frame-width) (nth 1 (car hor))))))
2987                t)
2988               (setq hor (cdr hor))))
2989
2990         ;; Go through the rules and eval the elements that are to be
2991         ;; evaled.  
2992         (while hor
2993           (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor))))
2994               (progn
2995                 ;; Expand short buffer name.
2996                 (setq w (aref val 0))
2997                 (and (setq w (cdr (assq w gnus-window-to-buffer)))
2998                      (progn
2999                        (setq val (apply 'vector (mapcar 'identity val)))
3000                        (aset val 0 w)))
3001                 (setq ohor (cons val ohor))))
3002           (setq hor (cdr hor)))
3003         (setq rule (cons (nreverse ohor) rule))
3004         (setq r (cdr r)))
3005       (setq rule (nreverse rule))
3006
3007       ;; We tally the window sizes.
3008       (setq total (window-height))
3009       (while rule
3010         (setq hor (car rule))
3011         (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal))
3012             (setq hor (cdr hor)))
3013         (setq sub 0)
3014         (while hor
3015           (setq rel (aref (car hor) 1)
3016                 heights (cons
3017                          (cond ((and (floatp rel) (= 1.0 rel))
3018                                 'x)
3019                                ((integerp rel)
3020                                 rel)
3021                                (t
3022                                 (max (floor (* total rel)) 4)))
3023                          heights)
3024                 sub (+ sub (if (numberp (car heights)) (car heights) 0))
3025                 hor (cdr hor)))
3026         (setq heights (nreverse heights)
3027               hor (car rule))
3028
3029         ;; We then go through these heighs and create windows for them.
3030         (while heights
3031           (setq height (car heights)
3032                 heights (cdr heights))
3033           (and (eq height 'x)
3034                (setq height (- total sub)))
3035           (and heights
3036                (split-window nil height))
3037           (setq to-buf (aref (car hor) 0))
3038           (switch-to-buffer 
3039            (cond ((not to-buf)
3040                   in-buf)
3041                  ((symbolp to-buf)
3042                   (symbol-value (aref (car hor) 0)))
3043                  (t
3044                   (aref (car hor) 0))))
3045           (and (> (length (car hor)) 2)
3046                (eq (aref (car hor) 2) 'point)
3047                (setq jump-buffer (current-buffer)))
3048           (other-window 1)
3049           (setq hor (cdr hor)))
3050       
3051         (setq rule (cdr rule)))
3052
3053       ;; Finally, we pop to the buffer that's supposed to have point. 
3054       (or jump-buffer (error "Missing `point' in spec for %s" setting))
3055
3056       (select-window (get-buffer-window jump-buffer t))
3057       (set-buffer jump-buffer))))
3058
3059 (defun gnus-all-windows-visible-p (rule)
3060   (let (invisible hor jump-buffer val buffer)
3061     ;; Go through the rules and eval the elements that are to be
3062     ;; evaled.  
3063     (while (and rule (not invisible))
3064       (setq hor (car rule)
3065             rule (cdr rule))
3066       (while (and hor (not invisible))
3067         (if (setq val (if (vectorp (car hor)) 
3068                           (car hor)
3069                         (if (not (eq (car (car hor)) 'horizontal))
3070                             (eval (car hor)))))
3071             (progn
3072               ;; Expand short buffer name.
3073               (setq buffer (or (cdr (assq (aref val 0) gnus-window-to-buffer))
3074                                (aref val 0)))
3075               (setq buffer (if (symbolp buffer) (symbol-value buffer)
3076                              buffer))
3077               (and (> (length val) 2) (eq 'point (aref val 2))
3078                    (setq jump-buffer buffer))
3079               (setq invisible (not (and buffer (get-buffer-window buffer))))))
3080         (setq hor (cdr hor))))
3081     (and (not invisible) jump-buffer)))
3082
3083 (defun gnus-window-top-edge (&optional window)
3084   (nth 1 (window-edges window)))
3085
3086 (defun gnus-remove-some-windows ()
3087   (let ((buffers gnus-window-to-buffer)
3088         buf bufs lowest-buf lowest)
3089     (save-excursion
3090       ;; Remove windows on all known Gnus buffers.
3091       (while buffers
3092         (setq buf (cdr (car buffers)))
3093         (if (symbolp buf)
3094             (setq buf (and (boundp buf) (symbol-value buf))))
3095         (and buf 
3096              (get-buffer-window buf)
3097              (progn
3098                (setq bufs (cons buf bufs))
3099                (pop-to-buffer buf)
3100                (if (or (not lowest)
3101                        (< (gnus-window-top-edge) lowest))
3102                    (progn
3103                      (setq lowest (gnus-window-top-edge))
3104                      (setq lowest-buf buf)))))
3105         (setq buffers (cdr buffers)))
3106       ;; Remove windows on *all* summary buffers.
3107       (let (wins)
3108         (walk-windows
3109          (lambda (win)
3110            (let ((buf (window-buffer win)))
3111              (if (string-match  "^\\*Summary" (buffer-name buf))
3112                  (progn
3113                    (setq bufs (cons buf bufs))
3114                    (pop-to-buffer buf)
3115                    (if (or (not lowest)
3116                            (< (gnus-window-top-edge) lowest))
3117                        (progn
3118                          (setq lowest-buf buf)
3119                          (setq lowest (gnus-window-top-edge))))))))))
3120       (and lowest-buf 
3121            (progn
3122              (pop-to-buffer lowest-buf)
3123              (switch-to-buffer nntp-server-buffer)))
3124       (while bufs
3125         (and (not (eq (car bufs) lowest-buf))
3126              (delete-windows-on (car bufs)))
3127         (setq bufs (cdr bufs))))))
3128                           
3129 (defun gnus-version ()
3130   "Version numbers of this version of Gnus."
3131   (interactive)
3132   (let ((methods gnus-valid-select-methods)
3133         (mess gnus-version)
3134         meth)
3135     ;; Go through all the legal select methods and add their version
3136     ;; numbers to the total version string.  Only the backends that are
3137     ;; currently in use will have their message numbers taken into
3138     ;; consideration. 
3139     (while methods
3140       (setq meth (intern (concat (car (car methods)) "-version")))
3141       (and (boundp meth)
3142            (stringp (symbol-value meth))
3143            (setq mess (concat mess "; " (symbol-value meth))))
3144       (setq methods (cdr methods)))
3145     (gnus-message 2 mess)))
3146
3147 (defun gnus-info-find-node ()
3148   "Find Info documentation of Gnus."
3149   (interactive)
3150   ;; Enlarge info window if needed.
3151   (let ((mode major-mode))
3152     (gnus-configure-windows 'info)
3153     (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))))
3154
3155 (defun gnus-replace-chars-in-string (string &rest pairs)
3156   "Replace characters in STRING from FROM to TO."
3157   (let ((string (substring string 0))   ;Copy string.
3158         (len (length string))
3159         (idx 0)
3160         sym to)
3161     (or (zerop (% (length pairs) 2)) 
3162         (error "Odd number of translation pairs"))
3163     (setplist 'sym pairs)
3164     ;; Replace all occurrences of FROM with TO.
3165     (while (< idx len)
3166       (if (setq to (get 'sym (aref string idx)))
3167           (aset string idx to))
3168       (setq idx (1+ idx)))
3169     string))
3170
3171 (defun gnus-days-between (date1 date2)
3172   ;; Return the number of days between date1 and date2.
3173   (- (gnus-day-number date1) (gnus-day-number date2)))
3174
3175 (defun gnus-day-number (date)
3176   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3177                      (timezone-parse-date date))))
3178     (timezone-absolute-from-gregorian 
3179      (nth 1 dat) (nth 2 dat) (car dat))))
3180
3181 ;; Returns a floating point number that says how many seconds have
3182 ;; lapsed between Jan 1 12:00:00 1970 and DATE.
3183 (defun gnus-seconds-since-epoch (date)
3184   (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
3185                         (timezone-parse-date date)))
3186          (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
3187                         (timezone-parse-time
3188                          (aref (timezone-parse-date date) 3))))
3189          (edate (mapcar (lambda (ti) (and ti (string-to-int ti)))
3190                         (timezone-parse-date "Jan 1 12:00:00 1970")))
3191          (tday (- (timezone-absolute-from-gregorian 
3192                    (nth 1 tdate) (nth 2 tdate) (nth 0 tdate))
3193                   (timezone-absolute-from-gregorian 
3194                    (nth 1 edate) (nth 2 edate) (nth 0 edate)))))
3195     (+ (nth 2 ttime)
3196        (* (nth 1 ttime) 60)
3197        (* 1.0 (nth 0 ttime) 60 60)
3198        (* 1.0 tday 60 60 24))))
3199
3200 (defun gnus-file-newer-than (file date)
3201   (let ((fdate (nth 5 (file-attributes file))))
3202     (or (> (car fdate) (car date))
3203         (and (= (car fdate) (car date))
3204              (> (nth 1 fdate) (nth 1 date))))))
3205
3206 (defun gnus-group-read-only-p (&optional group)
3207   "Check whether GROUP supports editing or not.
3208 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3209 that that variable is buffer-local to the summary buffers."
3210   (let ((group (or group gnus-newsgroup-name)))
3211     (not (gnus-check-backend-function 'request-replace-article group))))
3212
3213 (defun gnus-group-total-expirable-p (group)
3214   "Check whether GROUP is total-expirable or not."
3215   (let ((params (gnus-info-params (gnus-get-info group))))
3216     (or (memq 'total-expire params) 
3217         (cdr (assq 'total-expire params)) ; (total-expire . t)
3218         (and gnus-total-expirable-newsgroups ; Check var.
3219              (string-match gnus-total-expirable-newsgroups group)))))
3220
3221 (defun gnus-group-auto-expirable-p (group)
3222   "Check whether GROUP is total-expirable or not."
3223   (let ((params (gnus-info-params (gnus-get-info group))))
3224     (or (memq 'auto-expire params) 
3225         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3226         (and gnus-auto-expirable-newsgroups ; Check var.
3227              (string-match gnus-auto-expirable-newsgroups group)))))
3228
3229 (defun gnus-subject-equal (s1 s2)
3230   "Check whether two subjects are equal."
3231   (cond
3232    ((null gnus-summary-gather-subject-limit)
3233     (equal (gnus-simplify-subject-re s1)
3234            (gnus-simplify-subject-re s2)))
3235    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3236     (equal (gnus-simplify-subject-fuzzy s1)
3237            (gnus-simplify-subject-fuzzy s2)))
3238    ((numberp gnus-summary-gather-subject-limit)
3239     (equal (gnus-limit-string s1 gnus-summary-gather-subject-limit)
3240            (gnus-limit-string s2 gnus-summary-gather-subject-limit)))
3241    (t
3242     (equal s1 s2))))
3243
3244 ;; Returns a list of writable groups.
3245 (defun gnus-writable-groups ()
3246   (let ((alist gnus-newsrc-alist)
3247         groups)
3248     (while alist
3249       (or (gnus-group-read-only-p (car (car alist)))
3250           (setq groups (cons (car (car alist)) groups)))
3251       (setq alist (cdr alist)))
3252     (nreverse groups)))
3253
3254 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3255 ;; the echo area.
3256 (defun gnus-y-or-n-p (prompt)
3257   (prog1
3258       (y-or-n-p prompt)
3259     (message "")))
3260
3261 (defun gnus-yes-or-no-p (prompt)
3262   (prog1
3263       (yes-or-no-p prompt)
3264     (message "")))
3265
3266 ;; Check whether to use long file names.
3267 (defun gnus-use-long-file-name (symbol)
3268   ;; The variable has to be set...
3269   (and gnus-use-long-file-name
3270        ;; If it isn't a list, then we return t.
3271        (or (not (listp gnus-use-long-file-name))
3272            ;; If it is a list, and the list contains `symbol', we
3273            ;; return nil.  
3274            (not (memq symbol gnus-use-long-file-name)))))
3275
3276 ;; I suspect there's a better way, but I haven't taken the time to do
3277 ;; it yet. -erik selberg@cs.washington.edu
3278 (defun gnus-dd-mmm (messy-date)
3279   "Return a string like DD-MMM from a big messy string"
3280   (let ((datevec (timezone-parse-date messy-date)))
3281     (format "%2s-%s"
3282             (or (aref datevec 2) "??")
3283             (capitalize
3284              (or (car 
3285                   (nth (1- (string-to-number (aref datevec 1)))
3286                        timezone-months-assoc))
3287                  "???")))))
3288
3289 ;; Make a hash table (default and minimum size is 255).
3290 ;; Optional argument HASHSIZE specifies the table size.
3291 (defun gnus-make-hashtable (&optional hashsize)
3292   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3293
3294 ;; Make a number that is suitable for hashing; bigger than MIN and one
3295 ;; less than 2^x.
3296 (defun gnus-create-hash-size (min)
3297   (let ((i 1))
3298     (while (< i min)
3299       (setq i (* 2 i)))
3300     (1- i)))
3301
3302 ;; Show message if message has a lower level than `gnus-verbose'. 
3303 ;; Guide-line for numbers:
3304 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3305 ;; for things that take a long time, 7 - not very important messages
3306 ;; on stuff, 9 - messages inside loops.
3307 (defun gnus-message (level &rest args)
3308   (if (<= level gnus-verbose)
3309       (apply 'message args)
3310     ;; We have to do this format thingie here even if the result isn't
3311     ;; shown - the return value has to be the same as the return value
3312     ;; from `message'.
3313     (apply 'format args)))
3314
3315 (defun gnus-functionp (form)
3316   "Return non-nil if FORM is funcallable."
3317   (or (and (symbolp form) (fboundp form))
3318       (and (listp form) (eq (car form) 'lambda))))
3319
3320 ;; Generate a unique new group name.
3321 (defun gnus-generate-new-group-name (leaf)
3322   (let ((name leaf)
3323         (num 0))
3324     (while (gnus-gethash name gnus-newsrc-hashtb)
3325       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3326     name))
3327
3328 ;; Find out whether the gnus-visual TYPE is wanted.
3329 (defun gnus-visual-p (&optional type class)
3330   (and gnus-visual                      ; Has to be non-nil, at least.
3331        (if (not type)                   ; We don't care about type.
3332            gnus-visual
3333          (if (listp gnus-visual)        ; It's a list, so we check it.
3334              (or (memq type gnus-visual)
3335                  (memq class gnus-visual))
3336            t))))
3337
3338 (defun gnus-parent-id (references)
3339   "Return the last Message-ID in REFERENCES."
3340   (and references
3341        (string-match "\\(<[^<>]+>\\) *$" references)
3342        (substring references (match-beginning 1) (match-end 1))))
3343
3344 (defun gnus-ephemeral-group-p (group)
3345   "Say whether GROUP is ephemeral or not."
3346   (assoc 'quit-config (gnus-find-method-for-group group)))
3347
3348 (defun gnus-group-quit-config (group)
3349   "Return the quit-config of GROUP."
3350   (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
3351
3352 (defun gnus-simplify-mode-line ()
3353   "Make mode lines a bit simpler."
3354   (setq mode-line-modified "-- ")
3355   (when (listp mode-line-format)
3356     (make-local-variable 'mode-line-format)
3357     (setq mode-line-format (copy-sequence mode-line-format))
3358     (and (equal (nth 3 mode-line-format) "   ")
3359          (setcar (nthcdr 3 mode-line-format) ""))))
3360
3361 ;;; List and range functions
3362
3363 (defun gnus-last-element (list)
3364   "Return last element of LIST."
3365   (while (cdr list)
3366     (setq list (cdr list)))
3367   (car list))
3368
3369 (defun gnus-copy-sequence (list)
3370   "Do a complete, total copy of a list."
3371   (if (and (consp list) (not (consp (cdr list))))
3372       (cons (car list) (cdr list))
3373     (mapcar (lambda (elem) (if (consp elem) 
3374                                (if (consp (cdr elem))
3375                                    (gnus-copy-sequence elem)
3376                                  (cons (car elem) (cdr elem)))
3377                              elem))
3378             list)))
3379
3380 (defun gnus-set-difference (list1 list2)
3381   "Return a list of elements of LIST1 that do not appear in LIST2."
3382   (let ((list1 (copy-sequence list1)))
3383     (while list2
3384       (setq list1 (delq (car list2) list1))
3385       (setq list2 (cdr list2)))
3386     list1))
3387
3388 (defun gnus-sorted-complement (list1 list2)
3389   "Return a list of elements of LIST1 that do not appear in LIST2.
3390 Both lists have to be sorted over <."
3391   (let (out)
3392     (if (or (null list1) (null list2))
3393         (or list1 list2)
3394       (while (and list1 list2)
3395         (cond ((= (car list1) (car list2))
3396                (setq list1 (cdr list1)
3397                      list2 (cdr list2)))
3398               ((< (car list1) (car list2))
3399                (setq out (cons (car list1) out))
3400                (setq list1 (cdr list1)))
3401               (t
3402                (setq out (cons (car list2) out))
3403                (setq list2 (cdr list2)))))
3404       (nconc (nreverse out) (or list1 list2)))))
3405
3406 (defun gnus-intersection (list1 list2)      
3407   (let ((result nil))
3408     (while list2
3409       (if (memq (car list2) list1)
3410           (setq result (cons (car list2) result)))
3411       (setq list2 (cdr list2)))
3412     result))
3413
3414 (defun gnus-sorted-intersection (list1 list2)
3415   ;; LIST1 and LIST2 have to be sorted over <.
3416   (let (out)
3417     (while (and list1 list2)
3418       (cond ((= (car list1) (car list2))
3419              (setq out (cons (car list1) out)
3420                    list1 (cdr list1)
3421                    list2 (cdr list2)))
3422             ((< (car list1) (car list2))
3423              (setq list1 (cdr list1)))
3424             (t
3425              (setq list2 (cdr list2)))))
3426     (nreverse out)))
3427
3428 (defun gnus-set-sorted-intersection (list1 list2)
3429   ;; LIST1 and LIST2 have to be sorted over <.
3430   ;; This function modifies LIST1.
3431   (let* ((top (cons nil list1))
3432          (prev top))
3433     (while (and list1 list2)
3434       (cond ((= (car list1) (car list2))
3435              (setq prev list1
3436                    list1 (cdr list1)
3437                    list2 (cdr list2)))
3438             ((< (car list1) (car list2))
3439              (setcdr prev (cdr list1))
3440              (setq list1 (cdr list1)))
3441             (t
3442              (setq list2 (cdr list2)))))
3443     (setcdr prev nil)
3444     (cdr top)))
3445
3446 (defun gnus-compress-sequence (numbers &optional always-list)
3447   "Convert list of numbers to a list of ranges or a single range.
3448 If ALWAYS-LIST is non-nil, this function will always release a list of
3449 ranges."
3450   (let* ((first (car numbers))
3451          (last (car numbers))
3452          result)
3453     (if (null numbers)
3454         nil
3455       (if (not (listp (cdr numbers)))
3456           numbers
3457         (while numbers
3458           (cond ((= last (car numbers)) nil) ;Omit duplicated number
3459                 ((= (1+ last) (car numbers)) ;Still in sequence
3460                  (setq last (car numbers)))
3461                 (t                      ;End of one sequence
3462                  (setq result 
3463                        (cons (if (= first last) first
3464                                (cons first last)) result))
3465                  (setq first (car numbers))
3466                  (setq last  (car numbers))))
3467           (setq numbers (cdr numbers)))
3468         (if (and (not always-list) (null result))
3469             (if (= first last) (list first) (cons first last))
3470           (nreverse (cons (if (= first last) first (cons first last))
3471                           result)))))))
3472
3473 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3474 (defun gnus-uncompress-range (ranges)
3475   "Expand a list of ranges into a list of numbers.
3476 RANGES is either a single range on the form `(num . num)' or a list of
3477 these ranges."
3478   (let (first last result)
3479     (cond 
3480      ((null ranges)
3481       nil)
3482      ((not (listp (cdr ranges)))
3483       (setq first (car ranges))
3484       (setq last (cdr ranges))
3485       (while (<= first last)
3486         (setq result (cons first result))
3487         (setq first (1+ first)))
3488       (nreverse result))
3489      (t
3490       (while ranges
3491         (if (atom (car ranges))
3492             (if (numberp (car ranges))
3493                 (setq result (cons (car ranges) result)))
3494           (setq first (car (car ranges)))
3495           (setq last  (cdr (car ranges)))
3496           (while (<= first last)
3497             (setq result (cons first result))
3498             (setq first (1+ first))))
3499         (setq ranges (cdr ranges)))
3500       (nreverse result)))))
3501
3502 (defun gnus-add-to-range (ranges list)
3503   "Return a list of ranges that has all articles from both RANGES and LIST.
3504 Note: LIST has to be sorted over `<'."
3505   (if (not ranges)
3506       (gnus-compress-sequence list t)
3507     (setq list (copy-sequence list))
3508     (or (listp (cdr ranges))
3509         (setq ranges (list ranges)))
3510     (let ((out ranges)
3511           ilist lowest highest temp)
3512       (while (and ranges list)
3513         (setq ilist list)
3514         (setq lowest (or (and (atom (car ranges)) (car ranges))
3515                          (car (car ranges))))
3516         (while (and list (cdr list) (< (car (cdr list)) lowest))
3517           (setq list (cdr list)))
3518         (if (< (car ilist) lowest)
3519             (progn
3520               (setq temp list)
3521               (setq list (cdr list))
3522               (setcdr temp nil)
3523               (setq out (nconc (gnus-compress-sequence ilist t) out))))
3524         (setq highest (or (and (atom (car ranges)) (car ranges))
3525                           (cdr (car ranges))))
3526         (while (and list (<= (car list) highest))
3527           (setq list (cdr list)))
3528         (setq ranges (cdr ranges)))
3529       (if list
3530           (setq out (nconc (gnus-compress-sequence list t) out)))
3531       (setq out (sort out (lambda (r1 r2) 
3532                             (< (or (and (atom r1) r1) (car r1))
3533                                (or (and (atom r2) r2) (car r2))))))
3534       (setq ranges out)
3535       (while ranges
3536         (if (atom (car ranges))
3537             (if (cdr ranges)
3538                 (if (atom (car (cdr ranges)))
3539                     (if (= (1+ (car ranges)) (car (cdr ranges)))
3540                         (progn
3541                           (setcar ranges (cons (car ranges) 
3542                                                (car (cdr ranges))))
3543                           (setcdr ranges (cdr (cdr ranges)))))
3544                   (if (= (1+ (car ranges)) (car (car (cdr ranges))))
3545                       (progn
3546                         (setcar (car (cdr ranges)) (car ranges))
3547                         (setcar ranges (car (cdr ranges)))
3548                         (setcdr ranges (cdr (cdr ranges)))))))
3549           (if (cdr ranges)
3550               (if (atom (car (cdr ranges)))
3551                   (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
3552                       (progn
3553                         (setcdr (car ranges) (car (cdr ranges)))
3554                         (setcdr ranges (cdr (cdr ranges)))))
3555                 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
3556                     (progn
3557                       (setcdr (car ranges) (cdr (car (cdr ranges))))
3558                       (setcdr ranges (cdr (cdr ranges))))))))
3559         (setq ranges (cdr ranges)))
3560       out)))
3561
3562 (defun gnus-remove-from-range (ranges list)
3563   "Return a list of ranges that has all articles from LIST removed from RANGES.
3564 Note: LIST has to be sorted over `<'."
3565   ;; !!! This function shouldn't look like this, but I've got a headache.
3566   (gnus-compress-sequence 
3567    (gnus-sorted-complement
3568     (gnus-uncompress-range ranges) list)))
3569
3570 (defun gnus-member-of-range (number ranges)
3571   (if (not (listp (cdr ranges)))
3572       (and (>= number (car ranges)) 
3573            (<= number (cdr ranges)))
3574     (let ((not-stop t))
3575       (while (and ranges 
3576                   (if (numberp (car ranges))
3577                       (>= number (car ranges))
3578                     (>= number (car (car ranges))))
3579                   not-stop)
3580         (if (if (numberp (car ranges))
3581                 (= number (car ranges))
3582               (and (>= number (car (car ranges)))
3583                    (<= number (cdr (car ranges)))))
3584             (setq not-stop nil))
3585         (setq ranges (cdr ranges)))
3586       (not not-stop))))
3587
3588 (defun gnus-range-length (range)
3589   "Return the length RANGE would have if uncompressed."
3590   (length (gnus-uncompress-range range)))
3591
3592 (defun gnus-sublist-p (list sublist)
3593   "Test whether all elements in SUBLIST are members of LIST."
3594   (let ((sublistp t))
3595     (while sublist
3596       (unless (memq (pop sublist) list)
3597         (setq sublistp nil
3598               sublist nil)))
3599     sublistp))
3600
3601 \f
3602 ;;;
3603 ;;; Gnus group mode
3604 ;;;
3605
3606 (defvar gnus-group-mode-map nil)
3607 (defvar gnus-group-group-map nil)
3608 (defvar gnus-group-mark-map nil)
3609 (defvar gnus-group-list-map nil)
3610 (defvar gnus-group-sort-map nil)
3611 (defvar gnus-group-soup-map nil)
3612 (defvar gnus-group-sub-map nil)
3613 (defvar gnus-group-help-map nil)
3614 (defvar gnus-group-score-map nil)
3615 (put 'gnus-group-mode 'mode-class 'special)
3616
3617 (if gnus-group-mode-map
3618     nil
3619   (setq gnus-group-mode-map (make-keymap))
3620   (suppress-keymap gnus-group-mode-map)
3621   (define-key gnus-group-mode-map " " 'gnus-group-read-group)
3622   (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
3623   (define-key gnus-group-mode-map "\M- " 'gnus-group-unhidden-select-group)
3624   (define-key gnus-group-mode-map "\r" 'gnus-group-select-group)
3625   (define-key gnus-group-mode-map "\M-\r" 'gnus-group-quick-select-group)
3626   (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
3627   (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
3628   (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
3629   (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
3630   (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
3631   (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
3632   (define-key gnus-group-mode-map
3633     "\M-n" 'gnus-group-next-unread-group-same-level)
3634   (define-key gnus-group-mode-map 
3635     "\M-p" 'gnus-group-prev-unread-group-same-level)
3636   (define-key gnus-group-mode-map "," 'gnus-group-best-unread-group)
3637   (define-key gnus-group-mode-map "." 'gnus-group-first-unread-group)
3638   (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
3639   (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
3640   (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current)
3641   (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all)
3642   (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
3643   (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
3644   (define-key gnus-group-mode-map "m" 'gnus-group-mail)
3645   (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
3646   (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group)
3647   (define-key gnus-group-mode-map "R" 'gnus-group-restart)
3648   (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file)
3649   (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server)
3650   (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
3651   (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups)
3652   (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group)
3653   (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups)
3654   (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos)
3655   (define-key gnus-group-mode-map "\C-c\M-\C-a" 'gnus-group-description-apropos)
3656   (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
3657   (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
3658   (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
3659   (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
3660   (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
3661   (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
3662   (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
3663   (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed)
3664   (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles)
3665   (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups)
3666   (define-key gnus-group-mode-map "V" 'gnus-version)
3667   (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc)
3668   (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
3669   (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble)
3670   (define-key gnus-group-mode-map "q" 'gnus-group-exit)
3671   (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
3672   (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
3673   (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
3674   (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method)
3675   (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode)
3676   (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group)
3677   (define-key gnus-group-mode-map "<" 'beginning-of-buffer)
3678   (define-key gnus-group-mode-map ">" 'end-of-buffer)
3679   (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug)
3680   (define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups)
3681   (define-key gnus-group-mode-map "t" 'gnus-topic-mode)
3682   (define-key gnus-group-mode-map "\C-c\M-g" 'gnus-activate-all-groups)
3683
3684   (define-key gnus-group-mode-map "#" 'gnus-group-mark-group)
3685   (define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group)
3686   (define-prefix-command 'gnus-group-mark-map)
3687   (define-key gnus-group-mode-map "M" 'gnus-group-mark-map)
3688   (define-key gnus-group-mark-map "m" 'gnus-group-mark-group)
3689   (define-key gnus-group-mark-map "u" 'gnus-group-unmark-group)
3690   (define-key gnus-group-mark-map "w" 'gnus-group-mark-region)
3691   (define-key gnus-group-mark-map "r" 'gnus-group-mark-regexp)
3692
3693   (define-prefix-command 'gnus-group-group-map)
3694   (define-key gnus-group-mode-map "G" 'gnus-group-group-map)
3695   (define-key gnus-group-group-map "d" 'gnus-group-make-directory-group)
3696   (define-key gnus-group-group-map "h" 'gnus-group-make-help-group)
3697   (define-key gnus-group-group-map "a" 'gnus-group-make-archive-group)
3698   (define-key gnus-group-group-map "k" 'gnus-group-make-kiboze-group)
3699   (define-key gnus-group-group-map "m" 'gnus-group-make-group)
3700   (define-key gnus-group-group-map "E" 'gnus-group-edit-group)
3701   (define-key gnus-group-group-map "e" 'gnus-group-edit-group-method)
3702   (define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters)
3703   (define-key gnus-group-group-map "v" 'gnus-group-add-to-virtual)
3704   (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual)
3705   (define-key gnus-group-group-map "D" 'gnus-group-enter-directory)
3706   (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group)
3707   (define-key gnus-group-group-map "r" 'gnus-group-rename-group)
3708   (define-key gnus-group-group-map "\177" 'gnus-group-delete-group)
3709
3710   (define-prefix-command 'gnus-group-soup-map)
3711   (define-key gnus-group-group-map "s" 'gnus-group-soup-map)
3712   (define-key gnus-group-soup-map "b" 'gnus-group-brew-soup)
3713   (define-key gnus-group-soup-map "w" 'gnus-soup-save-areas)
3714   (define-key gnus-group-soup-map "s" 'gnus-soup-send-replies)
3715   (define-key gnus-group-soup-map "p" 'gnus-soup-pack-packet)
3716   (define-key gnus-group-soup-map "r" 'nnsoup-pack-replies)
3717
3718   (define-prefix-command 'gnus-group-sort-map)
3719   (define-key gnus-group-group-map "S" 'gnus-group-sort-map)
3720   (define-key gnus-group-sort-map "s" 'gnus-group-sort-groups)
3721   (define-key gnus-group-sort-map "a" 'gnus-group-sort-groups-by-alphabet)
3722   (define-key gnus-group-sort-map "u" 'gnus-group-sort-groups-by-unread)
3723   (define-key gnus-group-sort-map "l" 'gnus-group-sort-groups-by-level)
3724   (define-key gnus-group-sort-map "v" 'gnus-group-sort-groups-by-score)
3725   (define-key gnus-group-sort-map "r" 'gnus-group-sort-groups-by-rank)
3726   (define-key gnus-group-sort-map "m" 'gnus-group-sort-groups-by-method)
3727
3728   (define-prefix-command 'gnus-group-list-map)
3729   (define-key gnus-group-mode-map "A" 'gnus-group-list-map)
3730   (define-key gnus-group-list-map "k" 'gnus-group-list-killed)
3731   (define-key gnus-group-list-map "z" 'gnus-group-list-zombies)
3732   (define-key gnus-group-list-map "s" 'gnus-group-list-groups)
3733   (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups)
3734   (define-key gnus-group-list-map "A" 'gnus-group-list-active)
3735   (define-key gnus-group-list-map "a" 'gnus-group-apropos)
3736   (define-key gnus-group-list-map "d" 'gnus-group-description-apropos)
3737   (define-key gnus-group-list-map "m" 'gnus-group-list-matching)
3738   (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching)
3739   (define-key gnus-group-list-map "l" 'gnus-group-list-level)
3740
3741   (define-prefix-command 'gnus-group-score-map)
3742   (define-key gnus-group-mode-map "W" 'gnus-group-score-map)
3743   (define-key gnus-group-score-map "f" 'gnus-score-flush-cache)
3744
3745   (define-prefix-command 'gnus-group-help-map)
3746   (define-key gnus-group-mode-map "H" 'gnus-group-help-map)
3747   (define-key gnus-group-help-map "f" 'gnus-group-fetch-faq)
3748
3749   (define-prefix-command 'gnus-group-sub-map)
3750   (define-key gnus-group-mode-map "S" 'gnus-group-sub-map)
3751   (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level)
3752   (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group)
3753   (define-key gnus-group-sub-map "s" 'gnus-group-unsubscribe-group)
3754   (define-key gnus-group-sub-map "k" 'gnus-group-kill-group)
3755   (define-key gnus-group-sub-map "y" 'gnus-group-yank-group)
3756   (define-key gnus-group-sub-map "w" 'gnus-group-kill-region)
3757   (define-key gnus-group-sub-map "\C-k" 'gnus-group-kill-level)
3758   (define-key gnus-group-sub-map "z" 'gnus-group-kill-all-zombies))
3759
3760 (defun gnus-group-mode ()
3761   "Major mode for reading news.
3762
3763 All normal editing commands are switched off.
3764 \\<gnus-group-mode-map>
3765 The group buffer lists (some of) the groups available.  For instance,
3766 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
3767 lists all zombie groups. 
3768
3769 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe 
3770 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. 
3771
3772 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). 
3773
3774 The following commands are available:
3775
3776 \\{gnus-group-mode-map}"
3777   (interactive)
3778   (when (and menu-bar-mode
3779              (gnus-visual-p 'group-menu 'menu))
3780     (gnus-group-make-menu-bar))
3781   (kill-all-local-variables)
3782   (gnus-simplify-mode-line)
3783   (setq major-mode 'gnus-group-mode)
3784   (setq mode-name "Group")
3785   (gnus-group-set-mode-line)
3786   (setq mode-line-process nil)
3787   (use-local-map gnus-group-mode-map)
3788   (buffer-disable-undo (current-buffer))
3789   (setq truncate-lines t)
3790   (setq buffer-read-only t)
3791   (run-hooks 'gnus-group-mode-hook))
3792
3793 (defun gnus-mouse-pick-group (e)
3794   "Enter the group under the mouse pointer."
3795   (interactive "e")
3796   (mouse-set-point e)
3797   (gnus-group-read-group nil))
3798
3799 ;; Look at LEVEL and find out what the level is really supposed to be.
3800 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
3801 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
3802 (defun gnus-group-default-level (&optional level number-or-nil)
3803   (cond  
3804    (gnus-group-use-permanent-levels
3805     (setq gnus-group-default-list-level 
3806           (or level gnus-group-default-list-level))
3807     (or gnus-group-default-list-level gnus-level-subscribed))
3808    (number-or-nil
3809     level)
3810    (t
3811     (or level gnus-group-default-list-level gnus-level-subscribed))))
3812   
3813 ;;;###autoload
3814 (defun gnus-slave-no-server (&optional arg)
3815   "Read network news as a slave, without connecting to local server"
3816   (interactive "P")
3817   (gnus-no-server arg t))
3818
3819 ;;;###autoload
3820 (defun gnus-no-server (&optional arg slave)
3821   "Read network news.
3822 If ARG is a positive number, Gnus will use that as the
3823 startup level.  If ARG is nil, Gnus will be started at level 2. 
3824 If ARG is non-nil and not a positive number, Gnus will
3825 prompt the user for the name of an NNTP server to use.
3826 As opposed to `gnus', this command will not connect to the local server."
3827   (interactive "P")
3828   (make-local-variable 'gnus-group-use-permanent-levels)
3829   (setq gnus-group-use-permanent-levels t)
3830   (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
3831
3832 ;;;###autoload
3833 (defun gnus-slave (&optional arg)
3834   "Read news as a slave."
3835   (interactive "P")
3836   (gnus arg nil 'slave))
3837
3838 ;;;###autoload
3839 (defun gnus (&optional arg dont-connect slave)
3840   "Read network news.
3841 If ARG is non-nil and a positive number, Gnus will use that as the
3842 startup level.  If ARG is non-nil and not a positive number, Gnus will
3843 prompt the user for the name of an NNTP server to use."
3844   (interactive "P")
3845   (if (get-buffer gnus-group-buffer)
3846       (progn
3847         (switch-to-buffer gnus-group-buffer)
3848         (gnus-group-get-new-news))
3849
3850     (gnus-clear-system)
3851     (nnheader-init-server-buffer)
3852     (gnus-read-init-file)
3853     (setq gnus-slave slave)
3854
3855     (gnus-group-setup-buffer)
3856     (let ((buffer-read-only nil))
3857       (erase-buffer)
3858       (if (not gnus-inhibit-startup-message)
3859           (progn
3860             (gnus-group-startup-message)
3861             (sit-for 0))))
3862     
3863     (let ((level (and arg (numberp arg) (> arg 0) arg))
3864           did-connect)
3865       (unwind-protect
3866           (progn
3867             (or dont-connect 
3868                 (setq did-connect
3869                       (gnus-start-news-server (and arg (not level))))))
3870         (if (and (not dont-connect) 
3871                  (not did-connect))
3872             (gnus-group-quit)
3873           (run-hooks 'gnus-startup-hook)
3874           ;; NNTP server is successfully open. 
3875
3876           ;; Find the current startup file name.
3877           (setq gnus-current-startup-file 
3878                 (gnus-make-newsrc-file gnus-startup-file))
3879
3880           ;; Read the dribble file.
3881           (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
3882
3883           (gnus-summary-make-display-table)
3884           ;; Do the actual startup.
3885           (gnus-setup-news nil level)
3886           ;; Generate the group buffer.
3887           (gnus-group-list-groups level)
3888           (gnus-configure-windows 'group)
3889           (gnus-group-set-mode-line))))))
3890
3891 (defun gnus-unload ()
3892   "Unload all Gnus features."
3893   (interactive)
3894   (or (boundp 'load-history)
3895       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
3896   (let ((history load-history)
3897         feature)
3898     (while history
3899       (and (string-match "^gnus" (car (car history)))
3900            (setq feature (cdr (assq 'provide (car history))))
3901            (unload-feature feature 'force))
3902       (setq history (cdr history)))))
3903
3904 (defun gnus-compile ()
3905   "Byte-compile the Gnus startup file.
3906 This will also compile the user-defined format specs."
3907   (interactive)
3908   (let ((file (concat (make-temp-name "/tmp/gnuss") ".el")))
3909     (save-excursion
3910       (gnus-message 7 "Compiling user file...")
3911       (nnheader-set-temp-buffer " *compile gnus*")
3912       (and (file-exists-p gnus-init-file)
3913            (insert-file gnus-init-file))
3914       (goto-char (point-max))
3915
3916       (let ((formats '(summary summary-dummy group 
3917                                summary-mode group-mode article-mode))
3918             format fs)
3919         
3920         (while formats
3921           (setq format (symbol-name (car formats))
3922                 formats (cdr formats)
3923                 fs (cons (symbol-value 
3924                           (intern (format "gnus-%s-line-format" format)))
3925                          fs))
3926           (insert "(defun gnus-" format "-line-format-spec ()\n")
3927           (insert 
3928            (prin1-to-string
3929             (symbol-value 
3930              (intern (format "gnus-%s-line-format-spec" format)))))
3931           (insert ")\n")
3932           (insert "(setq gnus-" format 
3933                   "-line-format-spec (list 'gnus-byte-code 'gnus-"
3934                   format "-line-format-spec))\n"))
3935
3936         (insert "(setq gnus-old-specs '" (prin1-to-string fs) ")\n")
3937
3938         (write-region (point-min) (point-max) file nil 'silent)
3939         (byte-compile-file file)
3940         (rename-file
3941          (concat file "c") 
3942          (concat gnus-init-file 
3943                  (if (string-match "\\.el$" gnus-init-file) "c" ".elc"))
3944          t)
3945         (when (file-exists-p file)
3946           (delete-file file))
3947         (kill-buffer (current-buffer)))
3948       (gnus-message 7 "Compiling user file...done"))))
3949
3950 (defun gnus-indent-rigidly (start end arg)
3951   "Indent rigidly using only spaces and no tabs."
3952   (save-excursion
3953     (save-restriction
3954       (narrow-to-region start end)
3955       (indent-rigidly start end arg)
3956       (goto-char (point-min))
3957       (while (search-forward "\t" nil t)
3958         (replace-match "        " t t)))))
3959
3960 (defun gnus-group-startup-message (&optional x y)
3961   "Insert startup message in current buffer."
3962   ;; Insert the message.
3963   (erase-buffer)
3964   (insert
3965    (format "              %s
3966           _    ___ _             _      
3967           _ ___ __ ___  __    _ ___     
3968           __   _     ___    __  ___     
3969               _           ___     _     
3970              _  _ __             _      
3971              ___   __            _      
3972                    __           _       
3973                     _      _   _        
3974                    _      _    _        
3975                       _  _    _         
3976                   __  ___               
3977                  _   _ _     _          
3978                 _   _                   
3979               _    _                    
3980              _    _                     
3981             _                         
3982           __                             
3983
3984
3985            ""))
3986   ;; And then hack it.
3987   (gnus-indent-rigidly (point-min) (point-max) 
3988                        (/ (max (- (window-width) (or x 46)) 0) 2))
3989   (goto-char (point-min))
3990   (forward-line 1)
3991   (let* ((pheight (count-lines (point-min) (point-max)))
3992          (wheight (window-height))
3993          (rest (- wheight pheight)))
3994     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
3995   ;; Fontify some.
3996   (goto-char (point-min))
3997   (and (search-forward "Praxis" nil t)
3998        (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
3999   (goto-char (point-min))
4000   (let* ((mode-string (gnus-group-set-mode-line)))
4001     (setq mode-line-buffer-identification 
4002           (list (concat gnus-version (substring (car mode-string) 4))))
4003     (set-buffer-modified-p t)))
4004
4005 (defun gnus-group-startup-message-old (&optional x y)
4006   "Insert startup message in current buffer."
4007   ;; Insert the message.
4008   (erase-buffer)
4009   (insert
4010    (format "
4011      %s
4012            A newsreader 
4013       for GNU Emacs
4014
4015         Based on GNUS 
4016              written by 
4017      Masanobu UMEDA
4018
4019        A Praxis Release
4020       larsi@ifi.uio.no
4021
4022            gnus-version))
4023   ;; And then hack it.
4024   ;; 18 is the longest line.
4025   (indent-rigidly (point-min) (point-max) 
4026                   (/ (max (- (window-width) (or x 28)) 0) 2))
4027   (goto-char (point-min))
4028   ;; +4 is fuzzy factor.
4029   (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))
4030
4031   ;; Fontify some.
4032   (goto-char (point-min))
4033   (search-forward "Praxis")
4034   (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
4035   (goto-char (point-min)))
4036
4037 (defun gnus-group-setup-buffer ()
4038   (or (get-buffer gnus-group-buffer)
4039       (progn
4040         (switch-to-buffer gnus-group-buffer)
4041         (gnus-add-current-to-buffer-list)
4042         (gnus-group-mode)
4043         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4044
4045 (defun gnus-group-list-groups (&optional level unread lowest)
4046   "List newsgroups with level LEVEL or lower that have unread articles.
4047 Default is all subscribed groups.
4048 If argument UNREAD is non-nil, groups with no unread articles are also
4049 listed." 
4050   (interactive (list (if current-prefix-arg
4051                          (prefix-numeric-value current-prefix-arg)
4052                        (or
4053                         (gnus-group-default-level nil t)
4054                         gnus-group-default-list-level
4055                         gnus-level-subscribed))))
4056   (or level
4057       (setq level (car gnus-group-list-mode)
4058             unread (cdr gnus-group-list-mode)))
4059   (setq level (gnus-group-default-level level))
4060   (gnus-group-setup-buffer)             ;May call from out of group buffer
4061   (gnus-update-format-specifications)
4062   (let ((case-fold-search nil)
4063         (group (gnus-group-group-name)))
4064     (funcall gnus-group-prepare-function level unread lowest)
4065     (if (zerop (buffer-size))
4066         (gnus-message 5 gnus-no-groups-message)
4067       (goto-char (point-min))
4068       (if (not group)
4069           ;; Go to the first group with unread articles.
4070           (gnus-group-search-forward nil nil nil t)
4071         ;; Find the right group to put point on.  If the current group
4072         ;; has disapeared in the new listing, try to find the next
4073         ;; one.  If no next one can be found, just leave point at the
4074         ;; first newsgroup in the buffer.
4075         (if (not (gnus-goto-char
4076                   (text-property-any
4077                    (point-min) (point-max) 
4078                    'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4079             (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
4080               (while (and newsrc
4081                           (not (gnus-goto-char 
4082                                 (text-property-any 
4083                                  (point-min) (point-max) 'gnus-group 
4084                                  (gnus-intern-safe 
4085                                   (car (car newsrc)) gnus-active-hashtb)))))
4086                 (setq newsrc (cdr newsrc)))
4087               (or newsrc (progn (goto-char (point-max))
4088                                 (forward-line -1))))))
4089       ;; Adjust cursor point.
4090       (gnus-group-position-point))))
4091
4092 (defun gnus-group-list-level (level &optional all)
4093   "List groups on LEVEL.
4094 If ALL (the prefix), also list groups that have no unread articles."
4095   (interactive "nList groups on level: \nP")
4096   (gnus-group-list-groups level all level))
4097
4098 (defun gnus-group-prepare-flat (level &optional all lowest regexp) 
4099   "List all newsgroups with unread articles of level LEVEL or lower.
4100 If ALL is non-nil, list groups that have no unread articles.
4101 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4102 If REGEXP, only list groups matching REGEXP."
4103   (set-buffer gnus-group-buffer)
4104   (setq gnus-topic-indentation "")
4105   (let ((buffer-read-only nil)
4106         (newsrc (cdr gnus-newsrc-alist))
4107         (lowest (or lowest 1))
4108         info clevel unread group params)
4109     (erase-buffer)
4110     (if (< lowest gnus-level-zombie)
4111         ;; List living groups.
4112         (while newsrc
4113           (setq info (car newsrc)
4114                 group (gnus-info-group info)
4115                 params (gnus-info-params info)
4116                 newsrc (cdr newsrc)
4117                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4118           (and unread                   ; This group might be bogus
4119                (or (not regexp)
4120                    (string-match regexp group))
4121                (<= (setq clevel (gnus-info-level info)) level) 
4122                (>= clevel lowest)
4123                (or all                  ; We list all groups?
4124                    (eq unread t)        ; We list unactivated groups
4125                    (> unread 0)         ; We list groups with unread articles
4126                    (cdr (assq 'tick (gnus-info-marks info)))
4127                                         ; And groups with tickeds
4128                    ;; Check for permanent visibility.
4129                    (and gnus-permanently-visible-groups
4130                         (string-match gnus-permanently-visible-groups
4131                                       group))
4132                    (memq 'visible params)
4133                    (cdr (assq 'visible params)))
4134                (gnus-group-insert-group-line 
4135                 group (gnus-info-level info) 
4136                 (gnus-info-marks info) unread (gnus-info-method info)))))
4137       
4138     ;; List dead groups.
4139     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4140          (gnus-group-prepare-flat-list-dead 
4141           (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 
4142           gnus-level-zombie ?Z
4143           regexp))
4144     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4145          (gnus-group-prepare-flat-list-dead 
4146           (setq gnus-killed-list (sort gnus-killed-list 'string<)) 
4147           gnus-level-killed ?K regexp))
4148
4149     (gnus-group-set-mode-line)
4150     (setq gnus-group-list-mode (cons level all))
4151     (run-hooks 'gnus-group-prepare-hook)))
4152
4153 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4154   ;; List zombies and killed lists somehwat faster, which was
4155   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4156   ;; this by ignoring the group format specification altogether.
4157   (let (group beg)
4158     (if regexp
4159         ;; This loop is used when listing groups that match some
4160         ;; regexp. 
4161         (while groups
4162           (setq group (pop groups))
4163           (when (string-match regexp group)
4164             (add-text-properties 
4165              (point) (prog1 (1+ (point))
4166                        (insert " " mark "     *: " group "\n"))
4167              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4168                    'gnus-unread t
4169                    'gnus-level level))))
4170       ;; This loop is used when listing all groups.
4171       (while groups
4172         (add-text-properties 
4173          (point) (prog1 (1+ (point))
4174                    (insert " " mark "     *: " 
4175                            (setq group (pop groups)) "\n"))
4176          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4177                'gnus-unread t
4178                'gnus-level level))))))
4179
4180 (defmacro gnus-group-real-name (group)
4181   "Find the real name of a foreign newsgroup."
4182   `(let ((gname ,group))
4183      (if (string-match ":[^:]+$" gname)
4184          (substring gname (1+ (match-beginning 0)))
4185        gname)))
4186
4187 (defsubst gnus-server-add-address (method)
4188   (let ((method-name (symbol-name (car method))))
4189     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4190              (not (assq (intern (concat method-name "-address")) method)))
4191         (append method (list (list (intern (concat method-name "-address"))
4192                                    (nth 1 method))))
4193       method)))
4194
4195 (defsubst gnus-server-get-method (group method)
4196   ;; Input either a server name, and extended server name, or a
4197   ;; select method, and return a select method. 
4198   (cond ((stringp method)
4199          (gnus-server-to-method method))
4200         ((and (stringp (car method)) group)
4201          (gnus-server-extend-method group method))
4202         (t
4203          (gnus-server-add-address method))))
4204
4205 (defun gnus-server-to-method (server)
4206   "Map virtual server names to select methods."
4207   (or (and (equal server "native") gnus-select-method)
4208       (cdr (assoc server gnus-server-alist))))
4209
4210 (defun gnus-group-prefixed-name (group method)
4211   "Return the whole name from GROUP and METHOD."
4212   (and (stringp method) (setq method (gnus-server-to-method method)))
4213   (concat (format "%s" (car method))
4214           (if (and 
4215                (assoc (format "%s" (car method)) (gnus-methods-using 'address))
4216                (not (string= (nth 1 method) "")))
4217               (concat "+" (nth 1 method)))
4218           ":" group))
4219
4220 (defun gnus-group-real-prefix (group)
4221   "Return the prefix of the current group name."
4222   (if (string-match "^[^:]+:" group)
4223       (substring group 0 (match-end 0))
4224     ""))
4225
4226 (defun gnus-group-method-name (group)
4227   "Return the method used for selecting GROUP."
4228   (let ((prefix (gnus-group-real-prefix group)))
4229     (if (equal prefix "")
4230         gnus-select-method
4231       (if (string-match "^[^\\+]+\\+" prefix)
4232           (list (intern (substring prefix 0 (1- (match-end 0))))
4233                 (substring prefix (match-end 0) (1- (length prefix))))
4234         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
4235
4236 (defsubst gnus-secondary-method-p (method)
4237   "Return whether METHOD is a secondary select method."
4238   (let ((methods gnus-secondary-select-methods)
4239         (gmethod (gnus-server-get-method nil method)))
4240     (while (and methods
4241                 (not (equal (gnus-server-get-method nil (car methods)) 
4242                             gmethod)))
4243       (setq methods (cdr methods)))
4244     methods))
4245
4246 (defun gnus-group-foreign-p (group)
4247   "Say whether a group is foreign or not."
4248   (and (not (gnus-group-native-p group))
4249        (not (gnus-group-secondary-p group))))
4250
4251 (defun gnus-group-native-p (group)
4252   "Say whether the group is native or not."
4253   (not (string-match ":" group)))
4254
4255 (defun gnus-group-secondary-p (group)
4256   "Say whether the group is secondary or not."
4257   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4258
4259 (defun gnus-group-get-parameter (group &optional symbol)
4260   "Returns the group parameters for GROUP.
4261 If SYMBOL, return the value of that symbol in the group parameters."
4262   (let ((params (gnus-info-params (gnus-get-info group))))
4263     (if symbol
4264         (gnus-group-parameter-value params symbol)
4265       params)))
4266
4267 (defun gnus-group-parameter-value (params symbol)
4268   "Return the value of SYMBOL in group PARAMS."
4269   (or (car (memq symbol params))        ; It's either a simple symbol
4270       (cdr (assq symbol params))))      ; or a cons.
4271
4272 (defun gnus-group-add-parameter (group param)
4273   "Add parameter PARAM to GROUP."
4274   (let ((info (gnus-get-info group)))
4275     (if (not info)
4276         () ; This is a dead group.  We just ignore it.
4277       ;; Cons the new param to the old one and update.
4278       (gnus-group-set-info (cons param (gnus-info-params info)) 
4279                            group 'params))))
4280
4281 (defun gnus-group-add-score (group &optional score)
4282   "Add SCORE to the GROUP score.  
4283 If SCORE is nil, add 1 to the score of GROUP."
4284   (let ((info (gnus-get-info group)))
4285     (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
4286
4287 (defun gnus-summary-bubble-group ()
4288   "Increase the score of the current group.
4289 This is a handy function to add to `gnus-summary-exit-hook' to
4290 increase the score of each group you read."
4291   (gnus-group-add-score gnus-newsgroup-name))
4292
4293 (defun gnus-group-set-info (info &optional method-only-group part)
4294   (let* ((entry (gnus-gethash
4295                  (or method-only-group (gnus-info-group info))
4296                  gnus-newsrc-hashtb))
4297          (part-info info)
4298          (info (if method-only-group (nth 2 entry) info)))
4299     (when method-only-group
4300       (unless entry
4301         (error "Trying to change non-existent group %s" method-only-group))
4302       ;; We have recevied parts of the actual group info - either the
4303       ;; select method or the group parameters.  We first check
4304       ;; whether we have to extend the info, and if so, do that.
4305       (let ((len (length info))
4306             (total (if (eq part 'method) 5 6)))
4307         (when (< len total)
4308           (setcdr (nthcdr (1- len) info)
4309                   (make-list (- total len) nil)))
4310         ;; Then we enter the new info.
4311         (setcar (nthcdr (1- total) info) part-info)))
4312     (unless entry
4313       ;; This is a new group, so we just create it.
4314       (save-excursion
4315         (set-buffer gnus-group-buffer)
4316         (if (gnus-info-method info)
4317             ;; It's a foreign group...
4318             (gnus-group-make-group 
4319              (gnus-group-real-name (gnus-info-group info))
4320              (prin1-to-string (car (gnus-info-method info)))
4321              (nth 1 (gnus-info-method info)))
4322           ;; It's a native group.
4323           (gnus-group-make-group (gnus-info-group info)))
4324         (gnus-message 6 "Note: New group created")
4325         (setq entry 
4326               (gnus-gethash (gnus-group-prefixed-name 
4327                              (gnus-group-real-name (gnus-info-group info))
4328                              (or (gnus-info-method info) gnus-select-method))
4329                             gnus-newsrc-hashtb))))
4330     ;; Whether it was a new group or not, we now have the entry, so we
4331     ;; can do the update.
4332     (if entry
4333         (progn
4334           (setcar (nthcdr 2 entry) info)
4335           (when (and (not (eq (car entry) t)) 
4336                      (gnus-active (gnus-info-group info)))
4337             (let ((marked (gnus-info-marks info)))
4338               (setcar entry (length (gnus-list-of-unread-articles 
4339                                      (car info)))))))
4340       (error "No such group: %s" (gnus-info-group info)))))
4341
4342 (defun gnus-group-set-method-info (group select-method)
4343   (gnus-group-set-info select-method group 'method))
4344
4345 (defun gnus-group-set-params-info (group params)
4346   (gnus-group-set-info params group 'params))
4347
4348 (defun gnus-group-update-group-line ()
4349   "Update the current line in the group buffer."
4350   (let* ((buffer-read-only nil)
4351          (group (gnus-group-group-name))
4352          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4353     (and entry 
4354          (not (gnus-ephemeral-group-p group))
4355          (gnus-dribble-enter 
4356           (concat "(gnus-group-set-info '" 
4357                   (prin1-to-string (nth 2 entry)) ")")))
4358     (gnus-delete-line)
4359     (gnus-group-insert-group-line-info group)
4360     (forward-line -1)
4361     (gnus-group-position-point)))
4362
4363 (defun gnus-group-insert-group-line-info (group)
4364   "Insert GROUP on the current line."
4365   (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) 
4366         active info)
4367     (if entry
4368         (progn
4369           ;; (Un)subscribed group.
4370           (setq info (nth 2 entry))
4371           (gnus-group-insert-group-line 
4372            group (gnus-info-level info) (gnus-info-marks info)
4373            (or (car entry) t) (gnus-info-method info)))
4374       ;; This group is dead.
4375       (gnus-group-insert-group-line 
4376        group 
4377        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4378        nil 
4379        (if (setq active (gnus-active group))
4380            (- (1+ (cdr active)) (car active)) 0) 
4381        nil))))
4382
4383 ;; Dummy function redefined when running under XEmacs.
4384 (defalias 'gnus-group-remove-excess-properties 'ignore)
4385
4386 (defun gnus-group-insert-group-line 
4387   (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
4388                   gnus-tmp-method)
4389   "Insert a group line in the group buffer."
4390   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4391          (gnus-tmp-number-total 
4392           (if gnus-tmp-active 
4393               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4394             0))
4395          (gnus-tmp-number-of-unread 
4396           (if (numberp number) (int-to-string (max 0 number))
4397             "*"))
4398          (gnus-tmp-number-of-read
4399           (if (numberp number)
4400               (max 0 (- gnus-tmp-number-total number))
4401             "*"))
4402          (gnus-tmp-subscribed
4403           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4404                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4405                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4406                 (t ?K)))
4407          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4408          (gnus-tmp-newsgroup-description 
4409           (if gnus-description-hashtb
4410               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4411             ""))
4412          (gnus-tmp-moderated
4413           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4414          (gnus-tmp-moderated-string 
4415           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4416          (gnus-tmp-method
4417           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4418          (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) ""))
4419          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4420          (gnus-tmp-news-method-string 
4421           (if gnus-tmp-method
4422               (format "(%s:%s)" (car gnus-tmp-method)
4423                       (car (cdr gnus-tmp-method))) ""))
4424          (gnus-tmp-marked-mark 
4425           (if (and (numberp number) 
4426                    (zerop number)
4427                    (cdr (assq 'tick gnus-tmp-marked)))
4428               ?* ? ))
4429          (gnus-tmp-number
4430           (cond ((eq number t) "*" )
4431                 ((numberp number) (int-to-string number))
4432                 (t number)))
4433          (gnus-tmp-process-marked
4434           (if (member gnus-tmp-group gnus-group-marked)
4435               gnus-process-mark ? ))
4436          (buffer-read-only nil)
4437          header)                        ; passed as parameter to user-funcs.
4438     (beginning-of-line)
4439     (add-text-properties
4440      (point)
4441      (prog1 (1+ (point))
4442        ;; Insert the text.
4443        (eval gnus-group-line-format-spec))
4444      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4445        gnus-unread ,(if (numberp number)
4446                         (string-to-int gnus-tmp-number-of-unread)
4447                       t)
4448        gnus-marked ,gnus-tmp-marked-mark
4449        gnus-level ,gnus-tmp-level))
4450     ;; Allow XEmacs to remove front-sticky text properties.
4451     (gnus-group-remove-excess-properties)))
4452
4453 (defun gnus-group-update-group (group &optional visible-only)
4454   "Update all lines where GROUP appear.
4455 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4456 already." 
4457   (save-excursion
4458     (set-buffer gnus-group-buffer)
4459     ;; The buffer may be narrowed.
4460     (save-restriction
4461       (widen)
4462       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4463             (loc (point-min))
4464             found buffer-read-only visible)
4465         ;; Enter the current status into the dribble buffer.
4466         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4467           (if (and entry (not (gnus-ephemeral-group-p group)))
4468               (gnus-dribble-enter 
4469                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4470                        ")"))))
4471         ;; Find all group instances.  If topics are in use, each group
4472         ;; may be listed in more than once.
4473         (while (setq loc (text-property-any 
4474                           loc (point-max) 'gnus-group ident))
4475           (setq found t)
4476           (goto-char loc)
4477           (gnus-delete-line)
4478           (gnus-group-insert-group-line-info group)
4479           (setq loc (1+ loc)))
4480         (if (or found visible-only)
4481             ()
4482           ;; No such line in the buffer, find out where it's supposed to
4483           ;; go, and insert it there (or at the end of the buffer).
4484           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
4485           (let ((entry (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
4486             (while (and entry (car entry)
4487                         (not
4488                          (gnus-goto-char
4489                           (text-property-any
4490                            (point-min) (point-max) 
4491                            'gnus-group (gnus-intern-safe 
4492                                         (car (car entry)) 
4493                                         gnus-active-hashtb)))))
4494               (setq entry (cdr entry)))
4495             (or entry (goto-char (point-max))))
4496           ;; Finally insert the line.
4497           (gnus-group-insert-group-line-info group))
4498         (gnus-group-set-mode-line)))))
4499
4500 (defun gnus-group-set-mode-line ()
4501   (when (memq 'group gnus-updated-mode-lines)
4502     (let* ((gformat (or gnus-group-mode-line-format-spec
4503                         (setq gnus-group-mode-line-format-spec
4504                               (gnus-parse-format 
4505                                gnus-group-mode-line-format 
4506                                gnus-group-mode-line-format-alist))))
4507            (gnus-tmp-news-server (car (cdr gnus-select-method)))
4508            (gnus-tmp-news-method (car gnus-select-method))
4509            (max-len 60)
4510            header                       ;Dummy binding for user-defined formats
4511            ;; Get the resulting string.
4512            (mode-string (eval gformat)))
4513       ;; If the line is too long, we chop it off.
4514       (when (> (length mode-string) max-len) 
4515         (setq mode-string (substring mode-string 0 (- max-len 4))))
4516       (prog1
4517           (setq mode-line-buffer-identification (list mode-string))
4518         (set-buffer-modified-p t)))))
4519
4520 (defun gnus-group-group-name ()
4521   "Get the name of the newsgroup on the current line."
4522   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4523     (and group (symbol-name group))))
4524
4525 (defun gnus-group-group-level ()
4526   "Get the level of the newsgroup on the current line."
4527   (get-text-property (gnus-point-at-bol) 'gnus-level))
4528
4529 (defun gnus-group-group-unread ()
4530   "Get the number of unread articles of the newsgroup on the current line."
4531   (get-text-property (gnus-point-at-bol) 'gnus-unread))
4532
4533 (defun gnus-group-search-forward (&optional backward all level first-too)
4534   "Find the next newsgroup with unread articles.
4535 If BACKWARD is non-nil, find the previous newsgroup instead.
4536 If ALL is non-nil, just find any newsgroup.
4537 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4538 group exists.
4539 If FIRST-TOO, the current line is also eligible as a target."
4540   (let ((way (if backward -1 1))
4541         (low gnus-level-killed)
4542         (beg (point))
4543         pos found lev)
4544     (if (and backward (progn (beginning-of-line)) (bobp))
4545         nil
4546       (or first-too (forward-line way))
4547       (while (and 
4548               (not (eobp))
4549               (not (setq 
4550                     found 
4551                     (and (or all
4552                              (and
4553                               (let ((unread 
4554                                      (get-text-property (point) 'gnus-unread)))
4555                                 (and (numberp unread) (> unread 0)))
4556                               (setq lev (get-text-property (point)
4557                                                            'gnus-level))
4558                               (<= lev gnus-level-subscribed)))
4559                          (or (not level)
4560                              (and (setq lev (get-text-property (point)
4561                                                                'gnus-level))
4562                                   (or (= lev level)
4563                                       (and (< lev low)
4564                                            (< level lev)
4565                                            (progn
4566                                              (setq low lev)
4567                                              (setq pos (point))
4568                                              nil))))))))
4569               (zerop (forward-line way)))))
4570     (if found 
4571         (progn (gnus-group-position-point) t)
4572       (goto-char (or pos beg))
4573       (and pos t))))
4574
4575 ;;; Gnus group mode commands
4576
4577 ;; Group marking.
4578
4579 (defun gnus-group-mark-group (n &optional unmark no-advance)
4580   "Mark the current group."
4581   (interactive "p")
4582   (let ((buffer-read-only nil)
4583         group)
4584     (while 
4585         (and (> n 0) 
4586              (setq group (gnus-group-group-name))
4587              (progn
4588                (beginning-of-line)
4589                (forward-char 
4590                 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
4591                (delete-char 1)
4592                (if unmark
4593                    (progn
4594                      (insert " ")
4595                      (setq gnus-group-marked (delete group gnus-group-marked)))
4596                  (insert "#")
4597                  (setq gnus-group-marked
4598                        (cons group (delete group gnus-group-marked))))
4599                t)
4600              (or no-advance (zerop (gnus-group-next-group 1))))
4601       (setq n (1- n)))
4602     (gnus-summary-position-point)
4603     n))
4604
4605 (defun gnus-group-unmark-group (n)
4606   "Remove the mark from the current group."
4607   (interactive "p")
4608   (gnus-group-mark-group n 'unmark))
4609
4610 (defun gnus-group-mark-region (unmark beg end)
4611   "Mark all groups between point and mark.
4612 If UNMARK, remove the mark instead."
4613   (interactive "P\nr")
4614   (let ((num (count-lines beg end)))
4615     (save-excursion
4616       (goto-char beg)
4617       (- num (gnus-group-mark-group num unmark)))))
4618
4619 (defun gnus-group-mark-regexp (regexp)
4620   "Mark all groups that match some regexp."
4621   (interactive "sMark (regexp): ")
4622   (let ((alist (cdr gnus-newsrc-alist))
4623         group)
4624     (while alist
4625       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
4626         (gnus-group-set-mark group)))))
4627
4628 (defun gnus-group-remove-mark (group)
4629   (if (gnus-group-goto-group group)
4630       (save-excursion
4631         (gnus-group-mark-group 1 'unmark t))
4632     (setq gnus-group-marked
4633           (cons group (delete group gnus-group-marked)))))
4634                 
4635 (defun gnus-group-set-mark (group)
4636   (if (gnus-group-goto-group group)
4637       (save-excursion
4638         (gnus-group-mark-group 1 nil t))
4639     (setq gnus-group-marked
4640           (cons group (delete group gnus-group-marked)))))
4641                 
4642 ;; Return a list of groups to work on.  Take into consideration N (the
4643 ;; prefix) and the list of marked groups.
4644 (defun gnus-group-process-prefix (n)
4645   (cond
4646    (n
4647     (setq n (prefix-numeric-value n))
4648     ;; There is a prefix, so we return a list of the N next
4649     ;; groups. 
4650     (let ((way (if (< n 0) -1 1))
4651           (n (abs n))
4652           group groups)
4653       (save-excursion
4654         (while (and (> n 0)
4655                     (setq group (gnus-group-group-name)))
4656           (setq groups (cons group groups))
4657           (setq n (1- n))
4658           (gnus-group-next-group way)))
4659       (nreverse groups)))
4660    ((and (boundp 'transient-mark-mode)
4661          transient-mark-mode
4662          mark-active)
4663     ;; Work on the region between point and mark.
4664     (let ((max (max (point) (mark)))
4665           groups)
4666       (save-excursion
4667         (goto-char (min (point) (mark)))
4668         (while 
4669             (and 
4670              (push (gnus-group-group-name) groups)
4671              (zerop (gnus-group-next-group 1))
4672              (< (point) max)))
4673         (nreverse groups))))
4674    (gnus-group-marked
4675     ;; No prefix, but a list of marked articles.
4676     (reverse gnus-group-marked))
4677    (t
4678     ;; Neither marked articles or a prefix, so we return the
4679     ;; current group.
4680     (let ((group (gnus-group-group-name)))
4681       (and group (list group))))))
4682
4683 ;; Selecting groups.
4684
4685 (defun gnus-group-read-group (&optional all no-article group)
4686   "Read news in this newsgroup.
4687 If the prefix argument ALL is non-nil, already read articles become
4688 readable.  IF ALL is a number, fetch this number of articles.  If the
4689 optional argument NO-ARTICLE is non-nil, no article will be
4690 auto-selected upon group entry.  If GROUP is non-nil, fetch that
4691 group."
4692   (interactive "P")
4693   (let ((group (or group (gnus-group-group-name)))
4694         number active marked entry)
4695     (or group (error "No group on current line"))
4696     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
4697                                             group gnus-newsrc-hashtb)))))
4698     ;; This group might be a dead group.  In that case we have to get
4699     ;; the number of unread articles from `gnus-active-hashtb'.
4700     (setq number
4701           (cond ((numberp all) all)
4702                 (entry (car entry))
4703                 ((setq active (gnus-active group))
4704                  (- (1+ (cdr active)) (car active)))))
4705     (gnus-summary-read-group 
4706      group (or all (and (numberp number) 
4707                         (zerop (+ number (length (cdr (assq 'tick marked)))
4708                                   (length (cdr (assq 'dormant marked)))))))
4709      no-article)))
4710
4711 (defun gnus-group-select-group (&optional all)
4712   "Select this newsgroup.
4713 No article is selected automatically.
4714 If ALL is non-nil, already read articles become readable.
4715 If ALL is a number, fetch this number of articles."
4716   (interactive "P")
4717   (gnus-group-read-group all t))
4718
4719 (defun gnus-group-quick-select-group (&optional all)
4720   "Select the current group \"quickly\". 
4721 This means that no highlighting or scoring will be performed."
4722   (interactive "P")
4723   (let (gnus-visual
4724         gnus-score-find-score-files-function
4725         gnus-apply-kill-hook
4726         gnus-summary-expunge-below)
4727     (gnus-group-read-group all t)))
4728
4729 (defun gnus-group-visible-select-group (&optional all)
4730   "Select the current group without hiding any articles."
4731   (interactive "P")
4732   (let ((gnus-inhibit-limiting t))
4733     (gnus-group-read-group all t)))
4734
4735 ;;;###autoload
4736 (defun gnus-fetch-group (group)
4737   "Start Gnus if necessary and enter GROUP.
4738 Returns whether the fetching was successful or not."
4739   (interactive "sGroup name: ")
4740   (or (get-buffer gnus-group-buffer)
4741       (gnus))
4742   (gnus-group-select-group))
4743
4744 ;; Enter a group that is not in the group buffer.  Non-nil is returned
4745 ;; if selection was successful.
4746 (defun gnus-group-read-ephemeral-group 
4747   (group method &optional activate quit-config)
4748   (let ((group (if (gnus-group-foreign-p group) group
4749                  (gnus-group-prefixed-name group method)))
4750         (cur (current-buffer)))
4751     (gnus-sethash 
4752      group
4753      (list t nil (list group gnus-level-default-subscribed nil nil 
4754                        (append method
4755                                (list
4756                                 (list 'quit-config 
4757                                       (if quit-config quit-config
4758                                         (cons (current-buffer) 'summary)))))))
4759      gnus-newsrc-hashtb)
4760     (set-buffer gnus-group-buffer)
4761     (or (gnus-check-server method)
4762         (error "Unable to contact server: %s" (gnus-status-message method)))
4763     (if activate (or (gnus-request-group group)
4764                      (error "Couldn't request group")))
4765     (condition-case ()
4766         (gnus-group-read-group t t group)
4767       (error nil)
4768       (quit nil))
4769     (not (equal (current-buffer) cur))))
4770   
4771 (defun gnus-group-jump-to-group (group)
4772   "Jump to newsgroup GROUP."
4773   (interactive 
4774    (list (completing-read 
4775           "Group: " gnus-active-hashtb nil 
4776           (memq gnus-select-method gnus-have-read-active-file))))
4777
4778   (if (equal group "")
4779       (error "Empty group name"))
4780
4781   (let ((b (text-property-any 
4782             (point-min) (point-max) 
4783             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4784     (if b
4785         ;; Either go to the line in the group buffer...
4786         (goto-char b)
4787       ;; ... or insert the line.
4788       (or
4789        (gnus-active group)
4790        (gnus-activate-group group)
4791        (error "%s error: %s" group (gnus-status-message group)))
4792
4793       (gnus-group-update-group group)
4794       (goto-char (text-property-any 
4795                   (point-min) (point-max)
4796                   'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
4797   ;; Adjust cursor point.
4798   (gnus-group-position-point))
4799
4800 (defun gnus-group-goto-group (group)
4801   "Goto to newsgroup GROUP."
4802   (when group
4803     (let ((b (text-property-any (point-min) (point-max) 
4804                                 'gnus-group (gnus-intern-safe
4805                                              group gnus-active-hashtb))))
4806       (and b (goto-char b)))))
4807
4808 (defun gnus-group-next-group (n)
4809   "Go to next N'th newsgroup.
4810 If N is negative, search backward instead.
4811 Returns the difference between N and the number of skips actually
4812 done."
4813   (interactive "p")
4814   (gnus-group-next-unread-group n t))
4815
4816 (defun gnus-group-next-unread-group (n &optional all level)
4817   "Go to next N'th unread newsgroup.
4818 If N is negative, search backward instead.
4819 If ALL is non-nil, choose any newsgroup, unread or not.
4820 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
4821 such group can be found, the next group with a level higher than
4822 LEVEL.
4823 Returns the difference between N and the number of skips actually
4824 made."
4825   (interactive "p")
4826   (let ((backward (< n 0))
4827         (n (abs n)))
4828     (while (and (> n 0)
4829                 (gnus-group-search-forward 
4830                  backward (or (not gnus-group-goto-unread) all) level))
4831       (setq n (1- n)))
4832     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
4833                                (if level " on this level or higher" "")))
4834     n))
4835
4836 (defun gnus-group-prev-group (n)
4837   "Go to previous N'th newsgroup.
4838 Returns the difference between N and the number of skips actually
4839 done."
4840   (interactive "p")
4841   (gnus-group-next-unread-group (- n) t))
4842
4843 (defun gnus-group-prev-unread-group (n)
4844   "Go to previous N'th unread newsgroup.
4845 Returns the difference between N and the number of skips actually
4846 done."  
4847   (interactive "p")
4848   (gnus-group-next-unread-group (- n)))
4849
4850 (defun gnus-group-next-unread-group-same-level (n)
4851   "Go to next N'th unread newsgroup on the same level.
4852 If N is negative, search backward instead.
4853 Returns the difference between N and the number of skips actually
4854 done."
4855   (interactive "p")
4856   (gnus-group-next-unread-group n t (gnus-group-group-level))
4857   (gnus-group-position-point))
4858
4859 (defun gnus-group-prev-unread-group-same-level (n)
4860   "Go to next N'th unread newsgroup on the same level.
4861 Returns the difference between N and the number of skips actually
4862 done."
4863   (interactive "p")
4864   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
4865   (gnus-group-position-point))
4866
4867 (defun gnus-group-best-unread-group (&optional exclude-group)
4868   "Go to the group with the highest level.
4869 If EXCLUDE-GROUP, do not go to that group."
4870   (interactive)
4871   (goto-char (point-min))
4872   (let ((best 100000)
4873         unread best-point)
4874     (while (setq unread (get-text-property (point) 'gnus-unread))
4875       (if (and (numberp unread) (> unread 0))
4876           (progn
4877             (if (and (< (get-text-property (point) 'gnus-level) best)
4878                      (or (not exclude-group)
4879                          (not (equal exclude-group (gnus-group-group-name)))))
4880                 (progn 
4881                   (setq best (get-text-property (point) 'gnus-level))
4882                   (setq best-point (point))))))
4883       (forward-line 1))
4884     (if best-point (goto-char best-point))
4885     (gnus-summary-position-point)
4886     (and best-point (gnus-group-group-name))))
4887
4888 (defun gnus-group-first-unread-group ()
4889   "Go to the first group with unread articles."
4890   (interactive)
4891   (prog1
4892       (let ((opoint (point))
4893             unread)
4894         (goto-char (point-min))
4895         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
4896                 (and (numberp unread)   ; Not a topic.
4897                      (not (zerop unread))) ; Has unread articles.
4898                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
4899             (point)                     ; Success.
4900           (goto-char opoint)
4901           nil))                         ; Not success.
4902     (gnus-group-position-point)))
4903
4904 (defun gnus-group-enter-server-mode ()
4905   "Jump to the server buffer."
4906   (interactive)
4907   (gnus-enter-server-buffer))
4908
4909 (defun gnus-group-make-group (name &optional method address)
4910   "Add a new newsgroup.
4911 The user will be prompted for a NAME, for a select METHOD, and an
4912 ADDRESS."
4913   (interactive
4914    (cons 
4915     (read-string "Group name: ")
4916     (let ((method
4917            (completing-read 
4918             "Method: " (append gnus-valid-select-methods gnus-server-alist)
4919             nil t)))
4920       (if (assoc method gnus-valid-select-methods)
4921           (list method
4922                 (if (memq 'prompt-address
4923                           (assoc method gnus-valid-select-methods))
4924                     (read-string "Address: ")
4925                   ""))
4926         (list method nil)))))
4927   
4928   (save-excursion
4929     (set-buffer gnus-group-buffer)
4930     (let* ((meth (and method (if address (list (intern method) address) 
4931                                method)))
4932            (nname (if method (gnus-group-prefixed-name name meth) name))
4933            info)
4934       (and (gnus-gethash nname gnus-newsrc-hashtb)
4935            (error "Group %s already exists" nname))
4936       (gnus-group-change-level 
4937        (setq info (list t nname gnus-level-default-subscribed nil nil meth))
4938        gnus-level-default-subscribed gnus-level-killed 
4939        (and (gnus-group-group-name)
4940             (gnus-gethash (gnus-group-group-name)
4941                           gnus-newsrc-hashtb))
4942        t)
4943       (gnus-set-active nname (cons 1 0))
4944       (or (gnus-ephemeral-group-p name)
4945           (gnus-dribble-enter 
4946            (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
4947       (gnus-group-insert-group-line-info nname)
4948
4949       (if (assoc method gnus-valid-select-methods)
4950           (require (intern method)))
4951       (and (gnus-check-backend-function 'request-create-group nname)
4952            (gnus-request-create-group nname))
4953       t)))
4954
4955 (defun gnus-group-delete-group (group &optional force)
4956   "Delete the current group.
4957 If FORCE (the prefix) is non-nil, all the articles in the group will
4958 be deleted.  This is \"deleted\" as in \"removed forever from the face
4959 of the Earth\".  There is no undo."
4960   (interactive 
4961    (list (gnus-group-group-name)
4962          current-prefix-arg))
4963   (or group (error "No group to rename"))
4964   (or (gnus-check-backend-function 'request-delete-group group)
4965       (error "This backend does not support group deletion"))
4966   (prog1
4967       (if (not (gnus-yes-or-no-p
4968                 (format
4969                  "Do you really want to delete %s%s? " 
4970                  group (if force " and all its contents" ""))))
4971           () ; Whew!
4972         (gnus-message 6 "Deleting group %s..." group)
4973         (if (not (gnus-request-delete-group group force))
4974             (progn
4975               (gnus-message 3 "Couldn't delete group %s" group)
4976               (ding))
4977           (gnus-message 6 "Deleting group %s...done" group)
4978           (gnus-group-goto-group group)
4979           (gnus-group-kill-group 1 t)
4980           t))
4981     (gnus-group-position-point)))
4982
4983 (defun gnus-group-rename-group (group new-name)
4984   (interactive
4985    (list
4986     (gnus-group-group-name)
4987     (progn
4988       (or (gnus-check-backend-function 
4989            'request-rename-group (gnus-group-group-name))
4990           (error "This backend does not support renaming groups"))
4991       (read-string "New group name: "))))
4992
4993   (or (gnus-check-backend-function 'request-rename-group group)
4994       (error "This backend does not support renaming groups"))
4995
4996   (or group (error "No group to rename"))
4997   (and (string-match "^[ \t]*$" new-name) 
4998        (error "Not a valid group name"))
4999
5000   ;; We find the proper prefixed name.
5001   (setq new-name
5002         (gnus-group-prefixed-name 
5003          (gnus-group-real-name new-name)
5004          (gnus-info-method (gnus-get-info group))))
5005
5006   (gnus-message 6 "Renaming group %s to %s..." group new-name)
5007   (prog1
5008       (if (not (gnus-request-rename-group group new-name))
5009           (progn
5010             (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
5011             (ding))
5012         ;; We rename the group internally by killing it...
5013         (gnus-group-goto-group group)
5014         (gnus-group-kill-group)
5015         ;; ... changing its name ...
5016         (setcar (cdr (car gnus-list-of-killed-groups))
5017                 new-name)
5018         ;; ... and then yanking it.  Magic!
5019         (gnus-group-yank-group) 
5020         (gnus-set-active new-name (gnus-active group))
5021         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
5022         new-name)
5023     (gnus-group-position-point)))
5024
5025
5026 (defun gnus-group-edit-group (group &optional part)
5027   "Edit the group on the current line."
5028   (interactive (list (gnus-group-group-name)))
5029   (let ((done-func '(lambda () 
5030                       "Exit editing mode and update the information."
5031                       (interactive)
5032                       (gnus-group-edit-group-done 'part 'group)))
5033         (part (or part 'info))
5034         (winconf (current-window-configuration))
5035         info)
5036     (or group (error "No group on current line"))
5037     (or (setq info (gnus-get-info group))
5038         (error "Killed group; can't be edited"))
5039     (set-buffer (get-buffer-create gnus-group-edit-buffer))
5040     (gnus-configure-windows 'edit-group)
5041     (gnus-add-current-to-buffer-list)
5042     (emacs-lisp-mode)
5043     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
5044     (use-local-map (copy-keymap emacs-lisp-mode-map))
5045     (local-set-key "\C-c\C-c" done-func)
5046     (make-local-variable 'gnus-prev-winconf)
5047     (setq gnus-prev-winconf winconf)
5048     ;; We modify the func to let it know what part it is editing.
5049     (setcar (cdr (nth 4 done-func)) (list 'quote part))
5050     (setcar (cdr (cdr (nth 4 done-func))) group)
5051     (erase-buffer)
5052     (insert
5053      (cond 
5054       ((eq part 'method)
5055        ";; Type `C-c C-c' after editing the select method.\n\n")
5056       ((eq part 'params)
5057        ";; Type `C-c C-c' after editing the group parameters.\n\n")
5058       ((eq part 'info)
5059        ";; Type `C-c C-c' after editing the group info.\n\n")))
5060     (insert 
5061      (pp-to-string
5062       (cond ((eq part 'method)
5063              (or (gnus-info-method info) "native"))
5064             ((eq part 'params)
5065              (gnus-info-params info))
5066             (t info)))
5067      "\n")))
5068
5069 (defun gnus-group-edit-group-method (group)
5070   "Edit the select method of GROUP."
5071   (interactive (list (gnus-group-group-name)))
5072   (gnus-group-edit-group group 'method))
5073
5074 (defun gnus-group-edit-group-parameters (group)
5075   "Edit the group parameters of GROUP."
5076   (interactive (list (gnus-group-group-name)))
5077   (gnus-group-edit-group group 'params))
5078
5079 (defun gnus-group-edit-group-done (part group)
5080   "Get info from buffer, update variables and jump to the group buffer."
5081   (set-buffer (get-buffer-create gnus-group-edit-buffer))
5082   (goto-char (point-min))
5083   (let* ((form (read (current-buffer)))
5084          (winconf gnus-prev-winconf)
5085          (new-group (when (eq part 'info)
5086                       (if (or (not (nth 4 form))
5087                               (gnus-server-equal
5088                                gnus-select-method (nth 4 form)))
5089                           (gnus-group-real-name (car form))
5090                         (gnus-group-prefixed-name
5091                          (gnus-group-real-name (car form)) (nth 4 form))))))
5092     ;; Set the info.
5093     (if (eq part 'info) 
5094         (progn
5095           (when new-group (setcar form new-group))
5096           (gnus-group-set-info form))
5097       (gnus-group-set-info form group part))
5098     (kill-buffer (current-buffer))
5099     (and winconf (set-window-configuration winconf))
5100     (set-buffer gnus-group-buffer)
5101     (when (and new-group 
5102              (not (equal new-group group)))
5103       (when (gnus-group-goto-group group)
5104         (gnus-group-kill-group 1))
5105       (gnus-activate-group new-group))
5106     (gnus-group-update-group (or new-group group))
5107     (gnus-group-position-point)))
5108
5109 (defun gnus-group-make-help-group ()
5110   "Create the Gnus documentation group."
5111   (interactive)
5112   (let ((path load-path)
5113         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
5114         file dir)
5115     (and (gnus-gethash name gnus-newsrc-hashtb)
5116          (error "Documentation group already exists"))
5117     (while path
5118       (setq dir (file-name-as-directory (expand-file-name (pop path)))
5119             file nil)
5120       (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
5121                 (file-exists-p
5122                  (setq file (concat (file-name-directory 
5123                                      (directory-file-name dir))
5124                                     "etc/gnus-tut.txt"))))
5125         (setq path nil)))
5126     (if (not file)
5127         (message "Couldn't find doc group")
5128       (gnus-group-make-group 
5129        (gnus-group-real-name name)
5130        (list 'nndoc name
5131              (list 'nndoc-address file)
5132              (list 'nndoc-article-type 'mbox)))))
5133   (gnus-group-position-point))
5134
5135 (defun gnus-group-make-doc-group (file type)
5136   "Create a group that uses a single file as the source."
5137   (interactive 
5138    (list (read-file-name "File name: ") 
5139          (and current-prefix-arg 'ask)))
5140   (when (eq type 'ask)
5141     (let ((err "")
5142           char found)
5143       (while (not found)
5144         (message 
5145          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5146          err)
5147         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5148                           ((= char ?b) 'babyl)
5149                           ((= char ?d) 'digest)
5150                           ((= char ?f) 'forward)
5151                           ((= char ?a) 'mmfd)
5152                           (t (setq err (format "%c unknown. " char))
5153                              nil))))
5154       (setq type found)))
5155   (let* ((file (expand-file-name file))
5156          (name (gnus-generate-new-group-name
5157                 (gnus-group-prefixed-name
5158                  (file-name-nondirectory file) '(nndoc "")))))
5159     (gnus-group-make-group 
5160      (gnus-group-real-name name)
5161      (list 'nndoc name
5162            (list 'nndoc-address file)
5163            (list 'nndoc-article-type (or type 'guess))))
5164     (forward-line -1)
5165     (gnus-group-position-point)))
5166
5167 (defun gnus-group-make-archive-group (&optional all)
5168   "Create the (ding) Gnus archive group of the most recent articles.
5169 Given a prefix, create a full group."
5170   (interactive "P")
5171   (let ((group (gnus-group-prefixed-name 
5172                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5173     (and (gnus-gethash group gnus-newsrc-hashtb)
5174          (error "Archive group already exists"))
5175     (gnus-group-make-group
5176      (gnus-group-real-name group)
5177      (list 'nndir (if all "hpc" "edu")
5178            (list 'nndir-directory  
5179                  (if all gnus-group-archive-directory 
5180                    gnus-group-recent-archive-directory)))))
5181   (forward-line -1)
5182   (gnus-group-position-point))
5183
5184 (defun gnus-group-make-directory-group (dir)
5185   "Create an nndir group.
5186 The user will be prompted for a directory.  The contents of this
5187 directory will be used as a newsgroup.  The directory should contain
5188 mail messages or news articles in files that have numeric names."
5189   (interactive
5190    (list (read-file-name "Create group from directory: ")))
5191   (or (file-exists-p dir) (error "No such directory"))
5192   (or (file-directory-p dir) (error "Not a directory"))
5193   (let ((ext "")
5194         (i 0)
5195         group)
5196     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5197       (setq group
5198             (gnus-group-prefixed-name 
5199              (concat (file-name-as-directory (directory-file-name dir))
5200                      ext)
5201              '(nndir "")))
5202       (setq ext (format "<%d>" (setq i (1+ i)))))
5203     (gnus-group-make-group 
5204      (gnus-group-real-name group)
5205      (list 'nndir group (list 'nndir-directory dir))))
5206   (forward-line -1)
5207   (gnus-group-position-point))
5208
5209 (defun gnus-group-make-kiboze-group (group address scores)
5210   "Create an nnkiboze group.
5211 The user will be prompted for a name, a regexp to match groups, and
5212 score file entries for articles to include in the group."
5213   (interactive
5214    (list
5215     (read-string "nnkiboze group name: ")
5216     (read-string "Source groups (regexp): ")
5217     (let ((headers (mapcar (lambda (group) (list group))
5218                            '("subject" "from" "number" "date" "message-id"
5219                              "references" "chars" "lines" "xref"
5220                              "followup" "all" "body" "head")))
5221           scores header regexp regexps)
5222       (while (not (equal "" (setq header (completing-read 
5223                                           "Match on header: " headers nil t))))
5224         (setq regexps nil)
5225         (while (not (equal "" (setq regexp (read-string 
5226                                             (format "Match on %s (string): "
5227                                                     header)))))
5228           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5229         (setq scores (cons (cons header regexps) scores)))
5230       scores)))
5231   (gnus-group-make-group group "nnkiboze" address)
5232   (save-excursion
5233     (gnus-set-work-buffer)
5234     (let (emacs-lisp-mode-hook)
5235       (pp scores (current-buffer)))
5236     (write-region (point-min) (point-max) 
5237                   (gnus-score-file-name (concat "nnkiboze:" group))))
5238   (forward-line -1)
5239   (gnus-group-position-point))
5240
5241 (defun gnus-group-add-to-virtual (n vgroup)
5242   "Add the current group to a virtual group."
5243   (interactive
5244    (list current-prefix-arg
5245          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5246                           "nnvirtual:")))
5247   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5248       (error "%s is not an nnvirtual group" vgroup))
5249   (let* ((groups (gnus-group-process-prefix n))
5250          (method (gnus-info-method (gnus-get-info vgroup))))
5251     (setcar (cdr method)
5252             (concat 
5253              (nth 1 method) "\\|"
5254              (mapconcat 
5255               (lambda (s) 
5256                 (gnus-group-remove-mark s)
5257                 (concat "\\(^" (regexp-quote s) "$\\)"))
5258               groups "\\|"))))
5259   (gnus-group-position-point))
5260
5261 (defun gnus-group-make-empty-virtual (group)
5262   "Create a new, fresh, empty virtual group."
5263   (interactive "sCreate new, empty virtual group: ")
5264   (let* ((method (list 'nnvirtual "^$"))
5265          (pgroup (gnus-group-prefixed-name group method)))
5266     ;; Check whether it exists already.
5267     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
5268          (error "Group %s already exists." pgroup))
5269     ;; Subscribe the new group after the group on the current line.
5270     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
5271     (gnus-group-update-group pgroup)
5272     (forward-line -1)
5273     (gnus-group-position-point)))
5274
5275 (defun gnus-group-enter-directory (dir)
5276   "Enter an ephemeral nneething group."
5277   (interactive "DDirectory to read: ")
5278   (let* ((method (list 'nneething dir))
5279          (leaf (gnus-group-prefixed-name
5280                 (file-name-nondirectory (directory-file-name dir))
5281                 method))
5282          (name (gnus-generate-new-group-name leaf)))
5283     (let ((nneething-read-only t))
5284       (or (gnus-group-read-ephemeral-group 
5285            name method t
5286            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
5287                                       'summary 'group)))
5288           (error "Couldn't enter %s" dir)))))
5289
5290 ;; Group sorting commands
5291 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
5292
5293 (defun gnus-group-sort-groups (func &optional reverse)
5294   "Sort the group buffer according to FUNC.
5295 If REVERSE, reverse the sorting order."
5296   (interactive (list gnus-group-sort-function
5297                      current-prefix-arg))
5298   (unless (listp func)
5299     (setq func (list func)))
5300   ;; We peel off the dummy group from the alist.
5301   (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
5302     (pop gnus-newsrc-alist))
5303   ;; Do the sorting.
5304   (while func
5305     (setq gnus-newsrc-alist 
5306           (sort gnus-newsrc-alist (pop func))))
5307   (when reverse
5308     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
5309   ;; Regenerate the hash table.
5310   (gnus-make-hashtable-from-newsrc-alist)
5311   (gnus-group-list-groups))
5312
5313 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
5314   "Sort the group buffer alphabetically by group name.
5315 If REVERSE, sort in reverse order."
5316   (interactive "P")
5317   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
5318
5319 (defun gnus-group-sort-groups-by-unread (&optional reverse)
5320   "Sort the group buffer by number of unread articles.
5321 If REVERSE, sort in reverse order."
5322   (interactive "P")
5323   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
5324
5325 (defun gnus-group-sort-groups-by-level (&optional reverse)
5326   "Sort the group buffer by group level.
5327 If REVERSE, sort in reverse order."
5328   (interactive "P")
5329   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
5330
5331 (defun gnus-group-sort-groups-by-score (&optional reverse)
5332   "Sort the group buffer by group score.
5333 If REVERSE, sort in reverse order."
5334   (interactive "P")
5335   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
5336
5337 (defun gnus-group-sort-groups-by-rank (&optional reverse)
5338   "Sort the group buffer by group rank.
5339 If REVERSE, sort in reverse order."
5340   (interactive "P")
5341   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
5342
5343 (defun gnus-group-sort-groups-by-method (&optional reverse)
5344   "Sort the group buffer alphabetically by backend name.
5345 If REVERSE, sort in reverse order."
5346   (interactive "P")
5347   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
5348
5349 (defun gnus-group-sort-by-alphabet (info1 info2)
5350   "Sort alphabetically."
5351   (string< (gnus-info-group info1) (gnus-info-group info2)))
5352
5353 (defun gnus-group-sort-by-unread (info1 info2)
5354   "Sort by number of unread articles."
5355   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
5356         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
5357     (< (or (and (numberp n1) n1) 0)
5358        (or (and (numberp n2) n2) 0))))
5359
5360 (defun gnus-group-sort-by-level (info1 info2)
5361   "Sort by level."
5362   (< (gnus-info-level info1) (gnus-info-level info2)))
5363
5364 (defun gnus-group-sort-by-method (info1 info2)
5365   "Sort alphabetically by backend name."
5366   (string< (symbol-name (car (gnus-find-method-for-group
5367                               (gnus-info-group info1) info1)))
5368            (symbol-name (car (gnus-find-method-for-group 
5369                               (gnus-info-group info2) info2)))))
5370
5371 (defun gnus-group-sort-by-score (info1 info2)
5372   "Sort by group score."
5373   (< (gnus-info-score info1) (gnus-info-score info2)))
5374
5375 (defun gnus-group-sort-by-rank (info1 info2)
5376   "Sort by level and score."
5377   (let ((level1 (gnus-info-level info1))
5378         (level2 (gnus-info-level info2)))
5379     (or (< level1 level2)
5380         (and (= level1 level2)
5381              (< (gnus-info-score info1) (gnus-info-score info2))))))
5382
5383 ;; Group catching up.
5384
5385 (defun gnus-group-catchup-current (&optional n all)
5386   "Mark all articles not marked as unread in current newsgroup as read.
5387 If prefix argument N is numeric, the ARG next newsgroups will be
5388 caught up.  If ALL is non-nil, marked articles will also be marked as
5389 read.  Cross references (Xref: header) of articles are ignored.
5390 The difference between N and actual number of newsgroups that were
5391 caught up is returned."
5392   (interactive "P")
5393   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
5394                gnus-expert-user
5395                (gnus-y-or-n-p
5396                 (if all
5397                     "Do you really want to mark all articles as read? "
5398                   "Mark all unread articles as read? "))))
5399       n
5400     (let ((groups (gnus-group-process-prefix n))
5401           (ret 0))
5402       (while groups
5403         ;; Virtual groups have to be given special treatment. 
5404         (let ((method (gnus-find-method-for-group (car groups))))
5405           (if (eq 'nnvirtual (car method))
5406               (nnvirtual-catchup-group
5407                (gnus-group-real-name (car groups)) (nth 1 method) all)))
5408         (gnus-group-remove-mark (car groups))
5409         (if (prog1
5410                 (gnus-group-goto-group (car groups))
5411               (gnus-group-catchup (car groups) all))
5412             (gnus-group-update-group-line)
5413           (setq ret (1+ ret)))
5414         (setq groups (cdr groups)))
5415       (gnus-group-next-unread-group 1)
5416       ret)))
5417
5418 (defun gnus-group-catchup-current-all (&optional n)
5419   "Mark all articles in current newsgroup as read.
5420 Cross references (Xref: header) of articles are ignored."
5421   (interactive "P")
5422   (gnus-group-catchup-current n 'all))
5423
5424 (defun gnus-group-catchup (group &optional all)
5425   "Mark all articles in GROUP as read.
5426 If ALL is non-nil, all articles are marked as read.
5427 The return value is the number of articles that were marked as read,
5428 or nil if no action could be taken."
5429   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
5430          (num (car entry))
5431          (marked (nth 3 (nth 2 entry))))
5432     (if (not (numberp (car entry)))
5433         (gnus-message 1 "Can't catch up; non-active group")
5434       ;; Do the updating only if the newsgroup isn't killed.
5435       (when entry
5436         (gnus-update-read-articles group nil)
5437         ;; Also nix out the lists of marks and dormants. 
5438         (when all 
5439           (gnus-add-marked-articles group 'tick nil nil 'force)
5440           (gnus-add-marked-articles group 'dormant nil nil 'force))
5441         num))))
5442
5443 (defun gnus-group-expire-articles (&optional n)
5444   "Expire all expirable articles in the current newsgroup."
5445   (interactive "P")
5446   (let ((groups (gnus-group-process-prefix n))
5447         group)
5448     (unless groups
5449       (error "No groups to expire"))
5450     (while groups
5451       (setq group (pop groups))
5452       (gnus-group-remove-mark group)
5453       (when (gnus-check-backend-function 'request-expire-articles group)
5454         (let* ((info (gnus-get-info group))
5455                (expirable (if (gnus-group-total-expirable-p group)
5456                               (cons nil (gnus-list-of-read-articles group))
5457                             (assq 'expire (gnus-info-marks info))))
5458                (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
5459           (when expirable 
5460             (setcdr expirable
5461                     (gnus-compress-sequence
5462                      (if expiry-wait
5463                          (let ((nnmail-expiry-wait-function nil)
5464                                (nnmail-expiry-wait expiry-wait))
5465                            (gnus-request-expire-articles 
5466                             (gnus-uncompress-sequence (cdr expirable)) group))
5467                        (gnus-request-expire-articles 
5468                         (gnus-uncompress-sequence (cdr expirable))
5469                         group))))))))))
5470
5471 (defun gnus-group-expire-all-groups ()
5472   "Expire all expirable articles in all newsgroups."
5473   (interactive)
5474   (save-excursion
5475     (gnus-message 5 "Expiring...")
5476     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
5477                                      (cdr gnus-newsrc-alist))))
5478       (gnus-group-expire-articles nil)))
5479   (gnus-group-position-point)
5480   (gnus-message 5 "Expiring...done"))
5481
5482 (defun gnus-group-set-current-level (n level)
5483   "Set the level of the next N groups to LEVEL."
5484   (interactive 
5485    (list
5486     current-prefix-arg
5487     (string-to-int
5488      (let ((s (read-string 
5489                (format "Level (default %s): " (gnus-group-group-level)))))
5490        (if (string-match "^\\s-*$" s)
5491            (int-to-string (gnus-group-group-level))
5492          s)))))
5493   (or (and (>= level 1) (<= level gnus-level-killed))
5494       (error "Illegal level: %d" level))
5495   (let ((groups (gnus-group-process-prefix n))
5496         group)
5497     (while groups
5498       (setq group (car groups)
5499             groups (cdr groups))
5500       (gnus-group-remove-mark group)
5501       (gnus-message 6 "Changed level of %s from %d to %d" 
5502                     group (gnus-group-group-level) level)
5503       (gnus-group-change-level group level
5504                                (gnus-group-group-level))
5505       (gnus-group-update-group-line)))
5506   (gnus-group-position-point))
5507
5508 (defun gnus-group-unsubscribe-current-group (&optional n)
5509   "Toggle subscription of the current group.
5510 If given numerical prefix, toggle the N next groups."
5511   (interactive "P")
5512   (let ((groups (gnus-group-process-prefix n))
5513         group)
5514     (while groups
5515       (setq group (car groups)
5516             groups (cdr groups))
5517       (gnus-group-remove-mark group)
5518       (gnus-group-unsubscribe-group
5519        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
5520                  gnus-level-default-unsubscribed
5521                gnus-level-default-subscribed) t)
5522       (gnus-group-update-group-line))
5523     (gnus-group-next-group 1)))
5524
5525 (defun gnus-group-unsubscribe-group (group &optional level silent)
5526   "Toggle subscription to GROUP.
5527 Killed newsgroups are subscribed.  If SILENT, don't try to update the
5528 group line."
5529   (interactive
5530    (list (completing-read
5531           "Group: " gnus-active-hashtb nil 
5532           (memq gnus-select-method gnus-have-read-active-file))))
5533   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
5534     (cond
5535      ((string-match "^[ \t]$" group)
5536       (error "Empty group name"))
5537      (newsrc
5538       ;; Toggle subscription flag.
5539       (gnus-group-change-level 
5540        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) 
5541                                       gnus-level-subscribed) 
5542                                   (1+ gnus-level-subscribed)
5543                                 gnus-level-default-subscribed)))
5544       (unless silent
5545         (gnus-group-update-group group)))
5546      ((and (stringp group)
5547            (or (not (memq gnus-select-method gnus-have-read-active-file))
5548                (gnus-active group)))
5549       ;; Add new newsgroup.
5550       (gnus-group-change-level 
5551        group 
5552        (if level level gnus-level-default-subscribed) 
5553        (or (and (member group gnus-zombie-list) 
5554                 gnus-level-zombie) 
5555            gnus-level-killed)
5556        (and (gnus-group-group-name)
5557             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
5558       (unless silent
5559         (gnus-group-update-group group)))
5560      (t (error "No such newsgroup: %s" group)))
5561     (gnus-group-position-point)))
5562
5563 (defun gnus-group-transpose-groups (n)
5564   "Move the current newsgroup up N places.
5565 If given a negative prefix, move down instead.  The difference between
5566 N and the number of steps taken is returned." 
5567   (interactive "p")
5568   (or (gnus-group-group-name)
5569       (error "No group on current line"))
5570   (gnus-group-kill-group 1)
5571   (prog1
5572       (forward-line (- n))
5573     (gnus-group-yank-group)
5574     (gnus-group-position-point)))
5575
5576 (defun gnus-group-kill-all-zombies ()
5577   "Kill all zombie newsgroups."
5578   (interactive)
5579   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
5580   (setq gnus-zombie-list nil)
5581   (gnus-group-list-groups))
5582
5583 (defun gnus-group-kill-region (begin end)
5584   "Kill newsgroups in current region (excluding current point).
5585 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
5586   (interactive "r")
5587   (let ((lines
5588          ;; Count lines.
5589          (save-excursion
5590            (count-lines
5591             (progn
5592               (goto-char begin)
5593               (beginning-of-line)
5594               (point))
5595             (progn
5596               (goto-char end)
5597               (beginning-of-line)
5598               (point))))))
5599     (goto-char begin)
5600     (beginning-of-line)                 ;Important when LINES < 1
5601     (gnus-group-kill-group lines)))
5602
5603 (defun gnus-group-kill-group (&optional n discard)
5604   "Kill the next N groups.
5605 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
5606 However, only groups that were alive can be yanked; already killed 
5607 groups or zombie groups can't be yanked.
5608 The return value is the name of the group that was killed, or a list
5609 of groups killed."
5610   (interactive "P")
5611   (let ((buffer-read-only nil)
5612         (groups (gnus-group-process-prefix n))
5613         group entry level out)
5614     (if (< (length groups) 10)
5615         ;; This is faster when there are few groups.
5616         (while groups
5617           (push (setq group (pop groups)) out)
5618           (gnus-group-remove-mark group)
5619           (setq level (gnus-group-group-level))
5620           (gnus-delete-line)
5621           (if (and (not discard)
5622                    (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
5623               (setq gnus-list-of-killed-groups 
5624                     (cons (cons (car entry) (nth 2 entry)) 
5625                           gnus-list-of-killed-groups)))
5626           (gnus-group-change-level 
5627            (if entry entry group) gnus-level-killed (if entry nil level)))
5628       ;; If there are lots and lots of groups to be killed, we use
5629       ;; this thing instead.
5630       (let (entry)
5631         (setq groups (nreverse groups))
5632         (while groups
5633           (gnus-group-remove-mark (car groups))
5634           (gnus-delete-line)
5635           (setq entry (gnus-gethash (pop groups) gnus-newsrc-hashtb))
5636           (push (cons (car entry) (nth 2 entry))
5637                 gnus-list-of-killed-groups)
5638           (setcdr (cdr entry) (cdr (cdr (cdr entry)))))
5639         (gnus-make-hashtable-from-newsrc-alist)))
5640     
5641     (gnus-group-position-point)
5642     (if (< (length out) 2) (car out) (nreverse out))))
5643
5644 (defun gnus-group-yank-group (&optional arg)
5645   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
5646 inserting it before the current newsgroup.  The numeric ARG specifies
5647 how many newsgroups are to be yanked.  The name of the newsgroup yanked
5648 is returned, or (if several groups are yanked) a list of yanked groups
5649 is returned."
5650   (interactive "p")
5651   (setq arg (or arg 1))
5652   (let (info group prev out)
5653     (while (>= (decf arg) 0)
5654       (if (not (setq info (pop gnus-list-of-killed-groups)))
5655           (error "No more newsgroups to yank"))
5656       (push (setq group (nth 1 info)) out)
5657       ;; Find which newsgroup to insert this one before - search
5658       ;; backward until something suitable is found.  If there are no
5659       ;; other newsgroups in this buffer, just make this newsgroup the
5660       ;; first newsgroup.
5661       (setq prev (gnus-group-group-name))
5662       (gnus-group-change-level 
5663        info (nth 2 info) gnus-level-killed 
5664        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
5665        t)
5666       (gnus-group-insert-group-line-info group))
5667     (forward-line -1)
5668     (gnus-group-position-point)
5669     (if (< (length out) 2) (car out) (nreverse out))))
5670
5671 (defun gnus-group-kill-level (level)
5672   "Kill all groups that is on a certain LEVEL."
5673   (interactive "nKill all groups on level: ")
5674   (cond 
5675    ((= level gnus-level-zombie)
5676     (setq gnus-killed-list
5677           (nconc gnus-zombie-list gnus-killed-list))
5678     (setq gnus-zombie-list nil))
5679    ((and (< level gnus-level-zombie)
5680          (> level 0)
5681          (or gnus-expert-user
5682              (gnus-yes-or-no-p
5683               (format 
5684                "Do you really want to kill all groups on level %d? "
5685                level))))
5686     (let* ((prev gnus-newsrc-alist)
5687            (alist (cdr prev)))
5688       (while alist
5689         (if (= (gnus-info-level level) level)
5690             (setcdr prev (cdr alist))
5691           (setq prev alist))
5692         (setq alist (cdr alist)))
5693       (gnus-make-hashtable-from-newsrc-alist)
5694       (gnus-group-list-groups)))
5695    (t
5696     (error "Can't kill; illegal level: %d" level))))
5697       
5698 (defun gnus-group-list-all-groups (&optional arg)
5699   "List all newsgroups with level ARG or lower.
5700 Default is gnus-level-unsubscribed, which lists all subscribed and most
5701 unsubscribed groups."
5702   (interactive "P")
5703   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
5704
5705 ;; Redefine this to list ALL killed groups if prefix arg used.
5706 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
5707 (defun gnus-group-list-killed (&optional arg)
5708   "List all killed newsgroups in the group buffer.
5709 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
5710 entail asking the server for the groups."
5711   (interactive "P")
5712   ;; Find all possible killed newsgroups if arg.
5713   (when arg
5714     ;; First make sure active file has been read.
5715     (unless gnus-have-read-active-file
5716       (let ((gnus-read-active-file t))
5717         (gnus-read-active-file)))
5718     (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
5719     ;; Go through all newsgroups that are known to Gnus - enlarge kill list
5720     (mapatoms
5721      (lambda (sym)
5722        (let ((groups 0)
5723              (group (symbol-name sym)))
5724          (if (or (null group)
5725                  (gnus-gethash group gnus-killed-hashtb)
5726                  (gnus-gethash group gnus-newsrc-hashtb))
5727              ()
5728            (let ((do-sub (gnus-matches-options-n group)))
5729              (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
5730                  ()
5731                (setq groups (1+ groups))
5732                (setq gnus-killed-list 
5733                      (cons group gnus-killed-list))
5734                (gnus-sethash group group gnus-killed-hashtb))))))
5735      gnus-active-hashtb))
5736   (if (not gnus-killed-list)
5737       (gnus-message 6 "No killed groups")
5738     (let (gnus-group-list-mode)
5739       (funcall gnus-group-prepare-function 
5740                gnus-level-killed t gnus-level-killed))
5741     (goto-char (point-min)))
5742   (gnus-group-position-point))
5743
5744 (defun gnus-group-list-zombies ()
5745   "List all zombie newsgroups in the group buffer."
5746   (interactive)
5747   (if (not gnus-zombie-list)
5748       (gnus-message 6 "No zombie groups")
5749     (let (gnus-group-list-mode)
5750       (funcall gnus-group-prepare-function
5751                gnus-level-zombie t gnus-level-zombie))
5752     (goto-char (point-min)))
5753   (gnus-group-position-point))
5754
5755 (defun gnus-group-list-active ()
5756   "List all groups that are available from the server(s)."
5757   (interactive)
5758   ;; First we make sure that we have really read the active file. 
5759   (unless gnus-have-read-active-file
5760     (let ((gnus-read-active-file t))
5761       (gnus-read-active-file)))
5762   ;; Find all groups and sort them.
5763   (let ((groups 
5764          (sort 
5765           (let (list)
5766             (mapatoms
5767              (lambda (sym)
5768                (and (symbol-value sym)
5769                     (setq list (cons (symbol-name sym) list))))
5770              gnus-active-hashtb)
5771             list)
5772           'string<))
5773         (buffer-read-only nil))
5774     (erase-buffer)
5775     (while groups
5776       (gnus-group-insert-group-line-info (car groups))
5777       (setq groups (cdr groups)))
5778     (goto-char (point-min))))
5779
5780 (defun gnus-activate-all-groups (level)
5781   "Activate absolutely all groups."
5782   (interactive (list 7))
5783   (let ((gnus-activate-level level)
5784         (gnus-activate-foreign-newsgroups level))
5785     (gnus-group-get-new-news)))
5786
5787 (defun gnus-group-get-new-news (&optional arg)
5788   "Get newly arrived articles.
5789 If ARG is a number, it specifies which levels you are interested in
5790 re-scanning.  If ARG is non-nil and not a number, this will force
5791 \"hard\" re-reading of the active files from all servers."
5792   (interactive "P")
5793   (run-hooks 'gnus-get-new-news-hook)
5794   ;; We might read in new NoCeM messages here.
5795   (and gnus-use-nocem (gnus-nocem-scan-groups))
5796   ;; If ARG is not a number, then we read the active file.
5797   (and arg
5798        (not (numberp arg))
5799        (progn
5800          (let ((gnus-read-active-file t))
5801            (gnus-read-active-file))
5802          (setq arg nil)))
5803
5804   (setq arg (gnus-group-default-level arg t))
5805   (if (and gnus-read-active-file (not arg))
5806       (progn
5807         (gnus-read-active-file)
5808         (gnus-get-unread-articles arg))
5809     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
5810       (gnus-get-unread-articles arg)))
5811   (gnus-group-list-groups))
5812
5813 (defun gnus-group-get-new-news-this-group (&optional n)
5814   "Check for newly arrived news in the current group (and the N-1 next groups).
5815 The difference between N and the number of newsgroup checked is returned.
5816 If N is negative, this group and the N-1 previous groups will be checked."
5817   (interactive "P")
5818   (let* ((groups (gnus-group-process-prefix n))
5819          (ret (if (numberp n) (- n (length groups)) 0))
5820          group)
5821     (while groups
5822       (setq group (car groups)
5823             groups (cdr groups))
5824       (gnus-group-remove-mark group)
5825       (or (gnus-get-new-news-in-group group)
5826           (progn 
5827             (ding) 
5828             (message "%s error: %s" group (gnus-status-message group))
5829             (sit-for 2))))
5830     (gnus-group-next-unread-group 1 t)
5831     (gnus-summary-position-point)
5832     ret))
5833
5834 (defun gnus-get-new-news-in-group (group)
5835   (when (and group (gnus-activate-group group 'scan))
5836     (gnus-get-unread-articles-in-group 
5837      (gnus-get-info group) (gnus-active group))
5838     (when (gnus-group-goto-group group)
5839       (gnus-group-update-group-line))
5840     t))
5841
5842 (defun gnus-group-fetch-faq (group &optional faq-dir)
5843   "Fetch the FAQ for the current group."
5844   (interactive 
5845    (list
5846     (gnus-group-real-name (gnus-group-group-name))
5847     (cond (current-prefix-arg
5848            (completing-read 
5849             "Faq dir: " (and (listp gnus-group-faq-directory) 
5850                              gnus-group-faq-directory))))))
5851   (or faq-dir
5852       (setq faq-dir (if (listp gnus-group-faq-directory)
5853                         (car gnus-group-faq-directory)
5854                       gnus-group-faq-directory)))
5855   (or group (error "No group name given"))
5856   (let ((file (concat (file-name-as-directory faq-dir)
5857                       (gnus-group-real-name group))))
5858     (if (not (file-exists-p file))
5859         (error "No such file: %s" file)
5860       (find-file file))))
5861   
5862 (defun gnus-group-describe-group (force &optional group)
5863   "Display a description of the current newsgroup."
5864   (interactive (list current-prefix-arg (gnus-group-group-name)))
5865   (and force (setq gnus-description-hashtb nil))
5866   (let ((method (gnus-find-method-for-group group))
5867         desc)
5868     (or group (error "No group name given"))
5869     (and (or (and gnus-description-hashtb
5870                   ;; We check whether this group's method has been
5871                   ;; queried for a description file.  
5872                   (gnus-gethash 
5873                    (gnus-group-prefixed-name "" method) 
5874                    gnus-description-hashtb))
5875              (setq desc (gnus-group-get-description group))
5876              (gnus-read-descriptions-file method))
5877          (message
5878           (or desc (gnus-gethash group gnus-description-hashtb)
5879               "No description available")))))
5880
5881 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
5882 (defun gnus-group-describe-all-groups (&optional force)
5883   "Pop up a buffer with descriptions of all newsgroups."
5884   (interactive "P")
5885   (and force (setq gnus-description-hashtb nil))
5886   (if (not (or gnus-description-hashtb
5887                (gnus-read-all-descriptions-files)))
5888       (error "Couldn't request descriptions file"))
5889   (let ((buffer-read-only nil)
5890         b)
5891     (erase-buffer)
5892     (mapatoms
5893      (lambda (group)
5894        (setq b (point))
5895        (insert (format "      *: %-20s %s\n" (symbol-name group)
5896                        (symbol-value group)))
5897        (add-text-properties 
5898         b (1+ b) (list 'gnus-group group
5899                        'gnus-unread t 'gnus-marked nil
5900                        'gnus-level (1+ gnus-level-subscribed))))
5901      gnus-description-hashtb)
5902     (goto-char (point-min))
5903     (gnus-group-position-point)))
5904
5905 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
5906 (defun gnus-group-apropos (regexp &optional search-description)
5907   "List all newsgroups that have names that match a regexp."
5908   (interactive "sGnus apropos (regexp): ")
5909   (let ((prev "")
5910         (obuf (current-buffer))
5911         groups des)
5912     ;; Go through all newsgroups that are known to Gnus.
5913     (mapatoms 
5914      (lambda (group)
5915        (and (symbol-name group)
5916             (string-match regexp (symbol-name group))
5917             (setq groups (cons (symbol-name group) groups))))
5918      gnus-active-hashtb)
5919     ;; Go through all descriptions that are known to Gnus. 
5920     (if search-description
5921         (mapatoms 
5922          (lambda (group)
5923            (and (string-match regexp (symbol-value group))
5924                 (gnus-active (symbol-name group))
5925                 (setq groups (cons (symbol-name group) groups))))
5926          gnus-description-hashtb))
5927     (if (not groups)
5928         (gnus-message 3 "No groups matched \"%s\"." regexp)
5929       ;; Print out all the groups.
5930       (save-excursion
5931         (pop-to-buffer "*Gnus Help*")
5932         (buffer-disable-undo (current-buffer))
5933         (erase-buffer)
5934         (setq groups (sort groups 'string<))
5935         (while groups
5936           ;; Groups may be entered twice into the list of groups.
5937           (if (not (string= (car groups) prev))
5938               (progn
5939                 (insert (setq prev (car groups)) "\n")
5940                 (if (and gnus-description-hashtb
5941                          (setq des (gnus-gethash (car groups) 
5942                                                  gnus-description-hashtb)))
5943                     (insert "  " des "\n"))))
5944           (setq groups (cdr groups)))
5945         (goto-char (point-min))))
5946     (pop-to-buffer obuf)))
5947
5948 (defun gnus-group-description-apropos (regexp)
5949   "List all newsgroups that have names or descriptions that match a regexp."
5950   (interactive "sGnus description apropos (regexp): ")
5951   (if (not (or gnus-description-hashtb
5952                (gnus-read-all-descriptions-files)))
5953       (error "Couldn't request descriptions file"))
5954   (gnus-group-apropos regexp t))
5955
5956 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
5957 (defun gnus-group-list-matching (level regexp &optional all lowest) 
5958   "List all groups with unread articles that match REGEXP.
5959 If the prefix LEVEL is non-nil, it should be a number that says which
5960 level to cut off listing groups. 
5961 If ALL, also list groups with no unread articles.
5962 If LOWEST, don't list groups with level lower than LOWEST."
5963   (interactive "P\nsList newsgroups matching: ")
5964   (gnus-group-prepare-flat (or level gnus-level-subscribed)
5965                            all (or lowest 1) regexp)
5966   (goto-char (point-min))
5967   (gnus-group-position-point))
5968
5969 (defun gnus-group-list-all-matching (level regexp &optional lowest) 
5970   "List all groups that match REGEXP.
5971 If the prefix LEVEL is non-nil, it should be a number that says which
5972 level to cut off listing groups. 
5973 If LOWEST, don't list groups with level lower than LOWEST."
5974   (interactive "P\nsList newsgroups matching: ")
5975   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
5976
5977 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
5978 (defun gnus-group-save-newsrc (&optional force)
5979   "Save the Gnus startup files.
5980 If FORCE, force saving whether it is necessary or not."
5981   (interactive "P")
5982   (gnus-save-newsrc-file force))
5983
5984 (defun gnus-group-restart (&optional arg)
5985   "Force Gnus to read the .newsrc file."
5986   (interactive "P")
5987   (gnus-save-newsrc-file)
5988   (gnus-setup-news 'force)
5989   (gnus-group-list-groups arg))
5990
5991 (defun gnus-group-read-init-file ()
5992   "Read the Gnus elisp init file."
5993   (interactive)
5994   (gnus-read-init-file))
5995
5996 (defun gnus-group-check-bogus-groups (&optional silent)
5997   "Check bogus newsgroups.
5998 If given a prefix, don't ask for confirmation before removing a bogus
5999 group."
6000   (interactive "P")
6001   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
6002   (gnus-group-list-groups))
6003
6004 (defun gnus-group-edit-global-kill (&optional article group)
6005   "Edit the global kill file.
6006 If GROUP, edit that local kill file instead."
6007   (interactive "P")
6008   (setq gnus-current-kill-article article)
6009   (gnus-kill-file-edit-file group)
6010   (gnus-message 
6011    6
6012    (substitute-command-keys
6013     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
6014             (if group "local" "global")))))
6015
6016 (defun gnus-group-edit-local-kill (article group)
6017   "Edit a local kill file."
6018   (interactive (list nil (gnus-group-group-name)))
6019   (gnus-group-edit-global-kill article group))
6020
6021 (defun gnus-group-force-update ()
6022   "Update `.newsrc' file."
6023   (interactive)
6024   (gnus-save-newsrc-file))
6025
6026 (defun gnus-group-suspend ()
6027   "Suspend the current Gnus session.
6028 In fact, cleanup buffers except for group mode buffer.
6029 The hook gnus-suspend-gnus-hook is called before actually suspending."
6030   (interactive)
6031   (run-hooks 'gnus-suspend-gnus-hook)
6032   ;; Kill Gnus buffers except for group mode buffer.
6033   (let ((group-buf (get-buffer gnus-group-buffer)))
6034     ;; Do this on a separate list in case the user does a ^G before we finish
6035     (let ((gnus-buffer-list
6036            (delq group-buf (delq gnus-dribble-buffer
6037                                  (append gnus-buffer-list nil)))))
6038       (while gnus-buffer-list
6039         (gnus-kill-buffer (car gnus-buffer-list))
6040         (setq gnus-buffer-list (cdr gnus-buffer-list))))
6041     (if group-buf
6042         (progn
6043           (setq gnus-buffer-list (list group-buf))
6044           (bury-buffer group-buf)
6045           (delete-windows-on group-buf t)))))
6046
6047 (defun gnus-group-clear-dribble ()
6048   "Clear all information from the dribble buffer."
6049   (interactive)
6050   (gnus-dribble-clear)
6051   (gnus-message 7 "Cleared dribble buffer"))
6052
6053 (defun gnus-group-exit ()
6054   "Quit reading news after updating .newsrc.eld and .newsrc.
6055 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6056   (interactive)
6057   (if (or noninteractive                ;For gnus-batch-kill
6058           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
6059           (not gnus-interactive-exit)   ;Without confirmation
6060           gnus-expert-user
6061           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
6062       (progn
6063         (run-hooks 'gnus-exit-gnus-hook)
6064         ;; Offer to save data from non-quitted summary buffers.
6065         (gnus-offer-save-summaries)
6066         ;; Save the newsrc file(s).
6067         (gnus-save-newsrc-file)
6068         ;; Kill-em-all.
6069         (gnus-close-backends)
6070         ;; Shut down the cache.
6071         (when gnus-use-cache
6072           (gnus-cache-open))
6073         ;; Reset everything.
6074         (gnus-clear-system))))
6075
6076 (defun gnus-close-backends ()
6077   ;; Send a close request to all backends that support such a request. 
6078   (let ((methods gnus-valid-select-methods)
6079         func)
6080     (while methods
6081       (if (fboundp (setq func (intern (concat (car (car methods))
6082                                               "-request-close"))))
6083           (funcall func))
6084       (setq methods (cdr methods)))))
6085
6086 (defun gnus-group-quit ()
6087   "Quit reading news without updating .newsrc.eld or .newsrc.
6088 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6089   (interactive)
6090   (when (or noninteractive              ;For gnus-batch-kill
6091             (zerop (buffer-size))
6092             (not (gnus-server-opened gnus-select-method))
6093             gnus-expert-user
6094             (not gnus-current-startup-file)
6095             (gnus-yes-or-no-p
6096              (format "Quit reading news without saving %s? "
6097                      (file-name-nondirectory gnus-current-startup-file))))
6098     (run-hooks 'gnus-exit-gnus-hook)
6099     (if gnus-use-full-window
6100         (delete-other-windows)
6101       (gnus-remove-some-windows))
6102     (gnus-dribble-save)
6103     (gnus-close-backends)
6104     ;; Shut down the cache.
6105     (when gnus-use-cache
6106       (gnus-cache-open))
6107     (gnus-clear-system)))
6108
6109 (defun gnus-offer-save-summaries ()
6110   "Offer to save all active summary buffers."
6111   (save-excursion
6112     (let ((buflist (buffer-list)) 
6113           buffers bufname)
6114       ;; Go through all buffers and find all summaries.
6115       (while buflist
6116         (and (setq bufname (buffer-name (car buflist)))
6117              (string-match "Summary" bufname)
6118              (save-excursion
6119                (set-buffer bufname)
6120                ;; We check that this is, indeed, a summary buffer.
6121                (and (eq major-mode 'gnus-summary-mode)
6122                     ;; Also make sure this isn't bogus.
6123                     gnus-newsgroup-prepared))
6124              (push bufname buffers))
6125         (setq buflist (cdr buflist)))
6126       ;; Go through all these summary buffers and offer to save them.
6127       (when buffers
6128         (map-y-or-n-p 
6129          "Update summary buffer %s? "
6130          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
6131          buffers)))))
6132
6133 (defun gnus-group-describe-briefly ()
6134   "Give a one line description of the group mode commands."
6135   (interactive)
6136   (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select  \\[gnus-group-next-unread-group]:Forward  \\[gnus-group-prev-unread-group]:Backward  \\[gnus-group-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-group-describe-briefly]:This help")))
6137
6138 (defun gnus-group-browse-foreign-server (method)
6139   "Browse a foreign news server.
6140 If called interactively, this function will ask for a select method
6141  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). 
6142 If not, METHOD should be a list where the first element is the method
6143 and the second element is the address."
6144   (interactive
6145    (list (let ((how (completing-read 
6146                      "Which backend: "
6147                      (append gnus-valid-select-methods gnus-server-alist)
6148                      nil t "nntp")))
6149            ;; We either got a backend name or a virtual server name.
6150            ;; If the first, we also need an address.
6151            (if (assoc how gnus-valid-select-methods)
6152                (list (intern how)
6153                      ;; Suggested by mapjph@bath.ac.uk.
6154                      (completing-read 
6155                       "Address: " 
6156                       (mapcar (lambda (server) (list server))
6157                               gnus-secondary-servers)))
6158              ;; We got a server name, so we find the method.
6159              (gnus-server-to-method how)))))
6160   (gnus-browse-foreign-server method))
6161
6162 \f
6163 ;;;
6164 ;;; Browse Server Mode
6165 ;;;
6166
6167 (defvar gnus-browse-mode-hook nil)
6168 (defvar gnus-browse-mode-map nil)
6169 (put 'gnus-browse-mode 'mode-class 'special)
6170
6171 (if gnus-browse-mode-map
6172     nil
6173   (setq gnus-browse-mode-map (make-keymap))
6174   (suppress-keymap gnus-browse-mode-map)
6175   (define-key gnus-browse-mode-map " " 'gnus-browse-read-group)
6176   (define-key gnus-browse-mode-map "=" 'gnus-browse-select-group)
6177   (define-key gnus-browse-mode-map "n" 'gnus-browse-next-group)
6178   (define-key gnus-browse-mode-map "p" 'gnus-browse-prev-group)
6179   (define-key gnus-browse-mode-map "\177" 'gnus-browse-prev-group)
6180   (define-key gnus-browse-mode-map "N" 'gnus-browse-next-group)
6181   (define-key gnus-browse-mode-map "P" 'gnus-browse-prev-group)
6182   (define-key gnus-browse-mode-map "\M-n" 'gnus-browse-next-group)
6183   (define-key gnus-browse-mode-map "\M-p" 'gnus-browse-prev-group)
6184   (define-key gnus-browse-mode-map "\r" 'gnus-browse-select-group)
6185   (define-key gnus-browse-mode-map "u" 'gnus-browse-unsubscribe-current-group)
6186   (define-key gnus-browse-mode-map "l" 'gnus-browse-exit)
6187   (define-key gnus-browse-mode-map "L" 'gnus-browse-exit)
6188   (define-key gnus-browse-mode-map "q" 'gnus-browse-exit)
6189   (define-key gnus-browse-mode-map "Q" 'gnus-browse-exit)
6190   (define-key gnus-browse-mode-map "\C-c\C-c" 'gnus-browse-exit)
6191   (define-key gnus-browse-mode-map "?" 'gnus-browse-describe-briefly)
6192   (define-key gnus-browse-mode-map "\C-c\C-i" 'gnus-info-find-node)
6193   )
6194
6195 (defvar gnus-browse-current-method nil)
6196 (defvar gnus-browse-return-buffer nil)
6197
6198 (defvar gnus-browse-buffer "*Gnus Browse Server*")
6199
6200 (defun gnus-browse-foreign-server (method &optional return-buffer)
6201   "Browse the server METHOD."
6202   (setq gnus-browse-current-method method)
6203   (setq gnus-browse-return-buffer return-buffer)
6204   (let ((gnus-select-method method)
6205         groups group)
6206     (gnus-message 5 "Connecting to %s..." (nth 1 method))
6207     (cond 
6208      ((not (gnus-check-server method))
6209       (gnus-message 
6210        1 "Unable to contact server: %s" (gnus-status-message method))
6211       nil)
6212      ((not (gnus-request-list method))
6213       (gnus-message 
6214        1 "Couldn't request list: %s" (gnus-status-message method))
6215       nil)
6216      (t
6217       (get-buffer-create gnus-browse-buffer)
6218       (gnus-add-current-to-buffer-list)
6219       (and gnus-carpal (gnus-carpal-setup-buffer 'browse))
6220       (gnus-configure-windows 'browse)
6221       (buffer-disable-undo (current-buffer))
6222       (let ((buffer-read-only nil))
6223         (erase-buffer))
6224       (gnus-browse-mode)
6225       (setq mode-line-buffer-identification
6226             (list
6227              (format
6228               "Gnus: %%b {%s:%s}" (car method) (car (cdr method)))))
6229       (save-excursion
6230         (set-buffer nntp-server-buffer)
6231         (let ((cur (current-buffer)))
6232           (goto-char (point-min))
6233           (or (string= gnus-ignored-newsgroups "")
6234               (delete-matching-lines gnus-ignored-newsgroups))
6235           (while (re-search-forward 
6236                   "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
6237             (goto-char (match-end 1))
6238             (setq groups (cons (cons (match-string 1)
6239                                      (max 0 (- (1+ (read cur)) (read cur))))
6240                                groups)))))
6241       (setq groups (sort groups 
6242                          (lambda (l1 l2)
6243                            (string< (car l1) (car l2)))))
6244       (let ((buffer-read-only nil))
6245         (while groups
6246           (setq group (car groups))
6247           (insert 
6248            (format "K%7d: %s\n" (cdr group) (car group)))
6249           (setq groups (cdr groups))))
6250       (switch-to-buffer (current-buffer))
6251       (goto-char (point-min))
6252       (gnus-group-position-point)
6253       t))))
6254
6255 (defun gnus-browse-mode ()
6256   "Major mode for browsing a foreign server.
6257
6258 All normal editing commands are switched off.
6259
6260 \\<gnus-browse-mode-map>
6261 The only things you can do in this buffer is
6262
6263 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
6264 The group will be inserted into the group buffer upon exit from this
6265 buffer.  
6266
6267 2) `\\[gnus-browse-read-group]' to read a group ephemerally.
6268
6269 3) `\\[gnus-browse-exit]' to return to the group buffer."
6270   (interactive)
6271   (kill-all-local-variables)
6272   (when (and menu-bar-mode
6273              (gnus-visual-p 'browse-menu 'menu))
6274     (gnus-browse-make-menu-bar))
6275   (gnus-simplify-mode-line)
6276   (setq major-mode 'gnus-browse-mode)
6277   (setq mode-name "Browse Server")
6278   (setq mode-line-process nil)
6279   (use-local-map gnus-browse-mode-map)
6280   (buffer-disable-undo (current-buffer))
6281   (setq truncate-lines t)
6282   (setq buffer-read-only t)
6283   (run-hooks 'gnus-browse-mode-hook))
6284
6285 (defun gnus-browse-read-group (&optional no-article)
6286   "Enter the group at the current line."
6287   (interactive)
6288   (let ((group (gnus-browse-group-name)))
6289     (or (gnus-group-read-ephemeral-group 
6290          group gnus-browse-current-method nil
6291          (cons (current-buffer) 'browse))
6292         (error "Couldn't enter %s" group))))
6293
6294 (defun gnus-browse-select-group ()
6295   "Select the current group."
6296   (interactive)
6297   (gnus-browse-read-group 'no))
6298
6299 (defun gnus-browse-next-group (n)
6300   "Go to the next group."
6301   (interactive "p")
6302   (prog1
6303       (forward-line n)
6304     (gnus-group-position-point)))
6305
6306 (defun gnus-browse-prev-group (n)
6307   "Go to the next group."
6308   (interactive "p")
6309   (gnus-browse-next-group (- n)))
6310
6311 (defun gnus-browse-unsubscribe-current-group (arg)
6312   "(Un)subscribe to the next ARG groups."
6313   (interactive "p")
6314   (and (eobp)
6315        (error "No group at current line."))
6316   (let ((ward (if (< arg 0) -1 1))
6317         (arg (abs arg)))
6318     (while (and (> arg 0)
6319                 (not (eobp))
6320                 (gnus-browse-unsubscribe-group)
6321                 (zerop (gnus-browse-next-group ward)))
6322       (setq arg (1- arg)))
6323     (gnus-group-position-point)
6324     (if (/= 0 arg) (gnus-message 7 "No more newsgroups"))
6325     arg))
6326
6327 (defun gnus-browse-group-name ()
6328   (save-excursion
6329     (beginning-of-line)
6330     (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
6331       (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method))))
6332   
6333 (defun gnus-browse-unsubscribe-group ()
6334   "Toggle subscription of the current group in the browse buffer."
6335   (let ((sub nil)
6336         (buffer-read-only nil)
6337         group)
6338     (save-excursion
6339       (beginning-of-line)
6340       ;; If this group it killed, then we want to subscribe it.
6341       (if (= (following-char) ?K) (setq sub t))
6342       (setq group (gnus-browse-group-name))
6343       (delete-char 1)
6344       (if sub
6345           (progn
6346             (gnus-group-change-level 
6347              (list t group gnus-level-default-subscribed
6348                    nil nil gnus-browse-current-method) 
6349              gnus-level-default-subscribed gnus-level-killed
6350              (and (car (nth 1 gnus-newsrc-alist))
6351                   (gnus-gethash (car (nth 1 gnus-newsrc-alist))
6352                                 gnus-newsrc-hashtb))
6353              t)
6354             (insert ? ))
6355         (gnus-group-change-level 
6356          group gnus-level-killed gnus-level-default-subscribed)
6357         (insert ?K)))
6358     t))
6359
6360 (defun gnus-browse-exit ()
6361   "Quit browsing and return to the group buffer."
6362   (interactive)
6363   (if (eq major-mode 'gnus-browse-mode)
6364       (kill-buffer (current-buffer)))
6365   (if gnus-browse-return-buffer
6366       (gnus-configure-windows 'server 'force)
6367     (gnus-configure-windows 'group 'force)
6368     (gnus-group-list-groups nil)))
6369
6370 (defun gnus-browse-describe-briefly ()
6371   "Give a one line description of the group mode commands."
6372   (interactive)
6373   (gnus-message 6
6374                 (substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward  \\[gnus-group-prev-group]:Backward  \\[gnus-browse-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-browse-describe-briefly]:This help")))
6375       
6376 \f
6377 ;;;
6378 ;;; Gnus summary mode
6379 ;;;
6380
6381 (defvar gnus-summary-mode-map nil)
6382 (defvar gnus-summary-mark-map nil)
6383 (defvar gnus-summary-mscore-map nil)
6384 (defvar gnus-summary-article-map nil)
6385 (defvar gnus-summary-thread-map nil)
6386 (defvar gnus-summary-goto-map nil)
6387 (defvar gnus-summary-exit-map nil)
6388 (defvar gnus-summary-interest-map nil)
6389 (defvar gnus-summary-sort-map nil)
6390 (defvar gnus-summary-backend-map nil)
6391 (defvar gnus-summary-save-map nil)
6392 (defvar gnus-summary-wash-map nil)
6393 (defvar gnus-summary-wash-hide-map nil)
6394 (defvar gnus-summary-wash-highlight-map nil)
6395 (defvar gnus-summary-wash-time-map nil)
6396 (defvar gnus-summary-help-map nil)
6397 (defvar gnus-summary-limit-map nil)
6398
6399 (put 'gnus-summary-mode 'mode-class 'special)
6400
6401 (if gnus-summary-mode-map
6402     nil
6403   (setq gnus-summary-mode-map (make-keymap))
6404   (suppress-keymap gnus-summary-mode-map)
6405
6406   ;; Non-orthogonal keys
6407
6408   (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
6409   (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
6410   (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
6411   (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
6412   (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
6413   (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
6414   (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
6415   (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject)
6416   (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject)
6417   (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject)
6418   (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject)
6419   (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
6420   (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article)
6421   (define-key gnus-summary-mode-map 
6422     "\M-s" 'gnus-summary-search-article-forward)
6423   (define-key gnus-summary-mode-map 
6424     "\M-r" 'gnus-summary-search-article-backward)
6425   (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
6426   (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
6427   (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-article)
6428   (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
6429   (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article)
6430   (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward)
6431   (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward)
6432   (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward)
6433   (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
6434   (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
6435   (define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable)
6436   (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward)
6437   (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward)
6438   (define-key gnus-summary-mode-map 
6439     "k" 'gnus-summary-kill-same-subject-and-select)
6440   (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
6441   (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread)
6442   (define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread)
6443   (define-key gnus-summary-mode-map "e" 'gnus-summary-edit-article)
6444   (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable)
6445   (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable)
6446   (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads)
6447   (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread)
6448   (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread)
6449   (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread)
6450   (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread)
6451   (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread)
6452   (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread)
6453   (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
6454   (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
6455   (define-key gnus-summary-mode-map "\C-w" 'gnus-summary-mark-region-as-read)
6456   (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
6457   (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant)
6458   (define-key gnus-summary-mode-map 
6459     "\C-c\M-\C-s" 'gnus-summary-limit-include-expunged)
6460   (define-key gnus-summary-mode-map 
6461     "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
6462   (define-key gnus-summary-mode-map 
6463     "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
6464   (define-key gnus-summary-mode-map 
6465     "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
6466   (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
6467   (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score)
6468   (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
6469   (define-key gnus-summary-mode-map 
6470     "\C-x\C-s" 'gnus-summary-reselect-current-group)
6471   (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group)
6472   (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
6473   (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
6474   (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime)
6475   (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
6476   (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
6477   (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
6478   (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
6479   (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
6480   (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
6481   (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
6482   (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail)
6483   (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
6484   (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill)
6485   (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill)
6486   (define-key gnus-summary-mode-map "V" 'gnus-version)
6487   (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group)
6488   (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
6489   (define-key gnus-summary-mode-map "Q" 'gnus-summary-exit-no-update)
6490   (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
6491   (define-key gnus-summary-mode-map gnus-mouse-2 'gnus-mouse-pick-article)
6492   (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
6493   (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
6494   (define-key gnus-summary-mode-map "x" 'gnus-summary-limit-to-unread)
6495   (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
6496   (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
6497   (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
6498 ;  (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
6499   (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
6500   (define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu-view)
6501   (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-enter-digest-group)
6502   (define-key gnus-summary-mode-map "v" 'gnus-summary-verbose-headers)
6503   (define-key gnus-summary-mode-map "\C-c\C-b" 'gnus-bug)
6504
6505   (define-key gnus-summary-mode-map "*" 'gnus-cache-enter-article)
6506   (define-key gnus-summary-mode-map "\M-*" 'gnus-cache-remove-article)
6507
6508   ;; Sort of orthogonal keymap
6509   (define-prefix-command 'gnus-summary-mark-map)
6510   (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map)
6511   (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward)
6512   (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward)
6513   (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward)
6514   (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward)
6515   (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward)
6516   (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward)
6517   (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable)
6518   (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable)
6519   (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant)
6520   (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark)
6521   (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark)
6522   (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable)
6523   (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable)
6524   (define-key gnus-summary-mark-map "S" 'gnus-summary-limit-include-expunged)
6525   (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup)
6526   (define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here)
6527   (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all)
6528   (define-key gnus-summary-mark-map 
6529     "k" 'gnus-summary-kill-same-subject-and-select)
6530   (define-key gnus-summary-mark-map "K" 'gnus-summary-kill-same-subject)
6531
6532   (define-prefix-command 'gnus-summary-mscore-map)
6533   (define-key gnus-summary-mark-map "V" 'gnus-summary-mscore-map)
6534   (define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above)
6535   (define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above)
6536   (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above)
6537   (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below)
6538
6539   (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map)
6540   
6541   (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
6542
6543   (define-prefix-command 'gnus-summary-limit-map)
6544   (define-key gnus-summary-mode-map "/" 'gnus-summary-limit-map)
6545   (define-key gnus-summary-limit-map "/" 'gnus-summary-limit-to-subject)
6546   (define-key gnus-summary-limit-map "n" 'gnus-summary-limit-to-articles)
6547   (define-key gnus-summary-limit-map "w" 'gnus-summary-pop-limit)
6548   (define-key gnus-summary-limit-map "s" 'gnus-summary-limit-to-subject)
6549   (define-key gnus-summary-limit-map "u" 'gnus-summary-limit-to-unread)
6550   (define-key gnus-summary-limit-map "m" 'gnus-summary-limit-to-marks)
6551   (define-key gnus-summary-limit-map "v" 'gnus-summary-limit-to-score)
6552   (define-key gnus-summary-limit-map "D" 'gnus-summary-limit-include-dormant)
6553   (define-key gnus-summary-limit-map "d" 'gnus-summary-limit-exclude-dormant)
6554 ;  (define-key gnus-summary-limit-map "t" 'gnus-summary-limit-exclude-thread)
6555   (define-key gnus-summary-mark-map "E" 'gnus-summary-limit-include-expunged)
6556   (define-key gnus-summary-limit-map "c" 
6557     'gnus-summary-limit-exclude-childless-dormant)
6558
6559   (define-prefix-command 'gnus-summary-goto-map)
6560   (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map)
6561   (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article)
6562   (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article)
6563   (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article)
6564   (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article)
6565   (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject)
6566   (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject)
6567   (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject)
6568   (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject)
6569   (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article)
6570   (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article)
6571   (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject)
6572   (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article)
6573   (define-key gnus-summary-goto-map "p" 'gnus-summary-pop-article)
6574
6575
6576   (define-prefix-command 'gnus-summary-thread-map)
6577   (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map)
6578   (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread)
6579   (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread)
6580   (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread)
6581   (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads)
6582   (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread)
6583   (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads)
6584   (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread)
6585   (define-key gnus-summary-thread-map "H" 'gnus-summary-hide-all-threads)
6586   (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread)
6587   (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread)
6588   (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread)
6589   (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread)
6590   (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread)
6591   (define-key gnus-summary-thread-map "\M-#" 'gnus-uu-unmark-thread)
6592
6593   
6594   (define-prefix-command 'gnus-summary-exit-map)
6595   (define-key gnus-summary-mode-map "Z" 'gnus-summary-exit-map)
6596   (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit)
6597   (define-key gnus-summary-exit-map "C" 'gnus-summary-catchup-all-and-exit)
6598   (define-key gnus-summary-exit-map "E" 'gnus-summary-exit-no-update)
6599   (define-key gnus-summary-exit-map "Q" 'gnus-summary-exit)
6600   (define-key gnus-summary-exit-map "Z" 'gnus-summary-exit)
6601   (define-key gnus-summary-exit-map 
6602     "n" 'gnus-summary-catchup-and-goto-next-group)
6603   (define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group)
6604   (define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group)
6605   (define-key gnus-summary-exit-map "N" 'gnus-summary-next-group)
6606   (define-key gnus-summary-exit-map "P" 'gnus-summary-prev-group)
6607
6608
6609   (define-prefix-command 'gnus-summary-article-map)
6610   (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map)
6611   (define-key gnus-summary-article-map " " 'gnus-summary-next-page)
6612   (define-key gnus-summary-article-map "n" 'gnus-summary-next-page)
6613   (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page)
6614   (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page)
6615   (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up)
6616   (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article)
6617   (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article)
6618   (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article)
6619   (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article)
6620   (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article)
6621   (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article)
6622   (define-key gnus-summary-article-map "R" 'gnus-summary-refer-references)
6623   (define-key gnus-summary-article-map "g" 'gnus-summary-show-article)
6624   (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article)
6625
6626
6627
6628   (define-prefix-command 'gnus-summary-wash-map)
6629   (define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map)
6630
6631   (define-prefix-command 'gnus-summary-wash-hide-map)
6632   (define-key gnus-summary-wash-map "W" 'gnus-summary-wash-hide-map)
6633   (define-key gnus-summary-wash-hide-map "a" 'gnus-article-hide)
6634   (define-key gnus-summary-wash-hide-map "h" 'gnus-article-hide-headers)
6635   (define-key gnus-summary-wash-hide-map "s" 'gnus-article-hide-signature)
6636   (define-key gnus-summary-wash-hide-map "c" 'gnus-article-hide-citation)
6637   (define-key gnus-summary-wash-hide-map "p" 'gnus-article-hide-pgp)
6638   (define-key gnus-summary-wash-hide-map 
6639     "\C-c" 'gnus-article-hide-citation-maybe)
6640
6641   (define-prefix-command 'gnus-summary-wash-highlight-map)
6642   (define-key gnus-summary-wash-map "H" 'gnus-summary-wash-highlight-map)
6643   (define-key gnus-summary-wash-highlight-map "a" 'gnus-article-highlight)
6644   (define-key gnus-summary-wash-highlight-map 
6645     "h" 'gnus-article-highlight-headers)
6646   (define-key gnus-summary-wash-highlight-map
6647     "c" 'gnus-article-highlight-citation)
6648   (define-key gnus-summary-wash-highlight-map
6649     "s" 'gnus-article-highlight-signature)
6650
6651   (define-prefix-command 'gnus-summary-wash-time-map)
6652   (define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map)
6653   (define-key gnus-summary-wash-time-map "z" 'gnus-article-date-ut)
6654   (define-key gnus-summary-wash-time-map "u" 'gnus-article-date-ut)
6655   (define-key gnus-summary-wash-time-map "l" 'gnus-article-date-local)
6656   (define-key gnus-summary-wash-time-map "e" 'gnus-article-date-lapsed)
6657   (define-key gnus-summary-wash-time-map "o" 'gnus-article-date-original)
6658
6659   (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons)
6660   (define-key gnus-summary-wash-map "B" 'gnus-article-add-buttons-to-head)
6661   (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike)
6662   (define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap)
6663   (define-key gnus-summary-wash-map "c" 'gnus-article-remove-cr)
6664   (define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable)
6665   (define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face)
6666   (define-key gnus-summary-wash-map "l" 'gnus-summary-stop-page-breaking)
6667   (define-key gnus-summary-wash-map "r" 'gnus-summary-caesar-message)
6668   (define-key gnus-summary-wash-map "t" 'gnus-summary-toggle-header)
6669   (define-key gnus-summary-wash-map "m" 'gnus-summary-toggle-mime)
6670
6671
6672   (define-prefix-command 'gnus-summary-help-map)
6673   (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map)
6674   (define-key gnus-summary-help-map "v" 'gnus-version)
6675   (define-key gnus-summary-help-map "f" 'gnus-summary-fetch-faq)
6676   (define-key gnus-summary-help-map "d" 'gnus-summary-describe-group)
6677   (define-key gnus-summary-help-map "h" 'gnus-summary-describe-briefly)
6678   (define-key gnus-summary-help-map "i" 'gnus-info-find-node)
6679
6680
6681   (define-prefix-command 'gnus-summary-backend-map)
6682   (define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map)
6683   (define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles)
6684   (define-key gnus-summary-backend-map "\M-\C-e" 
6685     'gnus-summary-expire-articles-now)
6686   (define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article)
6687   (define-key gnus-summary-backend-map "m" 'gnus-summary-move-article)
6688   (define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article)
6689   (define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article)
6690   (define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article)
6691   (define-key gnus-summary-backend-map "q" 'gnus-summary-respool-query)
6692   (define-key gnus-summary-backend-map "i" 'gnus-summary-import-article)
6693
6694
6695   (define-prefix-command 'gnus-summary-save-map)
6696   (define-key gnus-summary-mode-map "O" 'gnus-summary-save-map)
6697   (define-key gnus-summary-save-map "o" 'gnus-summary-save-article)
6698   (define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail)
6699   (define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail)
6700   (define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file)
6701   (define-key gnus-summary-save-map "b" 'gnus-summary-save-article-body-file)
6702   (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder)
6703   (define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm)
6704   (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output)
6705   (define-key gnus-summary-save-map "s" 'gnus-soup-add-article)
6706
6707   (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map)
6708
6709   (define-key gnus-summary-mode-map "\M-&" 'gnus-summary-universal-argument)
6710   (define-key gnus-summary-article-map "D" 'gnus-summary-enter-digest-group)
6711
6712   (define-key gnus-summary-mode-map "V" 'gnus-summary-score-map)
6713
6714   (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-score)
6715   (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-score)
6716   )
6717
6718
6719 \f
6720
6721 (defun gnus-summary-mode (&optional group)
6722   "Major mode for reading articles.
6723
6724 All normal editing commands are switched off.
6725 \\<gnus-summary-mode-map>
6726 Each line in this buffer represents one article.  To read an
6727 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
6728 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', 
6729 respectively.
6730
6731 You can also post articles and send mail from this buffer.  To 
6732 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author 
6733 of an article, type `\\[gnus-summary-reply]'.
6734
6735 There are approx. one gazillion commands you can execute in this 
6736 buffer; read the info pages for more information (`\\[gnus-info-find-node]'). 
6737
6738 The following commands are available:
6739
6740 \\{gnus-summary-mode-map}"
6741   (interactive)
6742   (when (and menu-bar-mode
6743              (gnus-visual-p 'summary-menu 'menu))
6744     (gnus-summary-make-menu-bar))
6745   (kill-all-local-variables)
6746   (let ((locals gnus-summary-local-variables))
6747     (while locals
6748       (if (consp (car locals))
6749           (progn
6750             (make-local-variable (car (car locals)))
6751             (set (car (car locals)) (eval (cdr (car locals)))))
6752         (make-local-variable (car locals))
6753         (set (car locals) nil))
6754       (setq locals (cdr locals))))
6755   (gnus-make-thread-indent-array)
6756   (gnus-simplify-mode-line)
6757   (setq major-mode 'gnus-summary-mode)
6758   (setq mode-name "Summary")
6759   (make-local-variable 'minor-mode-alist)
6760   (use-local-map gnus-summary-mode-map)
6761   (buffer-disable-undo (current-buffer))
6762   (setq buffer-read-only t)             ;Disable modification
6763   (setq truncate-lines t)
6764   (setq selective-display t)
6765   (setq selective-display-ellipses t)   ;Display `...'
6766   (setq buffer-display-table gnus-summary-display-table)
6767   (setq gnus-newsgroup-name group)
6768   (run-hooks 'gnus-summary-mode-hook))
6769
6770 (defun gnus-summary-make-display-table ()
6771   ;; Change the display table.  Odd characters have a tendency to mess
6772   ;; up nicely formatted displays - we make all possible glyphs
6773   ;; display only a single character.
6774
6775   ;; We start from the standard display table, if any.
6776   (setq gnus-summary-display-table 
6777         (or (copy-sequence standard-display-table)
6778             (make-display-table)))
6779   ;; Nix out all the control chars...
6780   (let ((i 32))
6781     (while (>= (setq i (1- i)) 0)
6782       (aset gnus-summary-display-table i [??])))
6783   ;; ... but not newline and cr, of course. (cr is necessary for the
6784   ;; selective display).  
6785   (aset gnus-summary-display-table ?\n nil)
6786   (aset gnus-summary-display-table ?\r nil)
6787   ;; We nix out any glyphs over 126 that are not set already.  
6788   (let ((i 256))
6789     (while (>= (setq i (1- i)) 127)
6790       ;; Only modify if the entry is nil.
6791       (or (aref gnus-summary-display-table i) 
6792           (aset gnus-summary-display-table i [??])))))
6793
6794 (defun gnus-summary-clear-local-variables ()
6795   (let ((locals gnus-summary-local-variables))
6796     (while locals
6797       (if (consp (car locals))
6798           (and (vectorp (car (car locals)))
6799                (set (car (car locals)) nil))
6800         (and (vectorp (car locals))
6801              (set (car locals) nil)))
6802       (setq locals (cdr locals)))))
6803
6804 ;; Summary data functions.
6805
6806 (defmacro gnus-data-number (data)
6807   `(car ,data))
6808
6809 (defmacro gnus-data-mark (data)
6810   `(nth 1 ,data))
6811
6812 (defmacro gnus-data-set-mark (data mark)
6813   `(setcar (nthcdr 1 ,data) ,mark))
6814
6815 (defmacro gnus-data-pos (data)
6816   `(nth 2 ,data))
6817
6818 (defmacro gnus-data-set-pos (data pos)
6819   `(setcar (nthcdr 2 ,data) ,pos))
6820
6821 (defmacro gnus-data-header (data)
6822   `(nth 3 ,data))
6823
6824 (defmacro gnus-data-level (data)
6825   `(nth 4 ,data))
6826
6827 (defmacro gnus-data-unread-p (data)
6828   `(= (nth 1 ,data) gnus-unread-mark))
6829
6830 (defmacro gnus-data-pseudo-p (data)
6831   `(consp (nth 3 ,data)))
6832
6833 (defmacro gnus-data-find (number)
6834   `(assq ,number gnus-newsgroup-data))
6835
6836 (defmacro gnus-data-find-list (number &optional data)
6837   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
6838      (memq (assq ,number bdata)
6839            bdata)))
6840
6841 (defmacro gnus-data-make (number mark pos header level)
6842   `(list ,number ,mark ,pos ,header ,level))
6843
6844 (defun gnus-data-enter (after-article number mark pos header level offset)
6845   (let ((data (gnus-data-find-list after-article)))
6846     (or data (error "No such article: %d" after-article))
6847     (setcdr data (cons (gnus-data-make number mark pos header level)
6848                        (cdr data)))
6849     (setq gnus-newsgroup-data-reverse nil)
6850     (gnus-data-update-list (cdr (cdr data)) offset)))
6851
6852 (defun gnus-data-enter-list (after-article list &optional offset)
6853   (when list
6854     (let ((data (and after-article (gnus-data-find-list after-article)))
6855           (ilist list))
6856       (or data (not after-article) (error "No such article: %d" after-article))
6857       ;; Find the last element in the list to be spliced into the main
6858       ;; list.  
6859       (while (cdr list)
6860         (setq list (cdr list)))
6861       (if (not data)
6862           (progn
6863             (setcdr list gnus-newsgroup-data)
6864             (setq gnus-newsgroup-data ilist)
6865             (and offset (gnus-data-update-list (cdr list) offset)))
6866         (setcdr list (cdr data))
6867         (setcdr data ilist)
6868         (and offset (gnus-data-update-list (cdr data) offset)))
6869       (setq gnus-newsgroup-data-reverse nil))))
6870
6871 (defun gnus-data-remove (article &optional offset)
6872   (let ((data gnus-newsgroup-data))
6873     (if (= (gnus-data-number (car data)) article)
6874         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
6875               gnus-newsgroup-data-reverse nil)
6876       (while (cdr data)
6877         (and (= (gnus-data-number (car (cdr data))) article)
6878              (progn
6879                (setcdr data (cdr (cdr data)))
6880                (and offset (gnus-data-update-list (cdr data) offset))
6881                (setq data nil
6882                      gnus-newsgroup-data-reverse nil)))
6883         (setq data (cdr data))))))
6884
6885 (defmacro gnus-data-list (backward)
6886   `(if ,backward
6887        (or gnus-newsgroup-data-reverse
6888            (setq gnus-newsgroup-data-reverse
6889                  (reverse gnus-newsgroup-data)))
6890      gnus-newsgroup-data))
6891
6892 (defun gnus-data-update-list (data offset)
6893   "Add OFFSET to the POS of all data entries in DATA."
6894   (while data
6895     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
6896     (setq data (cdr data))))
6897
6898 (defun gnus-data-compute-positions ()
6899   "Compute the positions of all articles."
6900   (let ((data gnus-newsgroup-data)
6901         pos)
6902     (while data
6903       (when (setq pos (text-property-any 
6904                        (point-min) (point-max)
6905                        'gnus-number (gnus-data-number (car data))))
6906         (gnus-data-set-pos (car data) (+ pos 3)))
6907       (setq data (cdr data)))))
6908
6909 (defun gnus-summary-article-pseudo-p (article)
6910   "Say whether this article is a pseudo article or not."
6911   (not (vectorp (gnus-data-header (gnus-data-find article)))))
6912
6913 (defun gnus-article-parent-p (number)
6914   "Say whether this article is a parent or not."
6915   (let* ((data (gnus-data-find-list number)))
6916     (and (cdr data)                     ; There has to be an article after...
6917          (< (gnus-data-level (car data)) ; And it has to have a higher level.
6918             (gnus-data-level (nth 1 data))))))
6919     
6920 (defmacro gnus-summary-skip-intangible ()
6921   "If the current article is intangible, then jump to a different article."
6922   '(let ((to (get-text-property (point) 'gnus-intangible)))
6923     (when to
6924       (gnus-summary-goto-subject to))))
6925
6926 (defmacro gnus-summary-article-intangible-p ()
6927   "Say whether this article is intangible or not."
6928   '(get-text-property (point) 'gnus-intangible))
6929
6930 ;; Some summary mode macros.
6931
6932 (defmacro gnus-summary-article-number ()
6933   "The article number of the article on the current line.
6934 If there isn's an article number here, then we return the current
6935 article number."
6936   '(progn
6937      (gnus-summary-skip-intangible)
6938      (or (get-text-property (point) 'gnus-number) 
6939          (gnus-summary-last-subject))))
6940
6941 (defmacro gnus-summary-article-header (&optional number)
6942   `(gnus-data-header (gnus-data-find
6943                       ,(or number '(gnus-summary-article-number)))))
6944
6945 (defmacro gnus-summary-thread-level (&optional number)
6946   `(gnus-data-level (gnus-data-find
6947                      ,(or number '(gnus-summary-article-number)))))
6948
6949 (defmacro gnus-summary-article-mark (&optional number)
6950   `(gnus-data-mark (gnus-data-find
6951                     ,(or number '(gnus-summary-article-number)))))
6952
6953 (defmacro gnus-summary-article-pos (&optional number)
6954   `(gnus-data-pos (gnus-data-find
6955                    ,(or number '(gnus-summary-article-number)))))
6956
6957 (defmacro gnus-summary-article-subject (&optional number)
6958   "Return current subject string or nil if nothing."
6959   `(let ((headers 
6960           ,(if number
6961                `(gnus-data-header (assq ,number gnus-newsgroup-data))
6962              '(gnus-data-header (assq (gnus-summary-article-number)
6963                                       gnus-newsgroup-data)))))
6964      (and headers
6965           (vectorp headers)
6966           (mail-header-subject headers))))
6967
6968 (defmacro gnus-summary-article-score (&optional number)
6969   "Return current article score."
6970   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
6971                   gnus-newsgroup-scored))
6972        gnus-summary-default-score 0))
6973
6974 (defun gnus-summary-article-children (&optional number)
6975   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
6976          (level (gnus-data-level (car data)))
6977          l children)
6978     (while (and (setq data (cdr data))
6979                 (> (setq l (gnus-data-level (car data))) level))
6980       (and (= (1+ level) l)
6981            (setq children (cons (gnus-data-number (car data))
6982                                 children))))
6983     (nreverse children)))
6984
6985 (defun gnus-summary-article-parent (&optional number)
6986   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
6987                                     (gnus-data-list t)))
6988          (level (gnus-data-level (car data)))
6989          l)
6990     (if (zerop level)
6991         () ; This is a root.
6992       ;; We search until we find an article with a level less than
6993       ;; this one.  That function has to be the parent.
6994       (while (and (setq data (cdr data))
6995                   (not (< (gnus-data-level (car data)) level))))
6996       (and data (gnus-data-number (car data))))))
6997
6998
6999 ;; Various summary mode internalish functions.
7000
7001 (defun gnus-mouse-pick-article (e)
7002   (interactive "e")
7003   (mouse-set-point e)
7004   (gnus-summary-next-page nil t))
7005
7006 (defun gnus-summary-setup-buffer (group)
7007   "Initialize summary buffer."
7008   (let ((buffer (concat "*Summary " group "*")))
7009     (if (get-buffer buffer)
7010         (progn
7011           (set-buffer buffer)
7012           (setq gnus-summary-buffer (current-buffer))
7013           (not gnus-newsgroup-prepared))
7014       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
7015       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
7016       (gnus-add-current-to-buffer-list)
7017       (gnus-summary-mode group)
7018       (and gnus-carpal (gnus-carpal-setup-buffer 'summary))
7019       (setq gnus-newsgroup-name group)
7020       t)))
7021
7022 (defun gnus-set-global-variables ()
7023   ;; Set the global equivalents of the summary buffer-local variables
7024   ;; to the latest values they had.  These reflect the summary buffer
7025   ;; that was in action when the last article was fetched.
7026   (if (eq major-mode 'gnus-summary-mode) 
7027       (progn
7028         (setq gnus-summary-buffer (current-buffer))
7029         (let ((name gnus-newsgroup-name)
7030               (marked gnus-newsgroup-marked)
7031               (unread gnus-newsgroup-unreads)
7032               (headers gnus-current-headers)
7033               (data gnus-newsgroup-data)
7034               (score-file gnus-current-score-file))
7035           (save-excursion
7036             (set-buffer gnus-group-buffer)
7037             (setq gnus-newsgroup-name name)
7038             (setq gnus-newsgroup-marked marked)
7039             (setq gnus-newsgroup-unreads unread)
7040             (setq gnus-current-headers headers)
7041             (setq gnus-newsgroup-data data)
7042             (setq gnus-current-score-file score-file))))))
7043
7044 (defun gnus-summary-last-article-p (&optional article)
7045   "Return whether ARTICLE is the last article in the buffer."
7046   (if (not (setq article (or article (gnus-summary-article-number))))
7047       t ; All non-existant numbers are the last article. :-)
7048     (cdr (gnus-data-find-list article))))
7049     
7050 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
7051   "Insert a dummy root in the summary buffer."
7052   (beginning-of-line)
7053   (add-text-properties
7054    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
7055    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
7056
7057 (defvar gnus-thread-indent-array nil)
7058 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
7059 (defun gnus-make-thread-indent-array ()
7060   (let ((n 200))
7061     (if (and gnus-thread-indent-array
7062              (= gnus-thread-indent-level gnus-thread-indent-array-level))
7063         nil
7064       (setq gnus-thread-indent-array (make-vector 201 "")
7065             gnus-thread-indent-array-level gnus-thread-indent-level)
7066       (while (>= n 0)
7067         (aset gnus-thread-indent-array n
7068               (make-string (* n gnus-thread-indent-level) ? ))
7069         (setq n (1- n))))))
7070
7071 (defun gnus-summary-insert-line 
7072   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread 
7073                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
7074                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
7075   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
7076          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
7077          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
7078          (gnus-tmp-score-char
7079           (if (or (null gnus-summary-default-score)
7080                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7081                       gnus-summary-zcore-fuzz)) ? 
7082             (if (< gnus-tmp-score gnus-summary-default-score)
7083                 gnus-score-below-mark gnus-score-over-mark)))
7084          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
7085                                  ((memq gnus-tmp-current gnus-newsgroup-cached)
7086                                   gnus-cached-mark)
7087                                  (gnus-tmp-replied gnus-replied-mark)
7088                                  ((memq gnus-tmp-current gnus-newsgroup-saved)
7089                                   gnus-saved-mark)
7090                                  (t gnus-unread-mark)))
7091          (gnus-tmp-from (mail-header-from gnus-tmp-header))
7092          (gnus-tmp-name 
7093           (cond 
7094            ((string-match "(.+)" gnus-tmp-from)
7095             (substring gnus-tmp-from 
7096                        (1+ (match-beginning 0)) (1- (match-end 0))))
7097            ((string-match "<[^>]+> *$" gnus-tmp-from)
7098             (let ((beg (match-beginning 0)))
7099               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7100                        (substring gnus-tmp-from (1+ (match-beginning 0))
7101                                   (1- (match-end 0))))
7102                   (substring gnus-tmp-from 0 beg))))
7103            (t gnus-tmp-from)))
7104          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
7105          (gnus-tmp-number (mail-header-number gnus-tmp-header))
7106          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
7107          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
7108          (buffer-read-only nil))
7109     (when (string= gnus-tmp-name "")
7110       (setq gnus-tmp-name gnus-tmp-from))
7111     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7112     (put-text-property
7113      (point)
7114      (progn (eval gnus-summary-line-format-spec) (point))
7115      'gnus-number gnus-tmp-number)
7116     (when (gnus-visual-p 'summary-highlight 'highlight)
7117       (forward-line -1)
7118       (run-hooks 'gnus-summary-update-hook)
7119       (forward-line 1))))
7120
7121 (defun gnus-summary-update-line (&optional dont-update)
7122   ;; Update summary line after change.
7123   (when (and gnus-summary-default-score
7124              (not gnus-summary-inhibit-highlight))
7125     (let ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
7126           (article (gnus-summary-article-number)))
7127       (unless dont-update
7128         (if (and gnus-summary-mark-below
7129                  (< (gnus-summary-article-score)
7130                     gnus-summary-mark-below))
7131             ;; This article has a low score, so we mark it as read.
7132             (when (memq article gnus-newsgroup-unreads)
7133               (gnus-summary-mark-article-as-read gnus-low-score-mark))
7134           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
7135             ;; This article was previously marked as read on account
7136             ;; of a low score, but now it has risen, so we mark it as
7137             ;; unread. 
7138             (gnus-summary-mark-article-as-unread gnus-unread-mark))))
7139       ;; Do visual highlighting.
7140       (when (gnus-visual-p 'summary-highlight 'highlight)
7141         (run-hooks 'gnus-summary-update-hook)))))
7142
7143 (defvar gnus-tmp-new-adopts)
7144
7145 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
7146   ;; Sum up all elements (and sub-elements) in a list.
7147   (let* ((number
7148           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
7149           (cond ((and (consp thread) (cdr thread))
7150                  (apply
7151                   '+ 1 (mapcar
7152                         'gnus-summary-number-of-articles-in-thread 
7153                         (cdr thread))))
7154                 ((null thread)
7155                  1)
7156                 ((and level (zerop level) gnus-tmp-new-adopts)
7157                  (apply '+ 1 (mapcar 
7158                               'gnus-summary-number-of-articles-in-thread 
7159                               gnus-tmp-new-adopts)))
7160                 ((memq (mail-header-number (car thread))
7161                        gnus-newsgroup-limit)
7162                  1) 
7163                 (t 0))))
7164     (if char 
7165         (if (> number 1) gnus-not-empty-thread-mark
7166           gnus-empty-thread-mark)
7167       number)))
7168
7169 (defun gnus-summary-set-local-parameters (group)
7170  "Go through the local params of GROUP and set all variable specs in that list."
7171   (let ((params (gnus-info-params (gnus-get-info group)))
7172         elem)
7173     (while params
7174       (setq elem (car params)
7175             params (cdr params))
7176       (and (consp elem)                 ; Has to be a cons.
7177            (consp (cdr elem))           ; The cdr has to be a list.
7178            (symbolp (car elem))         ; Has to be a symbol in there.
7179            (progn                       ; So we set it.
7180              (make-local-variable (car elem))
7181              (set (car elem) (eval (nth 1 elem))))))))
7182
7183 (defun gnus-summary-read-group 
7184   (group &optional show-all no-article kill-buffer no-display)
7185   "Start reading news in newsgroup GROUP.
7186 If SHOW-ALL is non-nil, already read articles are also listed.
7187 If NO-ARTICLE is non-nil, no article is selected initially.
7188 If NO-DISPLAY, don't generate a summary buffer."
7189   (gnus-message 5 "Retrieving newsgroup: %s..." group)
7190   (let* ((new-group (gnus-summary-setup-buffer group))
7191          (quit-config (gnus-group-quit-config group))
7192          (did-select (and new-group (gnus-select-newsgroup group show-all))))
7193     (cond 
7194      ;; This summary buffer exists already, so we just select it. 
7195      ((not new-group)
7196       (gnus-set-global-variables)
7197       (gnus-kill-or-deaden-summary kill-buffer)
7198       (gnus-configure-windows 'summary 'force)
7199       (gnus-set-mode-line 'summary)
7200       (gnus-summary-position-point)
7201       (message "")
7202       t)
7203      ;; We couldn't select this group.
7204      ((null did-select) 
7205       (when (and (eq major-mode 'gnus-summary-mode)
7206                  (not (equal (current-buffer) kill-buffer)))
7207         (kill-buffer (current-buffer))
7208         (if (not quit-config)
7209             (progn
7210               (set-buffer gnus-group-buffer)
7211               (gnus-group-jump-to-group group)
7212               (gnus-group-next-unread-group 1))
7213           (if (not (buffer-name (car quit-config)))
7214               (gnus-configure-windows 'group 'force)
7215             (set-buffer (car quit-config))
7216             (and (eq major-mode 'gnus-summary-mode)
7217                  (gnus-set-global-variables))
7218             (gnus-configure-windows (cdr quit-config)))))
7219       (message "Can't select group")
7220       nil)
7221      ;; The user did a `C-g' while prompting for number of articles,
7222      ;; so we exit this group.
7223      ((eq did-select 'quit)
7224       (and (eq major-mode 'gnus-summary-mode)
7225            (not (equal (current-buffer) kill-buffer))
7226            (kill-buffer (current-buffer)))
7227       (gnus-kill-or-deaden-summary kill-buffer)
7228       (if (not quit-config)
7229           (progn
7230             (set-buffer gnus-group-buffer)
7231             (gnus-group-jump-to-group group)
7232             (gnus-group-next-unread-group 1)
7233             (gnus-configure-windows 'group 'force))
7234         (if (not (buffer-name (car quit-config)))
7235             (gnus-configure-windows 'group 'force)
7236           (set-buffer (car quit-config))
7237           (and (eq major-mode 'gnus-summary-mode)
7238                (gnus-set-global-variables))
7239           (gnus-configure-windows (cdr quit-config))))
7240       ;; Finallt signal the quit.
7241       (signal 'quit nil))
7242      ;; The group was successfully selected.
7243      (t
7244       (gnus-set-global-variables)
7245       ;; Save the active value in effect when the group was entered.
7246       (setq gnus-newsgroup-active 
7247             (gnus-copy-sequence
7248              (gnus-active gnus-newsgroup-name)))
7249       ;; You can change the summary buffer in some way with this hook.
7250       (run-hooks 'gnus-select-group-hook)
7251       ;; Set any local variables in the group parameters.
7252       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7253       ;; Do score processing.
7254       (when gnus-use-scoring
7255         (gnus-possibly-score-headers))
7256       (gnus-update-format-specifications)
7257       ;; Find the initial limit.
7258       (gnus-summary-initial-limit)
7259       ;; Generate the summary buffer.
7260       (unless no-display
7261         (gnus-summary-prepare))
7262       ;; If the summary buffer is empty, but there are some low-scored
7263       ;; articles or some excluded dormants, we include these in the
7264       ;; buffer. 
7265       (when (zerop (buffer-size))
7266         (cond (gnus-newsgroup-dormant
7267                (gnus-summary-limit-include-dormant))
7268               ((and gnus-newsgroup-scored show-all)
7269                (gnus-summary-limit-include-expunged))))
7270       ;; Function `gnus-apply-kill-file' must be called in this hook.
7271       (run-hooks 'gnus-apply-kill-hook)
7272       (if (zerop (buffer-size))
7273           (progn
7274             ;; This newsgroup is empty.
7275             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7276             (gnus-message 6 "No unread news")
7277             (gnus-kill-or-deaden-summary kill-buffer)
7278             ;; Return nil from this function.
7279             nil)
7280         ;; Hide conversation thread subtrees.  We cannot do this in
7281         ;; gnus-summary-prepare-hook since kill processing may not
7282         ;; work with hidden articles.
7283         (and gnus-show-threads
7284              gnus-thread-hide-subtree
7285              (gnus-summary-hide-all-threads))
7286         ;; Show first unread article if requested.
7287         (if (and (not no-article)
7288                  gnus-newsgroup-unreads
7289                  gnus-auto-select-first)
7290             (progn
7291               (if (eq gnus-auto-select-first 'best)
7292                   (gnus-summary-best-unread-article)
7293                 (gnus-summary-first-unread-article)))
7294           ;; Don't select any articles, just move point to the first
7295           ;; article in the group.
7296           (goto-char (point-min))
7297           (gnus-summary-position-point)
7298           (gnus-set-mode-line 'summary)
7299           (gnus-configure-windows 'summary 'force))
7300         ;; If we are in async mode, we send some info to the backend.
7301         (when gnus-newsgroup-async
7302           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7303         (gnus-kill-or-deaden-summary kill-buffer)
7304         (when (get-buffer-window gnus-group-buffer)
7305           ;; Gotta use windows, because recenter does wierd stuff if
7306           ;; the current buffer ain't the displayed window.
7307           (let ((owin (selected-window))) 
7308             (select-window (get-buffer-window gnus-group-buffer))
7309             (when (gnus-group-goto-group group)
7310               (recenter))
7311             (select-window owin))))
7312       ;; Mark this buffer as "prepared".
7313       (setq gnus-newsgroup-prepared t)
7314       t))))
7315
7316 (defun gnus-summary-prepare ()
7317   "Generate the summary buffer."
7318   (let ((buffer-read-only nil))
7319     (erase-buffer)
7320     (setq gnus-newsgroup-data nil
7321           gnus-newsgroup-data-reverse nil)
7322     (run-hooks 'gnus-summary-generate-hook)
7323     ;; Generate the buffer, either with threads or without.
7324     (gnus-summary-prepare-threads 
7325      (if gnus-show-threads
7326          (gnus-gather-threads (gnus-sort-threads (gnus-make-threads)))
7327        gnus-newsgroup-headers))
7328     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7329     ;; Call hooks for modifying summary buffer.
7330     (goto-char (point-min))
7331     (run-hooks 'gnus-summary-prepare-hook)))
7332
7333 (defun gnus-gather-threads (threads)
7334   "Gather threads that have lost their roots."
7335   (if (not gnus-summary-make-false-root)
7336       threads 
7337     (let ((hashtb (gnus-make-hashtable 1023))
7338           (prev threads)
7339           (result threads)
7340           subject hthread whole-subject)
7341       (while threads
7342         (setq whole-subject 
7343               (setq subject (mail-header-subject (car (car threads)))))
7344         (if (and gnus-summary-gather-exclude-subject
7345                  (string-match gnus-summary-gather-exclude-subject
7346                                subject))
7347             () ; We don't want to do anything with this.
7348           (if gnus-summary-gather-subject-limit
7349               (or (and (numberp gnus-summary-gather-subject-limit)
7350                        (> (length subject) gnus-summary-gather-subject-limit)
7351                        (setq subject
7352                              (substring subject 0 
7353                                         gnus-summary-gather-subject-limit)))
7354                   (and (eq 'fuzzy gnus-summary-gather-subject-limit)
7355                        (setq subject (gnus-simplify-subject-fuzzy subject))))
7356             (setq subject (gnus-simplify-subject-re subject)))
7357           (if (setq hthread 
7358                     (gnus-gethash subject hashtb))
7359               (progn
7360                 (or (stringp (car (car hthread)))
7361                     (setcar hthread (list whole-subject (car hthread))))
7362                 (setcdr (car hthread) (nconc (cdr (car hthread)) 
7363                                              (list (car threads))))
7364                 (setcdr prev (cdr threads))
7365                 (setq threads prev))
7366             (gnus-sethash subject threads hashtb)))
7367         (setq prev threads)
7368         (setq threads (cdr threads)))
7369       result)))
7370
7371 (defun gnus-make-threads ()
7372   "Go through the dependency hashtb and find the roots.  Return all threads."
7373   ;; Then we find all the roots and return all the threads.
7374   (let (threads)
7375     (mapatoms
7376      (lambda (refs)
7377        (or (car (symbol-value refs))
7378            (setq threads (append (cdr (symbol-value refs)) threads))))
7379      gnus-newsgroup-dependencies)
7380     threads))
7381   
7382 (defun gnus-build-old-threads ()
7383   ;; Look at all the articles that refer back to old articles, and
7384   ;; fetch the headers for the articles that aren't there.  This will
7385   ;; build complete threads - if the roots haven't been expired by the
7386   ;; server, that is.
7387   (let (id heads)
7388     (mapatoms
7389      (lambda (refs)
7390        (when (not (car (symbol-value refs)))
7391          (setq heads (cdr (symbol-value refs)))
7392          (while heads
7393            (if (memq (mail-header-number (car (car heads)))
7394                      gnus-newsgroup-dormant)
7395                (setq heads (cdr heads))
7396              (setq id (symbol-name refs))
7397              (while (and (setq id (gnus-build-get-header id))
7398                          (not (car (gnus-gethash 
7399                                     id gnus-newsgroup-dependencies)))))
7400              (setq heads nil)))))
7401      gnus-newsgroup-dependencies)))
7402
7403 (defun gnus-build-get-header (id)
7404   ;; Look through the buffer of NOV lines and find the header to
7405   ;; ID.  Enter this line into the dependencies hash table, and return
7406   ;; the id of the parent article (if any).
7407   (let ((deps gnus-newsgroup-dependencies)
7408         found header)
7409     (prog1
7410         (save-excursion
7411           (set-buffer nntp-server-buffer)
7412           (goto-char (point-min))
7413           (while (and (not found) (search-forward id nil t))
7414             (beginning-of-line)
7415             (setq found (looking-at 
7416                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
7417                                  (regexp-quote id))))
7418             (or found (beginning-of-line 2)))
7419           (when found
7420             (let (ref)
7421               (beginning-of-line)
7422               (and
7423                (setq header (gnus-nov-parse-line 
7424                              (read (current-buffer)) deps))
7425                (gnus-parent-id (mail-header-references header))))))
7426       (when header
7427         (let ((number (mail-header-number header)))
7428           (push number gnus-newsgroup-limit)
7429           (push header gnus-newsgroup-headers)
7430           (push number gnus-newsgroup-ancient))))))
7431
7432 (defun gnus-rebuild-thread (id)
7433   "Rebuild the thread containing ID."
7434   (let ((dep gnus-newsgroup-dependencies)
7435         (buffer-read-only nil)
7436         current headers refs thread art data)
7437     (if (not gnus-show-threads)
7438         (setq thread (list (car (gnus-gethash (downcase id) dep))))
7439       ;; Get the thread this article is part of.
7440       (setq thread (gnus-remove-thread id)))
7441     (setq current (save-excursion
7442                     (and (zerop (forward-line -1))
7443                          (gnus-summary-article-number))))
7444     ;; If this is a gathered thread, we have to go some re-gathering.
7445     (when (stringp (car thread))
7446       (let ((subject (car thread))
7447             roots thr)
7448         (setq thread (cdr thread))
7449         (while thread
7450           (unless (memq (setq thr (gnus-id-to-thread 
7451                                       (gnus-root-id
7452                                        (mail-header-id (car (car thread))))))
7453                         roots)
7454             (push thr roots))
7455           (setq thread (cdr thread)))
7456         ;; We now have all (unique) roots.
7457         (if (= (length roots) 1)
7458             ;; All the loose roots are now one solid root.
7459             (setq thread (car roots))
7460           (setq thread (cons subject (gnus-sort-threads roots))))))
7461     (let ((beg (point)) 
7462           threads)
7463       ;; We then insert this thread into the summary buffer.
7464       (let (gnus-newsgroup-data gnus-newsgroup-threads)
7465         (gnus-summary-prepare-threads (list thread))
7466         (setq data (nreverse gnus-newsgroup-data))
7467         (setq threads gnus-newsgroup-threads))
7468       ;; We splice the new data into the data structure.
7469       (gnus-data-enter-list current data)
7470       (gnus-data-compute-positions)
7471       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
7472
7473 (defun gnus-id-to-thread (id)
7474   "Return the (sub-)thread where ID appears."
7475   (gnus-gethash (downcase id) gnus-newsgroup-dependencies))
7476
7477 (defun gnus-root-id (id)
7478   "Return the id of the root of the thread where ID appears."
7479   (let (last-id prev)
7480     (while (and id (setq prev (car (gnus-gethash 
7481                                     (downcase id)
7482                                     gnus-newsgroup-dependencies))))
7483       (setq last-id id
7484             id (gnus-parent-id (mail-header-references prev))))
7485     last-id))
7486
7487 (defun gnus-remove-thread (id)
7488   "Remove the thread that has ID in it."
7489   (let ((dep gnus-newsgroup-dependencies)
7490         headers thread prev last-id)
7491     ;; First go up in this thread until we find the root.
7492     (setq last-id (gnus-root-id id))
7493     (setq headers (list (car (gnus-id-to-thread last-id))
7494                         (car (car (cdr (gnus-id-to-thread last-id))))))
7495     ;; We have now found the real root of this thread.  It might have
7496     ;; been gathered into some loose thread, so we have to search
7497     ;; through the threads to find the thread we wanted.
7498     (let ((threads gnus-newsgroup-threads)
7499           sub)
7500       (while threads
7501         (setq sub (car threads))
7502         (if (stringp (car sub))
7503             ;; This is a gathered threads, so we look at the roots
7504             ;; below it to find whether this article in in this
7505             ;; gathered root.
7506             (progn
7507               (setq sub (cdr sub))
7508               (while sub
7509                 (when (member (car (car sub)) headers)
7510                   (setq thread (car threads)
7511                         threads nil
7512                         sub nil))
7513                 (setq sub (cdr sub))))
7514           ;; It's an ordinary thread, so we check it.
7515           (when (eq (car sub) (car headers))
7516             (setq thread sub
7517                   threads nil)))
7518         (setq threads (cdr threads)))
7519       ;; If this article is in no thread, then it's a root. 
7520       (if thread 
7521           (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))
7522         (setq thread (gnus-gethash (downcase last-id) dep)))
7523       (when thread
7524         (prog1 
7525             thread ; We return this thread.
7526           (if (stringp (car thread))
7527               (progn
7528                 ;; If we use dummy roots, then we have to remove the
7529                 ;; dummy root as well.
7530                 (when (eq gnus-summary-make-false-root 'dummy)
7531                   ;; Uhm.
7532                   )
7533                 (setq thread (cdr thread))
7534                 (while thread
7535                   (gnus-remove-thread-1 (car thread))
7536                   (setq thread (cdr thread))))
7537             (gnus-remove-thread-1 thread)))))))
7538
7539 (defun gnus-remove-thread-1 (thread)
7540   "Remove the thread THREAD recursively."
7541   (let ((number (mail-header-number (car thread)))
7542         pos)
7543     (when (setq pos (text-property-any 
7544                      (point-min) (point-max) 'gnus-number number))
7545       (goto-char pos)
7546       (gnus-delete-line)
7547       (gnus-data-remove number))
7548     (setq thread (cdr thread))
7549     (while thread
7550       (gnus-remove-thread-1 (car thread))
7551       (setq thread (cdr thread)))))
7552
7553 (defun gnus-sort-threads (threads)
7554   "Sort THREADS as specified in `gnus-thread-sort-functions'."
7555   (let ((funs gnus-thread-sort-functions))
7556     (when funs
7557       (while funs
7558         (gnus-message 7 "Sorting with %S..." (car funs))
7559         (setq threads (sort threads (pop funs))))
7560       (gnus-message 7 "Sorting...done")))
7561   threads)
7562
7563 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
7564 (defmacro gnus-thread-header (thread)
7565   ;; Return header of first article in THREAD.
7566   ;; Note that THREAD must never, evr be anything else than a variable -
7567   ;; using some other form will lead to serious barfage.
7568   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
7569   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
7570   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; 
7571         (vector thread) 2))
7572
7573 (defsubst gnus-article-sort-by-number (h1 h2)
7574   "Sort articles by article number."
7575   (< (mail-header-number h1)
7576      (mail-header-number h2)))
7577
7578 (defun gnus-thread-sort-by-number (h1 h2)
7579   "Sort threads by root article number."
7580   (gnus-article-sort-by-number 
7581    (gnus-thread-header h1) (gnus-thread-header h2)))
7582
7583 (defsubst gnus-article-sort-by-author (h1 h2)
7584   "Sort articles by root author."
7585   (string-lessp
7586    (let ((extract (funcall 
7587                    gnus-extract-address-components
7588                    (mail-header-from h1))))
7589      (or (car extract) (cdr extract)))
7590    (let ((extract (funcall
7591                    gnus-extract-address-components 
7592                    (mail-header-from h2))))
7593      (or (car extract) (cdr extract)))))
7594
7595 (defun gnus-thread-sort-by-author (h1 h2)
7596   "Sort threads by root author."
7597   (gnus-article-sort-by-author
7598    (gnus-thread-header h1)  (gnus-thread-header h2)))
7599
7600 (defsubst gnus-article-sort-by-subject (h1 h2)
7601   "Sort articles by root subject."
7602   (string-lessp
7603    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
7604    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
7605
7606 (defun gnus-thread-sort-by-subject (h1 h2)
7607   "Sort threads by root subject."
7608   (gnus-article-sort-by-subject 
7609    (gnus-thread-header h1) (gnus-thread-header h2)))
7610
7611 (defsubst gnus-article-sort-by-date (h1 h2)
7612   "Sort articles by root article date."
7613   (string-lessp
7614    (gnus-sortable-date (mail-header-date h1))
7615    (gnus-sortable-date (mail-header-date h2))))
7616
7617 (defun gnus-thread-sort-by-date (h1 h2)
7618   "Sort threads by root article date."
7619   (gnus-article-sort-by-date 
7620    (gnus-thread-header h1) (gnus-thread-header h2)))
7621
7622 (defsubst gnus-article-sort-by-score (h1 h2)
7623   "Sort articles by root article score.
7624 Unscored articles will be counted as having a score of zero."
7625   (> (or (cdr (assq (mail-header-number h1)
7626                     gnus-newsgroup-scored))
7627          gnus-summary-default-score 0)
7628      (or (cdr (assq (mail-header-number h2)
7629                     gnus-newsgroup-scored))
7630          gnus-summary-default-score 0)))
7631
7632 (defun gnus-thread-sort-by-score (h1 h2)
7633   "Sort threads by root article score."
7634   (gnus-article-sort-by-score 
7635    (gnus-thread-header h1) (gnus-thread-header h2)))
7636
7637 (defun gnus-thread-sort-by-total-score (h1 h2)
7638   "Sort threads by the sum of all scores in the thread.
7639 Unscored articles will be counted as having a score of zero."
7640   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
7641
7642 (defun gnus-thread-total-score (thread)
7643   ;;  This function find the total score of THREAD.
7644   (if (consp thread)
7645       (if (stringp (car thread))
7646           (apply gnus-thread-score-function 0
7647                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
7648         (gnus-thread-total-score-1 thread))
7649     (gnus-thread-total-score-1 (list thread))))
7650
7651 (defun gnus-thread-total-score-1 (root)
7652   ;; This function find the total score of the thread below ROOT.
7653   (setq root (car root))
7654   (apply gnus-thread-score-function
7655          (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
7656              gnus-summary-default-score 0)
7657          (mapcar 'gnus-thread-total-score
7658                  (cdr (gnus-gethash (downcase (mail-header-id root))
7659                                     gnus-newsgroup-dependencies)))))
7660
7661 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
7662 (defvar gnus-tmp-prev-subject nil)
7663 (defvar gnus-tmp-false-parent nil)
7664 (defvar gnus-tmp-root-expunged nil)
7665 (defvar gnus-tmp-dummy-line nil)
7666
7667 (defun gnus-summary-prepare-threads (threads)
7668   "Prepare summary buffer from THREADS and indentation LEVEL.  
7669 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'  
7670 or a straight list of headers."
7671   (message "Generating summary...")
7672
7673   (setq gnus-newsgroup-threads threads)
7674   (beginning-of-line)
7675
7676   (let ((gnus-tmp-level 0)
7677         (default-score (or gnus-summary-default-score 0))
7678         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
7679         thread number subject stack state gnus-tmp-gathered beg-match
7680         new-roots gnus-tmp-new-adopts thread-end
7681         gnus-tmp-header gnus-tmp-unread
7682         gnus-tmp-replied gnus-tmp-subject-or-nil
7683         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
7684         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
7685         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
7686
7687     (setq gnus-tmp-prev-subject nil)
7688
7689     (if (vectorp (car threads))
7690         ;; If this is a straight (sic) list of headers, then a
7691         ;; threaded summary display isn't required, so we just create
7692         ;; an unthreaded one.
7693         (gnus-summary-prepare-unthreaded threads)
7694
7695       ;; Do the threaded display.
7696
7697       (while (or threads stack gnus-tmp-new-adopts new-roots)
7698
7699         (if (and (= gnus-tmp-level 0)
7700                  (not (setq gnus-tmp-dummy-line nil))
7701                  (or (not stack)
7702                      (= (car (car stack)) 0))
7703                  (not gnus-tmp-false-parent)
7704                  (or gnus-tmp-new-adopts new-roots))
7705             (if gnus-tmp-new-adopts
7706                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
7707                       thread (list (car gnus-tmp-new-adopts))
7708                       gnus-tmp-header (car (car thread))
7709                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
7710               (if new-roots
7711                   (setq thread (list (car new-roots))
7712                         gnus-tmp-header (car (car thread))
7713                         new-roots (cdr new-roots))))
7714
7715           (if threads
7716               ;; If there are some threads, we do them before the
7717               ;; threads on the stack.
7718               (setq thread threads
7719                     gnus-tmp-header (car (car thread)))
7720             ;; There were no current threads, so we pop something off
7721             ;; the stack. 
7722             (setq state (car stack)
7723                   gnus-tmp-level (car state)
7724                   thread (cdr state)
7725                   stack (cdr stack)
7726                   gnus-tmp-header (car (car thread)))))
7727
7728         (setq gnus-tmp-false-parent nil)
7729         (setq gnus-tmp-root-expunged nil)
7730         (setq thread-end nil)
7731
7732         (if (stringp gnus-tmp-header)
7733             ;; The header is a dummy root.
7734             (cond 
7735              ((eq gnus-summary-make-false-root 'adopt)
7736               ;; We let the first article adopt the rest.
7737               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
7738                                                (cdr (cdr (car thread)))))
7739               (setq gnus-tmp-gathered 
7740                     (nconc (mapcar
7741                             (lambda (h) (mail-header-number (car h)))
7742                             (cdr (cdr (car thread))))
7743                            gnus-tmp-gathered))
7744               (setq thread (cons (list (car (car thread))
7745                                        (car (cdr (car thread))))
7746                                  (cdr thread)))
7747               (setq gnus-tmp-level -1
7748                     gnus-tmp-false-parent t))
7749              ((eq gnus-summary-make-false-root 'empty)
7750               ;; We print adopted articles with empty subject fields.
7751               (setq gnus-tmp-gathered 
7752                     (nconc (mapcar
7753                             (lambda (h) (mail-header-number (car h)))
7754                             (cdr (cdr (car thread))))
7755                            gnus-tmp-gathered))
7756               (setq gnus-tmp-level -1))
7757              ((eq gnus-summary-make-false-root 'dummy)
7758               ;; We remember that we probably want to output a dummy
7759               ;; root.   
7760               (setq gnus-tmp-dummy-line gnus-tmp-header)
7761               (setq gnus-tmp-prev-subject gnus-tmp-header))
7762              (t
7763               ;; We do not make a root for the gathered
7764               ;; sub-threads at all.  
7765               (setq gnus-tmp-level -1)))
7766       
7767           (setq number (mail-header-number gnus-tmp-header)
7768                 subject (mail-header-subject gnus-tmp-header))
7769
7770           (cond 
7771            ;; If the thread has changed subject, we might want to make 
7772            ;; this subthread into a root.
7773            ((and (null gnus-thread-ignore-subject)
7774                  (not (zerop gnus-tmp-level))
7775                  gnus-tmp-prev-subject
7776                  (not (inline
7777                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
7778             (setq new-roots (nconc new-roots (list (car thread)))
7779                   thread-end t
7780                   gnus-tmp-header nil))
7781            ;; If the article lies outside the current limit,
7782            ;; then we do not display it.
7783            ((not (memq number gnus-newsgroup-limit))
7784             (setq gnus-tmp-gathered 
7785                   (nconc (mapcar
7786                           (lambda (h) (mail-header-number (car h)))
7787                           (cdr (car thread)))
7788                          gnus-tmp-gathered))
7789             (setq gnus-tmp-new-adopts (if (cdr (car thread))
7790                                           (append gnus-tmp-new-adopts 
7791                                                   (cdr (car thread)))
7792                                         gnus-tmp-new-adopts)
7793                   thread-end t
7794                   gnus-tmp-header nil)
7795             (when (zerop gnus-tmp-level)
7796               (setq gnus-tmp-root-expunged t)))
7797            ;; Perhaps this article is to be marked as read?
7798            ((and gnus-summary-mark-below
7799                  (< (or (cdr (assq number gnus-newsgroup-scored))
7800                         default-score)
7801                     gnus-summary-mark-below))
7802             (setq gnus-newsgroup-unreads 
7803                   (delq number gnus-newsgroup-unreads))
7804             (if gnus-newsgroup-auto-expire
7805                 (push number gnus-newsgroup-expirable)
7806               (push (cons number gnus-low-score-mark)
7807                     gnus-newsgroup-reads))))
7808           
7809           (when gnus-tmp-header
7810             ;; We may have an old dummy line to output before this
7811             ;; article.  
7812             (when gnus-tmp-dummy-line
7813               (gnus-summary-insert-dummy-line 
7814                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
7815               (setq gnus-tmp-dummy-line nil))
7816
7817             ;; Compute the mark.
7818             (setq 
7819              gnus-tmp-unread
7820              (cond 
7821               ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
7822               ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
7823               ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
7824               ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
7825               (t (or (cdr (assq number gnus-newsgroup-reads))
7826                      gnus-ancient-mark))))
7827
7828             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
7829                                   gnus-tmp-header gnus-tmp-level)
7830                   gnus-newsgroup-data)
7831
7832             ;; Actually insert the line.
7833             (setq 
7834              gnus-tmp-subject-or-nil
7835              (cond
7836               ((and gnus-thread-ignore-subject
7837                     gnus-tmp-prev-subject
7838                     (not (inline (gnus-subject-equal 
7839                                   gnus-tmp-prev-subject subject))))
7840                subject)
7841               ((zerop gnus-tmp-level)
7842                (if (and (eq gnus-summary-make-false-root 'empty)
7843                         (memq number gnus-tmp-gathered)
7844                         gnus-tmp-prev-subject
7845                         (inline (gnus-subject-equal
7846                                  gnus-tmp-prev-subject subject)))
7847                    gnus-summary-same-subject
7848                  subject))
7849               (t gnus-summary-same-subject)))
7850             (if (and (eq gnus-summary-make-false-root 'adopt)
7851                      (= gnus-tmp-level 1)
7852                      (memq number gnus-tmp-gathered))
7853                 (setq gnus-tmp-opening-bracket ?\<
7854                       gnus-tmp-closing-bracket ?\>)
7855               (setq gnus-tmp-opening-bracket ?\[
7856                     gnus-tmp-closing-bracket ?\]))
7857             (setq 
7858              gnus-tmp-indentation 
7859              (aref gnus-thread-indent-array gnus-tmp-level)
7860              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
7861              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
7862                                 gnus-summary-default-score 0)
7863              gnus-tmp-score-char
7864              (if (or (null gnus-summary-default-score)
7865                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7866                          gnus-summary-zcore-fuzz)) ? 
7867                (if (< gnus-tmp-score gnus-summary-default-score)
7868                    gnus-score-below-mark gnus-score-over-mark))
7869              gnus-tmp-replied
7870              (cond ((memq number gnus-newsgroup-processable)
7871                     gnus-process-mark)
7872                    ((memq number gnus-newsgroup-cached)
7873                     gnus-cached-mark)
7874                    ((memq number gnus-newsgroup-replied)
7875                     gnus-replied-mark)
7876                    (t gnus-unread-mark))
7877              gnus-tmp-from (mail-header-from gnus-tmp-header)
7878              gnus-tmp-name 
7879              (cond 
7880               ((string-match "(.+)" gnus-tmp-from)
7881                (substring gnus-tmp-from 
7882                           (1+ (match-beginning 0)) (1- (match-end 0))))
7883               ((string-match "<[^>]+> *$" gnus-tmp-from)
7884                (setq beg-match (match-beginning 0))
7885                (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7886                         (substring gnus-tmp-from (1+ (match-beginning 0))
7887                                    (1- (match-end 0))))
7888                    (substring gnus-tmp-from 0 beg-match)))
7889               (t gnus-tmp-from)))
7890             (when (string= gnus-tmp-name "")
7891               (setq gnus-tmp-name gnus-tmp-from))
7892             (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7893             (put-text-property
7894              (point)
7895              (progn (eval gnus-summary-line-format-spec) (point))
7896              'gnus-number number)
7897             (when gnus-visual-p
7898               (forward-line -1)
7899               (run-hooks 'gnus-summary-update-hook)
7900               (forward-line 1))
7901
7902             (setq gnus-tmp-prev-subject subject)))
7903
7904         (when (nth 1 thread) 
7905           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
7906         (incf gnus-tmp-level)
7907         (setq threads (if thread-end nil (cdr (car thread))))
7908         (unless threads
7909           (setq gnus-tmp-level 0)))))
7910   (message "Generating summary...done"))
7911
7912 (defun gnus-summary-prepare-unthreaded (headers)
7913   "Generate an unthreaded summary buffer based on HEADERS."
7914   (let (header number mark)
7915
7916     (while headers
7917       (setq header (car headers)
7918             headers (cdr headers)
7919             number (mail-header-number header))
7920
7921       ;; We may have to root out some bad articles...
7922       (when (memq number gnus-newsgroup-limit)
7923         (when (and gnus-summary-mark-below
7924                    (< (or (cdr (assq number gnus-newsgroup-scored))
7925                           gnus-summary-default-score 0)
7926                       gnus-summary-mark-below))
7927           (setq gnus-newsgroup-unreads 
7928                 (delq number gnus-newsgroup-unreads))
7929           (if gnus-newsgroup-auto-expire
7930               (push number gnus-newsgroup-expirable)
7931             (push (cons number gnus-low-score-mark)
7932                   gnus-newsgroup-reads)))
7933           
7934         (setq mark
7935               (cond 
7936                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
7937                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
7938                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
7939                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
7940                (t (or (cdr (assq number gnus-newsgroup-reads))
7941                       gnus-ancient-mark))))
7942         (setq gnus-newsgroup-data 
7943               (cons (gnus-data-make number mark (1+ (point)) header 0)
7944                     gnus-newsgroup-data))
7945         (gnus-summary-insert-line
7946          header 0 nil mark (memq number gnus-newsgroup-replied)
7947          (memq number gnus-newsgroup-expirable)
7948          (mail-header-subject header) nil
7949          (cdr (assq number gnus-newsgroup-scored))
7950          (memq number gnus-newsgroup-processable))))))
7951
7952 (defun gnus-select-newsgroup (group &optional read-all)
7953   "Select newsgroup GROUP.
7954 If READ-ALL is non-nil, all articles in the group are selected."
7955   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
7956          (info (nth 2 entry))
7957          articles)
7958
7959     (or (gnus-check-server
7960          (setq gnus-current-select-method (gnus-find-method-for-group group)))
7961         (error "Couldn't open server"))
7962     
7963     (or (and entry (not (eq (car entry) t))) ; Either it's active...
7964         (gnus-activate-group group) ; Or we can activate it...
7965         (progn ; Or we bug out.
7966           (kill-buffer (current-buffer))
7967           (error "Couldn't request group %s: %s" 
7968                  group (gnus-status-message group))))
7969
7970     (setq gnus-newsgroup-name group)
7971     (setq gnus-newsgroup-unselected nil)
7972     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
7973
7974     (and gnus-asynchronous
7975          (gnus-check-backend-function 
7976           'request-asynchronous gnus-newsgroup-name)
7977          (setq gnus-newsgroup-async
7978                (gnus-request-asynchronous gnus-newsgroup-name)))
7979
7980     ;; Adjust and set lists of article marks.
7981     (when info
7982       (gnus-adjust-marked-articles info))
7983
7984     (setq gnus-newsgroup-unreads 
7985           (gnus-set-difference
7986            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
7987            gnus-newsgroup-dormant))
7988
7989     (setq gnus-newsgroup-processable nil)
7990     
7991     (setq articles (gnus-articles-to-read group read-all))
7992     
7993     (cond 
7994      ((null articles) 
7995       (gnus-message 3 "Couldn't select newsgroup")
7996       'quit)
7997      ((eq articles 0) nil)
7998      (t
7999       ;; Init the dependencies hash table.
8000       (setq gnus-newsgroup-dependencies 
8001             (gnus-make-hashtable (length articles)))
8002       ;; Retrieve the headers and read them in.
8003       (gnus-message 5 "Fetching headers...")
8004       (setq gnus-newsgroup-headers 
8005             (if (eq 'nov 
8006                     (setq gnus-headers-retrieved-by
8007                           (gnus-retrieve-headers 
8008                            articles gnus-newsgroup-name
8009                            ;; We might want to fetch old headers, but
8010                            ;; not if there is only 1 article.
8011                            (and gnus-fetch-old-headers
8012                                 (or (and 
8013                                      (not (eq gnus-fetch-old-headers 'some))
8014                                      (not (numberp gnus-fetch-old-headers)))
8015                                     (> (length articles) 1))))))
8016                 (gnus-get-newsgroup-headers-xover articles)
8017               (gnus-get-newsgroup-headers)))
8018       (gnus-message 5 "Fetching headers...done")      
8019       ;; Set the initial limit.
8020       (setq gnus-newsgroup-limit (copy-sequence articles))
8021       ;; Remove canceled articles from the list of unread articles.
8022       (setq gnus-newsgroup-unreads
8023             (gnus-set-sorted-intersection 
8024              gnus-newsgroup-unreads
8025              (mapcar (lambda (headers) (mail-header-number headers))
8026                      gnus-newsgroup-headers)))
8027       ;; We might want to build some more threads first.
8028       (and gnus-fetch-old-headers
8029            (eq gnus-headers-retrieved-by 'nov)
8030            (gnus-build-old-threads))
8031       ;; Check whether auto-expire is to be done in this group.
8032       (setq gnus-newsgroup-auto-expire
8033             (gnus-group-auto-expirable-p group))
8034       ;; First and last article in this newsgroup.
8035       (and gnus-newsgroup-headers
8036            (setq gnus-newsgroup-begin 
8037                  (mail-header-number (car gnus-newsgroup-headers)))
8038            (setq gnus-newsgroup-end
8039                  (mail-header-number
8040                   (gnus-last-element gnus-newsgroup-headers))))
8041       (setq gnus-reffed-article-number -1)
8042       ;; GROUP is successfully selected.
8043       (or gnus-newsgroup-headers t)))))
8044
8045 (defun gnus-articles-to-read (group read-all)
8046   ;; Find out what articles the user wants to read.
8047   (let* ((articles
8048           ;; Select all articles if `read-all' is non-nil, or if there
8049           ;; are no unread articles.
8050           (if (or read-all
8051                   (and (zerop (length gnus-newsgroup-marked))
8052                        (zerop (length gnus-newsgroup-unreads))))
8053               (gnus-uncompress-range (gnus-active group))
8054             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked 
8055                           (copy-sequence gnus-newsgroup-unreads))
8056                   '<)))
8057          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
8058          (scored (length scored-list))
8059          (number (length articles))
8060          (marked (+ (length gnus-newsgroup-marked)
8061                     (length gnus-newsgroup-dormant)))
8062          (select
8063           (cond 
8064            ((numberp read-all)
8065             read-all)
8066            (t
8067             (condition-case ()
8068                 (cond 
8069                  ((and (or (<= scored marked) (= scored number))
8070                        (numberp gnus-large-newsgroup)
8071                        (> number gnus-large-newsgroup))
8072                   (let ((input
8073                          (read-string
8074                           (format
8075                            "How many articles from %s (default %d): "
8076                            gnus-newsgroup-name number))))
8077                     (if (string-match "^[ \t]*$" input) number input)))
8078                  ((and (> scored marked) (< scored number))
8079                   (let ((input
8080                          (read-string
8081                           (format "%s %s (%d scored, %d total): "
8082                                   "How many articles from"
8083                                   group scored number))))
8084                     (if (string-match "^[ \t]*$" input)
8085                         number input)))
8086                  (t number))
8087               (quit nil))))))
8088     (setq select (if (stringp select) (string-to-number select) select))
8089     (if (or (null select) (zerop select))
8090         select
8091       (if (and (not (zerop scored)) (<= (abs select) scored))
8092           (progn
8093             (setq articles (sort scored-list '<))
8094             (setq number (length articles)))
8095         (setq articles (copy-sequence articles)))
8096
8097       (if (< (abs select) number)
8098           (if (< select 0) 
8099               ;; Select the N oldest articles.
8100               (setcdr (nthcdr (1- (abs select)) articles) nil)
8101             ;; Select the N most recent articles.
8102             (setq articles (nthcdr (- number select) articles))))
8103       (setq gnus-newsgroup-unselected
8104             (gnus-sorted-intersection
8105              gnus-newsgroup-unreads
8106              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
8107       articles)))
8108
8109 (defun gnus-killed-articles (killed articles)
8110   (let (out)
8111     (while articles
8112       (if (inline (gnus-member-of-range (car articles) killed))
8113           (setq out (cons (car articles) out)))
8114       (setq articles (cdr articles)))
8115     out))
8116
8117 (defun gnus-adjust-marked-articles (info)
8118   "Set all article lists and remove all marks that are no longer legal."
8119   (let* ((marked-lists (gnus-info-marks info))
8120          (active (gnus-active (gnus-info-group info)))
8121          (min (car active))
8122          (max (cdr active))
8123          (types '((marked . tick) (replied . reply) 
8124                   (expirable . expire) (killed . killed)
8125                   (bookmarks . bookmark) (dormant . dormant)
8126                   (scored . score) (saved . save)))
8127          (uncompressed '(score bookmark))
8128          marks var articles article mark)
8129
8130     (while marked-lists
8131       (setq marks (pop marked-lists))
8132       (set (setq var (intern (format "gnus-newsgroup-%s" 
8133                                      (car (rassq (setq mark (car marks)) 
8134                                                  types)))))
8135            (if (memq (car marks) uncompressed) (cdr marks)
8136              (gnus-uncompress-range (cdr marks))))
8137
8138       (setq articles (symbol-value var))
8139
8140       ;; All articles have to be subsets of the active articles.  
8141       (cond 
8142        ;; Adjust "simple" lists.
8143        ((memq mark '(tick dormant expirable reply killed save))
8144         (while articles
8145           (when (or (< (setq article (pop articles)) min) (> article max))
8146             (set var (delq article (symbol-value var))))))
8147        ;; Adjust assocs.
8148        ((memq mark '(score bookmark))
8149         (while articles 
8150           (when (or (< (car (setq article (pop articles))) min) 
8151                     (> (car article) max))
8152             (set var (delq article (symbol-value var))))))))))
8153
8154 (defun gnus-update-marks ()
8155   "Enter the various lists of marked articles into the newsgroup info list."
8156   (let ((types '((marked . tick) (replied . reply) 
8157                  (expirable . expire) (killed . killed)
8158                  (bookmarks . bookmark) (dormant . dormant)
8159                  (scored . score) (saved . save)))
8160         (info (gnus-get-info gnus-newsgroup-name))
8161         (uncompressed '(score bookmark killed))
8162         var type list newmarked symbol)
8163     ;; Add all marks lists that are non-nil to the list of marks lists. 
8164     (while types
8165       (setq type (pop types))
8166       (when (setq list (symbol-value 
8167                         (setq symbol
8168                               (intern (format "gnus-newsgroup-%s" 
8169                                               (car type))))))
8170         (setq list (set symbol (sort list '<)))
8171         (push (cons (cdr type) 
8172                     (if (memq (cdr type) uncompressed) list
8173                       (gnus-compress-sequence list t)))
8174               newmarked)))
8175
8176     ;; Enter these new marks into the info of the group.
8177     (if (nthcdr 3 info)
8178         (setcar (nthcdr 3 info) newmarked)
8179       ;; Add the marks lists to the end of the info.
8180       (when newmarked
8181         (setcdr (nthcdr 2 info) (list newmarked))))
8182
8183     ;; Cut off the end of the info if there's nothing else there. 
8184     (let ((i 5))
8185       (while (and (> i 2)
8186                   (not (nth i info)))
8187         (when (nthcdr (decf i) info)
8188           (setcdr (nthcdr i info) nil))))))
8189
8190 (defun gnus-add-marked-articles (group type articles &optional info force)
8191   ;; Add ARTICLES of TYPE to the info of GROUP.
8192   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
8193   ;; add, but replace marked articles of TYPE with ARTICLES.
8194   (let ((info (or info (gnus-get-info group)))
8195         (uncompressed '(score bookmark killed))
8196         marked m)
8197     (or (not info)
8198         (and (not (setq marked (nthcdr 3 info)))
8199              (setcdr (nthcdr 2 info)
8200                      (list (list (cons type (gnus-compress-sequence
8201                                              articles t))))))
8202         (and (not (setq m (assq type (car marked))))
8203              (setcar marked 
8204                      (cons (cons type (gnus-compress-sequence articles t) )
8205                            (car marked))))
8206         (if force
8207             (setcdr m (gnus-compress-sequence articles t))
8208           (setcdr m (gnus-compress-sequence
8209                      (sort (nconc (gnus-uncompress-range m) 
8210                                   (copy-sequence articles)) '<) t))))))
8211          
8212 (defun gnus-set-mode-line (where)
8213   "This function sets the mode line of the article or summary buffers.
8214 If WHERE is `summary', the summary mode line format will be used."
8215   ;; Is this mode line one we keep updated?
8216   (when (memq where gnus-updated-mode-lines)
8217     (let (mode-string)
8218       (save-excursion
8219         ;; We evaluate this in the summary buffer since these
8220         ;; variables are buffer-local to that buffer.
8221         (set-buffer gnus-summary-buffer)
8222         ;; We bind all these variables that are used in the `eval' form
8223         ;; below. 
8224         (let* ((mformat (if (eq where 'article) 
8225                             gnus-article-mode-line-format-spec
8226                           gnus-summary-mode-line-format-spec))
8227                (gnus-tmp-group-name gnus-newsgroup-name)
8228                (gnus-tmp-article-number (or gnus-current-article 0))
8229                (gnus-tmp-unread gnus-newsgroup-unreads)
8230                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
8231                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
8232                (gnus-tmp-unread-and-unselected
8233                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
8234                             (zerop gnus-tmp-unselected)) "")
8235                       ((zerop gnus-tmp-unselected) 
8236                        (format "{%d more}" gnus-tmp-unread-and-unticked))
8237                       (t (format "{%d(+%d) more}"
8238                                  gnus-tmp-unread-and-unticked
8239                                  gnus-tmp-unselected))))
8240                (gnus-tmp-subject
8241                 (if (and gnus-current-headers
8242                          (vectorp gnus-current-headers))
8243                     (mail-header-subject gnus-current-headers) ""))
8244                max-len 
8245                header);; passed as argument to any user-format-funcs
8246           (setq mode-string (eval mformat))
8247           (setq max-len (max 4 (if gnus-mode-non-string-length
8248                                    (- (frame-width) 
8249                                       gnus-mode-non-string-length)
8250                                  (length mode-string))))
8251           ;; We might have to chop a bit of the string off...
8252           (when (> (length mode-string) max-len)
8253             (setq mode-string 
8254                   (concat (gnus-truncate-string mode-string (- max-len 3))
8255                           "...")))
8256           ;; Pad the mode string a bit.
8257           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
8258       ;; Update the mode line.
8259       (setq mode-line-buffer-identification (list mode-string))
8260       (set-buffer-modified-p t))))
8261
8262 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
8263   "Go through the HEADERS list and add all Xrefs to a hash table.
8264 The resulting hash table is returned, or nil if no Xrefs were found."
8265   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
8266          (virtual (memq 'virtual 
8267                         (assoc (symbol-name (car (gnus-find-method-for-group 
8268                                                   from-newsgroup)))
8269                                gnus-valid-select-methods)))     
8270          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
8271          (xref-hashtb (make-vector 63 0))
8272          start group entry number xrefs header)
8273     (while headers
8274       (setq header (pop headers))
8275       (when (and (setq xrefs (mail-header-xref header))
8276                  (not (memq (setq number (mail-header-number header))
8277                             unreads)))
8278         (setq start 0)
8279         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
8280           (setq start (match-end 0))
8281           (setq group (concat prefix (substring xrefs (match-beginning 1) 
8282                                                 (match-end 1))))
8283           (setq number 
8284                 (string-to-int (substring xrefs (match-beginning 2) 
8285                                           (match-end 2))))
8286           (if (setq entry (gnus-gethash group xref-hashtb))
8287               (setcdr entry (cons number (cdr entry)))
8288             (gnus-sethash group (cons number nil) xref-hashtb)))))
8289     (and start xref-hashtb)))
8290
8291 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
8292   "Look through all the headers and mark the Xrefs as read."
8293   (let ((virtual (memq 'virtual 
8294                        (assoc (symbol-name (car (gnus-find-method-for-group 
8295                                                  from-newsgroup)))
8296                               gnus-valid-select-methods)))
8297         name entry info xref-hashtb idlist method
8298         nth4)
8299     (save-excursion
8300       (set-buffer gnus-group-buffer)
8301       (when (setq xref-hashtb 
8302                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
8303         (mapatoms 
8304          (lambda (group)
8305            (unless (string= from-newsgroup (setq name (symbol-name group)))
8306              (setq idlist (symbol-value group))
8307              ;; Dead groups are not updated.
8308              (and (prog1 
8309                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
8310                             info (nth 2 entry))
8311                     (if (stringp (setq nth4 (gnus-info-method info)))
8312                         (setq nth4 (gnus-server-to-method nth4))))
8313                   ;; Only do the xrefs if the group has the same
8314                   ;; select method as the group we have just read.
8315                   (or (gnus-methods-equal-p 
8316                        nth4 (gnus-find-method-for-group from-newsgroup))
8317                       virtual
8318                       (equal nth4 (setq method (gnus-find-method-for-group 
8319                                                 from-newsgroup)))
8320                       (and (equal (car nth4) (car method))
8321                            (equal (nth 1 nth4) (nth 1 method))))
8322                   gnus-use-cross-reference
8323                   (or (not (eq gnus-use-cross-reference t))
8324                       virtual
8325                       ;; Only do cross-references on subscribed
8326                       ;; groups, if that is what is wanted.  
8327                       (<= (gnus-info-level info) gnus-level-subscribed))
8328                   (gnus-group-make-articles-read name idlist))))
8329          xref-hashtb)))))
8330
8331 (defun gnus-group-make-articles-read (group articles)
8332   (let* ((num 0)
8333          (entry (gnus-gethash group gnus-newsrc-hashtb))
8334          (info (nth 2 entry))
8335          (active (gnus-active group))
8336          range)
8337     ;; First peel off all illegal article numbers.
8338     (if active
8339         (let ((ids articles)
8340               id first)
8341           (while ids
8342             (setq id (car ids))
8343             (if (and first (> id (cdr active)))
8344                 (progn
8345                   ;; We'll end up in this situation in one particular
8346                   ;; obscure situation.  If you re-scan a group and get
8347                   ;; a new article that is cross-posted to a different
8348                   ;; group that has not been re-scanned, you might get
8349                   ;; crossposted article that has a higher number than
8350                   ;; Gnus believes possible.  So we re-activate this
8351                   ;; group as well.  This might mean doing the
8352                   ;; crossposting thingie will *increase* the number
8353                   ;; of articles in some groups.  Tsk, tsk.
8354                   (setq active (or (gnus-activate-group group) active))))
8355             (if (or (> id (cdr active))
8356                     (< id (car active)))
8357                 (setq articles (delq id articles)))
8358             (setq ids (cdr ids)))))
8359     ;; If the read list is nil, we init it.
8360     (and active
8361          (null (gnus-info-read info))
8362          (> (car active) 1)
8363          (gnus-info-set-read info (cons 1 (1- (car active)))))
8364     ;; Then we add the read articles to the range.
8365     (gnus-info-set-read
8366      info
8367      (setq range
8368            (gnus-add-to-range 
8369             (gnus-info-read info) (setq articles (sort articles '<)))))
8370     ;; Then we have to re-compute how many unread
8371     ;; articles there are in this group.
8372     (if active
8373         (progn
8374           (cond 
8375            ((not range)
8376             (setq num (- (1+ (cdr active)) (car active))))
8377            ((not (listp (cdr range)))
8378             (setq num (- (cdr active) (- (1+ (cdr range)) 
8379                                          (car range)))))
8380            (t
8381             (while range
8382               (if (numberp (car range))
8383                   (setq num (1+ num))
8384                 (setq num (+ num (- (1+ (cdr (car range)))
8385                                     (car (car range))))))
8386               (setq range (cdr range)))
8387             (setq num (- (cdr active) num))))
8388           ;; Update the number of unread articles.
8389           (setcar entry num)
8390           ;; Update the group buffer.
8391           (gnus-group-update-group group t)))))
8392
8393 (defun gnus-methods-equal-p (m1 m2)
8394   (let ((m1 (or m1 gnus-select-method))
8395         (m2 (or m2 gnus-select-method)))
8396     (or (equal m1 m2)
8397         (and (eq (car m1) (car m2))
8398              (or (not (memq 'address (assoc (symbol-name (car m1))
8399                                             gnus-valid-select-methods)))
8400                  (equal (nth 1 m1) (nth 1 m2)))))))
8401
8402 (defsubst gnus-header-value ()
8403   (buffer-substring (match-end 0) (gnus-point-at-eol)))
8404
8405 (defvar gnus-newsgroup-none-id 0)
8406
8407 (defun gnus-get-newsgroup-headers (&optional dependencies)
8408   (let ((cur nntp-server-buffer)
8409         (dependencies 
8410          (or dependencies
8411              (save-excursion (set-buffer gnus-summary-buffer)
8412                              gnus-newsgroup-dependencies)))
8413         headers id id-dep ref-dep end ref)
8414     (save-excursion
8415       (set-buffer nntp-server-buffer)
8416       (let ((case-fold-search t)
8417             in-reply-to header number p lines)
8418         (goto-char (point-min))
8419         ;; Search to the beginning of the next header.  Error messages
8420         ;; do not begin with 2 or 3.
8421         (while (re-search-forward "^[23][0-9]+ " nil t)
8422           (setq id nil
8423                 ref nil)
8424           ;; This implementation of this function, with nine
8425           ;; search-forwards instead of the one re-search-forward and
8426           ;; a case (which basically was the old function) is actually
8427           ;; about twice as fast, even though it looks messier.  You
8428           ;; can't have everything, I guess.  Speed and elegance
8429           ;; doesn't always go hand in hand.
8430           (setq 
8431            header
8432            (vector
8433             ;; Number.
8434             (prog1
8435                 (read cur)
8436               (end-of-line)
8437               (setq p (point))
8438               (narrow-to-region (point) 
8439                                 (or (and (search-forward "\n.\n" nil t)
8440                                          (- (point) 2))
8441                                     (point))))
8442             ;; Subject.
8443             (progn
8444               (goto-char p)
8445               (if (search-forward "\nsubject: " nil t)
8446                   (gnus-header-value) "(none)"))
8447             ;; From.
8448             (progn
8449               (goto-char p)
8450               (if (search-forward "\nfrom: " nil t)
8451                   (gnus-header-value) "(nobody)"))
8452             ;; Date.
8453             (progn
8454               (goto-char p)
8455               (if (search-forward "\ndate: " nil t)
8456                   (gnus-header-value) ""))
8457             ;; Message-ID.
8458             (progn
8459               (goto-char p)
8460               (if (search-forward "\nmessage-id: " nil t)
8461                   (setq id (gnus-header-value))
8462                 ;; If there was no message-id, we just fake one to make
8463                 ;; subsequent routines simpler.
8464                 (setq id (concat "none+" 
8465                                  (int-to-string 
8466                                   (setq gnus-newsgroup-none-id 
8467                                         (1+ gnus-newsgroup-none-id)))))))
8468             ;; References.
8469             (progn
8470               (goto-char p)
8471               (if (search-forward "\nreferences: " nil t)
8472                   (prog1
8473                       (gnus-header-value)
8474                     (setq end (match-end 0))
8475                     (save-excursion
8476                       (setq ref 
8477                             (downcase
8478                              (buffer-substring
8479                               (progn 
8480                                 (end-of-line)
8481                                 (search-backward ">" end t)
8482                                 (1+ (point)))
8483                               (progn
8484                                 (search-backward "<" end t)
8485                                 (point)))))))
8486                 ;; Get the references from the in-reply-to header if there
8487                 ;; were no references and the in-reply-to header looks
8488                 ;; promising. 
8489                 (if (and (search-forward "\nin-reply-to: " nil t)
8490                          (setq in-reply-to (gnus-header-value))
8491                          (string-match "<[^>]+>" in-reply-to))
8492                     (prog1
8493                         (setq ref (substring in-reply-to (match-beginning 0)
8494                                              (match-end 0)))
8495                       (setq ref (downcase ref))))
8496                 (setq ref "")))
8497             ;; Chars.
8498             0
8499             ;; Lines.
8500             (progn
8501               (goto-char p)
8502               (if (search-forward "\nlines: " nil t)
8503                   (if (numberp (setq lines (read cur)))
8504                       lines 0)
8505                 0))
8506             ;; Xref.
8507             (progn
8508               (goto-char p)
8509               (and (search-forward "\nxref: " nil t)
8510                    (gnus-header-value)))))
8511           (if (and gnus-nocem-hashtb
8512                    (gnus-gethash id gnus-nocem-hashtb))
8513               ;; Banned article.
8514               (setq header nil)
8515             ;; We do the threading while we read the headers.  The
8516             ;; message-id and the last reference are both entered into
8517             ;; the same hash table.  Some tippy-toeing around has to be
8518             ;; done in case an article has arrived before the article
8519             ;; which it refers to.
8520             (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8521                 (if (car (symbol-value id-dep))
8522                     ;; An article with this Message-ID has already
8523                     ;; been seen, so we ignore this one, except we add
8524                     ;; any additional Xrefs (in case the two articles
8525                     ;; came from different servers).
8526                     (progn
8527                       (mail-header-set-xref 
8528                        (car (symbol-value id-dep))
8529                        (concat (or (mail-header-xref 
8530                                     (car (symbol-value id-dep))) "")
8531                                (or (mail-header-xref header) "")))
8532                       (setq header nil))
8533                   (setcar (symbol-value id-dep) header))
8534               (set id-dep (list header))))
8535           (if header
8536               (progn
8537                 (if (boundp (setq ref-dep (intern ref dependencies)))
8538                     (setcdr (symbol-value ref-dep) 
8539                             (nconc (cdr (symbol-value ref-dep))
8540                                    (list (symbol-value id-dep))))
8541                   (set ref-dep (list nil (symbol-value id-dep))))
8542                 (setq headers (cons header headers))))
8543           (goto-char (point-max))
8544           (widen))
8545         (nreverse headers)))))
8546
8547 ;; The following macros and functions were written by Felix Lee
8548 ;; <flee@cse.psu.edu>. 
8549
8550 (defmacro gnus-nov-read-integer ()
8551   '(prog1
8552        (if (= (following-char) ?\t)
8553            0
8554          (let ((num (condition-case nil (read buffer) (error nil))))
8555            (if (numberp num) num 0)))
8556      (or (eobp) (forward-char 1))))
8557
8558 (defmacro gnus-nov-skip-field ()
8559   '(search-forward "\t" eol 'move))
8560
8561 (defmacro gnus-nov-field ()
8562   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
8563
8564 ;; Goes through the xover lines and returns a list of vectors
8565 (defun gnus-get-newsgroup-headers-xover (sequence)
8566   "Parse the news overview data in the server buffer, and return a
8567 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
8568   ;; Get the Xref when the users reads the articles since most/some
8569   ;; NNTP servers do not include Xrefs when using XOVER.
8570   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
8571   (let ((cur nntp-server-buffer)
8572         (dependencies gnus-newsgroup-dependencies)
8573         number headers header)
8574     (save-excursion
8575       (set-buffer nntp-server-buffer)
8576       ;; Allow the user to mangle the headers before parsing them.
8577       (run-hooks 'gnus-parse-headers-hook)
8578       ;; Allow the user to mangle the headers before parsing them.
8579       (run-hooks 'gnus-parse-headers-hook)
8580       (goto-char (point-min))
8581       (while (and sequence (not (eobp)))
8582         (setq number (read cur))
8583         (while (and sequence (< (car sequence) number))
8584           (setq sequence (cdr sequence)))
8585         (and sequence 
8586              (eq number (car sequence))
8587              (progn
8588                (setq sequence (cdr sequence))
8589                (if (setq header 
8590                          (inline (gnus-nov-parse-line number dependencies)))
8591                    (setq headers (cons header headers)))))
8592         (forward-line 1))
8593       (setq headers (nreverse headers)))
8594     headers))
8595
8596 ;; This function has to be called with point after the article number
8597 ;; on the beginning of the line.
8598 (defun gnus-nov-parse-line (number dependencies)
8599   (let ((none 0)
8600         (eol (gnus-point-at-eol)) 
8601         (buffer (current-buffer))
8602         header ref id id-dep ref-dep)
8603
8604     ;; overview: [num subject from date id refs chars lines misc]
8605     (narrow-to-region (point) eol)
8606     (or (eobp) (forward-char))
8607
8608     (condition-case nil
8609         (setq header
8610               (vector 
8611                number                   ; number
8612                (gnus-nov-field)         ; subject
8613                (gnus-nov-field)         ; from
8614                (gnus-nov-field)         ; date
8615                (setq id (or (gnus-nov-field)
8616                             (concat "none+"
8617                                     (int-to-string 
8618                                      (setq none (1+ none)))))) ; id
8619                (progn
8620                  (save-excursion
8621                    (let ((beg (point)))
8622                      (search-forward "\t" eol)
8623                      (if (search-backward ">" beg t)
8624                          (setq ref 
8625                                (downcase 
8626                                 (buffer-substring 
8627                                  (1+ (point))
8628                                  (progn
8629                                    (search-backward "<" beg t)
8630                                    (point)))))
8631                        (setq ref nil))))
8632                  (gnus-nov-field))      ; refs
8633                (gnus-nov-read-integer)  ; chars
8634                (gnus-nov-read-integer)  ; lines
8635                (if (= (following-char) ?\n)
8636                    nil
8637                  (gnus-nov-field))      ; misc
8638                ))
8639       (error (progn 
8640                (ding)
8641                (message "Strange nov line.")
8642                (setq header nil)
8643                (goto-char eol))))
8644
8645     (widen)
8646
8647     ;; We build the thread tree.
8648     (and header
8649          (if (and gnus-nocem-hashtb
8650                   (gnus-gethash id gnus-nocem-hashtb))
8651              ;; Banned article.
8652              (setq header nil)
8653            (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8654                (if (car (symbol-value id-dep))
8655                    ;; An article with this Message-ID has already been seen,
8656                    ;; so we ignore this one, except we add any additional
8657                    ;; Xrefs (in case the two articles came from different
8658                    ;; servers.
8659                    (progn
8660                      (mail-header-set-xref 
8661                       (car (symbol-value id-dep))
8662                       (concat (or (mail-header-xref 
8663                                    (car (symbol-value id-dep))) "")
8664                               (or (mail-header-xref header) "")))
8665                      (setq header nil))
8666                  (setcar (symbol-value id-dep) header))
8667              (set id-dep (list header)))))
8668     (if header
8669         (progn
8670           (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
8671               (setcdr (symbol-value ref-dep) 
8672                       (nconc (cdr (symbol-value ref-dep))
8673                              (list (symbol-value id-dep))))
8674             (set ref-dep (list nil (symbol-value id-dep))))))
8675     header))
8676
8677 (defun gnus-article-get-xrefs ()
8678   "Fill in the Xref value in `gnus-current-headers', if necessary.
8679 This is meant to be called in `gnus-article-internal-prepare-hook'."
8680   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
8681                                  gnus-current-headers)))
8682     (or (not gnus-use-cross-reference)
8683         (not headers)
8684         (and (mail-header-xref headers)
8685              (not (string= (mail-header-xref headers) "")))
8686         (let ((case-fold-search t)
8687               xref)
8688           (save-restriction
8689             (gnus-narrow-to-headers)
8690             (goto-char (point-min))
8691             (if (or (and (eq (downcase (following-char)) ?x)
8692                          (looking-at "Xref:"))
8693                     (search-forward "\nXref:" nil t))
8694                 (progn
8695                   (goto-char (1+ (match-end 0)))
8696                   (setq xref (buffer-substring (point) 
8697                                                (progn (end-of-line) (point))))
8698                   (mail-header-set-xref headers xref))))))))
8699
8700 (defun gnus-summary-insert-subject (id)
8701   "Find article ID and insert the summary line for that article."
8702   (let ((header (gnus-read-header id))
8703         number)
8704     (when header
8705       ;; Rebuild the thread that this article is part of and go to the
8706       ;; article we have fetched.
8707       (gnus-rebuild-thread (mail-header-id header))
8708       (gnus-summary-goto-subject (setq number (mail-header-number header)))
8709       (when (> number 0)
8710         ;; We have to update the boundaries, possibly.
8711         (and (> number gnus-newsgroup-end)
8712              (setq gnus-newsgroup-end number))
8713         (and (< number gnus-newsgroup-begin)
8714              (setq gnus-newsgroup-begin number))
8715         (setq gnus-newsgroup-unselected
8716               (delq number gnus-newsgroup-unselected)))
8717       ;; Report back a success.
8718       number)))
8719
8720 (defun gnus-summary-work-articles (n)
8721   "Return a list of articles to be worked upon.  The prefix argument,
8722 the list of process marked articles, and the current article will be
8723 taken into consideration."
8724   (cond
8725    ((and n (numberp n))
8726     ;; A numerical prefix has been given.
8727     (let ((backward (< n 0))
8728           (n (abs n))
8729           articles article)
8730       (save-excursion
8731         (while 
8732             (and (> n 0)
8733                  (push (setq article (gnus-summary-article-number))
8734                        articles)
8735                  (if backward
8736                      (gnus-summary-find-prev nil article)
8737                    (gnus-summary-find-next nil article)))
8738           (decf n)))
8739       (nreverse articles)))
8740    ((and (boundp 'transient-mark-mode)
8741          transient-mark-mode
8742          mark-active)
8743     ;; Work on the region between point and mark.
8744     (let ((max (max (point) (mark)))
8745           articles article)
8746       (save-excursion
8747         (goto-char (min (point) (mark)))
8748         (while 
8749             (and 
8750              (push (setq article (gnus-summary-article-number)) articles)
8751              (gnus-summary-find-next nil article)
8752              (< (point) max)))
8753         (nreverse articles))))
8754    (gnus-newsgroup-processable
8755     ;; There are process-marked articles present.
8756     (reverse gnus-newsgroup-processable))
8757    (t
8758     ;; Just return the current article.
8759     (list (gnus-summary-article-number)))))
8760
8761 (defun gnus-summary-search-group (&optional backward use-level)
8762   "Search for next unread newsgroup.
8763 If optional argument BACKWARD is non-nil, search backward instead."
8764   (save-excursion
8765     (set-buffer gnus-group-buffer)
8766     (if (gnus-group-search-forward 
8767          backward nil (if use-level (gnus-group-group-level) nil))
8768         (gnus-group-group-name))))
8769
8770 (defun gnus-summary-best-group (&optional exclude-group)
8771   "Find the name of the best unread group.
8772 If EXCLUDE-GROUP, do not go to this group."
8773   (save-excursion
8774     (set-buffer gnus-group-buffer)
8775     (save-excursion
8776       (gnus-group-best-unread-group exclude-group))))
8777
8778 (defun gnus-summary-find-next (&optional unread article backward)
8779   (if backward (gnus-summary-find-prev)
8780     (let* ((article (or article (gnus-summary-article-number)))
8781            (arts (gnus-data-find-list article))
8782            result)
8783       (when (or (not gnus-summary-check-current)
8784                 (not unread)
8785                 (not (gnus-data-unread-p (car arts))))
8786         (setq arts (cdr arts)))
8787       (when (setq result
8788                   (if unread
8789                       (progn
8790                         (while arts
8791                           (when (gnus-data-unread-p (car arts))
8792                             (setq result (car arts)
8793                                   arts nil))
8794                           (setq arts (cdr arts)))
8795                         result)
8796                     (car arts)))
8797         (goto-char (gnus-data-pos result))
8798         (gnus-data-number result)))))
8799
8800 (defun gnus-summary-find-prev (&optional unread article)
8801   (let* ((article (or article (gnus-summary-article-number)))
8802          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
8803          result)
8804     (when (or (not gnus-summary-check-current)
8805               (not unread)
8806               (not (gnus-data-unread-p (car arts))))
8807       (setq arts (cdr arts)))
8808     (if (setq result
8809               (if unread
8810                   (progn
8811                     (while arts
8812                       (and (gnus-data-unread-p (car arts))
8813                            (setq result (car arts)
8814                                  arts nil))
8815                       (setq arts (cdr arts)))
8816                     result)
8817                 (car arts)))
8818         (progn
8819           (goto-char (gnus-data-pos result))
8820           (gnus-data-number result)))))
8821
8822 (defun gnus-summary-find-subject (subject &optional unread backward article)
8823   (let* ((article (or article (gnus-summary-article-number)))
8824          (articles (gnus-data-list backward))
8825          (arts (gnus-data-find-list article articles))
8826          result)
8827     (when (or (not gnus-summary-check-current)
8828               (not unread)
8829               (not (gnus-data-unread-p (car arts))))
8830       (setq arts (cdr arts)))
8831     (while arts
8832       (and (or (not unread)
8833                (gnus-data-unread-p (car arts)))
8834            (vectorp (gnus-data-header (car arts)))
8835            (gnus-subject-equal 
8836             subject (mail-header-subject (gnus-data-header (car arts))))
8837            (setq result (car arts)
8838                  arts nil))
8839       (setq arts (cdr arts)))
8840     (and result
8841          (goto-char (gnus-data-pos result))
8842          (gnus-data-number result))))
8843
8844 (defun gnus-summary-search-forward (&optional unread subject backward)
8845   (cond (subject
8846          (gnus-summary-find-subject subject unread backward))
8847         (backward
8848          (gnus-summary-find-prev unread))
8849         (t
8850          (gnus-summary-find-next unread))))
8851
8852 (defun gnus-summary-recenter ()
8853   "Center point in the summary window.
8854 If `gnus-auto-center-summary' is nil, or the article buffer isn't
8855 displayed, no centering will be performed." 
8856   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
8857   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
8858   (let* ((top (cond ((< (window-height) 4) 0)
8859                     ((< (window-height) 7) 1)
8860                     (t 2)))
8861          (height (1- (window-height)))
8862          (bottom (save-excursion (goto-char (point-max))
8863                                  (forward-line (- height))
8864                                  (point)))
8865          (window (get-buffer-window (current-buffer))))
8866     (and 
8867      ;; The user has to want it,
8868      gnus-auto-center-summary 
8869      ;; the article buffer must be displayed,
8870      (get-buffer-window gnus-article-buffer)
8871      ;; Set the window start to either `bottom', which is the biggest
8872      ;; possible valid number, or the second line from the top,
8873      ;; whichever is the least.
8874      (set-window-start
8875       window (min bottom (save-excursion (forward-line (- top)) (point)))))))
8876
8877 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
8878 (defun gnus-short-group-name (group &optional levels)
8879   "Collapse GROUP name LEVELS."
8880   (let* ((name "") (foreign "") (depth -1) (skip 1)
8881          (levels (or levels
8882                      (progn
8883                        (while (string-match "\\." group skip)
8884                          (setq skip (match-end 0)
8885                                depth (+ depth 1)))
8886                        depth))))
8887     (if (string-match ":" group)
8888         (setq foreign (substring group 0 (match-end 0))
8889               group (substring group (match-end 0))))
8890     (while group
8891       (if (and (string-match "\\." group) (> levels 0))
8892           (setq name (concat name (substring group 0 1))
8893                 group (substring group (match-end 0))
8894                 levels (- levels 1)
8895                 name (concat name "."))
8896         (setq name (concat foreign name group)
8897               group nil)))
8898     name))
8899
8900 (defun gnus-summary-jump-to-group (newsgroup)
8901   "Move point to NEWSGROUP in group mode buffer."
8902   ;; Keep update point of group mode buffer if visible.
8903   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
8904       (save-window-excursion
8905         ;; Take care of tree window mode.
8906         (if (get-buffer-window gnus-group-buffer)
8907             (pop-to-buffer gnus-group-buffer))
8908         (gnus-group-jump-to-group newsgroup))
8909     (save-excursion
8910       ;; Take care of tree window mode.
8911       (if (get-buffer-window gnus-group-buffer)
8912           (pop-to-buffer gnus-group-buffer)
8913         (set-buffer gnus-group-buffer))
8914       (gnus-group-jump-to-group newsgroup))))
8915
8916 ;; This function returns a list of article numbers based on the
8917 ;; difference between the ranges of read articles in this group and
8918 ;; the range of active articles.
8919 (defun gnus-list-of-unread-articles (group)
8920   (let* ((read (gnus-info-read (gnus-get-info group)))
8921          (active (gnus-active group))
8922          (last (cdr active))
8923          first nlast unread)
8924     ;; If none are read, then all are unread. 
8925     (if (not read)
8926         (setq first (car active))
8927       ;; If the range of read articles is a single range, then the
8928       ;; first unread article is the article after the last read
8929       ;; article.  Sounds logical, doesn't it?
8930       (if (not (listp (cdr read)))
8931           (setq first (1+ (cdr read)))
8932         ;; `read' is a list of ranges.
8933         (if (/= (setq nlast (or (and (numberp (car read)) (car read)) 
8934                                 (car (car read)))) 1)
8935             (setq first 1))
8936         (while read
8937           (if first 
8938               (while (< first nlast)
8939                 (setq unread (cons first unread))
8940                 (setq first (1+ first))))
8941           (setq first (1+ (if (atom (car read)) (car read) (cdr (car read)))))
8942           (setq nlast (if (atom (car (cdr read))) 
8943                           (car (cdr read))
8944                         (car (car (cdr read)))))
8945           (setq read (cdr read)))))
8946     ;; And add the last unread articles.
8947     (while (<= first last)
8948       (setq unread (cons first unread))
8949       (setq first (1+ first)))
8950     ;; Return the list of unread articles.
8951     (nreverse unread)))
8952
8953 (defun gnus-list-of-read-articles (group)
8954   "Return a list of unread, unticked and non-dormant articles."
8955   (let* ((info (gnus-get-info group))
8956          (marked (gnus-info-marks info))
8957          (active (gnus-active group)))
8958     (and info active
8959          (gnus-set-difference
8960           (gnus-sorted-complement 
8961            (gnus-uncompress-range active) 
8962            (gnus-list-of-unread-articles group))
8963           (append 
8964            (gnus-uncompress-range (cdr (assq 'dormant marked)))
8965            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
8966
8967 ;; Various summary commands
8968
8969 (defun gnus-summary-universal-argument ()
8970   "Perform any operation on all articles marked with the process mark."
8971   (interactive)
8972   (gnus-set-global-variables)
8973   (let ((articles (reverse gnus-newsgroup-processable))
8974         func)
8975     (or articles (error "No articles marked"))
8976     (or (setq func (key-binding (read-key-sequence "C-c C-u")))
8977         (error "Undefined key"))
8978     (while articles
8979       (gnus-summary-goto-subject (car articles))
8980       (command-execute func)
8981       (gnus-summary-remove-process-mark (car articles))
8982       (setq articles (cdr articles)))))
8983
8984 (defun gnus-summary-toggle-truncation (&optional arg)
8985   "Toggle truncation of summary lines.
8986 With arg, turn line truncation on iff arg is positive."
8987   (interactive "P")
8988   (setq truncate-lines
8989         (if (null arg) (not truncate-lines)
8990           (> (prefix-numeric-value arg) 0)))
8991   (redraw-display))
8992
8993 (defun gnus-summary-reselect-current-group (&optional all)
8994   "Once exit and then reselect the current newsgroup.
8995 The prefix argument ALL means to select all articles."
8996   (interactive "P")
8997   (gnus-set-global-variables)
8998   (let ((current-subject (gnus-summary-article-number))
8999         (group gnus-newsgroup-name))
9000     (setq gnus-newsgroup-begin nil)
9001     (gnus-summary-exit)
9002     ;; We have to adjust the point of group mode buffer because the
9003     ;; current point was moved to the next unread newsgroup by
9004     ;; exiting.
9005     (gnus-summary-jump-to-group group)
9006     (gnus-group-read-group all t)
9007     (gnus-summary-goto-subject current-subject)))
9008
9009 (defun gnus-summary-rescan-group (&optional all)
9010   "Exit the newsgroup, ask for new articles, and select the newsgroup."
9011   (interactive "P")
9012   (gnus-set-global-variables)
9013   ;; Fix by Ilja Weis <kult@uni-paderborn.de>.
9014   (let ((group gnus-newsgroup-name))
9015     (gnus-summary-exit)
9016     (gnus-summary-jump-to-group group)
9017     (save-excursion
9018       (set-buffer gnus-group-buffer)
9019       (gnus-group-get-new-news-this-group 1))
9020     (gnus-summary-jump-to-group group)
9021     (gnus-group-read-group all)))
9022
9023 (defun gnus-summary-update-info ()
9024   (let* ((group gnus-newsgroup-name))
9025     (when gnus-newsgroup-kill-headers
9026       (setq gnus-newsgroup-killed
9027             (gnus-compress-sequence
9028              (nconc
9029               (gnus-set-sorted-intersection
9030                (gnus-uncompress-range gnus-newsgroup-killed)
9031                (setq gnus-newsgroup-unselected
9032                      (sort gnus-newsgroup-unselected '<)))
9033               (setq gnus-newsgroup-unreads
9034                     (sort gnus-newsgroup-unreads '<))) t)))
9035     (unless (listp (cdr gnus-newsgroup-killed))
9036       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
9037     (let ((headers gnus-newsgroup-headers))
9038       (gnus-close-group group)
9039       (run-hooks 'gnus-exit-group-hook)
9040       (unless gnus-save-score
9041         (setq gnus-newsgroup-scored nil))
9042       ;; Set the new ranges of read articles.
9043       (gnus-update-read-articles
9044        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
9045       ;; Set the current article marks.
9046       (gnus-update-marks)
9047       ;; Do the cross-ref thing.
9048       (when gnus-use-cross-reference
9049         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
9050       ;; Do adaptive scoring, and possibly save score files.
9051       (when gnus-newsgroup-adaptive
9052         (gnus-score-adaptive))
9053       (when gnus-use-scoring 
9054         (gnus-score-save))
9055       ;; Do not switch windows but change the buffer to work.
9056       (set-buffer gnus-group-buffer)
9057       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9058           (gnus-group-update-group group)))))
9059   
9060 (defun gnus-summary-exit (&optional temporary)
9061   "Exit reading current newsgroup, and then return to group selection mode.
9062 gnus-exit-group-hook is called with no arguments if that value is non-nil."
9063   (interactive)
9064   (gnus-set-global-variables)
9065   (gnus-kill-save-kill-buffer)
9066   (let* ((group gnus-newsgroup-name)
9067          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
9068          (mode major-mode)
9069          (buf (current-buffer)))
9070     (run-hooks 'gnus-summary-prepare-exit-hook)
9071     ;; Make all changes in this group permanent.
9072     (gnus-summary-update-info)          
9073     (set-buffer buf)
9074     (when gnus-use-cache
9075       (gnus-cache-possibly-remove-articles)
9076       (gnus-cache-save-buffers))
9077     ;; Make sure where I was, and go to next newsgroup.
9078     (set-buffer gnus-group-buffer)
9079     (or quit-config
9080         (progn
9081           (gnus-group-jump-to-group group)
9082           (gnus-group-next-unread-group 1)))
9083     (if temporary
9084         nil                             ;Nothing to do.
9085       (if (not gnus-kill-summary-on-exit)
9086           (gnus-deaden-summary)
9087         ;; We set all buffer-local variables to nil.  It is unclear why
9088         ;; this is needed, but if we don't, buffer-local variables are
9089         ;; not garbage-collected, it seems.  This would the lead to en
9090         ;; ever-growing Emacs.
9091         (set-buffer buf)
9092         (gnus-summary-clear-local-variables)
9093         ;; We clear the global counterparts of the buffer-local
9094         ;; variables as well, just to be on the safe side.
9095         (gnus-configure-windows 'group 'force)
9096         (gnus-summary-clear-local-variables)
9097         ;; Return to group mode buffer. 
9098         (if (eq mode 'gnus-summary-mode)
9099             (gnus-kill-buffer buf)))
9100       (setq gnus-current-select-method gnus-select-method)
9101       (pop-to-buffer gnus-group-buffer)
9102       ;; Clear the current group name.
9103       (setq gnus-newsgroup-name nil)
9104       (if (not quit-config)
9105           (progn
9106             (gnus-group-jump-to-group group)
9107             (gnus-group-next-unread-group 1))
9108         (if (not (buffer-name (car quit-config)))
9109             (gnus-configure-windows 'group 'force)
9110           (set-buffer (car quit-config))
9111           (and (eq major-mode 'gnus-summary-mode)
9112                (gnus-set-global-variables))
9113           (gnus-configure-windows (cdr quit-config))))
9114       (run-hooks 'gnus-summary-exit-hook))))
9115
9116 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
9117 (defun gnus-summary-exit-no-update (&optional no-questions)
9118   "Quit reading current newsgroup without updating read article info."
9119   (interactive)
9120   (gnus-set-global-variables)
9121   (let* ((group gnus-newsgroup-name)
9122          (quit-config (gnus-group-quit-config group)))
9123     (when (or no-questions
9124               gnus-expert-user
9125               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
9126       (if (not gnus-kill-summary-on-exit)
9127           (gnus-deaden-summary)
9128         (gnus-close-group group)
9129         (gnus-summary-clear-local-variables)
9130         (set-buffer gnus-group-buffer)
9131         (gnus-summary-clear-local-variables)
9132         (when (get-buffer gnus-summary-buffer)
9133           (kill-buffer gnus-summary-buffer)))
9134       ;; Return to the group buffer.
9135       (gnus-configure-windows 'group 'force)
9136       ;; Clear the current group name.
9137       (setq gnus-newsgroup-name nil)
9138       (when (equal (gnus-group-group-name) group)
9139         (gnus-group-next-unread-group 1))
9140       (when quit-config
9141         (if (not (buffer-name (car quit-config)))
9142             (gnus-configure-windows 'group 'force)
9143           (set-buffer (car quit-config))
9144           (when (eq major-mode 'gnus-summary-mode)
9145             (gnus-set-global-variables))
9146           (gnus-configure-windows (cdr quit-config)))))))
9147
9148 ;;; Dead summaries.
9149
9150 (defvar gnus-dead-summary-mode-map nil)
9151
9152 (if gnus-dead-summary-mode-map
9153     nil
9154   (setq gnus-dead-summary-map (make-keymap))
9155   (suppress-keymap gnus-dead-summary-map)
9156   (substitute-key-definition
9157    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-map)
9158   (let ((keys '("\C-d" "\r" "\177")))
9159     (while keys
9160       (define-key gnus-dead-summary-map
9161         (pop keys) 'gnus-summary-wake-up-the-dead))))
9162  
9163 (defvar gnus-dead-summary-mode nil
9164   "Minor mode for Gnus summary buffers.")
9165
9166 (defun gnus-dead-summary-mode (&optional arg)
9167   "Minor mode for Gnus summary buffers."
9168   (interactive "P")
9169   (when (eq major-mode 'gnus-summary-mode)
9170     (make-local-variable 'gnus-dead-summary-mode)
9171     (setq gnus-dead-summary-mode 
9172           (if (null arg) (not gnus-dead-summary-mode)
9173             (> (prefix-numeric-value arg) 0)))
9174     (when gnus-dead-summary-mode
9175       (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
9176         (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
9177       (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
9178         (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
9179               minor-mode-map-alist)))))
9180
9181 (defun gnus-deaden-summary ()
9182   "Make the current summary buffer into a dead summary buffer."
9183   ;; Kill any previous dead summary buffer.
9184   (when (and gnus-dead-summary
9185              (buffer-name gnus-dead-summary))
9186     (save-excursion
9187       (set-buffer gnus-dead-summary)
9188       (when gnus-dead-summary-mode
9189         (kill-buffer (current-buffer)))))
9190   ;; Make this the current dead summary.
9191   (setq gnus-dead-summary (current-buffer))
9192   (gnus-dead-summary-mode 1)
9193   (let ((name (buffer-name)))
9194     (when (string-match "Summary" name)
9195       (rename-buffer
9196        (concat (substring name 0 (match-beginning 0)) "Dead "
9197                (substring name (match-beginning 0))) t))))
9198
9199 (defun gnus-kill-or-deaden-summary (buffer)
9200   "Kill or deaden the summary BUFFER."
9201   (cond (gnus-kill-summary-on-exit
9202          (gnus-kill-buffer buffer))
9203         ((and (get-buffer buffer)
9204               (buffer-name (get-buffer buffer)))
9205          (save-excursion
9206            (set-buffer buffer)
9207            (gnus-deaden-summary)))))
9208
9209 (defun gnus-summary-wake-up-the-dead (&rest args)
9210   "Wake up the dead summary buffer."
9211   (interactive)
9212   (gnus-dead-summary-mode -1)
9213   (let ((name (buffer-name)))
9214     (when (string-match "Dead " name)
9215       (rename-buffer
9216        (concat (substring name 0 (match-beginning 0))
9217                (substring name (match-end 0))) t)))
9218   (gnus-message 3 "This dead summary is now alive again"))
9219
9220 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
9221 (defun gnus-summary-fetch-faq (&optional faq-dir)
9222   "Fetch the FAQ for the current group.
9223 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
9224 in."
9225   (interactive 
9226    (list
9227     (if current-prefix-arg
9228         (completing-read 
9229          "Faq dir: " (and (listp gnus-group-faq-directory)
9230                           gnus-group-faq-directory)))))
9231   (let (gnus-faq-buffer)
9232     (and (setq gnus-faq-buffer 
9233                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
9234          (gnus-configure-windows 'summary-faq))))
9235
9236 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
9237 (defun gnus-summary-describe-group (&optional force)
9238   "Describe the current newsgroup."
9239   (interactive "P")
9240   (gnus-group-describe-group force gnus-newsgroup-name))
9241
9242 (defun gnus-summary-describe-briefly ()
9243   "Describe summary mode commands briefly."
9244   (interactive)
9245   (gnus-message 6
9246                 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select  \\[gnus-summary-next-unread-article]:Forward  \\[gnus-summary-prev-unread-article]:Backward  \\[gnus-summary-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-summary-describe-briefly]:This help")))
9247
9248 ;; Walking around group mode buffer from summary mode.
9249
9250 (defun gnus-summary-next-group (&optional no-article target-group backward)
9251   "Exit current newsgroup and then select next unread newsgroup.
9252 If prefix argument NO-ARTICLE is non-nil, no article is selected
9253 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
9254 previous group instead."
9255   (interactive "P")
9256   (gnus-set-global-variables)
9257   (let ((current-group gnus-newsgroup-name)
9258         (current-buffer (current-buffer))
9259         entered)
9260     ;; First we semi-exit this group to update Xrefs and all variables.
9261     ;; We can't do a real exit, because the window conf must remain
9262     ;; the same in case the user is prompted for info, and we don't
9263     ;; want the window conf to change before that...
9264     (gnus-summary-exit t)
9265     (while (not entered)
9266       ;; Then we find what group we are supposed to enter.
9267       (set-buffer gnus-group-buffer)
9268       (gnus-group-jump-to-group current-group)
9269       (setq target-group 
9270             (or target-group        
9271                 (if (eq gnus-keep-same-level 'best) 
9272                     (gnus-summary-best-group gnus-newsgroup-name)
9273                   (gnus-summary-search-group backward gnus-keep-same-level))))
9274       (if (not target-group)
9275           ;; There are no further groups, so we return to the group
9276           ;; buffer.
9277           (progn
9278             (gnus-message 5 "Returning to the group buffer")
9279             (setq entered t)
9280             (set-buffer current-buffer)
9281             (gnus-summary-exit))
9282         ;; We try to enter the target group.
9283         (gnus-group-jump-to-group target-group)
9284         (let ((unreads (gnus-group-group-unread)))
9285           (if (and (or (eq t unreads)
9286                        (and unreads (not (zerop unreads))))
9287                    (gnus-summary-read-group
9288                     target-group nil no-article current-buffer))
9289               (setq entered t)
9290             (setq current-group target-group
9291                   target-group nil)))))))
9292
9293 (defun gnus-summary-prev-group (&optional no-article)
9294   "Exit current newsgroup and then select previous unread newsgroup.
9295 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
9296   (interactive "P")
9297   (gnus-summary-next-group no-article nil t))
9298
9299 ;; Walking around summary lines.
9300
9301 (defun gnus-summary-first-subject (&optional unread)
9302   "Go to the first unread subject.
9303 If UNREAD is non-nil, go to the first unread article.
9304 Returns the article selected or nil if there are no unread articles."
9305   (interactive "P")
9306   (prog1
9307       (cond 
9308        ;; Empty summary.
9309        ((null gnus-newsgroup-data)
9310         (gnus-message 3 "No articles in the group")
9311         nil)
9312        ;; Pick the first article.
9313        ((not unread)
9314         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
9315         (gnus-data-number (car gnus-newsgroup-data)))
9316        ;; No unread articles.
9317        ((null gnus-newsgroup-unreads)
9318         (gnus-message 3 "No more unread articles")
9319         nil)
9320        ;; Find the first unread article.
9321        (t
9322         (let ((data gnus-newsgroup-data))
9323           (while (and data
9324                       (not (gnus-data-unread-p (car data))))
9325             (setq data (cdr data)))
9326           (if data
9327               (progn
9328                 (goto-char (gnus-data-pos (car data)))
9329                 (gnus-data-number (car data)))))))
9330     (gnus-summary-position-point)))
9331
9332 (defun gnus-summary-next-subject (n &optional unread dont-display)
9333   "Go to next N'th summary line.
9334 If N is negative, go to the previous N'th subject line.
9335 If UNREAD is non-nil, only unread articles are selected.
9336 The difference between N and the actual number of steps taken is
9337 returned."
9338   (interactive "p")
9339   (let ((backward (< n 0))
9340         (n (abs n)))
9341     (while (and (> n 0)
9342                 (if backward
9343                     (gnus-summary-find-prev unread)
9344                   (gnus-summary-find-next unread)))
9345       (setq n (1- n)))
9346     (if (/= 0 n) (gnus-message 7 "No more%s articles"
9347                                (if unread " unread" "")))
9348     (or dont-display
9349         (progn
9350           (gnus-summary-recenter)
9351           (gnus-summary-position-point)))
9352     n))
9353
9354 (defun gnus-summary-next-unread-subject (n)
9355   "Go to next N'th unread summary line."
9356   (interactive "p")
9357   (gnus-summary-next-subject n t))
9358
9359 (defun gnus-summary-prev-subject (n &optional unread)
9360   "Go to previous N'th summary line.
9361 If optional argument UNREAD is non-nil, only unread article is selected."
9362   (interactive "p")
9363   (gnus-summary-next-subject (- n) unread))
9364
9365 (defun gnus-summary-prev-unread-subject (n)
9366   "Go to previous N'th unread summary line."
9367   (interactive "p")
9368   (gnus-summary-next-subject (- n) t))
9369
9370 (defun gnus-summary-goto-subject (article &optional force silent)
9371   "Go the subject line of ARTICLE.
9372 If FORCE, also allow jumping to articles not currently shown."
9373   (let ((b (point))
9374         (data (gnus-data-find article)))
9375     ;; We read in the article if we have to.
9376     (and (not data) 
9377          force
9378          (gnus-summary-insert-subject article)
9379          (setq data (gnus-data-find article)))
9380     (goto-char b)
9381     (if (and (not silent) (not data))
9382         (progn
9383           (message "Can't find article %d" article)
9384           nil)
9385       (goto-char (gnus-data-pos data))
9386       article)))
9387
9388 ;; Walking around summary lines with displaying articles.
9389
9390 (defun gnus-summary-expand-window (&optional arg)
9391   "Make the summary buffer take up the entire Emacs frame.
9392 Given a prefix, will force an `article' buffer configuration."
9393   (interactive "P")
9394   (gnus-set-global-variables)
9395   (if arg
9396       (gnus-configure-windows 'article 'force)
9397     (gnus-configure-windows 'summary 'force)))
9398
9399 (defun gnus-summary-display-article (article &optional all-header)
9400   "Display ARTICLE in article buffer."
9401   (gnus-set-global-variables)
9402   (if (null article)
9403       nil
9404     (prog1
9405         (gnus-article-prepare article all-header)
9406       (gnus-summary-show-thread)
9407       (run-hooks 'gnus-select-article-hook)
9408       (gnus-summary-recenter)
9409       (gnus-summary-goto-subject article)
9410       ;; Successfully display article.
9411       (gnus-summary-update-line)
9412       (gnus-article-set-window-start 
9413        (cdr (assq article gnus-newsgroup-bookmarks)))
9414       t)))
9415
9416 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
9417   "Select the current article.
9418 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
9419 non-nil, the article will be re-fetched even if it already present in
9420 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
9421 be displayed."
9422   (let ((article (or article (gnus-summary-article-number)))
9423         (all-headers (not (not all-headers))) ;Must be T or NIL.
9424         did) 
9425     (and (not pseudo) 
9426          (gnus-summary-article-pseudo-p article)
9427          (error "This is a pseudo-article."))
9428     (prog1
9429         (save-excursion
9430           (set-buffer gnus-summary-buffer)
9431           (if (or (null gnus-current-article)
9432                   (null gnus-article-current)
9433                   (null (get-buffer gnus-article-buffer))
9434                   (not (eq article (cdr gnus-article-current)))
9435                   (not (equal (car gnus-article-current) gnus-newsgroup-name))
9436                   force)
9437               ;; The requested article is different from the current article.
9438               (progn
9439                 (gnus-summary-display-article article all-headers)
9440                 (setq did article))
9441             (if (or all-headers gnus-show-all-headers) 
9442                 (gnus-article-show-all-headers))
9443             nil))
9444       (if did 
9445           (gnus-article-set-window-start 
9446            (cdr (assq article gnus-newsgroup-bookmarks)))))))
9447
9448 (defun gnus-summary-set-current-mark (&optional current-mark)
9449   "Obsolete function."
9450   nil)
9451
9452 (defun gnus-summary-next-article (&optional unread subject backward)
9453   "Select the next article.
9454 If UNREAD, only unread articles are selected.
9455 If SUBJECT, only articles with SUBJECT are selected.
9456 If BACKWARD, the previous article is selected instead of the next."
9457   (interactive "P")
9458   (gnus-set-global-variables)
9459   (let (header)
9460     (cond
9461      ;; Is there such an article?
9462      ((and (gnus-summary-search-forward unread subject backward)
9463            (or (gnus-summary-display-article (gnus-summary-article-number))
9464                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9465       (gnus-summary-position-point))
9466      ;; If not, we try the first unread, if that is wanted.
9467      ((and subject
9468            gnus-auto-select-same
9469            (or (gnus-summary-first-unread-article)
9470                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9471       (gnus-summary-position-point)
9472       (gnus-message 6 "Wrapped"))
9473      ;; Try to get next/previous article not displayed in this group.
9474      ((and gnus-auto-extend-newsgroup
9475            (not unread) (not subject))
9476       (gnus-summary-goto-article 
9477        (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
9478        nil t))
9479      ;; Go to next/previous group.
9480      (t
9481       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9482           (gnus-summary-jump-to-group gnus-newsgroup-name))
9483       (let ((cmd last-command-char)
9484             (group 
9485              (if (eq gnus-keep-same-level 'best) 
9486                  (gnus-summary-best-group gnus-newsgroup-name)
9487                (gnus-summary-search-group backward gnus-keep-same-level))))
9488         ;; For some reason, the group window gets selected.  We change
9489         ;; it back.  
9490         (select-window (get-buffer-window (current-buffer)))
9491         ;; Select next unread newsgroup automagically.
9492         (cond 
9493          ((not gnus-auto-select-next)
9494           (gnus-message 7 "No more%s articles" (if unread " unread" "")))
9495          ((or (eq gnus-auto-select-next 'quietly)
9496               (and (eq gnus-auto-select-next 'almost-quietly)
9497                    (gnus-summary-last-article-p)))
9498           ;; Select quietly.
9499           (if (gnus-ephemeral-group-p gnus-newsgroup-name)
9500               (gnus-summary-exit)
9501             (gnus-message 7 "No more%s articles (%s)..."
9502                           (if unread " unread" "") 
9503                           (if group (concat "selecting " group)
9504                             "exiting"))
9505             (gnus-summary-next-group nil group backward)))
9506          (t
9507           (gnus-summary-walk-group-buffer 
9508            gnus-newsgroup-name cmd unread backward))))))))
9509
9510 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
9511   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
9512                       (?\C-p (gnus-group-prev-unread-group 1))))
9513         keve key group ended)
9514     (while (not ended)
9515       (save-excursion
9516         (set-buffer gnus-group-buffer)
9517         (setq group (gnus-group-group-name)))
9518       (gnus-message 
9519        7 "No more%s articles%s" (if unread " unread" "")
9520        (if (and group 
9521                 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
9522            (format " (Type %s for %s [%s])"
9523                    (single-key-description cmd) group
9524                    (car (gnus-gethash group gnus-newsrc-hashtb)))
9525          (format " (Type %s to exit %s)"
9526                  (single-key-description cmd)
9527                  gnus-newsgroup-name)))
9528       ;; Confirm auto selection.
9529       (setq key (car (setq keve (gnus-read-event-char))))
9530       (setq ended t)
9531       (cond 
9532        ((assq key keystrokes)
9533         (let ((obuf (current-buffer)))
9534           (switch-to-buffer gnus-group-buffer)
9535           (and group
9536                (gnus-group-jump-to-group group))
9537           (eval (car (cdr (assq key keystrokes))))
9538           (setq group (gnus-group-group-name))
9539           (switch-to-buffer obuf))
9540         (setq ended nil))
9541        ((equal key cmd)
9542         (if (or (not group)
9543                 (gnus-ephemeral-group-p gnus-newsgroup-name))
9544             (gnus-summary-exit)
9545           (gnus-summary-next-group nil group backward)))
9546        (t
9547         (push (cdr keve) unread-command-events))))))
9548
9549 (defun gnus-read-event-char ()
9550   "Get the next event."
9551   (let ((event (read-event)))
9552     (cons (and (numberp event) event) event)))
9553
9554 (defun gnus-summary-next-unread-article ()
9555   "Select unread article after current one."
9556   (interactive)
9557   (gnus-summary-next-article t (and gnus-auto-select-same
9558                                     (gnus-summary-article-subject))))
9559
9560 (defun gnus-summary-prev-article (&optional unread subject)
9561   "Select the article after the current one.
9562 If UNREAD is non-nil, only unread articles are selected."
9563   (interactive "P")
9564   (gnus-summary-next-article unread subject t))
9565
9566 (defun gnus-summary-prev-unread-article ()
9567   "Select unred article before current one."
9568   (interactive)
9569   (gnus-summary-prev-article t (and gnus-auto-select-same
9570                                     (gnus-summary-article-subject))))
9571
9572 (defun gnus-summary-next-page (&optional lines circular)
9573   "Show next page of selected article.
9574 If end of article, select next article.
9575 Argument LINES specifies lines to be scrolled up.
9576 If CIRCULAR is non-nil, go to the start of the article instead of 
9577 instead of selecting the next article when reaching the end of the
9578 current article." 
9579   (interactive "P")
9580   (setq gnus-summary-buffer (current-buffer))
9581   (gnus-set-global-variables)
9582   (let ((article (gnus-summary-article-number))
9583         (endp nil))
9584     (gnus-configure-windows 'article)
9585     (if (or (null gnus-current-article)
9586             (null gnus-article-current)
9587             (/= article (cdr gnus-article-current))
9588             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9589         ;; Selected subject is different from current article's.
9590         (gnus-summary-display-article article)
9591       (gnus-eval-in-buffer-window
9592        gnus-article-buffer
9593        (setq endp (gnus-article-next-page lines)))
9594       (if endp
9595           (cond (circular
9596                  (gnus-summary-beginning-of-article))
9597                 (lines
9598                  (gnus-message 3 "End of message"))
9599                 ((null lines)
9600                  (gnus-summary-next-unread-article)))))
9601     (gnus-summary-recenter)
9602     (gnus-summary-position-point)))
9603
9604 (defun gnus-summary-prev-page (&optional lines)
9605   "Show previous page of selected article.
9606 Argument LINES specifies lines to be scrolled down."
9607   (interactive "P")
9608   (gnus-set-global-variables)
9609   (let ((article (gnus-summary-article-number)))
9610     (gnus-configure-windows 'article)
9611     (if (or (null gnus-current-article)
9612             (null gnus-article-current)
9613             (/= article (cdr gnus-article-current))
9614             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9615         ;; Selected subject is different from current article's.
9616         (gnus-summary-display-article article)
9617       (gnus-summary-recenter)
9618       (gnus-eval-in-buffer-window gnus-article-buffer
9619                                   (gnus-article-prev-page lines))))
9620   (gnus-summary-position-point))
9621
9622 (defun gnus-summary-scroll-up (lines)
9623   "Scroll up (or down) one line current article.
9624 Argument LINES specifies lines to be scrolled up (or down if negative)."
9625   (interactive "p")
9626   (gnus-set-global-variables)
9627   (gnus-configure-windows 'article)
9628   (or (gnus-summary-select-article nil nil 'pseudo)
9629       (gnus-eval-in-buffer-window 
9630        gnus-article-buffer
9631        (cond ((> lines 0)
9632               (if (gnus-article-next-page lines)
9633                   (gnus-message 3 "End of message")))
9634              ((< lines 0)
9635               (gnus-article-prev-page (- lines))))))
9636   (gnus-summary-recenter)
9637   (gnus-summary-position-point))
9638
9639 (defun gnus-summary-next-same-subject ()
9640   "Select next article which has the same subject as current one."
9641   (interactive)
9642   (gnus-set-global-variables)
9643   (gnus-summary-next-article nil (gnus-summary-article-subject)))
9644
9645 (defun gnus-summary-prev-same-subject ()
9646   "Select previous article which has the same subject as current one."
9647   (interactive)
9648   (gnus-set-global-variables)
9649   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
9650
9651 (defun gnus-summary-next-unread-same-subject ()
9652   "Select next unread article which has the same subject as current one."
9653   (interactive)
9654   (gnus-set-global-variables)
9655   (gnus-summary-next-article t (gnus-summary-article-subject)))
9656
9657 (defun gnus-summary-prev-unread-same-subject ()
9658   "Select previous unread article which has the same subject as current one."
9659   (interactive)
9660   (gnus-set-global-variables)
9661   (gnus-summary-prev-article t (gnus-summary-article-subject)))
9662
9663 (defun gnus-summary-first-unread-article ()
9664   "Select the first unread article. 
9665 Return nil if there are no unread articles."
9666   (interactive)
9667   (gnus-set-global-variables)
9668   (prog1
9669       (if (gnus-summary-first-subject t)
9670           (progn
9671             (gnus-summary-show-thread)
9672             (gnus-summary-first-subject t)
9673             (gnus-summary-display-article (gnus-summary-article-number))))
9674     (gnus-summary-position-point)))
9675
9676 (defun gnus-summary-best-unread-article ()
9677   "Select the unread article with the highest score."
9678   (interactive)
9679   (gnus-set-global-variables)
9680   (let ((best -1000000)
9681         (data gnus-newsgroup-data)
9682         article score)
9683     (while data
9684       (and (gnus-data-unread-p (car data))
9685            (> (setq score 
9686                     (gnus-summary-article-score (gnus-data-number (car data))))
9687               best)
9688            (setq best score
9689                  article (gnus-data-number (car data))))
9690       (setq data (cdr data)))
9691     (if article
9692         (gnus-summary-goto-article article)
9693       (error "No unread articles"))
9694     (gnus-summary-position-point)))
9695
9696 (defun gnus-summary-last-subject ()
9697   "Go to the last displayed subject line in the group."
9698   (let ((article (gnus-data-number (car (gnus-data-list t)))))
9699     (when article
9700       (gnus-summary-goto-subject article))))
9701
9702 (defun gnus-summary-goto-article (article &optional all-headers force)
9703   "Fetch ARTICLE and display it if it exists.
9704 If ALL-HEADERS is non-nil, no header lines are hidden."
9705   (interactive
9706    (list
9707     (string-to-int
9708      (completing-read 
9709       "Article number: "
9710       (mapcar (lambda (number) (list (int-to-string number)))
9711               gnus-newsgroup-limit)))
9712     current-prefix-arg
9713     t))
9714   (prog1
9715       (if (gnus-summary-goto-subject article force)
9716           (gnus-summary-display-article article all-headers)
9717         (message "Couldn't go to article %s" article) nil)
9718     (gnus-summary-position-point)))
9719
9720 (defun gnus-summary-goto-last-article ()
9721   "Go to the previously read article."
9722   (interactive)
9723   (prog1
9724       (and gnus-last-article
9725            (gnus-summary-goto-article gnus-last-article))
9726     (gnus-summary-position-point)))
9727
9728 (defun gnus-summary-pop-article (number)
9729   "Pop one article off the history and go to the previous.
9730 NUMBER articles will be popped off."
9731   (interactive "p")
9732   (let (to)
9733     (setq gnus-newsgroup-history
9734           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
9735     (if to
9736         (gnus-summary-goto-article (car to))
9737       (error "Article history empty")))
9738   (gnus-summary-position-point))
9739
9740 ;; Summary commands and functions for limiting the summary buffer.
9741
9742 (defun gnus-summary-limit-to-articles (n)
9743   "Limit the summary buffer to the next N articles.
9744 If not given a prefix, use the process marked articles instead."
9745   (interactive "P")
9746   (gnus-set-global-variables)
9747   (prog1
9748       (let ((articles (gnus-summary-work-articles n)))
9749         (gnus-summary-limit articles))
9750     (gnus-summary-position-point)))
9751
9752 (defun gnus-summary-pop-limit (&optional total)
9753   "Restore the previous limit.
9754 If given a prefix, remove all limits."
9755   (interactive "P")
9756   (gnus-set-global-variables)
9757   (prog2
9758       (if total (setq gnus-newsgroup-limits 
9759                       (list (mapcar (lambda (h) (mail-header-number h))
9760                                     gnus-newsgroup-headers))))
9761       (gnus-summary-limit nil 'pop)
9762     (gnus-summary-position-point)))
9763
9764 (defun gnus-summary-limit-to-subject (subject)
9765   "Limit the summary buffer to articles that have subjects that match a regexp."
9766   (interactive "sRegexp: ")
9767   (when (not (equal "" subject))
9768     (prog1
9769         (let ((articles (gnus-summary-find-matching "subject" subject 'all)))
9770           (or articles (error "Found no matches for \"%s\"" subject))
9771           (gnus-summary-limit articles))
9772       (gnus-summary-position-point))))
9773
9774 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
9775 (make-obsolete 
9776  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
9777
9778 (defun gnus-summary-limit-to-unread (&optional all)
9779   "Limit the summary buffer to articles that are not marked as read.
9780 If ALL is non-nil, limit strictly to unread articles."
9781   (interactive "P")
9782   (if all
9783       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
9784     (gnus-summary-limit-to-marks
9785      ;; Concat all the marks that say that an article is read and have
9786      ;; those removed.  
9787      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
9788            gnus-killed-mark gnus-kill-file-mark
9789            gnus-low-score-mark gnus-expirable-mark
9790            gnus-canceled-mark gnus-catchup-mark)
9791      'reverse)))
9792
9793 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
9794 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
9795
9796 (defun gnus-summary-limit-to-marks (marks &optional reverse)
9797   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
9798 If REVERSE, limit the summary buffer to articles that are not marked
9799 with MARKS.  MARKS can either be a string of marks or a list of marks. 
9800 Returns how many articles were removed."
9801   (interactive "sMarks: ")
9802   (gnus-set-global-variables)
9803   (prog1
9804       (let ((data gnus-newsgroup-data)
9805             (marks (if (listp marks) marks
9806                      (append marks nil))) ; Transform to list.
9807             articles)
9808         (while data
9809           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
9810                  (memq (gnus-data-mark (car data)) marks))
9811                (setq articles (cons (gnus-data-number (car data)) articles)))
9812           (setq data (cdr data)))
9813         (gnus-summary-limit articles))
9814     (gnus-summary-position-point)))
9815
9816 (defun gnus-summary-limit-to-score (&optional score)
9817   "Limit to articles with score at or above SCORE."
9818   (interactive "P")
9819   (gnus-set-global-variables)
9820   (setq score (if score
9821                   (prefix-numeric-value score)
9822                 (or gnus-summary-default-score 0)))
9823   (let ((data gnus-newsgroup-data)
9824         articles)
9825     (while data
9826       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
9827                 score)
9828         (push (gnus-data-number (car data)) articles))
9829       (setq data (cdr data)))
9830     (prog1
9831         (gnus-summary-limit articles)
9832       (gnus-summary-position-point))))
9833
9834 (defun gnus-summary-limit-include-dormant ()
9835   "Display all the hidden articles that are marked as dormant."
9836   (interactive)
9837   (gnus-set-global-variables)
9838   (or gnus-newsgroup-dormant 
9839       (error "There are no dormant articles in this group"))
9840   (prog1
9841       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
9842     (gnus-summary-position-point)))
9843
9844 (defun gnus-summary-limit-exclude-dormant ()
9845   "Hide all dormant articles."
9846   (interactive)
9847   (gnus-set-global-variables)
9848   (prog1
9849       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
9850     (gnus-summary-position-point)))
9851
9852 (defun gnus-summary-limit-exclude-childless-dormant ()
9853   "Hide all dormant articles that have no children."
9854   (interactive)
9855   (gnus-set-global-variables)
9856   (let ((data gnus-newsgroup-data)
9857         articles)
9858     ;; Find all articles that are either not dormant or have
9859     ;; children. 
9860     (while data
9861       (and (or (not (= (gnus-data-mark (car data)) gnus-dormant-mark))
9862                (gnus-article-parent-p (gnus-data-number (car data))))
9863            (setq articles (cons (gnus-data-number (car data))
9864                                 articles)))
9865       (setq data (cdr data)))
9866     ;; Do the limiting.
9867     (prog1
9868         (gnus-summary-limit articles)
9869       (gnus-summary-position-point))))
9870  
9871 (defun gnus-summary-limit (articles &optional pop)
9872   (if pop
9873       ;; We pop the previous limit off the stack and use that.
9874       (setq articles (car gnus-newsgroup-limits)
9875             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
9876     ;; We use the new limit, so we push the old limit on the stack. 
9877     (setq gnus-newsgroup-limits 
9878           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
9879   ;; Set the limit.
9880   (setq gnus-newsgroup-limit articles)
9881   (let ((total (length gnus-newsgroup-data))
9882         (data (gnus-data-find-list (gnus-summary-article-number)))
9883         found)
9884     ;; This will do all the work of generating the new summary buffer
9885     ;; according to the new limit.
9886     (gnus-summary-prepare)
9887     ;; Try to return to the article you were at, or on in the
9888     ;; neighborhood.  
9889     (if data
9890         ;; We try to find some article after the current one.
9891         (while data
9892           (and (gnus-summary-goto-subject (gnus-data-number (car data)))
9893                (setq data nil
9894                      found t))
9895           (setq data (cdr data))))
9896     (or found
9897         ;; If there is no data, that means that we were after the last
9898         ;; article.  The same goes when we can't find any articles
9899         ;; after the current one.
9900         (progn
9901           (goto-char (point-max))
9902           (gnus-summary-find-prev)))
9903     ;; We return how many articles were removed from the summary
9904     ;; buffer as a result of the new limit.
9905     (- total (length gnus-newsgroup-data))))
9906
9907 (defun gnus-summary-initial-limit ()
9908   "Figure out what the initial limit is supposed to be on group entry.
9909 This entails weeding out unwanted dormants, low-scored articles,
9910 fetch-old-headers verbiage, and so on."
9911   ;; Most groups have nothing to remove.
9912   (if (or gnus-inhibit-limiting
9913           (and (null gnus-newsgroup-dormant)
9914                (not (eq gnus-fetch-old-headers 'some))
9915                (null gnus-summary-expunge-below)
9916                (null gnus-thread-expunge-below)))
9917       () ; Do nothing.
9918     (push gnus-newsgroup-limit gnus-newsgroup-limits)
9919     (setq gnus-newsgroup-limit nil)
9920     (mapatoms
9921      (lambda (node)
9922        (unless (car (symbol-value node))
9923          ;; These threads have no parents -- they are roots.
9924          (let ((nodes (cdr (symbol-value node))))
9925            (while nodes
9926              (if (and gnus-thread-expunge-below
9927                       (< (gnus-thread-total-score (car nodes))
9928                          gnus-thread-expunge-below))
9929                  (gnus-expunge-thread (pop nodes))
9930                (gnus-summary-limit-children (pop nodes)))))))
9931      gnus-newsgroup-dependencies)
9932     (when (not gnus-newsgroup-limit)
9933       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
9934     gnus-newsgroup-limit))
9935
9936 (defun gnus-summary-limit-children (thread)
9937   "Return 1 if this subthread is visible and 0 if it is not."
9938   ;; First we get the number of visible children to this thread.  This
9939   ;; is done by recursing down the thread using this function, so this
9940   ;; will really go down to a leaf article first, before slowly
9941   ;; working its way up towards the root.
9942   (let ((children 
9943          (if (cdr thread)
9944              (apply '+ (mapcar 'gnus-summary-limit-children 
9945                                (cdr thread)))
9946            0))
9947         (number (mail-header-number (car thread)))
9948         score)
9949     (if (or 
9950          ;; If this article is dormant and has absolutely no visible
9951          ;; children, then this article isn't visible.
9952          (and (memq number gnus-newsgroup-dormant)
9953               (= children 0))
9954          ;; If this is a "fetch-old-headered" and there is only one
9955          ;; visible child (or less), then we don't want this article. 
9956          (and (eq gnus-fetch-old-headers 'some)
9957               (memq number gnus-newsgroup-ancient)
9958               (<= children 1))
9959          ;; If we use expunging, and this article is really
9960          ;; low-scored, then we don't want this article.
9961          (when (and gnus-summary-expunge-below
9962                     (< (setq score 
9963                              (or (cdr (assq number gnus-newsgroup-scored)) 
9964                                  gnus-summary-default-score))
9965                        gnus-summary-expunge-below))
9966            ;; We increase the expunge-tally here, but that has
9967            ;; nothing to do with the limits, really.
9968            (incf gnus-newsgroup-expunged-tally)
9969            ;; We also mark as read here, if that's wanted.
9970            (when (and gnus-summary-mark-below
9971                       (< score gnus-summary-mark-below))
9972              (setq gnus-newsgroup-unreads 
9973                    (delq number gnus-newsgroup-unreads))
9974              (if gnus-newsgroup-auto-expire
9975                  (push number gnus-newsgroup-expirable)
9976                (push (cons number gnus-low-score-mark)
9977                      gnus-newsgroup-reads)))
9978            t))
9979         ;; Nope, invisible article.
9980         0
9981       ;; Ok, this article is to be visible, so we add it to the limit
9982       ;; and return 1.
9983       (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
9984       1)))
9985
9986 (defun gnus-expunge-thread (thread)
9987   "Mark all articles in THREAD as read."
9988   (let* ((number (mail-header-number (car thread))))
9989     (incf gnus-newsgroup-expunged-tally)
9990     ;; We also mark as read here, if that's wanted.
9991     (setq gnus-newsgroup-unreads 
9992           (delq number gnus-newsgroup-unreads))
9993     (if gnus-newsgroup-auto-expire
9994         (push number gnus-newsgroup-expirable)
9995       (push (cons number gnus-low-score-mark)
9996             gnus-newsgroup-reads)))
9997   ;; Go recursively through all subthreads.
9998   (mapcar 'gnus-expunge-thread (cdr thread)))
9999
10000 ;; Summary article oriented commands
10001
10002 (defun gnus-summary-refer-parent-article (n)
10003   "Refer parent article N times.
10004 The difference between N and the number of articles fetched is returned."
10005   (interactive "p")
10006   (gnus-set-global-variables)
10007   (while 
10008       (and 
10009        (> n 0)
10010        (let* ((header (gnus-summary-article-header))
10011               (ref 
10012                ;; If we try to find the parent of the currently
10013                ;; displayed article, then we take a look at the actual
10014                ;; References header, since this is slightly more
10015                ;; reliable than the References field we got from the
10016                ;; server. 
10017                (if (and (eq (mail-header-number header) 
10018                             (cdr gnus-article-current))
10019                         (equal gnus-newsgroup-name 
10020                                (car gnus-article-current)))
10021                    (save-excursion
10022                      (set-buffer gnus-original-article-buffer)
10023                      (gnus-narrow-to-headers)
10024                      (prog1
10025                          (mail-fetch-field "references")
10026                        (widen)))
10027                  ;; It's not the current article, so we take a bet on
10028                  ;; the value we got from the server. 
10029                  (mail-header-references header))))
10030          (if ref
10031              (or (gnus-summary-refer-article (gnus-parent-id ref))
10032                  (gnus-message 1 "Couldn't find parent"))
10033            (gnus-message 1 "No references in article %d"
10034                          (gnus-summary-article-number))
10035            nil)))
10036     (setq n (1- n)))
10037   (gnus-summary-position-point)
10038   n)
10039
10040 (defun gnus-summary-refer-references ()
10041   "Fetch all articles mentioned in the References header.
10042 Return how many articles were fetched."
10043   (interactive)
10044   (gnus-set-global-variables)
10045   (let ((ref (mail-header-references (gnus-summary-article-header)))
10046         (current (gnus-summary-article-number))
10047         (n 0))
10048     ;; For each Message-ID in the References header...
10049     (while (string-match "<[^>]*>" ref)
10050       (incf n)
10051       ;; ... fetch that article.
10052       (gnus-summary-refer-article 
10053        (prog1 (match-string 0 ref)
10054          (setq ref (substring ref (match-end 0))))))
10055     (gnus-summary-goto-subject current)
10056     (gnus-summary-position-point)
10057     n))
10058     
10059 (defun gnus-summary-refer-article (message-id)
10060   "Fetch an article specified by MESSAGE-ID."
10061   (interactive "sMessage-ID: ")
10062   (when (and (stringp message-id)
10063              (not (zerop (length message-id))))
10064     ;; Construct the correct Message-ID if necessary.
10065     ;; Suggested by tale@pawl.rpi.edu.
10066     (unless (string-match "^<" message-id)
10067       (setq message-id (concat "<" message-id)))
10068     (unless (string-match ">$" message-id)
10069       (setq message-id (concat message-id ">")))
10070     (let ((header (car (gnus-gethash (downcase message-id)
10071                                      gnus-newsgroup-dependencies))))
10072       (if header
10073           ;; The article is present in the buffer, to we just go to it.
10074           (gnus-summary-goto-article (mail-header-number header) nil t)
10075         ;; We fetch the article
10076         (let ((gnus-override-method gnus-refer-article-method)
10077               number)
10078           ;; Start the special refer-article method, if necessary.
10079           (when gnus-refer-article-method
10080             (gnus-check-server gnus-refer-article-method))
10081           ;; Fetch the header, and display the article.
10082           (when (setq number (gnus-summary-insert-subject message-id))
10083             (gnus-summary-select-article nil nil nil number)))))))
10084
10085 (defun gnus-summary-enter-digest-group (&optional force)
10086   "Enter a digest group based on the current article."
10087   (interactive "P")
10088   (gnus-set-global-variables)
10089   (gnus-summary-select-article)
10090   (let ((name (format "%s-%d" 
10091                       (gnus-group-prefixed-name 
10092                        gnus-newsgroup-name (list 'nndoc "")) 
10093                       gnus-current-article))
10094         (ogroup gnus-newsgroup-name)
10095         (buf (current-buffer)))
10096     (save-excursion
10097       (set-buffer gnus-original-article-buffer)
10098       (goto-char (point-min))
10099       (search-forward "\n\n" nil t)
10100       (narrow-to-region (point) (point-max)))
10101     (unwind-protect
10102         (if (gnus-group-read-ephemeral-group 
10103              name `(nndoc ,name (nndoc-address 
10104                                  ,(get-buffer gnus-original-article-buffer))
10105                           (nndoc-article-type ,(if force 'digest 'guess))) t)
10106             ;; Make all postings to this group go to the parent group.
10107             (setcdr (nthcdr 4 (gnus-get-info name))
10108                     (list (list (cons 'to-group ogroup))))
10109           ;; Couldn't select this doc group.
10110           (switch-to-buffer buf)
10111           (gnus-set-global-variables)
10112           (gnus-configure-windows 'summary)
10113           (gnus-message 3 "Article couldn't be entered?"))
10114       (save-excursion
10115         (set-buffer gnus-original-article-buffer)
10116         (widen)))))
10117
10118 (defun gnus-summary-isearch-article (&optional regexp-p)
10119   "Do incremental search forward on the current article.
10120 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
10121   (interactive "P")
10122   (gnus-set-global-variables)
10123   (gnus-summary-select-article)
10124   (gnus-eval-in-buffer-window 
10125    gnus-article-buffer
10126    (goto-char (point-min))
10127    (isearch-forward regexp-p)))
10128
10129 (defun gnus-summary-search-article-forward (regexp &optional backward)
10130   "Search for an article containing REGEXP forward.
10131 If BACKWARD, search backward instead."
10132   (interactive
10133    (list (read-string
10134           (format "Search article %s (regexp%s): "
10135                   (if current-prefix-arg "backward" "forward")
10136                   (if gnus-last-search-regexp
10137                       (concat ", default " gnus-last-search-regexp)
10138                     "")))
10139          current-prefix-arg))
10140   (gnus-set-global-variables)
10141   (if (string-equal regexp "")
10142       (setq regexp (or gnus-last-search-regexp ""))
10143     (setq gnus-last-search-regexp regexp))
10144   (if (gnus-summary-search-article regexp backward)
10145       (gnus-article-set-window-start 
10146        (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
10147     (error "Search failed: \"%s\"" regexp)))
10148
10149 (defun gnus-summary-search-article-backward (regexp)
10150   "Search for an article containing REGEXP backward."
10151   (interactive
10152    (list (read-string
10153           (format "Search article backward (regexp%s): "
10154                   (if gnus-last-search-regexp
10155                       (concat ", default " gnus-last-search-regexp)
10156                     "")))))
10157   (gnus-summary-search-article-forward regexp 'backward))
10158
10159 (defun gnus-summary-search-article (regexp &optional backward)
10160   "Search for an article containing REGEXP.
10161 Optional argument BACKWARD means do search for backward.
10162 gnus-select-article-hook is not called during the search."
10163   (let ((gnus-select-article-hook nil)  ;Disable hook.
10164         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
10165         (re-search
10166          (if backward
10167              (function re-search-backward) (function re-search-forward)))
10168         (found nil)
10169         (last nil))
10170     ;; Hidden thread subtrees must be searched for ,too.
10171     (gnus-summary-show-all-threads)
10172     ;; First of all, search current article.
10173     ;; We don't want to read article again from NNTP server nor reset
10174     ;; current point.
10175     (gnus-summary-select-article)
10176     (gnus-message 9 "Searching article: %d..." gnus-current-article)
10177     (setq last gnus-current-article)
10178     (gnus-eval-in-buffer-window
10179      gnus-article-buffer
10180      (save-restriction
10181        (widen)
10182        ;; Begin search from current point.
10183        (setq found (funcall re-search regexp nil t))))
10184     ;; Then search next articles.
10185     (while (and (not found)
10186                 (gnus-summary-display-article 
10187                  (if backward (gnus-summary-find-prev)
10188                    (gnus-summary-find-next))))
10189       (gnus-message 9 "Searching article: %d..." gnus-current-article)
10190       (gnus-eval-in-buffer-window
10191        gnus-article-buffer
10192        (save-restriction
10193          (widen)
10194          (goto-char (if backward (point-max) (point-min)))
10195          (setq found (funcall re-search regexp nil t)))))
10196     (message "")
10197     ;; Adjust article pointer.
10198     (or (eq last gnus-current-article)
10199         (setq gnus-last-article last))
10200     ;; Return T if found such article.
10201     found))
10202
10203 (defun gnus-summary-find-matching (header regexp &optional backward unread
10204                                           not-case-fold)
10205   "Return a list of all articles that match REGEXP on HEADER.
10206 The search stars on the current article and goes forwards unless
10207 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
10208 If UNREAD is non-nil, only unread articles will
10209 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
10210 in the comparisons."
10211   (let ((data (if (eq backward 'all) gnus-newsgroup-data
10212                 (gnus-data-find-list 
10213                  (gnus-summary-article-number) (gnus-data-list backward))))
10214         (func (intern (concat "gnus-header-" header)))
10215         (case-fold-search (not not-case-fold))
10216         articles d)
10217     (or (fboundp func) (error "%s is not a valid header" header))
10218     (while data
10219       (setq d (car data))
10220       (and (or (not unread)             ; We want all articles...
10221                (gnus-data-unread-p d))  ; Or just unreads.
10222            (vectorp (gnus-data-header d)) ; It's not a pseudo.
10223            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
10224            (setq articles (cons (gnus-data-number d) articles))) ; Success!
10225       (setq data (cdr data)))
10226     (nreverse articles)))
10227     
10228 (defun gnus-summary-execute-command (header regexp command &optional backward)
10229   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
10230 If HEADER is an empty string (or nil), the match is done on the entire
10231 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
10232   (interactive
10233    (list (let ((completion-ignore-case t))
10234            (completing-read 
10235             "Header name: "
10236             (mapcar (lambda (string) (list string))
10237                     '("Number" "Subject" "From" "Lines" "Date"
10238                       "Message-ID" "Xref" "References"))
10239             nil 'require-match))
10240          (read-string "Regexp: ")
10241          (read-key-sequence "Command: ")
10242          current-prefix-arg))
10243   (gnus-set-global-variables)
10244   ;; Hidden thread subtrees must be searched as well.
10245   (gnus-summary-show-all-threads)
10246   ;; We don't want to change current point nor window configuration.
10247   (save-excursion
10248     (save-window-excursion
10249       (gnus-message 6 "Executing %s..." (key-description command))
10250       ;; We'd like to execute COMMAND interactively so as to give arguments.
10251       (gnus-execute header regexp
10252                     `(lambda () (call-interactively ',(key-binding command)))
10253                     backward)
10254       (gnus-message 6 "Executing %s...done" (key-description command)))))
10255
10256 (defun gnus-summary-beginning-of-article ()
10257   "Scroll the article back to the beginning."
10258   (interactive)
10259   (gnus-set-global-variables)
10260   (gnus-summary-select-article)
10261   (gnus-configure-windows 'article)
10262   (gnus-eval-in-buffer-window
10263    gnus-article-buffer
10264    (widen)
10265    (goto-char (point-min))
10266    (and gnus-break-pages (gnus-narrow-to-page))))
10267
10268 (defun gnus-summary-end-of-article ()
10269   "Scroll to the end of the article."
10270   (interactive)
10271   (gnus-set-global-variables)
10272   (gnus-summary-select-article)
10273   (gnus-configure-windows 'article)
10274   (gnus-eval-in-buffer-window 
10275    gnus-article-buffer
10276    (widen)
10277    (goto-char (point-max))
10278    (recenter -3)
10279    (and gnus-break-pages (gnus-narrow-to-page))))
10280
10281 (defun gnus-summary-show-article (&optional arg)
10282   "Force re-fetching of the current article.
10283 If ARG (the prefix) is non-nil, show the raw article without any
10284 article massaging functions being run."
10285   (interactive "P")
10286   (gnus-set-global-variables)
10287   (if (not arg)
10288       ;; Select the article the normal way.
10289       (gnus-summary-select-article nil 'force)
10290     ;; Bind the article treatment functions to nil.
10291     (let ((gnus-have-all-headers t)
10292           gnus-article-display-hook
10293           gnus-article-prepare-hook
10294           gnus-visual)
10295       (gnus-summary-select-article nil 'force)))
10296   (gnus-configure-windows 'article)
10297   (gnus-summary-position-point))
10298
10299 (defun gnus-summary-verbose-headers (&optional arg)
10300   "Toggle permanent full header display.
10301 If ARG is a positive number, turn header display on.
10302 If ARG is a negative number, turn header display off."
10303   (interactive "P")
10304   (gnus-set-global-variables)
10305   (gnus-summary-toggle-header arg)
10306   (setq gnus-show-all-headers
10307         (cond ((or (not (numberp arg))
10308                    (zerop arg))
10309                (not gnus-show-all-headers))
10310               ((natnump arg)
10311                t))))
10312
10313 (defun gnus-summary-toggle-header (&optional arg)
10314   "Show the headers if they are hidden, or hide them if they are shown.
10315 If ARG is a positive number, show the entire header.
10316 If ARG is a negative number, hide the unwanted header lines."
10317   (interactive "P")
10318   (gnus-set-global-variables)
10319   (save-excursion
10320     (set-buffer gnus-article-buffer)
10321     (let* ((buffer-read-only nil)
10322            (inhibit-point-motion-hooks t) 
10323            (hidden (text-property-any 
10324                     (goto-char (point-min)) (search-forward "\n\n")
10325                     'invisible t))
10326            e)
10327       (goto-char (point-min))
10328       (when (search-forward "\n\n" nil t)
10329         (delete-region (point-min) (1- (point))))
10330       (goto-char (point-min))
10331       (save-excursion 
10332         (set-buffer gnus-original-article-buffer)
10333         (goto-char (point-min))
10334         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
10335       (insert-buffer-substring gnus-original-article-buffer 1 e)
10336       (let ((gnus-inhibit-hiding t))
10337         (run-hooks 'gnus-article-display-hook))
10338       (if (or (not hidden) (and (numberp arg) (< arg 0)))
10339           (gnus-article-hide-headers)))))
10340
10341 (defun gnus-summary-show-all-headers ()
10342   "Make all header lines visible."
10343   (interactive)
10344   (gnus-set-global-variables)
10345   (gnus-article-show-all-headers))
10346
10347 (defun gnus-summary-toggle-mime (&optional arg)
10348   "Toggle MIME processing.
10349 If ARG is a positive number, turn MIME processing on."
10350   (interactive "P")
10351   (gnus-set-global-variables)
10352   (setq gnus-show-mime
10353         (if (null arg) (not gnus-show-mime)
10354           (> (prefix-numeric-value arg) 0)))
10355   (gnus-summary-select-article t 'force))
10356
10357 (defun gnus-summary-caesar-message (&optional arg)
10358   "Caesar rotate the current article by 13.
10359 The numerical prefix specifies how manu places to rotate each letter
10360 forward."
10361   (interactive "P")
10362   (gnus-set-global-variables)
10363   (gnus-summary-select-article)
10364   (let ((mail-header-separator ""))
10365     (gnus-eval-in-buffer-window 
10366      gnus-article-buffer
10367      (save-restriction
10368        (widen)
10369        (let ((start (window-start)))
10370          (news-caesar-buffer-body arg)
10371          (set-window-start (get-buffer-window (current-buffer)) start))))))
10372
10373 (defun gnus-summary-stop-page-breaking ()
10374   "Stop page breaking in the current article."
10375   (interactive)
10376   (gnus-set-global-variables)
10377   (gnus-summary-select-article)
10378   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
10379
10380 ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
10381
10382 (defun gnus-summary-move-article (&optional n to-newsgroup select-method)
10383   "Move the current article to a different newsgroup.
10384 If N is a positive number, move the N next articles.
10385 If N is a negative number, move the N previous articles.
10386 If N is nil and any articles have been marked with the process mark,
10387 move those articles instead.
10388 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
10389 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10390 re-spool using this method.
10391 For this function to work, both the current newsgroup and the
10392 newsgroup that you want to move to have to support the `request-move'
10393 and `request-accept' functions. (Ie. mail newsgroups at present.)"
10394   (interactive "P")
10395   (gnus-set-global-variables)
10396   (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)
10397       (error "The current newsgroup does not support article moving"))
10398   (let ((articles (gnus-summary-work-articles n))
10399         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
10400         art-group to-method sel-met)
10401     (if (and (not to-newsgroup) (not select-method))
10402         (setq to-newsgroup
10403               (completing-read 
10404                (format "Where do you want to move %s? %s"
10405                        (if (> (length articles) 1)
10406                            (format "these %d articles" (length articles))
10407                          "this article")
10408                        (if gnus-current-move-group
10409                            (format "(default %s) " gnus-current-move-group)
10410                          ""))
10411                gnus-active-hashtb nil nil prefix)))
10412     (if to-newsgroup
10413         (progn
10414           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
10415               (setq to-newsgroup (or gnus-current-move-group "")))
10416           (or (gnus-active to-newsgroup)
10417               (gnus-activate-group to-newsgroup)
10418               (error "No such group: %s" to-newsgroup))
10419           (setq gnus-current-move-group to-newsgroup)))
10420     (setq to-method (if select-method (list select-method "")
10421                       (gnus-find-method-for-group to-newsgroup)))
10422     (or (gnus-check-backend-function 'request-accept-article (car to-method))
10423         (error "%s does not support article copying" (car to-method)))
10424     (or (gnus-check-server to-method)
10425         (error "Can't open server %s" (car to-method)))
10426     (gnus-message 6 "Moving to %s: %s..." 
10427                   (or select-method to-newsgroup) articles)
10428     (while articles
10429       (if (setq art-group
10430                 (gnus-request-move-article 
10431                  (car articles)         ; Article to move
10432                  gnus-newsgroup-name    ; From newsgrouo
10433                  (nth 1 (gnus-find-method-for-group 
10434                          gnus-newsgroup-name)) ; Server
10435                  (list 'gnus-request-accept-article 
10436                        (if select-method
10437                            (list 'quote select-method)
10438                          to-newsgroup)
10439                        (not (cdr articles))) ; Accept form
10440                  (not (cdr articles)))) ; Only save nov last time
10441           (let* ((buffer-read-only nil)
10442                  (entry 
10443                   (or
10444                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
10445                    (gnus-gethash 
10446                     (gnus-group-prefixed-name 
10447                      (car art-group) 
10448                      (if select-method (list select-method "")
10449                        (gnus-find-method-for-group to-newsgroup)))
10450                     gnus-newsrc-hashtb)))
10451                  (info (nth 2 entry))
10452                  (article (car articles)))
10453             ;; Update the group that has been moved to.
10454             (if (not info)
10455                 ()                      ; This group does not exist yet.
10456               (unless (memq article gnus-newsgroup-unreads)
10457                 (gnus-info-set-read 
10458                  info (gnus-add-to-range (gnus-info-read info) 
10459                                          (list (cdr art-group)))))
10460
10461               ;; Copy any marks over to the new group.
10462               (let ((marks '((tick . gnus-newsgroup-marked)
10463                              (dormant . gnus-newsgroup-dormant)
10464                              (expire . gnus-newsgroup-expirable)
10465                              (bookmark . gnus-newsgroup-bookmarks)
10466                              (save . gnus-newsgroup-saved)
10467                              (reply . gnus-newsgroup-replied)))
10468                     (to-article (cdr art-group)))
10469
10470                 ;; See whether the article is to be put in the cache.
10471                 (when gnus-use-cache
10472                   (gnus-cache-possibly-enter-article 
10473                    (gnus-info-group info) to-article
10474                    (let ((header (copy-sequence
10475                                   (gnus-summary-article-header article))))
10476                      (mail-header-set-number header to-article)
10477                      header)
10478                    (memq article gnus-newsgroup-marked)
10479                    (memq article gnus-newsgroup-dormant)
10480                    (memq article gnus-newsgroup-unreads)))
10481
10482                 (while marks
10483                   (if (memq article (symbol-value (cdr (car marks))))
10484                       (gnus-add-marked-articles 
10485                        (gnus-info-group info) (car (car marks))
10486                        (list to-article) info))
10487                   (setq marks (cdr marks)))))
10488             (gnus-summary-goto-subject article)
10489             (gnus-summary-mark-article article gnus-canceled-mark))
10490         (gnus-message 1 "Couldn't move article %s" (car articles)))
10491       (gnus-summary-remove-process-mark (car articles))
10492       (setq articles (cdr articles)))
10493     (gnus-set-mode-line 'summary)))
10494
10495 (defun gnus-summary-respool-article (&optional n respool-method)
10496   "Respool the current article.
10497 The article will be squeezed through the mail spooling process again,
10498 which means that it will be put in some mail newsgroup or other
10499 depending on `nnmail-split-methods'.
10500 If N is a positive number, respool the N next articles.
10501 If N is a negative number, respool the N previous articles.
10502 If N is nil and any articles have been marked with the process mark,
10503 respool those articles instead.
10504
10505 Respooling can be done both from mail groups and \"real\" newsgroups.
10506 In the former case, the articles in question will be moved from the
10507 current group into whatever groups they are destined to.  In the
10508 latter case, they will be copied into the relevant groups."
10509   (interactive "P")
10510   (gnus-set-global-variables)
10511   (let ((respool-methods (gnus-methods-using 'respool))
10512         (methname 
10513          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
10514     (or respool-method
10515         (setq respool-method
10516               (completing-read
10517                "What method do you want to use when respooling? "
10518                respool-methods nil t methname)))
10519     (or (string= respool-method "")
10520         (if (assoc (symbol-name
10521                     (car (gnus-find-method-for-group gnus-newsgroup-name)))
10522                    respool-methods)
10523             (gnus-summary-move-article n nil (intern respool-method))
10524           (gnus-summary-copy-article n nil (intern respool-method))))))
10525
10526 ;; Suggested by gregj@unidata.com (Gregory J. Grubbs).
10527 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
10528   "Move the current article to a different newsgroup.
10529 If N is a positive number, move the N next articles.
10530 If N is a negative number, move the N previous articles.
10531 If N is nil and any articles have been marked with the process mark,
10532 move those articles instead.
10533 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
10534 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10535 re-spool using this method.
10536 For this function to work, the newsgroup that you want to move to have
10537 to support the `request-move' and `request-accept'
10538 functions. (Ie. mail newsgroups at present.)"
10539   (interactive "P")
10540   (gnus-set-global-variables)
10541   (let ((articles (gnus-summary-work-articles n))
10542         (copy-buf (get-buffer-create "*copy work*"))
10543         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
10544         art-group to-method)
10545     (buffer-disable-undo copy-buf)
10546     (if (and (not to-newsgroup) (not select-method))
10547         (setq to-newsgroup
10548               (completing-read 
10549                (format "Where do you want to copy %s? %s"
10550                        (if (> (length articles) 1)
10551                            (format "these %d articles" (length articles))
10552                          "this article")
10553                        (if gnus-current-move-group
10554                            (format "(default %s) " gnus-current-move-group)
10555                          ""))
10556                gnus-active-hashtb nil nil prefix)))
10557     (if to-newsgroup
10558         (progn
10559           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
10560               (setq to-newsgroup (or gnus-current-move-group "")))
10561           (or (gnus-active to-newsgroup)
10562               (gnus-activate-group to-newsgroup)
10563               (error "No such group: %s" to-newsgroup))
10564           (setq gnus-current-move-group to-newsgroup)))
10565     (setq to-method (if select-method (list select-method "")
10566                       (gnus-find-method-for-group to-newsgroup)))
10567     (or (gnus-check-backend-function 'request-accept-article (car to-method))
10568         (error "%s does not support article copying" (car to-method)))
10569     (or (gnus-check-server to-method)
10570         (error "Can't open server %s" (car to-method)))
10571     (while articles
10572       (gnus-message 6 "Copying to %s: %s..." 
10573                     (or select-method to-newsgroup) articles)
10574       (if (setq art-group
10575                 (save-excursion
10576                   (set-buffer copy-buf)
10577                   (gnus-request-article-this-buffer
10578                    (car articles) gnus-newsgroup-name)
10579                   (gnus-request-accept-article
10580                    (if select-method select-method to-newsgroup)
10581                    (not (cdr articles)))))
10582           (let* ((entry 
10583                   (or
10584                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
10585                    (gnus-gethash 
10586                     (gnus-group-prefixed-name 
10587                      (car art-group) 
10588                      (if select-method (list select-method "")
10589                        (gnus-find-method-for-group to-newsgroup)))
10590                     gnus-newsrc-hashtb)))
10591                  (info (nth 2 entry))
10592                  (article (car articles)))
10593             ;; We copy the info over to the new group.
10594             (if (not info)
10595                 ()                      ; This group does not exist (yet).
10596               (if (not (memq article gnus-newsgroup-unreads))
10597                   (gnus-info-set-read 
10598                    info (gnus-add-to-range (gnus-info-read info) 
10599                                            (list (cdr art-group)))))
10600
10601               ;; Copy any marks over to the new group.
10602               (let ((marks '((tick . gnus-newsgroup-marked)
10603                              (dormant . gnus-newsgroup-dormant)
10604                              (expire . gnus-newsgroup-expirable)
10605                              (bookmark . gnus-newsgroup-bookmarks)
10606                              (save . gnus-newsgroup-saved)
10607                              (reply . gnus-newsgroup-replied)))
10608                     (to-article (cdr art-group)))
10609
10610               ;; See whether the article is to be put in the cache.
10611               (when gnus-use-cache
10612                 (gnus-cache-possibly-enter-article 
10613                  (gnus-info-group info) to-article 
10614                  (let ((header (copy-sequence
10615                                 (gnus-summary-article-header article))))
10616                    (mail-header-set-number header to-article)
10617                    header)
10618                  (memq article gnus-newsgroup-marked)
10619                  (memq article gnus-newsgroup-dormant)
10620                  (memq article gnus-newsgroup-unreads)))
10621
10622               (while marks
10623                 (if (memq article (symbol-value (cdr (car marks))))
10624                     (gnus-add-marked-articles 
10625                      (gnus-info-group info) (car (car marks)) 
10626                      (list to-article) info))
10627                 (setq marks (cdr marks))))))
10628         (gnus-message 1 "Couldn't copy article %s" (car articles)))
10629       (gnus-summary-remove-process-mark (car articles))
10630       (setq articles (cdr articles)))
10631     (kill-buffer copy-buf)))
10632
10633 (defun gnus-summary-import-article (file)
10634   "Import a random file into a mail newsgroup."
10635   (interactive "fImport file: ")
10636   (gnus-set-global-variables)
10637   (let ((group gnus-newsgroup-name)
10638         atts lines)
10639     (or (gnus-check-backend-function 'request-accept-article group)
10640         (error "%s does not support article importing" group))
10641     (or (file-readable-p file)
10642         (not (file-regular-p file))
10643         (error "Can't read %s" file))
10644     (save-excursion
10645       (set-buffer (get-buffer-create " *import file*"))
10646       (buffer-disable-undo (current-buffer))
10647       (erase-buffer)
10648       (insert-file-contents file)
10649       (goto-char (point-min))
10650       (if (nnheader-article-p)
10651           ()
10652         (setq atts (file-attributes file)
10653               lines (count-lines (point-min) (point-max)))
10654         (insert "From: " (read-string "From: ") "\n"
10655                 "Subject: " (read-string "Subject: ") "\n"
10656                 "Date: " (current-time-string (nth 5 atts)) "\n"
10657                 "Message-ID: " (gnus-inews-message-id) "\n"
10658                 "Lines: " (int-to-string lines) "\n"
10659                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
10660       (gnus-request-accept-article group t)
10661       (kill-buffer (current-buffer)))))
10662
10663 (defun gnus-summary-expire-articles ()
10664   "Expire all articles that are marked as expirable in the current group."
10665   (interactive)
10666   (gnus-set-global-variables)
10667   (when (gnus-check-backend-function 
10668          'request-expire-articles gnus-newsgroup-name)
10669     ;; This backend supports expiry.
10670     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
10671            (expirable (if total
10672                           (gnus-list-of-read-articles gnus-newsgroup-name)
10673                         (setq gnus-newsgroup-expirable
10674                               (sort gnus-newsgroup-expirable '<))))
10675            (expiry-wait (gnus-group-get-parameter 
10676                          gnus-newsgroup-name 'expiry-wait))
10677            es)
10678       (when expirable
10679         ;; There are expirable articles in this group, so we run them
10680         ;; through the expiry process.
10681         (gnus-message 6 "Expiring articles...")
10682         ;; The list of articles that weren't expired is returned.
10683         (if expiry-wait
10684             (let ((nnmail-expiry-wait-function nil)
10685                   (nnmail-expiry-wait expiry-wait))
10686               (setq es (gnus-request-expire-articles
10687                         expirable gnus-newsgroup-name)))
10688           (setq es (gnus-request-expire-articles
10689                     expirable gnus-newsgroup-name)))
10690         (or total (setq gnus-newsgroup-expirable es))
10691         ;; We go through the old list of expirable, and mark all
10692         ;; really expired articles as non-existant.
10693         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
10694           (let ((gnus-use-cache nil))
10695             (while expirable
10696               (unless (memq (car expirable) es)
10697                 (when (gnus-data-find (car expirable))
10698                   (gnus-summary-mark-article
10699                    (car expirable) gnus-canceled-mark)))
10700               (setq expirable (cdr expirable)))))
10701         (gnus-message 6 "Expiring articles...done")))))
10702
10703 (defun gnus-summary-expire-articles-now ()
10704   "Expunge all expirable articles in the current group.
10705 This means that *all* articles that are marked as expirable will be
10706 deleted forever, right now."
10707   (interactive)
10708   (gnus-set-global-variables)
10709   (or gnus-expert-user
10710       (gnus-y-or-n-p
10711        "Are you really, really, really sure you want to expunge? ")
10712       (error "Phew!"))
10713   (let ((nnmail-expiry-wait 'immediate)
10714         (nnmail-expiry-wait-function nil))
10715     (gnus-summary-expire-articles)))
10716
10717 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
10718 (defun gnus-summary-delete-article (&optional n)
10719   "Delete the N next (mail) articles.
10720 This command actually deletes articles.  This is not a marking
10721 command.  The article will disappear forever from your life, never to
10722 return. 
10723 If N is negative, delete backwards.
10724 If N is nil and articles have been marked with the process mark,
10725 delete these instead."
10726   (interactive "P")
10727   (gnus-set-global-variables)
10728   (or (gnus-check-backend-function 'request-expire-articles 
10729                                    gnus-newsgroup-name)
10730       (error "The current newsgroup does not support article deletion."))
10731   ;; Compute the list of articles to delete.
10732   (let ((articles (gnus-summary-work-articles n))
10733         not-deleted)
10734     (if (and gnus-novice-user
10735              (not (gnus-y-or-n-p 
10736                    (format "Do you really want to delete %s forever? "
10737                            (if (> (length articles) 1) "these articles"
10738                              "this article")))))
10739         ()
10740       ;; Delete the articles.
10741       (setq not-deleted (gnus-request-expire-articles 
10742                          articles gnus-newsgroup-name 'force))
10743       (while articles
10744         (gnus-summary-remove-process-mark (car articles))       
10745         ;; The backend might not have been able to delete the article
10746         ;; after all.  
10747         (or (memq (car articles) not-deleted)
10748             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
10749         (setq articles (cdr articles))))
10750     (gnus-summary-position-point)
10751     (gnus-set-mode-line 'summary)
10752     not-deleted))
10753
10754 (defun gnus-summary-edit-article (&optional force)
10755   "Enter into a buffer and edit the current article.
10756 This will have permanent effect only in mail groups.
10757 If FORCE is non-nil, allow editing of articles even in read-only
10758 groups."
10759   (interactive "P")
10760   (gnus-set-global-variables)
10761   (when (and (not force)
10762              (gnus-group-read-only-p))
10763     (error "The current newsgroup does not support article editing."))
10764   (gnus-summary-select-article t nil t)
10765   (gnus-configure-windows 'article)
10766   (select-window (get-buffer-window gnus-article-buffer))
10767   (gnus-message 6 "C-c C-c to end edits")
10768   (setq buffer-read-only nil)
10769   (text-mode)
10770   (use-local-map (copy-keymap (current-local-map)))
10771   (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
10772   (buffer-enable-undo)
10773   (widen)
10774   (goto-char (point-min))
10775   (search-forward "\n\n" nil t))
10776
10777 (defun gnus-summary-edit-article-done ()
10778   "Make edits to the current article permanent."
10779   (interactive)
10780   (if (gnus-group-read-only-p)
10781       (progn
10782         (gnus-summary-edit-article-postpone)
10783         (message "The current newsgroup does not support article editing.")
10784         (ding))
10785     (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
10786       (erase-buffer)
10787       (insert buf)
10788       (if (not (gnus-request-replace-article 
10789                 (cdr gnus-article-current) (car gnus-article-current) 
10790                 (current-buffer)))
10791           (error "Couldn't replace article.")
10792         (gnus-article-mode)
10793         (use-local-map gnus-article-mode-map)
10794         (setq buffer-read-only t)
10795         (buffer-disable-undo (current-buffer))
10796         (gnus-configure-windows 'summary))
10797       (and (gnus-visual-p 'summary-highlight 'highlight)
10798            (run-hooks 'gnus-visual-mark-article-hook)))))
10799
10800 (defun gnus-summary-edit-article-postpone ()
10801   "Postpone changes to the current article."
10802   (interactive)
10803   (gnus-article-mode)
10804   (use-local-map gnus-article-mode-map)
10805   (setq buffer-read-only t)
10806   (buffer-disable-undo (current-buffer))
10807   (gnus-configure-windows 'summary)
10808   (and (gnus-visual-p 'summary-highlight 'highlight)
10809        (run-hooks 'gnus-visual-mark-article-hook)))
10810
10811 (defun gnus-summary-respool-query ()
10812   "Query where the respool algorithm would put this article."
10813   (interactive)
10814   (gnus-set-global-variables)
10815   (gnus-summary-select-article)
10816   (save-excursion
10817     (set-buffer gnus-article-buffer)
10818     (save-restriction
10819       (goto-char (point-min))
10820       (search-forward "\n\n")
10821       (narrow-to-region (point-min) (point))
10822       (pp-eval-expression
10823        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
10824
10825 ;; Summary score commands.
10826
10827 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
10828
10829 (defun gnus-summary-raise-score (n)
10830   "Raise the score of the current article by N."
10831   (interactive "p")
10832   (gnus-set-global-variables)
10833   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
10834
10835 (defun gnus-summary-set-score (n)
10836   "Set the score of the current article to N."
10837   (interactive "p")
10838   (gnus-set-global-variables)
10839   (save-excursion
10840     (gnus-summary-show-thread)
10841     (let ((buffer-read-only nil))
10842       ;; Set score.
10843       (gnus-summary-update-mark
10844        (if (= n (or gnus-summary-default-score 0)) ? 
10845          (if (< n (or gnus-summary-default-score 0)) 
10846              gnus-score-below-mark gnus-score-over-mark)) 'score))
10847     (let* ((article (gnus-summary-article-number))
10848            (score (assq article gnus-newsgroup-scored)))
10849       (if score (setcdr score n)
10850         (setq gnus-newsgroup-scored 
10851               (cons (cons article n) gnus-newsgroup-scored))))
10852     (gnus-summary-update-line)))
10853
10854 (defun gnus-summary-current-score ()
10855   "Return the score of the current article."
10856   (interactive)
10857   (gnus-set-global-variables)
10858   (message "%s" (gnus-summary-article-score)))
10859
10860 ;; Summary marking commands.
10861
10862 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
10863   "Mark articles which has the same subject as read, and then select the next.
10864 If UNMARK is positive, remove any kind of mark.
10865 If UNMARK is negative, tick articles."
10866   (interactive "P")
10867   (gnus-set-global-variables)
10868   (if unmark
10869       (setq unmark (prefix-numeric-value unmark)))
10870   (let ((count
10871          (gnus-summary-mark-same-subject
10872           (gnus-summary-article-subject) unmark)))
10873     ;; Select next unread article.  If auto-select-same mode, should
10874     ;; select the first unread article.
10875     (gnus-summary-next-article t (and gnus-auto-select-same
10876                                       (gnus-summary-article-subject)))
10877     (gnus-message 7 "%d article%s marked as %s"
10878                   count (if (= count 1) " is" "s are")
10879                   (if unmark "unread" "read"))))
10880
10881 (defun gnus-summary-kill-same-subject (&optional unmark)
10882   "Mark articles which has the same subject as read. 
10883 If UNMARK is positive, remove any kind of mark.
10884 If UNMARK is negative, tick articles."
10885   (interactive "P")
10886   (gnus-set-global-variables)
10887   (if unmark
10888       (setq unmark (prefix-numeric-value unmark)))
10889   (let ((count
10890          (gnus-summary-mark-same-subject
10891           (gnus-summary-article-subject) unmark)))
10892     ;; If marked as read, go to next unread subject.
10893     (if (null unmark)
10894         ;; Go to next unread subject.
10895         (gnus-summary-next-subject 1 t))
10896     (gnus-message 7 "%d articles are marked as %s"
10897                   count (if unmark "unread" "read"))))
10898
10899 (defun gnus-summary-mark-same-subject (subject &optional unmark)
10900   "Mark articles with same SUBJECT as read, and return marked number.
10901 If optional argument UNMARK is positive, remove any kinds of marks.
10902 If optional argument UNMARK is negative, mark articles as unread instead."
10903   (let ((count 1))
10904     (save-excursion
10905       (cond 
10906        ((null unmark)                   ; Mark as read.
10907         (while (and 
10908                 (progn
10909                   (gnus-summary-mark-article-as-read gnus-killed-mark)
10910                   (gnus-summary-show-thread) t)
10911                 (gnus-summary-find-subject subject))
10912           (setq count (1+ count))))
10913        ((> unmark 0)                    ; Tick.
10914         (while (and
10915                 (progn
10916                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
10917                   (gnus-summary-show-thread) t)
10918                 (gnus-summary-find-subject subject))
10919           (setq count (1+ count))))
10920        (t                               ; Mark as unread.
10921         (while (and
10922                 (progn
10923                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
10924                   (gnus-summary-show-thread) t)
10925                 (gnus-summary-find-subject subject))
10926           (setq count (1+ count)))))
10927       (gnus-set-mode-line 'summary)
10928       ;; Return the number of marked articles.
10929       count)))
10930
10931 (defun gnus-summary-mark-as-processable (n &optional unmark)
10932   "Set the process mark on the next N articles.
10933 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
10934 the process mark instead.  The difference between N and the actual
10935 number of articles marked is returned."
10936   (interactive "p")
10937   (gnus-set-global-variables)
10938   (let ((backward (< n 0))
10939         (n (abs n)))
10940     (while (and 
10941             (> n 0)
10942             (if unmark
10943                 (gnus-summary-remove-process-mark
10944                  (gnus-summary-article-number))
10945               (gnus-summary-set-process-mark (gnus-summary-article-number)))
10946             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
10947       (setq n (1- n)))
10948     (if (/= 0 n) (gnus-message 7 "No more articles"))
10949     (gnus-summary-recenter)
10950     (gnus-summary-position-point)
10951     n))
10952
10953 (defun gnus-summary-unmark-as-processable (n)
10954   "Remove the process mark from the next N articles.
10955 If N is negative, mark backward instead.  The difference between N and
10956 the actual number of articles marked is returned."
10957   (interactive "p")
10958   (gnus-set-global-variables)
10959   (gnus-summary-mark-as-processable n t))
10960
10961 (defun gnus-summary-unmark-all-processable ()
10962   "Remove the process mark from all articles."
10963   (interactive)
10964   (gnus-set-global-variables)
10965   (save-excursion
10966     (while gnus-newsgroup-processable
10967       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
10968   (gnus-summary-position-point))
10969
10970 (defun gnus-summary-mark-as-expirable (n)
10971   "Mark N articles forward as expirable.
10972 If N is negative, mark backward instead.  The difference between N and
10973 the actual number of articles marked is returned."
10974   (interactive "p")
10975   (gnus-set-global-variables)
10976   (gnus-summary-mark-forward n gnus-expirable-mark))
10977
10978 (defun gnus-summary-mark-article-as-replied (article)
10979   "Mark ARTICLE replied and update the summary line."
10980   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
10981   (let ((buffer-read-only nil))
10982     (when (gnus-summary-goto-subject article)
10983       (gnus-summary-update-secondary-mark article))))
10984
10985 (defun gnus-summary-set-bookmark (article)
10986   "Set a bookmark in current article."
10987   (interactive (list (gnus-summary-article-number)))
10988   (gnus-set-global-variables)
10989   (if (or (not (get-buffer gnus-article-buffer))
10990           (not gnus-current-article)
10991           (not gnus-article-current)
10992           (not (equal gnus-newsgroup-name (car gnus-article-current))))
10993       (error "No current article selected"))
10994   ;; Remove old bookmark, if one exists.
10995   (let ((old (assq article gnus-newsgroup-bookmarks)))
10996     (if old (setq gnus-newsgroup-bookmarks 
10997                   (delq old gnus-newsgroup-bookmarks))))
10998   ;; Set the new bookmark, which is on the form 
10999   ;; (article-number . line-number-in-body).
11000   (setq gnus-newsgroup-bookmarks 
11001         (cons 
11002          (cons article 
11003                (save-excursion
11004                  (set-buffer gnus-article-buffer)
11005                  (count-lines
11006                   (min (point)
11007                        (save-excursion
11008                          (goto-char (point-min))
11009                          (search-forward "\n\n" nil t)
11010                          (point)))
11011                   (point))))
11012          gnus-newsgroup-bookmarks))
11013   (gnus-message 6 "A bookmark has been added to the current article."))
11014
11015 (defun gnus-summary-remove-bookmark (article)
11016   "Remove the bookmark from the current article."
11017   (interactive (list (gnus-summary-article-number)))
11018   (gnus-set-global-variables)
11019   ;; Remove old bookmark, if one exists.
11020   (let ((old (assq article gnus-newsgroup-bookmarks)))
11021     (if old 
11022         (progn
11023           (setq gnus-newsgroup-bookmarks 
11024                 (delq old gnus-newsgroup-bookmarks))
11025           (gnus-message 6 "Removed bookmark."))
11026       (gnus-message 6 "No bookmark in current article."))))
11027
11028 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11029 (defun gnus-summary-mark-as-dormant (n)
11030   "Mark N articles forward as dormant.
11031 If N is negative, mark backward instead.  The difference between N and
11032 the actual number of articles marked is returned."
11033   (interactive "p")
11034   (gnus-set-global-variables)
11035   (gnus-summary-mark-forward n gnus-dormant-mark))
11036
11037 (defun gnus-summary-set-process-mark (article)
11038   "Set the process mark on ARTICLE and update the summary line."
11039   (setq gnus-newsgroup-processable 
11040         (cons article 
11041               (delq article gnus-newsgroup-processable)))
11042   (when (gnus-summary-goto-subject article)
11043     (gnus-summary-show-thread)
11044     (gnus-summary-update-secondary-mark article)))
11045
11046 (defun gnus-summary-remove-process-mark (article)
11047   "Remove the process mark from ARTICLE and update the summary line."
11048   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
11049   (when (gnus-summary-goto-subject article)
11050     (gnus-summary-show-thread)
11051     (gnus-summary-update-secondary-mark article)))
11052
11053 (defun gnus-summary-set-saved-mark (article)
11054   "Set the process mark on ARTICLE and update the summary line."
11055   (push article gnus-newsgroup-saved)
11056   (when (gnus-summary-goto-subject article)
11057     (gnus-summary-update-secondary-mark article)))
11058
11059 (defun gnus-summary-mark-forward (n &optional mark no-expire)
11060   "Mark N articles as read forwards.
11061 If N is negative, mark backwards instead.
11062 Mark with MARK.  If MARK is ? , ?! or ??, articles will be
11063 marked as unread. 
11064 The difference between N and the actual number of articles marked is
11065 returned."
11066   (interactive "p")
11067   (gnus-set-global-variables)
11068   (let ((backward (< n 0))
11069         (gnus-summary-goto-unread
11070          (and gnus-summary-goto-unread
11071               (not (memq mark (list gnus-unread-mark
11072                                     gnus-ticked-mark gnus-dormant-mark)))))
11073         (n (abs n))
11074         (mark (or mark gnus-del-mark)))
11075     (while (and (> n 0)
11076                 (gnus-summary-mark-article nil mark no-expire)
11077                 (zerop (gnus-summary-next-subject 
11078                         (if backward -1 1) gnus-summary-goto-unread t)))
11079       (setq n (1- n)))
11080     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
11081     (gnus-summary-recenter)
11082     (gnus-summary-position-point)
11083     (gnus-set-mode-line 'summary)
11084     n))
11085
11086 (defun gnus-summary-mark-article-as-read (mark)
11087   "Mark the current article quickly as read with MARK."
11088   (let ((article (gnus-summary-article-number)))
11089     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11090     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11091     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11092     (setq gnus-newsgroup-reads
11093           (cons (cons article mark) gnus-newsgroup-reads))
11094     ;; Possibly remove from cache, if that is used. 
11095     (and gnus-use-cache (gnus-cache-enter-remove-article article))
11096     (and gnus-newsgroup-auto-expire 
11097          (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11098              (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11099              (= mark gnus-read-mark) (= mark gnus-souped-mark))
11100          (progn
11101            (setq mark gnus-expirable-mark)
11102            (setq gnus-newsgroup-expirable 
11103                  (cons article gnus-newsgroup-expirable))))
11104     ;; Fix the mark.
11105     (gnus-summary-update-mark mark 'unread)
11106     t))
11107
11108 (defun gnus-summary-mark-article-as-unread (mark)
11109   "Mark the current article quickly as unread with MARK."
11110   (let ((article (gnus-summary-article-number)))
11111     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11112     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11113     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11114     (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
11115     (cond ((= mark gnus-ticked-mark)
11116            (push article gnus-newsgroup-marked))
11117           ((= mark gnus-dormant-mark)
11118            (push article gnus-newsgroup-dormant))
11119           (t     
11120            (push article gnus-newsgroup-unreads)))
11121     (setq gnus-newsgroup-reads
11122           (delq (assq article gnus-newsgroup-reads)
11123                 gnus-newsgroup-reads))
11124
11125     ;; See whether the article is to be put in the cache.
11126     (and gnus-use-cache
11127          (vectorp (gnus-summary-article-header article))
11128          (save-excursion
11129            (gnus-cache-possibly-enter-article 
11130             gnus-newsgroup-name article 
11131             (gnus-summary-article-header article)
11132             (= mark gnus-ticked-mark)
11133             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11134
11135     ;; Fix the mark.
11136     (gnus-summary-update-mark mark 'unread)
11137     t))
11138
11139 (defun gnus-summary-mark-article (&optional article mark no-expire)
11140   "Mark ARTICLE with MARK.  MARK can be any character.
11141 Four MARK strings are reserved: `? ' (unread), `?!' (ticked), 
11142 `??' (dormant) and `?E' (expirable).
11143 If MARK is nil, then the default character `?D' is used.
11144 If ARTICLE is nil, then the article on the current line will be
11145 marked." 
11146   ;; The mark might be a string.
11147   (and (stringp mark)
11148        (setq mark (aref mark 0)))
11149   ;; If no mark is given, then we check auto-expiring.
11150   (and (not no-expire)
11151        gnus-newsgroup-auto-expire 
11152        (or (not mark)
11153            (and (numberp mark) 
11154                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11155                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11156                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
11157        (setq mark gnus-expirable-mark))
11158   (let* ((mark (or mark gnus-del-mark))
11159          (article (or article (gnus-summary-article-number))))
11160     (or article (error "No article on current line"))
11161     (if (or (= mark gnus-unread-mark) 
11162             (= mark gnus-ticked-mark) 
11163             (= mark gnus-dormant-mark))
11164         (gnus-mark-article-as-unread article mark)
11165       (gnus-mark-article-as-read article mark))
11166
11167     ;; See whether the article is to be put in the cache.
11168     (and gnus-use-cache
11169          (not (= mark gnus-canceled-mark))
11170          (vectorp (gnus-summary-article-header article))
11171          (save-excursion
11172            (gnus-cache-possibly-enter-article 
11173             gnus-newsgroup-name article 
11174             (gnus-summary-article-header article)
11175             (= mark gnus-ticked-mark)
11176             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11177
11178     (if (gnus-summary-goto-subject article nil t)
11179         (let ((buffer-read-only nil))
11180           (gnus-summary-show-thread)
11181           ;; Fix the mark.
11182           (gnus-summary-update-mark mark 'unread)
11183           t))))
11184
11185 (defun gnus-summary-update-secondary-mark (article)
11186   "Update the secondary (read, process, cache) mark."
11187   (gnus-summary-update-mark
11188    (cond ((memq article gnus-newsgroup-processable)
11189           gnus-process-mark)
11190          ((memq article gnus-newsgroup-cached)
11191           gnus-cached-mark)
11192          ((memq article gnus-newsgroup-replied)
11193           gnus-replied-mark)
11194          ((memq article gnus-newsgroup-saved)
11195           gnus-saved-mark)
11196          (t gnus-unread-mark))
11197    'replied)
11198   (when (gnus-visual-p 'summary-highlight 'highlight)
11199     (run-hooks 'gnus-summary-update-hook))
11200   t)
11201
11202 (defun gnus-summary-update-mark (mark type)
11203   (beginning-of-line)
11204   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
11205         (buffer-read-only nil))
11206     (when forward
11207       ;; Go to the right position on the line.
11208       (forward-char forward)
11209       ;; Replace the old mark with the new mark.
11210       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
11211       ;; Optionally update the marks by some user rule.
11212       (when (eq type 'unread)
11213         (gnus-data-set-mark 
11214          (gnus-data-find (gnus-summary-article-number)) mark)
11215         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
11216   
11217 (defun gnus-mark-article-as-read (article &optional mark)
11218   "Enter ARTICLE in the pertinent lists and remove it from others."
11219   ;; Make the article expirable.
11220   (let ((mark (or mark gnus-del-mark)))
11221     (if (= mark gnus-expirable-mark)
11222         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
11223       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
11224     ;; Remove from unread and marked lists.
11225     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11226     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11227     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11228     (push (cons article mark) gnus-newsgroup-reads)
11229     ;; Possibly remove from cache, if that is used. 
11230     (when gnus-use-cache 
11231       (gnus-cache-enter-remove-article article))))
11232
11233 (defun gnus-mark-article-as-unread (article &optional mark)
11234   "Enter ARTICLE in the pertinent lists and remove it from others."
11235   (let ((mark (or mark gnus-ticked-mark)))
11236     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11237     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11238     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11239     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11240     (cond ((= mark gnus-ticked-mark)
11241            (push article gnus-newsgroup-marked))
11242           ((= mark gnus-dormant-mark)
11243            (push article gnus-newsgroup-dormant))
11244           (t     
11245            (push article gnus-newsgroup-unreads)))
11246     (setq gnus-newsgroup-reads
11247           (delq (assq article gnus-newsgroup-reads)
11248                 gnus-newsgroup-reads))))
11249
11250 (defalias 'gnus-summary-mark-as-unread-forward 
11251   'gnus-summary-tick-article-forward)
11252 (make-obsolete 'gnus-summary-mark-as-unread-forward 
11253                'gnus-summary-tick-article-forward)
11254 (defun gnus-summary-tick-article-forward (n)
11255   "Tick N articles forwards.
11256 If N is negative, tick backwards instead.
11257 The difference between N and the number of articles ticked is returned."
11258   (interactive "p")
11259   (gnus-summary-mark-forward n gnus-ticked-mark))
11260
11261 (defalias 'gnus-summary-mark-as-unread-backward 
11262   'gnus-summary-tick-article-backward)
11263 (make-obsolete 'gnus-summary-mark-as-unread-backward 
11264                'gnus-summary-tick-article-backward)
11265 (defun gnus-summary-tick-article-backward (n)
11266   "Tick N articles backwards.
11267 The difference between N and the number of articles ticked is returned."
11268   (interactive "p")
11269   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
11270
11271 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
11272 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
11273 (defun gnus-summary-tick-article (&optional article clear-mark)
11274   "Mark current article as unread.
11275 Optional 1st argument ARTICLE specifies article number to be marked as unread.
11276 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
11277   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
11278                                        gnus-ticked-mark)))
11279
11280 (defun gnus-summary-mark-as-read-forward (n)
11281   "Mark N articles as read forwards.
11282 If N is negative, mark backwards instead.
11283 The difference between N and the actual number of articles marked is
11284 returned."
11285   (interactive "p")
11286   (gnus-summary-mark-forward n gnus-del-mark t))
11287
11288 (defun gnus-summary-mark-as-read-backward (n)
11289   "Mark the N articles as read backwards.
11290 The difference between N and the actual number of articles marked is
11291 returned."
11292   (interactive "p")
11293   (gnus-summary-mark-forward (- n) gnus-del-mark t))
11294
11295 (defun gnus-summary-mark-as-read (&optional article mark)
11296   "Mark current article as read.
11297 ARTICLE specifies the article to be marked as read.
11298 MARK specifies a string to be inserted at the beginning of the line."
11299   (gnus-summary-mark-article article mark))
11300
11301 (defun gnus-summary-clear-mark-forward (n)
11302   "Clear marks from N articles forward.
11303 If N is negative, clear backward instead.
11304 The difference between N and the number of marks cleared is returned."
11305   (interactive "p")
11306   (gnus-summary-mark-forward n gnus-unread-mark))
11307
11308 (defun gnus-summary-clear-mark-backward (n)
11309   "Clear marks from N articles backward.
11310 The difference between N and the number of marks cleared is returned."
11311   (interactive "p")
11312   (gnus-summary-mark-forward (- n) gnus-unread-mark))
11313
11314 (defun gnus-summary-mark-unread-as-read ()
11315   "Intended to be used by `gnus-summary-mark-article-hook'."
11316   (when (memq gnus-current-article gnus-newsgroup-unreads)
11317     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
11318
11319 (defun gnus-summary-mark-region-as-read (point mark all)
11320   "Mark all unread articles between point and mark as read.
11321 If given a prefix, mark all articles between point and mark as read,
11322 even ticked and dormant ones."
11323   (interactive "r\nP")
11324   (save-excursion
11325     (let (article)
11326       (goto-char point)
11327       (beginning-of-line)
11328       (while (and 
11329               (< (point) mark)
11330               (progn
11331                 (when (or all 
11332                           (memq (setq article (gnus-summary-article-number))
11333                                 gnus-newsgroup-unreads))
11334                   (gnus-summary-mark-article article gnus-del-mark))
11335                 t)
11336               (gnus-summary-find-next))))))
11337
11338 (defun gnus-summary-mark-below (score mark)
11339   "Mark articles with score less than SCORE with MARK."
11340   (interactive "P\ncMark: ")
11341   (gnus-set-global-variables)
11342   (setq score (if score
11343                   (prefix-numeric-value score)
11344                 (or gnus-summary-default-score 0)))
11345   (save-excursion
11346     (set-buffer gnus-summary-buffer)
11347     (goto-char (point-min))
11348     (while (not (eobp))
11349       (and (< (gnus-summary-article-score) score)
11350            (gnus-summary-mark-article nil mark))
11351       (gnus-summary-find-next))))
11352
11353 (defun gnus-summary-kill-below (&optional score)
11354   "Mark articles with score below SCORE as read."
11355   (interactive "P")
11356   (gnus-set-global-variables)
11357   (gnus-summary-mark-below score gnus-killed-mark))
11358
11359 (defun gnus-summary-clear-above (&optional score)
11360   "Clear all marks from articles with score above SCORE."
11361   (interactive "P")
11362   (gnus-set-global-variables)
11363   (gnus-summary-mark-above score gnus-unread-mark))
11364
11365 (defun gnus-summary-tick-above (&optional score)
11366   "Tick all articles with score above SCORE."
11367   (interactive "P")
11368   (gnus-set-global-variables)
11369   (gnus-summary-mark-above score gnus-ticked-mark))
11370
11371 (defun gnus-summary-mark-above (score mark)
11372   "Mark articles with score over SCORE with MARK."
11373   (interactive "P\ncMark: ")
11374   (gnus-set-global-variables)
11375   (setq score (if score
11376                   (prefix-numeric-value score)
11377                 (or gnus-summary-default-score 0)))
11378   (save-excursion
11379     (set-buffer gnus-summary-buffer)
11380     (goto-char (point-min))
11381     (while (and (progn
11382                   (if (> (gnus-summary-article-score) score)
11383                       (gnus-summary-mark-article nil mark))
11384                   t)
11385                 (gnus-summary-find-next)))))
11386
11387 ;; Suggested by Daniel Quinlan <quinlan@best.com>.  
11388 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
11389 (defun gnus-summary-limit-include-expunged ()
11390   "Display all the hidden articles that were expunged for low scores."
11391   (interactive)
11392   (gnus-set-global-variables)
11393   (let ((buffer-read-only nil))
11394     (let ((scored gnus-newsgroup-scored)
11395           headers h)
11396       (while scored
11397         (or (gnus-summary-goto-subject (car (car scored)))
11398             (and (setq h (gnus-summary-article-header (car (car scored))))
11399                  (< (cdr (car scored)) gnus-summary-expunge-below)
11400                  (setq headers (cons h headers))))
11401         (setq scored (cdr scored)))
11402       (or headers (error "No expunged articles hidden."))
11403       (goto-char (point-min))
11404       (gnus-summary-prepare-unthreaded (nreverse headers)))
11405     (goto-char (point-min))
11406     (gnus-summary-position-point)))
11407
11408 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
11409   "Mark all articles not marked as unread in this newsgroup as read.
11410 If prefix argument ALL is non-nil, all articles are marked as read.
11411 If QUIETLY is non-nil, no questions will be asked.
11412 If TO-HERE is non-nil, it should be a point in the buffer.  All
11413 articles before this point will be marked as read.
11414 The number of articles marked as read is returned."
11415   (interactive "P")
11416   (gnus-set-global-variables)
11417   (prog1
11418       (if (or quietly
11419               (not gnus-interactive-catchup) ;Without confirmation?
11420               gnus-expert-user
11421               (gnus-y-or-n-p
11422                (if all
11423                    "Mark absolutely all articles as read? "
11424                  "Mark all unread articles as read? ")))
11425           (if (and not-mark 
11426                    (not gnus-newsgroup-adaptive)
11427                    (not gnus-newsgroup-auto-expire))
11428               (progn
11429                 (when all
11430                   (setq gnus-newsgroup-marked nil
11431                         gnus-newsgroup-dormant nil))
11432                 (setq gnus-newsgroup-unreads nil))
11433             ;; We actually mark all articles as canceled, which we
11434             ;; have to do when using auto-expiry or adaptive scoring. 
11435             (gnus-summary-show-all-threads)
11436             (if (gnus-summary-first-subject (not all))
11437                 (while (and 
11438                         (if to-here (< (point) to-here) t)
11439                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
11440                         (gnus-summary-find-next (not all)))))
11441             (unless to-here
11442               (setq gnus-newsgroup-unreads nil))
11443             (gnus-set-mode-line 'summary)))
11444     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
11445       (if (and (not to-here) (eq 'nnvirtual (car method)))
11446           (nnvirtual-catchup-group
11447            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
11448     (gnus-summary-position-point)))
11449
11450 (defun gnus-summary-catchup-to-here (&optional all)
11451   "Mark all unticked articles before the current one as read.
11452 If ALL is non-nil, also mark ticked and dormant articles as read."
11453   (interactive "P")
11454   (gnus-set-global-variables)
11455   (save-excursion
11456     (let ((beg (point)))
11457       ;; We check that there are unread articles.
11458       (when (or all (gnus-summary-find-prev))
11459         (gnus-summary-catchup all t beg))))
11460   (gnus-summary-position-point))
11461
11462 (defun gnus-summary-catchup-all (&optional quietly)
11463   "Mark all articles in this newsgroup as read."
11464   (interactive "P")
11465   (gnus-set-global-variables)
11466   (gnus-summary-catchup t quietly))
11467
11468 (defun gnus-summary-catchup-and-exit (&optional all quietly)
11469   "Mark all articles not marked as unread in this newsgroup as read, then exit.
11470 If prefix argument ALL is non-nil, all articles are marked as read."
11471   (interactive "P")
11472   (gnus-set-global-variables)
11473   (gnus-summary-catchup all quietly nil 'fast)
11474   ;; Select next newsgroup or exit.
11475   (if (eq gnus-auto-select-next 'quietly)
11476       (gnus-summary-next-group nil)
11477     (gnus-summary-exit)))
11478
11479 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
11480   "Mark all articles in this newsgroup as read, and then exit."
11481   (interactive "P")
11482   (gnus-set-global-variables)
11483   (gnus-summary-catchup-and-exit t quietly))
11484
11485 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
11486 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
11487   "Mark all articles in this group as read and select the next group.
11488 If given a prefix, mark all articles, unread as well as ticked, as
11489 read." 
11490   (interactive "P")
11491   (gnus-set-global-variables)
11492   (gnus-summary-catchup all)
11493   (gnus-summary-next-article t))
11494
11495 ;; Thread-based commands.
11496
11497 (defun gnus-summary-articles-in-thread (&optional article)
11498   "Return a list of all articles in the current thread.
11499 If ARTICLE is non-nil, return all articles in the thread that starts
11500 with that article."
11501   (let* ((article (or article (gnus-summary-article-number)))
11502          (data (gnus-data-find-list article))
11503          (top-level (gnus-data-level (car data)))
11504          (top-subject 
11505           (cond ((null gnus-thread-operation-ignore-subject)
11506                  (gnus-simplify-subject-re
11507                   (mail-header-subject (gnus-data-header (car data)))))
11508                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
11509                  (gnus-simplify-subject-fuzzy
11510                   (mail-header-subject (gnus-data-header (car data)))))
11511                 (t nil)))
11512          articles)
11513     (if (not data)
11514         ()                              ; This article doesn't exist.
11515       (while data
11516         (and (or (not top-subject)
11517                  (string= top-subject
11518                           (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
11519                               (gnus-simplify-subject-fuzzy
11520                                (mail-header-subject 
11521                                 (gnus-data-header (car data))))
11522                             (gnus-simplify-subject-re
11523                              (mail-header-subject 
11524                               (gnus-data-header (car data)))))))
11525              (setq articles (cons (gnus-data-number (car data)) articles)))
11526         (if (and (setq data (cdr data))
11527                  (> (gnus-data-level (car data)) top-level))
11528             ()
11529           (setq data nil)))
11530       ;; Return the list of articles.
11531       (nreverse articles))))
11532
11533 (defun gnus-summary-toggle-threads (&optional arg)
11534   "Toggle showing conversation threads.
11535 If ARG is positive number, turn showing conversation threads on."
11536   (interactive "P")
11537   (gnus-set-global-variables)
11538   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
11539     (setq gnus-show-threads
11540           (if (null arg) (not gnus-show-threads)
11541             (> (prefix-numeric-value arg) 0)))
11542     (gnus-summary-prepare)
11543     (gnus-summary-goto-subject current)
11544     (gnus-summary-position-point)))
11545
11546 (defun gnus-summary-show-all-threads ()
11547   "Show all threads."
11548   (interactive)
11549   (gnus-set-global-variables)
11550   (save-excursion
11551     (let ((buffer-read-only nil))
11552       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
11553   (gnus-summary-position-point))
11554
11555 (defun gnus-summary-show-thread ()
11556   "Show thread subtrees.
11557 Returns nil if no thread was there to be shown."
11558   (interactive)
11559   (gnus-set-global-variables)
11560   (let ((buffer-read-only nil)
11561         (orig (point))
11562         ;; first goto end then to beg, to have point at beg after let
11563         (end (progn (end-of-line) (point)))
11564         (beg (progn (beginning-of-line) (point))))
11565     (prog1
11566         ;; Any hidden lines here?
11567         (search-forward "\r" end t)
11568       (subst-char-in-region beg end ?\^M ?\n t)
11569       (goto-char orig)
11570       (gnus-summary-position-point))))
11571
11572 (defun gnus-summary-hide-all-threads ()
11573   "Hide all thread subtrees."
11574   (interactive)
11575   (gnus-set-global-variables)
11576   (save-excursion
11577     (goto-char (point-min))
11578     (gnus-summary-hide-thread)
11579     (while (zerop (gnus-summary-next-thread 1 t))
11580       (gnus-summary-hide-thread)))
11581   (gnus-summary-position-point))
11582
11583 (defun gnus-summary-hide-thread ()
11584   "Hide thread subtrees.
11585 Returns nil if no threads were there to be hidden."
11586   (interactive)
11587   (gnus-set-global-variables)
11588   (let ((buffer-read-only nil)
11589         (start (point))
11590         (article (gnus-summary-article-number))
11591         end)
11592     ;; Go forward until either the buffer ends or the subthread
11593     ;; ends. 
11594     (when (and (not (eobp))
11595                (or (and (zerop (gnus-summary-next-thread 1 t))
11596                         (gnus-summary-find-prev))
11597                    (goto-char (gnus-data-pos (car (gnus-data-list 'rev))))))
11598       (setq end (point))
11599       (prog1
11600           (if (and (> (point) start)
11601                    (search-backward "\n" start t))
11602               (progn
11603                 (subst-char-in-region start end ?\n ?\^M)
11604                 (gnus-summary-goto-subject article))
11605             (goto-char start)
11606             nil)
11607         (gnus-summary-position-point)))))
11608
11609 (defun gnus-summary-go-to-next-thread (&optional previous)
11610   "Go to the same level (or less) next thread.
11611 If PREVIOUS is non-nil, go to previous thread instead.
11612 Return the article number moved to, or nil if moving was impossible."
11613   (let* ((level (gnus-summary-thread-level))
11614          (article (gnus-summary-article-number))
11615          (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
11616          oart)
11617     (while data
11618       (if (<= (gnus-data-level (car data)) level)
11619           (setq oart (gnus-data-number (car data))
11620                 data nil)
11621         (setq data (cdr data))))
11622     (and oart 
11623          (gnus-summary-goto-subject oart))))
11624
11625 (defun gnus-summary-next-thread (n &optional silent)
11626   "Go to the same level next N'th thread.
11627 If N is negative, search backward instead.
11628 Returns the difference between N and the number of skips actually
11629 done.
11630
11631 If SILENT, don't output messages."
11632   (interactive "p")
11633   (gnus-set-global-variables)
11634   (let ((backward (< n 0))
11635         (n (abs n)))
11636     (while (and (> n 0)
11637                 (gnus-summary-go-to-next-thread backward))
11638       (decf n))
11639     (gnus-summary-position-point)
11640     (when (and (not silent) (/= 0 n))
11641       (gnus-message 7 "No more threads"))
11642     n))
11643
11644 (defun gnus-summary-prev-thread (n)
11645   "Go to the same level previous N'th thread.
11646 Returns the difference between N and the number of skips actually
11647 done."
11648   (interactive "p")
11649   (gnus-set-global-variables)
11650   (gnus-summary-next-thread (- n)))
11651
11652 (defun gnus-summary-go-down-thread ()
11653   "Go down one level in the current thread."
11654   (let ((children (gnus-summary-article-children)))
11655     (and children
11656          (gnus-summary-goto-subject (car children)))))
11657
11658 (defun gnus-summary-go-up-thread ()
11659   "Go up one level in the current thread."
11660   (let ((parent (gnus-summary-article-parent)))
11661     (and parent
11662          (gnus-summary-goto-subject parent))))
11663
11664 (defun gnus-summary-down-thread (n)
11665   "Go down thread N steps.
11666 If N is negative, go up instead.
11667 Returns the difference between N and how many steps down that were
11668 taken."
11669   (interactive "p")
11670   (gnus-set-global-variables)
11671   (let ((up (< n 0))
11672         (n (abs n)))
11673     (while (and (> n 0)
11674                 (if up (gnus-summary-go-up-thread)
11675                   (gnus-summary-go-down-thread)))
11676       (setq n (1- n)))
11677     (gnus-summary-position-point)
11678     (if (/= 0 n) (gnus-message 7 "Can't go further"))
11679     n))
11680
11681 (defun gnus-summary-up-thread (n)
11682   "Go up thread N steps.
11683 If N is negative, go up instead.
11684 Returns the difference between N and how many steps down that were
11685 taken."
11686   (interactive "p")
11687   (gnus-set-global-variables)
11688   (gnus-summary-down-thread (- n)))
11689
11690 (defun gnus-summary-kill-thread (&optional unmark)
11691   "Mark articles under current thread as read.
11692 If the prefix argument is positive, remove any kinds of marks.
11693 If the prefix argument is negative, tick articles instead."
11694   (interactive "P")
11695   (gnus-set-global-variables)
11696   (if unmark
11697       (setq unmark (prefix-numeric-value unmark)))
11698   (let ((articles (gnus-summary-articles-in-thread)))
11699     (save-excursion
11700       ;; Expand the thread.
11701       (gnus-summary-show-thread)
11702       ;; Mark all the articles.
11703       (while articles
11704         (gnus-summary-goto-subject (car articles))
11705         (cond ((null unmark) 
11706                (gnus-summary-mark-article-as-read gnus-killed-mark))
11707               ((> unmark 0) 
11708                (gnus-summary-mark-article-as-unread gnus-unread-mark))
11709               (t 
11710                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
11711         (setq articles (cdr articles))))
11712     ;; Hide killed subtrees.
11713     (and (null unmark)
11714          gnus-thread-hide-killed
11715          (gnus-summary-hide-thread))
11716     ;; If marked as read, go to next unread subject.
11717     (if (null unmark)
11718         ;; Go to next unread subject.
11719         (gnus-summary-next-subject 1 t)))
11720   (gnus-set-mode-line 'summary))
11721
11722 ;; Summary sorting commands
11723
11724 (defun gnus-summary-sort-by-number (&optional reverse)
11725   "Sort summary buffer by article number.
11726 Argument REVERSE means reverse order."
11727   (interactive "P")
11728   (gnus-summary-sort 'number reverse))
11729
11730 (defun gnus-summary-sort-by-author (&optional reverse)
11731   "Sort summary buffer by author name alphabetically.
11732 If case-fold-search is non-nil, case of letters is ignored.
11733 Argument REVERSE means reverse order."
11734   (interactive "P")
11735   (gnus-summary-sort 'author reverse))
11736
11737 (defun gnus-summary-sort-by-subject (&optional reverse)
11738   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
11739 If case-fold-search is non-nil, case of letters is ignored.
11740 Argument REVERSE means reverse order."
11741   (interactive "P")
11742   (gnus-summary-sort 'subject reverse))
11743
11744 (defun gnus-summary-sort-by-date (&optional reverse)
11745   "Sort summary buffer by date.
11746 Argument REVERSE means reverse order."
11747   (interactive "P")
11748   (gnus-summary-sort 'date reverse))
11749
11750 (defun gnus-summary-sort-by-score (&optional reverse)
11751   "Sort summary buffer by score.
11752 Argument REVERSE means reverse order."
11753   (interactive "P")
11754   (gnus-summary-sort 'score reverse))
11755
11756 (defun gnus-summary-sort (predicate reverse)
11757   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
11758   (gnus-set-global-variables)
11759   (let* ((gnus-thread-sort-functions 
11760           (list (intern (format "gnus-thread-sort-by-%s" predicate))))
11761          (gnus-article-sort-functions
11762           (list (intern (format "gnus-article-sort-by-%s" predicate))))
11763          (buffer-read-only)
11764          (gnus-summary-prepare-hook nil))
11765     ;; We do the sorting by regenerating the threads.
11766     (gnus-summary-prepare)
11767     ;; Hide subthreads if needed.
11768     (when (and gnus-show-threads gnus-thread-hide-subtree)
11769       (gnus-summary-hide-all-threads)))
11770   ;; If in async mode, we send some info to the backend.
11771   (when gnus-newsgroup-async
11772     (gnus-request-asynchronous 
11773      gnus-newsgroup-name gnus-newsgroup-data)))
11774   
11775 (defun gnus-sortable-date (date)
11776   "Make sortable string by string-lessp from DATE.
11777 Timezone package is used."
11778   (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
11779          (year (aref date 0))
11780          (month (aref date 1))
11781          (day (aref date 2)))
11782     (timezone-make-sortable-date 
11783      year month day 
11784      (timezone-make-time-string
11785       (aref date 3) (aref date 4) (aref date 5)))))
11786
11787
11788 ;; Summary saving commands.
11789
11790 (defun gnus-summary-save-article (&optional n not-saved)
11791   "Save the current article using the default saver function.
11792 If N is a positive number, save the N next articles.
11793 If N is a negative number, save the N previous articles.
11794 If N is nil and any articles have been marked with the process mark,
11795 save those articles instead.
11796 The variable `gnus-default-article-saver' specifies the saver function."
11797   (interactive "P")
11798   (gnus-set-global-variables)
11799   (let ((articles (gnus-summary-work-articles n))
11800         file header article)
11801     (while articles
11802       (setq header (gnus-summary-article-header
11803                     (setq article (pop articles))))
11804       (if (not (vectorp header))
11805           ;; This is a pseudo-article.
11806           (if (assq 'name header)
11807               (gnus-copy-file (cdr (assq 'name header)))
11808             (gnus-message 1 "Article %d is unsaveable" article))
11809         ;; This is a real article.
11810         (save-window-excursion
11811           (gnus-summary-select-article t nil nil article))
11812         (unless gnus-save-all-headers
11813           ;; Remove headers accoring to `gnus-saved-headers'.
11814           (let ((gnus-visible-headers 
11815                  (or gnus-saved-headers gnus-visible-headers)))
11816             (gnus-article-hide-headers t)))
11817         ;; Remove any X-Gnus lines.
11818         (save-excursion
11819           (set-buffer gnus-article-buffer)
11820           (save-restriction
11821             (let ((buffer-read-only nil))
11822               (gnus-narrow-to-headers)
11823               (while (re-search-forward "^X-Gnus" nil t)
11824                 (gnus-delete-line)))))
11825         (save-window-excursion
11826           (if (not gnus-default-article-saver)
11827               (error "No default saver is defined.")
11828             (setq file (funcall
11829                         gnus-default-article-saver
11830                         (cond
11831                          ((not gnus-prompt-before-saving)
11832                           'default)
11833                          ((eq gnus-prompt-before-saving 'always)
11834                           nil)
11835                          (t file))))))
11836         (gnus-summary-remove-process-mark article)
11837         (unless not-saved
11838           (gnus-summary-set-saved-mark article))))
11839     (gnus-summary-position-point)
11840     n))
11841
11842 (defun gnus-summary-pipe-output (&optional arg)
11843   "Pipe the current article to a subprocess.
11844 If N is a positive number, pipe the N next articles.
11845 If N is a negative number, pipe the N previous articles.
11846 If N is nil and any articles have been marked with the process mark,
11847 pipe those articles instead."
11848   (interactive "P")
11849   (gnus-set-global-variables)
11850   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
11851     (gnus-summary-save-article arg t))
11852   (gnus-configure-windows 'pipe))
11853
11854 (defun gnus-summary-save-article-mail (&optional arg)
11855   "Append the current article to an mail file.
11856 If N is a positive number, save the N next articles.
11857 If N is a negative number, save the N previous articles.
11858 If N is nil and any articles have been marked with the process mark,
11859 save those articles instead."
11860   (interactive "P")
11861   (gnus-set-global-variables)
11862   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
11863     (gnus-summary-save-article arg)))
11864
11865 (defun gnus-summary-save-article-rmail (&optional arg)
11866   "Append the current article to an rmail file.
11867 If N is a positive number, save the N next articles.
11868 If N is a negative number, save the N previous articles.
11869 If N is nil and any articles have been marked with the process mark,
11870 save those articles instead."
11871   (interactive "P")
11872   (gnus-set-global-variables)
11873   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
11874     (gnus-summary-save-article arg)))
11875
11876 (defun gnus-summary-save-article-file (&optional arg)
11877   "Append the current article to a file.
11878 If N is a positive number, save the N next articles.
11879 If N is a negative number, save the N previous articles.
11880 If N is nil and any articles have been marked with the process mark,
11881 save those articles instead."
11882   (interactive "P")
11883   (gnus-set-global-variables)
11884   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
11885     (gnus-summary-save-article arg)))
11886
11887 (defun gnus-summary-save-article-body-file (&optional arg)
11888   "Append the current article body to a file.
11889 If N is a positive number, save the N next articles.
11890 If N is a negative number, save the N previous articles.
11891 If N is nil and any articles have been marked with the process mark,
11892 save those articles instead."
11893   (interactive "P")
11894   (gnus-set-global-variables)
11895   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
11896     (gnus-summary-save-article arg)))
11897
11898 (defun gnus-read-save-file-name (prompt default-name)
11899   (let ((methods gnus-split-methods)
11900         split-name method result match)
11901     ;; Let the split methods have their say.
11902     (when gnus-split-methods
11903       (save-excursion
11904         (set-buffer gnus-original-article-buffer)
11905         (save-restriction
11906           (gnus-narrow-to-headers)
11907           (while methods
11908             (goto-char (point-min))
11909             (setq method (pop methods))
11910             (setq match (pop method))
11911             (when (cond
11912                    ((stringp match)
11913                     ;; Regular expression.
11914                     (condition-case () 
11915                         (re-search-forward match nil t)
11916                       (error nil)))
11917                    ((gnus-functionp match)
11918                     (save-restriction
11919                       (widen)
11920                       (setq result (funcall match gnus-newsgroup-name))))
11921                    ((consp match)
11922                     (save-restriction
11923                       (widen)
11924                       (setq result (eval match)))))
11925               (setq split-name (append (cdr methods) split-name))
11926               (cond ((stringp result)
11927                      (push result split-name))
11928                     ((consp result)
11929                      (setq split-name (append result split-name)))))))))
11930     (cond
11931      ;; No split name was found.
11932      ((null split-name)
11933       (read-file-name
11934        (concat prompt " (default " (file-name-nondirectory default-name) ") ")
11935        (file-name-directory default-name)
11936        default-name))
11937      ;; A single split name was found
11938      ((= 1 (length split-name))
11939       (read-file-name
11940        (concat prompt " (default " (car split-name) ") ")
11941        gnus-article-save-directory
11942        (concat gnus-article-save-directory (car split-name))))
11943      ;; A list of splits was found.
11944      (t
11945       (setq split-name (mapcar (lambda (el) (list el)) (nreverse split-name)))
11946       (let ((result (completing-read (concat prompt " ") split-name nil nil)))
11947         (concat gnus-article-save-directory
11948                 (if (string= result "")
11949                     (car (car split-name))
11950                   result)))))))
11951
11952 (defun gnus-article-archive-name (group)
11953   "Return the first instance of an \"Archive-name\" in the current buffer."
11954   (let ((case-fold-search t))
11955     (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
11956       (match-string 1))))
11957
11958 (defun gnus-summary-save-in-rmail (&optional filename)
11959   "Append this article to Rmail file.
11960 Optional argument FILENAME specifies file name.
11961 Directory to save to is default to `gnus-article-save-directory' which
11962 is initialized from the SAVEDIR environment variable."
11963   (interactive)
11964   (gnus-set-global-variables)
11965   (let ((default-name
11966           (funcall gnus-rmail-save-name gnus-newsgroup-name
11967                    gnus-current-headers gnus-newsgroup-last-rmail)))
11968     (setq filename
11969           (cond ((eq filename 'default)
11970                  default-name)
11971                 (filename filename)
11972                 (t (gnus-read-save-file-name 
11973                     "Save in rmail file:" default-name))))
11974     (gnus-make-directory (file-name-directory filename))
11975     (gnus-eval-in-buffer-window 
11976      gnus-original-article-buffer
11977      (save-excursion
11978        (save-restriction
11979          (widen)
11980          (gnus-output-to-rmail filename))))
11981     ;; Remember the directory name to save articles
11982     (setq gnus-newsgroup-last-rmail filename)))
11983
11984 (defun gnus-summary-save-in-mail (&optional filename)
11985   "Append this article to Unix mail file.
11986 Optional argument FILENAME specifies file name.
11987 Directory to save to is default to `gnus-article-save-directory' which
11988 is initialized from the SAVEDIR environment variable."
11989   (interactive)
11990   (gnus-set-global-variables)
11991   (let ((default-name
11992           (funcall gnus-mail-save-name gnus-newsgroup-name
11993                    gnus-current-headers gnus-newsgroup-last-mail)))
11994     (setq filename
11995           (cond ((eq filename 'default)
11996                  default-name)
11997                 (filename filename)
11998                 (t (gnus-read-save-file-name 
11999                     "Save in Unix mail file:" default-name))))
12000     (setq filename
12001           (expand-file-name filename
12002                             (and default-name
12003                                  (file-name-directory default-name))))
12004     (gnus-make-directory (file-name-directory filename))
12005     (gnus-eval-in-buffer-window 
12006      gnus-original-article-buffer
12007      (save-excursion
12008        (save-restriction
12009          (widen)
12010          (if (and (file-readable-p filename) (mail-file-babyl-p filename))
12011              (gnus-output-to-rmail filename)
12012            (let ((mail-use-rfc822 t))
12013              (rmail-output filename 1 t t))))))
12014     ;; Remember the directory name to save articles.
12015     (setq gnus-newsgroup-last-mail filename)))
12016
12017 (defun gnus-summary-save-in-file (&optional filename)
12018   "Append this article to file.
12019 Optional argument FILENAME specifies file name.
12020 Directory to save to is default to `gnus-article-save-directory' which
12021 is initialized from the SAVEDIR environment variable."
12022   (interactive)
12023   (gnus-set-global-variables)
12024   (let ((default-name
12025           (funcall gnus-file-save-name gnus-newsgroup-name
12026                    gnus-current-headers gnus-newsgroup-last-file)))
12027     (setq filename
12028           (cond ((eq filename 'default)
12029                  default-name)
12030                 (filename filename)
12031                 (t (gnus-read-save-file-name 
12032                     "Save in file:" default-name))))
12033     (gnus-make-directory (file-name-directory filename))
12034     (gnus-eval-in-buffer-window 
12035      gnus-article-buffer
12036      (save-excursion
12037        (save-restriction
12038          (widen)
12039          (gnus-output-to-file filename))))
12040     ;; Remember the directory name to save articles.
12041     (setq gnus-newsgroup-last-file filename)))
12042
12043 (defun gnus-summary-save-body-in-file (&optional filename)
12044   "Append this article body to a file.
12045 Optional argument FILENAME specifies file name.
12046 The directory to save in defaults to `gnus-article-save-directory' which
12047 is initialized from the SAVEDIR environment variable."
12048   (interactive)
12049   (gnus-set-global-variables)
12050   (let ((default-name
12051           (funcall gnus-file-save-name gnus-newsgroup-name
12052                    gnus-current-headers gnus-newsgroup-last-file)))
12053     (setq filename
12054           (cond ((eq filename 'default)
12055                  default-name)
12056                 (filename filename)
12057                 (t (gnus-read-save-file-name 
12058                     "Save body in file:" default-name))))
12059     (gnus-make-directory (file-name-directory filename))
12060     (gnus-eval-in-buffer-window 
12061      gnus-article-buffer
12062      (save-excursion
12063        (save-restriction
12064          (widen)
12065          (goto-char (point-min))
12066          (and (search-forward "\n\n" nil t)
12067               (narrow-to-region (point) (point-max)))
12068          (gnus-output-to-file filename))))
12069     ;; Remember the directory name to save articles.
12070     (setq gnus-newsgroup-last-file filename)))
12071
12072 (defun gnus-summary-save-in-pipe (&optional command)
12073   "Pipe this article to subprocess."
12074   (interactive)
12075   (gnus-set-global-variables)
12076   (setq command
12077         (cond ((eq command 'default)
12078                gnus-last-shell-command)
12079               (command command)
12080               (t (read-string "Shell command on article: "
12081                               gnus-last-shell-command))))
12082   (if (string-equal command "")
12083       (setq command gnus-last-shell-command))
12084   (gnus-eval-in-buffer-window 
12085    gnus-article-buffer
12086    (save-restriction
12087      (widen)
12088      (shell-command-on-region (point-min) (point-max) command nil)))
12089   (setq gnus-last-shell-command command))
12090
12091 ;; Summary extract commands
12092
12093 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
12094   (let ((buffer-read-only nil)
12095         (article (gnus-summary-article-number))
12096         after-article b e)
12097     (or (gnus-summary-goto-subject article)
12098         (error (format "No such article: %d" article)))
12099     (gnus-summary-position-point)
12100     ;; If all commands are to be bunched up on one line, we collect
12101     ;; them here.  
12102     (if gnus-view-pseudos-separately
12103         ()
12104       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
12105             files action)
12106         (while ps
12107           (setq action (cdr (assq 'action (car ps))))
12108           (setq files (list (cdr (assq 'name (car ps)))))
12109           (while (and ps (cdr ps)
12110                       (string= (or action "1")
12111                                (or (cdr (assq 'action (car (cdr ps)))) "2")))
12112             (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
12113             (setcdr ps (cdr (cdr ps))))
12114           (if (not files)
12115               ()
12116             (if (not (string-match "%s" action))
12117                 (setq files (cons " " files)))
12118             (setq files (cons " " files))
12119             (and (assq 'execute (car ps))
12120                  (setcdr (assq 'execute (car ps))
12121                          (funcall (if (string-match "%s" action)
12122                                       'format 'concat)
12123                                   action 
12124                                   (mapconcat (lambda (f) f) files " ")))))
12125           (setq ps (cdr ps)))))
12126     (if (and gnus-view-pseudos (not not-view))
12127         (while pslist
12128           (and (assq 'execute (car pslist))
12129                (gnus-execute-command (cdr (assq 'execute (car pslist)))
12130                                      (eq gnus-view-pseudos 'not-confirm)))
12131           (setq pslist (cdr pslist)))
12132       (save-excursion
12133         (while pslist
12134           (setq after-article (or (cdr (assq 'article (car pslist)))
12135                                   (gnus-summary-article-number)))
12136           (gnus-summary-goto-subject after-article)
12137           (forward-line 1)
12138           (setq b (point))
12139           (insert "          " (file-name-nondirectory
12140                                 (cdr (assq 'name (car pslist))))
12141                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
12142           (setq e (point))
12143           (forward-line -1)             ; back to `b'
12144           (put-text-property b e 'gnus-number gnus-reffed-article-number)
12145           (gnus-data-enter after-article
12146                            gnus-reffed-article-number
12147                            gnus-unread-mark 
12148                            b
12149                            (car pslist) 
12150                            0 
12151                            (- e b))
12152           (setq gnus-newsgroup-unreads
12153                 (cons gnus-reffed-article-number gnus-newsgroup-unreads))
12154           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
12155           (setq pslist (cdr pslist)))))))
12156
12157 (defun gnus-pseudos< (p1 p2)
12158   (let ((c1 (cdr (assq 'action p1)))
12159         (c2 (cdr (assq 'action p2))))
12160     (and c1 c2 (string< c1 c2))))
12161
12162 (defun gnus-request-pseudo-article (props)
12163   (cond ((assq 'execute props)
12164          (gnus-execute-command (cdr (assq 'execute props)))))
12165   (let ((gnus-current-article (gnus-summary-article-number)))
12166     (run-hooks 'gnus-mark-article-hook)))
12167
12168 (defun gnus-execute-command (command &optional automatic)
12169   (save-excursion
12170     (gnus-article-setup-buffer)
12171     (set-buffer gnus-article-buffer)
12172     (let ((command (if automatic command (read-string "Command: " command)))
12173           (buffer-read-only nil))
12174       (erase-buffer)
12175       (insert "$ " command "\n\n")
12176       (if gnus-view-pseudo-asynchronously
12177           (start-process "gnus-execute" nil "sh" "-c" command)
12178         (call-process "sh" nil t nil "-c" command)))))
12179
12180 (defun gnus-copy-file (file &optional to)
12181   "Copy FILE to TO."
12182   (interactive
12183    (list (read-file-name "Copy file: " default-directory)
12184          (read-file-name "Copy file to: " default-directory)))
12185   (gnus-set-global-variables)
12186   (or to (setq to (read-file-name "Copy file to: " default-directory)))
12187   (and (file-directory-p to) 
12188        (setq to (concat (file-name-as-directory to)
12189                         (file-name-nondirectory file))))
12190   (copy-file file to))
12191
12192 ;; Summary kill commands.
12193
12194 (defun gnus-summary-edit-global-kill (article)
12195   "Edit the \"global\" kill file."
12196   (interactive (list (gnus-summary-article-number)))
12197   (gnus-set-global-variables)
12198   (gnus-group-edit-global-kill article))
12199
12200 (defun gnus-summary-edit-local-kill ()
12201   "Edit a local kill file applied to the current newsgroup."
12202   (interactive)
12203   (gnus-set-global-variables)
12204   (setq gnus-current-headers (gnus-summary-article-header))
12205   (gnus-set-global-variables)
12206   (gnus-group-edit-local-kill 
12207    (gnus-summary-article-number) gnus-newsgroup-name))
12208
12209 \f
12210 ;;;
12211 ;;; Gnus article mode
12212 ;;;
12213
12214 (put 'gnus-article-mode 'mode-class 'special)
12215
12216 (if gnus-article-mode-map
12217     nil
12218   (setq gnus-article-mode-map (make-keymap))
12219   (suppress-keymap gnus-article-mode-map)
12220   (define-key gnus-article-mode-map " " 'gnus-article-next-page)
12221   (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
12222   (define-key gnus-article-mode-map "\C-c^" 'gnus-article-refer-article)
12223   (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
12224   (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
12225   (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail)
12226   (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
12227   (define-key gnus-article-mode-map gnus-mouse-2 'gnus-article-push-button)
12228   (define-key gnus-article-mode-map "\r" 'gnus-article-press-button)
12229   (define-key gnus-article-mode-map "\t" 'gnus-article-next-button)
12230   (define-key gnus-article-mode-map "\M-\t" 'gnus-article-prev-button)
12231   (define-key gnus-article-mode-map "\C-c\C-b" 'gnus-bug)
12232   
12233   ;; Duplicate almost all summary keystrokes in the article mode map.
12234   (let ((commands 
12235          (list 
12236           "p" "N" "P" "\M-\C-n" "\M-\C-p"
12237           "\M-n" "\M-p" "." "," "\M-s" "\M-r" "<" ">" "j"
12238           "u" "!" "U" "d" "D" "E" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k"
12239           "\M-\C-l" "e" "#" "\M-#" "\M-\C-t" "\M-\C-s" "\M-\C-h"
12240           "\M-\C-f" "\M-\C-b" "\M-\C-u" "\M-\C-d" "&" "\C-w"
12241           "\C-t" "?" "\C-c\M-\C-s" "\C-c\C-s\C-n" "\C-c\C-s\C-a"
12242           "\C-c\C-s\C-s" "\C-c\C-s\C-d" "\C-c\C-s\C-i" "\C-x\C-s"
12243           "\M-g" "w" "\C-c\C-r" "\M-t" "C"
12244           "o" "\C-o" "|" "\M-k" "\M-K" "V" "\C-c\C-d"
12245           "\C-c\C-i" "x" "X" "t" "g" "?" "l"
12246           "\C-c\C-v\C-v" "\C-d" "v" 
12247 ;;        "Mt" "M!" "Md" "Mr"
12248 ;;        "Mc" "M " "Me" "Mx" "M?" "Mb" "MB" "M#" "M\M-#" "M\M-r"
12249 ;;        "M\M-\C-r" "MD" "M\M-D" "MS" "MC" "MH" "M\C-c" "Mk" "MK"
12250 ;;        "Ms" "Mc" "Mu" "Mm" "Mk" "Gn" "Gp" "GN" "GP" "G\C-n" "G\C-p"
12251 ;;        "G\M-n" "G\M-p" "Gf" "Gb" "Gg" "Gl" "Gp" "Tk" "Tl" "Ti" "TT"
12252 ;;        "Ts" "TS" "Th" "TH" "Tn" "Tp" "Tu" "Td" "T#" "A " "An" "A\177" "Ap"
12253 ;;        "A\r" "A<" "A>" "Ab" "Ae" "A^" "Ar" "Aw" "Ac" "Ag" "At" "Am"
12254 ;;        "As" "Wh" "Ws" "Wc" "Wo" "Ww" "Wd" "Wq" "Wf" "Wt" "W\C-t"
12255 ;;        "WT" "WA" "Wa" "WH" "WC" "WS" "Wb" "Hv" "Hf" "Hd" "Hh" "Hi"
12256 ;;        "Be" "B\177" "Bm" "Br" "Bw" "Bc" "Bq" "Bi" "Oo" "Om" "Or"
12257 ;;        "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve"
12258 ;;        "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi"
12259           )))
12260     (while commands
12261       (define-key gnus-article-mode-map (car commands) 
12262         'gnus-article-summary-command)
12263       (setq commands (cdr commands))))
12264
12265   (let ((commands (list "q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
12266 ;;                      "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" 
12267                          "=" "n"  "^" "\M-^")))
12268     (while commands
12269       (define-key gnus-article-mode-map (car commands) 
12270         'gnus-article-summary-command-nosave)
12271       (setq commands (cdr commands)))))
12272
12273
12274 (defun gnus-article-mode ()
12275   "Major mode for displaying an article.
12276
12277 All normal editing commands are switched off.
12278
12279 The following commands are available:
12280
12281 \\<gnus-article-mode-map>
12282 \\[gnus-article-next-page]\t Scroll the article one page forwards
12283 \\[gnus-article-prev-page]\t Scroll the article one page backwards
12284 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
12285 \\[gnus-article-show-summary]\t Display the summary buffer
12286 \\[gnus-article-mail]\t Send a reply to the address near point
12287 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
12288 \\[gnus-info-find-node]\t Go to the Gnus info node"
12289   (interactive)
12290   (when (and menu-bar-mode
12291              (gnus-visual-p 'article-menu 'menu))
12292     (gnus-article-make-menu-bar))
12293   (kill-all-local-variables)
12294   (gnus-simplify-mode-line)
12295   (setq mode-name "Article")
12296   (setq major-mode 'gnus-article-mode)
12297   (make-local-variable 'minor-mode-alist)
12298   (or (assq 'gnus-show-mime minor-mode-alist)
12299       (setq minor-mode-alist
12300             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
12301   (use-local-map gnus-article-mode-map)
12302   (make-local-variable 'page-delimiter)
12303   (setq page-delimiter gnus-page-delimiter)
12304   (buffer-disable-undo (current-buffer))
12305   (setq buffer-read-only t)             ;Disable modification
12306   (run-hooks 'gnus-article-mode-hook))
12307
12308 (defun gnus-article-setup-buffer ()
12309   "Initialize article mode buffer."
12310   ;; Returns the article buffer.
12311   (if (get-buffer gnus-article-buffer)
12312       (save-excursion
12313         (set-buffer gnus-article-buffer)
12314         (buffer-disable-undo (current-buffer))
12315         (setq buffer-read-only t)
12316         (gnus-add-current-to-buffer-list)
12317         (or (eq major-mode 'gnus-article-mode)
12318             (gnus-article-mode))
12319         (current-buffer))
12320     (save-excursion
12321       (set-buffer (get-buffer-create gnus-article-buffer))
12322       (gnus-add-current-to-buffer-list)
12323       (gnus-article-mode)
12324       (current-buffer))))
12325
12326 ;; Set article window start at LINE, where LINE is the number of lines
12327 ;; from the head of the article.
12328 (defun gnus-article-set-window-start (&optional line)
12329   (set-window-start 
12330    (get-buffer-window gnus-article-buffer)
12331    (save-excursion
12332      (set-buffer gnus-article-buffer)
12333      (goto-char (point-min))
12334      (if (not line)
12335          (point-min)
12336        (gnus-message 6 "Moved to bookmark")
12337        (search-forward "\n\n" nil t)
12338        (forward-line line)
12339        (point)))))
12340
12341 (defun gnus-kill-all-overlays ()
12342   "Delete all overlays in the current buffer."
12343   (when (fboundp 'overlay-lists)
12344     (let* ((overlayss (overlay-lists))
12345            (buffer-read-only nil)
12346            (overlays (nconc (car overlayss) (cdr overlayss))))
12347       (while overlays
12348         (delete-overlay (pop overlays))))))
12349
12350 (defun gnus-request-article-this-buffer (article group)
12351   "Get an article and insert it into this buffer."
12352   (prog1
12353       (save-excursion
12354         (if (get-buffer gnus-original-article-buffer)
12355             (set-buffer (get-buffer gnus-original-article-buffer))
12356           (set-buffer (get-buffer-create gnus-original-article-buffer))
12357           (buffer-disable-undo (current-buffer))
12358           (setq major-mode 'gnus-original-article-mode)
12359           (setq buffer-read-only t)
12360           (gnus-add-current-to-buffer-list))
12361
12362         (setq group (or group gnus-newsgroup-name))
12363
12364         ;; Open server if it has closed.
12365         (gnus-check-server (gnus-find-method-for-group group))
12366
12367         ;; Using `gnus-request-article' directly will insert the article into
12368         ;; `nntp-server-buffer' - so we'll save some time by not having to
12369         ;; copy it from the server buffer into the article buffer.
12370
12371         ;; We only request an article by message-id when we do not have the
12372         ;; headers for it, so we'll have to get those.
12373         (and (stringp article) 
12374              (let ((gnus-override-method gnus-refer-article-method))
12375                (gnus-read-header article)))
12376
12377         ;; If the article number is negative, that means that this article
12378         ;; doesn't belong in this newsgroup (possibly), so we find its
12379         ;; message-id and request it by id instead of number.
12380         (if (not (numberp article))
12381             ()
12382           (save-excursion
12383             (set-buffer gnus-summary-buffer)
12384             (let ((header (gnus-summary-article-header article)))
12385               (if (< article 0)
12386                   (if (vectorp header)
12387                       ;; It's a real article.
12388                       (setq article (mail-header-id header))
12389                     ;; It is an extracted pseudo-article.
12390                     (setq article 'pseudo)
12391                     (gnus-request-pseudo-article header)))
12392
12393               (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
12394                 (if (not (eq (car method) 'nneething))
12395                     ()
12396                   (let ((dir (concat (file-name-as-directory (nth 1 method))
12397                                      (mail-header-subject header))))
12398                     (if (file-directory-p dir)
12399                         (progn
12400                           (setq article 'nneething)
12401                           (gnus-group-enter-directory dir)))))))))
12402
12403         (cond 
12404          ;; We first check `gnus-original-article-buffer'.
12405          ((and (equal (car gnus-original-article) group)
12406                (eq (cdr gnus-original-article) article))
12407           ;; We don't have to do anything, since it's already where we
12408           ;; want it.  
12409           'article)
12410          ;; Check the backlog.
12411          ((and gnus-keep-backlog
12412                (gnus-backlog-request-article group article (current-buffer)))
12413           'article)
12414          ;; Check the cache.
12415          ((and gnus-use-cache
12416                (numberp article)
12417                (gnus-cache-request-article article group))
12418           'article)
12419          ;; Get the article and put into the article buffer.
12420          ((or (stringp article) (numberp article))
12421           (let ((gnus-override-method 
12422                  (and (stringp article) gnus-refer-article-method))
12423                 (buffer-read-only nil))
12424             (erase-buffer)
12425             (gnus-kill-all-overlays)
12426             (if (gnus-request-article article group (current-buffer))
12427                 (progn
12428                   (and gnus-keep-backlog 
12429                        (gnus-backlog-enter-article 
12430                         group article (current-buffer)))
12431                   'article))))
12432          ;; It was a pseudo.
12433          (t article)))
12434     (setq gnus-original-article (cons group article))
12435     (let (buffer-read-only)
12436       (erase-buffer)
12437       (gnus-kill-all-overlays)
12438       (insert-buffer-substring gnus-original-article-buffer))))
12439
12440 (defun gnus-read-header (id)
12441   "Read the headers of article ID and enter them into the Gnus system."
12442   (let ((group gnus-newsgroup-name)
12443         (headers gnus-newsgroup-headers)
12444         header where)
12445     ;; First we check to see whether the header in question is already
12446     ;; fetched. 
12447     (if (stringp id)
12448         ;; This is a Message-ID.
12449         (while headers
12450           (if (string= id (mail-header-id (car headers)))
12451               (setq header (car headers)
12452                     headers nil)
12453             (setq headers (cdr headers))))
12454       ;; This is an article number.
12455       (while headers
12456         (if (= id (mail-header-number (car headers)))
12457             (setq header (car headers)
12458                   headers nil)
12459           (setq headers (cdr headers)))))
12460     (if header
12461         ;; We have found the header.
12462         header
12463       ;; We have to really fetch the header to this article.
12464       (when (setq where
12465                   (if (gnus-check-backend-function 'request-head group)
12466                       (gnus-request-head id group)
12467                     (gnus-request-article id group)))
12468         (save-excursion
12469           (set-buffer nntp-server-buffer)
12470           (and (search-forward "\n\n" nil t)
12471                (delete-region (1- (point)) (point-max)))
12472           (goto-char (point-max))
12473           (insert ".\n")
12474           (goto-char (point-min))
12475           (insert "211 "
12476                   (int-to-string
12477                    (cond
12478                     ((numberp id)
12479                      id)
12480                     ((cdr where)
12481                      (cdr where))
12482                     (t
12483                      gnus-reffed-article-number)))
12484                   " Article retrieved.\n"))
12485         (if (not (setq header (car (gnus-get-newsgroup-headers))))
12486             () ; Malformed head.
12487           (if (and (stringp id)
12488                    (not (string= (gnus-group-real-name group)
12489                                  (car where))))
12490               ;; If we fetched by Message-ID and the article came
12491               ;; from a different group, we fudge some bogus article
12492               ;; numbers for this article.
12493               (mail-header-set-number header gnus-reffed-article-number))
12494           (decf gnus-reffed-article-number)
12495           (push header gnus-newsgroup-headers)
12496           (setq gnus-current-headers header)
12497           (push (mail-header-number header) gnus-newsgroup-limit)
12498           header)))))
12499
12500 (defun gnus-article-prepare (article &optional all-headers header)
12501   "Prepare ARTICLE in article mode buffer.
12502 ARTICLE should either be an article number or a Message-ID.
12503 If ARTICLE is an id, HEADER should be the article headers.
12504 If ALL-HEADERS is non-nil, no headers are hidden."
12505   (save-excursion
12506     ;; Make sure we start in a summary buffer.
12507     (unless (eq major-mode 'gnus-summary-mode)
12508       (set-buffer gnus-summary-buffer))
12509     (setq gnus-summary-buffer (current-buffer))
12510     ;; Make sure the connection to the server is alive.
12511     (unless (gnus-server-opened
12512              (gnus-find-method-for-group gnus-newsgroup-name))
12513       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
12514       (gnus-request-group gnus-newsgroup-name t))
12515     (let* ((article (if header (mail-header-number header) article))
12516            (summary-buffer (current-buffer))
12517            (internal-hook gnus-article-internal-prepare-hook)
12518            (group gnus-newsgroup-name)
12519            result)
12520       (save-excursion
12521         (gnus-article-setup-buffer)
12522         (set-buffer gnus-article-buffer)
12523         ;; Deactivate active regions.
12524         (when (and (boundp 'transient-mark-mode)
12525                    transient-mark-mode)
12526           (setq mark-active nil))
12527         (if (not (setq result (let ((buffer-read-only nil))
12528                                 (gnus-request-article-this-buffer 
12529                                  article group))))
12530             ;; There is no such article.
12531             (save-excursion
12532               (if (not (numberp article))
12533                   ()
12534                 (setq gnus-article-current 
12535                       (cons gnus-newsgroup-name article))
12536                 (set-buffer gnus-summary-buffer)
12537                 (setq gnus-current-article article)
12538                 (gnus-summary-mark-article article gnus-canceled-mark))
12539               (gnus-message 
12540                1 "No such article (may have expired or been canceled)")
12541               (ding)
12542               nil)
12543           (if (or (eq result 'pseudo) (eq result 'nneething))
12544               (progn
12545                 (save-excursion
12546                   (set-buffer summary-buffer)
12547                   (setq gnus-last-article gnus-current-article
12548                         gnus-newsgroup-history (cons gnus-current-article
12549                                                      gnus-newsgroup-history)
12550                         gnus-current-article 0
12551                         gnus-current-headers nil
12552                         gnus-article-current nil)
12553                   (if (eq result 'nneething)
12554                       (gnus-configure-windows 'summary)
12555                     (gnus-configure-windows 'article))
12556                   (gnus-set-global-variables))
12557                 (gnus-set-mode-line 'article))
12558             ;; The result from the `request' was an actual article -
12559             ;; or at least some text that is now displayed in the
12560             ;; article buffer.
12561             (if (and (numberp article)
12562                      (not (eq article gnus-current-article)))
12563                 ;; Seems like a new article has been selected.
12564                 ;; `gnus-current-article' must be an article number.
12565                 (save-excursion
12566                   (set-buffer summary-buffer)
12567                   (setq gnus-last-article gnus-current-article
12568                         gnus-newsgroup-history (cons gnus-current-article
12569                                                      gnus-newsgroup-history)
12570                         gnus-current-article article
12571                         gnus-current-headers 
12572                         (gnus-summary-article-header gnus-current-article)
12573                         gnus-article-current 
12574                         (cons gnus-newsgroup-name gnus-current-article))
12575                   (unless (vectorp gnus-current-headers)
12576                     (setq gnus-current-headers nil))
12577                   (gnus-summary-show-thread)
12578                   (run-hooks 'gnus-mark-article-hook)
12579                   (gnus-set-mode-line 'summary)
12580                   (and (gnus-visual-p 'article-highlight 'highlight)
12581                        (run-hooks 'gnus-visual-mark-article-hook))
12582                   ;; Set the global newsgroup variables here.
12583                   ;; Suggested by Jim Sisolak
12584                   ;; <sisolak@trans4.neep.wisc.edu>.
12585                   (gnus-set-global-variables)
12586                   (setq gnus-have-all-headers 
12587                         (or all-headers gnus-show-all-headers))
12588                   (and gnus-use-cache 
12589                        (vectorp (gnus-summary-article-header article))
12590                        (gnus-cache-possibly-enter-article
12591                         group article
12592                         (gnus-summary-article-header article)
12593                         (memq article gnus-newsgroup-marked)
12594                         (memq article gnus-newsgroup-dormant)
12595                         (memq article gnus-newsgroup-unreads)))))
12596             ;; Hooks for getting information from the article.
12597             ;; This hook must be called before being narrowed.
12598             (let (buffer-read-only)
12599               (run-hooks 'internal-hook)
12600               (run-hooks 'gnus-article-prepare-hook)
12601               ;; Decode MIME message.
12602               (if gnus-show-mime
12603                   (if (or (not gnus-strict-mime)
12604                           (gnus-fetch-field "Mime-Version"))
12605                       (funcall gnus-show-mime-method)
12606                     (funcall gnus-decode-encoded-word-method)))
12607               ;; Perform the article display hooks.
12608               (run-hooks 'gnus-article-display-hook))
12609             ;; Do page break.
12610             (goto-char (point-min))
12611             (and gnus-break-pages (gnus-narrow-to-page))
12612             (gnus-set-mode-line 'article)
12613             (gnus-configure-windows 'article)
12614             (goto-char (point-min))
12615             t))))))
12616
12617 (defun gnus-article-show-all-headers ()
12618   "Show all article headers in article mode buffer."
12619   (save-excursion 
12620     (gnus-article-setup-buffer)
12621     (set-buffer gnus-article-buffer)
12622     (let ((buffer-read-only nil))
12623       (remove-text-properties (point-min) (point-max) 
12624                               gnus-hidden-properties))))
12625
12626 (defun gnus-article-hide-headers-if-wanted ()
12627   "Hide unwanted headers if `gnus-have-all-headers' is nil.
12628 Provided for backwards compatability."
12629   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
12630       gnus-inhibit-hiding
12631       (gnus-article-hide-headers)))
12632
12633 (defun gnus-article-hide-headers (&optional delete)
12634   "Hide unwanted headers and possibly sort them as well."
12635   (interactive "P")
12636   ;; This function might be inhibited.
12637   (unless gnus-inhibit-hiding
12638     (save-excursion
12639       (set-buffer gnus-article-buffer)
12640       (save-restriction
12641         (let ((buffer-read-only nil)
12642               (ignored (when (not (stringp gnus-visible-headers))
12643                          (cond ((stringp gnus-ignored-headers)
12644                                 gnus-ignored-headers)
12645                                ((listp gnus-ignored-headers)
12646                                 (mapconcat 'identity gnus-ignored-headers
12647                                            "\\|")))))
12648               (visible (cond ((stringp gnus-visible-headers)
12649                               gnus-visible-headers)
12650                              ((listp gnus-visible-headers)
12651                               (mapconcat 'identity gnus-visible-headers
12652                                          "\\|"))))
12653               want-list beg want-l)
12654           ;; First we narrow to just the headers.
12655           (widen)
12656           (goto-char (point-min))
12657           ;; Hide any "From " lines at the beginning of (mail) articles. 
12658           (while (looking-at "From ")
12659             (forward-line 1))
12660           (unless (bobp) 
12661             (add-text-properties (point-min) (point) gnus-hidden-properties))
12662           ;; Then treat the rest of the header lines.
12663           (narrow-to-region 
12664            (point) 
12665            (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
12666           ;; Then we use the two regular expressions
12667           ;; `gnus-ignored-headers' and `gnus-visible-headers' to
12668           ;; select which header lines is to remain visible in the
12669           ;; article buffer.
12670           (goto-char (point-min))
12671           (while (re-search-forward "^[^ \t]*:" nil t)
12672             (beginning-of-line)
12673             ;; We add the headers we want to keep to a list and delete
12674             ;; them from the buffer.
12675             (if (or (and visible (looking-at visible))
12676                     (and ignored (not (looking-at ignored))))
12677                 (progn
12678                   (push (buffer-substring
12679                          (setq beg (point))
12680                          (progn 
12681                            (forward-line 1)
12682                            ;; Be sure to get multi-line headers...
12683                            (re-search-forward "^[^ \t]*:" nil t)
12684                            (beginning-of-line) 
12685                            (point)))
12686                         want-list)
12687                   (delete-region beg (point)))
12688               (forward-line 1)))
12689           ;; Sort the headers that we want to display.
12690           (setq want-list (sort want-list 'gnus-article-header-less))
12691           (goto-char (point-min))
12692           (while want-list
12693             (insert (pop want-list)))
12694           ;; We make the unwanted headers invisible.
12695           (if delete
12696               (delete-region (point-min) (point-max))
12697             ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
12698             (add-text-properties 
12699              (point) (point-max) gnus-hidden-properties)))))))
12700
12701 (defsubst gnus-article-header-rank (header)
12702   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
12703   (let ((list gnus-sorted-header-list)
12704         (i 0))
12705     (while list
12706       (when (string-match (car list) header)
12707         (setq list nil))
12708       (setq list (cdr list))
12709       (incf i))
12710     i))
12711
12712 (defun gnus-article-header-less (h1 h2)
12713   "Say whether string H1 is \"less\" than string H2."
12714   (< (gnus-article-header-rank h1)
12715      (gnus-article-header-rank h2)))
12716
12717 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
12718 (defun gnus-article-treat-overstrike ()
12719   "Translate overstrikes into bold text."
12720   (interactive)
12721   (save-excursion
12722     (set-buffer gnus-article-buffer)
12723     (let ((buffer-read-only nil))
12724       (while (search-forward "\b" nil t)
12725         (let ((next (following-char))
12726               (previous (char-after (- (point) 2))))
12727           (cond ((eq next previous)
12728                  (put-text-property (- (point) 2) (point) 'invisible t)
12729                  (put-text-property (point) (1+ (point)) 'face 'bold))
12730                 ((eq next ?_)
12731                  (put-text-property (1- (point)) (1+ (point)) 'invisible t)
12732                  (put-text-property
12733                   (- (point) 2) (1- (point)) 'face 'underline))
12734                 ((eq previous ?_)
12735                  (put-text-property (- (point) 2) (point) 'invisible t)
12736                  (put-text-property 
12737                   (point) (1+ (point))  'face 'underline))))))))
12738
12739 (defun gnus-article-word-wrap ()
12740   "Format too long lines."
12741   (interactive)
12742   (save-excursion
12743     (set-buffer gnus-article-buffer)
12744     (let ((buffer-read-only nil)
12745           p)
12746       (widen)
12747       (goto-char (point-min))
12748       (search-forward "\n\n" nil t)
12749       (end-of-line 1)
12750       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
12751             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
12752             (adaptive-fill-mode t))
12753         (while (not (eobp))
12754           (and (>= (current-column) (min fill-column (window-width)))
12755                (/= (preceding-char) ?:)
12756                (fill-paragraph nil))
12757           (end-of-line 2))))))
12758
12759 (defun gnus-article-remove-cr ()
12760   "Remove carriage returns from an article."
12761   (interactive)
12762   (save-excursion
12763     (set-buffer gnus-article-buffer)
12764     (let ((buffer-read-only nil))
12765       (goto-char (point-min))
12766       (while (search-forward "\r" nil t)
12767         (replace-match "" t t)))))
12768
12769 (defun gnus-article-display-x-face (&optional force)
12770   "Look for an X-Face header and display it if present."
12771   (interactive (list 'force))
12772   (save-excursion
12773     (set-buffer gnus-article-buffer)
12774     ;; Delete the old process, if any.
12775     (when (process-status "gnus-x-face")
12776       (delete-process "gnus-x-face"))
12777     (let ((inhibit-point-motion-hooks t)
12778           (case-fold-search nil)
12779           from)
12780       (save-restriction
12781         (gnus-narrow-to-headers)
12782         (setq from (mail-fetch-field "from"))
12783         (goto-char (point-min))
12784         (when (and gnus-article-x-face-command 
12785                    (or force
12786                        ;; Check whether this face is censored.
12787                        (not gnus-article-x-face-too-ugly)
12788                        (and gnus-article-x-face-too-ugly from
12789                             (not (string-match gnus-article-x-face-too-ugly 
12790                                                from))))
12791                    ;; Has to be present.
12792                    (re-search-forward "^X-Face: " nil t))
12793           ;; We now have the area of the buffer where the X-Face is stored.
12794           (let ((beg (point))
12795                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
12796             ;; We display the face.
12797             (if (symbolp gnus-article-x-face-command)
12798                 ;; The command is a lisp function, so we call it.
12799                 (if (gnus-functionp gnus-article-x-face-command)
12800                     (funcall gnus-article-x-face-command beg end)
12801                   (error "%s is not a function" gnus-article-x-face-command))
12802               ;; The command is a string, so we interpret the command
12803               ;; as a, well, command, and fork it off.
12804               (let ((process-connection-type nil))
12805                 (process-kill-without-query
12806                  (start-process 
12807                   "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
12808                 (process-send-region "gnus-x-face" beg end)
12809                 (process-send-eof "gnus-x-face")))))))))
12810
12811 (defun gnus-headers-decode-quoted-printable ()
12812   "Hack to remove QP encoding from headers."
12813   (let ((case-fold-search t)
12814         (inhibit-point-motion-hooks t)
12815         string)
12816     (goto-char (point-min))
12817     (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
12818       (setq string (match-string 1))
12819       (narrow-to-region (match-beginning 0) (match-end 0))
12820       (delete-region (point-min) (point-max))
12821       (insert string)
12822       (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
12823       (subst-char-in-region (point-min) (point-max) ?_ ? )
12824       (widen)
12825       (goto-char (point-min)))))
12826        
12827 (defun gnus-article-de-quoted-unreadable (&optional force)
12828   "Do a naive translation of a quoted-printable-encoded article.
12829 This is in no way, shape or form meant as a replacement for real MIME
12830 processing, but is simply a stop-gap measure until MIME support is
12831 written.
12832 If FORCE, decode the article whether it is marked as quoted-printable
12833 or not." 
12834   (interactive (list 'force))
12835   (save-excursion
12836     (set-buffer gnus-article-buffer)
12837     (let ((case-fold-search t)
12838           (buffer-read-only nil)
12839           (type (gnus-fetch-field "content-transfer-encoding")))
12840       (when (or force
12841                 (and type (string-match "quoted-printable" type)))
12842         (goto-char (point-min))
12843         (search-forward "\n\n" nil 'move)
12844         (gnus-mime-decode-quoted-printable (point) (point-max))
12845         (gnus-headers-decode-quoted-printable)))))
12846
12847 (defun gnus-mime-decode-quoted-printable (from to)
12848   "Decode Quoted-Printable in the region between FROM and TO."
12849   (goto-char from)
12850   (while (search-forward "=" to t)
12851     (cond ((eq (following-char) ?\n)
12852            (delete-char -1)
12853            (delete-char 1))
12854           ((looking-at "[0-9A-F][0-9A-F]")
12855            (delete-char -1)
12856            (insert (hexl-hex-string-to-integer
12857                     (buffer-substring (point) (+ 2 (point)))))
12858            (delete-char 2))
12859           ((looking-at "=")
12860            (delete-char 1))
12861           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
12862
12863 (defun gnus-article-hide-pgp ()
12864   "Hide any PGP headers and signatures in the current article."
12865   (interactive)
12866   (save-excursion
12867     (set-buffer gnus-article-buffer)
12868     (let (buffer-read-only beg end)
12869       (widen)
12870       (goto-char (point-min))
12871       ;; Hide the "header".
12872       (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
12873            (add-text-properties (match-beginning 0) (match-end 0)
12874                                 gnus-hidden-properties))
12875       (setq beg (point))
12876       ;; Hide the actual signature.
12877       (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
12878            (setq end (match-beginning 0))
12879            (add-text-properties 
12880             (match-beginning 0)
12881             (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
12882                 (match-end 0)
12883               ;; Perhaps we shouldn't hide to the end of the buffer
12884               ;; if there is no end to the signature?
12885               (point-max))
12886             gnus-hidden-properties))
12887       ;; Hide "- " PGP quotation markers.
12888       (when (and beg end)
12889         (narrow-to-region beg end)
12890         (goto-char (point-min))
12891         (while (re-search-forward "^- " nil t)
12892           (add-text-properties (match-beginning 0) (match-end 0)
12893                                gnus-hidden-properties))
12894         (widen)))))
12895
12896 (defvar gnus-article-time-units
12897   `((year . ,(* 365.25 24 60 60))
12898     (week . ,(* 7 24 60 60))
12899     (day . ,(* 24 60 60))
12900     (hour . ,(* 60 60))
12901     (minute . 60)
12902     (second . 1))
12903   "Mapping from time units to seconds.")
12904
12905 (defun gnus-article-date-ut (&optional type highlight)
12906   "Convert DATE date to universal time in the current article.
12907 If TYPE is `local', convert to local time; if it is `lapsed', output
12908 how much time has lapsed since DATE."
12909   (interactive (list 'ut t))
12910   (let* ((header (or gnus-current-headers 
12911                      (gnus-summary-article-header) ""))
12912          (date (and (vectorp header) (mail-header-date header)))
12913          (date-regexp "^Date: \\|^X-Sent: ")
12914          (inhibit-point-motion-hooks t))
12915     (when (and date (not (string= date "")))
12916       (save-excursion
12917         (set-buffer gnus-article-buffer)
12918         (save-restriction
12919           (gnus-narrow-to-headers)
12920           (let ((buffer-read-only nil))
12921             ;; Delete any old Date headers.
12922             (if (zerop (nnheader-remove-header date-regexp t))
12923                 (beginning-of-line)
12924               (goto-char (point-max)))
12925             (insert
12926              (cond 
12927               ;; Convert to the local timezone.  We have to slap a
12928               ;; `condition-case' round the calls to the timezone
12929               ;; functions since they aren't particularly resistant to
12930               ;; buggy dates.
12931               ((eq type 'local)
12932                (concat "Date: " (condition-case ()
12933                                     (timezone-make-date-arpa-standard date)
12934                                   (error date))
12935                        "\n"))
12936               ;; Convert to Universal Time.
12937               ((eq type 'ut)
12938                (concat "Date: "
12939                        (condition-case ()
12940                            (timezone-make-date-arpa-standard date nil "UT")
12941                          (error date))
12942                        "\n"))
12943               ;; Get the original date from the article.
12944               ((eq type 'original)
12945                (concat "Date: " date "\n"))
12946               ;; Do an X-Sent lapsed format.
12947               ((eq type 'lapsed)
12948                ;; If the date is seriously mangled, the timezone
12949                ;; functions are liable to bug out, so we condition-case
12950                ;; the entire thing.  
12951                (let* ((real-sec (condition-case ()
12952                                     (- (gnus-seconds-since-epoch 
12953                                         (timezone-make-date-arpa-standard
12954                                          (current-time-string) 
12955                                          (current-time-zone) "UT"))
12956                                        (gnus-seconds-since-epoch 
12957                                         (timezone-make-date-arpa-standard 
12958                                          date nil "UT")))
12959                                   (error 0)))
12960                       (sec (abs real-sec))
12961                       num prev)
12962                  (if (zerop sec)
12963                      "X-Sent: Now\n"
12964                    (concat
12965                     "X-Sent: "
12966                     ;; This is a bit convoluted, but basically we go
12967                     ;; through the time units for years, weeks, etc,
12968                     ;; and divide things to see whether that results
12969                     ;; in positive answers.
12970                     (mapconcat 
12971                      (lambda (unit)
12972                        (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
12973                            ;; The (remaining) seconds are too few to
12974                            ;; be divided into this time unit.
12975                            "" 
12976                          ;; It's big enough, so we output it.
12977                          (setq sec (- sec (* num (cdr unit))))
12978                          (prog1
12979                              (concat (if prev ", " "") (int-to-string 
12980                                                         (floor num))
12981                                      " " (symbol-name (car unit))
12982                                      (if (> num 1) "s" ""))
12983                            (setq prev t))))
12984                      gnus-article-time-units "")
12985                     ;; If dates are odd, then it might appear like the
12986                     ;; article was sent in the future.
12987                     (if (> real-sec 0)
12988                         " ago\n"
12989                       " in the future\n")))))
12990               (t
12991                (error "Unknown conversion type: %s" type)))))
12992           ;; Do highlighting.
12993           (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
12994             (gnus-article-highlight-headers)))))))
12995
12996 (defun gnus-article-date-local (&optional highlight)
12997   "Convert the current article date to the local timezone."
12998   (interactive (list t))
12999   (gnus-article-date-ut 'local highlight))
13000
13001 (defun gnus-article-date-original (&optional highlight)
13002   "Convert the current article date to what it was originally.
13003 This is only useful if you have used some other date conversion
13004 function and want to see what the date was before converting."
13005   (interactive (list t))
13006   (gnus-article-date-ut 'original highlight))
13007
13008 (defun gnus-article-date-lapsed (&optional highlight)
13009   "Convert the current article date to time lapsed since it was sent."
13010   (interactive (list t))
13011   (gnus-article-date-ut 'lapsed highlight))
13012
13013 (defun gnus-article-maybe-highlight ()
13014   "Do some article highlighting if `gnus-visual' is non-nil."
13015   (if (gnus-visual-p 'article-highlight 'highlight)
13016       (gnus-article-highlight-some)))
13017
13018 ;; Article savers.
13019
13020 (defun gnus-output-to-rmail (file-name)
13021   "Append the current article to an Rmail file named FILE-NAME."
13022   (require 'rmail)
13023   ;; Most of these codes are borrowed from rmailout.el.
13024   (setq file-name (expand-file-name file-name))
13025   (setq rmail-default-rmail-file file-name)
13026   (let ((artbuf (current-buffer))
13027         (tmpbuf (get-buffer-create " *Gnus-output*")))
13028     (save-excursion
13029       (or (get-file-buffer file-name)
13030           (file-exists-p file-name)
13031           (if (gnus-yes-or-no-p
13032                (concat "\"" file-name "\" does not exist, create it? "))
13033               (let ((file-buffer (create-file-buffer file-name)))
13034                 (save-excursion
13035                   (set-buffer file-buffer)
13036                   (rmail-insert-rmail-file-header)
13037                   (let ((require-final-newline nil))
13038                     (write-region (point-min) (point-max) file-name t 1)))
13039                 (kill-buffer file-buffer))
13040             (error "Output file does not exist")))
13041       (set-buffer tmpbuf)
13042       (buffer-disable-undo (current-buffer))
13043       (erase-buffer)
13044       (insert-buffer-substring artbuf)
13045       (gnus-convert-article-to-rmail)
13046       ;; Decide whether to append to a file or to an Emacs buffer.
13047       (let ((outbuf (get-file-buffer file-name)))
13048         (if (not outbuf)
13049             (append-to-file (point-min) (point-max) file-name)
13050           ;; File has been visited, in buffer OUTBUF.
13051           (set-buffer outbuf)
13052           (let ((buffer-read-only nil)
13053                 (msg (and (boundp 'rmail-current-message)
13054                           (symbol-value 'rmail-current-message))))
13055             ;; If MSG is non-nil, buffer is in RMAIL mode.
13056             (if msg
13057                 (progn (widen)
13058                        (narrow-to-region (point-max) (point-max))))
13059             (insert-buffer-substring tmpbuf)
13060             (if msg
13061                 (progn
13062                   (goto-char (point-min))
13063                   (widen)
13064                   (search-backward "\^_")
13065                   (narrow-to-region (point) (point-max))
13066                   (goto-char (1+ (point-min)))
13067                   (rmail-count-new-messages t)
13068                   (rmail-show-message msg)))))))
13069     (kill-buffer tmpbuf)))
13070
13071 (defun gnus-output-to-file (file-name)
13072   "Append the current article to a file named FILE-NAME."
13073   (setq file-name (expand-file-name file-name))
13074   (let ((artbuf (current-buffer))
13075         (tmpbuf (get-buffer-create " *Gnus-output*")))
13076     (save-excursion
13077       (set-buffer tmpbuf)
13078       (buffer-disable-undo (current-buffer))
13079       (erase-buffer)
13080       (insert-buffer-substring artbuf)
13081       ;; Append newline at end of the buffer as separator, and then
13082       ;; save it to file.
13083       (goto-char (point-max))
13084       (insert "\n")
13085       (append-to-file (point-min) (point-max) file-name))
13086     (kill-buffer tmpbuf)))
13087
13088 (defun gnus-convert-article-to-rmail ()
13089   "Convert article in current buffer to Rmail message format."
13090   (let ((buffer-read-only nil))
13091     ;; Convert article directly into Babyl format.
13092     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
13093     (goto-char (point-min))
13094     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
13095     (while (search-forward "\n\^_" nil t) ;single char
13096       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
13097     (goto-char (point-max))
13098     (insert "\^_")))
13099
13100 (defun gnus-narrow-to-page (&optional arg)
13101   "Narrow the article buffer to a page.
13102 If given a numerical ARG, move forward ARG pages."
13103   (interactive "P")
13104   (setq arg (if arg (prefix-numeric-value arg) 0))
13105   (save-excursion
13106     (set-buffer gnus-article-buffer)
13107     (goto-char (point-min))
13108     (widen)
13109     (when 
13110         (cond ((< arg 0)
13111                (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
13112               ((> arg 0)
13113                (re-search-forward page-delimiter nil 'move arg)))
13114       (goto-char (match-end 0)))
13115     (when (and (gnus-visual-p 'page-marker)
13116                (not (bolp)))
13117       (gnus-insert-prev-page-button))
13118     (narrow-to-region
13119      (point)
13120      (if (re-search-forward page-delimiter nil 'move)
13121          (prog1 (match-beginning 0) 
13122            (when (and (gnus-visual-p 'page-marker)
13123                       (not (bolp)))
13124              (gnus-insert-next-page-button)))
13125        (point)))))
13126
13127 ;; Article mode commands
13128
13129 (defun gnus-article-next-page (&optional lines)
13130   "Show next page of current article.
13131 If end of article, return non-nil.  Otherwise return nil.
13132 Argument LINES specifies lines to be scrolled up."
13133   (interactive "P")
13134   (move-to-window-line -1)
13135   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
13136   (if (save-excursion
13137         (end-of-line)
13138         (and (pos-visible-in-window-p)  ;Not continuation line.
13139              (eobp)))
13140       ;; Nothing in this page.
13141       (if (or (not gnus-break-pages)
13142               (save-excursion
13143                 (save-restriction
13144                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
13145           t                             ;Nothing more.
13146         (gnus-narrow-to-page 1)         ;Go to next page.
13147         nil)
13148     ;; More in this page.
13149     (condition-case ()
13150         (scroll-up lines)
13151       (end-of-buffer
13152        ;; Long lines may cause an end-of-buffer error.
13153        (goto-char (point-max))))
13154     nil))
13155
13156 (defun gnus-article-prev-page (&optional lines)
13157   "Show previous page of current article.
13158 Argument LINES specifies lines to be scrolled down."
13159   (interactive "P")
13160   (move-to-window-line 0)
13161   (if (and gnus-break-pages
13162            (bobp)
13163            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
13164       (progn
13165         (gnus-narrow-to-page -1)        ;Go to previous page.
13166         (goto-char (point-max))
13167         (recenter -1))
13168     (condition-case ()
13169         (scroll-down lines)
13170       (error nil))))
13171
13172 (defun gnus-article-refer-article ()
13173   "Read article specified by message-id around point."
13174   (interactive)
13175   (search-forward ">" nil t)            ;Move point to end of "<....>".
13176   (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
13177       (let ((message-id (match-string 1)))
13178         (set-buffer gnus-summary-buffer)
13179         (gnus-summary-refer-article message-id))
13180     (error "No references around point")))
13181
13182 (defun gnus-article-show-summary ()
13183   "Reconfigure windows to show summary buffer."
13184   (interactive)
13185   (gnus-configure-windows 'article)
13186   (gnus-summary-goto-subject gnus-current-article))
13187
13188 (defun gnus-article-describe-briefly ()
13189   "Describe article mode commands briefly."
13190   (interactive)
13191   (gnus-message 6
13192                 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-next-page]:Next page  \\[gnus-article-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
13193
13194 (defun gnus-article-summary-command ()
13195   "Execute the last keystroke in the summary buffer."
13196   (interactive)
13197   (let ((obuf (current-buffer))
13198         (owin (current-window-configuration))
13199         func)
13200     (switch-to-buffer gnus-summary-buffer 'norecord)
13201     (setq func (lookup-key (current-local-map) (this-command-keys)))
13202     (call-interactively func)
13203     (set-buffer obuf)
13204     (set-window-configuration owin)
13205     (set-window-point (get-buffer-window (current-buffer)) (point))))
13206
13207 (defun gnus-article-summary-command-nosave ()
13208   "Execute the last keystroke in the summary buffer."
13209   (interactive)
13210   (let (func)
13211     (pop-to-buffer gnus-summary-buffer 'norecord)
13212     (setq func (lookup-key (current-local-map) (this-command-keys)))
13213     (call-interactively func)))
13214
13215 \f
13216 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
13217
13218 ;;;###autoload
13219 (defalias 'gnus-batch-kill 'gnus-batch-score)
13220 ;;;###autoload
13221 (defun gnus-batch-score ()
13222   "Run batched scoring.
13223 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
13224 Newsgroups is a list of strings in Bnews format.  If you want to score
13225 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
13226 score the alt hierarchy, you'd say \"!alt.all\"."
13227   (interactive)
13228   (let* ((yes-and-no
13229           (gnus-newsrc-parse-options
13230            (apply (function concat)
13231                   (mapcar (lambda (g) (concat g " "))
13232                           command-line-args-left))))
13233          (gnus-expert-user t)
13234          (nnmail-spool-file nil)
13235          (gnus-use-dribble-file nil)
13236          (yes (car yes-and-no))
13237          (no (cdr yes-and-no))
13238          group newsrc entry
13239          ;; Disable verbose message.
13240          gnus-novice-user gnus-large-newsgroup)
13241     ;; Eat all arguments.
13242     (setq command-line-args-left nil)
13243     ;; Start Gnus.
13244     (gnus)
13245     ;; Apply kills to specified newsgroups in command line arguments.
13246     (setq newsrc (cdr gnus-newsrc-alist))
13247     (while newsrc
13248       (setq group (car (car newsrc)))
13249       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
13250       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
13251                (and (car entry)
13252                     (or (eq (car entry) t)
13253                         (not (zerop (car entry)))))
13254                (if yes (string-match yes group) t)
13255                (or (null no) (not (string-match no group))))
13256           (progn
13257             (gnus-summary-read-group group nil t nil t)
13258             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
13259                  (gnus-summary-exit))))
13260       (setq newsrc (cdr newsrc)))
13261     ;; Exit Emacs.
13262     (switch-to-buffer gnus-group-buffer)
13263     (gnus-group-save-newsrc)))
13264
13265 (defun gnus-apply-kill-file ()
13266   "Apply a kill file to the current newsgroup.
13267 Returns the number of articles marked as read."
13268   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
13269           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
13270       (gnus-apply-kill-file-internal)
13271     0))
13272
13273 (defun gnus-kill-save-kill-buffer ()
13274   (save-excursion
13275     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
13276       (if (get-file-buffer file)
13277           (progn
13278             (set-buffer (get-file-buffer file))
13279             (and (buffer-modified-p) (save-buffer))
13280             (kill-buffer (current-buffer)))))))
13281
13282 (defvar gnus-kill-file-name "KILL"
13283   "Suffix of the kill files.")
13284
13285 (defun gnus-newsgroup-kill-file (newsgroup)
13286   "Return the name of a kill file name for NEWSGROUP.
13287 If NEWSGROUP is nil, return the global kill file name instead."
13288   (cond ((or (null newsgroup)
13289              (string-equal newsgroup ""))
13290          ;; The global KILL file is placed at top of the directory.
13291          (expand-file-name gnus-kill-file-name
13292                            (or gnus-kill-files-directory "~/News")))
13293         ((gnus-use-long-file-name 'not-kill)
13294          ;; Append ".KILL" to newsgroup name.
13295          (expand-file-name (concat (gnus-newsgroup-saveable-name newsgroup)
13296                                    "." gnus-kill-file-name)
13297                            (or gnus-kill-files-directory "~/News")))
13298         (t
13299          ;; Place "KILL" under the hierarchical directory.
13300          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
13301                                    "/" gnus-kill-file-name)
13302                            (or gnus-kill-files-directory "~/News")))))
13303
13304 \f
13305 ;;;
13306 ;;; Dribble file
13307 ;;;
13308
13309 (defvar gnus-dribble-ignore nil)
13310 (defvar gnus-dribble-eval-file nil)
13311
13312 (defun gnus-dribble-file-name ()
13313   (concat 
13314    (if gnus-dribble-directory
13315        (concat (file-name-as-directory gnus-dribble-directory)
13316                (file-name-nondirectory gnus-current-startup-file))
13317      gnus-current-startup-file)
13318    "-dribble"))
13319
13320 (defun gnus-dribble-enter (string)
13321   (if (and (not gnus-dribble-ignore)
13322            (or gnus-dribble-buffer
13323                gnus-slave)
13324            (buffer-name gnus-dribble-buffer))
13325       (let ((obuf (current-buffer)))
13326         (set-buffer gnus-dribble-buffer)
13327         (insert string "\n")
13328         (set-window-point (get-buffer-window (current-buffer)) (point-max))
13329         (set-buffer obuf))))
13330
13331 (defun gnus-dribble-read-file ()
13332   (let ((dribble-file (gnus-dribble-file-name)))
13333     (save-excursion 
13334       (set-buffer (setq gnus-dribble-buffer 
13335                         (get-buffer-create 
13336                          (file-name-nondirectory dribble-file))))
13337       (gnus-add-current-to-buffer-list)
13338       (erase-buffer)
13339       (setq buffer-file-name dribble-file)
13340       (auto-save-mode t)
13341       (buffer-disable-undo (current-buffer))
13342       (bury-buffer (current-buffer))
13343       (set-buffer-modified-p nil)
13344       (let ((auto (make-auto-save-file-name))
13345             (gnus-dribble-ignore t))
13346         (if (or (file-exists-p auto) (file-exists-p dribble-file))
13347             (progn
13348               (if (file-newer-than-file-p auto dribble-file)
13349                   (setq dribble-file auto))
13350               (insert-file-contents dribble-file)
13351               (if (not (zerop (buffer-size)))
13352                   (set-buffer-modified-p t))
13353               (if (gnus-y-or-n-p 
13354                    "Auto-save file exists.  Do you want to read it? ")
13355                   (setq gnus-dribble-eval-file t))))))))
13356
13357 (defun gnus-dribble-eval-file ()
13358   (if (not gnus-dribble-eval-file)
13359       ()
13360     (setq gnus-dribble-eval-file nil)
13361     (save-excursion
13362       (let ((gnus-dribble-ignore t))
13363         (set-buffer gnus-dribble-buffer)
13364         (eval-buffer (current-buffer))))))
13365
13366 (defun gnus-dribble-delete-file ()
13367   (if (file-exists-p (gnus-dribble-file-name))
13368       (delete-file (gnus-dribble-file-name)))
13369   (if gnus-dribble-buffer
13370       (save-excursion
13371         (set-buffer gnus-dribble-buffer)
13372         (let ((auto (make-auto-save-file-name)))
13373           (if (file-exists-p auto)
13374               (delete-file auto))
13375           (erase-buffer)
13376           (set-buffer-modified-p nil)))))
13377
13378 (defun gnus-dribble-save ()
13379   (if (and gnus-dribble-buffer
13380            (buffer-name gnus-dribble-buffer))
13381       (save-excursion
13382         (set-buffer gnus-dribble-buffer)
13383         (save-buffer))))
13384
13385 (defun gnus-dribble-clear ()
13386   (save-excursion
13387     (if (gnus-buffer-exists-p gnus-dribble-buffer)
13388         (progn
13389           (set-buffer gnus-dribble-buffer)
13390           (erase-buffer)
13391           (set-buffer-modified-p nil)
13392           (setq buffer-saved-size (buffer-size))))))
13393
13394 ;;;
13395 ;;; Server Communication
13396 ;;;
13397
13398 (defun gnus-start-news-server (&optional confirm)
13399   "Open a method for getting news.
13400 If CONFIRM is non-nil, the user will be asked for an NNTP server."
13401   (let (how)
13402     (if gnus-current-select-method
13403         ;; Stream is already opened.
13404         nil
13405       ;; Open NNTP server.
13406       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
13407       (if confirm
13408           (progn
13409             ;; Read server name with completion.
13410             (setq gnus-nntp-server
13411                   (completing-read "NNTP server: "
13412                                    (mapcar (lambda (server) (list server))
13413                                            (cons (list gnus-nntp-server)
13414                                                  gnus-secondary-servers))
13415                                    nil nil gnus-nntp-server))))
13416
13417       (if (and gnus-nntp-server 
13418                (stringp gnus-nntp-server)
13419                (not (string= gnus-nntp-server "")))
13420           (setq gnus-select-method
13421                 (cond ((or (string= gnus-nntp-server "")
13422                            (string= gnus-nntp-server "::"))
13423                        (list 'nnspool (system-name)))
13424                       ((string-match "^:" gnus-nntp-server)
13425                        (list 'nnmh gnus-nntp-server 
13426                              (list 'nnmh-directory 
13427                                    (file-name-as-directory
13428                                     (expand-file-name
13429                                      (concat "~/" (substring
13430                                                    gnus-nntp-server 1)))))
13431                              (list 'nnmh-get-new-mail nil)))
13432                       (t
13433                        (list 'nntp gnus-nntp-server)))))
13434
13435       (setq how (car gnus-select-method))
13436       (cond ((eq how 'nnspool)
13437              (require 'nnspool)
13438              (gnus-message 5 "Looking up local news spool..."))
13439             ((eq how 'nnmh)
13440              (require 'nnmh)
13441              (gnus-message 5 "Looking up mh spool..."))
13442             (t
13443              (require 'nntp)))
13444       (setq gnus-current-select-method gnus-select-method)
13445       (run-hooks 'gnus-open-server-hook)
13446       (or 
13447        ;; gnus-open-server-hook might have opened it
13448        (gnus-server-opened gnus-select-method)  
13449        (gnus-open-server gnus-select-method)
13450        (gnus-y-or-n-p
13451         (format
13452          "%s open error: '%s'.  Continue? "
13453          (nth 1 gnus-select-method)
13454          (gnus-status-message gnus-select-method)))
13455        (progn
13456          (gnus-message 1 "Couldn't open server on %s" 
13457                        (nth 1 gnus-select-method))
13458          (ding)
13459          nil)))))
13460
13461 (defun gnus-check-server (&optional method)
13462   "Check whether the connection to METHOD is down.
13463 If METHOD is nil, use `gnus-select-method'.
13464 If it is down, start it up (again)."
13465   (let ((method (or method gnus-select-method)))
13466     ;; Transform virtual server names into select methods.
13467     (when (stringp method)
13468       (setq method (gnus-server-to-method method)))
13469     (if (gnus-server-opened method)
13470         ;; The stream is already opened.
13471         t
13472       ;; Open the server.
13473       (gnus-message 5 "Opening %s server on %s..." (car method) (nth 1 method))
13474       (run-hooks 'gnus-open-server-hook)
13475       (prog1
13476           (gnus-open-server method)
13477         (message "")))))
13478
13479 (defun gnus-get-function (method function)
13480   "Return a function symbol based on METHOD and FUNCTION."
13481   ;; Translate server names into methods.
13482   (unless method
13483     (error "Attempted use of a nil select method"))
13484   (when (stringp method)
13485     (setq method (gnus-server-to-method method)))
13486   (let ((func (intern (format "%s-%s" (car method) function))))
13487     ;; If the functions isn't bound, we require the backend in
13488     ;; question.  
13489     (unless (fboundp func)
13490       (require (car method))
13491       (unless (fboundp func)
13492         ;; This backend doesn't implement this function.
13493         (error "No such function: %s" func)))
13494     func))
13495
13496 ;;; Interface functions to the backends.
13497
13498 (defun gnus-open-server (method)
13499   "Open a connection to METHOD."
13500   (let ((elem (assoc method gnus-opened-servers)))
13501     ;; If this method was previously denied, we just return nil.
13502     (if (eq (nth 1 elem) 'denied)
13503         (progn
13504           (gnus-message 1 "Denied server")
13505           nil)
13506       ;; Open the server.
13507       (let ((result
13508              (funcall (gnus-get-function method 'open-server)
13509                       (nth 1 method) (nthcdr 2 method))))
13510         ;; If this hasn't been opened before, we add it to the list.
13511         (unless elem 
13512           (setq elem (list method nil)
13513                 gnus-opened-servers (cons elem gnus-opened-servers)))
13514         ;; Set the status of this server.
13515         (setcar (cdr elem) (if result 'ok 'denied))
13516         ;; Return the result from the "open" call.
13517         result))))
13518
13519 (defun gnus-close-server (method)
13520   "Close the connection to METHOD."
13521   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
13522
13523 (defun gnus-request-list (method)
13524   "Request the active file from METHOD."
13525   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
13526
13527 (defun gnus-request-list-newsgroups (method)
13528   "Request the newsgroups file from METHOD."
13529   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
13530
13531 (defun gnus-request-newgroups (date method)
13532   "Request all new groups since DATE from METHOD."
13533   (funcall (gnus-get-function method 'request-newgroups) 
13534            date (nth 1 method)))
13535
13536 (defun gnus-server-opened (method)
13537   "Check whether a connection to METHOD has been opened."
13538   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
13539
13540 (defun gnus-status-message (method)
13541   "Return the status message from METHOD.
13542 If METHOD is a string, it is interpreted as a group name.   The method
13543 this group uses will be queried."
13544   (let ((method (if (stringp method) (gnus-find-method-for-group method)
13545                   method)))
13546     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
13547
13548 (defun gnus-request-group (group &optional dont-check)
13549   "Request GROUP.  If DONT-CHECK, no information is required."
13550   (let ((method (gnus-find-method-for-group group)))
13551     (funcall (gnus-get-function method 'request-group) 
13552              (gnus-group-real-name group) (nth 1 method) dont-check)))
13553
13554 (defun gnus-request-asynchronous (group &optional articles)
13555   "Request that GROUP behave asynchronously.
13556 ARTICLES is the `data' of the group."
13557   (let ((method (gnus-find-method-for-group group)))
13558     (funcall (gnus-get-function method 'request-asynchronous) 
13559              (gnus-group-real-name group) (nth 1 method) articles)))
13560
13561 (defun gnus-list-active-group (group)
13562   "Request active information on GROUP."
13563   (let ((method (gnus-find-method-for-group group))
13564         (func 'list-active-group))
13565     (when (gnus-check-backend-function func group)
13566       (funcall (gnus-get-function method func) 
13567                (gnus-group-real-name group) (nth 1 method)))))
13568
13569 (defun gnus-request-group-description (group)
13570   "Request a description of GROUP."
13571   (let ((method (gnus-find-method-for-group group))
13572         (func 'request-group-description))
13573     (when (gnus-check-backend-function func group)
13574       (funcall (gnus-get-function method func) 
13575                (gnus-group-real-name group) (nth 1 method)))))
13576
13577 (defun gnus-close-group (group)
13578   "Request the GROUP be closed."
13579   (let ((method (gnus-find-method-for-group group)))
13580     (funcall (gnus-get-function method 'close-group) 
13581              (gnus-group-real-name group) (nth 1 method))))
13582
13583 (defun gnus-retrieve-headers (articles group &optional fetch-old)
13584   "Request headers for ARTICLES in GROUP.
13585 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
13586   (let ((method (gnus-find-method-for-group group)))
13587     (if (and gnus-use-cache (numberp (car articles)))
13588         (gnus-cache-retrieve-headers articles group fetch-old)
13589       (funcall (gnus-get-function method 'retrieve-headers) 
13590                articles (gnus-group-real-name group) (nth 1 method)
13591                fetch-old))))
13592
13593 (defun gnus-retrieve-groups (groups method)
13594   "Request active information on GROUPS from METHOD."
13595   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
13596
13597 (defun gnus-request-type (group &optional article)
13598   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
13599   (let ((method (gnus-find-method-for-group group)))
13600     (if (not (gnus-check-backend-function 'request-type (car method)))
13601         'unknown
13602       (funcall (gnus-get-function method 'request-type)
13603                (gnus-group-real-name group) article))))
13604
13605 (defun gnus-request-article (article group &optional buffer)
13606   "Request the ARTICLE in GROUP.
13607 ARTICLE can either be an article number or an article Message-ID.
13608 If BUFFER, insert the article in that group."
13609   (let ((method (gnus-find-method-for-group group)))
13610     (funcall (gnus-get-function method 'request-article) 
13611              article (gnus-group-real-name group) (nth 1 method) buffer)))
13612
13613 (defun gnus-request-head (article group)
13614   "Request the head of ARTICLE in GROUP."
13615   (let ((method (gnus-find-method-for-group group)))
13616     (funcall (gnus-get-function method 'request-head) 
13617              article (gnus-group-real-name group) (nth 1 method))))
13618
13619 (defun gnus-request-body (article group)
13620   "Request the body of ARTICLE in GROUP."
13621   (let ((method (gnus-find-method-for-group group)))
13622     (funcall (gnus-get-function method 'request-body) 
13623              article (gnus-group-real-name group) (nth 1 method))))
13624
13625 (defun gnus-request-post (method)
13626   "Post the current buffer using METHOD."
13627   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
13628
13629 (defun gnus-request-scan (group method)
13630   "Request a SCAN being performed in GROUP from METHOD.
13631 If GROUP is nil, all groups on METHOD are scanned."
13632   (let ((method (if group (gnus-find-method-for-group group) method)))
13633     (funcall (gnus-get-function method 'request-scan) 
13634              (and group (gnus-group-real-name group)) (nth 1 method))))
13635
13636 (defun gnus-request-update-info (info method)
13637   "Request that METHOD update INFO."
13638   (when (gnus-check-backend-function 'request-update-info method)
13639     (funcall (gnus-get-function method 'request-update-info) 
13640              (gnus-group-real-name (gnus-info-group info)) 
13641              info (nth 1 method))))
13642
13643 (defun gnus-request-expire-articles (articles group &optional force)
13644   (let ((method (gnus-find-method-for-group group)))
13645     (funcall (gnus-get-function method 'request-expire-articles) 
13646              articles (gnus-group-real-name group) (nth 1 method)
13647              force)))
13648
13649 (defun gnus-request-move-article 
13650   (article group server accept-function &optional last)
13651   (let ((method (gnus-find-method-for-group group)))
13652     (funcall (gnus-get-function method 'request-move-article) 
13653              article (gnus-group-real-name group) 
13654              (nth 1 method) accept-function last)))
13655
13656 (defun gnus-request-accept-article (group &optional last)
13657   (let ((func (if (symbolp group) group
13658                 (car (gnus-find-method-for-group group)))))
13659     (funcall (intern (format "%s-request-accept-article" func))
13660              (if (stringp group) (gnus-group-real-name group) group)
13661              last)))
13662
13663 (defun gnus-request-replace-article (article group buffer)
13664   (let ((func (car (gnus-find-method-for-group group))))
13665     (funcall (intern (format "%s-request-replace-article" func))
13666              article (gnus-group-real-name group) buffer)))
13667
13668 (defun gnus-request-create-group (group)
13669   (let ((method (gnus-find-method-for-group group)))
13670     (funcall (gnus-get-function method 'request-create-group) 
13671              (gnus-group-real-name group) (nth 1 method))))
13672
13673 (defun gnus-request-delete-group (group &optional force)
13674   (let ((method (gnus-find-method-for-group group)))
13675     (funcall (gnus-get-function method 'request-delete-group) 
13676              (gnus-group-real-name group) force (nth 1 method))))
13677
13678 (defun gnus-request-rename-group (group new-name)
13679   (let ((method (gnus-find-method-for-group group)))
13680     (funcall (gnus-get-function method 'request-rename-group) 
13681              (gnus-group-real-name group) 
13682              (gnus-group-real-name new-name) (nth 1 method))))
13683
13684 (defun gnus-post-method (group force-group-method)
13685   "Return the posting method based on GROUP and FORCE."
13686   (let ((group-method (if (stringp group)
13687                           (gnus-find-method-for-group group)
13688                         group)))
13689     (cond 
13690      ;; If the group-method is nil (which shouldn't happen) we use 
13691      ;; the default method.
13692      ((null group-method)
13693       gnus-select-method)
13694      ;; We want this group's method.
13695      (force-group-method group-method)
13696      ;; Override normal method.
13697      ((and gnus-post-method
13698            (or (gnus-method-option-p group-method 'post)
13699                (gnus-method-option-p group-method 'post-mail)))
13700       gnus-post-method)
13701      ;; Perhaps this is a mail group?
13702      ((and (not (gnus-member-of-valid 'post group))
13703            (not (gnus-method-option-p group-method 'post-mail)))
13704       group-method)
13705      ;; Use the normal select method.
13706      (t gnus-select-method))))
13707
13708 (defun gnus-member-of-valid (symbol group)
13709   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
13710   (memq symbol (assoc
13711                 (symbol-name (car (gnus-find-method-for-group group)))
13712                 gnus-valid-select-methods)))
13713
13714 (defun gnus-method-option-p (method option)
13715   "Return non-nil if select METHOD has OPTION as a parameter."
13716   (memq option (assoc (format "%s" (car method))
13717                       gnus-valid-select-methods)))
13718
13719 (defmacro gnus-server-equal (ss1 ss2)
13720   "Say whether two servers are equal."
13721   `(let ((s1 ,ss1)
13722          (s2 ,ss2))
13723      (or (equal s1 s2)
13724          (and (= (length s1) (length s2))
13725               (progn
13726                 (while (and s1 (member (car s1) s2))
13727                   (setq s1 (cdr s1)))
13728                 (null s1))))))
13729
13730 (defun gnus-server-extend-method (group method)
13731   ;; This function "extends" a virtual server.  If the server is
13732   ;; "hello", and the select method is ("hello" (my-var "something")) 
13733   ;; in the group "alt.alt", this will result in a new virtual server
13734   ;; called "helly+alt.alt".
13735   (let ((entry
13736          (gnus-copy-sequence 
13737           (if (equal (car method) "native") gnus-select-method
13738             (cdr (assoc (car method) gnus-server-alist))))))
13739     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
13740     (nconc entry (cdr method))))
13741
13742 (defun gnus-find-method-for-group (group &optional info)
13743   "Find the select method that GROUP uses."
13744   (or gnus-override-method
13745       (and (not group)
13746            gnus-select-method)
13747       (let ((info (or info (gnus-get-info group)))
13748             method)
13749         (if (or (not info)
13750                 (not (setq method (gnus-info-method info))))
13751             (setq method gnus-select-method)
13752           (setq method
13753                 (cond ((stringp method)
13754                        (gnus-server-to-method method))
13755                       ((stringp (car method))
13756                        (gnus-server-extend-method group method))
13757                       (t
13758                        method))))
13759         (gnus-server-add-address method))))
13760
13761 (defun gnus-check-backend-function (func group)
13762   "Check whether GROUP supports function FUNC."
13763   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
13764                   group)))
13765     (fboundp (intern (format "%s-%s" method func)))))
13766
13767 (defun gnus-methods-using (feature)
13768   "Find all methods that have FEATURE."
13769   (let ((valids gnus-valid-select-methods)
13770         outs)
13771     (while valids
13772       (if (memq feature (car valids)) 
13773           (setq outs (cons (car valids) outs)))
13774       (setq valids (cdr valids)))
13775     outs))
13776
13777 ;;; 
13778 ;;; Active & Newsrc File Handling
13779 ;;;
13780
13781 ;; Newsrc related functions.
13782 ;; Gnus internal format of gnus-newsrc-alist:
13783 ;; (("alt.general" 3 (1 . 1))
13784 ;;  ("alt.misc"    3 ((1 . 10) (12 . 15)))
13785 ;;  ("alt.test"    7 (1 . 99) (45 57 93)) ...)
13786 ;; The first item is the group name; the second is the subscription
13787 ;; level; the third is either a range of a list of ranges of read
13788 ;; articles, the optional fourth element is a list of marked articles,
13789 ;; the optional fifth element is the select method.
13790 ;;
13791 ;; Gnus internal format of gnus-newsrc-hashtb:
13792 ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...)
13793 ;; This is the entry for "alt.misc". The first element is the number
13794 ;; of unread articles in "alt.misc". The cdr of this entry is the
13795 ;; element *before* "alt.misc" in gnus-newsrc-alist, which makes is
13796 ;; trivial to remove or add new elements into gnus-newsrc-alist
13797 ;; without scanning the entire list.  So, to get the actual information
13798 ;; of "alt.misc", you'd say something like 
13799 ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb))
13800 ;;
13801 ;; Gnus internal format of gnus-active-hashtb:
13802 ;; ((1 . 1))
13803 ;;  (5 . 10))
13804 ;;  (67 . 99)) ...)
13805 ;; The only element in each entry in this hash table is a range of
13806 ;; (possibly) available articles. (Articles in this range may have
13807 ;; been expired or canceled.)
13808 ;;
13809 ;; Gnus internal format of gnus-killed-list and gnus-zombie-list:
13810 ;; ("alt.misc" "alt.test" "alt.general" ...)
13811
13812 (defun gnus-setup-news (&optional rawfile level)
13813   "Setup news information.
13814 If RAWFILE is non-nil, the .newsrc file will also be read.
13815 If LEVEL is non-nil, the news will be set up at level LEVEL."
13816   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
13817     ;; Clear some variables to re-initialize news information.
13818     (if init (setq gnus-newsrc-alist nil 
13819                    gnus-active-hashtb nil))
13820
13821     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
13822     (if init (gnus-read-newsrc-file rawfile))
13823
13824     ;; If we don't read the complete active file, we fill in the
13825     ;; hashtb here. 
13826     (if (or (null gnus-read-active-file)
13827             (eq gnus-read-active-file 'some))
13828         (gnus-update-active-hashtb-from-killed))
13829
13830     ;; Read the active file and create `gnus-active-hashtb'.
13831     ;; If `gnus-read-active-file' is nil, then we just create an empty
13832     ;; hash table.  The partial filling out of the hash table will be
13833     ;; done in `gnus-get-unread-articles'.
13834     (and gnus-read-active-file 
13835          (not level)
13836          (gnus-read-active-file))
13837
13838     (or gnus-active-hashtb
13839         (setq gnus-active-hashtb (make-vector 4095 0)))
13840
13841     ;; Initialize the cache.
13842     (when gnus-use-cache
13843       (gnus-cache-open))
13844
13845     ;; Possibly eval the dribble file.
13846     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
13847
13848     (gnus-update-format-specifications)
13849
13850     ;; Find new newsgroups and treat them.
13851     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
13852              (gnus-check-server gnus-select-method))
13853         (gnus-find-new-newsgroups))
13854
13855     ;; Find the number of unread articles in each non-dead group.
13856     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
13857       (gnus-get-unread-articles level))
13858
13859     (if (and init gnus-check-bogus-newsgroups 
13860              gnus-read-active-file (not level)
13861              (gnus-server-opened gnus-select-method))
13862         (gnus-check-bogus-newsgroups))))
13863
13864 (defun gnus-find-new-newsgroups ()
13865   "Search for new newsgroups and add them.
13866 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
13867 The `-n' option line from .newsrc is respected."
13868   (interactive)
13869   (or (gnus-check-first-time-used)
13870       (if (or (consp gnus-check-new-newsgroups)
13871               (eq gnus-check-new-newsgroups 'ask-server))
13872           (gnus-ask-server-for-new-groups)
13873         (let ((groups 0)
13874               group new-newsgroups)
13875           (gnus-message 5 "Looking for new newsgroups...")
13876           (or gnus-have-read-active-file (gnus-read-active-file))
13877           (setq gnus-newsrc-last-checked-date (current-time-string))
13878           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
13879           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
13880           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
13881           (mapatoms
13882            (lambda (sym)
13883              (if (or (null (setq group (symbol-name sym)))
13884                      (not (boundp sym))
13885                      (null (symbol-value sym))
13886                      (gnus-gethash group gnus-killed-hashtb)
13887                      (gnus-gethash group gnus-newsrc-hashtb))
13888                  ()
13889                (let ((do-sub (gnus-matches-options-n group)))
13890                  (cond 
13891                   ((eq do-sub 'subscribe)
13892                    (setq groups (1+ groups))
13893                    (gnus-sethash group group gnus-killed-hashtb)
13894                    (funcall gnus-subscribe-options-newsgroup-method group))
13895                   ((eq do-sub 'ignore)
13896                    nil)
13897                   (t
13898                    (setq groups (1+ groups))
13899                    (gnus-sethash group group gnus-killed-hashtb)
13900                    (if gnus-subscribe-hierarchical-interactive
13901                        (setq new-newsgroups (cons group new-newsgroups))
13902                      (funcall gnus-subscribe-newsgroup-method group)))))))
13903            gnus-active-hashtb)
13904           (if new-newsgroups 
13905               (gnus-subscribe-hierarchical-interactive new-newsgroups))
13906           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
13907           (if (> groups 0)
13908               (gnus-message 6 "%d new newsgroup%s arrived." 
13909                             groups (if (> groups 1) "s have" " has"))
13910             (gnus-message 6 "No new newsgroups."))))))
13911
13912 (defun gnus-matches-options-n (group)
13913   ;; Returns `subscribe' if the group is to be uncoditionally
13914   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
13915   ;; no match for the group.
13916
13917   ;; First we check the two user variables.
13918   (cond
13919    ((and gnus-options-subscribe
13920          (string-match gnus-options-subscribe group))
13921     'subscribe)
13922    ((and gnus-auto-subscribed-groups 
13923          (string-match gnus-auto-subscribed-groups group))
13924     'subscribe)
13925    ((and gnus-options-not-subscribe
13926          (string-match gnus-options-not-subscribe group))
13927     'ignore)
13928    ;; Then we go through the list that was retrieved from the .newsrc
13929    ;; file.  This list has elements on the form 
13930    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
13931    ;; is in the reverse order of the options line) is returned.
13932    (t
13933     (let ((regs gnus-newsrc-options-n))
13934       (while (and regs
13935                   (not (string-match (car (car regs)) group)))
13936         (setq regs (cdr regs)))
13937       (and regs (cdr (car regs)))))))
13938
13939 (defun gnus-ask-server-for-new-groups ()
13940   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
13941          (methods (cons gnus-select-method 
13942                         (append
13943                          (and (consp gnus-check-new-newsgroups)
13944                               gnus-check-new-newsgroups)
13945                          gnus-secondary-select-methods)))
13946          (groups 0)
13947          (new-date (current-time-string))
13948          (hashtb (gnus-make-hashtable 100))
13949          group new-newsgroups got-new method)
13950     ;; Go through both primary and secondary select methods and
13951     ;; request new newsgroups.  
13952     (while methods
13953       (setq method (gnus-server-get-method nil (car methods)))
13954       (and (gnus-check-server method)
13955            (gnus-request-newgroups date method)
13956            (save-excursion
13957              (setq got-new t)
13958              (set-buffer nntp-server-buffer)
13959              ;; Enter all the new groups in a hashtable.
13960              (gnus-active-to-gnus-format method hashtb 'ignore)))
13961       (setq methods (cdr methods)))
13962     (and got-new (setq gnus-newsrc-last-checked-date new-date))
13963     ;; Now all new groups from all select methods are in `hashtb'.
13964     (mapatoms
13965      (lambda (group-sym)
13966        (setq group (symbol-name group-sym))
13967        (if (or (null group)
13968                (null (symbol-value group-sym))
13969                (gnus-gethash group gnus-newsrc-hashtb)
13970                (member group gnus-zombie-list)
13971                (member group gnus-killed-list))
13972            ;; The group is already known.
13973            ()
13974          (and (symbol-value group-sym)
13975               (gnus-set-active group (symbol-value group-sym)))
13976          (let ((do-sub (gnus-matches-options-n group)))
13977            (cond ((eq do-sub 'subscribe)
13978                   (setq groups (1+ groups))
13979                   (gnus-sethash group group gnus-killed-hashtb)
13980                   (funcall 
13981                    gnus-subscribe-options-newsgroup-method group))
13982                  ((eq do-sub 'ignore)
13983                   nil)
13984                  (t
13985                   (setq groups (1+ groups))
13986                   (gnus-sethash group group gnus-killed-hashtb)
13987                   (if gnus-subscribe-hierarchical-interactive
13988                       (setq new-newsgroups (cons group new-newsgroups))
13989                     (funcall gnus-subscribe-newsgroup-method group)))))))
13990      hashtb)
13991     (if new-newsgroups 
13992         (gnus-subscribe-hierarchical-interactive new-newsgroups))
13993     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
13994     (if (> groups 0)
13995         (gnus-message 6 "%d new newsgroup%s arrived." 
13996                       groups (if (> groups 1) "s have" " has")))
13997     got-new))
13998
13999 (defun gnus-check-first-time-used ()
14000   (if (or (> (length gnus-newsrc-alist) 1)
14001           (file-exists-p gnus-startup-file)
14002           (file-exists-p (concat gnus-startup-file ".el"))
14003           (file-exists-p (concat gnus-startup-file ".eld")))
14004       nil
14005     (gnus-message 6 "First time user; subscribing you to default groups")
14006     (or gnus-have-read-active-file (gnus-read-active-file))
14007     (setq gnus-newsrc-last-checked-date (current-time-string))
14008     (let ((groups gnus-default-subscribed-newsgroups)
14009           group)
14010       (if (eq groups t)
14011           nil
14012         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
14013         (mapatoms
14014          (lambda (sym)
14015            (if (null (setq group (symbol-name sym)))
14016                ()
14017              (let ((do-sub (gnus-matches-options-n group)))
14018                (cond 
14019                 ((eq do-sub 'subscribe)
14020                  (gnus-sethash group group gnus-killed-hashtb)
14021                  (funcall gnus-subscribe-options-newsgroup-method group))
14022                 ((eq do-sub 'ignore)
14023                  nil)
14024                 (t
14025                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
14026          gnus-active-hashtb)
14027         (while groups
14028           (if (gnus-active (car groups))
14029               (gnus-group-change-level 
14030                (car groups) gnus-level-default-subscribed gnus-level-killed))
14031           (setq groups (cdr groups)))
14032         (gnus-group-make-help-group)
14033         (and gnus-novice-user
14034              (gnus-message 7 "`A k' to list killed groups"))))))
14035
14036 (defun gnus-subscribe-group (group previous &optional method)
14037   (gnus-group-change-level 
14038    (if method
14039        (list t group gnus-level-default-subscribed nil nil method)
14040      group) 
14041    gnus-level-default-subscribed gnus-level-killed previous t))
14042
14043 ;; `gnus-group-change-level' is the fundamental function for changing
14044 ;; subscription levels of newsgroups.  This might mean just changing
14045 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
14046 ;; again, which subscribes/unsubscribes a group, which is equally
14047 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
14048 ;; from 8-9 to 1-7 means that you remove the group from the list of
14049 ;; killed (or zombie) groups and add them to the (kinda) subscribed
14050 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
14051 ;; which is trivial.
14052 ;; ENTRY can either be a string (newsgroup name) or a list (if
14053 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
14054 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
14055 ;; entries. 
14056 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
14057 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
14058 ;; after. 
14059 (defun gnus-group-change-level (entry level &optional oldlevel
14060                                       previous fromkilled)
14061   (let (group info active num)
14062     ;; Glean what info we can from the arguments
14063     (if (consp entry)
14064         (if fromkilled (setq group (nth 1 entry))
14065           (setq group (car (nth 2 entry))))
14066       (setq group entry))
14067     (if (and (stringp entry)
14068              oldlevel 
14069              (< oldlevel gnus-level-zombie))
14070         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
14071     (if (and (not oldlevel)
14072              (consp entry))
14073         (setq oldlevel (car (cdr (nth 2 entry)))))
14074     (if (stringp previous)
14075         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
14076
14077     (if (and (>= oldlevel gnus-level-zombie)
14078              (gnus-gethash group gnus-newsrc-hashtb))
14079         ;; We are trying to subscribe a group that is already
14080         ;; subscribed. 
14081         ()                              ; Do nothing. 
14082
14083       (or (gnus-ephemeral-group-p group)
14084           (gnus-dribble-enter
14085            (format "(gnus-group-change-level %S %S %S %S %S)" 
14086                    group level oldlevel (car (nth 2 previous)) fromkilled)))
14087     
14088       ;; Then we remove the newgroup from any old structures, if needed.
14089       ;; If the group was killed, we remove it from the killed or zombie
14090       ;; list.  If not, and it is in fact going to be killed, we remove
14091       ;; it from the newsrc hash table and assoc.
14092       (cond ((>= oldlevel gnus-level-zombie)
14093              (if (= oldlevel gnus-level-zombie)
14094                  (setq gnus-zombie-list (delete group gnus-zombie-list))
14095                (setq gnus-killed-list (delete group gnus-killed-list))))
14096             (t
14097              (if (and (>= level gnus-level-zombie)
14098                       entry)
14099                  (progn
14100                    (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
14101                    (if (nth 3 entry)
14102                        (setcdr (gnus-gethash (car (nth 3 entry))
14103                                              gnus-newsrc-hashtb)
14104                                (cdr entry)))
14105                    (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
14106
14107       ;; Finally we enter (if needed) the list where it is supposed to
14108       ;; go, and change the subscription level.  If it is to be killed,
14109       ;; we enter it into the killed or zombie list.
14110       (cond ((>= level gnus-level-zombie)
14111              ;; Remove from the hash table.
14112              (gnus-sethash group nil gnus-newsrc-hashtb)
14113              ;; We do not enter foreign groups into the list of dead
14114              ;; groups.  
14115              (unless (gnus-group-foreign-p group)
14116                (if (= level gnus-level-zombie)
14117                    (setq gnus-zombie-list (cons group gnus-zombie-list))
14118                  (setq gnus-killed-list (cons group gnus-killed-list)))))
14119             (t
14120              ;; If the list is to be entered into the newsrc assoc, and
14121              ;; it was killed, we have to create an entry in the newsrc
14122              ;; hashtb format and fix the pointers in the newsrc assoc.
14123              (if (>= oldlevel gnus-level-zombie)
14124                  (progn
14125                    (if (listp entry)
14126                        (progn
14127                          (setq info (cdr entry))
14128                          (setq num (car entry)))
14129                      (setq active (gnus-active group))
14130                      (setq num 
14131                            (if active (- (1+ (cdr active)) (car active)) t))
14132                      ;; Check whether the group is foreign.  If so, the
14133                      ;; foreign select method has to be entered into the
14134                      ;; info. 
14135                      (let ((method (gnus-group-method-name group)))
14136                        (if (eq method gnus-select-method)
14137                            (setq info (list group level nil))
14138                          (setq info (list group level nil nil method)))))
14139                    (or previous 
14140                        (setq previous 
14141                              (let ((p gnus-newsrc-alist))
14142                                (while (cdr (cdr p))
14143                                  (setq p (cdr p)))
14144                                p)))
14145                    (setq entry (cons info (cdr (cdr previous))))
14146                    (if (cdr previous)
14147                        (progn
14148                          (setcdr (cdr previous) entry)
14149                          (gnus-sethash group (cons num (cdr previous)) 
14150                                        gnus-newsrc-hashtb))
14151                      (setcdr previous entry)
14152                      (gnus-sethash group (cons num previous)
14153                                    gnus-newsrc-hashtb))
14154                    (if (cdr entry)
14155                        (setcdr (gnus-gethash (car (car (cdr entry)))
14156                                              gnus-newsrc-hashtb)
14157                                entry)))
14158                ;; It was alive, and it is going to stay alive, so we
14159                ;; just change the level and don't change any pointers or
14160                ;; hash table entries.
14161                (setcar (cdr (car (cdr (cdr entry)))) level)))))))
14162
14163 (defun gnus-kill-newsgroup (newsgroup)
14164   "Obsolete function.  Kills a newsgroup."
14165   (gnus-group-change-level
14166    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
14167
14168 (defun gnus-check-bogus-newsgroups (&optional confirm)
14169   "Remove bogus newsgroups.
14170 If CONFIRM is non-nil, the user has to confirm the deletion of every
14171 newsgroup." 
14172   (let ((newsrc (cdr gnus-newsrc-alist))
14173         bogus group entry info)
14174     (gnus-message 5 "Checking bogus newsgroups...")
14175     (unless gnus-have-read-active-file 
14176       (gnus-read-active-file))
14177     (when (member gnus-select-method gnus-have-read-active-file)
14178       ;; Find all bogus newsgroup that are subscribed.
14179       (while newsrc
14180         (setq info (pop newsrc)
14181               group (gnus-info-group info))
14182         (unless (or (gnus-active group) ; Active
14183                     (gnus-info-method info) ; Foreign
14184                     (and confirm
14185                          (not (gnus-y-or-n-p
14186                                (format "Remove bogus newsgroup: %s " group)))))
14187           ;; Found a bogus newsgroup.
14188           (push group bogus)))
14189       ;; Remove all bogus subscribed groups by first killing them, and
14190       ;; then removing them from the list of killed groups.
14191       (while bogus
14192         (when (setq entry (gnus-gethash (setq group (pop bogus))
14193                                         gnus-newsrc-hashtb))
14194           (gnus-group-change-level entry gnus-level-killed)
14195           (setq gnus-killed-list (delete group gnus-killed-list))))
14196       ;; Then we remove all bogus groups from the list of killed and
14197       ;; zombie groups.  They are are removed without confirmation.
14198       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
14199             killed)
14200         (while dead-lists
14201           (setq killed (symbol-value (car dead-lists)))
14202           (while killed
14203             (unless (gnus-active (setq group (pop killed)))
14204               ;; The group is bogus.
14205               ;; !!!Slow as hell.
14206               (set (car dead-lists)
14207                    (delete group (symbol-value (car dead-lists))))))
14208           (setq dead-lists (cdr dead-lists))))
14209       (gnus-message 5 "Checking bogus newsgroups...done"))))
14210
14211 (defun gnus-check-duplicate-killed-groups ()
14212   "Remove duplicates from the list of killed groups."
14213   (interactive)
14214   (let ((killed gnus-killed-list))
14215     (while killed
14216       (gnus-message 9 "%d" (length killed))
14217       (setcdr killed (delete (car killed) (cdr killed)))
14218       (setq killed (cdr killed)))))
14219
14220 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
14221 ;; and compute how many unread articles there are in each group.
14222 (defun gnus-get-unread-articles (&optional level) 
14223   (let* ((newsrc (cdr gnus-newsrc-alist))
14224          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
14225          (foreign-level
14226           (min 
14227            (cond ((and gnus-activate-foreign-newsgroups 
14228                        (not (numberp gnus-activate-foreign-newsgroups)))
14229                   (1+ gnus-level-subscribed))
14230                  ((numberp gnus-activate-foreign-newsgroups)
14231                   gnus-activate-foreign-newsgroups)
14232                  (t 0))
14233            level))
14234          (update
14235           (fboundp (intern (format "%s-request-update-info"
14236                                    (car gnus-select-method)))))
14237          info group active virtuals method fmethod)
14238     (gnus-message 5 "Checking new news...")
14239
14240     (while newsrc
14241       (setq info (car newsrc)
14242             group (gnus-info-group info)
14243             active (gnus-active group))
14244
14245       ;; Check newsgroups.  If the user doesn't want to check them, or
14246       ;; they can't be checked (for instance, if the news server can't
14247       ;; be reached) we just set the number of unread articles in this
14248       ;; newsgroup to t.  This means that Gnus thinks that there are
14249       ;; unread articles, but it has no idea how many.
14250       (if (and (setq method (gnus-info-method info))
14251                (not (gnus-server-equal
14252                      gnus-select-method
14253                      (prog1
14254                          (setq fmethod (gnus-server-get-method nil method))
14255                        ;; We do this here because it would be awkward
14256                        ;; to do it anywhere else.  Hell, it's pretty
14257                        ;; awkward here as well, but at least it's
14258                        ;; reasonably efficient. 
14259                        (and (<= (gnus-info-level info) foreign-level)
14260                             (gnus-request-update-info info method)))))
14261                (not (gnus-secondary-method-p method)))
14262           ;; These groups are foreign.  Check the level.
14263           (if (<= (gnus-info-level info) foreign-level)
14264               (setq active (gnus-activate-group (gnus-info-group info) 'scan)))
14265
14266         ;; These groups are native or secondary. 
14267         (if (<= (gnus-info-level info) level)
14268             (progn
14269               (if (and update (not method))
14270                   (progn
14271                     ;; Allow updating of native groups as well, even
14272                     ;; though that's pretty unlikely.
14273                     (gnus-request-update-info info gnus-select-method)
14274                     (setq active (gnus-activate-group 
14275                                   (gnus-info-group info) 'scan)))
14276                 (or gnus-read-active-file
14277                     (setq active (gnus-activate-group 
14278                                   (gnus-info-group info) 'scan)))))))
14279       
14280       (if active
14281           (gnus-get-unread-articles-in-group info active)
14282         ;; The group couldn't be reached, so we nix out the number of
14283         ;; unread articles and stuff.
14284         (gnus-set-active group nil)
14285         (setcar (gnus-gethash group gnus-newsrc-hashtb) t))
14286       
14287       (setq newsrc (cdr newsrc)))
14288
14289     (gnus-message 5 "Checking new news...done")))
14290
14291 ;; Create a hash table out of the newsrc alist.  The `car's of the
14292 ;; alist elements are used as keys.
14293 (defun gnus-make-hashtable-from-newsrc-alist ()
14294   (let ((alist gnus-newsrc-alist)
14295         (ohashtb gnus-newsrc-hashtb)
14296         prev)
14297     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
14298     (setq alist 
14299           (setq prev (setq gnus-newsrc-alist 
14300                            (if (equal (car (car gnus-newsrc-alist))
14301                                       "dummy.group")
14302                                gnus-newsrc-alist
14303                              (cons (list "dummy.group" 0 nil) alist)))))
14304     (while alist
14305       (gnus-sethash 
14306        (car (car alist)) 
14307        (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb))) 
14308              prev)
14309        gnus-newsrc-hashtb)
14310       (setq prev alist
14311             alist (cdr alist)))))
14312
14313 (defun gnus-make-hashtable-from-killed ()
14314   "Create a hash table from the killed and zombie lists."
14315   (let ((lists '(gnus-killed-list gnus-zombie-list))
14316         list)
14317     (setq gnus-killed-hashtb 
14318           (gnus-make-hashtable 
14319            (+ (length gnus-killed-list) (length gnus-zombie-list))))
14320     (while lists
14321       (setq list (symbol-value (car lists)))
14322       (setq lists (cdr lists))
14323       (while list
14324         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
14325         (setq list (cdr list))))))
14326
14327 (defun gnus-get-unread-articles-in-group (info active)
14328   (let* ((range (gnus-info-read info))
14329          (num 0)
14330          (marked (gnus-info-marks info)))
14331     ;; If a cache is present, we may have to alter the active info.
14332     (and gnus-use-cache
14333          (gnus-cache-possibly-alter-active (gnus-info-group info) active))
14334     ;; Modify the list of read articles according to what articles 
14335     ;; are available; then tally the unread articles and add the
14336     ;; number to the group hash table entry.
14337     (cond 
14338      ((zerop (cdr active))
14339       (setq num 0))
14340      ((not range)
14341       (setq num (- (1+ (cdr active)) (car active))))
14342      ((not (listp (cdr range)))
14343       ;; Fix a single (num . num) range according to the
14344       ;; active hash table.
14345       ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
14346       (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
14347       (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
14348       ;; Compute number of unread articles.
14349       (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
14350      (t
14351       ;; The read list is a list of ranges.  Fix them according to
14352       ;; the active hash table.
14353       ;; First peel off any elements that are below the lower
14354       ;; active limit. 
14355       (while (and (cdr range) 
14356                   (>= (car active) 
14357                       (or (and (atom (car (cdr range))) (car (cdr range)))
14358                           (car (car (cdr range))))))
14359         (if (numberp (car range))
14360             (setcar range 
14361                     (cons (car range) 
14362                           (or (and (numberp (car (cdr range)))
14363                                    (car (cdr range))) 
14364                               (cdr (car (cdr range))))))
14365           (setcdr (car range) 
14366                   (or (and (numberp (nth 1 range)) (nth 1 range))
14367                       (cdr (car (cdr range))))))
14368         (setcdr range (cdr (cdr range))))
14369       ;; Adjust the first element to be the same as the lower limit. 
14370       (if (and (not (atom (car range))) 
14371                (< (cdr (car range)) (car active)))
14372           (setcdr (car range) (1- (car active))))
14373       ;; Then we want to peel off any elements that are higher
14374       ;; than the upper active limit.  
14375       (let ((srange range))
14376         ;; Go past all legal elements.
14377         (while (and (cdr srange) 
14378                     (<= (or (and (atom (car (cdr srange)))
14379                                  (car (cdr srange)))
14380                             (car (car (cdr srange)))) (cdr active)))
14381           (setq srange (cdr srange)))
14382         (if (cdr srange)
14383             ;; Nuke all remaining illegal elements.
14384             (setcdr srange nil))
14385
14386         ;; Adjust the final element.
14387         (if (and (not (atom (car srange)))
14388                  (> (cdr (car srange)) (cdr active)))
14389             (setcdr (car srange) (cdr active))))
14390       ;; Compute the number of unread articles.
14391       (while range
14392         (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
14393                                     (cdr (car range))))
14394                             (or (and (atom (car range)) (car range))
14395                                 (car (car range))))))
14396         (setq range (cdr range)))
14397       (setq num (max 0 (- (cdr active) num)))))
14398     ;; Set the number of unread articles.
14399     (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)
14400     num))
14401
14402 (defun gnus-activate-group (group &optional scan)
14403   ;; Check whether a group has been activated or not.
14404   ;; If SCAN, request a scan of that group as well.
14405   (let ((method (gnus-find-method-for-group group))
14406         active)
14407     (and (gnus-check-server method)
14408          ;; We escape all bugs and quit here to make it possible to
14409          ;; continue if a group is so out-there that it reports bugs
14410          ;; and stuff.
14411          (progn
14412            (and scan
14413                 (gnus-check-backend-function 'request-scan (car method))
14414                 (gnus-request-scan group method))
14415            t)
14416          (condition-case ()
14417              (gnus-request-group group)
14418         ;   (error nil)
14419            (quit nil))
14420          (save-excursion
14421            (set-buffer nntp-server-buffer)
14422            (goto-char (point-min))
14423            ;; Parse the result we got from `gnus-request-group'.
14424            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
14425                 (progn
14426                   (goto-char (match-beginning 1))
14427                   (gnus-set-active 
14428                    group (setq active (cons (read (current-buffer))
14429                                             (read (current-buffer)))))
14430                   ;; Return the new active info.
14431                   active))))))
14432
14433 (defun gnus-update-read-articles (group unread)
14434   "Update the list of read and ticked articles in GROUP using the
14435 UNREAD and TICKED lists.
14436 Note: UNSELECTED has to be sorted over `<'.
14437 Returns whether the updating was successful."
14438   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
14439          (entry (gnus-gethash group gnus-newsrc-hashtb))
14440          (info (nth 2 entry))
14441          (marked (gnus-info-marks info))
14442          (prev 1)
14443          (unread (sort (copy-sequence unread) '<))
14444          read)
14445     (if (or (not info) (not active))
14446         ;; There is no info on this group if it was, in fact,
14447         ;; killed.  Gnus stores no information on killed groups, so
14448         ;; there's nothing to be done. 
14449         ;; One could store the information somewhere temporarily,
14450         ;; perhaps...  Hmmm... 
14451         ()
14452       ;; Remove any negative articles numbers.
14453       (while (and unread (< (car unread) 0))
14454         (setq unread (cdr unread)))
14455       ;; Remove any expired article numbers
14456       (while (and unread (< (car unread) (car active)))
14457         (setq unread (cdr unread)))
14458       ;; Compute the ranges of read articles by looking at the list of
14459       ;; unread articles.  
14460       (while unread
14461         (if (/= (car unread) prev)
14462             (setq read (cons (if (= prev (1- (car unread))) prev
14463                                (cons prev (1- (car unread)))) read)))
14464         (setq prev (1+ (car unread)))
14465         (setq unread (cdr unread)))
14466       (when (<= prev (cdr active))
14467         (setq read (cons (cons prev (cdr active)) read)))
14468       ;; Enter this list into the group info.
14469       (gnus-info-set-read 
14470        info (if (> (length read) 1) (nreverse read) read))
14471       ;; Set the number of unread articles in gnus-newsrc-hashtb.
14472       (gnus-get-unread-articles-in-group info (gnus-active group))
14473       t)))
14474
14475 (defun gnus-make-articles-unread (group articles)
14476   "Mark ARTICLES in GROUP as unread."
14477   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
14478                           (gnus-gethash (gnus-group-real-name group)
14479                                         gnus-newsrc-hashtb))))
14480          (ranges (gnus-info-read info))
14481          news article)
14482     (while articles
14483       (when (gnus-member-of-range 
14484              (setq article (pop articles)) ranges)
14485         (setq news (cons article news))))
14486     (when news
14487       (gnus-info-set-read 
14488        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
14489       (gnus-group-update-group group t))))
14490
14491 ;; Enter all dead groups into the hashtb.
14492 (defun gnus-update-active-hashtb-from-killed ()
14493   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
14494         (lists (list gnus-killed-list gnus-zombie-list))
14495         killed)
14496     (while lists
14497       (setq killed (car lists))
14498       (while killed
14499         (gnus-sethash (car killed) nil hashtb)
14500         (setq killed (cdr killed)))
14501       (setq lists (cdr lists)))))
14502
14503 ;; Get the active file(s) from the backend(s).
14504 (defun gnus-read-active-file ()
14505   (gnus-group-set-mode-line)
14506   (let ((methods (if (gnus-check-server gnus-select-method)
14507                      ;; The native server is available.
14508                      (cons gnus-select-method gnus-secondary-select-methods)
14509                    ;; The native server is down, so we just do the
14510                    ;; secondary ones.   
14511                    gnus-secondary-select-methods))
14512         list-type)
14513     (setq gnus-have-read-active-file nil)
14514     (save-excursion
14515       (set-buffer nntp-server-buffer)
14516       (while methods
14517         (let* ((method (gnus-server-get-method nil (car methods)))
14518                (where (nth 1 method))
14519                (mesg (format "Reading active file%s via %s..."
14520                              (if (and where (not (zerop (length where))))
14521                                  (concat " from " where) "")
14522                              (car method))))
14523           (gnus-message 5 mesg)
14524           (if (not (gnus-check-server method))
14525               ()
14526             ;; Request that the backend scan its incoming messages.
14527             (and (gnus-check-backend-function 'request-scan (car method))
14528                  (gnus-request-scan nil method))
14529             (cond 
14530              ((and (eq gnus-read-active-file 'some)
14531                    (gnus-check-backend-function 'retrieve-groups (car method)))
14532               (let ((newsrc (cdr gnus-newsrc-alist))
14533                     (gmethod (gnus-server-get-method nil method))
14534                     groups)
14535                 (while newsrc
14536                   (and (gnus-server-equal 
14537                         (gnus-find-method-for-group 
14538                          (car (car newsrc)) (car newsrc))
14539                         gmethod)
14540                        (setq groups (cons (gnus-group-real-name 
14541                                            (car (car newsrc))) groups)))
14542                   (setq newsrc (cdr newsrc)))
14543                 (gnus-check-server method)
14544                 (setq list-type (gnus-retrieve-groups groups method))
14545                 (cond 
14546                  ((not list-type)
14547                   (gnus-message 
14548                    1 "Cannot read partial active file from %s server." 
14549                    (car method))
14550                   (ding)
14551                   (sit-for 2))
14552                  ((eq list-type 'active)
14553                   (gnus-active-to-gnus-format method gnus-active-hashtb))
14554                  (t
14555                   (gnus-groups-to-gnus-format method gnus-active-hashtb)))))
14556              (t
14557               (if (not (gnus-request-list method))
14558                   (progn
14559                     (gnus-message 1 "Cannot read active file from %s server." 
14560                                   (car method))
14561                     (ding))
14562                 (gnus-active-to-gnus-format method)
14563                 ;; We mark this active file as read.
14564                 (setq gnus-have-read-active-file
14565                       (cons method gnus-have-read-active-file))
14566                 (gnus-message 5 "%sdone" mesg))))))
14567         (setq methods (cdr methods))))))
14568
14569 ;; Read an active file and place the results in `gnus-active-hashtb'.
14570 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
14571   (unless method
14572     (setq method gnus-select-method))
14573   (let ((cur (current-buffer))
14574         (hashtb (or hashtb 
14575                     (if (and gnus-active-hashtb 
14576                              (not (equal method gnus-select-method)))
14577                         gnus-active-hashtb
14578                       (setq gnus-active-hashtb
14579                             (if (equal method gnus-select-method)
14580                                 (gnus-make-hashtable 
14581                                  (count-lines (point-min) (point-max)))
14582                               (gnus-make-hashtable 4096))))))
14583         (flag-hashtb (gnus-make-hashtable 60)))
14584     ;; Delete unnecessary lines.
14585     (goto-char (point-min))
14586     (while (search-forward "\nto." nil t)
14587       (delete-region (1+ (match-beginning 0)) 
14588                      (progn (forward-line 1) (point))))
14589     (or (string= gnus-ignored-newsgroups "")
14590         (progn
14591           (goto-char (point-min))
14592           (delete-matching-lines gnus-ignored-newsgroups)))
14593     ;; Make the group names readable as a lisp expression even if they
14594     ;; contain special characters.
14595     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
14596     (goto-char (point-max))
14597     (while (re-search-backward "[][';?()#]" nil t)
14598       (insert ?\\))
14599     ;; If these are groups from a foreign select method, we insert the
14600     ;; group prefix in front of the group names. 
14601     (and method (not (gnus-server-equal
14602                       (gnus-server-get-method nil method)
14603                       (gnus-server-get-method nil gnus-select-method)))
14604          (let ((prefix (gnus-group-prefixed-name "" method)))
14605            (goto-char (point-min))
14606            (while (and (not (eobp))
14607                        (progn (insert prefix)
14608                               (zerop (forward-line 1)))))))
14609     ;; Store the active file in a hash table.
14610     (goto-char (point-min))
14611     (if (string-match "%[oO]" gnus-group-line-format)
14612         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
14613         ;; If we want information on moderated groups, we use this
14614         ;; loop...   
14615         (let* ((mod-hashtb (make-vector 7 0))
14616                (m (intern "m" mod-hashtb))
14617                group max min)
14618           (while (not (eobp))
14619             (condition-case nil
14620                 (progn
14621                   (narrow-to-region (point) (gnus-point-at-eol))
14622                   (setq group (let ((obarray hashtb)) (read cur)))
14623                   (if (and (numberp (setq max (read cur)))
14624                            (numberp (setq min (read cur)))
14625                            (progn 
14626                              (skip-chars-forward " \t")
14627                              (not
14628                               (or (= (following-char) ?=)
14629                                   (= (following-char) ?x)
14630                                   (= (following-char) ?j)))))
14631                       (set group (cons min max))
14632                     (set group nil))
14633                   ;; Enter moderated groups into a list.
14634                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
14635                       (setq gnus-moderated-list 
14636                             (cons (symbol-name group) gnus-moderated-list))))
14637               (error 
14638                (and group
14639                     (symbolp group)
14640                     (set group nil))))
14641             (widen)
14642             (forward-line 1)))
14643       ;; And if we do not care about moderation, we use this loop,
14644       ;; which is faster.
14645       (let (group max min)
14646         (while (not (eobp))
14647           (condition-case ()
14648               (progn
14649                 (narrow-to-region (point) (gnus-point-at-eol))
14650                 ;; group gets set to a symbol interned in the hash table
14651                 ;; (what a hack!!) - jwz
14652                 (setq group (let ((obarray hashtb)) (read cur)))
14653                 (if (and (numberp (setq max (read cur)))
14654                          (numberp (setq min (read cur)))
14655                          (progn 
14656                            (skip-chars-forward " \t")
14657                            (not
14658                             (or (= (following-char) ?=)
14659                                 (= (following-char) ?x)
14660                                 (= (following-char) ?j)))))
14661                     (set group (cons min max))
14662                   (set group nil)))
14663             (error 
14664              (progn 
14665                (and group
14666                     (symbolp group)
14667                     (set group nil))
14668                (or ignore-errors
14669                    (gnus-message 3 "Warning - illegal active: %s"
14670                                  (buffer-substring 
14671                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
14672           (widen)
14673           (forward-line 1))))))
14674
14675 (defun gnus-groups-to-gnus-format (method &optional hashtb)
14676   ;; Parse a "groups" active file.
14677   (let ((cur (current-buffer))
14678         (hashtb (or hashtb 
14679                     (if (and method gnus-active-hashtb)
14680                         gnus-active-hashtb
14681                       (setq gnus-active-hashtb
14682                             (gnus-make-hashtable 
14683                              (count-lines (point-min) (point-max)))))))
14684         (prefix (and method 
14685                      (not (gnus-server-equal
14686                            (gnus-server-get-method nil method)
14687                            (gnus-server-get-method nil gnus-select-method)))
14688                      (gnus-group-prefixed-name "" method))))
14689
14690     (goto-char (point-min))
14691     ;; We split this into to separate loops, one with the prefix
14692     ;; and one without to speed the reading up somewhat.
14693     (if prefix
14694         (let (min max opoint group)
14695           (while (not (eobp))
14696             (condition-case ()
14697                 (progn
14698                   (read cur) (read cur)
14699                   (setq min (read cur)
14700                         max (read cur)
14701                         opoint (point))
14702                   (skip-chars-forward " \t")
14703                   (insert prefix)
14704                   (goto-char opoint)
14705                   (set (let ((obarray hashtb)) (read cur)) 
14706                        (cons min max)))
14707               (error (and group (symbolp group) (set group nil))))
14708             (forward-line 1)))
14709       (let (min max group)
14710         (while (not (eobp))
14711           (condition-case ()
14712               (if (= (following-char) ?2)
14713                   (progn
14714                     (read cur) (read cur)
14715                     (setq min (read cur)
14716                           max (read cur))
14717                     (set (setq group (let ((obarray hashtb)) (read cur)))
14718                          (cons min max))))
14719             (error (and group (symbolp group) (set group nil))))
14720           (forward-line 1))))))
14721
14722 (defun gnus-read-newsrc-file (&optional force)
14723   "Read startup file.
14724 If FORCE is non-nil, the .newsrc file is read."
14725   ;; Reset variables that might be defined in the .newsrc.eld file.
14726   (let ((variables gnus-variable-list))
14727     (while variables
14728       (set (car variables) nil)
14729       (setq variables (cdr variables))))
14730   (let* ((newsrc-file gnus-current-startup-file)
14731          (quick-file (concat newsrc-file ".el")))
14732     (save-excursion
14733       ;; We always load the .newsrc.eld file.  If always contains
14734       ;; much information that can not be gotten from the .newsrc
14735       ;; file (ticked articles, killed groups, foreign methods, etc.)
14736       (gnus-read-newsrc-el-file quick-file)
14737  
14738       (if (or force
14739               (and (file-newer-than-file-p newsrc-file quick-file)
14740                    (file-newer-than-file-p newsrc-file 
14741                                            (concat quick-file "d")))
14742               (not gnus-newsrc-alist))
14743           ;; We read the .newsrc file.  Note that if there if a
14744           ;; .newsrc.eld file exists, it has already been read, and
14745           ;; the `gnus-newsrc-hashtb' has been created.  While reading
14746           ;; the .newsrc file, Gnus will only use the information it
14747           ;; can find there for changing the data already read -
14748           ;; ie. reading the .newsrc file will not trash the data
14749           ;; already read (except for read articles).
14750           (save-excursion
14751             (gnus-message 5 "Reading %s..." newsrc-file)
14752             (set-buffer (find-file-noselect newsrc-file))
14753             (buffer-disable-undo (current-buffer))
14754             (gnus-newsrc-to-gnus-format)
14755             (kill-buffer (current-buffer))
14756             (gnus-message 5 "Reading %s...done" newsrc-file)))
14757
14758       ;; Read any slave files.
14759       (or gnus-slave
14760           (gnus-master-read-slave-newsrc)))))
14761
14762 (defun gnus-read-newsrc-el-file (file)
14763   (let ((ding-file (concat file "d")))
14764     ;; We always, always read the .eld file.
14765     (gnus-message 5 "Reading %s..." ding-file)
14766     (let (gnus-newsrc-assoc)
14767       (condition-case nil
14768           (load ding-file t t t)
14769         (error
14770          (gnus-message 1 "Error in %s" ding-file)
14771          (ding)))
14772       (when gnus-newsrc-assoc 
14773         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
14774     (gnus-make-hashtable-from-newsrc-alist)
14775     (when (file-newer-than-file-p file ding-file)
14776       ;; Old format quick file
14777       (gnus-message 5 "Reading %s..." file)
14778       ;; The .el file is newer than the .eld file, so we read that one
14779       ;; as well. 
14780       (gnus-read-old-newsrc-el-file file))))
14781
14782 ;; Parse the old-style quick startup file
14783 (defun gnus-read-old-newsrc-el-file (file)
14784   (let (newsrc killed marked group m)
14785     (prog1
14786         (let ((gnus-killed-assoc nil)
14787               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
14788           (prog1
14789               (condition-case nil
14790                   (load file t t t)
14791                 (error nil))
14792             (setq newsrc gnus-newsrc-assoc
14793                   killed gnus-killed-assoc
14794                   marked gnus-marked-assoc)))
14795       (setq gnus-newsrc-alist nil)
14796       (while newsrc
14797         (setq group (car newsrc))
14798         (let ((info (gnus-get-info (car group))))
14799           (if info
14800               (progn
14801                 (gnus-info-set-read info (cdr (cdr group)))
14802                 (gnus-info-set-level
14803                  info (if (nth 1 group) gnus-level-default-subscribed 
14804                         gnus-level-default-unsubscribed))
14805                 (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
14806             (setq gnus-newsrc-alist
14807                   (cons 
14808                    (setq info
14809                          (list (car group)
14810                                (if (nth 1 group) gnus-level-default-subscribed
14811                                  gnus-level-default-unsubscribed) 
14812                                (cdr (cdr group))))
14813                    gnus-newsrc-alist)))
14814           (if (setq m (assoc (car group) marked))
14815               (gnus-info-set-marks 
14816                info (cons (list (cons 'tick (gnus-compress-sequence
14817                                              (sort (cdr m) '<) t)))
14818                           nil))))
14819         (setq newsrc (cdr newsrc)))
14820       (setq newsrc killed)
14821       (while newsrc
14822         (setcar newsrc (car (car newsrc)))
14823         (setq newsrc (cdr newsrc)))
14824       (setq gnus-killed-list killed))
14825     ;; The .el file version of this variable does not begin with
14826     ;; "options", while the .eld version does, so we just add it if it
14827     ;; isn't there.
14828     (and
14829      gnus-newsrc-options 
14830      (progn
14831        (and (not (string-match "^ *options" gnus-newsrc-options))
14832             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
14833        (and (not (string-match "\n$" gnus-newsrc-options))
14834             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
14835        ;; Finally, if we read some options lines, we parse them.
14836        (or (string= gnus-newsrc-options "")
14837            (gnus-newsrc-parse-options gnus-newsrc-options))))
14838
14839     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
14840     (gnus-make-hashtable-from-newsrc-alist)))
14841       
14842 (defun gnus-make-newsrc-file (file)
14843   "Make server dependent file name by catenating FILE and server host name."
14844   (let* ((file (expand-file-name file nil))
14845          (real-file (concat file "-" (nth 1 gnus-select-method))))
14846     (if (or (file-exists-p real-file)
14847             (file-exists-p (concat real-file ".el"))
14848             (file-exists-p (concat real-file ".eld")))
14849         real-file file)))
14850
14851 (defun gnus-newsrc-to-gnus-format ()
14852   (setq gnus-newsrc-options "")
14853   (setq gnus-newsrc-options-n nil)
14854
14855   (or gnus-active-hashtb
14856       (setq gnus-active-hashtb (make-vector 4095 0)))
14857   (let ((buf (current-buffer))
14858         (already-read (> (length gnus-newsrc-alist) 1))
14859         group subscribed options-symbol newsrc Options-symbol
14860         symbol reads num1)
14861     (goto-char (point-min))
14862     ;; We intern the symbol `options' in the active hashtb so that we
14863     ;; can `eq' against it later.
14864     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
14865     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
14866   
14867     (while (not (eobp))
14868       ;; We first read the first word on the line by narrowing and
14869       ;; then reading into `gnus-active-hashtb'.  Most groups will
14870       ;; already exist in that hashtb, so this will save some string
14871       ;; space.
14872       (narrow-to-region
14873        (point)
14874        (progn (skip-chars-forward "^ \t!:\n") (point)))
14875       (goto-char (point-min))
14876       (setq symbol 
14877             (and (/= (point-min) (point-max))
14878                  (let ((obarray gnus-active-hashtb)) (read buf))))
14879       (widen)
14880       ;; Now, the symbol we have read is either `options' or a group
14881       ;; name.  If it is an options line, we just add it to a string. 
14882       (cond 
14883        ((or (eq symbol options-symbol)
14884             (eq symbol Options-symbol))
14885         (setq gnus-newsrc-options
14886               ;; This concatting is quite inefficient, but since our
14887               ;; thorough studies show that approx 99.37% of all
14888               ;; .newsrc files only contain a single options line, we
14889               ;; don't give a damn, frankly, my dear.
14890               (concat gnus-newsrc-options
14891                       (buffer-substring 
14892                        (gnus-point-at-bol)
14893                        ;; Options may continue on the next line.
14894                        (or (and (re-search-forward "^[^ \t]" nil 'move)
14895                                 (progn (beginning-of-line) (point)))
14896                            (point)))))
14897         (forward-line -1))
14898        (symbol
14899         (or (boundp symbol) (set symbol nil))
14900         ;; It was a group name.
14901         (setq subscribed (= (following-char) ?:)
14902               group (symbol-name symbol)
14903               reads nil)
14904         (if (eolp)
14905             ;; If the line ends here, this is clearly a buggy line, so
14906             ;; we put point a the beginning of line and let the cond
14907             ;; below do the error handling.
14908             (beginning-of-line)
14909           ;; We skip to the beginning of the ranges.
14910           (skip-chars-forward "!: \t"))
14911         ;; We are now at the beginning of the list of read articles.
14912         ;; We read them range by range.
14913         (while
14914             (cond 
14915              ((looking-at "[0-9]+")
14916               ;; We narrow and read a number instead of buffer-substring/
14917               ;; string-to-int because it's faster.  narrow/widen is
14918               ;; faster than save-restriction/narrow, and save-restriction
14919               ;; produces a garbage object.
14920               (setq num1 (progn
14921                            (narrow-to-region (match-beginning 0) (match-end 0))
14922                            (read buf)))
14923               (widen)
14924               ;; If the next character is a dash, then this is a range.
14925               (if (= (following-char) ?-)
14926                   (progn
14927                     ;; We read the upper bound of the range.
14928                     (forward-char 1)
14929                     (if (not (looking-at "[0-9]+"))
14930                         ;; This is a buggy line, by we pretend that
14931                         ;; it's kinda OK.  Perhaps the user should be
14932                         ;; dinged? 
14933                         (setq reads (cons num1 reads))
14934                       (setq reads 
14935                             (cons 
14936                              (cons num1
14937                                    (progn
14938                                      (narrow-to-region (match-beginning 0) 
14939                                                        (match-end 0))
14940                                      (read buf)))
14941                              reads))
14942                       (widen)))
14943                 ;; It was just a simple number, so we add it to the
14944                 ;; list of ranges.
14945                 (setq reads (cons num1 reads)))
14946               ;; If the next char in ?\n, then we have reached the end
14947               ;; of the line and return nil.
14948               (/= (following-char) ?\n))
14949              ((= (following-char) ?\n)
14950               ;; End of line, so we end.
14951               nil)
14952              (t
14953               ;; Not numbers and not eol, so this might be a buggy
14954               ;; line... 
14955               (or (eobp)                
14956                   ;; If it was eob instead of ?\n, we allow it.
14957                   (progn
14958                     ;; The line was buggy.
14959                     (setq group nil)
14960                     (gnus-message 3 "Mangled line: %s" 
14961                                   (buffer-substring (gnus-point-at-bol) 
14962                                                     (gnus-point-at-eol)))
14963                     (ding)
14964                     (sit-for 1)))
14965               nil))
14966           ;; Skip past ", ".  Spaces are illegal in these ranges, but
14967           ;; we allow them, because it's a common mistake to put a
14968           ;; space after the comma.
14969           (skip-chars-forward ", "))
14970
14971         ;; We have already read .newsrc.eld, so we gently update the
14972         ;; data in the hash table with the information we have just
14973         ;; read. 
14974         (when group
14975           (let ((info (gnus-get-info group))
14976                 level)
14977             (if info
14978                 ;; There is an entry for this file in the alist.
14979                 (progn
14980                   (gnus-info-set-read info (nreverse reads))
14981                   ;; We update the level very gently.  In fact, we
14982                   ;; only change it if there's been a status change
14983                   ;; from subscribed to unsubscribed, or vice versa.
14984                   (setq level (gnus-info-level info))
14985                   (cond ((and (<= level gnus-level-subscribed)
14986                               (not subscribed))
14987                          (setq level (if reads
14988                                          gnus-level-default-unsubscribed 
14989                                        (1+ gnus-level-default-unsubscribed))))
14990                         ((and (> level gnus-level-subscribed) subscribed)
14991                          (setq level gnus-level-default-subscribed)))
14992                   (gnus-info-set-level info level))
14993               ;; This is a new group.
14994               (setq info (list group 
14995                                (if subscribed
14996                                    gnus-level-default-subscribed 
14997                                  (if reads
14998                                      (1+ gnus-level-subscribed)
14999                                    gnus-level-default-unsubscribed))
15000                                (nreverse reads))))
15001             (setq newsrc (cons info newsrc))))))
15002       (forward-line 1))
15003     
15004     (setq newsrc (nreverse newsrc))
15005
15006     (if (not already-read)
15007         ()
15008       ;; We now have two newsrc lists - `newsrc', which is what we
15009       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
15010       ;; what we've read from .newsrc.eld.  We have to merge these
15011       ;; lists.  We do this by "attaching" any (foreign) groups in the
15012       ;; gnus-newsrc-alist to the (native) group that precedes them. 
15013       (let ((rc (cdr gnus-newsrc-alist))
15014             (prev gnus-newsrc-alist)
15015             entry mentry)
15016         (while rc
15017           (or (null (nth 4 (car rc)))   ; It's a native group.
15018               (assoc (car (car rc)) newsrc) ; It's already in the alist.
15019               (if (setq entry (assoc (car (car prev)) newsrc))
15020                   (setcdr (setq mentry (memq entry newsrc))
15021                           (cons (car rc) (cdr mentry)))
15022                 (setq newsrc (cons (car rc) newsrc))))
15023           (setq prev rc
15024                 rc (cdr rc)))))
15025
15026     (setq gnus-newsrc-alist newsrc)
15027     ;; We make the newsrc hashtb.
15028     (gnus-make-hashtable-from-newsrc-alist)
15029
15030     ;; Finally, if we read some options lines, we parse them.
15031     (or (string= gnus-newsrc-options "")
15032         (gnus-newsrc-parse-options gnus-newsrc-options))))
15033
15034 ;; Parse options lines to find "options -n !all rec.all" and stuff.
15035 ;; The return value will be a list on the form
15036 ;; ((regexp1 . ignore)
15037 ;;  (regexp2 . subscribe)...)
15038 ;; When handling new newsgroups, groups that match a `ignore' regexp
15039 ;; will be ignored, and groups that match a `subscribe' regexp will be
15040 ;; subscribed.  A line like
15041 ;; options -n !all rec.all
15042 ;; will lead to a list that looks like
15043 ;; (("^rec\\..+" . subscribe) 
15044 ;;  ("^.+" . ignore))
15045 ;; So all "rec.*" groups will be subscribed, while all the other
15046 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
15047 ;; different from "options -n rec.all !all". 
15048 (defun gnus-newsrc-parse-options (options)
15049   (let (out eol)
15050     (save-excursion
15051       (gnus-set-work-buffer)
15052       (insert (regexp-quote options))
15053       ;; First we treat all continuation lines.
15054       (goto-char (point-min))
15055       (while (re-search-forward "\n[ \t]+" nil t)
15056         (replace-match " " t t))
15057       ;; Then we transform all "all"s into ".+"s.
15058       (goto-char (point-min))
15059       (while (re-search-forward "\\ball\\b" nil t)
15060         (replace-match ".+" t t))
15061       (goto-char (point-min))
15062       ;; We remove all other options than the "-n" ones.
15063       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
15064         (replace-match " ")
15065         (forward-char -1))
15066       (goto-char (point-min))
15067
15068       ;; We are only interested in "options -n" lines - we
15069       ;; ignore the other option lines.
15070       (while (re-search-forward "[ \t]-n" nil t)
15071         (setq eol 
15072               (or (save-excursion
15073                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
15074                          (- (point) 2)))
15075                   (gnus-point-at-eol)))
15076         ;; Search for all "words"...
15077         (while (re-search-forward "[^ \t,\n]+" eol t)
15078           (if (= (char-after (match-beginning 0)) ?!)
15079               ;; If the word begins with a bang (!), this is a "not"
15080               ;; spec.  We put this spec (minus the bang) and the
15081               ;; symbol `ignore' into the list.
15082               (setq out (cons (cons (concat 
15083                                      "^" (buffer-substring 
15084                                           (1+ (match-beginning 0))
15085                                           (match-end 0)))
15086                                     'ignore) out))
15087             ;; There was no bang, so this is a "yes" spec.
15088             (setq out (cons (cons (concat "^" (match-string 0))
15089                                   'subscribe) out)))))
15090     
15091       (setq gnus-newsrc-options-n out))))
15092
15093 (defun gnus-save-newsrc-file (&optional force)
15094   "Save .newsrc file."
15095   ;; Note: We cannot save .newsrc file if all newsgroups are removed
15096   ;; from the variable gnus-newsrc-alist.
15097   (when (and (or gnus-newsrc-alist gnus-killed-list)
15098              gnus-current-startup-file)
15099     (save-excursion
15100       (if (and (or gnus-use-dribble-file gnus-slave)
15101                (not force)
15102                (or (not gnus-dribble-buffer)
15103                    (not (buffer-name gnus-dribble-buffer))
15104                    (zerop (save-excursion
15105                             (set-buffer gnus-dribble-buffer)
15106                             (buffer-size)))))
15107           (gnus-message 4 "(No changes need to be saved)")
15108         (run-hooks 'gnus-save-newsrc-hook)
15109         (if gnus-slave
15110             (gnus-slave-save-newsrc)
15111           ;; Save .newsrc.
15112           (when gnus-save-newsrc-file
15113             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
15114             (gnus-gnus-to-newsrc-format)
15115             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
15116           ;; Save .newsrc.eld.
15117           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
15118           (make-local-variable 'version-control)
15119           (setq version-control 'never)
15120           (setq buffer-file-name 
15121                 (concat gnus-current-startup-file ".eld"))
15122           (gnus-add-current-to-buffer-list)
15123           (buffer-disable-undo (current-buffer))
15124           (erase-buffer)
15125           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
15126           (gnus-gnus-to-quick-newsrc-format)
15127           (run-hooks 'gnus-save-quick-newsrc-hook)
15128           (save-buffer)
15129           (kill-buffer (current-buffer))
15130           (gnus-message 
15131            5 "Saving %s.eld...done" gnus-current-startup-file))
15132         (gnus-dribble-delete-file)))))
15133
15134 (defun gnus-gnus-to-quick-newsrc-format ()
15135   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
15136   (insert ";; Gnus startup file.\n")
15137   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
15138   (insert ";; to read .newsrc.\n")
15139   (insert "(setq gnus-newsrc-file-version "
15140           (prin1-to-string gnus-version) ")\n")
15141   (let ((variables 
15142          (if gnus-save-killed-list gnus-variable-list
15143            ;; Remove the `gnus-killed-list' from the list of variables
15144            ;; to be saved, if required.
15145            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
15146         ;; Peel off the "dummy" group.
15147         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
15148         variable)
15149     ;; Insert the variables into the file.
15150     (while variables
15151       (when (and (boundp (setq variable (pop variables)))
15152                  (symbol-value variable))
15153         (insert "(setq " (symbol-name variable) " '"
15154                 (prin1-to-string (symbol-value variable)) ")\n")))))
15155
15156 (defun gnus-gnus-to-newsrc-format ()
15157   ;; Generate and save the .newsrc file.
15158   (let ((newsrc (cdr gnus-newsrc-alist))
15159         info ranges range)
15160     (save-excursion
15161       (set-buffer (create-file-buffer gnus-current-startup-file))
15162       (setq buffer-file-name gnus-current-startup-file)
15163       (buffer-disable-undo (current-buffer))
15164       (erase-buffer)
15165       ;; Write options.
15166       (if gnus-newsrc-options (insert gnus-newsrc-options))
15167       ;; Write subscribed and unsubscribed.
15168       (while newsrc
15169         (setq info (car newsrc))
15170         (if (not (gnus-info-method info))
15171             ;; Don't write foreign groups to .newsrc.
15172             (progn
15173               (insert (gnus-info-group info)
15174                       (if (> (gnus-info-level info) gnus-level-subscribed)
15175                           "!" ":"))
15176               (if (setq ranges (gnus-info-read info))
15177                   (progn
15178                     (insert " ")
15179                     (if (not (listp (cdr ranges)))
15180                         (if (= (car ranges) (cdr ranges))
15181                             (insert (int-to-string (car ranges)))
15182                           (insert (int-to-string (car ranges)) "-" 
15183                                   (int-to-string (cdr ranges))))
15184                       (while ranges
15185                         (setq range (car ranges)
15186                               ranges (cdr ranges))
15187                         (if (or (atom range) (= (car range) (cdr range)))
15188                             (insert (int-to-string 
15189                                      (or (and (atom range) range) 
15190                                          (car range))))
15191                           (insert (int-to-string (car range)) "-"
15192                                   (int-to-string (cdr range))))
15193                         (if ranges (insert ","))))))
15194               (insert "\n")))
15195         (setq newsrc (cdr newsrc)))
15196       (make-local-variable 'version-control)
15197       (setq version-control 'never)
15198       ;; It has been reported that sometime the modtime on the .newsrc
15199       ;; file seems to be off.  We really do want to overwrite it, so
15200       ;; we clear the modtime here before saving.  It's a bit odd,
15201       ;; though... 
15202       ;; sometimes the modtime clear isn't sufficient.  most brute force:
15203       ;; delete the silly thing entirely first.  but this fails to provide
15204       ;; such niceties as .newsrc~ creation.
15205       (if gnus-modtime-botch
15206           (delete-file gnus-startup-file)
15207         (clear-visited-file-modtime))
15208       (run-hooks 'gnus-save-standard-newsrc-hook)
15209       (save-buffer)
15210       (kill-buffer (current-buffer)))))
15211
15212
15213 ;;; Slave functions.
15214
15215 (defun gnus-slave-save-newsrc ()
15216   (save-excursion
15217     (set-buffer gnus-dribble-buffer)
15218     (let ((slave-name 
15219            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
15220       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
15221
15222 (defun gnus-master-read-slave-newsrc ()
15223   (let ((slave-files 
15224          (directory-files 
15225           (file-name-directory gnus-current-startup-file)
15226           t (concat 
15227              "^" (regexp-quote
15228                   (concat
15229                    (file-name-nondirectory gnus-current-startup-file)
15230                    "-slave-")))
15231           t))
15232         file)
15233     (if (not slave-files)
15234         ()                              ; There are no slave files to read.
15235       (gnus-message 7 "Reading slave newsrcs...")
15236       (save-excursion
15237         (set-buffer (get-buffer-create " *gnus slave*"))
15238         (buffer-disable-undo (current-buffer))
15239         (setq slave-files 
15240               (sort (mapcar (lambda (file) 
15241                               (list (nth 5 (file-attributes file)) file))
15242                             slave-files)
15243                     (lambda (f1 f2)
15244                       (or (< (car (car f1)) (car (car f2)))
15245                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
15246         (while slave-files
15247           (erase-buffer)
15248           (setq file (nth 1 (car slave-files)))
15249           (insert-file-contents file)
15250           (if (condition-case ()
15251                   (progn
15252                     (eval-buffer (current-buffer))
15253                     t)
15254                 (error 
15255                  (message "Possible error in %s" file)
15256                  (ding)
15257                  (sit-for 2)
15258                  nil))
15259               (or gnus-slave ; Slaves shouldn't delete these files.
15260                   (condition-case ()
15261                       (delete-file file)
15262                     (error nil))))
15263           (setq slave-files (cdr slave-files))))
15264       (gnus-message 7 "Reading slave newsrcs...done"))))
15265
15266
15267 ;;; Group description.
15268
15269 (defun gnus-read-all-descriptions-files ()
15270   (let ((methods (cons gnus-select-method gnus-secondary-select-methods)))
15271     (while methods
15272       (gnus-read-descriptions-file (car methods))
15273       (setq methods (cdr methods)))
15274     t))
15275
15276 (defun gnus-read-descriptions-file (&optional method)
15277   (let ((method (or method gnus-select-method)))
15278     ;; We create the hashtable whether we manage to read the desc file
15279     ;; to avoid trying to re-read after a failed read.
15280     (or gnus-description-hashtb
15281         (setq gnus-description-hashtb 
15282               (gnus-make-hashtable (length gnus-active-hashtb))))
15283     ;; Mark this method's desc file as read.
15284     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
15285                   gnus-description-hashtb)
15286
15287     (gnus-message 5 "Reading descriptions file via %s..." (car method))
15288     (cond 
15289      ((not (gnus-check-server method))
15290       (gnus-message 1 "Couldn't open server")
15291       nil)
15292      ((not (gnus-request-list-newsgroups method))
15293       (gnus-message 1 "Couldn't read newsgroups descriptions")
15294       nil)
15295      (t
15296       (let (group)
15297         (save-excursion
15298           (save-restriction
15299             (set-buffer nntp-server-buffer)
15300             (goto-char (point-min))
15301             (if (or (search-forward "\n.\n" nil t)
15302                     (goto-char (point-max)))
15303                 (progn
15304                   (beginning-of-line)
15305                   (narrow-to-region (point-min) (point))))
15306             (goto-char (point-min))
15307             (while (not (eobp))
15308               ;; If we get an error, we set group to 0, which is not a
15309               ;; symbol... 
15310               (setq group 
15311                     (condition-case ()
15312                         (let ((obarray gnus-description-hashtb))
15313                           ;; Group is set to a symbol interned in this
15314                           ;; hash table.
15315                           (read nntp-server-buffer))
15316                       (error 0)))
15317               (skip-chars-forward " \t")
15318               ;; ...  which leads to this line being effectively ignored.
15319               (and (symbolp group)
15320                    (set group (buffer-substring 
15321                                (point) (progn (end-of-line) (point)))))
15322               (forward-line 1))))
15323         (gnus-message 5 "Reading descriptions file...done")
15324         t)))))
15325
15326 (defun gnus-group-get-description (group)
15327   "Get the description of a group by sending XGTITLE to the server."
15328   (when (gnus-request-group-description group)
15329     (save-excursion
15330       (set-buffer nntp-server-buffer)
15331       (goto-char (point-min))
15332       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
15333         (match-string 1)))))
15334
15335 ;;;
15336 ;;; Buffering of read articles.
15337 ;;;
15338
15339 (defvar gnus-backlog-buffer " *Gnus Backlog*")
15340 (defvar gnus-backlog-articles nil)
15341 (defvar gnus-backlog-hashtb nil)
15342
15343 (defun gnus-backlog-buffer ()
15344   "Return the backlog buffer."
15345   (or (get-buffer gnus-backlog-buffer)
15346       (save-excursion
15347         (set-buffer (get-buffer-create gnus-backlog-buffer))
15348         (buffer-disable-undo (current-buffer))
15349         (setq buffer-read-only t)
15350         (gnus-add-current-to-buffer-list)
15351         (get-buffer gnus-backlog-buffer))))
15352
15353 (defun gnus-backlog-setup ()
15354   "Initialize backlog variables."
15355   (unless gnus-backlog-hashtb
15356     (setq gnus-backlog-hashtb (make-vector 1023 0))))
15357
15358 (defun gnus-backlog-shutdown ()
15359   "Clear all backlog variables and buffers."
15360   (when (get-buffer gnus-backlog-buffer)
15361     (kill-buffer gnus-backlog-buffer))
15362   (setq gnus-backlog-hashtb nil
15363         gnus-backlog-articles nil))
15364
15365 (defun gnus-backlog-enter-article (group number buffer)
15366   (gnus-backlog-setup)
15367   (let ((ident (intern (concat group ":" (int-to-string number))
15368                        gnus-backlog-hashtb))
15369         b)
15370     (if (memq ident gnus-backlog-articles)
15371         () ; It's already kept.
15372       ;; Remove the oldest article, if necessary.
15373       (and (numberp gnus-keep-backlog)
15374            (>= (length gnus-backlog-articles) gnus-keep-backlog)
15375            (gnus-backlog-remove-oldest-article))
15376       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
15377       ;; Insert the new article.
15378       (save-excursion
15379         (set-buffer (gnus-backlog-buffer))
15380         (let (buffer-read-only)
15381           (goto-char (point-max))
15382           (or (bolp) (insert "\n"))
15383           (setq b (point))
15384           (insert-buffer-substring buffer)
15385           ;; Tag the beginning of the article with the ident.
15386           (put-text-property b (1+ b) 'gnus-backlog ident))))))
15387
15388 (defun gnus-backlog-remove-oldest-article ()
15389   (save-excursion
15390     (set-buffer (gnus-backlog-buffer))
15391     (goto-char (point-min))
15392     (if (zerop (buffer-size))
15393         () ; The buffer is empty.
15394       (let ((ident (get-text-property (point) 'gnus-backlog))
15395             buffer-read-only)
15396         ;; Remove the ident from the list of articles.
15397         (when ident
15398           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
15399         ;; Delete the article itself.
15400         (delete-region 
15401          (point) (next-single-property-change
15402                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
15403
15404 (defun gnus-backlog-request-article (group number buffer)
15405   (gnus-backlog-setup)
15406   (let ((ident (intern (concat group ":" (int-to-string number))
15407                        gnus-backlog-hashtb))
15408         beg end)
15409     (when (memq ident gnus-backlog-articles)
15410       ;; It was in the backlog.
15411       (save-excursion
15412         (set-buffer (gnus-backlog-buffer))
15413         (if (not (setq beg (text-property-any 
15414                             (point-min) (point-max) 'gnus-backlog
15415                             ident)))
15416             ;; It wasn't in the backlog after all.
15417             (progn
15418               (setq gnus-backlog-articles (delq ident gnus-backlog-articles))
15419               nil)
15420           ;; Find the end (i. e., the beginning of the next article).
15421           (setq end
15422                 (next-single-property-change 
15423                  (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
15424       (let ((buffer-read-only nil))
15425         (erase-buffer)
15426         (insert-buffer-substring gnus-backlog-buffer beg end)
15427         t))))
15428
15429 ;; Allow redefinition of Gnus functions.
15430
15431 (gnus-ems-redefine)
15432
15433 (provide 'gnus)
15434
15435 ;;; gnus.el ends here