*** 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 ;; Although (ding) Gnus looks suspiciously like GNUS, it isn't quite
27 ;; the same beast. Most internal structures have been changed. If you
28 ;; have written packages that depend on any of the hash tables,
29 ;; `gnus-newsrc-alist', `gnus-killed-assoc', marked lists, the .newsrc
30 ;; buffer, or internal knowledge of the `nntp-header-' macros, or
31 ;; dependence on the buffers having a certain format, your code will
32 ;; fail.
33
34 ;;; Code:
35
36 (require 'mail-utils)
37 (require 'timezone)
38 (require 'nnheader)
39
40 ;; Site dependent variables. These variables should be defined in
41 ;; paths.el.
42
43 (defvar gnus-default-nntp-server nil
44   "Specify a default NNTP server.
45 This variable should be defined in paths.el, and should never be set
46 by the user.
47 If you want to change servers, you should use `gnus-select-method'.
48 See the documentation to that variable.")
49
50 (defconst gnus-backup-default-subscribed-newsgroups 
51   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
52   "Default default new newsgroups the first time Gnus is run.
53 Should be set in paths.el, and shouldn't be touched by the user.")
54
55 (defvar gnus-local-domain nil
56   "Local domain name without a host name.
57 The DOMAINNAME environment variable is used instead if it is defined.
58 If the `system-name' function returns the full Internet name, there is
59 no need to set this variable.")
60
61 (defvar gnus-local-organization nil
62   "String with a description of what organization (if any) the user belongs to.
63 The ORGANIZATION environment variable is used instead if it is defined.
64 If this variable contains a function, this function will be called
65 with the current newsgroup name as the argument. The function should
66 return a string.
67
68 In any case, if the string (either in the variable, in the environment
69 variable, or returned by the function) is a file name, the contents of
70 this file will be used as the organization.")
71
72 (defvar gnus-use-generic-from nil
73   "If nil, the full host name will be the system name prepended to the domain name.
74 If this is a string, the full host name will be this string.
75 If this is non-nil, non-string, the domain name will be used as the
76 full host name.")
77
78 (defvar gnus-use-generic-path nil
79   "If nil, use the NNTP server name in the Path header.
80 If stringp, use this; if non-nil, use no host name (user name only).")
81
82
83 ;; Customization variables
84
85 (defvar gnus-select-method 
86   (list 'nntp (or (getenv "NNTPSERVER") 
87                   (if (and gnus-default-nntp-server
88                            (not (string= gnus-default-nntp-server "")))
89                       gnus-default-nntp-server)
90                   (system-name)))
91   "*Default method for selecting a newsgroup.
92 This variable should be a list, where the first element is how the
93 news is to be fetched, the second is the address. 
94
95 For instance, if you want to get your news via NNTP from
96 \"flab.flab.edu\", you could say:
97
98 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
99
100 If you want to use your local spool, say:
101
102 (setq gnus-select-method (list 'nnspool (system-name)))
103
104 If you use this variable, you must set `gnus-nntp-server' to nil.
105
106 There is a lot more to know about select methods and virtual servers -
107 see the manual for details.")
108
109 ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
110 (defvar gnus-post-method nil
111   "*Preferred method for posting USENET news.
112 If this variable is nil, Gnus will use the current method to decide
113 which method to use when posting.  If it is non-nil, it will override
114 the current method.  This method will not be used in mail groups and
115 the like, only in \"real\" newsgroups.
116
117 The value must be a valid method as discussed in the documentation of
118 `gnus-select-method'.")
119
120 (defvar gnus-refer-article-method nil
121   "*Preferred method for fetching an article by Message-ID.
122 If you are reading news from the local spool (with nnspool), fetching
123 articles by Message-ID is painfully slow. By setting this method to an
124 nntp method, you might get acceptable results.
125
126 The value of this variable must be a valid select method as discussed
127 in the documentation of `gnus-select-method'")
128
129 (defvar gnus-secondary-select-methods nil
130   "*A list of secondary methods that will be used for reading news.
131 This is a list where each element is a complete select method (see
132 `gnus-select-method').  
133
134 If, for instance, you want to read your mail with the nnml backend,
135 you could set this variable:
136
137 (setq gnus-secondary-select-methods '((nnml \"\"))")
138
139 (defvar gnus-secondary-servers nil
140   "*List of NNTP servers that the user can choose between interactively.
141 To make Gnus query you for a server, you have to give `gnus' a
142 non-numeric prefix - `C-u M-x gnus', in short.")
143
144 (defvar gnus-nntp-server nil
145   "*The name of the host running the NNTP server.
146 This variable is semi-obsolete. Use the `gnus-select-method'
147 variable instead.")
148
149 (defvar gnus-nntp-service "nntp"
150   "*NNTP service name (\"nntp\" or 119).
151 This is an obsolete variable, which is scarcely used. If you use an
152 nntp server for your newsgroup and want to change the port number
153 used to 899, you would say something along these lines:
154
155  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
156
157 (defvar gnus-startup-file "~/.newsrc"
158   "*Your `.newsrc' file.
159 `.newsrc-SERVER' will be used instead if that exists.")
160
161 (defvar gnus-init-file "~/.gnus"
162   "*Your Gnus elisp startup file.
163 If a file with the .el or .elc suffixes exist, it will be read
164 instead.") 
165
166 (defvar gnus-group-faq-directory
167   "/anonymous@rtfm.mit.edu:/pub/usenet-by-group/"
168   "*Directory where the group FAQs are stored.
169 This will most commonly be on a remote machine, and the file will be
170 fetched by ange-ftp.")
171
172 (defvar gnus-group-archive-directory
173   "/ftp@sina.tcamc.uh.edu:/pub/emacs/ding-list/" 
174   "*The address of the (ding) archives.")
175
176 (defvar gnus-default-subscribed-newsgroups nil
177   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
178 It should be a list of strings.
179 If it is `t', Gnus will not do anything special the first time it is
180 started; it'll just use the normal newsgroups subscription methods.")
181
182 (defvar gnus-use-cross-reference t
183   "*Non-nil means that cross referenced articles will be marked as read.
184 If nil, ignore cross references.  If t, mark articles as read in
185 subscribed newsgroups. If neither t nor nil, mark as read in all
186 newsgroups.") 
187
188 (defvar gnus-use-dribble-file t
189   "*Non-nil means that Gnus will use a dribble file to store user updates.
190 If Emacs should crash without saving the .newsrc files, complete
191 information can be restored from the dribble file.")
192
193 (defvar gnus-asynchronous nil
194   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
195
196 (defvar gnus-asynchronous-article-function nil
197   "*Function for picking articles to pre-fetch, possibly.")
198
199 (defvar gnus-score-file-single-match-alist nil
200   "*Alist mapping regexps to lists of score files.
201 Each element of this alist should be of the form
202         (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
203
204 If the name of a group is matched by REGEXP, the corresponding scorefiles
205 will be used for that group.
206 The first match found is used, subsequent matching entries are ignored (to
207 use multiple matches, see gnus-score-file-multiple-match-alist).
208
209 These score files are loaded in addition to any files returned by
210 gnus-score-find-score-files-function (which see).")
211
212 (defvar gnus-score-file-multiple-match-alist nil
213   "*Alist mapping regexps to lists of score files.
214 Each element of this alist should be of the form
215         (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
216
217 If the name of a group is matched by REGEXP, the corresponding scorefiles
218 will be used for that group.
219 If multiple REGEXPs match a group, the score files corresponding to each
220 match will be used (for only one match to be used, see
221 gnus-score-file-single-match-alist).
222
223 These score files are loaded in addition to any files returned by
224 gnus-score-find-score-files-function (which see).")
225
226
227 (defvar gnus-score-file-suffix "SCORE"
228   "*Suffix of the score files.")
229
230 (defvar gnus-adaptive-file-suffix "ADAPT"
231   "*Suffix of the adaptive score files.")
232
233 (defvar gnus-score-find-score-files-function 'gnus-score-find-bnews
234   "*Function used to find SCORE files.
235 The function will be called with the group name as the argument, and
236 should return a list of score files to apply to that group.  The score
237 files do not actually have to exist.
238
239 Predefined values are:
240
241 gnus-score-find-single: Only apply the group's own SCORE file.
242 gnus-score-find-hierarchical: Also apply SCORE files from parent groups.
243 gnus-score-find-bnews: Apply SCORE files whose names matches.
244
245 See the documentation to these functions for more information.
246
247 This variable can also be a list of functions to be called.  Each
248 function should either return a list of score files, or a list of
249 score alists.")
250
251 (defvar gnus-score-interactive-default-score 1000
252   "*Scoring commands will raise/lower the score with this number as the default.")
253
254 (defvar gnus-large-newsgroup 200
255   "*The number of articles which indicates a large newsgroup.
256 If the number of articles in a newsgroup is greater than this value,
257 confirmation is required for selecting the newsgroup.")
258
259 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
260 (defvar gnus-no-groups-message "No news is horrible news"
261   "*Message displayed by Gnus when no groups are available.")
262
263 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
264   "*Non-nil means that the default name of a file to save articles in is the group name.
265 If it's nil, the directory form of the group name is used instead.
266
267 If this variable is a list, and the list contains the element
268 `not-score', long file names will not be used for score files; if it
269 contains the element `not-save', long file names will not be used for
270 saving; and if it contains the element `not-kill', long file names
271 will not be used for kill files.")
272
273 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
274   "*Name of the directory articles will be saved in (default \"~/News\").
275 Initialized from the SAVEDIR environment variable.")
276
277 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
278   "*Name of the directory where kill files will be stored (default \"~/News\").
279 Initialized from the SAVEDIR environment variable.")
280
281 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
282   "*A function to save articles in your favorite format.
283 The function must be interactively callable (in other words, it must
284 be an Emacs command).
285
286 Gnus provides the following functions:
287
288 * gnus-summary-save-in-rmail (Rmail format)
289 * gnus-summary-save-in-mail (Unix mail format)
290 * gnus-summary-save-in-folder (MH folder)
291 * gnus-summary-save-in-file (article format).
292 * gnus-summary-save-in-vm (use VM's folder format).")
293
294 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
295   "*A function generating a file name to save articles in Rmail format.
296 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
297
298 (defvar gnus-mail-save-name (function gnus-plain-save-name)
299   "*A function generating a file name to save articles in Unix mail format.
300 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
301
302 (defvar gnus-folder-save-name (function gnus-folder-save-name)
303   "*A function generating a file name to save articles in MH folder.
304 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
305
306 (defvar gnus-file-save-name (function gnus-numeric-save-name)
307   "*A function generating a file name to save articles in article format.
308 The function is called with NEWSGROUP, HEADERS, and optional
309 LAST-FILE.")
310
311 (defvar gnus-split-methods nil
312   "*Variable used to suggest where articles are to be saved.
313 The syntax of this variable is the same as `nnmail-split-methods'.  
314
315 For instance, if you would like to save articles related to Gnus in
316 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
317 you could set this variable to something like:
318
319  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
320    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))")
321
322 (defvar gnus-save-score nil
323   "*If non-nil, save group scoring info.")
324
325 (defvar gnus-use-adaptive-scoring nil
326   "*If non-nil, use some adaptive scoring scheme.")
327
328 (defvar gnus-use-cache nil
329   "*If non-nil, Gnus will cache (some) articles locally.")
330
331 (defvar gnus-use-scoring t
332   "*If non-nil, enable scoring.")
333
334 (defvar gnus-fetch-old-headers nil
335   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
336 If an unread article in the group refers to an older, already read (or
337 just marked as read) article, the old article will not normally be
338 displayed in the Summary buffer.  If this variable is non-nil, Gnus
339 will attempt to grab the headers to the old articles, and thereby
340 build complete threads.  If it has the value `some', only enough
341 headers to connect otherwise loose threads will be displayed.
342
343 The server has to support XOVER for any of this to work.")
344
345 (defvar gnus-visual t
346   "*If non-nil, will do various highlighting.
347 If nil, no mouse highlights (or any other highlights) will be
348 performed.  This might speed up Gnus some when generating large group
349 and summary buffers.")
350
351 (defvar gnus-novice-user t
352   "*Non-nil means that you are a usenet novice.
353 If non-nil, verbose messages may be displayed and confirmations may be
354 required.")
355
356 (defvar gnus-expert-user nil
357   "*Non-nil means that you will never be asked for confirmation about anything.
358 And that means *anything*.")
359
360 (defvar gnus-verbose 7
361   "*Integer that says how verbose Gnus should be.
362 The higher the number, the more messages Gnus will flash to say what
363 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
364 display most important messages; and at ten, Gnus will keep on
365 jabbering all the time.")
366
367 (defvar gnus-keep-same-level nil
368   "*Non-nil means that the next newsgroup after the current will be on the same level.
369 When you type, for instance, `n' after reading the last article in the
370 current newsgroup, you will go to the next newsgroup. If this variable
371 is nil, the next newsgroup will be the next from the group
372 buffer. 
373 If this variable is non-nil, Gnus will either put you in the
374 next newsgroup with the same level, or, if no such newsgroup is
375 available, the next newsgroup with the lowest possible level higher
376 than the current level.
377 If this variable is `best', Gnus will make the next newsgroup the one
378 with the best level.")
379
380 (defvar gnus-summary-make-false-root 'adopt
381   "*nil means that Gnus won't gather loose threads.
382 If the root of a thread has expired or been read in a previous
383 session, the information necessary to build a complete thread has been
384 lost. Instead of having many small sub-threads from this original thread
385 scattered all over the summary buffer, Gnus can gather them. 
386
387 If non-nil, Gnus will try to gather all loose sub-threads from an
388 original thread into one large thread.
389
390 If this variable is non-nil, it should be one of `none', `adopt',
391 `dummy' or `empty'.
392
393 If this variable is `none', Gnus will not make a false root, but just
394 present the sub-threads after another.
395 If this variable is `dummy', Gnus will create a dummy root that will
396 have all the sub-threads as children.
397 If this variable is `adopt', Gnus will make one of the \"children\"
398 the parent and mark all the step-children as such.
399 If this variable is `empty', the \"children\" are printed with empty
400 subject fields.  (Or rather, they will be printed with a string
401 given by the `gnus-summary-same-subject' variable.)")
402
403 (defvar gnus-summary-gather-subject-limit nil
404   "*Maximum length of subject comparisons when gathering loose threads.
405 Use nil to compare full subjects.  Setting this variable to a low
406 number will help gather threads that have been corrupted by
407 newsreaders chopping off subject lines, but it might also mean that
408 unrelated articles that have subject that happen to begin with the
409 same few characters will be incorrectly gathered.
410
411 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
412 comparing subjects.")
413
414 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
415 (defvar gnus-summary-same-subject ""
416   "*String indicating that the current article has the same subject as the previous.
417 This variable will only be used if the value of
418 `gnus-summary-make-false-root' is `empty'.")
419
420 (defvar gnus-summary-goto-unread nil
421   "*If non-nil, marking commands will go to the next unread article.")
422
423 (defvar gnus-group-goto-unread t
424   "*If non-nil, movement commands will go to the next unread and subscribed group.")
425
426 (defvar gnus-check-new-newsgroups t
427   "*Non-nil means that Gnus will add new newsgroups at startup.
428 If this variable is `ask-server', Gnus will ask the server for new
429 groups since the last time it checked. This means that the killed list
430 is no longer necessary, so you could set `gnus-save-killed-list' to
431 nil. 
432
433 A variant is to have this variable be a list of select methods. Gnus
434 will then use the `ask-server' method on all these select methods to
435 query for new groups from all those servers.
436
437 Eg.
438   (setq gnus-check-new-newsgroups 
439         '((nntp \"some.server\") (nntp \"other.server\")))
440
441 If this variable is nil, then you have to tell Gnus explicitly to
442 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
443
444 (defvar gnus-check-bogus-newsgroups nil
445   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
446 If this variable is nil, then you have to tell Gnus explicitly to
447 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
448
449 (defvar gnus-read-active-file t
450   "*Non-nil means that Gnus will read the entire active file at startup.
451 If this variable is nil, Gnus will only know about the groups in your
452 `.newsrc' file.
453
454 If this variable is `some', Gnus will try to only read the relevant
455 parts of the active file from the server.  Not all servers support
456 this, and it might be quite slow with other servers, but this should
457 generally be faster than both the t and nil value.
458
459 If you set this variable to nil or `some', you probably still want to
460 be told about new newsgroups that arrive.  To do that, set
461 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
462 properly with all servers.")
463
464 (defvar gnus-level-subscribed 5
465   "*Groups with levels less than or equal to this variable are subscribed.")
466
467 (defvar gnus-level-unsubscribed 7
468   "*Groups with levels less than or equal to this variable are unsubscribed.
469 Groups with levels less than `gnus-level-subscribed', which should be
470 less than this variable, are subscribed.")
471
472 (defvar gnus-level-zombie 8
473   "*Groups with this level are zombie groups.")
474
475 (defvar gnus-level-killed 9
476   "*Groups with this level are killed.")
477
478 (defvar gnus-level-default-subscribed 3
479   "*New subscribed groups will be subscribed at this level.")
480
481 (defvar gnus-level-default-unsubscribed 6
482   "*New unsubscribed groups will be unsubscribed at this level.")
483
484 (defvar gnus-activate-foreign-newsgroups nil
485   "*If nil, Gnus will not check foreign newsgroups at startup.
486 If it is non-nil, it should be a number between one and nine. Foreign
487 newsgroups that have a level lower or equal to this number will be
488 activated on startup. For instance, if you want to active all
489 subscribed newsgroups, but not the rest, you'd set this variable to 
490 `gnus-level-subscribed'.
491
492 If you subscribe to lots of newsgroups from different servers, startup
493 might take a while. By setting this variable to nil, you'll save time,
494 but you won't be told how many unread articles there are in the
495 groups.")
496
497 (defvar gnus-save-newsrc-file t
498   "*Non-nil means that Gnus will save the `.newsrc' file.
499 Gnus always saves its own startup file, which is called
500 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
501 be readily understood by other newsreaders.  If you don't plan on
502 using other newsreaders, set this variable to nil to save some time on
503 exit.")
504
505 (defvar gnus-save-killed-list t
506   "*If non-nil, save the list of killed groups to the startup file.
507 This will save both time (when starting and quitting) and space (both
508 memory and disk), but it will also mean that Gnus has no record of
509 which groups are new and which are old, so the automatic new
510 newsgroups subscription methods become meaningless. You should always
511 set `gnus-check-new-newsgroups' to `ask-server' or nil if you set this
512 variable to nil.")
513
514 (defvar gnus-interactive-catchup t
515   "*If non-nil, require your confirmation when catching up a group.")
516
517 (defvar gnus-interactive-post t
518   "*If non-nil, group name will be asked for when posting.")
519
520 (defvar gnus-interactive-exit t
521   "*If non-nil, require your confirmation when exiting Gnus.")
522
523 (defvar gnus-kill-killed nil
524   "*If non-nil, Gnus will apply kill files to already killed articles.
525 If it is nil, Gnus will never apply kill files to articles that have
526 already been through the scoring process, which might very well save lots
527 of time.")
528
529 (defvar gnus-extract-address-components 'gnus-extract-address-components
530   "*Function for extracting address components from a From header.
531 Two pre-defined function exist: `gnus-extract-address-components',
532 which is the default, quite fast, and too simplistic solution, and
533 `mail-extract-address-components', which works much better, but is
534 slower.")
535
536 (defvar gnus-summary-default-score 0
537   "*Default article score level.
538 If this variable is nil, scoring will be disabled.")
539
540 (defvar gnus-summary-zcore-fuzz 0
541   "*Fuzziness factor for the zcore in the summary buffer.
542 Articles with scores closer than this to `gnus-summary-default-score'
543 will not be marked.")
544
545 (defvar gnus-group-default-list-level gnus-level-subscribed
546   "*Default listing level. 
547 Ignored if `gnus-group-use-permanent-levels' is nil.")
548
549 (defvar gnus-group-use-permanent-levels nil
550   "*If non-nil, once you set a level, Gnus will use this level.")
551
552 (defvar gnus-show-mime nil
553   "*If non-ni, do mime processing of articles.
554 The articles will simply be fed to the function given by
555 `gnus-show-mime-method'.")
556
557 (defvar gnus-strict-mime t
558   "*If nil, decode MIME header even if there is not Mime-Version field.")
559  
560 (defvar gnus-show-mime-method (function metamail-buffer)
561   "*Function to process a MIME message.
562 The function is called from the article buffer.")
563
564 (defvar gnus-show-threads t
565   "*If non-nil, display threads in summary mode.")
566
567 (defvar gnus-thread-hide-subtree nil
568   "*If non-nil, hide all threads initially.
569 If threads are hidden, you have to run the command
570 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
571 to expose hidden threads.")
572
573 (defvar gnus-thread-hide-killed t
574   "*If non-nil, hide killed threads automatically.")
575
576 (defvar gnus-thread-ignore-subject nil
577   "*If non-nil, ignore subjects and do all threading based on the Reference header.
578 If nil, which is the default, articles that have different subjects
579 from their parents will start separate threads.")
580
581 (defvar gnus-thread-indent-level 4
582   "*Number that says how much each sub-thread should be indented.")
583
584 (defvar gnus-ignored-newsgroups ""
585   "*A regexp to match uninteresting newsgroups in the active file.
586 Any lines in the active file matching this regular expression are
587 removed from the newsgroup list before anything else is done to it,
588 thus making them effectively non-existent.")
589
590 (defvar gnus-ignored-headers
591   "^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:"
592   "*All headers that match this regexp will be hidden.
593 Also see `gnus-visible-headers'.")
594
595 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:"
596   "*All headers that do not match this regexp will be hidden.
597 Also see `gnus-ignored-headers'.")
598
599 (defvar gnus-sorted-header-list
600   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" 
601     "^Cc:" "^Date:" "^Organization:")
602   "*This variable is a list of regular expressions.
603 If it is non-nil, headers that match the regular expressions will
604 be placed first in the article buffer in the sequence specified by
605 this list.")
606
607 (defvar gnus-show-all-headers nil
608   "*If non-nil, don't hide any headers.")
609
610 (defvar gnus-save-all-headers t
611   "*If non-nil, don't remove any headers before saving.")
612
613 (defvar gnus-inhibit-startup-message nil
614   "*If non-nil, the startup message will not be displayed.")
615
616 (defvar gnus-signature-separator "^-- *$"
617   "Regexp matching signature separator.")
618
619 (defvar gnus-auto-extend-newsgroup t
620   "*If non-nil, extend newsgroup forward and backward when requested.")
621
622 (defvar gnus-auto-select-first t
623   "*If non-nil, select the first unread article when entering a group.
624 If you want to prevent automatic selection of the first unread article
625 in some newsgroups, set the variable to nil in
626 `gnus-select-group-hook'.") 
627
628 (defvar gnus-auto-select-next t
629   "*If non-nil, offer to go to the next group from the end of the previous.
630 If the value is t and the next newsgroup is empty, Gnus will exit
631 summary mode and go back to group mode.  If the value is neither nil
632 nor t, Gnus will select the following unread newsgroup.  In
633 particular, if the value is the symbol `quietly', the next unread
634 newsgroup will be selected without any confirmations.")
635
636 (defvar gnus-auto-select-same nil
637   "*If non-nil, select the next article with the same subject.")
638
639 (defvar gnus-summary-check-current nil
640   "*If non-nil, consider the current article when moving.
641 The \"unread\" movement commands will stay on the same line if the
642 current article is unread.")
643
644 (defvar gnus-auto-center-summary t
645   "*If non-nil, always center the current summary buffer.")
646
647 (defvar gnus-break-pages t
648   "*If non-nil, do page breaking on articles.
649 The page delimiter is specified by the `gnus-page-delimiter'
650 variable.")
651
652 (defvar gnus-page-delimiter "^\^L"
653   "*Regexp describing what to use as article page delimiters.
654 The default value is \"^\^L\", which is a form linefeed at the
655 beginning of a line.")
656
657 (defvar gnus-use-full-window t
658   "*If non-nil, use the entire Emacs screen.")
659
660 (defvar gnus-window-configuration nil
661   "Obsolete variable.  See `gnus-buffer-configuration'.")
662
663 (defvar gnus-buffer-configuration
664   '((group ([group 1.0 point] 
665             (if gnus-carpal [group-carpal 4])))
666     (summary ([summary 1.0 point]
667               (if gnus-carpal [summary-carpal 4])))
668     (article ([summary 0.25 point] 
669               (if gnus-carpal [summary-carpal 4]) 
670               [article 1.0]))
671     (server ([server 1.0 point]
672              (if gnus-carpal [server-carpal 2])))
673     (browse ([browse 1.0 point]
674              (if gnus-carpal [browse-carpal 2])))
675     (group-mail ([mail 1.0 point]))
676     (summary-mail ([mail 1.0 point]))
677     (summary-reply ([article 0.5]
678                     [mail 1.0 point]))
679     (info ([nil 1.0 point]))
680     (summary-faq ([summary 0.25]
681                   [article 1.0 point]))
682     (edit-group ([group 0.5]
683                  [edit-group 1.0 point]))
684     (edit-server ([server 0.5]
685                   [edit-server 1.0 point]))
686     (post ([post 1.0 point]))
687     (reply ([article 0.5]
688             [mail 1.0 point]))
689     (mail-forward ([mail 1.0 point]))
690     (post-forward ([post 1.0 point]))
691     (reply-yank ([mail 1.0 point]))
692     (followup ([article 0.5]
693                [post 1.0 point]))
694     (followup-yank ([post 1.0 point])))
695   "Window configuration for all possible Gnus buffers.
696 This variable is a list of lists.  Each of these lists has a NAME and
697 a RULE.  The NAMEs are commonsense names like `group', which names a
698 rule used when displaying the group buffer; `summary', which names a
699 rule for what happens when you enter a group and do not display an
700 article buffer; and so on.  See the value of this variable for a
701 complete list of NAMEs.
702
703 Each RULE is a list of vectors.  The first element in this vector is
704 the name of the buffer to be displayed; the second element is the
705 percentage of the screen this buffer is to occupy (a number in the
706 0.0-0.99 range); the optional third element is `point', which should
707 be present to denote which buffer point is to go to after making this
708 buffer configuration.")
709
710 (defvar gnus-window-to-buffer
711   '((group . gnus-group-buffer)
712     (summary . gnus-summary-buffer)
713     (article . gnus-article-buffer)
714     (server . gnus-server-buffer)
715     (browse . "*Gnus Browse Server*")
716     (edit-group . gnus-group-edit-buffer)
717     (edit-server . gnus-server-edit-buffer)
718     (group-carpal . gnus-carpal-group-buffer)
719     (summary-carpal . gnus-carpal-summary-buffer)
720     (server-carpal . gnus-carpal-server-buffer)
721     (browse-carpal . gnus-carpal-browse-buffer)
722     (mail . "*mail*")
723     (post . gnus-post-news-buffer))
724   "Mapping from short symbols to buffer names or buffer variables.")
725
726 (defvar gnus-carpal nil
727   "*If non-nil, display clickable icons.")
728
729 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
730   "*Function called with a group name when new group is detected.
731 A few pre-made functions are supplied: `gnus-subscribe-randomly'
732 inserts new groups at the beginning of the list of groups;
733 `gnus-subscribe-alphabetically' inserts new groups in strict
734 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
735 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
736 for your decision.")
737
738 ;; Suggested by a bug report by Hallvard B Furuseth.
739 ;; <h.b.furuseth@usit.uio.no>. 
740 (defvar gnus-subscribe-options-newsgroup-method
741   (function gnus-subscribe-alphabetically)
742   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
743 If, for instance, you want to subscribe to all newsgroups in the
744 \"no\" and \"alt\" hierarchies, you'd put the following in your
745 .newsrc file:
746
747 options -n no.all alt.all
748
749 Gnus will the subscribe all new newsgroups in these hierarchies with
750 the subscription method in this variable.")
751
752 (defvar gnus-subscribe-hierarchical-interactive nil
753   "*If non-nil, Gnus will offer to subscribe hierarchically.
754 When a new hierarchy appears, Gnus will ask the user:
755
756 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
757
758 If the user pressed `d', Gnus will descend the hierarchy, `y' will
759 subscribe to all newsgroups in the hierarchy and `s' will skip this
760 hierarchy in its entirety.")
761
762 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
763   "*Function used for sorting the group buffer.
764 This function will be called with group info entries as the arguments
765 for the groups to be sorted.  Pre-made functions include
766 `gnus-sort-by-alphabet', `gnus-sort-by-unread' and
767 `gnus-sort-by-level'")
768
769 ;; Mark variables suggested by Thomas Michanek
770 ;; <Thomas.Michanek@telelogic.se>. 
771 (defvar gnus-unread-mark ? 
772   "*Mark used for unread articles.")
773 (defvar gnus-ticked-mark ?!
774   "*Mark used for ticked articles.")
775 (defvar gnus-dormant-mark ??
776   "*Mark used for dormant articles.")
777 (defvar gnus-del-mark ?D
778   "*Mark used for del'd articles.")
779 (defvar gnus-read-mark ?d
780   "*Mark used for read articles.")
781 (defvar gnus-expirable-mark ?E
782   "*Mark used for expirable articles.")
783 (defvar gnus-killed-mark ?K
784   "*Mark used for killed articles.")
785 (defvar gnus-kill-file-mark ?X
786   "*Mark used for articles killed by kill files.")
787 (defvar gnus-low-score-mark ?Y
788   "*Mark used for articles with a low score.")
789 (defvar gnus-catchup-mark ?C
790   "*Mark used for articles that are caught up.")
791 (defvar gnus-replied-mark ?R
792   "*Mark used for articles that have been replied to.")
793 (defvar gnus-process-mark ?# 
794   "*Process mark.")
795 (defvar gnus-ancient-mark ?A
796   "*Mark used for ancient articles.")
797 (defvar gnus-canceled-mark ?G
798   "*Mark used for cancelled articles.")
799 (defvar gnus-score-over-mark ?+
800   "*Score mark used for articles with high scores.")
801 (defvar gnus-score-below-mark ?-
802   "*Score mark used for articles with low scores.")
803 (defvar gnus-empty-thread-mark ? 
804   "*There is no thread under the article.")
805 (defvar gnus-not-empty-thread-mark ?=
806   "*There is a thread under the article.")
807 (defvar gnus-dummy-mark ?Z
808   "*This is a dummy article.")
809
810 (defvar gnus-view-pseudo-asynchronously nil
811   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
812
813 (defvar gnus-view-pseudos nil
814   "*If `automatic', pseudo-articles will be viewed automatically.
815 If `not-confirm', pseudos will be viewed automatically, and the user
816 will not be asked to confirm the command.")
817
818 (defvar gnus-view-pseudos-separately t
819   "*If non-nil, one pseudo-article will be created for each file to be viewed.
820 If nil, all files that use the same viewing command will be given as a
821 list of parameters to that command.")
822
823 (defvar gnus-group-line-format "%M%S%p%5y: %(%g%)\n"
824   "*Format of group lines.
825 It works along the same lines as a normal formatting string,
826 with some simple extensions.
827
828 %M    Only marked articles (character, \"*\" or \" \")
829 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
830 %L    Level of subscribedness (integer)
831 %N    Number of unread articles (integer)
832 %I    Number of dormant articles (integer)
833 %i    Number of ticked and dormant (integer)
834 %T    Number of ticked articles (integer)
835 %R    Number of read articles (integer)
836 %t    Total number of articles (integer)
837 %y    Number of unread, unticked articles (integer)
838 %G    Group name (string)
839 %g    Qualified group name (string)
840 %D    Group description (string)
841 %s    Select method (string)
842 %o    Moderated group (char, \"m\")
843 %p    Process mark (char)
844 %O    Moderated group (string, \"(m)\" or \"\")
845 %n    Select from where (string)
846 %z    A string that look like `<%s:%n>' if a foreign select method is used
847 %u    User defined specifier. The next character in the format string should
848       be a letter.  Gnus will call the function gnus-user-format-function-X,
849       where X is the letter following %u. The function will be passed the
850       current header as argument. The function should return a string, which
851       will be inserted into the buffer just like information from any other
852       group specifier.
853
854 Text between %( and %) will be highlighted with `gnus-mouse-face' when
855 the mouse point move inside the area.  There can only be one such area.
856
857 Note that this format specification is not always respected. For
858 reasons of efficiency, when listing killed groups, this specification
859 is ignored altogether. If the spec is changed considerably, your
860 output may end up looking strange when listing both alive and killed
861 groups.
862
863 If you use %o or %O, reading the active file will be slower and quite
864 a bit of extra memory will be used. %D will also worsen performance.
865 Also note that if you change the format specification to include any
866 of these specs, you must probably re-start Gnus to see them go into
867 effect.") 
868
869 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
870   "*The format specification of the lines in the summary buffer.
871
872 It works along the same lines as a normal formatting string,
873 with some simple extensions.
874
875 %N   Article number, left padded with spaces (string)
876 %S   Subject (string)
877 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
878 %n   Name of the poster (string)
879 %A   Address of the poster (string)
880 %F   Contents of the From: header (string)
881 %x   Contents of the Xref: header (string)
882 %D   Date of the article (string)
883 %d   Date of the article (string) in DD-MMM format
884 %M   Message-id of the article (string)
885 %r   References of the article (string)
886 %c   Number of characters in the article (integer)
887 %L   Number of lines in the article (integer)
888 %I   Indentation based on thread level (a string of spaces)
889 %T   A string with two possible values: 80 spaces if the article
890      is on thread level two or larger and 0 spaces on level one
891 %R   \"R\" if this article has been replied to, \" \" otherwise (character)
892 %U   Status of this article (character, \"D\", \"K\", \"-\" or \" \")
893 %[   Opening bracket (character, \"[\" or \"<\")
894 %]   Closing bracket (character, \"]\" or \">\")
895 %>   Spaces of length thread-level (string)
896 %<   Spaces of length (- 20 thread-level) (string)
897 %i   Article score (number)
898 %z   Article zcore (character)
899 %t   Number of articles under the current thread (number).
900 %e   Whether the thread is empty or not (character).
901 %u   User defined specifier. The next character in the format string should
902      be a letter.  Gnus will call the function gnus-user-format-function-X,
903      where X is the letter following %u. The function will be passed the
904      current header as argument. The function should return a string, which
905      will be inserted into the summary just like information from any other
906      summary specifier.
907
908 Text between %( and %) will be highlighted with `gnus-mouse-face'
909 when the mouse point is placed inside the area.  There can only be one
910 such area.
911
912 The %U (status), %R (replied) and %z (zcore) specs have to be handled
913 with care. For reasons of efficiency, Gnus will compute what column
914 these characters will end up in, and \"hard-code\" that. This means that
915 it is illegal to have these specs after a variable-length spec. Well,
916 you might not be arrested, but your summary buffer will look strange,
917 which is bad enough.
918
919 The smart choice is to have these specs as for to the left as
920 possible. 
921
922 This restriction may disappear in later versions of Gnus.")
923
924 (defvar gnus-summary-dummy-line-format "*  :                          : %S\n"
925   "*The format specification for the dummy roots in the summary buffer.
926 It works along the same lines as a normal formatting string,
927 with some simple extensions.
928
929 %S  The subject")
930
931 (defvar gnus-summary-mode-line-format "(ding) %G/%A %Z"
932   "*The format specification for the summary mode line.")
933
934 (defvar gnus-article-mode-line-format "(ding) %G/%A %S"
935   "*The format specification for the article mode line.")
936
937 (defvar gnus-group-mode-line-format "(ding) List of groups   {%M:%S}  "
938   "*The format specification for the group mode line.")
939
940 (defvar gnus-valid-select-methods
941   '(("nntp" post address prompt-address)
942     ("nnspool" post)
943     ("nnvirtual" none virtual prompt-address) 
944     ("nnmbox" mail respool) 
945     ("nnml" mail respool)
946     ("nnmh" mail respool) 
947     ("nndir" none prompt-address address)
948     ("nneething" none prompt-address)
949     ("nndigest" none) 
950     ("nndoc" none prompt-address) 
951     ("nnbabyl" mail respool) 
952     ("nnkiboze" post virtual) 
953     ("nnsoup" post)
954     ("nnfolder" mail respool))
955   "An alist of valid select methods.
956 The first element of each list lists should be a string with the name
957 of the select method. The other elements may be be the category of
958 this method (ie. `post', `mail', `none' or whatever) or other
959 properties that this method has (like being respoolable).
960 If you implement a new select method, all you should have to change is
961 this variable. I think.")
962
963 (defvar gnus-updated-mode-lines '(group article summary)
964   "*List of buffers that should update their mode lines.
965 The list may contain the symbols `group', `article' and `summary'. If
966 the corresponding symbol is present, Gnus will keep that mode line
967 updated with information that may be pertinent. 
968 If this variable is nil, screen refresh may be quicker.")
969
970 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
971 (defvar gnus-mode-non-string-length 21
972   "*Max length of mode-line non-string contents.
973 If this is nil, Gnus will take space as is needed, leaving the rest
974 of the modeline intact.")
975
976 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
977 (defvar gnus-mouse-face 'highlight
978   "*Face used for mouse highlighting in Gnus.
979 No mouse highlights will be done if `gnus-visual' is nil.")
980
981 (defvar gnus-summary-mark-below nil
982   "*Mark all articles with a score below this variable as read.
983 This variable is local to each summary buffer and usually set by the
984 score file.")  
985
986 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
987   "*List of functions used for sorting threads in the summary buffer.
988 By default, threads are sorted by article number.
989
990 Each function takes two threads and return non-nil if the first thread
991 should be sorted before the other.  If you use more than one function,
992 the primary sort function should be the last.
993
994 Ready-mady functions include `gnus-thread-sort-by-number',
995 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
996 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
997 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
998
999 (defvar gnus-thread-score-function '+
1000   "*Function used for calculating the total score of a thread.
1001
1002 The function is called with the scores of the article and each
1003 subthread and should then return the score of the thread.
1004
1005 Some functions you can use are `+', `max', or `min'.")
1006
1007 (defvar gnus-options-subscribe nil
1008   "*All new groups matching this regexp will be subscribed unconditionally.
1009 Note that this variable deals only with new newsgroups.  This variable
1010 does not affect old newsgroups.")
1011
1012 (defvar gnus-options-not-subscribe nil
1013   "*All new groups matching this regexp will be ignored.
1014 Note that this variable deals only with new newsgroups.  This variable
1015 does not affect old (already subscribed) newsgroups.")
1016
1017 (defvar gnus-auto-expirable-newsgroups nil
1018   "*Groups in which to automatically mark read articles as expirable.
1019 If non-nil, this should be a regexp that should match all groups in
1020 which to perform auto-expiry.  This only makes sense for mail groups.")
1021
1022 (defvar gnus-hidden-properties '(invisible t intangible t)
1023   "Property list to use for hiding text.")
1024
1025 ;; Hooks.
1026
1027 (defvar gnus-group-mode-hook nil
1028   "*A hook for Gnus group mode.")
1029
1030 (defvar gnus-summary-mode-hook nil
1031   "*A hook for Gnus summary mode.")
1032
1033 (defvar gnus-article-mode-hook nil
1034   "*A hook for Gnus article mode.")
1035
1036 (defvar gnus-open-server-hook nil
1037   "*A hook called just before opening connection to the news server.")
1038
1039 (defvar gnus-startup-hook nil
1040   "*A hook called at startup.
1041 This hook is called after Gnus is connected to the NNTP server.")
1042
1043 (defvar gnus-get-new-news-hook nil
1044   "*A hook run just before Gnus checks for new news.")
1045
1046 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1047   "*A function that is called to generate the group buffer.
1048 The function is called with three arguments: The first is a number;
1049 all group with a level less or equal to that number should be listed,
1050 if the second is non-nil, empty groups should also be displayed. If
1051 the third is non-nil, it is a number. No groups with a level lower
1052 than this number should be displayed.
1053
1054 The only current function implemented is `gnus-group-prepare-flat'.")
1055
1056 (defvar gnus-group-prepare-hook nil
1057   "*A hook called after the group buffer has been generated.
1058 If you want to modify the group buffer, you can use this hook.")
1059
1060 (defvar gnus-summary-prepare-hook nil
1061   "*A hook called after the summary buffer has been generated.
1062 If you want to modify the summary buffer, you can use this hook.")
1063
1064 (defvar gnus-article-prepare-hook nil
1065   "*A hook called after an article has been prepared in the article buffer.
1066 If you want to run a special decoding program like nkf, use this hook.")
1067
1068 (defvar gnus-article-display-hook nil
1069   "*A hook called after the article is displayed in the article buffer.
1070 The hook is designed to change the contents of the article
1071 buffer. Typical functions that this hook may contain are
1072 `gnus-article-hide-headers' (hide selected headers),
1073 `gnus-article-maybe-highlight' (perform fancy article highlighting), 
1074 `gnus-article-hide-signature' (hide signature) and
1075 `gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1076 (add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1077 (add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1078
1079 (defvar gnus-article-x-face-command
1080   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1081   "String or function to be executed to display an X-Face header.
1082 If it is a string, the command will be executed in a sub-shell
1083 asynchronously. The compressed face will be piped to this command.") 
1084
1085 (defvar gnus-article-x-face-too-ugly nil
1086   "Regexp matching posters whose face shouldn't be shown automatically.")
1087
1088 (defvar gnus-select-group-hook nil
1089   "*A hook called when a newsgroup is selected.
1090
1091 If you'd like to simplify subjects like the
1092 `gnus-summary-next-same-subject' command does, you can use the
1093 following hook:
1094
1095  (setq gnus-select-group-hook
1096       (list
1097         (lambda ()
1098           (mapcar (lambda (header)
1099                      (header-set-subject
1100                       header
1101                       (gnus-simplify-subject
1102                        (header-subject header) 're-only)))
1103                   gnus-newsgroup-headers))))")
1104
1105 (defvar gnus-select-article-hook
1106   '(gnus-summary-show-thread)
1107   "*A hook called when an article is selected.
1108 The default hook shows conversation thread subtrees of the selected
1109 article automatically using `gnus-summary-show-thread'.")
1110
1111 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1112   "*A hook called to apply kill files to a group.
1113 This hook is intended to apply a kill file to the selected newsgroup.
1114 The function `gnus-apply-kill-file' is called by default.
1115
1116 Since a general kill file is too heavy to use only for a few
1117 newsgroups, I recommend you to use a lighter hook function. For
1118 example, if you'd like to apply a kill file to articles which contains
1119 a string `rmgroup' in subject in newsgroup `control', you can use the
1120 following hook:
1121
1122 \(setq gnus-apply-kill-hook
1123       (list
1124         (lambda ()
1125           (cond ((string-match \"control\" gnus-newsgroup-name)
1126                  (gnus-kill \"Subject\" \"rmgroup\")
1127                  (gnus-expunge \"X\"))))))")
1128
1129 (defvar gnus-visual-mark-article-hook 
1130   (list 'gnus-highlight-selected-summary)
1131   "*Hook run after selecting an article in the summary buffer.
1132 It is meant to be used for highlighting the article in some way.  It
1133 is not run if `gnus-visual' is nil.")
1134
1135 (defvar gnus-prepare-article-hook (list 'gnus-inews-insert-signature)
1136   "*A hook called after preparing body, but before preparing header headers.
1137 The default hook (`gnus-inews-insert-signature') inserts a signature
1138 file specified by the variable `gnus-signature-file'.")
1139
1140 (defvar gnus-exit-group-hook nil
1141   "*A hook called when exiting (not quitting) summary mode.")
1142
1143 (defvar gnus-suspend-gnus-hook nil
1144   "*A hook called when suspending (not exiting) Gnus.")
1145
1146 (defvar gnus-exit-gnus-hook nil
1147   "*A hook called when exiting Gnus.")
1148
1149 (defvar gnus-save-newsrc-hook nil
1150   "*A hook called when saving the newsrc file.")
1151
1152 (defvar gnus-summary-update-hook 
1153   (list 'gnus-summary-highlight-line)
1154   "*A hook called when a summary line is changed.
1155 The hook will not be called if `gnus-visual' is nil.
1156
1157 The default function `gnus-summary-highlight-line' will
1158 highlight the line according to the `gnus-summary-highlight'
1159 variable.")
1160
1161 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1162   "*A hook called when an article is selected for the first time.
1163 The hook is intended to mark an article as read (or unread)
1164 automatically when it is selected.")
1165
1166 \f
1167 ;; Internal variables
1168
1169 ;; Avoid highlighting in kill files.
1170 (defvar gnus-summary-inhibit-highlight nil)
1171 (defvar gnus-newsgroup-selected-overlay nil)
1172
1173 (defvar gnus-article-mode-map nil)
1174 (defvar caesar-translate-table nil)
1175 (defvar gnus-dribble-buffer nil)
1176 (defvar gnus-headers-retrieved-by nil)
1177 (defvar gnus-article-reply nil)
1178 (defvar gnus-override-method nil)
1179 (defvar gnus-article-check-size nil)
1180
1181 (defvar gnus-current-score-file nil)
1182 (defvar gnus-internal-global-score-files nil)
1183 (defvar gnus-score-file-list nil)
1184
1185
1186 (defvar gnus-current-move-group nil)
1187
1188 (defvar gnus-newsgroup-dependencies nil)
1189 (defvar gnus-newsgroup-threads nil)
1190 (defvar gnus-newsgroup-async nil)
1191 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1192
1193 (defvar gnus-newsgroup-adaptive nil)
1194
1195 (defvar gnus-summary-display-table nil)
1196
1197 (defconst gnus-group-line-format-alist
1198   (list (list ?M 'marked ?c)
1199         (list ?S 'subscribed ?c)
1200         (list ?L 'level ?d)
1201         (list ?N 'number ?s)
1202         (list ?I 'number-of-dormant ?d)
1203         (list ?T 'number-of-ticked ?d)
1204         (list ?R 'number-of-read ?s)
1205         (list ?t 'number-total ?d)
1206         (list ?y 'number-of-unread-unticked ?s)
1207         (list ?i 'number-of-ticked-and-dormant ?d)
1208         (list ?g 'group ?s)
1209         (list ?G 'qualified-group ?s)
1210         (list ?D 'newsgroup-description ?s)
1211         (list ?o 'moderated ?c)
1212         (list ?O 'moderated-string ?s)
1213         (list ?p 'process-marked ?c)
1214         (list ?s 'news-server ?s)
1215         (list ?n 'news-method ?s)
1216         (list ?z 'news-method-string ?s)
1217         (list ?u 'user-defined ?s)))
1218
1219 (defconst gnus-summary-line-format-alist 
1220   (list (list ?N 'number ?d)
1221         (list ?S 'subject ?s)
1222         (list ?s 'subject-or-nil ?s)
1223         (list ?n 'name ?s)
1224         (list ?A 'address ?s)
1225         (list ?F 'from ?s)
1226         (list ?x (macroexpand '(header-xref header)) ?s)
1227         (list ?D (macroexpand '(header-date header)) ?s)
1228         (list ?d '(gnus-dd-mmm (header-date header)) ?s)
1229         (list ?M (macroexpand '(header-id header)) ?s)
1230         (list ?r (macroexpand '(header-references header)) ?s)
1231         (list ?c '(or (header-chars header) 0) ?d)
1232         (list ?L 'lines ?d)
1233         (list ?I 'indentation ?s)
1234         (list ?T '(if (= level 0) "" (make-string (frame-width) ? )) ?s)
1235         (list ?R 'replied ?c)
1236         (list ?\[ 'opening-bracket ?c)
1237         (list ?\] 'closing-bracket ?c)
1238         (list ?\> '(make-string level ? ) ?s)
1239         (list ?\< '(make-string (max 0 (- 20 level)) ? ) ?s)
1240         (list ?i 'score ?d)
1241         (list ?z 'score-char ?c)
1242         (list ?U 'unread ?c)
1243         (list ?t '(gnus-summary-number-of-articles-in-thread 
1244                    (or (prog1 gnus-tmp-adopt-thread 
1245                          (setq gnus-tmp-adopt-thread nil))
1246                        (if (boundp 'thread) (symbol-value 'thread)
1247                          thread nil)))
1248                    ?d)
1249         (list ?e '(gnus-summary-number-of-articles-in-thread 
1250                    (or gnus-tmp-adopt-thread 
1251                        (if (boundp 'thread) (symbol-value 'thread)
1252                          thread nil)) t)
1253                    ?d)
1254         (list ?u 'user-defined ?s))
1255   "An alist of format specifications that can appear in summary lines,
1256 and what variables they correspond with, along with the type of the
1257 variable (string, integer, character, etc).")
1258
1259 (defconst gnus-summary-dummy-line-format-alist
1260   (list (list ?S 'subject ?s)
1261         (list ?N 'number ?d)
1262         (list ?u 'user-defined ?s)))
1263
1264 (defconst gnus-summary-mode-line-format-alist 
1265   (list (list ?G 'group-name ?s)
1266         (list ?g '(gnus-short-group-name group-name) ?s)
1267         (list ?A 'article-number ?d)
1268         (list ?Z 'unread-and-unselected ?s)
1269         (list ?V 'gnus-version ?s)
1270         (list ?U 'unread ?d)
1271         (list ?S 'subject ?s)
1272         (list ?e 'unselected ?d)
1273         (list ?u 'user-defined ?s)
1274         (list ?s '(gnus-current-score-file-nondirectory) ?s)))
1275
1276 (defconst gnus-group-mode-line-format-alist 
1277   (list (list ?S 'news-server ?s)
1278         (list ?M 'news-method ?s)
1279         (list ?u 'user-defined ?s)))
1280
1281 (defvar gnus-have-read-active-file nil)
1282
1283 (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)"
1284   "The mail address of the Gnus maintainers.")
1285
1286 (defconst gnus-version "(ding) Gnus v0.85"
1287   "Version number for this version of Gnus.")
1288
1289 (defvar gnus-info-nodes
1290   '((gnus-group-mode            "(gnus)The Group Buffer")
1291     (gnus-summary-mode          "(gnus)The Summary Buffer")
1292     (gnus-article-mode          "(gnus)The Article Buffer"))
1293   "Assoc list of major modes and related Info nodes.")
1294
1295 (defvar gnus-documentation-group-file "~/dgnus/lisp/doc.txt"
1296   "The location of the (ding) Gnus documentation group.")
1297
1298 (defvar gnus-group-buffer "*Group*")
1299 (defvar gnus-summary-buffer "*Summary*")
1300 (defvar gnus-article-buffer "*Article*")
1301 (defvar gnus-server-buffer "*Server*")
1302
1303 (defvar gnus-work-buffer " *gnus work*")
1304
1305 (defvar gnus-buffer-list nil
1306   "Gnus buffers that should be killed on exit.")
1307
1308 (defvar gnus-server-alist nil
1309   "List of available servers.")
1310
1311 (defvar gnus-variable-list
1312   '(gnus-newsrc-options gnus-newsrc-options-n
1313     gnus-newsrc-last-checked-date 
1314     gnus-newsrc-alist gnus-server-alist
1315     gnus-killed-list gnus-zombie-list)
1316   "Gnus variables saved in the quick startup file.")
1317
1318 (defvar gnus-overload-functions
1319   '((news-inews gnus-inews-news "rnewspost")
1320     (caesar-region gnus-caesar-region "rnews"))
1321   "Functions overloaded by gnus.
1322 It is a list of `(original overload &optional file)'.")
1323
1324 (defvar gnus-newsrc-options nil
1325   "Options line in the .newsrc file.")
1326
1327 (defvar gnus-newsrc-options-n nil
1328   "List of regexps representing groups to be subscribed/ignored unconditionally.") 
1329
1330 (defvar gnus-newsrc-last-checked-date nil
1331   "Date Gnus last asked server for new newsgroups.")
1332
1333 (defvar gnus-newsrc-alist nil
1334   "Assoc list of read articles.
1335 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1336
1337 (defvar gnus-newsrc-hashtb nil
1338   "Hashtable of gnus-newsrc-alist.")
1339
1340 (defvar gnus-killed-list nil
1341   "List of killed newsgroups.")
1342
1343 (defvar gnus-killed-hashtb nil
1344   "Hash table equivalent of gnus-killed-list.")
1345
1346 (defvar gnus-zombie-list nil
1347   "List of almost dead newsgroups.")
1348
1349 (defvar gnus-description-hashtb nil
1350   "Descriptions of newsgroups.")
1351
1352 (defvar gnus-list-of-killed-groups nil
1353   "List of newsgroups that have recently been killed by the user.")
1354
1355 (defvar gnus-active-hashtb nil
1356   "Hashtable of active articles.")
1357
1358 (defvar gnus-moderated-list nil
1359   "List of moderated newsgroups.")
1360
1361 (defvar gnus-group-marked nil)
1362
1363 (defvar gnus-current-startup-file nil
1364   "Startup file for the current host.")
1365
1366 (defvar gnus-last-search-regexp nil
1367   "Default regexp for article search command.")
1368
1369 (defvar gnus-last-shell-command nil
1370   "Default shell command on article.")
1371
1372 (defvar gnus-current-select-method nil
1373   "The current method for selecting a newsgroup.")
1374
1375 (defvar gnus-have-all-newsgroups nil)
1376
1377 (defvar gnus-article-internal-prepare-hook nil)
1378
1379 (defvar gnus-newsgroup-name nil)
1380 (defvar gnus-newsgroup-begin nil)
1381 (defvar gnus-newsgroup-end nil)
1382 (defvar gnus-newsgroup-last-rmail nil)
1383 (defvar gnus-newsgroup-last-mail nil)
1384 (defvar gnus-newsgroup-last-folder nil)
1385 (defvar gnus-newsgroup-last-file nil)
1386 (defvar gnus-newsgroup-auto-expire nil)
1387 (defvar gnus-newsgroup-active nil)
1388
1389 (defvar gnus-newsgroup-unreads nil
1390   "List of unread articles in the current newsgroup.")
1391
1392 (defvar gnus-newsgroup-unselected nil
1393   "List of unselected unread articles in the current newsgroup.")
1394
1395 (defvar gnus-newsgroup-marked nil
1396   "List of ticked articles in the current newsgroup (a subset of unread art).")
1397
1398 (defvar gnus-newsgroup-killed nil
1399   "List of ranges of articles that have been through the scoring process.")
1400
1401 (defvar gnus-newsgroup-kill-headers nil)
1402
1403 (defvar gnus-newsgroup-replied nil
1404   "List of articles that have been replied to in the current newsgroup.")
1405
1406 (defvar gnus-newsgroup-expirable nil
1407   "List of articles in the current newsgroup that can be expired.")
1408
1409 (defvar gnus-newsgroup-processable nil
1410   "List of articles in the current newsgroup that can be processed.")
1411
1412 (defvar gnus-newsgroup-bookmarks nil
1413   "List of articles in the current newsgroup that have bookmarks.")
1414
1415 (defvar gnus-newsgroup-dormant nil
1416   "List of dormant articles in the current newsgroup.")
1417
1418 (defvar gnus-newsgroup-scored nil
1419   "List of scored articles in the current newsgroup.")
1420
1421 (defvar gnus-newsgroup-headers nil
1422   "List of article headers in the current newsgroup.")
1423 (defvar gnus-newsgroup-headers-hashtb-by-number nil)
1424
1425 (defvar gnus-newsgroup-ancient nil
1426   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1427
1428 (defvar gnus-current-article nil)
1429 (defvar gnus-article-current nil)
1430 (defvar gnus-current-headers nil)
1431 (defvar gnus-have-all-headers nil)
1432 (defvar gnus-last-article nil)
1433 (defvar gnus-newsgroup-history nil)
1434 (defvar gnus-current-kill-article nil)
1435
1436 ;; Save window configuration.
1437 (defvar gnus-prev-winconf nil)
1438
1439 ;; Format specs
1440 (defvar gnus-summary-line-format-spec nil)
1441 (defvar gnus-summary-dummy-line-format-spec nil)
1442 (defvar gnus-group-line-format-spec nil)
1443 (defvar gnus-summary-mode-line-format-spec nil)
1444 (defvar gnus-article-mode-line-format-spec nil)
1445 (defvar gnus-group-mode-line-format-spec nil)
1446 (defvar gnus-summary-mark-positions nil)
1447
1448 (defvar gnus-summary-expunge-below nil)
1449 (defvar gnus-reffed-article-number nil)
1450
1451 (defvar rmail-default-file (expand-file-name "~/XMBOX"))
1452 (defvar rmail-default-rmail-file (expand-file-name "~/XNEWS"))
1453
1454 (defconst gnus-summary-local-variables 
1455   '(gnus-newsgroup-name 
1456     gnus-newsgroup-begin gnus-newsgroup-end 
1457     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail 
1458     gnus-newsgroup-last-folder gnus-newsgroup-last-file 
1459     gnus-newsgroup-auto-expire gnus-newsgroup-unreads 
1460     gnus-newsgroup-unselected gnus-newsgroup-marked
1461     gnus-newsgroup-replied gnus-newsgroup-expirable
1462     gnus-newsgroup-processable gnus-newsgroup-killed
1463     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1464     gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number
1465     gnus-current-article gnus-current-headers gnus-have-all-headers
1466     gnus-last-article gnus-article-internal-prepare-hook
1467     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1468     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1469     gnus-newsgroup-threads gnus-newsgroup-async
1470     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below 
1471     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1472     gnus-newsgroup-history gnus-newsgroup-ancient
1473     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring))
1474   "Variables that are buffer-local to the summary buffers.")
1475
1476 (defconst gnus-bug-message
1477   "Sending a bug report to the Gnus Towers.
1478 ========================================
1479
1480 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1481 be sent to the Gnus Bug Exterminators. 
1482
1483 At the bottom of the buffer you'll see lots of variable settings.
1484 Please do not delete those.  They will tell the Bug People what your
1485 environment is, so that it will be easier to locate the bugs.
1486
1487 If you have found a bug that makes Emacs go \"beep\", set
1488 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') 
1489 and include the backtrace in your bug report.
1490
1491 Please describe the bug in annoying, painstaking detail.
1492
1493 Thank you for your help in stamping out bugs.
1494 ")
1495
1496 ;;; End of variables.
1497
1498 ;; Define some autoload functions Gnus might use.
1499 (eval-and-compile
1500
1501   ;; Various 
1502   (autoload 'metamail-buffer "metamail")
1503   (autoload 'Info-goto-node "info")
1504   (autoload 'hexl-hex-string-to-integer "hexl")
1505   (autoload 'pp "pp")
1506   (autoload 'pp-to-string "pp")
1507   (autoload 'pp-eval-expression "pp")
1508   (autoload 'mail-extract-address-components "mail-extr")
1509
1510   (autoload 'nnmail-split-fancy "nnmail")
1511   (autoload 'nnvirtual-catchup-group "nnvirtual")
1512
1513   ;; timezone
1514   (autoload 'timezone-make-date-arpa-standard "timezone")
1515   (autoload 'timezone-fix-time "timezone")
1516   (autoload 'timezone-make-sortable-date "timezone")
1517   (autoload 'timezone-make-time-string "timezone")
1518
1519   ;; rmail & friends
1520   (autoload 'mail-position-on-field "sendmail")
1521   (autoload 'mail-setup "sendmail")
1522   (autoload 'rmail-output "rmailout")
1523   (autoload 'news-mail-other-window "rnewspost")
1524   (autoload 'news-reply-yank-original "rnewspost")
1525   (autoload 'news-caesar-buffer-body "rnewspost")
1526   (autoload 'rmail-insert-rmail-file-header "rmail")
1527   (autoload 'rmail-count-new-messages "rmail")
1528   (autoload 'rmail-show-message "rmail")
1529
1530   ;; gnus-soup
1531   (autoload 'gnus-group-brew-soup "gnus-soup" nil t)
1532   (autoload 'gnus-brew-soup "gnus-soup" nil t)
1533   (autoload 'gnus-soup-add-article "gnus-soup" nil t)
1534   (autoload 'gnus-soup-send-replies "gnus-soup" nil t)
1535   (autoload 'gnus-soup-save-areas "gnus-soup" nil t)
1536   (autoload 'gnus-soup-pack-packet "gnus-soup" nil t)
1537   (autoload 'nnsoup-pack-replies "nnsoup" nil t)
1538
1539   ;; gnus-mh
1540   (autoload 'gnus-mail-reply-using-mhe "gnus-mh")
1541   (autoload 'gnus-mail-forward-using-mhe "gnus-mh")
1542   (autoload 'gnus-mail-other-window-using-mhe "gnus-mh")
1543   (autoload 'gnus-summary-save-in-folder "gnus-mh")
1544   (autoload 'gnus-summary-save-article-folder "gnus-mh")
1545   (autoload 'gnus-Folder-save-name "gnus-mh")
1546   (autoload 'gnus-folder-save-name "gnus-mh")
1547
1548   ;; gnus-vis misc
1549   (autoload 'gnus-group-make-menu-bar "gnus-vis")
1550   (autoload 'gnus-summary-make-menu-bar "gnus-vis")
1551   (autoload 'gnus-server-make-menu-bar "gnus-vis")
1552   (autoload 'gnus-article-make-menu-bar "gnus-vis")
1553   (autoload 'gnus-browse-make-menu-bar "gnus-vis")
1554   (autoload 'gnus-highlight-selected-summary "gnus-vis")
1555   (autoload 'gnus-summary-highlight-line "gnus-vis")
1556   (autoload 'gnus-carpal-setup-buffer "gnus-vis")
1557
1558   ;; gnus-vis article
1559   (autoload 'gnus-article-push-button "gnus-vis" nil t)
1560   (autoload 'gnus-article-press-button "gnus-vis" nil t)
1561   (autoload 'gnus-article-highlight "gnus-vis" nil t)
1562   (autoload 'gnus-article-hide "gnus-vis" nil t)
1563   (autoload 'gnus-article-hide-signature "gnus-vis" nil t)
1564   (autoload 'gnus-article-highlight-headers "gnus-vis" nil t)
1565   (autoload 'gnus-article-highlight-signature "gnus-vis" nil t)
1566   (autoload 'gnus-article-add-buttons "gnus-vis" nil t)
1567   (autoload 'gnus-article-next-button "gnus-vis" nil t)
1568   (autoload 'gnus-article-add-button "gnus-vis")
1569
1570   ;; gnus-cite
1571   (autoload 'gnus-article-highlight-citation "gnus-cite" nil t)
1572   (autoload 'gnus-article-hide-citation-maybe "gnus-cite" nil t)
1573   (autoload 'gnus-article-hide-citation "gnus-cite" nil t)
1574
1575   ;; gnus-kill
1576   (autoload 'gnus-kill "gnus-kill")
1577   (autoload 'gnus-apply-kill-file-internal "gnus-kill")
1578   (autoload 'gnus-kill-file-edit-file "gnus-kill")
1579   (autoload 'gnus-kill-file-raise-followups-to-author "gnus-kill")
1580   (autoload 'gnus-execute "gnus-kill")
1581   (autoload 'gnus-expunge "gnus-kill")
1582
1583   ;; gnus-cache
1584   (autoload 'gnus-cache-possibly-enter-article "gnus-cache")
1585   (autoload 'gnus-cache-save-buffers "gnus-cache")
1586   (autoload 'gnus-cache-possibly-remove-article "gnus-cache")
1587   (autoload 'gnus-cache-request-article "gnus-cache")
1588   (autoload 'gnus-cache-retrieve-headers "gnus-cache")
1589   (autoload 'gnus-cache-possibly-alter-active "gnus-cache")
1590   (autoload 'gnus-jog-cache "gnus-cache" nil t)
1591
1592   ;; gnus-score
1593   (autoload 'gnus-summary-increase-score "gnus-score" nil t)
1594   (autoload 'gnus-summary-lower-score "gnus-score" nil t)
1595   (autoload 'gnus-summary-score-map "gnus-score" nil nil 'keymap)
1596   (autoload 'gnus-score-save "gnus-score")
1597   (autoload 'gnus-score-headers "gnus-score")
1598   (autoload 'gnus-current-score-file-nondirectory "gnus-score")
1599   (autoload 'gnus-score-adaptive "gnus-score")
1600   (autoload 'gnus-score-remove-lines-adaptive "gnus-score")
1601   (autoload 'gnus-score-find-trace "gnus-score")
1602
1603   ;; gnus-edit
1604   (autoload 'gnus-score-customize "gnus-edit" nil t)
1605
1606   ;; gnus-uu
1607   (autoload 'gnus-uu-extract-map "gnus-uu" nil nil 'keymap)
1608   (autoload 'gnus-uu-mark-map "gnus-uu" nil nil 'keymap)
1609   (autoload 'gnus-uu-digest-mail-forward "gnus-uu" nil t)
1610   (autoload 'gnus-uu-digest-post-forward "gnus-uu" nil t)
1611   (autoload 'gnus-uu-mark-series "gnus-uu" nil t)
1612   (autoload 'gnus-uu-mark-region "gnus-uu" nil t)
1613   (autoload 'gnus-uu-mark-by-regexp "gnus-uu" nil t)
1614   (autoload 'gnus-uu-mark-all "gnus-uu" nil t)
1615   (autoload 'gnus-uu-mark-sparse "gnus-uu" nil t)
1616   (autoload 'gnus-uu-mark-thread "gnus-uu" nil t)
1617   (autoload 'gnus-uu-decode-uu "gnus-uu" nil t)
1618   (autoload 'gnus-uu-decode-uu-and-save "gnus-uu" nil t)
1619   (autoload 'gnus-uu-decode-unshar "gnus-uu" nil t)
1620   (autoload 'gnus-uu-decode-unshar-and-save "gnus-uu" nil t)
1621   (autoload 'gnus-uu-decode-save "gnus-uu" nil t)
1622   (autoload 'gnus-uu-decode-binhex "gnus-uu" nil t)
1623   (autoload 'gnus-uu-decode-uu-view "gnus-uu" nil t)
1624   (autoload 'gnus-uu-decode-uu-and-save-view "gnus-uu" nil t)
1625   (autoload 'gnus-uu-decode-unshar-view "gnus-uu" nil t)
1626   (autoload 'gnus-uu-decode-unshar-and-save-view "gnus-uu" nil t)
1627   (autoload 'gnus-uu-decode-save-view "gnus-uu" nil t)
1628   (autoload 'gnus-uu-decode-binhex-view "gnus-uu" nil t)
1629
1630   ;; gnus-msg
1631   (autoload 'gnus-summary-send-map "gnus-msg" nil nil 'keymap)
1632   (autoload 'gnus-group-post-news "gnus-msg" nil t)
1633   (autoload 'gnus-group-mail "gnus-msg" nil t)
1634   (autoload 'gnus-summary-post-news "gnus-msg" nil t)
1635   (autoload 'gnus-summary-followup "gnus-msg" nil t)
1636   (autoload 'gnus-summary-followup-with-original "gnus-msg" nil t)
1637   (autoload 'gnus-summary-followup-and-reply "gnus-msg" nil t)
1638   (autoload 'gnus-summary-followup-and-reply-with-original "gnus-msg" nil t)
1639   (autoload 'gnus-summary-cancel-article "gnus-msg" nil t)
1640   (autoload 'gnus-summary-supersede-article "gnus-msg" nil t)
1641   (autoload 'gnus-post-news "gnus-msg" nil t)
1642   (autoload 'gnus-inews-news "gnus-msg" nil t)
1643   (autoload 'gnus-cancel-news "gnus-msg" nil t)
1644   (autoload 'gnus-summary-reply "gnus-msg" nil t)
1645   (autoload 'gnus-summary-reply-with-original "gnus-msg" nil t)
1646   (autoload 'gnus-summary-mail-forward "gnus-msg" nil t)
1647   (autoload 'gnus-summary-mail-other-window "gnus-msg" nil t)
1648   (autoload 'gnus-mail-reply-using-mail "gnus-msg")
1649   (autoload 'gnus-mail-yank-original "gnus-msg")
1650   (autoload 'gnus-mail-send-and-exit "gnus-msg")
1651   (autoload 'gnus-mail-forward-using-mail "gnus-msg")
1652   (autoload 'gnus-mail-other-window-using-mail "gnus-msg")
1653   (autoload 'gnus-article-mail-with-original "gnus-msg")
1654   (autoload 'gnus-article-mail "gnus-msg")
1655
1656   ;; gnus-vm
1657   (autoload 'gnus-summary-save-in-vm "gnus-vm" nil t)
1658   (autoload 'gnus-summary-save-article-vm "gnus-vm" nil t)
1659   (autoload 'gnus-mail-forward-using-vm "gnus-vm")
1660   (autoload 'gnus-mail-reply-using-vm "gnus-vm")
1661   (autoload 'gnus-mail-other-window-using-vm "gnus-vm" nil t)
1662   (autoload 'gnus-yank-article "gnus-vm" nil t)
1663
1664   )
1665
1666 \f
1667
1668 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1669 ;; If you want the cursor to go somewhere else, set these two
1670 ;; functions in some startup hook to whatever you want.
1671 (defalias 'gnus-summary-position-cursor 'gnus-goto-colon)
1672 (defalias 'gnus-group-position-cursor 'gnus-goto-colon)
1673
1674 ;;; Various macros and substs.
1675
1676 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
1677   "Pop to BUFFER, evaluate FORMS, and then returns to original window."
1678   (` (let ((GnusStartBufferWindow (selected-window)))
1679        (unwind-protect
1680            (progn
1681              (pop-to-buffer (, buffer))
1682              (,@ forms))
1683          (select-window GnusStartBufferWindow)))))
1684
1685 (defmacro gnus-gethash (string hashtable)
1686   "Get hash value of STRING in HASHTABLE."
1687   ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
1688   ;;(` (abbrev-expansion (, string) (, hashtable)))
1689   (` (symbol-value (intern-soft (, string) (, hashtable)))))
1690
1691 (defmacro gnus-sethash (string value hashtable)
1692   "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
1693   ;; We cannot use define-abbrev since it only accepts string as value.
1694   ;; (set (intern string hashtable) value))
1695   (` (set (intern (, string) (, hashtable)) (, value))))
1696
1697 (defsubst gnus-buffer-substring (beg end)
1698   (buffer-substring (match-beginning beg) (match-end end)))
1699
1700 (defsubst gnus-simplify-subject-re (subject)
1701   "Remove \"Re:\" from subject lines."
1702   (let ((case-fold-search t))
1703     (if (string-match "^re: *" subject)
1704         (substring subject (match-end 0))
1705       subject)))
1706
1707 (defsubst gnus-goto-char (point)
1708   (and point (goto-char point)))
1709
1710 (defmacro gnus-buffer-exists-p (buffer)
1711   (` (and (, buffer)
1712           (funcall (if (stringp (, buffer)) 'get-buffer 'buffer-name)
1713                    (, buffer)))))
1714
1715 (defmacro gnus-kill-buffer (buffer)
1716   (` (if (gnus-buffer-exists-p (, buffer))
1717          (kill-buffer (, buffer)))))
1718
1719 (defsubst gnus-point-at-bol ()
1720   "Return point at the beginning of line."
1721   (let ((p (point)))
1722     (beginning-of-line)
1723     (prog1
1724         (point)
1725       (goto-char p))))
1726
1727 (defsubst gnus-point-at-eol ()
1728   "Return point at the beginning of line."
1729   (let ((p (point)))
1730     (end-of-line)
1731     (prog1
1732         (point)
1733       (goto-char p))))
1734
1735 ;; Delete the current line (and the next N lines.);
1736 (defmacro gnus-delete-line (&optional n)
1737   (` (delete-region (progn (beginning-of-line) (point))
1738                     (progn (forward-line (, (or n 1))) (point)))))
1739
1740 ;;; Load the compatability functions. 
1741
1742 (require 'gnus-ems)
1743
1744 \f
1745 ;;;
1746 ;;; Gnus Utility Functions
1747 ;;;
1748
1749 (defun gnus-extract-address-components (from)
1750   (let (name address)
1751     ;; First find the address - the thing with the @ in it.  This may
1752     ;; not be accurate in mail addresses, but does the trick most of
1753     ;; the time in news messages.
1754     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
1755         (setq address (substring from (match-beginning 0) (match-end 0))))
1756     ;; Then we check whether the "name <address>" format is used.
1757     (and address
1758          (string-match (concat "<" (regexp-quote address) ">") from)
1759          (and (setq name (substring from 0 (1- (match-beginning 0))))
1760               ;; Strip any quotes from the name.
1761               (string-match "\".*\"" name)
1762               (setq name (substring name 1 (1- (match-end 0))))))
1763     ;; If not, then "address (name)" is used.
1764     (or name
1765         (and (string-match "(.+)" from)
1766              (setq name (substring from (1+ (match-beginning 0)) 
1767                                    (1- (match-end 0)))))
1768         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
1769         ;; XOVER might not support folded From headers.
1770         (and (string-match "(.*" from)
1771              (setq name (substring from (1+ (match-beginning 0)) 
1772                                    (match-end 0)))))
1773     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1774     (list (or name from) (or address from))))
1775
1776 (defun gnus-fetch-field (field)
1777   "Return the value of the header FIELD of current article."
1778   (save-excursion
1779     (save-restriction
1780       (let ((case-fold-search t))
1781         (gnus-narrow-to-headers)
1782         (mail-fetch-field field)))))
1783
1784 (defun gnus-goto-colon ()
1785   (beginning-of-line)
1786   (search-forward ":" (gnus-point-at-eol) t))
1787
1788 (defun gnus-narrow-to-headers ()
1789   (widen)
1790   (save-excursion
1791     (narrow-to-region
1792      (goto-char (point-min))
1793      (if (search-forward "\n\n" nil t)
1794          (1- (point))
1795        (point-max)))))
1796
1797 (defun gnus-update-format-specifications ()
1798   (gnus-make-thread-indent-array)
1799   (setq gnus-summary-line-format-spec 
1800         (gnus-parse-format
1801          gnus-summary-line-format gnus-summary-line-format-alist))
1802   (gnus-update-summary-mark-positions)
1803   (setq gnus-summary-dummy-line-format-spec 
1804         (gnus-parse-format gnus-summary-dummy-line-format 
1805                            gnus-summary-dummy-line-format-alist))
1806   (setq gnus-group-line-format-spec
1807         (gnus-parse-format 
1808          gnus-group-line-format 
1809          gnus-group-line-format-alist))
1810   (if (and (string-match "%D" gnus-group-line-format)
1811            (not gnus-description-hashtb)
1812            gnus-read-active-file)
1813       (gnus-read-all-descriptions-files))
1814   (setq gnus-summary-mode-line-format-spec 
1815         (gnus-parse-format gnus-summary-mode-line-format 
1816                            gnus-summary-mode-line-format-alist))
1817   (setq gnus-article-mode-line-format-spec 
1818         (gnus-parse-format gnus-article-mode-line-format 
1819                            gnus-summary-mode-line-format-alist))
1820   (setq gnus-group-mode-line-format-spec 
1821         (gnus-parse-format gnus-group-mode-line-format 
1822                            gnus-group-mode-line-format-alist)))
1823
1824 (defun gnus-update-summary-mark-positions ()
1825   (save-excursion
1826     (let ((gnus-replied-mark 129)
1827           (gnus-score-below-mark 130)
1828           (gnus-score-over-mark 130)
1829           (thread nil)
1830           pos)
1831       (gnus-set-work-buffer)
1832       (gnus-summary-insert-line 
1833        nil [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
1834       (goto-char (point-min))
1835       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
1836                                          (- (point) 2)))))
1837       (goto-char (point-min))
1838       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
1839                                           (- (point) 2))) pos))
1840       (goto-char (point-min))
1841       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
1842                                         (- (point) 2))) pos))
1843       (setq gnus-summary-mark-positions pos))))
1844
1845 (defun gnus-format-max-width (form length)
1846   (let* ((val (eval form))
1847          (valstr (if (numberp val) (int-to-string val) val)))
1848     (if (> (length valstr) length)
1849         (substring valstr 0 length)
1850       valstr)))
1851
1852 (defun gnus-set-mouse-face (string)
1853   ;; Set mouse face property on STRING.
1854   (put-text-property 0 (length string) 'mouse-face gnus-mouse-face string)
1855   string)
1856
1857 (defun gnus-parse-format (format spec-alist)
1858   ;; This function parses the FORMAT string with the help of the
1859   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1860   ;; string.  If the FORMAT string contains the specifiers %( and %)
1861   ;; the text between them will have the mouse-face text property.
1862   (if (string-match "\\`\\(.*\\)%(\\(.*\\)%)\\(.*\n?\\)\\'" format)
1863       (if (and gnus-visual gnus-mouse-face)
1864           (let ((pre (substring format (match-beginning 1) (match-end 1)))
1865                 (button (substring format (match-beginning 2) (match-end 2)))
1866                 (post (substring format (match-beginning 3) (match-end 3))))
1867             (list 'concat
1868                   (gnus-parse-simple-format pre spec-alist)
1869                   (list 'gnus-set-mouse-face
1870                         (gnus-parse-simple-format button spec-alist))
1871                   (gnus-parse-simple-format post spec-alist)))
1872         (gnus-parse-simple-format
1873          (concat (substring format (match-beginning 1) (match-end 1))
1874                  (substring format (match-beginning 2) (match-end 2))
1875                  (substring format (match-beginning 3) (match-end 3)))
1876          spec-alist))
1877     (gnus-parse-simple-format format spec-alist)))
1878
1879 (defun gnus-parse-simple-format (format spec-alist)
1880   ;; This function parses the FORMAT string with the help of the
1881   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1882   ;; string. The list will consist of the symbol `format', a format
1883   ;; specification string, and a list of forms depending on the
1884   ;; SPEC-ALIST.
1885   (let ((max-width 0)
1886         spec flist fstring b newspec max-width elem beg)
1887     (save-excursion
1888       (gnus-set-work-buffer)
1889       (insert format)
1890       (goto-char (point-min))
1891       (while (re-search-forward "%[-0-9]*\\(,[0-9]*\\)*\\(.\\)\\(.\\)?" nil t)
1892         (setq spec (string-to-char (buffer-substring (match-beginning 2)
1893                                                      (match-end 2))))
1894         ;; First check if there are any specs that look anything like
1895         ;; "%12,12A", ie. with a "max width specification". These have
1896         ;; to be treated specially.
1897         (if (setq beg (match-beginning 1))
1898             (setq max-width 
1899                   (string-to-int 
1900                    (buffer-substring (1+ (match-beginning 1)) (match-end 1))))
1901           (setq max-width 0)
1902           (setq beg (match-beginning 2)))
1903         ;; Find the specification from `spec-alist'.
1904         (if (not (setq elem (cdr (assq spec spec-alist))))
1905             (setq elem '("*" ?s)))
1906         ;; Treat user defined format specifiers specially
1907         (and (eq (car elem) 'user-defined)
1908              (setq elem
1909                    (list 
1910                     (list (intern (concat "gnus-user-format-function-"
1911                                           (buffer-substring
1912                                            (match-beginning 3)
1913                                            (match-end 3))))
1914                           'header)
1915                     ?s))
1916              (delete-region (match-beginning 3) (match-end 3)))
1917         (if (not (zerop max-width))
1918             (let ((el (car elem)))
1919               (cond ((= (car (cdr elem)) ?c) 
1920                      (setq el (list 'char-to-string el)))
1921                     ((= (car (cdr elem)) ?d)
1922                      (numberp el) (setq el (list 'int-to-string el))))
1923               (setq flist (cons (list 'gnus-format-max-width el max-width) 
1924                                 flist))
1925               (setq newspec ?s))
1926           (setq flist (cons (car elem) flist))
1927           (setq newspec (car (cdr elem))))
1928         ;; Remove the old specification (and possibly a ",12" string).
1929         (delete-region beg (match-end 2))
1930         ;; Insert the new specification.
1931         (goto-char beg)
1932         (insert newspec))
1933       (setq fstring (buffer-substring 1 (point-max))))
1934     (cons 'format (cons fstring (nreverse flist)))))
1935
1936 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
1937 (defun gnus-read-init-file ()
1938   (and gnus-init-file
1939        (or (and (file-exists-p gnus-init-file) 
1940                 ;; Don't try to load a directory.
1941                 (not (file-directory-p gnus-init-file)))
1942            (file-exists-p (concat gnus-init-file ".el"))
1943            (file-exists-p (concat gnus-init-file ".elc")))
1944        (load gnus-init-file nil t)))
1945
1946 (defun gnus-set-work-buffer ()
1947   (if (get-buffer gnus-work-buffer)
1948       (progn
1949         (set-buffer gnus-work-buffer)
1950         (erase-buffer))
1951     (set-buffer (get-buffer-create gnus-work-buffer))
1952     (kill-all-local-variables)
1953     (buffer-disable-undo (current-buffer))
1954     (gnus-add-current-to-buffer-list)))
1955
1956 ;; Article file names when saving.
1957
1958 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
1959   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1960 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
1961 Otherwise, it is like ~/News/news/group/num."
1962   (let ((default
1963           (expand-file-name
1964            (concat (if (gnus-use-long-file-name 'not-save)
1965                        (gnus-capitalize-newsgroup newsgroup)
1966                      (gnus-newsgroup-directory-form newsgroup))
1967                    "/" (int-to-string (header-number headers)))
1968            (or gnus-article-save-directory "~/News"))))
1969     (if (and last-file
1970              (string-equal (file-name-directory default)
1971                            (file-name-directory last-file))
1972              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
1973         default
1974       (or last-file default))))
1975
1976 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
1977   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1978 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
1979 Otherwise, it is like ~/News/news/group/num."
1980   (let ((default
1981           (expand-file-name
1982            (concat (if (gnus-use-long-file-name 'not-save)
1983                        newsgroup
1984                      (gnus-newsgroup-directory-form newsgroup))
1985                    "/" (int-to-string (header-number headers)))
1986            (or gnus-article-save-directory "~/News"))))
1987     (if (and last-file
1988              (string-equal (file-name-directory default)
1989                            (file-name-directory last-file))
1990              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
1991         default
1992       (or last-file default))))
1993
1994 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
1995   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1996 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
1997 Otherwise, it is like ~/News/news/group/news."
1998   (or last-file
1999       (expand-file-name
2000        (if (gnus-use-long-file-name 'not-save)
2001            (gnus-capitalize-newsgroup newsgroup)
2002          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2003        (or gnus-article-save-directory "~/News"))))
2004
2005 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2006   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2007 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
2008 Otherwise, it is like ~/News/news/group/news."
2009   (or last-file
2010       (expand-file-name
2011        (if (gnus-use-long-file-name 'not-save)
2012            newsgroup
2013          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2014        (or gnus-article-save-directory "~/News"))))
2015
2016 ;; For subscribing new newsgroup
2017
2018 (defun gnus-subscribe-hierarchical-interactive (groups)
2019   (let ((groups (sort groups 'string<))
2020         prefixes prefix start rest ans group starts)
2021     (while groups
2022       (setq prefixes (list "^"))
2023       (while (and groups prefixes)
2024         (while (not (string-match (car prefixes) (car groups)))
2025           (setq prefixes (cdr prefixes)))
2026         (setq prefix (car prefixes))
2027         (setq start (1- (length prefix)))
2028         (if (and (string-match "[^\\.]\\." (car groups) start)
2029                  (cdr groups)
2030                  (setq prefix 
2031                        (concat "^" (substring (car groups) 0 (match-end 0))))
2032                  (string-match prefix (car (cdr groups))))
2033             (progn
2034               (setq prefixes (cons prefix prefixes))
2035               (message "Descend hierarchy %s? ([y]nsq): " 
2036                        (substring prefix 1 (1- (length prefix))))
2037               (setq ans (read-char))
2038               (cond ((= ans ?n)
2039                      (while (and groups 
2040                                  (string-match prefix 
2041                                                (setq group (car groups))))
2042                        (setq gnus-killed-list 
2043                              (cons group gnus-killed-list))
2044                        (gnus-sethash group group gnus-killed-hashtb)
2045                        (setq groups (cdr groups)))
2046                      (setq starts (cdr starts)))
2047                     ((= ans ?s)
2048                      (while (and groups 
2049                                  (string-match prefix 
2050                                                (setq group (car groups))))
2051                        (gnus-sethash group group gnus-killed-hashtb)
2052                        (gnus-subscribe-alphabetically (car groups))
2053                        (setq groups (cdr groups)))
2054                      (setq starts (cdr starts)))
2055                     ((= ans ?q)
2056                      (while groups
2057                        (setq group (car groups))
2058                        (setq gnus-killed-list (cons group gnus-killed-list))
2059                        (gnus-sethash group group gnus-killed-hashtb)
2060                        (setq groups (cdr groups))))
2061                     (t nil)))
2062           (message "Subscribe %s? ([n]yq)" (car groups))
2063           (setq ans (read-char))
2064           (setq group (car groups))
2065           (cond ((= ans ?y)
2066                  (gnus-subscribe-alphabetically (car groups))
2067                  (gnus-sethash group group gnus-killed-hashtb))
2068                 ((= ans ?q)
2069                  (while groups
2070                    (setq group (car groups))
2071                    (setq gnus-killed-list (cons group gnus-killed-list))
2072                    (gnus-sethash group group gnus-killed-hashtb)
2073                    (setq groups (cdr groups))))
2074                 (t 
2075                  (setq gnus-killed-list (cons group gnus-killed-list))
2076                  (gnus-sethash group group gnus-killed-hashtb)))
2077           (setq groups (cdr groups)))))))
2078
2079 (defun gnus-subscribe-randomly (newsgroup)
2080   "Subscribe new NEWSGROUP by making it the first newsgroup."
2081   (gnus-subscribe-newsgroup newsgroup))
2082
2083 (defun gnus-subscribe-alphabetically (newgroup)
2084   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2085   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2086   (let ((groups (cdr gnus-newsrc-alist))
2087         before)
2088     (while (and (not before) groups)
2089       (if (string< newgroup (car (car groups)))
2090           (setq before (car (car groups)))
2091         (setq groups (cdr groups))))
2092     (gnus-subscribe-newsgroup newgroup before)))
2093
2094 (defun gnus-subscribe-hierarchically (newgroup)
2095   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2096   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2097   (save-excursion
2098     (set-buffer (find-file-noselect gnus-current-startup-file))
2099     (let ((groupkey newgroup)
2100           before)
2101       (while (and (not before) groupkey)
2102         (goto-char (point-min))
2103         (let ((groupkey-re
2104                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2105           (while (and (re-search-forward groupkey-re nil t)
2106                       (progn
2107                         (setq before (buffer-substring
2108                                       (match-beginning 1) (match-end 1)))
2109                         (string< before newgroup)))))
2110         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2111         (setq groupkey
2112               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2113                   (substring groupkey (match-beginning 1) (match-end 1)))))
2114       (gnus-subscribe-newsgroup newgroup before))))
2115
2116 (defun gnus-subscribe-interactively (newsgroup)
2117   "Subscribe new NEWSGROUP interactively.
2118 It is inserted in hierarchical newsgroup order if subscribed. If not,
2119 it is killed."
2120   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
2121       (gnus-subscribe-hierarchically newsgroup)
2122     (setq gnus-killed-list (cons newsgroup gnus-killed-list))))
2123
2124 (defun gnus-subscribe-zombies (newsgroup)
2125   "Make new NEWSGROUP a zombie group."
2126   (setq gnus-zombie-list (cons newsgroup gnus-zombie-list)))
2127
2128 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2129   "Subscribe new NEWSGROUP.
2130 If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
2131 the first newsgroup."
2132   ;; We subscribe the group by changing its level to `subscribed'.
2133   (gnus-group-change-level 
2134    newsgroup gnus-level-default-subscribed
2135    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2136   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2137
2138 ;; For directories
2139
2140 (defun gnus-newsgroup-directory-form (newsgroup)
2141   "Make hierarchical directory name from NEWSGROUP name."
2142   (let ((newsgroup (substring newsgroup 0)) ;Copy string.
2143         (len (length newsgroup))
2144         idx)
2145     ;; If this is a foreign group, we don't want to translate the
2146     ;; entire name.  
2147     (if (setq idx (string-match ":" newsgroup))
2148         (aset newsgroup idx ?/)
2149       (setq idx 0))
2150     ;; Replace all occurrences of `.' with `/'.
2151     (while (< idx len)
2152       (if (= (aref newsgroup idx) ?.)
2153           (aset newsgroup idx ?/))
2154       (setq idx (1+ idx)))
2155     newsgroup))
2156
2157 (defun gnus-make-directory (dir)
2158   "Make DIRECTORY recursively."
2159   (let* ((dir (expand-file-name dir default-directory))
2160          dirs)
2161     (if (string-match "/$" dir)
2162         (setq dir (substring dir 0 (match-beginning 0))))
2163     (while (not (file-exists-p dir))
2164       (setq dirs (cons dir dirs))
2165       (string-match "/[^/]+$" dir)
2166       (setq dir (substring dir 0 (match-beginning 0))))
2167     (while dirs
2168       (make-directory (car dirs))
2169       (setq dirs (cdr dirs)))))
2170
2171 (defun gnus-capitalize-newsgroup (newsgroup)
2172   "Capitalize NEWSGROUP name."
2173   (and (not (zerop (length newsgroup)))
2174        (concat (char-to-string (upcase (aref newsgroup 0)))
2175                (substring newsgroup 1))))
2176
2177 ;; Var
2178
2179 (defun gnus-simplify-subject (subject &optional re-only)
2180   "Remove `Re:' and words in parentheses.
2181 If optional argument RE-ONLY is non-nil, strip `Re:' only."
2182   (let ((case-fold-search t))           ;Ignore case.
2183     ;; Remove `Re:' and `Re^N:'.
2184     (if (string-match "^re:[ \t]*" subject)
2185         (setq subject (substring subject (match-end 0))))
2186     ;; Remove words in parentheses from end.
2187     (or re-only
2188         (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2189           (setq subject (substring subject 0 (match-beginning 0)))))
2190     ;; Return subject string.
2191     subject))
2192
2193 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2194 ;; all whitespace.
2195 (defun gnus-simplify-subject-fuzzy (subject)
2196   (let ((case-fold-search t))
2197     (save-excursion
2198       (gnus-set-work-buffer)
2199       (insert subject)
2200       (inline (gnus-simplify-buffer-fuzzy))
2201       (buffer-string))))
2202
2203 (defun gnus-simplify-buffer-fuzzy ()
2204   (goto-char (point-min))
2205   ;; Fix by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2206   (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2207                             nil t)
2208     (replace-match "" t t))
2209   (goto-char (point-min))
2210   (while (re-search-forward "[ \t\n]*([^()]*)[ \t\n]*$" nil t)
2211     (replace-match "" t t))
2212   (goto-char (point-min))
2213   (while (re-search-forward "[ \t]+" nil t)
2214     (replace-match " " t t))
2215   (goto-char (point-min))
2216   (while (re-search-forward "[ \t]+$" nil t)
2217     (replace-match "" t t))
2218   (goto-char (point-min))
2219   (while (re-search-forward "^[ \t]+" nil t)
2220     (replace-match "" t t)))
2221
2222 ;; Add the current buffer to the list of buffers to be killed on exit. 
2223 (defun gnus-add-current-to-buffer-list ()
2224   (or (memq (current-buffer) gnus-buffer-list)
2225       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
2226
2227 (defun gnus-string> (s1 s2)
2228   (not (or (string< s1 s2)
2229            (string= s1 s2))))
2230
2231 ;; Functions accessing headers.
2232 ;; Functions are more convenient than macros in some cases.
2233
2234 (defun gnus-header-number (header)
2235   (header-number header))
2236
2237 (defun gnus-header-subject (header)
2238   (header-subject header))
2239
2240 (defun gnus-header-from (header)
2241   (header-from header))
2242
2243 (defun gnus-header-xref (header)
2244   (header-xref header))
2245
2246 (defun gnus-header-lines (header)
2247   (header-lines header))
2248
2249 (defun gnus-header-date (header)
2250   (header-date header))
2251
2252 (defun gnus-header-id (header)
2253   (header-id header))
2254
2255 (defun gnus-header-references (header)
2256   (header-references header))
2257
2258 ;;; General various misc type functions.
2259
2260 (defun gnus-clear-system ()
2261   "Clear all variables and buffers."
2262   ;; Clear Gnus variables.
2263   (let ((variables gnus-variable-list))
2264     (while variables
2265       (set (car variables) nil)
2266       (setq variables (cdr variables))))
2267   ;; Clear other internal variables.
2268   (setq gnus-list-of-killed-groups nil
2269         gnus-have-read-active-file nil
2270         gnus-newsrc-alist nil
2271         gnus-newsrc-hashtb nil
2272         gnus-killed-list nil
2273         gnus-zombie-list nil
2274         gnus-killed-hashtb nil
2275         gnus-active-hashtb nil
2276         gnus-moderated-list nil
2277         gnus-description-hashtb nil
2278         gnus-newsgroup-headers nil
2279         gnus-newsgroup-headers-hashtb-by-number nil
2280         gnus-newsgroup-name nil
2281         gnus-server-alist nil
2282         gnus-current-select-method nil)
2283   ;; Reset any score variables.
2284   (and (boundp 'gnus-score-cache)
2285        (set 'gnus-score-cache nil))
2286   (and (boundp 'gnus-internal-global-score-files)
2287        (set 'gnus-internal-global-score-files nil))
2288   ;; Kill the startup file.
2289   (and gnus-current-startup-file
2290        (get-file-buffer gnus-current-startup-file)
2291        (kill-buffer (get-file-buffer gnus-current-startup-file)))
2292   ;; Save any cache buffers.
2293   (and gnus-use-cache (gnus-cache-save-buffers))
2294   ;; Clear the dribble buffer.
2295   (gnus-dribble-clear)
2296   ;; Kill global KILL file buffer.
2297   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
2298       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
2299   (gnus-kill-buffer nntp-server-buffer)
2300   ;; Kill Gnus buffers.
2301   (while gnus-buffer-list
2302     (gnus-kill-buffer (car gnus-buffer-list))
2303     (setq gnus-buffer-list (cdr gnus-buffer-list))))
2304
2305 (defun gnus-windows-old-to-new (setting)
2306   (if (symbolp setting)
2307       (setq setting 
2308             (cond ((eq setting 'SelectArticle)
2309                    'article)
2310                   ((eq setting 'SelectSubject)
2311                    'summary)
2312                   ((eq setting 'SelectNewsgroup)
2313                    'group)
2314                   (t setting))))
2315   (if (or (listp setting)
2316           (not (and gnus-window-configuration
2317                     (memq setting '(group summary article)))))
2318       setting
2319     (let* ((setting (if (eq setting 'group) 
2320                         (if (assq 'newsgroup gnus-window-configuration)
2321                             'newsgroup
2322                           'newsgroups) setting))
2323            (elem (car (cdr (assq setting gnus-window-configuration))))
2324            (total (apply '+ elem))
2325            (types '(group summary article))
2326            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
2327            (i 0)
2328            perc
2329            out)
2330       (while (< i 3)
2331         (or (zerop (nth i elem))
2332             (progn
2333               (setq perc  (/ (* 1.0 (nth 0 elem)) total))
2334               (setq out (cons (if (eq pbuf (nth i types))
2335                                   (vector (nth i types) perc 'point)
2336                                 (vector (nth i types) perc))
2337                               out))))
2338         (setq i (1+ i)))
2339       (list (nreverse out)))))
2340            
2341 (defun gnus-add-configuration (conf)
2342   (setq gnus-buffer-configuration 
2343         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
2344                          gnus-buffer-configuration))))
2345
2346 (defun gnus-configure-windows (setting)
2347   (setq setting (gnus-windows-old-to-new setting))
2348   (let ((r (if (symbolp setting)
2349                   (cdr (assq setting gnus-buffer-configuration))
2350                 setting))
2351         (in-buf (current-buffer))
2352         rule val window w height hor ohor heights sub jump-buffer
2353         rel total to-buf)
2354     (or r (error "No such setting: %s" setting))
2355
2356     ;; Either remove all windows or just remove all Gnus windows.
2357     (if gnus-use-full-window
2358         (delete-other-windows)
2359       (gnus-remove-some-windows)
2360       (switch-to-buffer nntp-server-buffer))
2361
2362     (while r
2363       (setq hor (car r)
2364             ohor nil)
2365
2366       ;; We have to do the (possible) horizontal splitting before the
2367       ;; vertical. 
2368       (if (and (listp (car hor)) 
2369                (eq (car (car hor)) 'horizontal))
2370           (progn
2371             (split-window 
2372              nil
2373              (if (integerp (nth 1 (car hor)))
2374                  (nth 1 (car hor))
2375                (- (frame-width) (floor (* (frame-width) (nth 1 (car hor))))))
2376              t)
2377             (setq hor (cdr hor))))
2378
2379       ;; Go through the rules and eval the elements that are to be
2380       ;; evaled.  
2381       (while hor
2382         (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor))))
2383             (progn
2384               ;; Expand short buffer name.
2385               (setq w (aref val 0))
2386               (and (setq w (cdr (assq w gnus-window-to-buffer)))
2387                    (progn
2388                      (setq val (apply 'vector (mapcar (lambda (v) v) val)))
2389                      (aset val 0 w)))
2390               (setq ohor (cons val ohor))))
2391         (setq hor (cdr hor)))
2392       (setq rule (cons (nreverse ohor) rule))
2393       (setq r (cdr r)))
2394     (setq rule (nreverse rule))
2395
2396     ;; We tally the window sizes.
2397     (setq total (window-height))
2398     (while rule
2399       (setq hor (car rule))
2400       (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal))
2401           (setq hor (cdr hor)))
2402       (setq sub 0)
2403       (while hor
2404         (setq rel (aref (car hor) 1)
2405               heights (cons
2406                        (cond ((and (floatp rel) (= 1.0 rel))
2407                               'x)
2408                              ((integerp rel)
2409                               rel)
2410                              (t
2411                               (max (floor (* total rel)) 4)))
2412                        heights)
2413               sub (+ sub (if (numberp (car heights)) (car heights) 0))
2414               hor (cdr hor)))
2415       (setq heights (nreverse heights)
2416             hor (car rule))
2417
2418       ;; We then go through these heighs and create windows for them.
2419       (while heights
2420         (setq height (car heights)
2421               heights (cdr heights))
2422         (and (eq height 'x)
2423              (setq height (- total sub)))
2424         (and heights
2425              (split-window nil height))
2426         (setq to-buf (aref (car hor) 0))
2427         (switch-to-buffer 
2428          (cond ((not to-buf)
2429                 in-buf)
2430                ((symbolp to-buf)
2431                 (symbol-value (aref (car hor) 0)))
2432                (t
2433                 (aref (car hor) 0))))
2434         (and (> (length (car hor)) 2)
2435              (eq (aref (car hor) 2) 'point)
2436              (setq jump-buffer (current-buffer)))
2437         (other-window 1)
2438         (setq hor (cdr hor)))
2439       
2440       (setq rule (cdr rule)))
2441
2442     ;; Finally, we pop to the buffer that's supposed to have point. 
2443     (or jump-buffer (error "Missing `point' in spec for %s" setting))
2444
2445     (select-window (get-buffer-window jump-buffer))
2446     (set-buffer jump-buffer)))
2447       
2448 (defun gnus-remove-some-windows ()
2449   (let ((buffers gnus-window-to-buffer)
2450         (first t)
2451         buf)
2452     (while buffers
2453       (setq buf (cdr (car buffers)))
2454       (if (symbolp buf)
2455           (setq buf (and (boundp buf) (symbol-value buf))))
2456       (and buf 
2457            (get-buffer-window buf)
2458            (progn
2459              (set-buffer buf)
2460              (if first
2461                  (progn
2462                    (switch-to-buffer nntp-server-buffer)
2463                    (setq first nil))
2464                (delete-window (get-buffer-window buf)))))
2465       (setq buffers (cdr buffers)))
2466     (set-buffer nntp-server-buffer)))
2467
2468 (defun gnus-version ()
2469   "Version numbers of this version of Gnus."
2470   (interactive)
2471   (let ((methods gnus-valid-select-methods)
2472         (mess gnus-version)
2473         meth)
2474     ;; Go through all the legal select methods and add their version
2475     ;; numbers to the total version string. Only the backends that are
2476     ;; currently in use will have their message numbers taken into
2477     ;; consideration. 
2478     (while methods
2479       (setq meth (intern (concat (car (car methods)) "-version")))
2480       (and (boundp meth)
2481            (stringp (symbol-value meth))
2482            (setq mess (concat mess "; " (symbol-value meth))))
2483       (setq methods (cdr methods)))
2484     (gnus-message 2 mess)))
2485
2486 (defun gnus-info-find-node ()
2487   "Find Info documentation of Gnus."
2488   (interactive)
2489   ;; Enlarge info window if needed.
2490   (let ((mode major-mode))
2491     (gnus-configure-windows 'info)
2492     (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))))
2493
2494 (defun gnus-bug ()
2495   "Send a bug report to the Gnus maintainers."
2496   (interactive)
2497   (let ((winconf (current-window-configuration)))
2498     (delete-other-windows)
2499     (switch-to-buffer "*Gnus Bug Help*")
2500     (erase-buffer)
2501     (insert gnus-bug-message)
2502     (goto-char (point-min))
2503     (pop-to-buffer "*Gnus Bug*")
2504     (erase-buffer)
2505     (mail-mode)
2506     (mail-setup gnus-maintainer nil nil nil nil nil)
2507     (make-local-variable 'gnus-prev-winconf)
2508     (setq gnus-prev-winconf winconf)
2509     (goto-char (point-min))
2510     (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
2511     (forward-line 1)
2512     (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version)))
2513     (let ((b (point)))
2514       (gnus-debug)
2515       (goto-char (- b 3)))
2516     (message "")))
2517
2518 (defun gnus-debug ()
2519   "Attemps to go through the Gnus source file and report what variables have been changed.
2520 The source file has to be in the Emacs load path."
2521   (interactive)
2522   (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el"))
2523         file dirs expr olist)
2524     (save-excursion
2525       (set-buffer (get-buffer-create " *gnus bug info*"))
2526       (buffer-disable-undo (current-buffer))
2527       (message "Please wait while we snoop your variables...")
2528       (sit-for 0)
2529       (while files
2530         (erase-buffer)
2531         (setq dirs load-path)
2532         (while dirs
2533           (if (or (not (car dirs))
2534                   (not (stringp (car dirs)))
2535                   (not (file-exists-p 
2536                         (setq file (concat (file-name-as-directory 
2537                                             (car dirs)) (car files))))))
2538               (setq dirs (cdr dirs))
2539             (setq dirs nil)
2540             (insert-file-contents file)
2541             (goto-char (point-min))
2542             (or (re-search-forward "^;;* Internal variables" nil t)
2543                 (error "Malformed sources in file %s" file))
2544             (narrow-to-region (point-min) (point))
2545             (goto-char (point-min))
2546             (while (setq expr (condition-case () 
2547                                   (read (current-buffer)) (error nil)))
2548               (and (eq (car expr) 'defvar)
2549                    (stringp (nth 3 expr))
2550                    (or (not (boundp (nth 1 expr)))
2551                        (not (equal (eval (nth 2 expr))
2552                                    (symbol-value (nth 1 expr)))))
2553                    (setq olist (cons (nth 1 expr) olist))))))
2554         (setq files (cdr files)))
2555       (kill-buffer (current-buffer)))
2556     (insert "------------------- Environment follows -------------------\n\n")
2557     (while olist
2558       (if (boundp (car olist))
2559           (insert "(setq " (symbol-name (car olist)) " '" 
2560                   (prin1-to-string (symbol-value (car olist))) ")\n")
2561         (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
2562       (setq olist (cdr olist)))
2563     (insert "\n\n")))
2564
2565 (defun gnus-overload-functions (&optional overloads)
2566   "Overload functions specified by optional argument OVERLOADS.
2567 If nothing is specified, use the variable gnus-overload-functions."
2568   (let ((defs nil)
2569         (overloads (or overloads gnus-overload-functions)))
2570     (while overloads
2571       (setq defs (car overloads))
2572       (setq overloads (cdr overloads))
2573       ;; Load file before overloading function if necessary.  Make
2574       ;; sure we cannot use `require' always.
2575       (and (not (fboundp (car defs)))
2576            (car (cdr (cdr defs)))
2577            (load (car (cdr (cdr defs))) nil 'nomessage))
2578       (fset (car defs) (car (cdr defs))))))
2579
2580 (defun gnus-replace-chars-in-string (string from to)
2581   "Replace characters in STRING from FROM to TO."
2582   (let ((string (substring string 0))   ;Copy string.
2583         (len (length string))
2584         (idx 0))
2585     ;; Replace all occurrences of FROM with TO.
2586     (while (< idx len)
2587       (if (= (aref string idx) from)
2588           (aset string idx to))
2589       (setq idx (1+ idx)))
2590     string))
2591
2592 (defun gnus-days-between (date1 date2)
2593   ;; Return the number of days between date1 and date2.
2594   (- (gnus-day-number date1) (gnus-day-number date2)))
2595
2596 (defun gnus-day-number (date)
2597   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
2598                      (timezone-parse-date date))))
2599     (timezone-absolute-from-gregorian 
2600      (nth 1 dat) (nth 2 dat) (car dat))))
2601
2602 ;; Returns a floating point number that says how many seconds have
2603 ;; lapsed between Jan 1 12:00:00 1970 and DATE.
2604 (defun gnus-seconds-since-epoch (date)
2605   (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
2606                         (timezone-parse-date date)))
2607          (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
2608                         (timezone-parse-time
2609                          (aref (timezone-parse-date date) 3))))
2610          (edate (mapcar (lambda (ti) (and ti (string-to-int ti)))
2611                         (timezone-parse-date "Jan 1 12:00:00 1970")))
2612          (tday (- (timezone-absolute-from-gregorian 
2613                    (nth 1 tdate) (nth 2 tdate) (nth 0 tdate))
2614                   (timezone-absolute-from-gregorian 
2615                    (nth 1 edate) (nth 2 edate) (nth 0 edate)))))
2616     (+ (nth 2 ttime)
2617        (* (nth 1 ttime) 60)
2618        (* 1.0 (nth 0 ttime) 60 60)
2619        (* 1.0 tday 60 60 24))))
2620
2621 (defun gnus-file-newer-than (file date)
2622   (let ((fdate (nth 5 (file-attributes file))))
2623     (or (> (car fdate) (car date))
2624         (and (= (car fdate) (car date))
2625              (> (nth 1 fdate) (nth 1 date))))))
2626
2627 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
2628 ;; the echo area.
2629 (defun gnus-y-or-n-p (prompt)
2630   (prog1
2631       (y-or-n-p prompt)
2632     (message "")))
2633
2634 (defun gnus-yes-or-no-p (prompt)
2635   (prog1
2636       (yes-or-no-p prompt)
2637     (message "")))
2638
2639 ;; Check whether to use long file names.
2640 (defun gnus-use-long-file-name (symbol)
2641   ;; The variable has to be set...
2642   (and gnus-use-long-file-name
2643        ;; If it isn't a list, then we return t.
2644        (or (not (listp gnus-use-long-file-name))
2645            ;; If it is a list, and the list contains `symbol', we
2646            ;; return nil.  
2647            (not (memq symbol gnus-use-long-file-name)))))
2648
2649 ;; I suspect there's a better way, but I haven't taken the time to do
2650 ;; it yet. -erik selberg@cs.washington.edu
2651 (defun gnus-dd-mmm (messy-date)
2652   "Return a string like DD-MMM from a big messy string"
2653   (let ((datevec (timezone-parse-date messy-date)))
2654     (format "%2s-%s"
2655             (or (aref datevec 2) "??")
2656             (capitalize
2657              (or (car 
2658                   (nth (1- (string-to-number (aref datevec 1)))
2659                        timezone-months-assoc))
2660                  "???")))))
2661
2662 ;; Make a hash table (default and minimum size is 255).
2663 ;; Optional argument HASHSIZE specifies the table size.
2664 (defun gnus-make-hashtable (&optional hashsize)
2665   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
2666
2667 ;; Make a number that is suitable for hashing; bigger than MIN and one
2668 ;; less than 2^x.
2669 (defun gnus-create-hash-size (min)
2670   (let ((i 1))
2671     (while (< i min)
2672       (setq i (* 2 i)))
2673     (1- i)))
2674
2675 ;; Show message if message has a lower level than `gnus-verbose'. 
2676 ;; Guide-line for numbers:
2677 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
2678 ;; for things that take a long time, 7 - not very important messages
2679 ;; on stuff, 9 - messages inside loops.
2680 (defun gnus-message (level &rest args)
2681   (if (<= level gnus-verbose)
2682       (apply 'message args)
2683     ;; We have to do this format thingie here even if the result isn't
2684     ;; shown - the return value has to be the same as the return value
2685     ;; from `message'.
2686     (apply 'format args)))
2687
2688 ;; Generate a unique new group name.
2689 (defun gnus-generate-new-group-name (leaf)
2690   (let ((name leaf)
2691         (num 0))
2692     (while (gnus-gethash name gnus-newsrc-hashtb)
2693       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
2694     name))
2695
2696 (defun gnus-find-file-noselect (file &optional force)
2697   "Does vaguely the same as find-file-noselect. No hooks are run."
2698   (let (buf insert)
2699     (if (setq buf (get-file-buffer file))
2700         (setq insert force)
2701       (setq buf (create-file-buffer file))
2702       (setq insert t))
2703     (if (not insert)
2704         buf
2705       (save-excursion
2706         (set-buffer buf)
2707         (erase-buffer)
2708         (and (file-readable-p file)
2709              (insert-file-contents file))
2710         (set-visited-file-name file)
2711         (set-buffer-modified-p nil)
2712         (current-buffer)))))
2713
2714 ;;; List and range functions
2715
2716 (defun gnus-last-element (list)
2717   "Return last element of LIST."
2718   (while (cdr list)
2719     (setq list (cdr list)))
2720   (car list))
2721
2722 (defun gnus-copy-sequence (list)
2723   "Do a complete, total copy of a list."
2724   (if (and (consp list) (not (consp (cdr list))))
2725       (cons (car list) (cdr list))
2726     (mapcar (lambda (elem) (if (consp elem) 
2727                                (if (consp (cdr elem))
2728                                    (gnus-copy-sequence elem)
2729                                  (cons (car elem) (cdr elem)))
2730                              elem))
2731             list)))
2732
2733 (defun gnus-set-difference (list1 list2)
2734   "Return a list of elements of LIST1 that do not appear in LIST2."
2735   (let ((list1 (copy-sequence list1)))
2736     (while list2
2737       (setq list1 (delq (car list2) list1))
2738       (setq list2 (cdr list2)))
2739     list1))
2740
2741 (defun gnus-sorted-complement (list1 list2)
2742   "Return a list of elements of LIST1 that do not appear in LIST2.
2743 Both lists have to be sorted over <."
2744   (let (out)
2745     (if (or (null list1) (null list2))
2746         (or list1 list2)
2747       (while (and list1 list2)
2748         (cond ((= (car list1) (car list2))
2749                (setq list1 (cdr list1)
2750                      list2 (cdr list2)))
2751               ((< (car list1) (car list2))
2752                (setq out (cons (car list1) out))
2753                (setq list1 (cdr list1)))
2754               (t
2755                (setq out (cons (car list2) out))
2756                (setq list2 (cdr list2)))))
2757       (nconc (nreverse out) (or list1 list2)))))
2758
2759 (defun gnus-intersection (list1 list2)      
2760   (let ((result nil))
2761     (while list2
2762       (if (memq (car list2) list1)
2763           (setq result (cons (car list2) result)))
2764       (setq list2 (cdr list2)))
2765     result))
2766
2767 (defun gnus-sorted-intersection (list1 list2)
2768   ;; LIST1 and LIST2 have to be sorted over <.
2769   (let (out)
2770     (while (and list1 list2)
2771       (cond ((= (car list1) (car list2))
2772              (setq out (cons (car list1) out)
2773                    list1 (cdr list1)
2774                    list2 (cdr list2)))
2775             ((< (car list1) (car list2))
2776              (setq list1 (cdr list1)))
2777             (t
2778              (setq list2 (cdr list2)))))
2779     (nreverse out)))
2780
2781 (defun gnus-set-sorted-intersection (list1 list2)
2782   ;; LIST1 and LIST2 have to be sorted over <.
2783   ;; This function modifies LIST1.
2784   (let* ((top (cons nil list1))
2785          (prev top))
2786   (while (and list1 list2)
2787     (cond ((= (car list1) (car list2))
2788            (setq prev list1
2789                  list1 (cdr list1)
2790                  list2 (cdr list2)))
2791           ((< (car list1) (car list2))
2792            (setcdr prev (cdr list1))
2793            (setq list1 (cdr list1)))
2794           (t
2795            (setq list2 (cdr list2)))))
2796   (setcdr prev nil)
2797   (cdr top)))
2798
2799 (defun gnus-compress-sequence (numbers &optional always-list)
2800   "Convert list of numbers to a list of ranges or a single range.
2801 If ALWAYS-LIST is non-nil, this function will always release a list of
2802 ranges."
2803   (let* ((first (car numbers))
2804          (last (car numbers))
2805          result)
2806     (if (null numbers)
2807         nil
2808       (if (not (listp (cdr numbers)))
2809           numbers
2810         (while numbers
2811           (cond ((= last (car numbers)) nil) ;Omit duplicated number
2812                 ((= (1+ last) (car numbers)) ;Still in sequence
2813                  (setq last (car numbers)))
2814                 (t                      ;End of one sequence
2815                  (setq result 
2816                        (cons (if (= first last) first
2817                                (cons first last)) result))
2818                  (setq first (car numbers))
2819                  (setq last  (car numbers))))
2820           (setq numbers (cdr numbers)))
2821         (if (and (not always-list) (null result))
2822             (if (= first last) (list first) (cons first last))
2823           (nreverse (cons (if (= first last) first (cons first last))
2824                           result)))))))
2825
2826 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
2827 (defun gnus-uncompress-range (ranges)
2828   "Expand a list of ranges into a list of numbers.
2829 RANGES is either a single range on the form `(num . num)' or a list of
2830 these ranges."
2831   (let (first last result)
2832     (cond 
2833      ((null ranges)
2834       nil)
2835      ((not (listp (cdr ranges)))
2836       (setq first (car ranges))
2837       (setq last (cdr ranges))
2838       (while (<= first last)
2839         (setq result (cons first result))
2840         (setq first (1+ first)))
2841       (nreverse result))
2842      (t
2843       (while ranges
2844         (if (atom (car ranges))
2845             (if (numberp (car ranges))
2846                 (setq result (cons (car ranges) result)))
2847           (setq first (car (car ranges)))
2848           (setq last  (cdr (car ranges)))
2849           (while (<= first last)
2850             (setq result (cons first result))
2851             (setq first (1+ first))))
2852         (setq ranges (cdr ranges)))
2853       (nreverse result)))))
2854
2855 (defun gnus-add-to-range (ranges list)
2856   "Return a list of ranges that has all articles from both RANGES and LIST.
2857 Note: LIST has to be sorted over `<'."
2858   (if (not ranges)
2859       (gnus-compress-sequence list t)
2860     (setq list (copy-sequence list))
2861     (or (listp (cdr ranges))
2862         (setq ranges (list ranges)))
2863     (let ((out ranges)
2864           ilist lowest highest temp)
2865       (while (and ranges list)
2866         (setq ilist list)
2867         (setq lowest (or (and (atom (car ranges)) (car ranges))
2868                          (car (car ranges))))
2869         (while (and list (cdr list) (< (car (cdr list)) lowest))
2870           (setq list (cdr list)))
2871         (if (< (car ilist) lowest)
2872             (progn
2873               (setq temp list)
2874               (setq list (cdr list))
2875               (setcdr temp nil)
2876               (setq out (nconc (gnus-compress-sequence ilist t) out))))
2877         (setq highest (or (and (atom (car ranges)) (car ranges))
2878                           (cdr (car ranges))))
2879         (while (and list (<= (car list) highest))
2880           (setq list (cdr list)))
2881         (setq ranges (cdr ranges)))
2882       (if list
2883           (setq out (nconc (gnus-compress-sequence list t) out)))
2884       (setq out (sort out (lambda (r1 r2) 
2885                             (< (or (and (atom r1) r1) (car r1))
2886                                (or (and (atom r2) r2) (car r2))))))
2887       (setq ranges out)
2888       (while ranges
2889         (if (atom (car ranges))
2890             (if (cdr ranges)
2891                 (if (atom (car (cdr ranges)))
2892                     (if (= (1+ (car ranges)) (car (cdr ranges)))
2893                         (progn
2894                           (setcar ranges (cons (car ranges) 
2895                                                (car (cdr ranges))))
2896                           (setcdr ranges (cdr (cdr ranges)))))
2897                   (if (= (1+ (car ranges)) (car (car (cdr ranges))))
2898                       (progn
2899                         (setcar (car (cdr ranges)) (car ranges))
2900                         (setcar ranges (car (cdr ranges)))
2901                         (setcdr ranges (cdr (cdr ranges)))))))
2902           (if (cdr ranges)
2903               (if (atom (car (cdr ranges)))
2904                   (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
2905                       (progn
2906                         (setcdr (car ranges) (car (cdr ranges)))
2907                         (setcdr ranges (cdr (cdr ranges)))))
2908                 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
2909                     (progn
2910                       (setcdr (car ranges) (cdr (car (cdr ranges))))
2911                       (setcdr ranges (cdr (cdr ranges))))))))
2912         (setq ranges (cdr ranges)))
2913       out)))
2914
2915 (defun gnus-remove-from-range (ranges list)
2916   "Return a list of ranges that has all articles from LIST removed from RANGES.
2917 Note: LIST has to be sorted over `<'."
2918   ;; !!! This function shouldn't look like this, but I've got a headache.
2919   (gnus-compress-sequence 
2920    (gnus-sorted-complement
2921     (gnus-uncompress-range ranges) list)))
2922
2923 (defun gnus-member-of-range (number ranges)
2924   (if (not (listp (cdr ranges)))
2925       (and (>= number (car ranges)) 
2926            (<= number (cdr ranges)))
2927     (let ((not-stop t))
2928       (while (and ranges 
2929                   (if (numberp (car ranges))
2930                       (>= number (car ranges))
2931                     (>= number (car (car ranges))))
2932                   not-stop)
2933         (if (if (numberp (car ranges))
2934                 (= number (car ranges))
2935               (and (>= number (car (car ranges)))
2936                    (<= number (cdr (car ranges)))))
2937             (setq not-stop nil))
2938         (setq ranges (cdr ranges)))
2939       (not not-stop))))
2940
2941 \f
2942 ;;;
2943 ;;; Gnus group mode
2944 ;;;
2945
2946 (defvar gnus-group-mode-map nil)
2947 (defvar gnus-group-group-map nil)
2948 (defvar gnus-group-mark-map nil)
2949 (defvar gnus-group-list-map nil)
2950 (defvar gnus-group-sub-map nil)
2951 (put 'gnus-group-mode 'mode-class 'special)
2952
2953 (if gnus-group-mode-map
2954     nil
2955   (setq gnus-group-mode-map (make-keymap))
2956   (suppress-keymap gnus-group-mode-map)
2957   (define-key gnus-group-mode-map " " 'gnus-group-read-group)
2958   (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
2959   (define-key gnus-group-mode-map "\r" 'gnus-group-select-group)
2960   (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
2961   (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
2962   (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
2963   (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
2964   (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
2965   (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
2966   (define-key gnus-group-mode-map "\M-n" 'gnus-group-next-unread-group-same-level)
2967   (define-key gnus-group-mode-map "\M-p" 'gnus-group-prev-unread-group-same-level)
2968   (define-key gnus-group-mode-map "," 'gnus-group-best-unread-group)
2969   (define-key gnus-group-mode-map "." 'gnus-group-first-unread-group)
2970   (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
2971   (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
2972   (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current)
2973   (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all)
2974   (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
2975   (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
2976   (define-key gnus-group-mode-map "m" 'gnus-group-mail)
2977   (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
2978   (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group)
2979   (define-key gnus-group-mode-map "R" 'gnus-group-restart)
2980   (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file)
2981   (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server)
2982   (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
2983   (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups)
2984   (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group)
2985   (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups)
2986   (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos)
2987   (define-key gnus-group-mode-map "\C-c\M-C-a" 'gnus-group-description-apropos)
2988   (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
2989   (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
2990   (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
2991   (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
2992   (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
2993   (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
2994   (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
2995   (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed)
2996   (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles)
2997   (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups)
2998   (define-key gnus-group-mode-map "V" 'gnus-version)
2999   (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc)
3000   (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
3001   (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble)
3002   (define-key gnus-group-mode-map "q" 'gnus-group-exit)
3003   (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
3004   (define-key gnus-group-mode-map "\M-f" 'gnus-group-fetch-faq)
3005   (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
3006   (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
3007   (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method)
3008   (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode)
3009   (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group)
3010   (define-key gnus-group-mode-map "<" 'beginning-of-buffer)
3011   (define-key gnus-group-mode-map ">" 'end-of-buffer)
3012   (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug)
3013   (define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups)
3014
3015   (define-key gnus-group-mode-map "#" 'gnus-group-mark-group)
3016   (define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group)
3017   (define-prefix-command 'gnus-group-mark-map)
3018   (define-key gnus-group-mode-map "M" 'gnus-group-mark-map)
3019   (define-key gnus-group-mark-map "m" 'gnus-group-mark-group)
3020   (define-key gnus-group-mark-map "u" 'gnus-group-unmark-group)
3021   (define-key gnus-group-mark-map "w" 'gnus-group-mark-region)
3022
3023   (define-prefix-command 'gnus-group-group-map)
3024   (define-key gnus-group-mode-map "G" 'gnus-group-group-map)
3025   (define-key gnus-group-group-map "d" 'gnus-group-make-directory-group)
3026   (define-key gnus-group-group-map "h" 'gnus-group-make-help-group)
3027   (define-key gnus-group-group-map "a" 'gnus-group-make-archive-group)
3028   (define-key gnus-group-group-map "k" 'gnus-group-make-kiboze-group)
3029   (define-key gnus-group-group-map "m" 'gnus-group-make-group)
3030   (define-key gnus-group-group-map "E" 'gnus-group-edit-group)
3031   (define-key gnus-group-group-map "e" 'gnus-group-edit-group-method)
3032   (define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters)
3033   (define-key gnus-group-group-map "v" 'gnus-group-add-to-virtual)
3034   (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual)
3035   (define-key gnus-group-group-map "D" 'gnus-group-enter-directory)
3036   (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group)
3037   (define-key gnus-group-group-map "sb" 'gnus-group-brew-soup)
3038   (define-key gnus-group-group-map "sw" 'gnus-soup-save-areas)
3039   (define-key gnus-group-group-map "ss" 'gnus-soup-send-replies)
3040   (define-key gnus-group-group-map "sp" 'gnus-soup-pack-packet)
3041   (define-key gnus-group-group-map "sr" 'nnsoup-pack-replies)
3042
3043   (define-prefix-command 'gnus-group-list-map)
3044   (define-key gnus-group-mode-map "A" 'gnus-group-list-map)
3045   (define-key gnus-group-list-map "k" 'gnus-group-list-killed)
3046   (define-key gnus-group-list-map "z" 'gnus-group-list-zombies)
3047   (define-key gnus-group-list-map "s" 'gnus-group-list-groups)
3048   (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups)
3049   (define-key gnus-group-list-map "a" 'gnus-group-apropos)
3050   (define-key gnus-group-list-map "d" 'gnus-group-description-apropos)
3051   (define-key gnus-group-list-map "m" 'gnus-group-list-matching)
3052   (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching)
3053
3054   (define-prefix-command 'gnus-group-sub-map)
3055   (define-key gnus-group-mode-map "S" 'gnus-group-sub-map)
3056   (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level)
3057   (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group)
3058   (define-key gnus-group-sub-map "s" 'gnus-group-unsubscribe-group)
3059   (define-key gnus-group-sub-map "k" 'gnus-group-kill-group)
3060   (define-key gnus-group-sub-map "y" 'gnus-group-yank-group)
3061   (define-key gnus-group-sub-map "w" 'gnus-group-kill-region)
3062   (define-key gnus-group-sub-map "z" 'gnus-group-kill-all-zombies))
3063
3064 (defun gnus-group-mode ()
3065   "Major mode for reading news.
3066
3067 All normal editing commands are switched off.
3068 \\<gnus-group-mode-map>
3069 The group buffer lists (some of) the groups available.  For instance,
3070 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
3071 lists all zombie groups. 
3072
3073 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe 
3074 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. 
3075
3076 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). 
3077
3078 The following commands are available:
3079
3080 \\{gnus-group-mode-map}"
3081   (interactive)
3082   (if gnus-visual (gnus-group-make-menu-bar))
3083   (kill-all-local-variables)
3084   (setq mode-line-modified "-- ")
3085   (make-local-variable 'mode-line-format)
3086   (setq mode-line-format (copy-sequence mode-line-format))
3087   (and (equal (nth 3 mode-line-format) "   ")
3088        (setcar (nthcdr 3 mode-line-format) ""))
3089   (setq major-mode 'gnus-group-mode)
3090   (setq mode-name "Group")
3091   (gnus-group-set-mode-line)
3092   (setq mode-line-process nil)
3093   (use-local-map gnus-group-mode-map)
3094   (buffer-disable-undo (current-buffer))
3095   (setq truncate-lines t)
3096   (setq buffer-read-only t)
3097   (run-hooks 'gnus-group-mode-hook))
3098
3099 (defun gnus-mouse-pick-group (e)
3100   (interactive "e")
3101   (mouse-set-point e)
3102   (gnus-group-read-group nil))
3103
3104 ;;;###autoload
3105 (defun gnus-no-server (&optional arg)
3106   "Read network news.
3107 If ARG is a positive number, Gnus will use that as the
3108 startup level. If ARG is nil, Gnus will be started at level 2. 
3109 If ARG is non-nil and not a positive number, Gnus will
3110 prompt the user for the name of an NNTP server to use.
3111 As opposed to `gnus', this command will not connect to the local server."
3112   (interactive "P")
3113   (gnus (or arg (1- gnus-level-default-subscribed)) t))
3114
3115 (defalias '\(ding\) 'gnus)
3116
3117 ;;;###autoload
3118 (defun gnus (&optional arg dont-connect)
3119   "Read network news.
3120 If ARG is non-nil and a positive number, Gnus will use that as the
3121 startup level. If ARG is non-nil and not a positive number, Gnus will
3122 prompt the user for the name of an NNTP server to use."
3123   (interactive "P")
3124   (if (get-buffer gnus-group-buffer)
3125       (progn
3126         (switch-to-buffer gnus-group-buffer)
3127         (gnus-group-get-new-news))
3128     (gnus-clear-system)
3129     (nnheader-init-server-buffer)
3130     (gnus-read-init-file)
3131     (let ((level (and arg (numberp arg) (> arg 0) arg))
3132           did-connect)
3133       (unwind-protect
3134           (progn
3135             (gnus-group-setup-buffer)
3136             (or dont-connect 
3137                 (setq did-connect
3138                       (gnus-start-news-server (and arg (not level))))))
3139         (if (and (not dont-connect) 
3140                  (not did-connect))
3141             (gnus-group-quit)
3142           (run-hooks 'gnus-startup-hook)
3143           ;; NNTP server is successfully open. 
3144           (gnus-update-format-specifications)
3145           (gnus-summary-make-display-table)
3146           (let ((buffer-read-only nil))
3147             (erase-buffer)
3148             (if (not gnus-inhibit-startup-message)
3149                 (progn
3150                   (gnus-group-startup-message)
3151                   (sit-for 0))))
3152           (gnus-setup-news nil level)
3153           (and gnus-use-dribble-file (gnus-dribble-open))
3154           (gnus-group-list-groups level)
3155           (gnus-configure-windows 'group))))))
3156
3157 (defun gnus-group-startup-message (&optional x y)
3158   "Insert startup message in current buffer."
3159   ;; Insert the message.
3160   (erase-buffer)
3161   (insert
3162    (format "
3163     %s
3164            A newsreader 
3165       for GNU Emacs
3166
3167         Based on GNUS 
3168              written by 
3169      Masanobu UMEDA
3170
3171     Lars Magne 
3172          Ingebrigtsen 
3173       larsi@ifi.uio.no
3174
3175            gnus-version))
3176   ;; And then hack it.
3177   ;; 18 is the longest line.
3178   (indent-rigidly (point-min) (point-max) 
3179                   (/ (max (- (window-width) (or x 28)) 0) 2))
3180   (goto-char (point-min))
3181   ;; +4 is fuzzy factor.
3182   (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)))
3183
3184 (defun gnus-group-setup-buffer ()
3185   (or (get-buffer gnus-group-buffer)
3186       (progn
3187         (switch-to-buffer gnus-group-buffer)
3188         (gnus-add-current-to-buffer-list)
3189         (gnus-group-mode)
3190         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
3191
3192 (defun gnus-group-list-groups (level &optional unread)
3193   "List newsgroups with level LEVEL or lower that have unread articles.
3194 Default is all subscribed groups.
3195 If argument UNREAD is non-nil, groups with no unread articles are also listed."
3196   (interactive (list (and current-prefix-arg
3197                           (prefix-numeric-value current-prefix-arg))))
3198   (if gnus-group-use-permanent-levels
3199       (progn
3200         (setq gnus-group-default-list-level 
3201               (or level gnus-group-default-list-level))
3202         (setq level (or gnus-group-default-list-level gnus-level-subscribed)))
3203     (setq level (or level gnus-group-default-list-level 
3204                     gnus-level-subscribed)))
3205   (gnus-group-setup-buffer)     ;May call from out of group buffer
3206   (let ((case-fold-search nil)
3207         (group (gnus-group-group-name)))
3208     (funcall gnus-group-prepare-function level unread nil)
3209     (if (zerop (buffer-size))
3210         (gnus-message 5 gnus-no-groups-message)
3211       (goto-char (point-min))
3212       (if (not group)
3213           ;; Go to the first group with unread articles.
3214           (gnus-group-search-forward nil nil nil t)
3215         ;; Find the right group to put point on. If the current group
3216         ;; has disapeared in the new listing, try to find the next
3217         ;; one. If no next one can be found, just leave point at the
3218         ;; first newsgroup in the buffer.
3219         (if (not (gnus-goto-char
3220                   (text-property-any (point-min) (point-max) 
3221                                      'gnus-group (intern group))))
3222             (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
3223               (while (and newsrc
3224                           (not (gnus-goto-char 
3225                                 (text-property-any 
3226                                  (point-min) (point-max) 'gnus-group 
3227                                  (intern (car (car newsrc)))))))
3228                 (setq newsrc (cdr newsrc)))
3229               (or newsrc (progn (goto-char (point-max))
3230                                 (forward-line -1))))))
3231       ;; Adjust cursor point.
3232       (gnus-group-position-cursor))))
3233
3234 (defun gnus-group-prepare-flat (level &optional all lowest regexp) 
3235   "List all newsgroups with unread articles of level LEVEL or lower.
3236 If ALL is non-nil, list groups that have no unread articles.
3237 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
3238 If REGEXP, only list groups matching REGEXP."
3239   (set-buffer gnus-group-buffer)
3240   (let ((buffer-read-only nil)
3241         (newsrc (cdr gnus-newsrc-alist))
3242         (lowest (or lowest 1))
3243         info clevel unread group)
3244     (erase-buffer)
3245     (if (< lowest gnus-level-zombie)
3246         ;; List living groups.
3247         (while newsrc
3248           (setq info (car newsrc)
3249                 group (car info)
3250                 newsrc (cdr newsrc)
3251                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
3252           (and unread ; This group might be bogus
3253                (or (not regexp)
3254                    (string-match regexp group))
3255                (<= (setq clevel (car (cdr info))) level) 
3256                (>= clevel lowest)
3257                (or all            ; We list all groups?
3258                    (eq unread t)  ; We list unactivated groups
3259                    (> unread 0)   ; We list groups with unread articles
3260                    (cdr (assq 'tick (nth 3 info)))) ; And groups with tickeds
3261                (gnus-group-insert-group-line 
3262                 nil group (car (cdr info)) (nth 3 info) unread (nth 4 info)))))
3263
3264     ;; List dead groups.
3265     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
3266          (gnus-group-prepare-flat-list-dead 
3267           (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 
3268           gnus-level-zombie ?Z
3269           regexp))
3270     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
3271          (gnus-group-prepare-flat-list-dead 
3272           (setq gnus-killed-list (sort gnus-killed-list 'string<)) 
3273           gnus-level-killed ?K regexp))
3274
3275     (gnus-group-set-mode-line)
3276     (setq gnus-have-all-newsgroups all)
3277     (run-hooks 'gnus-group-prepare-hook)))
3278
3279 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
3280   ;; List zombies and killed lists somehwat faster, which was
3281   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
3282   ;; this by ignoring the group format specification altogether.
3283   (let (group beg)
3284     (while groups
3285       (setq group (car groups)
3286             groups (cdr groups))
3287       (if (or (not regexp)
3288               (string-match regexp group))
3289           (progn
3290             (setq beg (point))
3291             (insert (format " %c     *: %s\n" mark group))
3292             (add-text-properties 
3293              beg (1+ beg) 
3294              (list 'gnus-group (intern group)
3295                    'gnus-unread t
3296                    'gnus-level level)))))))
3297
3298 (defun gnus-group-real-name (group)
3299   "Find the real name of a foreign newsgroup."
3300   (if (string-match ":[^:]+$" group)
3301       (substring group (1+ (match-beginning 0)))
3302     group))
3303
3304 (defun gnus-group-prefixed-name (group method)
3305   "Return the whole name from GROUP and METHOD."
3306   (and (stringp method) (setq method (gnus-server-to-method method)))
3307   (concat (format "%s" (car method))
3308           (if (and 
3309                (assoc (format "%s" (car method)) (gnus-methods-using 'address))
3310                (not (string= (nth 1 method) "")))
3311               (concat "+" (nth 1 method)))
3312           ":" group))
3313
3314 (defun gnus-group-real-prefix (group)
3315   "Return the prefix of the current group name."
3316   (if (string-match "^[^:]+:" group)
3317       (substring group 0 (match-end 0))
3318     ""))
3319
3320 (defun gnus-group-method-name (group)
3321   "Return the method used for selecting GROUP."
3322   (let ((prefix (gnus-group-real-prefix group)))
3323     (if (equal prefix "")
3324         gnus-select-method
3325       (if (string-match "^[^\\+]+\\+" prefix)
3326           (list (intern (substring prefix 0 (1- (match-end 0))))
3327                 (substring prefix (match-end 0) (1- (length prefix))))
3328         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
3329
3330 (defun gnus-group-foreign-p (group)
3331   "Return nil if GROUP is native, non-nil if it is foreign."
3332   (string-match ":" group))
3333
3334 (defun gnus-group-set-info (info &optional method-only-group part)
3335   (let* ((entry (gnus-gethash
3336                  (or method-only-group (car info)) gnus-newsrc-hashtb))
3337          (part-info info)
3338          (info (if method-only-group (nth 2 entry) info)))
3339     (if (not method-only-group)
3340         ()
3341       (or entry
3342           (error "Trying to change non-existent group %s" method-only-group))
3343       ;; We have recevied parts of the actual group info - either the
3344       ;; select method or the group parameters.  We first check
3345       ;; whether we have to extend the info, and if so, do that.
3346       (let ((len (length info))
3347             (total (if (eq part 'method) 5 6)))
3348         (and (< len total)
3349              (setcdr (nthcdr (1- len) info)
3350                      (make-list (- total len) nil)))
3351         ;; Then we enter the new info.
3352         (setcar (nthcdr (1- total) info) part-info)))
3353     ;; We uncompress some lists of marked articles.
3354     (let (marked)
3355       (if (not (setq marked (nth 3 info)))
3356           ()
3357         (while marked
3358           (or (eq 'score (car (car marked)))
3359               (eq 'bookmark (car (car marked)))
3360               (eq 'killed (car (car marked)))
3361               (setcdr (car marked) 
3362                       (gnus-uncompress-range (cdr (car marked)))))
3363           (setq marked (cdr marked)))))
3364     (if entry
3365         ()
3366       ;; This is a new group, so we just create it.
3367       (save-excursion
3368         (set-buffer gnus-group-buffer)
3369         (if (nth 4 info)
3370             ;; It's a foreign group...
3371             (gnus-group-make-group 
3372              (gnus-group-real-name (car info))
3373              (prin1-to-string (car (nth 4 info)))
3374              (nth 1 (nth 4 info)))
3375           ;; It's a native group.
3376           (gnus-group-make-group
3377            (car info)
3378            (prin1-to-string (car gnus-select-method))
3379            (nth 1 gnus-select-method)))
3380         (gnus-message 6 "Note: New group created")
3381         (setq entry 
3382               (gnus-gethash (gnus-group-prefixed-name 
3383                              (gnus-group-real-name (car info))
3384                              (or (nth 4 info) gnus-select-method))
3385                             gnus-newsrc-hashtb))))
3386     ;; Whether it was a new group or not, we now have the entry, so we
3387     ;; can do the update.
3388     (if entry
3389         (progn
3390           (setcar (nthcdr 2 entry) info)
3391           (if (and (not (eq (car entry) t)) 
3392                    (gnus-gethash (car info) gnus-active-hashtb))
3393               (let ((marked (nth 3 info)))
3394                 (setcar entry 
3395                         (max 0 (- (length (gnus-list-of-unread-articles 
3396                                            (car info)))
3397                                   (length (cdr (assq 'tick marked)))
3398                                   (length (cdr (assq 'dormant marked)))))))))
3399       (error "No such group: %s" (car info)))))
3400
3401 (defun gnus-group-set-method-info (group select-method)
3402   (gnus-group-set-info select-method group 'method))
3403
3404 (defun gnus-group-set-params-info (group params)
3405   (gnus-group-set-info params group 'params))
3406
3407 (defun gnus-group-update-group-line ()
3408   "This function updates the current line in the newsgroup buffer and
3409 moves the point to the colon."
3410   (let* ((buffer-read-only nil)
3411          (group (gnus-group-group-name))
3412          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
3413     (if entry
3414         (gnus-dribble-enter 
3415          (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
3416                  ")")))
3417     (beginning-of-line)
3418     (delete-region (point) (progn (forward-line 1) (point)))
3419     (gnus-group-insert-group-line-info group)
3420     (forward-line -1)
3421     (gnus-group-position-cursor)))
3422
3423 (defun gnus-group-insert-group-line-info (group)
3424   (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) 
3425         active info)
3426     (if entry
3427         (progn
3428           (setq info (nth 2 entry))
3429           (gnus-group-insert-group-line 
3430            nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
3431       (setq active (gnus-gethash group gnus-active-hashtb))
3432       (gnus-group-insert-group-line 
3433        nil group (if (member group gnus-zombie-list) gnus-level-zombie
3434                    gnus-level-killed)
3435        nil (if active (- (1+ (cdr active)) (car active)) 0) nil))))
3436
3437 (defun gnus-group-insert-group-line (gformat group level marked number method)
3438   (let* ((gformat (or gformat gnus-group-line-format-spec))
3439          (active (gnus-gethash group gnus-active-hashtb))
3440          (number-total (if active (1+ (- (cdr active) (car active))) 0))
3441          (number-of-dormant (length (cdr (assq 'dormant marked))))
3442          (number-of-ticked (length (cdr (assq 'tick marked))))
3443          (number-of-ticked-and-dormant
3444           (+ number-of-ticked number-of-dormant))
3445          (number-of-unread-unticked 
3446           (if (numberp number) (int-to-string (max 0 number))
3447             "*"))
3448          (number-of-read
3449           (if (numberp number)
3450               (max 0 (- number-total number))
3451             "*"))
3452          (subscribed (cond ((<= level gnus-level-subscribed) ? )
3453                            ((<= level gnus-level-unsubscribed) ?U)
3454                            ((= level gnus-level-zombie) ?Z)
3455                            (t ?K)))
3456          (qualified-group (gnus-group-real-name group))
3457          (newsgroup-description 
3458           (if gnus-description-hashtb
3459               (or (gnus-gethash group gnus-description-hashtb) "")
3460             ""))
3461          (moderated (if (member group gnus-moderated-list) ?m ? ))
3462          (moderated-string (if (eq moderated ?m) "(m)" ""))
3463          (method (gnus-server-get-method group method))
3464          (news-server (or (car (cdr method)) ""))
3465          (news-method (or (car method) ""))
3466          (news-method-string 
3467           (if method (format "(%s:%s)" (car method) (car (cdr method))) ""))
3468          (marked (if (and 
3469                       (numberp number) 
3470                       (zerop number)
3471                       (> number-of-ticked 0))
3472                      ?* ? ))
3473          (number (if (eq number t) "*" (+ number number-of-dormant 
3474                                           number-of-ticked)))
3475          (process-marked (if (member qualified-group gnus-group-marked)
3476                              gnus-process-mark ? ))
3477          (buffer-read-only nil)
3478          b)
3479     (beginning-of-line)
3480     (setq b (point))
3481     ;; Insert the text.
3482     (insert (eval gformat))
3483
3484     (add-text-properties 
3485      b (1+ b) (list 'gnus-group (intern group)
3486                     'gnus-unread (if (numberp number)
3487                                      (string-to-int number-of-unread-unticked)
3488                                    t)
3489                     'gnus-marked marked
3490                     'gnus-level level))))
3491
3492 (defun gnus-group-update-group (group &optional visible-only)
3493   "Update newsgroup info of GROUP.
3494 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already."
3495   (save-excursion
3496     (set-buffer gnus-group-buffer)
3497     (let ((buffer-read-only nil)
3498           visible)
3499       (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
3500         (if entry
3501             (gnus-dribble-enter 
3502              (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
3503                      ")"))))
3504       ;; Buffer may be narrowed.
3505       (save-restriction
3506         (widen)
3507         ;; Search a line to modify.  If the buffer is large, the search
3508         ;; takes long time.  In most cases, current point is on the line
3509         ;; we are looking for.  So, first of all, check current line. 
3510         (if (or (progn
3511                   (beginning-of-line)
3512                   (eq (get-text-property (point) 'gnus-group)
3513                       (intern group)))
3514                 (progn
3515                   (gnus-goto-char 
3516                    (text-property-any 
3517                     (point-min) (point-max) 'gnus-group (intern group)))))
3518             ;; GROUP is listed in current buffer. So, delete old line.
3519             (progn
3520               (setq visible t)
3521               (beginning-of-line)
3522               (delete-region (point) (progn (forward-line 1) (point))))
3523           ;; No such line in the buffer, find out where it's supposed to
3524           ;; go, and insert it there (or at the end of the buffer).
3525           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
3526           (or visible-only
3527               (let ((entry 
3528                      (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
3529                 (while (and entry
3530                             (car entry)
3531                             (not
3532                              (gnus-goto-char
3533                               (text-property-any
3534                                (point-min) (point-max) 
3535                                'gnus-group (intern (car (car entry)))))))
3536                   (setq entry (cdr entry)))
3537                 (or entry (goto-char (point-max)))))))
3538       (if (or visible (not visible-only))
3539           (gnus-group-insert-group-line-info group))
3540       (gnus-group-set-mode-line))))
3541
3542 (defun gnus-group-set-mode-line ()
3543   (if (memq 'group gnus-updated-mode-lines)
3544       (let* ((gformat (or gnus-group-mode-line-format-spec
3545                           (setq gnus-group-mode-line-format-spec
3546                                 (gnus-parse-format 
3547                                  gnus-group-mode-line-format 
3548                                  gnus-group-mode-line-format-alist))))
3549              (news-server (car (cdr gnus-select-method)))
3550              (news-method (car gnus-select-method))
3551              (max-len 60)
3552              (mode-string (eval gformat)))
3553         (setq mode-string (eval gformat))
3554         (if (> (length mode-string) max-len) 
3555             (setq mode-string (substring mode-string 0 (- max-len 4))))
3556         (setq mode-line-buffer-identification mode-string)
3557         (set-buffer-modified-p t))))
3558
3559 (defun gnus-group-group-name ()
3560   "Get the name of the newsgroup on the current line."
3561   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
3562     (and group (symbol-name group))))
3563
3564 (defun gnus-group-group-level ()
3565   "Get the level of the newsgroup on the current line."
3566   (get-text-property (gnus-point-at-bol) 'gnus-level))
3567
3568 (defun gnus-group-search-forward (&optional backward all level first-too)
3569   "Find the next newsgroup with unread articles.
3570 If BACKWARD is non-nil, find the previous newsgroup instead.
3571 If ALL is non-nil, just find any newsgroup.
3572 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
3573 group exists.
3574 If FIRST-TOO, the current line is also eligible as a target."
3575   (let ((way (if backward -1 1))
3576         (low 10)
3577         (beg (point))
3578         pos found)
3579     (if (and backward (progn (beginning-of-line)) (bobp))
3580         nil
3581       (or first-too (forward-line way))
3582       (while (and 
3583               (not (eobp))
3584               (not (setq 
3585                     found 
3586                     (and (or all
3587                              (and
3588                               (let ((unread 
3589                                      (get-text-property (point) 'gnus-unread)))
3590                                 (or (eq unread t) (and unread (> unread 0))))
3591                               (let ((lev (get-text-property
3592                                           (point) 'gnus-level)))
3593                                 (and lev (<= (get-text-property 
3594                                               (point) 'gnus-level)
3595                                              gnus-level-subscribed)))))
3596                          (or (not level)
3597                              (let ((lev (get-text-property (point) 'gnus-level)))
3598                                (if (and lev (<= lev level))
3599                                    t
3600                                  (if (< lev low)
3601                                      (progn
3602                                        (setq low lev)
3603                                        (setq pos (point))))
3604                                  nil))))))
3605               (zerop (forward-line way)))))
3606     (if found 
3607         (progn (gnus-group-position-cursor) t)
3608       (if pos (goto-char pos) (goto-char beg))
3609       nil)))
3610
3611 ;;; Gnus group mode commands
3612
3613 ;; Group marking.
3614
3615 (defun gnus-group-mark-group (n &optional unmark)
3616   "Mark the current group."
3617   (interactive "p")
3618   (let ((buffer-read-only nil)
3619         group)
3620     (while 
3621         (and (> n 0) 
3622              (setq group (gnus-group-group-name))
3623              (progn
3624                (beginning-of-line)
3625                (forward-char 2)
3626                (delete-char 1)
3627                (if unmark
3628                    (progn
3629                      (insert " ")
3630                      (setq gnus-group-marked (delete group gnus-group-marked)))
3631                  (insert "#")
3632                  (setq gnus-group-marked
3633                        (cons group (delete group gnus-group-marked))))
3634                t)
3635              (zerop (gnus-group-next-group 1)))
3636       (setq n (1- n)))
3637     (gnus-summary-position-cursor)
3638     n))
3639
3640 (defun gnus-group-unmark-group (n)
3641   "Remove the mark from the current group."
3642   (interactive "p")
3643   (gnus-group-mark-group n 'unmark))
3644
3645 (defun gnus-group-mark-region (unmark beg end)
3646   "Mark all groups between point and mark.
3647 If UNMARK, remove the mark instead."
3648   (interactive "P\nr")
3649   (let ((num (count-lines beg end)))
3650     (save-excursion
3651       (goto-char beg)
3652       (- num (gnus-group-mark-group num unmark)))))
3653
3654 (defun gnus-group-remove-mark (group)
3655   (and (gnus-group-goto-group group)
3656        (save-excursion
3657          (gnus-group-mark-group 1 'unmark))))
3658
3659 ;; Return a list of groups to work on.  Take into consideration N (the
3660 ;; prefix) and the list of marked groups.
3661 (defun gnus-group-process-prefix (n)
3662   (cond (n
3663          (setq n (prefix-numeric-value n))
3664          ;; There is a prefix, so we return a list of the N next
3665          ;; groups. 
3666          (let ((way (if (< n 0) -1 1))
3667                (n (abs n))
3668                group groups)
3669            (save-excursion
3670              (while (and (> n 0)
3671                          (setq group (gnus-group-group-name)))
3672                (setq groups (cons group groups))
3673                (setq n (1- n))
3674                (forward-line way)))
3675            (nreverse groups)))
3676         (gnus-group-marked
3677          ;; No prefix, but a list of marked articles.
3678          (reverse gnus-group-marked))
3679         (t
3680          ;; Neither marked articles or a prefix, so we return the
3681          ;; current group.
3682          (let ((group (gnus-group-group-name)))
3683            (and group (list group))))))
3684
3685 ;; Selecting groups.
3686
3687 (defun gnus-group-read-group (all &optional no-article group)
3688   "Read news in this newsgroup.
3689 If argument ALL is non-nil, already read articles become readable.
3690 If optional argument NO-ARTICLE is non-nil, no article body is displayed."
3691   (interactive "P")
3692   (let ((group (or group (gnus-group-group-name)))
3693         number active marked entry)
3694     (or group (error "No group on current line"))
3695     (setq marked 
3696           (nth 3 (nth 2 (setq entry (gnus-gethash group gnus-newsrc-hashtb)))))
3697     ;; This group might be a dead group. In that case we have to get
3698     ;; the number of unread articles from `gnus-active-hashtb'.
3699     (if entry
3700         (setq number (car entry))
3701       (if (setq active (gnus-gethash group gnus-active-hashtb))
3702           (setq number (- (1+ (cdr active)) (car active)))))
3703     (gnus-summary-read-group 
3704      group (or all (and (numberp number) 
3705                         (zerop (+ number (length (cdr (assq 'tick marked)))
3706                                   (length (cdr (assq 'dormant marked)))))))
3707      no-article)))
3708
3709 (defun gnus-group-select-group (all)
3710   "Select this newsgroup.
3711 No article is selected automatically.
3712 If argument ALL is non-nil, already read articles become readable."
3713   (interactive "P")
3714   (gnus-group-read-group all t))
3715
3716 ;; Enter a group that is not in the group buffer. Non-nil is returned
3717 ;; if selection was successful.
3718 (defun gnus-group-read-ephemeral-group 
3719   (group method &optional activate quit-config)
3720   (let ((group (if (gnus-group-foreign-p group) group
3721                  (gnus-group-prefixed-name group method))))
3722     (gnus-sethash 
3723      group
3724      (list t nil (list group gnus-level-default-subscribed nil nil 
3725                        (append method
3726                                (list
3727                                 (list 'quit-config 
3728                                       (if quit-config quit-config
3729                                         (cons (current-buffer) 'summary)))))))
3730      gnus-newsrc-hashtb)
3731     (set-buffer gnus-group-buffer)
3732     (or (gnus-server-opened method)
3733         (gnus-open-server method)
3734         (error "Unable to contact server: %s" (gnus-status-message method)))
3735     (if activate (gnus-request-group group))
3736     (condition-case ()
3737         (gnus-group-read-group t t group)
3738       (error nil)
3739       (quit nil))
3740     (not (equal major-mode 'gnus-group-mode))))
3741   
3742 (defun gnus-group-jump-to-group (group)
3743   "Jump to newsgroup GROUP."
3744   (interactive 
3745    (list (completing-read 
3746           "Group: " gnus-active-hashtb nil (not (not gnus-read-active-file)))))
3747
3748   (if (equal group "")
3749       (error "Empty group name"))
3750
3751   (let ((b (text-property-any 
3752             (point-min) (point-max) 'gnus-group (intern group))))
3753     (if b
3754         ;; Either go to the line in the group buffer...
3755         (goto-char b)
3756       ;; ... or insert the line.
3757       (or
3758        (gnus-gethash group gnus-active-hashtb)
3759        (gnus-activate-newsgroup group)
3760        (error "%s error: %s" group (gnus-status-message group)))
3761
3762       (gnus-group-update-group group)
3763       (goto-char (text-property-any 
3764                   (point-min) (point-max) 'gnus-group (intern group)))))
3765   ;; Adjust cursor point.
3766   (gnus-group-position-cursor))
3767
3768 (defun gnus-group-goto-group (group)
3769   "Goto to newsgroup GROUP."
3770   (let ((b (text-property-any (point-min) (point-max) 
3771                               'gnus-group (intern group))))
3772     (and b (goto-char b))))
3773
3774 (defun gnus-group-next-group (n)
3775   "Go to next N'th newsgroup.
3776 If N is negative, search backward instead.
3777 Returns the difference between N and the number of skips actually
3778 done."
3779   (interactive "p")
3780   (gnus-group-next-unread-group n t))
3781
3782 (defun gnus-group-next-unread-group (n &optional all level)
3783   "Go to next N'th unread newsgroup.
3784 If N is negative, search backward instead.
3785 If ALL is non-nil, choose any newsgroup, unread or not.
3786 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
3787 such group can be found, the next group with a level higher than
3788 LEVEL.
3789 Returns the difference between N and the number of skips actually
3790 made."
3791   (interactive "p")
3792   (let ((backward (< n 0))
3793         (n (abs n)))
3794     (while (and (> n 0)
3795                 (gnus-group-search-forward 
3796                  backward (or (not gnus-group-goto-unread) all) level))
3797       (setq n (1- n)))
3798     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
3799                                (if level " on this level or higher" "")))
3800     n))
3801
3802 (defun gnus-group-prev-group (n)
3803   "Go to previous N'th newsgroup.
3804 Returns the difference between N and the number of skips actually
3805 done."
3806   (interactive "p")
3807   (gnus-group-next-unread-group (- n) t))
3808
3809 (defun gnus-group-prev-unread-group (n)
3810   "Go to previous N'th unread newsgroup.
3811 Returns the difference between N and the number of skips actually
3812 done."  
3813   (interactive "p")
3814   (gnus-group-next-unread-group (- n)))
3815
3816 (defun gnus-group-next-unread-group-same-level (n)
3817   "Go to next N'th unread newsgroup on the same level.
3818 If N is negative, search backward instead.
3819 Returns the difference between N and the number of skips actually
3820 done."
3821   (interactive "p")
3822   (gnus-group-next-unread-group n t (gnus-group-group-level))
3823   (gnus-group-position-cursor))
3824
3825 (defun gnus-group-prev-unread-group-same-level (n)
3826   "Go to next N'th unread newsgroup on the same level.
3827 Returns the difference between N and the number of skips actually
3828 done."
3829   (interactive "p")
3830   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
3831   (gnus-group-position-cursor))
3832
3833 (defun gnus-group-best-unread-group (&optional exclude-group)
3834   "Go to the group with the highest level.
3835 If EXCLUDE-GROUP, do not go to that group."
3836   (interactive)
3837   (goto-char (point-min))
3838   (let ((best 100000)
3839         unread best-point)
3840     (while (setq unread (get-text-property (point) 'gnus-unread))
3841       (if (and (numberp unread) (> unread 0))
3842           (progn
3843             (or best-point (setq best-point (point)))
3844             (if (and (< (get-text-property (point) 'gnus-level) best)
3845                      (or (not exclude-group)
3846                          (not (equal exclude-group (gnus-group-group-name)))))
3847                 (progn 
3848                   (setq best (get-text-property (point) 'gnus-level))
3849                   (setq best-point (point))))))
3850       (forward-line 1))
3851     (if best-point (goto-char best-point))
3852     (gnus-summary-position-cursor)
3853     (and best-point (gnus-group-group-name))))
3854
3855 (defun gnus-group-first-unread-group ()
3856   "Go to the first group with unread articles."
3857   (interactive)
3858   (goto-char (point-min))
3859   (or (not (zerop (or (get-text-property (point) 'gnus-unread) 0)))
3860       (gnus-group-next-unread-group 1))
3861   (gnus-group-position-cursor))
3862
3863 (defun gnus-group-enter-server-mode ()
3864   "Jump to the server buffer."
3865   (interactive)
3866   (gnus-server-setup-buffer)
3867   (gnus-configure-windows 'server)
3868   (gnus-server-prepare))
3869
3870 (defun gnus-group-make-group (name method &optional address)
3871   "Add a new newsgroup.
3872 The user will be prompted for a NAME, for a select METHOD, and an
3873 ADDRESS."
3874   (interactive
3875    (cons 
3876     (read-string "Group name: ")
3877     (let ((method
3878            (completing-read 
3879             "Method: " (append gnus-valid-select-methods gnus-server-alist)
3880             nil t)))
3881       (if (assoc method gnus-valid-select-methods)
3882           (list method
3883                 (if (memq 'prompt-address
3884                           (assoc method gnus-valid-select-methods))
3885                     (read-string "Address: ")
3886                   ""))
3887         (list method nil)))))
3888   
3889   (let* ((meth (if address (list (intern method) address) method))
3890          (nname (gnus-group-prefixed-name name meth))
3891          info)
3892     (and (gnus-gethash nname gnus-newsrc-hashtb)
3893          (error "Group %s already exists" nname))
3894     (gnus-group-change-level 
3895      (setq info (list t nname gnus-level-default-subscribed nil nil meth))
3896      gnus-level-default-subscribed gnus-level-killed 
3897      (and (gnus-group-group-name)
3898           (gnus-gethash (gnus-group-group-name)
3899                         gnus-newsrc-hashtb))
3900      t)
3901     (gnus-sethash nname '(0 . 0) gnus-active-hashtb)
3902     (gnus-dribble-enter 
3903      (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))
3904     (gnus-group-insert-group-line-info nname)
3905
3906     (and (gnus-check-backend-function 'request-create-group nname)
3907          (gnus-request-create-group nname))))
3908
3909 (defun gnus-group-edit-group (group &optional part)
3910   "Edit the group on the current line."
3911   (interactive (list (gnus-group-group-name)))
3912   (let ((done-func '(lambda () 
3913                       "Exit editing mode and update the information."
3914                       (interactive)
3915                       (gnus-group-edit-group-done 'part 'group)))
3916         (part (or part 'info))
3917         (winconf (current-window-configuration))
3918         info)
3919     (or group (error "No group on current line"))
3920     (or (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
3921         (error "Killed group; can't be edited"))
3922     (set-buffer (get-buffer-create gnus-group-edit-buffer))
3923     (gnus-configure-windows 'edit-group)
3924     (gnus-add-current-to-buffer-list)
3925     (emacs-lisp-mode)
3926     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
3927     (use-local-map (copy-keymap emacs-lisp-mode-map))
3928     (local-set-key "\C-c\C-c" done-func)
3929     (make-local-variable 'gnus-prev-winconf)
3930     (setq gnus-prev-winconf winconf)
3931     ;; We modify the func to let it know what part it is editing.
3932     (setcar (cdr (nth 4 done-func)) (list 'quote part))
3933     (setcar (cdr (cdr (nth 4 done-func))) group)
3934     (erase-buffer)
3935     (insert
3936      (cond 
3937       ((eq part 'method)
3938        ";; Type `C-c C-c' after editing the select method.\n\n")
3939       ((eq part 'params)
3940        ";; Type `C-c C-c' after editing the group parameters.\n\n")
3941       ((eq part 'info)
3942        ";; Type `C-c C-c' after editing the group info.\n\n")))
3943     (let ((cinfo (gnus-copy-sequence info))
3944           marked)
3945       (if (not (setq marked (nth 3 cinfo)))
3946           ()
3947         (while marked
3948           (or (eq 'score (car (car marked)))
3949               (eq 'bookmark (car (car marked)))
3950               (eq 'killed (car (car marked)))
3951               (setcdr (car marked) 
3952                       (gnus-compress-sequence (sort (cdr (car marked)) '<) t)))
3953           (setq marked (cdr marked))))
3954       (insert 
3955        (pp-to-string
3956         (cond ((eq part 'method)
3957                (or (nth 4 info) "native"))
3958               ((eq part 'params)
3959                (nth 5 info))
3960               (t
3961                cinfo)))
3962        "\n"))))
3963
3964 (defun gnus-group-edit-group-method (group)
3965   "Edit the select method of GROUP."
3966   (interactive (list (gnus-group-group-name)))
3967   (gnus-group-edit-group group 'method))
3968
3969 (defun gnus-group-edit-group-parameters (group)
3970   "Edit the group parameters of GROUP."
3971   (interactive (list (gnus-group-group-name)))
3972   (gnus-group-edit-group group 'params))
3973
3974 (defun gnus-group-edit-group-done (part group)
3975   "Get info from buffer, update variables and jump to the group buffer."
3976   (set-buffer (get-buffer-create gnus-group-edit-buffer))
3977   (goto-char (point-min))
3978   (let ((form (read (current-buffer)))
3979         (winconf gnus-prev-winconf))
3980     (if (eq part 'info) 
3981         (gnus-group-set-info form)
3982       (gnus-group-set-info form group part))
3983     (kill-buffer (current-buffer))
3984     (and winconf (set-window-configuration winconf))
3985     (set-buffer gnus-group-buffer)
3986     (gnus-group-update-group (gnus-group-group-name))
3987     (gnus-group-position-cursor)))
3988
3989 (defun gnus-group-make-help-group ()
3990   "Create the (ding) Gnus documentation group."
3991   (interactive)
3992   (let ((path load-path))
3993     (and (gnus-gethash (setq name (gnus-group-prefixed-name
3994                                    "gnus-help" '(nndoc "gnus-help")))
3995                        gnus-newsrc-hashtb)
3996          (error "Documentation group already exists"))
3997     (while (and path
3998                 (not (file-exists-p (concat (file-name-as-directory (car path))
3999                                             "doc.txt"))))
4000       (setq path (cdr path)))
4001     (or path (error "Couldn't find doc group"))
4002     (gnus-group-make-group 
4003      (gnus-group-real-name name)
4004      (list 'nndoc name
4005            (list 'nndoc-address (concat (file-name-as-directory (car path)) "doc.txt"))
4006            (list 'nndoc-article-type 'mbox))))
4007   (gnus-group-position-cursor))
4008
4009 (defun gnus-group-make-doc-group (file type)
4010   "Create a group that uses a single file as the source."
4011   (interactive 
4012    (list (read-file-name "File name: ") 
4013          (let ((err "")
4014                found char)
4015            (while (not found)
4016              (message "%sFile type (mbox, babyl, digest) [mbd]: " err)
4017              (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
4018                                ((= char ?b) 'babyl)
4019                                ((= char ?d) 'digest)
4020                                (t (setq mess "%c unknown. " char)
4021                                   nil))))
4022            found)))
4023   (let* ((file (expand-file-name file))
4024          (name (gnus-generate-new-group-name
4025                 (gnus-group-prefixed-name
4026                  (file-name-nondirectory file) '(nndoc "")))))
4027     (gnus-group-make-group 
4028      (gnus-group-real-name name)
4029      (list 'nndoc name
4030            (list 'nndoc-address file)
4031            (list 'nndoc-article-type type)))))
4032
4033 (defun gnus-group-make-archive-group ()
4034   "Create the (ding) Gnus archive group."
4035   (interactive)
4036   (and (gnus-gethash (gnus-group-prefixed-name "ding.archives" '(nndir ""))
4037                      gnus-newsrc-hashtb)
4038        (error "Archive group already exists"))
4039   (gnus-group-make-group "ding.archives" "nndir" gnus-group-archive-directory)
4040   (gnus-group-position-cursor))
4041
4042 (defun gnus-group-make-directory-group (dir)
4043   "Create an nndir group.
4044 The user will be prompted for a directory. The contents of this
4045 directory will be used as a newsgroup. The directory should contain
4046 mail messages or news articles in files that have numeric names."
4047   (interactive
4048    (list (read-file-name "Create group from directory: ")))
4049   (or (file-exists-p dir) (error "No such directory"))
4050   (or (file-directory-p dir) (error "Not a directory"))
4051   (gnus-group-make-group dir "nndir" dir)
4052   (gnus-group-position-cursor))
4053
4054 (defun gnus-group-make-kiboze-group (group address scores)
4055   "Create an nnkiboze group.
4056 The user will be prompted for a name, a regexp to match groups, and
4057 score file entries for articles to include in the group."
4058   (interactive
4059    (list
4060     (read-string "nnkiboze group name: ")
4061     (read-string "Source groups (regexp): ")
4062     (let ((headers (mapcar (lambda (group) (list group))
4063                            '("subject" "from" "number" "date" "message-id"
4064                              "references" "chars" "lines" "xref")))
4065           scores header regexp regexps)
4066       (while (not (equal "" (setq header (completing-read 
4067                                           "Match on header: " headers nil t))))
4068         (setq regexps nil)
4069         (while (not (equal "" (setq regexp (read-string 
4070                                             (format "Match on %s (string): "
4071                                                     header)))))
4072           (setq regexps (cons (list regexp nil nil 'r) regexps)))
4073         (setq scores (cons (cons header regexps) scores)))
4074       scores)))
4075   (gnus-group-make-group group "nnkiboze" address)
4076   (save-excursion
4077     (gnus-set-work-buffer)
4078     (let (emacs-lisp-mode-hook)
4079       (pp scores (current-buffer)))
4080     (write-region (point-min) (point-max) 
4081                   (concat (or gnus-kill-files-directory "~/News")
4082                           "nnkiboze:" group "." gnus-score-file-suffix)))
4083   (gnus-group-position-cursor))
4084
4085 (defun gnus-group-add-to-virtual (n vgroup)
4086   "Add the current group to a virtual group."
4087   (interactive
4088    (list current-prefix-arg
4089          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
4090                           "nnvirtual:")))
4091   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
4092       (error "%s is not an nnvirtual group" vgroup))
4093   (let* ((groups (gnus-group-process-prefix n))
4094          (method (nth 4 (nth 2 (gnus-gethash vgroup gnus-newsrc-hashtb)))))
4095     (setcar (cdr method)
4096             (concat 
4097              (nth 1 method) "\\|"
4098              (mapconcat 
4099               (lambda (s) 
4100                 (gnus-group-remove-mark s)
4101                 (concat "\\(^" (regexp-quote s) "$\\)"))
4102               groups "\\|"))))
4103   (gnus-group-position-cursor))
4104
4105 (defun gnus-group-make-empty-virtual (group)
4106   "Create a new, fresh, empty virtual group."
4107   (interactive "sCreate new, empty virtual group: ")
4108   (let* ((method (list 'nnvirtual "^$"))
4109          (pgroup (gnus-group-prefixed-name group method)))
4110     ;; Check whether it exists already.
4111     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
4112          (error "Group %s already exists." pgroup))
4113     ;; Subscribe the new group after the group on the current line.
4114     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
4115     (gnus-group-update-group pgroup)
4116     (forward-line -1)
4117     (gnus-group-position-cursor)))
4118
4119 (defun gnus-group-enter-directory (dir)
4120   "Enter an ephemeral nneething group."
4121   (interactive "DDirectory to read: ")
4122   (let* ((method (list 'nneething dir))
4123          (leaf (gnus-group-prefixed-name
4124                 (file-name-nondirectory (directory-file-name dir))
4125                 method))
4126          (name (gnus-generate-new-group-name leaf))
4127          (num 0))
4128     (let ((nneething-read-only t))
4129       (or (gnus-group-read-ephemeral-group 
4130            name method t
4131            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
4132                                       'summary 'group)))
4133           (error "Couldn't enter %s" dir)))))
4134
4135 ;; Group sorting commands
4136 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
4137
4138 (defun gnus-group-sort-groups ()
4139   "Sort the group buffer using `gnus-group-sort-function'."
4140   (interactive)
4141   (setq gnus-newsrc-alist 
4142         (sort (cdr gnus-newsrc-alist) gnus-group-sort-function))
4143   (gnus-make-hashtable-from-newsrc-alist)
4144   (gnus-group-list-groups nil gnus-have-all-newsgroups))
4145
4146 (defun gnus-group-sort-by-alphabet (info1 info2)
4147   (string< (car info1) (car info2)))
4148
4149 (defun gnus-group-sort-by-unread (info1 info2)
4150   (let ((n1 (car (gnus-gethash (car info1) gnus-newsrc-hashtb)))
4151         (n2 (car (gnus-gethash (car info2) gnus-newsrc-hashtb))))
4152     (< (or (and (numberp n1) n1) 0)
4153        (or (and (numberp n2) n2) 0))))
4154
4155 (defun gnus-group-sort-by-level (info1 info2)
4156   (< (nth 1 info1) (nth 1 info2)))
4157
4158 ;; Group catching up.
4159
4160 (defun gnus-group-catchup-current (n &optional all)
4161   "Mark all articles not marked as unread in current newsgroup as read.
4162 If prefix argument N is numeric, the ARG next newsgroups will be
4163 caught up. If ALL is non-nil, marked articles will also be marked as
4164 read. Cross references (Xref: header) of articles are ignored.
4165 The difference between N and actual number of newsgroups that were
4166 caught up is returned."
4167   (interactive "P")
4168   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
4169                gnus-expert-user
4170                (gnus-y-or-n-p
4171                 (if all
4172                     "Do you really want to mark all articles as read? "
4173                   "Mark all unread articles as read? "))))
4174       n
4175     (let ((groups (gnus-group-process-prefix n))
4176           (ret 0))
4177       (while groups
4178         ;; Virtual groups have to be given special treatment. 
4179         (let ((method (gnus-find-method-for-group (car groups))))
4180           (if (eq 'nnvirtual (car method))
4181               (nnvirtual-catchup-group
4182                (gnus-group-real-name (car groups)) (nth 1 method) all)))
4183         (gnus-group-remove-mark (car groups))
4184         (if (prog1
4185                 (gnus-group-goto-group (car groups))
4186               (gnus-group-catchup (car groups) all))
4187             (gnus-group-update-group-line)
4188           (setq ret (1+ ret)))
4189         (setq groups (cdr groups)))
4190       (gnus-group-next-unread-group 1)
4191       ret)))
4192
4193 (defun gnus-group-catchup-current-all (n)
4194   "Mark all articles in current newsgroup as read.
4195 Cross references (Xref: header) of articles are ignored."
4196   (interactive "P")
4197   (gnus-group-catchup-current n 'all))
4198
4199 (defun gnus-group-catchup (group &optional all)
4200   "Mark all articles in GROUP as read.
4201 If ALL is non-nil, all articles are marked as read.
4202 The return value is the number of articles that were marked as read,
4203 or nil if no action could be taken."
4204   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
4205          (num (car entry))
4206          (marked (nth 3 (nth 2 entry)))
4207          ticked)
4208     (if (not (numberp (car entry)))
4209         (gnus-message 1 "Can't catch up; non-active group")
4210       ;; Do the updating only if the newsgroup isn't killed.
4211       (if (not entry)
4212           ()
4213         (gnus-update-read-articles 
4214          group (and (not all) (append (cdr (assq 'tick marked))
4215                                       (cdr (assq 'dormant marked))))
4216          nil (and (not all) (cdr (assq 'tick marked))))
4217         (and all marked
4218              (setcar (nthcdr 3 (nth 2 entry)) 
4219                      (delq (assq 'dormant marked) 
4220                            (nth 3 (nth 2 entry)))))))
4221     num))
4222
4223 (defun gnus-group-expire-articles (n)
4224   "Expire all expirable articles in the current newsgroup."
4225   (interactive "P")
4226   (let ((groups (gnus-group-process-prefix n))
4227         group)
4228     (or groups (error "No groups to expire"))
4229     (while groups
4230       (setq group (car groups)
4231             groups (cdr groups))
4232       (gnus-group-remove-mark group)
4233       (if (not (gnus-check-backend-function 'request-expire-articles group))
4234           ()
4235         (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
4236                (expirable (if (memq 'total-expire (nth 5 info))
4237                               (cons nil (gnus-list-of-read-articles group))
4238                             (assq 'expire (nth 3 info)))))
4239           (and expirable 
4240                (setcdr expirable
4241                        (gnus-request-expire-articles 
4242                         (cdr expirable) group))))))))
4243
4244 (defun gnus-group-expire-all-groups ()
4245   "Expire all expirable articles in all newsgroups."
4246   (interactive)
4247   (gnus-message 5 "Expiring...")
4248   (let ((gnus-group-marked (mapcar (lambda (info) (car info))
4249                                    (cdr gnus-newsrc-alist))))
4250     (gnus-group-expire-articles nil))
4251   (gnus-message 5 "Expiring...done"))
4252
4253 (defun gnus-group-set-current-level (n level)
4254   "Set the level of the next N groups to LEVEL."
4255   (interactive "P\nnLevel: ")
4256   (or (and (>= level 1) (<= level gnus-level-killed))
4257       (error "Illegal level: %d" level))
4258   (let ((groups (gnus-group-process-prefix n))
4259         group)
4260     (while groups
4261       (setq group (car groups)
4262             groups (cdr groups))
4263       (gnus-group-remove-mark group)
4264       (gnus-message 6 "Changed level of %s from %d to %d" 
4265                     group (gnus-group-group-level) level)
4266       (gnus-group-change-level group level
4267                                (gnus-group-group-level))
4268       (gnus-group-update-group-line)))
4269   (gnus-group-position-cursor))
4270
4271 (defun gnus-group-unsubscribe-current-group (arg)
4272   "Toggle subscribe from/to unsubscribe current group."
4273   (interactive "P")
4274   (let ((group (gnus-group-group-name)))
4275     (or group (error "No newsgroup on current line"))
4276     (or arg (setq arg (if (<= (gnus-group-group-level) gnus-level-subscribed)
4277                           gnus-level-default-unsubscribed
4278                         gnus-level-default-subscribed)))
4279     (gnus-group-unsubscribe-group group arg)
4280     (gnus-group-next-group 1)))
4281
4282 (defun gnus-group-unsubscribe-group (group &optional level)
4283   "Toggle subscribe from/to unsubscribe GROUP.
4284 New newsgroup is added to .newsrc automatically."
4285   (interactive
4286    (list (completing-read "Group: " gnus-active-hashtb nil 
4287                           gnus-have-read-active-file)))
4288   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
4289     (cond (newsrc
4290            ;; Toggle subscription flag.
4291            (gnus-group-change-level 
4292             newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) 
4293                                            gnus-level-subscribed) 
4294                                        (1+ gnus-level-subscribed)
4295                                      gnus-level-default-subscribed)))
4296            (gnus-group-update-group group))
4297           ((and (stringp group)
4298                 (or (not gnus-have-read-active-file)
4299                     (gnus-gethash group gnus-active-hashtb)))
4300            ;; Add new newsgroup.
4301            (gnus-group-change-level 
4302             group 
4303             (if level level gnus-level-default-subscribed) 
4304             (or (and (member group gnus-zombie-list) 
4305                      gnus-level-zombie) 
4306                 gnus-level-killed)
4307             (and (gnus-group-group-name)
4308                  (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
4309            (gnus-group-update-group group))
4310           (t (error "No such newsgroup: %s" group)))
4311     (gnus-group-position-cursor)))
4312
4313 (defun gnus-group-transpose-groups (n)
4314   "Move the current newsgroup up N places.
4315 If given a negative prefix, move down instead. The difference between
4316 N and the number of steps taken is returned." 
4317   (interactive "p")
4318   (or (gnus-group-group-name)
4319       (error "No group on current line"))
4320   (gnus-group-kill-group 1)
4321   (prog1
4322       (forward-line (- n))
4323     (gnus-group-yank-group)
4324     (gnus-group-position-cursor)))
4325
4326 (defun gnus-group-kill-all-zombies ()
4327   "Kill all zombie newsgroups."
4328   (interactive)
4329   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
4330   (setq gnus-zombie-list nil)
4331   (funcall gnus-group-prepare-function gnus-level-subscribed nil nil)
4332   (goto-char (point-min))
4333   (gnus-group-position-cursor))
4334
4335 (defun gnus-group-kill-region (begin end)
4336   "Kill newsgroups in current region (excluding current point).
4337 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
4338   (interactive "r")
4339   (let ((lines
4340          ;; Exclude a line where current point is on.
4341          (1-
4342           ;; Count lines.
4343           (save-excursion
4344             (count-lines
4345              (progn
4346                (goto-char begin)
4347                (beginning-of-line)
4348                (point))
4349              (progn
4350                (goto-char end)
4351                (end-of-line)
4352                (point)))))))
4353     (goto-char begin)
4354     (beginning-of-line)                 ;Important when LINES < 1
4355     (gnus-group-kill-group lines)))
4356
4357 (defun gnus-group-kill-group (n)
4358   "The the next N groups.
4359 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
4360 However, only groups that were alive can be yanked; already killed 
4361 groups or zombie groups can't be yanked.
4362 The return value is the name of the (last) group that was killed."
4363   (interactive "P")
4364   (let ((buffer-read-only nil)
4365         (groups (gnus-group-process-prefix n))
4366         group entry level)
4367     (while groups
4368       (setq group (car groups)
4369             groups (cdr groups))
4370       (gnus-group-remove-mark group)
4371       (setq level (gnus-group-group-level))
4372       (gnus-delete-line)
4373       (if (setq entry (gnus-gethash group gnus-newsrc-hashtb))
4374           (setq gnus-list-of-killed-groups 
4375                 (cons (cons (car entry) (nth 2 entry)) 
4376                       gnus-list-of-killed-groups)))
4377       (gnus-group-change-level 
4378        (if entry entry group) gnus-level-killed (if entry nil level)))
4379     (gnus-group-position-cursor)
4380     group))
4381
4382 (defun gnus-group-yank-group (&optional arg)
4383   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
4384 inserting it before the current newsgroup.  The numeric ARG specifies
4385 how many newsgroups are to be yanked.  The name of the (last)
4386 newsgroup yanked is returned."
4387   (interactive "p")
4388   (if (not arg) (setq arg 1))
4389   (let (info group prev)
4390     (while (>= (setq arg (1- arg)) 0)
4391       (if (not (setq info (car gnus-list-of-killed-groups)))
4392           (error "No more newsgroups to yank"))
4393       (setq group (nth 2 info))
4394       ;; Find which newsgroup to insert this one before - search
4395       ;; backward until something suitable is found. If there are no
4396       ;; other newsgroups in this buffer, just make this newsgroup the
4397       ;; first newsgroup.
4398       (setq prev (gnus-group-group-name))
4399       (gnus-group-change-level 
4400        info (nth 2 info) gnus-level-killed 
4401        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
4402        t)
4403       (gnus-group-insert-group-line-info (nth 1 info))
4404       (setq gnus-list-of-killed-groups 
4405             (cdr gnus-list-of-killed-groups)))
4406     (forward-line -1)
4407     (gnus-group-position-cursor)
4408     group))
4409       
4410 (defun gnus-group-list-all-groups (arg)
4411   "List all newsgroups with level ARG or lower.
4412 Default is gnus-level-unsubscribed, which lists all subscribed and most
4413 unsubscribed groups."
4414   (interactive "P")
4415   (setq arg (or arg gnus-level-unsubscribed))
4416   (gnus-group-list-groups arg t))
4417
4418 (defun gnus-group-list-killed ()
4419   "List all killed newsgroups in the group buffer."
4420   (interactive)
4421   (if (not gnus-killed-list)
4422       (gnus-message 6 "No killed groups")
4423     (funcall gnus-group-prepare-function gnus-level-killed t gnus-level-killed)
4424     (goto-char (point-min)))
4425   (gnus-group-position-cursor))
4426
4427 (defun gnus-group-list-zombies ()
4428   "List all zombie newsgroups in the group buffer."
4429   (interactive)
4430   (if (not gnus-zombie-list)
4431       (gnus-message 6 "No zombie groups")
4432     (funcall gnus-group-prepare-function gnus-level-zombie t gnus-level-zombie)
4433     (goto-char (point-min)))
4434   (gnus-group-position-cursor))
4435
4436 (defun gnus-group-get-new-news (&optional arg)
4437   "Get newly arrived articles.
4438 If ARG is non-nil, it should be a number between one and nine to
4439 specify which levels you are interested in re-scanning."
4440   (interactive "P")
4441   (run-hooks 'gnus-get-new-news-hook)
4442   (let ((level arg))
4443     (if gnus-group-use-permanent-levels
4444         (if level
4445             (setq gnus-group-default-list-level level)
4446           (setq level (or gnus-group-default-list-level 
4447                           gnus-level-subscribed))))
4448     (if (and gnus-read-active-file (not level))
4449         (progn
4450           (gnus-read-active-file)
4451           (gnus-get-unread-articles (or level (1+ gnus-level-subscribed))))
4452       (let ((gnus-read-active-file nil))
4453         (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))))
4454     (gnus-group-list-groups (or (and gnus-group-use-permanent-levels level)
4455                                 gnus-group-default-list-level
4456                                 gnus-level-subscribed)
4457                             gnus-have-all-newsgroups)))
4458
4459 (defun gnus-group-get-new-news-this-group (n)
4460   "Check for newly arrived news in the current group (and the N-1 next groups).
4461 The difference between N and the number of newsgroup checked is returned.
4462 If N is negative, this group and the N-1 previous groups will be checked."
4463   (interactive "P")
4464   (let* ((groups (gnus-group-process-prefix n))
4465          (ret (if (numberp n) (- n (length groups)) 0))
4466          (w-p (window-start))
4467          group)
4468     (while groups
4469       (setq group (car groups)
4470             groups (cdr groups))
4471       (gnus-group-remove-mark group)
4472       (or (gnus-get-new-news-in-group group)
4473           (progn 
4474             (ding) 
4475             (message "%s error: %s" group (gnus-status-message group))
4476             (sit-for 2))))
4477     ;; !!! I don't know why the buffer scrolls forward when updating
4478     ;; the first line in the group buffer, but it does. So we set the
4479     ;; window start forcibly.
4480 ;    (set-window-start (get-buffer-window (current-buffer)) w-p)
4481     (gnus-group-next-unread-group 1 t)
4482     (gnus-summary-position-cursor)
4483     ret))
4484
4485 (defun gnus-get-new-news-in-group (group)
4486   (and group 
4487        (gnus-activate-newsgroup group)
4488        (progn
4489          (gnus-get-unread-articles-in-group 
4490           (nth 2 (gnus-gethash group gnus-newsrc-hashtb))
4491           (gnus-gethash group gnus-active-hashtb))
4492          (gnus-group-update-group-line)
4493          t)))
4494
4495 (defun gnus-group-fetch-faq (group)
4496   "Fetch the FAQ for the current group."
4497   (interactive (list (gnus-group-real-name (gnus-group-group-name))))
4498   (or group (error "No group name given"))
4499   (let ((file (concat gnus-group-faq-directory group))) 
4500     (if (not (file-exists-p file))
4501         (error "No such file: %s" file)
4502       (find-file file))))
4503   
4504 (defun gnus-group-describe-group (force &optional group)
4505   "Display a description of the current newsgroup."
4506   (interactive (list current-prefix-arg (gnus-group-group-name)))
4507   (and force (setq gnus-description-hashtb nil))
4508   (let ((method (gnus-find-method-for-group group))
4509         desc)
4510     (or group (error "No group name given"))
4511     (and (or (and gnus-description-hashtb
4512                   ;; We check whether this group's method has been
4513                   ;; queried for a description file.  
4514                   (gnus-gethash 
4515                    (gnus-group-prefixed-name "" method) 
4516                    gnus-description-hashtb))
4517              (setq desc (gnus-group-get-description group))
4518              (gnus-read-descriptions-file method))
4519          (message
4520           (or desc (gnus-gethash group gnus-description-hashtb)
4521               "No description available")))))
4522
4523 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
4524 (defun gnus-group-describe-all-groups (force)
4525   "Pop up a buffer with descriptions of all newsgroups."
4526   (interactive "P")
4527   (and force (setq gnus-description-hashtb nil))
4528   (if (not (or gnus-description-hashtb
4529                (gnus-read-all-descriptions-files)))
4530       (error "Couldn't request descriptions file"))
4531   (let ((buffer-read-only nil)
4532         b)
4533     (erase-buffer)
4534     (mapatoms
4535      (lambda (group)
4536        (setq b (point))
4537        (insert (format "      *: %-20s %s\n" (symbol-name group)
4538                        (symbol-value group)))
4539        (add-text-properties 
4540         b (1+ b) (list 'gnus-group group
4541                        'gnus-unread t 'gnus-marked nil
4542                        'gnus-level (1+ gnus-level-subscribed))))
4543      gnus-description-hashtb)
4544     (goto-char (point-min))
4545     (gnus-group-position-cursor)))
4546
4547 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
4548 (defun gnus-group-apropos (regexp &optional search-description)
4549   "List all newsgroups that have names that match a regexp."
4550   (interactive "sGnus apropos (regexp): ")
4551   (let ((prev "")
4552         (obuf (current-buffer))
4553         groups des prev)
4554     ;; Go through all newsgroups that are known to Gnus.
4555     (mapatoms 
4556      (lambda (group)
4557        (and (string-match regexp (symbol-name group))
4558             (setq groups (cons (symbol-name group) groups))))
4559      gnus-active-hashtb)
4560     ;; Go through all descriptions that are known to Gnus. 
4561     (if search-description
4562         (mapatoms 
4563          (lambda (group)
4564            (and (string-match regexp (symbol-value group))
4565                 (gnus-gethash (symbol-name group) gnus-active-hashtb)
4566                 (setq groups (cons (symbol-name group) groups))))
4567          gnus-description-hashtb))
4568     (if (not groups)
4569         (gnus-message 3 "No groups matched \"%s\"." regexp)
4570       ;; Print out all the groups.
4571       (save-excursion
4572         (pop-to-buffer "*Gnus Help*")
4573         (buffer-disable-undo (current-buffer))
4574         (erase-buffer)
4575         (setq groups (sort groups 'string<))
4576         (while groups
4577           ;; Groups may be entered twice into the list of groups.
4578           (if (not (string= (car groups) prev))
4579               (progn
4580                 (insert (setq prev (car groups)) "\n")
4581                 (if (and gnus-description-hashtb
4582                          (setq des (gnus-gethash (car groups) 
4583                                                  gnus-description-hashtb)))
4584                     (insert "  " des "\n"))))
4585           (setq groups (cdr groups)))
4586         (goto-char (point-min))))
4587     (pop-to-buffer obuf)))
4588
4589 (defun gnus-group-description-apropos (regexp)
4590   "List all newsgroups that have names or descriptions that match a regexp."
4591   (interactive "sGnus description apropos (regexp): ")
4592   (if (not (or gnus-description-hashtb
4593                (gnus-read-all-descriptions-files)))
4594       (error "Couldn't request descriptions file"))
4595   (gnus-group-apropos regexp t))
4596
4597 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
4598 (defun gnus-group-list-matching (level regexp &optional all lowest) 
4599   "List all groups with unread articles that match REGEXP.
4600 If the prefix LEVEL is non-nil, it should be a number that says which
4601 level to cut off listing groups. 
4602 If ALL, also list groups with no unread articles.
4603 If LOWEST, don't list groups with level lower than LOWEST."
4604   (interactive "P\nsList newsgroups matching: ")
4605   (gnus-group-prepare-flat (or level gnus-level-subscribed)
4606                            all (or lowest 1) regexp)
4607   (goto-char (point-min))
4608   (gnus-group-position-cursor))
4609
4610 (defun gnus-group-list-all-matching (level regexp &optional lowest) 
4611   "List all groups that match REGEXP.
4612 If the prefix LEVEL is non-nil, it should be a number that says which
4613 level to cut off listing groups. 
4614 If LOWEST, don't list groups with level lower than LOWEST."
4615   (interactive "P\nsList newsgroups matching: ")
4616   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
4617
4618 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
4619 (defun gnus-group-save-newsrc ()
4620   "Save the Gnus startup files."
4621   (interactive)
4622   (gnus-save-newsrc-file))
4623
4624 (defun gnus-group-restart (&optional arg)
4625   "Force Gnus to read the .newsrc file."
4626   (interactive "P")
4627   (gnus-save-newsrc-file)
4628   (gnus-setup-news 'force)
4629   (gnus-group-list-groups arg gnus-have-all-newsgroups))
4630
4631 (defun gnus-group-read-init-file ()
4632   "Read the Gnus elisp init file."
4633   (interactive)
4634   (gnus-read-init-file))
4635
4636 (defun gnus-group-check-bogus-groups (silent)
4637   "Check bogus newsgroups.
4638 If given a prefix, don't ask for confirmation before removing a bogus
4639 group."
4640   (interactive "P")
4641   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
4642   (gnus-group-list-groups nil gnus-have-all-newsgroups))
4643
4644 (defun gnus-group-edit-global-kill (article &optional group)
4645   "Edit the global kill file.
4646 If GROUP, edit that local kill file instead."
4647   (interactive "P")
4648   (setq gnus-current-kill-article article)
4649   (gnus-kill-file-edit-file group)
4650   (gnus-message 6
4651    (substitute-command-keys
4652     "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)")))
4653
4654 (defun gnus-group-edit-local-kill (article group)
4655   "Edit a local kill file."
4656   (interactive (list nil (gnus-group-group-name)))
4657   (gnus-group-edit-global-kill article group))
4658
4659 (defun gnus-group-force-update ()
4660   "Update `.newsrc' file."
4661   (interactive)
4662   (gnus-save-newsrc-file))
4663
4664 (defun gnus-group-suspend ()
4665   "Suspend the current Gnus session.
4666 In fact, cleanup buffers except for group mode buffer.
4667 The hook gnus-suspend-gnus-hook is called before actually suspending."
4668   (interactive)
4669   (run-hooks 'gnus-suspend-gnus-hook)
4670   ;; Kill Gnus buffers except for group mode buffer.
4671   (let ((group-buf (get-buffer gnus-group-buffer)))
4672     ;; Do this on a separate list in case the user does a ^G before we finish
4673     (let ((gnus-buffer-list
4674            (delq group-buf (delq gnus-dribble-buffer
4675                                  (append gnus-buffer-list nil)))))
4676       (while gnus-buffer-list
4677         (gnus-kill-buffer (car gnus-buffer-list))
4678         (setq gnus-buffer-list (cdr gnus-buffer-list))))
4679     (if group-buf
4680         (progn
4681           (setq gnus-buffer-list (list group-buf))
4682           (bury-buffer group-buf)
4683           (delete-windows-on group-buf t)))))
4684
4685 (defun gnus-group-clear-dribble ()
4686   "Clear all information from the dribble buffer."
4687   (interactive)
4688   (gnus-dribble-clear))
4689
4690 (defun gnus-group-exit ()
4691   "Quit reading news after updating .newsrc.eld and .newsrc.
4692 The hook `gnus-exit-gnus-hook' is called before actually exiting."
4693   (interactive)
4694   (if (or noninteractive                ;For gnus-batch-kill
4695           (zerop (buffer-size))         ;No news is good news.
4696           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
4697           (not gnus-interactive-exit)   ;Without confirmation
4698           gnus-expert-user
4699           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
4700       (progn
4701         (run-hooks 'gnus-exit-gnus-hook)
4702         (gnus-offer-save-summaries)
4703         (gnus-save-newsrc-file)
4704         (gnus-close-backends)
4705         (gnus-clear-system))))
4706
4707 (defun gnus-close-backends ()
4708   ;; Send a close request to all backends that support such a request. 
4709   (let ((methods gnus-valid-select-methods)
4710         func)
4711     (while methods
4712       (if (fboundp (setq func (intern (concat (car (car methods))
4713                                               "-request-close"))))
4714           (funcall func))
4715       (setq methods (cdr methods)))))
4716
4717 (defun gnus-group-quit ()
4718   "Quit reading news without updating .newsrc.eld or .newsrc.
4719 The hook `gnus-exit-gnus-hook' is called before actually exiting."
4720   (interactive)
4721   (if (or noninteractive                ;For gnus-batch-kill
4722           (zerop (buffer-size))
4723           (not (gnus-server-opened gnus-select-method))
4724           gnus-expert-user
4725           (not gnus-current-startup-file)
4726           (gnus-yes-or-no-p
4727            (format "Quit reading news without saving %s? "
4728                    (file-name-nondirectory gnus-current-startup-file))))
4729       (progn
4730         (run-hooks 'gnus-exit-gnus-hook)
4731         (gnus-dribble-save)
4732         (gnus-close-backends)
4733         (gnus-clear-system))))
4734
4735 (defun gnus-offer-save-summaries ()
4736   (let ((buffers (buffer-list)))
4737     (save-excursion
4738       (while buffers
4739         (and 
4740          ;; We look for buffers with "Summary" in the name.
4741          (string-match "Summary" (or (buffer-name (car buffers)) ""))
4742          (progn
4743            (set-buffer (car buffers))
4744            ;; We check that this is, indeed, a summary buffer.
4745            (eq major-mode 'gnus-summary-mode)) 
4746          ;; We ask the user whether she wants to save the info.
4747          (gnus-y-or-n-p
4748                (format "Update summary buffer %s? " (buffer-name)))
4749          ;; We do it by simply exiting.
4750          (gnus-summary-exit))
4751         (setq buffers (cdr buffers))))))
4752
4753 (defun gnus-group-describe-briefly ()
4754   "Give a one line description of the group mode commands."
4755   (interactive)
4756   (gnus-message 6
4757    (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")))
4758
4759 (defun gnus-group-browse-foreign-server (method)
4760   "Browse a foreign news server.
4761 If called interactively, this function will ask for a select method
4762  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). 
4763 If not, METHOD should be a list where the first element is the method
4764 and the second element is the address."
4765   (interactive
4766    (list (let ((how (completing-read 
4767                      "Which backend: "
4768                      (append gnus-valid-select-methods gnus-server-alist)
4769                      nil t "nntp")))
4770            ;; We either got a backend name or a virtual server name.
4771            ;; If the first, we also need an address.
4772            (if (assoc how gnus-valid-select-methods)
4773                (list (intern how)
4774                      ;; Suggested by mapjph@bath.ac.uk.
4775                      (completing-read 
4776                       "Address: " 
4777                       (mapcar (lambda (server) (list server))
4778                               gnus-secondary-servers)))
4779              ;; We got a server name, so we find the method.
4780              (gnus-server-to-method how)))))
4781   (gnus-browse-foreign-server method))
4782
4783 \f
4784 ;;;
4785 ;;; Browse Server Mode
4786 ;;;
4787
4788 (defvar gnus-browse-mode-hook nil)
4789 (defvar gnus-browse-mode-map nil)
4790 (put 'gnus-browse-mode 'mode-class 'special)
4791
4792 (if gnus-browse-mode-map
4793     nil
4794   (setq gnus-browse-mode-map (make-keymap))
4795   (suppress-keymap gnus-browse-mode-map)
4796   (define-key gnus-browse-mode-map " " 'gnus-browse-read-group)
4797   (define-key gnus-browse-mode-map "=" 'gnus-browse-select-group)
4798   (define-key gnus-browse-mode-map "n" 'gnus-browse-next-group)
4799   (define-key gnus-browse-mode-map "p" 'gnus-browse-prev-group)
4800   (define-key gnus-browse-mode-map "\177" 'gnus-browse-prev-group)
4801   (define-key gnus-browse-mode-map "N" 'gnus-browse-next-group)
4802   (define-key gnus-browse-mode-map "P" 'gnus-browse-prev-group)
4803   (define-key gnus-browse-mode-map "\M-n" 'gnus-browse-next-group)
4804   (define-key gnus-browse-mode-map "\M-p" 'gnus-browse-prev-group)
4805   (define-key gnus-browse-mode-map "\r" 'gnus-browse-select-group)
4806   (define-key gnus-browse-mode-map "u" 'gnus-browse-unsubscribe-current-group)
4807   (define-key gnus-browse-mode-map "l" 'gnus-browse-exit)
4808   (define-key gnus-browse-mode-map "L" 'gnus-browse-exit)
4809   (define-key gnus-browse-mode-map "q" 'gnus-browse-exit)
4810   (define-key gnus-browse-mode-map "Q" 'gnus-browse-exit)
4811   (define-key gnus-browse-mode-map "\C-c\C-c" 'gnus-browse-exit)
4812   (define-key gnus-browse-mode-map "?" 'gnus-browse-describe-briefly)
4813   (define-key gnus-browse-mode-map "\C-c\C-i" 'gnus-info-find-node)
4814   )
4815
4816 (defvar gnus-browse-current-method nil)
4817 (defvar gnus-browse-return-buffer nil)
4818
4819 (defvar gnus-browse-buffer "*Gnus Browse Server*")
4820
4821 (defun gnus-browse-foreign-server (method &optional return-buffer)
4822   (setq gnus-browse-current-method method)
4823   (setq gnus-browse-return-buffer return-buffer)
4824   (let ((gnus-select-method method)
4825         groups group)
4826     (gnus-message 5 "Connecting to %s..." (nth 1 method))
4827     (or (gnus-server-opened method)
4828         (gnus-open-server method)
4829         (error "Unable to contact server: %s" (gnus-status-message method)))
4830     (or (gnus-request-list method)
4831         (error "Couldn't request list: %s" (gnus-status-message method)))
4832     (get-buffer-create gnus-browse-buffer)
4833     (gnus-add-current-to-buffer-list)
4834     (and gnus-carpal (gnus-carpal-setup-buffer 'browse))
4835     (gnus-configure-windows 'browse)
4836     (buffer-disable-undo (current-buffer))
4837     (let ((buffer-read-only nil))
4838       (erase-buffer))
4839     (gnus-browse-mode)
4840     (setq mode-line-buffer-identification
4841           (format
4842            "(ding) Browse Server {%s:%s}" (car method) (car (cdr method))))
4843     (save-excursion
4844       (set-buffer nntp-server-buffer)
4845       (let ((cur (current-buffer)))
4846         (goto-char (point-min))
4847         (or (string= gnus-ignored-newsgroups "")
4848             (delete-matching-lines gnus-ignored-newsgroups))
4849         (while (re-search-forward 
4850                 "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
4851           (goto-char (match-end 1))
4852           (setq groups (cons (cons (buffer-substring (match-beginning 1)
4853                                                      (match-end 1))
4854                                    (max 0 (- (1+ (read cur)) (read cur))))
4855                              groups)))))
4856     (setq groups (sort groups 
4857                        (lambda (l1 l2)
4858                          (string< (car l1) (car l2)))))
4859     (let ((buffer-read-only nil))
4860       (while groups
4861         (setq group (car groups))
4862         (insert 
4863          (format "K%7d: %s\n" (cdr group) (car group)))
4864         (setq groups (cdr groups))))
4865     (switch-to-buffer (current-buffer))
4866     (goto-char (point-min))
4867     (gnus-group-position-cursor)))
4868
4869 (defun gnus-browse-mode ()
4870   "Major mode for browsing a foreign server.
4871
4872 All normal editing commands are switched off.
4873
4874 \\<gnus-browse-mode-map>
4875 The only things you can do in this buffer is
4876
4877 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
4878 The group will be inserted into the group buffer upon exit from this
4879 buffer.  
4880
4881 2) `\\[gnus-browse-read-group]' to read a group ephemerally.
4882
4883 3) `\\[gnus-browse-exit]' to return to the group buffer."
4884   (interactive)
4885   (kill-all-local-variables)
4886   (if gnus-visual (gnus-browse-make-menu-bar))
4887   (setq mode-line-modified "-- ")
4888   (make-local-variable 'mode-line-format)
4889   (setq mode-line-format (copy-sequence mode-line-format))
4890   (and (equal (nth 3 mode-line-format) "   ")
4891        (setcar (nthcdr 3 mode-line-format) ""))
4892   (setq major-mode 'gnus-browse-mode)
4893   (setq mode-name "Browse Server")
4894   (setq mode-line-process nil)
4895   (use-local-map gnus-browse-mode-map)
4896   (buffer-disable-undo (current-buffer))
4897   (setq truncate-lines t)
4898   (setq buffer-read-only t)
4899   (run-hooks 'gnus-browse-mode-hook))
4900
4901 (defun gnus-browse-read-group (&optional no-article)
4902   "Enter the group at the current line."
4903   (interactive)
4904   (let ((group (gnus-browse-group-name)))
4905     (or (gnus-group-read-ephemeral-group 
4906          group gnus-browse-current-method nil
4907          (cons (current-buffer) 'browse))
4908         (error "Couldn't enter %s" group))))
4909
4910 (defun gnus-browse-select-group ()
4911   "Select the current group."
4912   (interactive)
4913   (gnus-browse-read-group 'no))
4914
4915 (defun gnus-browse-next-group (n)
4916   "Go to the next group."
4917   (interactive "p")
4918   (prog1
4919       (forward-line n)
4920     (gnus-group-position-cursor)))
4921
4922 (defun gnus-browse-prev-group (n)
4923   "Go to the next group."
4924   (interactive "p")
4925   (gnus-browse-next-group (- n)))
4926
4927 (defun gnus-browse-unsubscribe-current-group (arg)
4928   "(Un)subscribe to the next ARG groups."
4929   (interactive "p")
4930   (and (eobp)
4931        (error "No group at current line."))
4932   (let ((ward (if (< arg 0) -1 1))
4933         (arg (abs arg)))
4934     (while (and (> arg 0)
4935                 (not (eobp))
4936                 (gnus-browse-unsubscribe-group)
4937                 (zerop (gnus-browse-next-group ward)))
4938       (setq arg (1- arg)))
4939     (gnus-group-position-cursor)
4940     (if (/= 0 arg) (gnus-message 7 "No more newsgroups"))
4941     arg))
4942
4943 (defun gnus-browse-group-name ()
4944   (save-excursion
4945     (beginning-of-line)
4946     (if (not (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t))
4947         ()
4948       (gnus-group-prefixed-name 
4949        (buffer-substring (match-beginning 1) (match-end 1))
4950        gnus-browse-current-method))))
4951   
4952 (defun gnus-browse-unsubscribe-group ()
4953   (let ((sub nil)
4954         (buffer-read-only nil)
4955         group)
4956     (save-excursion
4957       (beginning-of-line)
4958       (if (= (following-char) ?K) (setq sub t))
4959       (setq group (gnus-browse-group-name))
4960       (beginning-of-line)
4961       (delete-char 1)
4962       (if sub
4963           (progn
4964             (gnus-group-change-level 
4965              (list t group gnus-level-default-subscribed
4966                    nil nil gnus-browse-current-method) 
4967              gnus-level-default-subscribed gnus-level-killed
4968              (gnus-gethash (car (nth 1 gnus-newsrc-alist)) gnus-newsrc-hashtb)
4969              t)
4970             (insert ? ))
4971         (gnus-group-change-level 
4972          group gnus-level-killed gnus-level-default-subscribed)
4973         (insert ?K)))
4974     t))
4975
4976 (defun gnus-browse-exit ()
4977   "Quit browsing and return to the group buffer."
4978   (interactive)
4979   (if (eq major-mode 'gnus-browse-mode)
4980       (kill-buffer (current-buffer)))
4981   (if gnus-browse-return-buffer
4982       (gnus-configure-windows 'server)
4983     (gnus-configure-windows 'group)))
4984
4985 (defun gnus-browse-describe-briefly ()
4986   "Give a one line description of the group mode commands."
4987   (interactive)
4988   (gnus-message 6
4989    (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")))
4990       
4991 \f
4992 ;;;
4993 ;;; Gnus summary mode
4994 ;;;
4995
4996 (defvar gnus-summary-mode-map nil)
4997 (defvar gnus-summary-mark-map nil)
4998 (defvar gnus-summary-mscore-map nil)
4999 (defvar gnus-summary-article-map nil)
5000 (defvar gnus-summary-thread-map nil)
5001 (defvar gnus-summary-goto-map nil)
5002 (defvar gnus-summary-exit-map nil)
5003 (defvar gnus-summary-various-map nil)
5004 (defvar gnus-summary-interest-map nil)
5005 (defvar gnus-summary-sort-map nil)
5006 (defvar gnus-summary-backend-map nil)
5007 (defvar gnus-summary-save-map nil)
5008 (defvar gnus-summary-wash-map nil)
5009 (defvar gnus-summary-help-map nil)
5010
5011 (put 'gnus-summary-mode 'mode-class 'special)
5012
5013 (if gnus-summary-mode-map
5014     nil
5015   (setq gnus-summary-mode-map (make-keymap))
5016   (suppress-keymap gnus-summary-mode-map)
5017
5018   ;; Non-orthogonal keys
5019
5020   (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
5021   (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
5022   (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
5023   (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
5024   (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
5025   (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
5026   (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
5027   (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject)
5028   (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject)
5029   (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject)
5030   (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject)
5031   (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
5032   (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article)
5033   (define-key gnus-summary-mode-map "\M-s" 'gnus-summary-search-article-forward)
5034   (define-key gnus-summary-mode-map "\M-r" 'gnus-summary-search-article-backward)
5035   (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
5036   (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
5037   (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
5038   (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
5039   (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article)
5040   (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward)
5041   (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward)
5042   (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward)
5043   (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
5044   (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
5045   (define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable)
5046   (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward)
5047   (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward)
5048   (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
5049   (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
5050   (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread)
5051   (define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread)
5052   (define-key gnus-summary-mode-map "e" 'gnus-summary-edit-article)
5053   (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable)
5054   (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable)
5055   (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads)
5056   (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread)
5057   (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread)
5058   (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread)
5059   (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread)
5060   (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread)
5061   (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread)
5062   (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
5063   (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
5064   (define-key gnus-summary-mode-map "\C-w" 'gnus-summary-mark-region-as-read)
5065   (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
5066   (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant)
5067   (define-key gnus-summary-mode-map "\C-c\M-\C-s" 'gnus-summary-show-all-expunged)
5068   (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
5069   (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
5070   (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
5071   (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
5072   (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score)
5073   (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
5074   (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
5075   (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group)
5076   (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
5077   (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
5078   (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime)
5079   (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
5080   (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
5081   (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
5082   (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
5083   (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
5084   (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
5085   (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
5086   (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail)
5087   (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
5088   (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill)
5089   (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill)
5090   (define-key gnus-summary-mode-map "V" 'gnus-version)
5091   (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group)
5092   (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
5093   (define-key gnus-summary-mode-map "Q" 'gnus-summary-exit-no-update)
5094   (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
5095   (define-key gnus-summary-mode-map gnus-mouse-2 'gnus-mouse-pick-article)
5096   (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
5097   (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
5098   (define-key gnus-summary-mode-map "x" 'gnus-summary-remove-lines-marked-as-read)
5099 ; (define-key gnus-summary-mode-map "X" 'gnus-summary-remove-lines-marked-with)
5100   (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
5101   (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
5102   (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
5103 ;  (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
5104   (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
5105   (define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu-view)
5106   (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-enter-digest-group)
5107
5108
5109   ;; Sort of orthogonal keymap
5110   (define-prefix-command 'gnus-summary-mark-map)
5111   (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map)
5112   (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward)
5113   (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward)
5114   (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward)
5115   (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward)
5116   (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward)
5117   (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward)
5118   (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable)
5119   (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable)
5120   (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant)
5121   (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark)
5122   (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark)
5123   (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable)
5124   (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable)
5125   (define-key gnus-summary-mark-map "\M-r" 'gnus-summary-remove-lines-marked-as-read)
5126   (define-key gnus-summary-mark-map "\M-\C-r" 'gnus-summary-remove-lines-marked-with)
5127   (define-key gnus-summary-mark-map "D" 'gnus-summary-show-all-dormant)
5128   (define-key gnus-summary-mark-map "\M-D" 'gnus-summary-hide-all-dormant)
5129   (define-key gnus-summary-mark-map "S" 'gnus-summary-show-all-expunged)
5130   (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup)
5131   (define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here)
5132   (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all)
5133   (define-key gnus-summary-mark-map "k" 'gnus-summary-kill-same-subject-and-select)
5134   (define-key gnus-summary-mark-map "K" 'gnus-summary-kill-same-subject)
5135
5136   (define-prefix-command 'gnus-summary-mscore-map)
5137   (define-key gnus-summary-mark-map "s" 'gnus-summary-mscore-map)
5138   (define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above)
5139   (define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above)
5140   (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above)
5141   (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below)
5142
5143   (define-key gnus-summary-mark-map "p" 'gnus-uu-mark-map)
5144   
5145   (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
5146   
5147   (define-prefix-command 'gnus-summary-goto-map)
5148   (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map)
5149   (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article)
5150   (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article)
5151   (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article)
5152   (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article)
5153   (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject)
5154   (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject)
5155   (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject)
5156   (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject)
5157   (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article)
5158   (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article)
5159   (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject)
5160   (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article)
5161   (define-key gnus-summary-goto-map "p" 'gnus-summary-pop-article)
5162
5163
5164   (define-prefix-command 'gnus-summary-thread-map)
5165   (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map)
5166   (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread)
5167   (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread)
5168   (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread)
5169   (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads)
5170   (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread)
5171   (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads)
5172   (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread)
5173   (define-key gnus-summary-thread-map "H" 'gnus-summary-hide-all-threads)
5174   (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread)
5175   (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread)
5176   (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread)
5177   (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread)
5178   (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread)
5179
5180   
5181   (define-prefix-command 'gnus-summary-exit-map)
5182   (define-key gnus-summary-mode-map "Z" 'gnus-summary-exit-map)
5183   (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit)
5184   (define-key gnus-summary-exit-map "C" 'gnus-summary-catchup-all-and-exit)
5185   (define-key gnus-summary-exit-map "E" 'gnus-summary-exit-no-update)
5186   (define-key gnus-summary-exit-map "Q" 'gnus-summary-exit)
5187   (define-key gnus-summary-exit-map "Z" 'gnus-summary-exit)
5188   (define-key gnus-summary-exit-map "n" 'gnus-summary-catchup-and-goto-next-group)
5189   (define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group)
5190   (define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group)
5191   (define-key gnus-summary-exit-map "N" 'gnus-summary-next-group)
5192   (define-key gnus-summary-exit-map "P" 'gnus-summary-prev-group)
5193
5194
5195   (define-prefix-command 'gnus-summary-article-map)
5196   (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map)
5197   (define-key gnus-summary-article-map " " 'gnus-summary-next-page)
5198   (define-key gnus-summary-article-map "n" 'gnus-summary-next-page)
5199   (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page)
5200   (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page)
5201   (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up)
5202   (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article)
5203   (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article)
5204   (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article)
5205   (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article)
5206   (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article)
5207   (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article)
5208   (define-key gnus-summary-article-map "w" 'gnus-summary-stop-page-breaking)
5209   (define-key gnus-summary-article-map "c" 'gnus-summary-caesar-message)
5210   (define-key gnus-summary-article-map "g" 'gnus-summary-show-article)
5211   (define-key gnus-summary-article-map "t" 'gnus-summary-toggle-header)
5212   (define-key gnus-summary-article-map "m" 'gnus-summary-toggle-mime)
5213   (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article)
5214
5215
5216   (define-prefix-command 'gnus-summary-wash-map)
5217   (define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map)
5218   (define-key gnus-summary-wash-map "h" 'gnus-article-hide-headers)
5219   (define-key gnus-summary-wash-map "s" 'gnus-article-hide-signature)
5220   (define-key gnus-summary-wash-map "c" 'gnus-article-hide-citation)
5221   (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike)
5222   (define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap)
5223   (define-key gnus-summary-wash-map "d" 'gnus-article-remove-cr)
5224   (define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable)
5225   (define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face)
5226   (define-key gnus-summary-wash-map "t" 'gnus-article-date-ut)
5227   (define-key gnus-summary-wash-map "\C-t" 'gnus-article-date-local)
5228   (define-key gnus-summary-wash-map "T" 'gnus-article-date-lapsed)
5229
5230   (define-key gnus-summary-wash-map "A" 'gnus-article-highlight)
5231   (define-key gnus-summary-wash-map "a" 'gnus-article-hide)
5232   (define-key gnus-summary-wash-map "H" 'gnus-article-highlight-headers)
5233   (define-key gnus-summary-wash-map "C" 'gnus-article-highlight-citation)
5234   (define-key gnus-summary-wash-map "S" 'gnus-article-highlight-signature)
5235   (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons)
5236
5237
5238   (define-prefix-command 'gnus-summary-help-map)
5239   (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map)
5240   (define-key gnus-summary-help-map "v" 'gnus-version)
5241   (define-key gnus-summary-help-map "f" 'gnus-summary-fetch-faq)
5242   (define-key gnus-summary-help-map "d" 'gnus-summary-describe-group)
5243   (define-key gnus-summary-help-map "h" 'gnus-summary-describe-briefly)
5244   (define-key gnus-summary-help-map "i" 'gnus-info-find-node)
5245
5246
5247   (define-prefix-command 'gnus-summary-backend-map)
5248   (define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map)
5249   (define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles)
5250   (define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article)
5251   (define-key gnus-summary-backend-map "m" 'gnus-summary-move-article)
5252   (define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article)
5253   (define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article)
5254   (define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article)
5255   (define-key gnus-summary-backend-map "q" 'gnus-summary-fancy-query)
5256   (define-key gnus-summary-backend-map "i" 'gnus-summary-import-article)
5257
5258
5259   (define-prefix-command 'gnus-summary-save-map)
5260   (define-key gnus-summary-mode-map "O" 'gnus-summary-save-map)
5261   (define-key gnus-summary-save-map "o" 'gnus-summary-save-article)
5262   (define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail)
5263   (define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail)
5264   (define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file)
5265   (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder)
5266   (define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm)
5267   (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output)
5268 ;  (define-key gnus-summary-save-map "s" 'gnus-soup-add-article)
5269
5270   (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map)
5271   
5272   (define-prefix-command 'gnus-summary-various-map)
5273   (define-key gnus-summary-mode-map "V" 'gnus-summary-various-map)
5274   (define-key gnus-summary-various-map "u" 'gnus-summary-universal-argument)
5275   (define-key gnus-summary-various-map "\C-s" 'gnus-summary-search-article-forward)
5276   (define-key gnus-summary-various-map "\C-r" 'gnus-summary-search-article-backward)
5277   (define-key gnus-summary-various-map "r" 'gnus-summary-refer-article)
5278   (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command)
5279   (define-key gnus-summary-various-map "T" 'gnus-summary-toggle-truncation)
5280   (define-key gnus-summary-various-map "e" 'gnus-summary-expand-window)
5281   (define-key gnus-summary-various-map "D" 'gnus-summary-enter-digest-group)
5282   (define-key gnus-summary-various-map "k" 'gnus-summary-edit-local-kill)
5283   (define-key gnus-summary-various-map "K" 'gnus-summary-edit-global-kill)
5284
5285   (define-key gnus-summary-various-map "S" 'gnus-summary-score-map)
5286
5287   (define-prefix-command 'gnus-summary-sort-map)
5288   (define-key gnus-summary-various-map "s" 'gnus-summary-sort-map)
5289   (define-key gnus-summary-sort-map "n" 'gnus-summary-sort-by-number)
5290   (define-key gnus-summary-sort-map "a" 'gnus-summary-sort-by-author)
5291   (define-key gnus-summary-sort-map "s" 'gnus-summary-sort-by-subject)
5292   (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date)
5293   (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score)
5294
5295   (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-score)
5296   (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-score)
5297   )
5298
5299
5300 \f
5301
5302 (defun gnus-summary-mode ()
5303   "Major mode for reading articles.
5304
5305 All normal editing commands are switched off.
5306 \\<gnus-summary-mode-map>
5307 Each line in this buffer represents one article.  To read an
5308 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
5309 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', 
5310 respectively.
5311
5312 You can also post articles and send mail from this buffer.  To 
5313 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author 
5314 of an article, type `\\[gnus-summary-reply]'.
5315
5316 There are approx. one gazillion commands you can execute in this 
5317 buffer; read the info pages for more information (`\\[gnus-info-find-node]'). 
5318
5319 The following commands are available:
5320
5321 \\{gnus-summary-mode-map}"
5322   (interactive)
5323   (if gnus-visual (gnus-summary-make-menu-bar))
5324   (kill-all-local-variables)
5325   (let ((locals gnus-summary-local-variables))
5326     (while locals
5327       (if (consp (car locals))
5328           (progn
5329             (make-local-variable (car (car locals)))
5330             (set (car (car locals)) (eval (cdr (car locals)))))
5331         (make-local-variable (car locals))
5332         (set (car locals) nil))
5333       (setq locals (cdr locals))))
5334   (gnus-make-thread-indent-array)
5335   (gnus-update-format-specifications)
5336   (setq mode-line-modified "-- ")
5337   (make-local-variable 'mode-line-format)
5338   (setq mode-line-format (copy-sequence mode-line-format))
5339   (and (equal (nth 3 mode-line-format) "   ")
5340        (setcar (nthcdr 3 mode-line-format) ""))
5341   (setq major-mode 'gnus-summary-mode)
5342   (setq mode-name "Summary")
5343   (make-local-variable 'minor-mode-alist)
5344   (use-local-map gnus-summary-mode-map)
5345   (buffer-disable-undo (current-buffer))
5346   (setq buffer-read-only t)             ;Disable modification
5347   (setq truncate-lines t)
5348   (setq selective-display t)
5349   (setq selective-display-ellipses t)   ;Display `...'
5350   (setq buffer-display-table gnus-summary-display-table)
5351   (run-hooks 'gnus-summary-mode-hook))
5352
5353 (defun gnus-summary-make-display-table ()
5354   ;; Change the display table.  Odd characters have a tendency to mess
5355   ;; up nicely formatted displays - we make all possible glyphs
5356   ;; display only a single character.
5357
5358   ;; We start from the standard display table, if any.
5359   (setq gnus-summary-display-table 
5360         (or (copy-sequence standard-display-table)
5361             (make-display-table)))
5362   ;; Nix out all the control chars...
5363   (let ((i 32))
5364     (while (>= (setq i (1- i)) 0)
5365       (aset gnus-summary-display-table i [??])))
5366   ;; ... but not newline and cr, of course. (cr is necessary for the
5367   ;; selective display).  
5368   (aset gnus-summary-display-table ?\n nil)
5369   (aset gnus-summary-display-table ?\r nil)
5370   ;; We nix out any glyphs over 126 that are not set already.  
5371   (let ((i 256))
5372     (while (>= (setq i (1- i)) 127)
5373       ;; Only modify if the entry is nil.
5374       (or (aref gnus-summary-display-table i) 
5375           (aset gnus-summary-display-table i [??])))))
5376
5377 (defun gnus-summary-clear-local-variables ()
5378   (let ((locals gnus-summary-local-variables))
5379     (while locals
5380       (if (consp (car locals))
5381           (and (vectorp (car (car locals)))
5382                (set (car (car locals)) nil))
5383         (and (vectorp (car locals))
5384              (set (car locals) nil)))
5385       (setq locals (cdr locals)))))
5386
5387 (defun gnus-mouse-pick-article (e)
5388   (interactive "e")
5389   (mouse-set-point e)
5390   (gnus-summary-next-page nil t))
5391
5392 (defun gnus-summary-setup-buffer (group)
5393   "Initialize summary buffer."
5394   (let ((buffer (concat "*Summary " group "*")))
5395     (if (get-buffer buffer)
5396         (progn
5397           (set-buffer buffer)
5398           (not gnus-newsgroup-begin))
5399       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
5400       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
5401       (gnus-add-current-to-buffer-list)
5402       (gnus-summary-mode)
5403       (and gnus-carpal (gnus-carpal-setup-buffer 'summary))
5404       (setq gnus-newsgroup-name group)
5405       t)))
5406
5407 (defun gnus-set-global-variables ()
5408   ;; Set the global equivalents of the summary buffer-local variables
5409   ;; to the latest values they had. These reflect the summary buffer
5410   ;; that was in action when the last article was fetched.
5411   (if (eq major-mode 'gnus-summary-mode) 
5412       (progn
5413         (setq gnus-summary-buffer (current-buffer))
5414         (let ((name gnus-newsgroup-name)
5415               (marked gnus-newsgroup-marked)
5416               (unread gnus-newsgroup-unreads)
5417               (headers gnus-current-headers)
5418               (score-file gnus-current-score-file))
5419           (save-excursion
5420             (set-buffer gnus-group-buffer)
5421             (setq gnus-newsgroup-name name)
5422             (setq gnus-newsgroup-marked marked)
5423             (setq gnus-newsgroup-unreads unread)
5424             (setq gnus-current-headers headers)
5425             (setq gnus-current-score-file score-file))))))
5426
5427 (defun gnus-summary-insert-dummy-line (sformat subject number)
5428   (if (not sformat) 
5429       (setq sformat gnus-summary-dummy-line-format-spec))
5430   (let (b)
5431     (beginning-of-line)
5432     (setq b (point))
5433     (insert (eval sformat))
5434     (add-text-properties
5435      b (1+ b)
5436      (list 'gnus-number number 
5437            'gnus-mark gnus-dummy-mark
5438            'gnus-level 0))))
5439
5440 (defvar gnus-thread-indent-array nil)
5441 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
5442 (defun gnus-make-thread-indent-array ()
5443   (let ((n 200))
5444     (if (and gnus-thread-indent-array
5445              (= gnus-thread-indent-level gnus-thread-indent-array-level))
5446         nil
5447       (setq gnus-thread-indent-array (make-vector 201 "")
5448             gnus-thread-indent-array-level gnus-thread-indent-level)
5449       (while (>= n 0)
5450         (aset gnus-thread-indent-array n
5451               (make-string (* n gnus-thread-indent-level) ? ))
5452         (setq n (1- n))))))
5453
5454 (defun gnus-summary-insert-line 
5455   (sformat header level current unread replied expirable subject-or-nil
5456            &optional dummy score)
5457   (or sformat (setq sformat gnus-summary-line-format-spec))
5458   (let* ((indentation (aref gnus-thread-indent-array level))
5459          (lines (header-lines header))
5460          (score (or score gnus-summary-default-score 0))
5461          (score-char
5462           (if (or (null gnus-summary-default-score)
5463                   (<= (abs (- score gnus-summary-default-score))
5464                       gnus-summary-zcore-fuzz)) ? 
5465             (if (< score gnus-summary-default-score)
5466                 gnus-score-below-mark gnus-score-over-mark)))
5467          (replied (if replied gnus-replied-mark ? ))
5468          (from (header-from header))
5469          (name-address (funcall gnus-extract-address-components from))
5470          (address (car (cdr name-address)))
5471          (name (or (car name-address) (car (cdr name-address))))
5472          (subject (header-subject header))
5473          (number (header-number header))
5474          (opening-bracket (if dummy ?\< ?\[))
5475          (closing-bracket (if dummy ?\> ?\]))
5476          (buffer-read-only nil)
5477          (b (progn (beginning-of-line) (point))))
5478     (or (numberp lines) (setq lines 0))
5479     (insert (eval sformat))
5480     (add-text-properties
5481      b (1+ b) (list 'gnus-number number 
5482                     'gnus-mark (or unread gnus-unread-mark)
5483                     'gnus-level level))))
5484
5485 (defun gnus-summary-update-line (&optional dont-update)
5486   ;; Update summary line after change.
5487   (or (not gnus-summary-default-score)
5488       gnus-summary-inhibit-highlight
5489       (let ((gnus-summary-inhibit-highlight t)
5490             (article (gnus-summary-article-number)))
5491         (progn
5492           (or dont-update
5493               (if (and gnus-summary-mark-below
5494                        (< (gnus-summary-article-score)
5495                           gnus-summary-mark-below))
5496                   (and (not (memq article gnus-newsgroup-marked))
5497                        (not (memq article gnus-newsgroup-dormant))
5498                        (memq article gnus-newsgroup-unreads)
5499                        (gnus-summary-mark-article nil gnus-low-score-mark))
5500                 (and (eq (gnus-summary-article-mark) gnus-low-score-mark)
5501                      (gnus-summary-mark-article nil gnus-unread-mark))))
5502           (and gnus-visual
5503                (run-hooks 'gnus-summary-update-hook))))))
5504
5505 (defun gnus-summary-update-lines (&optional beg end)
5506   ;; Rehighlight summary buffer according to `gnus-summary-highlight'.
5507   (let ((beg (or beg (point-min)))
5508         (end (or end (point-max))))
5509     (save-excursion
5510       (set-buffer gnus-summary-buffer)
5511       (goto-char beg)
5512       (while (and (not (eobp)) (< (point) end))
5513         (gnus-summary-update-line)
5514         (forward-line 1)))))
5515
5516 (defun gnus-summary-number-of-articles-in-thread (thread &optional char)
5517   ;; Sum up all elements (and sub-elements) in a list.
5518   (let ((number 
5519          (if (listp thread) 
5520              (apply 
5521               '+ (mapcar 'gnus-summary-number-of-articles-in-thread thread))
5522            1)))
5523     (if char 
5524         (if (> number 1) gnus-not-empty-thread-mark
5525           gnus-empty-thread-mark)
5526       number)))
5527
5528 (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer)
5529   "Start reading news in newsgroup GROUP.
5530 If SHOW-ALL is non-nil, already read articles are also listed.
5531 If NO-ARTICLE is non-nil, no article is selected initially."
5532   (gnus-message 5 "Retrieving newsgroup: %s..." group)
5533   (let* ((new-group (gnus-summary-setup-buffer group))
5534          (did-select (and new-group (gnus-select-newsgroup group show-all)))
5535          (method (car (gnus-find-method-for-group group))))
5536     (cond 
5537      ((not new-group)
5538       (gnus-set-global-variables)
5539       (gnus-kill-buffer kill-buffer)
5540       (gnus-configure-windows 'summary)
5541       (gnus-set-mode-line 'summary)
5542       (gnus-summary-position-cursor)
5543       (message "")
5544       t)
5545      ((null did-select) 
5546       (and (eq major-mode 'gnus-summary-mode)
5547            (not (equal (current-buffer) kill-buffer))
5548            (progn
5549              (kill-buffer (current-buffer))
5550              (set-buffer gnus-group-buffer)
5551              (gnus-group-next-unread-group 1)))
5552       (message "Can't select group")
5553       nil)
5554      ((eq did-select 'quit)
5555       (and (eq major-mode 'gnus-summary-mode)
5556            (not (equal (current-buffer) kill-buffer))
5557            (kill-buffer (current-buffer)))
5558       (gnus-kill-buffer kill-buffer)
5559       (gnus-configure-windows 'group)
5560       (gnus-group-next-unread-group 1)
5561       (signal 'quit nil))
5562      (t
5563       (gnus-set-global-variables)
5564       ;; Save the active value in effect when the group was entered.
5565       (setq gnus-newsgroup-active 
5566             (gnus-copy-sequence
5567              (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
5568       ;; You can change the subjects in this hook.
5569       (run-hooks 'gnus-select-group-hook)
5570       ;; Do score processing.
5571       (and gnus-use-scoring (gnus-possibly-score-headers))
5572       ;; Update the format specifiers.
5573       (gnus-update-format-specifications)
5574       ;; Generate the summary buffer.
5575       (gnus-summary-prepare)
5576       (if (zerop (buffer-size))
5577           (cond (gnus-newsgroup-dormant
5578                  (gnus-summary-show-all-dormant))
5579                 ((and gnus-newsgroup-scored show-all)
5580                  (gnus-summary-show-all-expunged))))
5581       ;; Function `gnus-apply-kill-file' must be called in this hook.
5582       (run-hooks 'gnus-apply-kill-hook)
5583       (if (zerop (buffer-size))
5584           (progn
5585             ;; This newsgroup is empty.
5586             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
5587             (gnus-message 6 "No unread news")
5588             (gnus-kill-buffer kill-buffer)
5589             nil)
5590         ;;(save-excursion
5591         ;;  (if kill-buffer
5592         ;;      (let ((gnus-summary-buffer kill-buffer))
5593         ;;      (gnus-configure-windows 'group))))
5594         ;; Hide conversation thread subtrees.  We cannot do this in
5595         ;; gnus-summary-prepare-hook since kill processing may not
5596         ;; work with hidden articles.
5597         (and gnus-show-threads
5598              gnus-thread-hide-subtree
5599              (gnus-summary-hide-all-threads))
5600         ;; Show first unread article if requested.
5601         (goto-char (point-min))
5602         (if (and (not no-article)
5603                  gnus-auto-select-first
5604                  (gnus-summary-first-unread-article))
5605             ()
5606           (gnus-configure-windows 'summary))
5607         (gnus-set-mode-line 'summary)
5608         (gnus-summary-position-cursor)
5609         ;; If in async mode, we send some info to the backend.
5610         (and gnus-newsgroup-async
5611              (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads))
5612              (gnus-request-asynchronous 
5613               gnus-newsgroup-name
5614               (if (and gnus-asynchronous-article-function
5615                        (fboundp gnus-asynchronous-article-function))
5616                   (funcall gnus-asynchronous-article-function
5617                            gnus-newsgroup-threads)
5618                 gnus-newsgroup-threads)))
5619         (gnus-kill-buffer kill-buffer)
5620         (if (not (get-buffer-window gnus-group-buffer))
5621             ()
5622           ;; gotta use windows, because recenter does wierd stuff if
5623           ;; the current buffer ain't the displayed window.
5624           (let ((owin (selected-window))) 
5625             (select-window (get-buffer-window gnus-group-buffer))
5626             (and (gnus-group-goto-group group)
5627                  (recenter))
5628             (select-window owin))))
5629       t))))
5630
5631 (defun gnus-summary-prepare ()
5632   ;; Generate the summary buffer.
5633   (let ((buffer-read-only nil))
5634     (erase-buffer)
5635     (gnus-summary-prepare-threads 
5636      (if gnus-show-threads
5637          (gnus-gather-threads 
5638           (gnus-sort-threads 
5639            (if (and gnus-summary-expunge-below
5640                     (not gnus-fetch-old-headers))
5641                (gnus-make-threads-and-expunge)
5642              (gnus-make-threads))))
5643        gnus-newsgroup-headers)
5644      0 nil nil t)
5645     ;; Erase header retrieval message.
5646     (gnus-summary-update-lines)
5647     (message "")
5648     ;; Remove the final newline.
5649     ;;(goto-char (point-max))
5650     ;;(delete-char -1)
5651     ;; Call hooks for modifying summary buffer.
5652     ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
5653     (goto-char (point-min))
5654     (run-hooks 'gnus-summary-prepare-hook)))
5655
5656 (defun gnus-subject-equal (s1 s2)
5657   (cond 
5658    ((numberp gnus-summary-gather-subject-limit)
5659     (string= (if (> (length s1) gnus-summary-gather-subject-limit)
5660                  (substring s1 0 gnus-summary-gather-subject-limit)
5661                s1)
5662              (if (> (length s2) gnus-summary-gather-subject-limit)
5663                  (substring s2 0 gnus-summary-gather-subject-limit)
5664                s2)))
5665    ((eq 'fuzzy gnus-summary-gather-subject-limit)
5666     (string= (gnus-simplify-subject-fuzzy s1)
5667              (gnus-simplify-subject-fuzzy s2)))
5668    (t
5669     (string= s1 s2))))
5670
5671 (defun gnus-gather-threads (threads)
5672   "Gather threads that have lost their roots."
5673   (if (not gnus-summary-make-false-root)
5674       threads 
5675     (let ((hashtb (gnus-make-hashtable 1023))
5676           (prev threads)
5677           (result threads)
5678           thread subject hthread whole-subject)
5679       (while threads
5680         (setq whole-subject 
5681               (setq subject (header-subject (car (car threads)))))
5682         (if gnus-summary-gather-subject-limit
5683             (or (and (numberp gnus-summary-gather-subject-limit)
5684                      (> (length subject) gnus-summary-gather-subject-limit)
5685                      (setq subject
5686                            (substring subject 0 
5687                                       gnus-summary-gather-subject-limit)))
5688                 (and (eq 'fuzzy gnus-summary-gather-subject-limit)
5689                      (setq subject (gnus-simplify-subject-fuzzy subject))))
5690           (setq subject (gnus-simplify-subject-re subject)))
5691         (if (setq hthread 
5692                   (gnus-gethash subject hashtb))
5693             (progn
5694               (or (stringp (car (car hthread)))
5695                   (setcar hthread (list whole-subject (car hthread))))
5696               (setcdr (car hthread) (nconc (cdr (car hthread)) 
5697                                            (list (car threads))))
5698               (setcdr prev (cdr threads))
5699               (setq threads prev))
5700           (gnus-sethash subject threads hashtb))
5701         (setq prev threads)
5702         (setq threads (cdr threads)))
5703       result)))
5704
5705 (defun gnus-make-threads ()
5706   ;; This function takes the dependencies already made by 
5707   ;; `gnus-get-newsgroup-headers' and builds the trees. First we go
5708   ;; through the dependecies in the hash table and finds all the
5709   ;; roots. Roots do not refer back to any valid articles.
5710   (let (roots)
5711     (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
5712          (gnus-build-old-threads))
5713     (mapatoms
5714      (lambda (refs)
5715        (if (not (car (symbol-value refs)))
5716            (setq roots (append (cdr (symbol-value refs)) roots))
5717          ;; Ok, these refer back to valid articles, but if
5718          ;; `gnus-thread-ignore-subject' is nil, we have to check that
5719          ;; the root has the same subject as its children. The children
5720          ;; that do not are made into roots and removed from the list
5721          ;; of children. 
5722          (or gnus-thread-ignore-subject
5723              (let* ((prev (symbol-value refs))
5724                     (subject (gnus-simplify-subject-re 
5725                               (header-subject (car prev))))
5726                     (headers (cdr prev)))
5727                (while headers
5728                  (if (not (string= subject
5729                                    (gnus-simplify-subject-re 
5730                                     (header-subject (car headers)))))
5731                      (progn
5732                        (setq roots (cons (car headers) roots))
5733                        (setcdr prev (cdr headers)))
5734                    (setq prev headers))
5735                  (setq headers (cdr headers)))))))
5736      gnus-newsgroup-dependencies)
5737     
5738     (mapcar 'gnus-trim-thread
5739             (apply 'append
5740                    (mapcar 'gnus-cut-thread
5741                            (mapcar 'gnus-make-sub-thread roots))))))
5742   
5743 (defun gnus-make-threads-and-expunge ()
5744   ;; This function takes the dependencies already made by 
5745   ;; `gnus-get-newsgroup-headers' and builds the trees. First we go
5746   ;; through the dependecies in the hash table and finds all the
5747   ;; roots. Roots do not refer back to any valid articles.
5748   (let ((default (or gnus-summary-default-score 0))
5749         (below gnus-summary-expunge-below)
5750         roots article)
5751     (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
5752          (gnus-build-old-threads))
5753     (mapatoms
5754      (lambda (refs)
5755        (if (not (car (symbol-value refs)))
5756            ;; These articles do not refer back to any other articles -
5757            ;; they are roots.
5758            (let ((headers (cdr (symbol-value refs))))
5759              ;; We weed out the low-scored articles.
5760              (while headers
5761                (if (not (< (or (cdr (assq (header-number (car headers))
5762                                           gnus-newsgroup-scored)) default)
5763                            below))
5764                    ;; It is over.
5765                    (setq roots (cons (car headers) roots))
5766                  ;; It is below, so we mark it as read.
5767                  (setq gnus-newsgroup-unreads
5768                        (delq (header-number (car headers))
5769                              gnus-newsgroup-unreads)))
5770                (setq headers (cdr headers))))
5771          ;; Ok, these refer back to valid articles, but if
5772          ;; `gnus-thread-ignore-subject' is nil, we have to check that
5773          ;; the root has the same subject as its children. The children
5774          ;; that do not are made into roots and removed from the list
5775          ;; of children. 
5776          (or gnus-thread-ignore-subject
5777              (let* ((prev (symbol-value refs))
5778                     (subject (gnus-simplify-subject-re 
5779                               (header-subject (car prev))))
5780                     (headers (cdr prev)))
5781                (while headers
5782                  (if (not (string= subject
5783                                    (gnus-simplify-subject-re 
5784                                     (header-subject (car headers)))))
5785                      (progn
5786                        (if (not (< (or (cdr (assq (header-number (car headers))
5787                                                   gnus-newsgroup-scored))
5788                                        default) below))
5789                            (setq roots (cons (car headers) roots))
5790                          (setq gnus-newsgroup-unreads
5791                                (delq (header-number (car headers))
5792                                      gnus-newsgroup-unreads)))
5793                        (setcdr prev (cdr headers)))
5794                    (setq prev headers))
5795                  (setq headers (cdr headers)))))
5796          ;; If this article is expunged, some of the children might be
5797          ;; roots.  
5798          (if (< (or (cdr (assq (header-number (car (symbol-value refs)))
5799                                gnus-newsgroup-scored)) default)
5800                 below)
5801              (let* ((prev (symbol-value refs))
5802                     (headers (cdr prev)))
5803                (while headers
5804                  (setq article (header-number (car headers)))
5805                  (if (not (< (or (cdr (assq article gnus-newsgroup-scored))
5806                                  default) below))
5807                      (progn (setq roots (cons (car headers) roots))
5808                             (setq prev headers))
5809                    (setq gnus-newsgroup-unreads 
5810                          (delq article gnus-newsgroup-unreads))
5811                    (setcdr prev (cdr headers)))
5812                  (setq headers (cdr headers))))
5813            ;; It was not expunged, but we look at expunged children.
5814            (let* ((prev (symbol-value refs))
5815                   (headers (cdr prev))
5816                   article id)
5817              (while headers
5818                (setq article (header-number (car headers)))
5819                (if (not (< (or (cdr (assq article gnus-newsgroup-scored))
5820                                default) below))
5821                    (setq prev headers)
5822                  (setq gnus-newsgroup-unreads 
5823                        (delq article gnus-newsgroup-unreads))
5824                  (setcdr prev (cdr headers)))
5825                (setq headers (cdr headers)))))))
5826      gnus-newsgroup-dependencies)
5827
5828     (mapcar 'gnus-trim-thread
5829             (apply 'append
5830                    (mapcar 'gnus-cut-thread
5831                            (mapcar 'gnus-make-sub-thread roots))))))
5832   
5833 (defun gnus-cut-thread (thread)
5834   ;; Remove leaf dormant or ancient articles from THREAD.
5835   (let ((head (car thread))
5836         (tail (apply 'append (mapcar 'gnus-cut-thread (cdr thread)))))
5837     (if (and (null tail)
5838              (let ((number (header-number head)))
5839                (or (memq number gnus-newsgroup-ancient)
5840                    (memq number gnus-newsgroup-dormant)
5841                    (and gnus-summary-expunge-below
5842                         (eq gnus-fetch-old-headers 'some)
5843                         (< (or (cdr (assq number gnus-newsgroup-scored))
5844                                gnus-summary-default-score 0)
5845                            gnus-summary-expunge-below)
5846                         (progn
5847                           (setq gnus-newsgroup-unreads
5848                                 (delq number gnus-newsgroup-unreads))
5849                           t)))))
5850         nil
5851       (list (cons head tail)))))
5852
5853 (defun gnus-trim-thread (thread)
5854   ;; Remove root ancient articles with only one child from THREAD.
5855   (if (and (eq gnus-fetch-old-headers 'some)
5856            (memq (header-number (car thread)) gnus-newsgroup-ancient)
5857            (= (length thread) 2))
5858       (gnus-trim-thread (nth 1 thread))
5859     thread))
5860
5861 (defun gnus-make-sub-thread (root)
5862   ;; This function makes a sub-tree for a node in the tree.
5863   (let ((children (reverse (cdr (gnus-gethash (downcase (header-id root))
5864                                               gnus-newsgroup-dependencies)))))
5865     (cons root (mapcar 'gnus-make-sub-thread children))))
5866
5867 (defun gnus-build-old-threads ()
5868   ;; Look at all the articles that refer back to old articles, and
5869   ;; fetch the headers for the articles that aren't there. This will
5870   ;; build complete threads - if the roots haven't been expired by the
5871   ;; server, that is.
5872   (let (id heads)
5873     (mapatoms
5874      (lambda (refs)
5875        (if (not (car (symbol-value refs)))
5876            (progn
5877              (setq heads (cdr (symbol-value refs)))
5878              (while heads
5879                (if (not (memq (header-number (car heads))
5880                               gnus-newsgroup-dormant))
5881                    (progn
5882                      (setq id (symbol-name refs))
5883                      (while (and (setq id (gnus-build-get-header id))
5884                                  (not (car (gnus-gethash 
5885                                             id gnus-newsgroup-dependencies)))))
5886                      (setq heads nil))
5887                  (setq heads (cdr heads)))))))
5888      gnus-newsgroup-dependencies)))
5889
5890 (defun gnus-build-get-header (id)
5891   ;; Look through the buffer of NOV lines and find the header to
5892   ;; ID. Enter this line into the dependencies hash table, and return
5893   ;; the id of the parent article (if any).
5894   (let ((deps gnus-newsgroup-dependencies)
5895         found header)
5896     (prog1
5897         (save-excursion
5898           (set-buffer nntp-server-buffer)
5899           (goto-char (point-min))
5900           (while (and (not found) (search-forward id nil t))
5901             (beginning-of-line)
5902             (setq found (looking-at 
5903                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
5904                                  (regexp-quote id))))
5905             (or found (beginning-of-line 2)))
5906           (if found
5907               (let (ref)
5908                 (beginning-of-line)
5909                 (and
5910                  (setq header (gnus-nov-parse-line 
5911                                (read (current-buffer)) deps))
5912                  (setq ref (header-references header))
5913                  (string-match "\\(<[^>]+>\\) *$" ref)
5914                  (substring ref (match-beginning 1) (match-end 1))))))
5915       (and header
5916            (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers)
5917                  gnus-newsgroup-ancient (cons (header-number header)
5918                                               gnus-newsgroup-ancient))))))
5919
5920 ;; Re-build the thread containing ID.
5921 (defun gnus-rebuild-thread (id)
5922   (let ((dep gnus-newsgroup-dependencies)
5923         (buffer-read-only nil)
5924         parent headers refs thread art)
5925     (while (and id (setq headers
5926                          (car (setq art (gnus-gethash (downcase id) dep)))))
5927       (setq parent art)
5928       (setq id (and (setq refs (header-references headers))
5929                     (string-match "\\(<[^>]+>\\) *$" refs)
5930                     (substring refs (match-beginning 1) (match-end 1)))))
5931     (setq thread (gnus-make-sub-thread (car parent)))
5932     (gnus-rebuild-remove-articles thread)
5933     (let ((beg (point)))
5934       (gnus-summary-prepare-threads (list thread) 0)
5935       (gnus-summary-update-lines beg (point)))))
5936
5937 ;; Delete all lines in the summary buffer that correspond to articles
5938 ;; in this thread.
5939 (defun gnus-rebuild-remove-articles (thread)
5940   (and (gnus-summary-goto-subject (header-number (car thread)))
5941        (gnus-delete-line))
5942   (mapcar (lambda (th) (gnus-rebuild-remove-articles th)) (cdr thread)))
5943
5944 (defun gnus-sort-threads (threads)
5945   ;; Sort threads as specified in `gnus-thread-sort-functions'.
5946   (let ((fun gnus-thread-sort-functions))
5947     (while fun
5948       (setq threads (sort threads (car fun))
5949             fun (cdr fun))))
5950   threads)
5951
5952 (defun gnus-thread-header (thread)
5953   ;; Return header of first article in THREAD.
5954   (if (consp thread)
5955       (if (stringp (car thread))
5956           (car (car (cdr thread)))
5957         (car thread))
5958     thread))
5959
5960 (defun gnus-thread-sort-by-number (h1 h2)
5961   "Sort threads by root article number."
5962   (let ((h1 (gnus-thread-header h1))
5963         (h2 (gnus-thread-header h2)))
5964     (< (header-number h1) (header-number h2))))
5965
5966 (defun gnus-thread-sort-by-author (h1 h2)
5967   "Sort threads by root author."
5968   (let ((h1 (gnus-thread-header h1))
5969         (h2 (gnus-thread-header h2)))
5970     (string-lessp
5971      (let ((extract (funcall 
5972                      gnus-extract-address-components (header-from h1))))
5973        (or (car extract) (cdr extract)))
5974      (let ((extract (funcall
5975                      gnus-extract-address-components (header-from h2))))
5976        (or (car extract) (cdr extract))))))
5977
5978 (defun gnus-thread-sort-by-subject (h1 h2)
5979   "Sort threads by root subject."
5980   (let ((h1 (gnus-thread-header h1))
5981         (h2 (gnus-thread-header h2)))
5982     (string-lessp
5983      (downcase (gnus-simplify-subject (header-subject h1)))
5984      (downcase (gnus-simplify-subject (header-subject h2))))))
5985
5986 (defun gnus-thread-sort-by-date (h1 h2)
5987   "Sort threads by root article date."
5988   (let ((h1 (gnus-thread-header h1))
5989         (h2 (gnus-thread-header h2)))
5990     (string-lessp
5991      (gnus-sortable-date (header-date h1))
5992      (gnus-sortable-date (header-date h2)))))
5993
5994 (defun gnus-thread-sort-by-score (h1 h2)
5995   "Sort threads by root article score.
5996 Unscored articles will be counted as having a score of zero."
5997   (let ((h1 (gnus-thread-header h1))
5998         (h2 (gnus-thread-header h2)))
5999     (let ((s1 (assq (header-number h1) gnus-newsgroup-scored))
6000           (s2 (assq (header-number h2) gnus-newsgroup-scored)))
6001       (> (or (cdr s1) gnus-summary-default-score 0)
6002          (or (cdr s2) gnus-summary-default-score 0)))))
6003
6004 (defun gnus-thread-sort-by-total-score (h1 h2)
6005   "Sort threads by the sum of all scores in the thread.
6006 Unscored articles will be counted as having a score of zero."
6007   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
6008
6009 (defun gnus-thread-total-score (thread)
6010   ;;  This function find the total score of THREAD.
6011   (if (consp thread)
6012       (if (stringp (car thread))
6013           (apply gnus-thread-score-function 0
6014                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
6015         (gnus-thread-total-score-1 thread))
6016     (gnus-thread-total-score-1 (list thread))))
6017
6018 (defun gnus-thread-total-score-1 (root)
6019   ;; This function find the total score of the thread below ROOT.
6020   (setq root (car root))
6021   (apply gnus-thread-score-function
6022          (or (cdr (assq (header-number root) gnus-newsgroup-scored))
6023              gnus-summary-default-score 0)
6024          (mapcar 'gnus-thread-total-score
6025                  (cdr (gnus-gethash (downcase (header-id root))
6026                                     gnus-newsgroup-dependencies)))))
6027
6028 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
6029 (defvar gnus-tmp-prev-subject "")
6030 (defvar gnus-tmp-adopt-thread nil)
6031
6032 ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>.
6033 (defun gnus-summary-prepare-threads 
6034   (threads level &optional not-child no-subject cull)
6035   "Prepare summary buffer from THREADS and indentation LEVEL.  
6036 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'  
6037 or a straight list of headers."
6038   (let (thread header number subject clevel)
6039     (while threads
6040       (setq thread (car threads)
6041             threads (cdr threads))
6042       ;; If `thread' is a cons, hierarchical threads are used.  If not,
6043       ;; `thread' is the header.
6044       (if (consp thread)
6045           (setq header (car thread))
6046         (setq header thread)
6047         (and cull
6048              (or (memq (setq number (header-number header))
6049                        gnus-newsgroup-dormant)
6050                  (and gnus-summary-expunge-below
6051                       (< (or (cdr (assq number gnus-newsgroup-scored))
6052                              gnus-summary-default-score 0)
6053                          gnus-summary-expunge-below)))
6054              (progn
6055                (setq header nil)
6056                (setq gnus-newsgroup-unreads 
6057                      (delq number gnus-newsgroup-unreads)))))
6058       (cond 
6059        ((stringp header)
6060         ;; The header is a dummy root.
6061         (cond ((eq gnus-summary-make-false-root 'adopt)
6062                ;; We let the first article adopt the rest.
6063                (let ((gnus-tmp-adopt-thread (list (cdr thread))))
6064                  (gnus-summary-prepare-threads (list (car (cdr thread))) 0))
6065                (setq thread (cdr (cdr thread)))
6066                (while thread
6067                  (gnus-summary-prepare-threads (list (car thread)) 1 t)
6068                  (setq thread (cdr thread))))
6069               ((eq gnus-summary-make-false-root 'dummy)
6070                ;; We output a dummy root.
6071                (gnus-summary-insert-dummy-line 
6072                 nil header (header-number (car (car (cdr thread)))))
6073                (setq clevel 1))
6074               ((eq gnus-summary-make-false-root 'empty)
6075                ;; We print the articles with empty subject fields. 
6076                (let ((gnus-tmp-adopt-thread (list (cdr thread))))
6077                  (gnus-summary-prepare-threads (list (car (cdr thread))) 0))
6078                (setq thread (cdr (cdr thread)))
6079                (while thread
6080                  (gnus-summary-prepare-threads 
6081                   (list (car thread)) 0 nil
6082                   (not (and (eq gnus-summary-gather-subject-limit 'fuzzy)
6083                             (not (string=  
6084                                   (gnus-simplify-subject-re 
6085                                    (header-subject (car (car thread))))
6086                                   (gnus-simplify-subject-re header))))))
6087                  (setq thread (cdr thread))))
6088               (t
6089                ;; We do not make a root for the gathered
6090                ;; sub-threads at all.  
6091                (setq clevel 0)))
6092         ;; Print the sub-threads.
6093         (and (consp thread) (cdr thread)
6094              (gnus-summary-prepare-threads (cdr thread) clevel)))
6095        ;; The header is a real article.
6096        (header
6097         (setq number (header-number header)
6098               subject (header-subject header))
6099         (and gnus-newsgroup-async
6100              (setq gnus-newsgroup-threads
6101                    (cons (cons (header-number header)
6102                                (header-lines header)) gnus-newsgroup-threads)))
6103         (gnus-summary-insert-line
6104          nil header level nil 
6105          (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
6106                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
6107                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
6108                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
6109                (t gnus-ancient-mark))
6110          (memq number gnus-newsgroup-replied)
6111          (memq number gnus-newsgroup-expirable)
6112          (if no-subject 
6113              gnus-summary-same-subject
6114            (if (or (zerop level)
6115                    (and gnus-thread-ignore-subject
6116                         (not (string= 
6117                               (gnus-simplify-subject-re gnus-tmp-prev-subject)
6118                               (gnus-simplify-subject-re subject)))))
6119                subject
6120              gnus-summary-same-subject))
6121          not-child
6122          (cdr (assq number gnus-newsgroup-scored)))
6123         (setq gnus-tmp-prev-subject subject)
6124         ;; Recursively print subthreads.
6125         (and (consp thread) (cdr thread)
6126              (gnus-summary-prepare-threads (cdr thread) (1+ level))))))))
6127
6128 (defun gnus-select-newsgroup (group &optional read-all)
6129   "Select newsgroup GROUP.
6130 If READ-ALL is non-nil, all articles in the group are selected."
6131   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
6132          (info (nth 2 entry))
6133          articles header-marks)
6134     (gnus-check-news-server
6135      (setq gnus-current-select-method (gnus-find-method-for-group group)))
6136
6137     (or (gnus-server-opened gnus-current-select-method)
6138         (gnus-open-server gnus-current-select-method)
6139         (error "Couldn't open server"))
6140     
6141     (or (and (eq (car entry) t)
6142              (gnus-activate-newsgroup (car info)))
6143         (gnus-request-group group t)
6144         (progn
6145           (kill-buffer (current-buffer))
6146           (error "Couldn't request group %s: %s" 
6147                  group (gnus-status-message group))))
6148
6149     (setq gnus-newsgroup-name group)
6150     (setq gnus-newsgroup-unselected nil)
6151     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
6152
6153     (and gnus-asynchronous
6154          (gnus-check-backend-function 
6155           'request-asynchronous gnus-newsgroup-name)
6156          (setq gnus-newsgroup-async
6157                (gnus-request-asynchronous gnus-newsgroup-name)))
6158
6159     (setq articles (gnus-articles-to-read group read-all))
6160
6161     (cond 
6162      ((null articles) 
6163       (gnus-message 3 "Couldn't select newsgroup")
6164       'quit)
6165      ((eq articles 0) nil)
6166      (t
6167       ;; Init the dependencies hash table.
6168       (setq gnus-newsgroup-dependencies 
6169             (gnus-make-hashtable (length articles)))
6170       ;; Retrieve the headers and read them in.
6171       (setq gnus-newsgroup-headers 
6172             (if (eq 'nov (setq gnus-headers-retrieved-by
6173                                (gnus-retrieve-headers 
6174                                 (if (and gnus-fetch-old-headers 
6175                                          (not (eq 1 (car articles))))
6176                                     (cons 1 articles)
6177                                   articles)
6178                                 gnus-newsgroup-name)))
6179                 (progn
6180                   (gnus-get-newsgroup-headers-xover articles))
6181               (gnus-get-newsgroup-headers)))
6182       ;; If we were to fetch old headers, but the backend didn't
6183       ;; support XOVER, then it is possible we fetched one article
6184       ;; that we shouldn't have. If that's the case, we pop it off the
6185       ;; list of headers.
6186       (and (not (eq gnus-headers-retrieved-by 'nov))
6187            gnus-fetch-old-headers
6188            gnus-newsgroup-headers
6189            (/= (header-number (car gnus-newsgroup-headers)) (car articles))
6190            (let ((val (gnus-gethash 
6191                        (downcase (header-id (car gnus-newsgroup-headers)))
6192                        gnus-newsgroup-dependencies)))
6193              (and val (setcar val nil))
6194              (setq gnus-newsgroup-headers (cdr gnus-newsgroup-headers))))
6195       ;; Remove cancelled articles from the list of unread articles.
6196       (setq gnus-newsgroup-unreads
6197             (gnus-set-sorted-intersection 
6198              gnus-newsgroup-unreads
6199              (mapcar (lambda (headers) (header-number headers))
6200                      gnus-newsgroup-headers)))
6201       ;; Adjust and set lists of article marks.
6202       (and info
6203            (let (marked)
6204              (gnus-adjust-marked-articles info)
6205              (setq gnus-newsgroup-marked 
6206                    (cdr (assq 'tick (setq marked (nth 3 info)))))
6207              (setq gnus-newsgroup-replied (cdr (assq 'reply marked)))
6208              (setq gnus-newsgroup-expirable (cdr (assq 'expire marked)))
6209              (setq gnus-newsgroup-killed (cdr (assq 'killed marked)))
6210              (setq gnus-newsgroup-bookmarks (cdr (assq 'bookmark marked)))
6211              (setq gnus-newsgroup-dormant (cdr (assq 'dormant marked)))
6212              (setq gnus-newsgroup-scored (cdr (assq 'score marked)))
6213              (setq gnus-newsgroup-processable nil)))
6214       ;; Check whether auto-expire is to be done in this group.
6215       (setq gnus-newsgroup-auto-expire
6216             (or (and (stringp gnus-auto-expirable-newsgroups)
6217                      (string-match gnus-auto-expirable-newsgroups group))
6218                 (memq 'auto-expire (nth 5 info))))
6219       ;; First and last article in this newsgroup.
6220       (and gnus-newsgroup-headers
6221            (setq gnus-newsgroup-begin 
6222                  (header-number (car gnus-newsgroup-headers)))
6223            (setq gnus-newsgroup-end
6224                  (header-number (gnus-last-element gnus-newsgroup-headers))))
6225       (setq gnus-reffed-article-number -1)
6226       ;; GROUP is successfully selected.
6227       (or gnus-newsgroup-headers t)))))
6228
6229 (defun gnus-articles-to-read (group read-all)
6230   ;; Find out what articles the user wants to read.
6231   (let* ((articles
6232           ;; Select all articles if `read-all' is non-nil, or if all the
6233           ;; unread articles are dormant articles.
6234           (if (or (and read-all (not (numberp read-all)))
6235                   (= (length gnus-newsgroup-unreads) 
6236                      (length gnus-newsgroup-dormant)))
6237               (gnus-uncompress-range 
6238                (gnus-gethash group gnus-active-hashtb))
6239             gnus-newsgroup-unreads))
6240          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
6241          (scored (length scored-list))
6242          (number (length articles))
6243          (marked (+ (length gnus-newsgroup-marked)
6244                     (length gnus-newsgroup-dormant)))
6245          (select
6246           (cond 
6247            ((numberp read-all)
6248             read-all)
6249            (t
6250             (condition-case ()
6251                 (cond ((and (or (<= scored marked)
6252                                 (= scored number))
6253                             (numberp gnus-large-newsgroup)
6254                             (> number gnus-large-newsgroup))
6255                        (let ((input
6256                               (read-string
6257                                (format
6258                                 "How many articles from %s (default %d): "
6259                                 gnus-newsgroup-name number))))
6260                          (if (string-equal input "")
6261                              number input)))
6262                       ((and (> scored marked) (< scored number))
6263                        (let ((input
6264                               (read-string
6265                                (format 
6266                                 "%s %s (%d scored, %d total): "
6267                                 "How many articles from"
6268                                 group scored number))))
6269                          (if (string-equal input "")
6270                              number input)))
6271                       (t number))
6272               (quit nil)))))
6273          total-articles)
6274     (setq select (if (stringp select) (string-to-number select) select))
6275     (if (or (null select) (zerop select))
6276         select
6277       (if (and (not (zerop scored)) (<= (abs select) scored))
6278           (progn
6279             (setq articles (sort scored-list '<))
6280             (setq number (length articles)))
6281         (setq articles (copy-sequence articles)))
6282
6283       (setq total-articles articles)
6284       
6285       (if (< (abs select) number)
6286           (if (< select 0) 
6287               ;; Select the N oldest articles.
6288               (setcdr (nthcdr (1- (abs select)) articles) nil)
6289             ;; Select the N most recent articles.
6290             (setq articles (nthcdr (- number select) articles))))
6291       (setq gnus-newsgroup-unselected
6292             (gnus-sorted-intersection
6293              gnus-newsgroup-unreads
6294              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
6295       articles)))
6296
6297 (defun gnus-killed-articles (killed articles)
6298   (let (out)
6299     (while articles
6300       (if (inline (gnus-member-of-range (car articles) killed))
6301           (setq out (cons (car articles) out)))
6302       (setq articles (cdr articles)))
6303     out))
6304
6305 (defun gnus-adjust-marked-articles (info &optional active)
6306   "Remove all marked articles that are no longer legal."
6307   (let ((marked-lists (nth 3 info))
6308         (active (or active (gnus-gethash (car info) gnus-active-hashtb)))
6309         marked m prev)
6310     ;; There are many types of marked articles.
6311     (while marked-lists
6312       (setq m (cdr (setq prev (car marked-lists))))
6313       (cond ((or (eq 'tick (car prev)) (eq 'dormant (car prev)))
6314              ;; Make sure that all ticked articles are a subset of the
6315              ;; unread/unselected articles.
6316              (while m
6317                (if (or (memq (car m) gnus-newsgroup-unreads)
6318                        (memq (car m) gnus-newsgroup-unselected))
6319                    (setq prev m)
6320                  (setcdr prev (cdr m)))
6321                (setq m (cdr m))))
6322             ((eq 'score (car prev))
6323              ;; Scored articles should be a subset of
6324              ;; unread/unselected articles. 
6325              (while m
6326                (if (or (memq (car (car m)) gnus-newsgroup-unreads)
6327                        (memq (car (car m)) gnus-newsgroup-unreads))
6328                    (setq prev m)
6329                  (setcdr prev (cdr m)))
6330                (setq m (cdr m))))
6331             ((eq 'bookmark (car prev))
6332              ;; Bookmarks should be a subset of active articles.
6333              (while m
6334                (if (< (car (car m)) (car active))
6335                    (setcdr prev (cdr m))
6336                  (setq prev m))
6337                (setq m (cdr m))))
6338             ((eq 'killed (car prev))
6339              ;; Articles that have been through the kill process are
6340              ;; to be a subset of active articles.
6341              (while (and m (< (or (and (numberp (car m)) (car m))
6342                                   (cdr (car m)))
6343                               (car active)))
6344                (setcdr prev (cdr m))
6345                (setq m (cdr m)))
6346              (if (and m (< (or (and (numberp (car m)) (car m))
6347                                (car (car m)))
6348                            (car active))) 
6349                  (setcar (if (numberp (car m)) m (car m)) (car active))))
6350             ((or (eq 'reply (car prev)) (eq 'expire (car prev)))
6351              ;; The replied and expirable articles have to be articles
6352              ;; that are active. 
6353              (while m
6354                (if (< (car m) (car active))
6355                    (setcdr prev (cdr m))
6356                  (setq prev m))
6357                (setq m (cdr m)))))
6358       (setq marked-lists (cdr marked-lists)))
6359     ;; Remove all lists that are empty.
6360     (setq marked-lists (nth 3 info))
6361     (if marked-lists
6362         (progn
6363           (while (= 1 (length (car marked-lists)))
6364             (setq marked-lists (cdr marked-lists)))
6365           (setq m (cdr (setq prev marked-lists)))
6366           (while m
6367             (if (= 1 (length (car m)))
6368                 (setcdr prev (cdr m))
6369               (setq prev m))
6370             (setq m (cdr m)))
6371           (setcar (nthcdr 3 info) marked-lists)))
6372     ;; Finally, if there are no marked lists at all left, and if there
6373     ;; are no elements after the lists in the info list, we just chop
6374     ;; the info list off before the marked lists.
6375     (and (null marked-lists) 
6376          (not (nthcdr 4 info))
6377          (setcdr (nthcdr 2 info) nil)))
6378   info)
6379
6380 (defun gnus-set-marked-articles 
6381   (info ticked replied expirable killed dormant bookmark score) 
6382   "Enter the various lists of marked articles into the newsgroup info list."
6383   (let (newmarked)
6384     (and ticked (setq newmarked (cons (cons 'tick ticked) nil)))
6385     (and replied (setq newmarked (cons (cons 'reply replied) newmarked)))
6386     (and expirable (setq newmarked (cons (cons 'expire expirable) 
6387                                          newmarked)))
6388     (and killed (setq newmarked (cons (cons 'killed killed) newmarked)))
6389     (and dormant (setq newmarked (cons (cons 'dormant dormant) newmarked)))
6390     (and bookmark (setq newmarked (cons (cons 'bookmark bookmark) 
6391                                         newmarked)))
6392     (and score (setq newmarked (cons (cons 'score score) newmarked)))
6393     (if (nthcdr 3 info)
6394         (progn
6395           (setcar (nthcdr 3 info) newmarked)
6396           (and (not newmarked)
6397                (not (nthcdr 4 info))
6398                (setcdr (nthcdr 2 info) nil)))
6399       (if newmarked
6400           (setcdr (nthcdr 2 info) (list newmarked))))))
6401
6402 (defun gnus-add-marked-articles (group type articles &optional info force)
6403   ;; Add ARTICLES of TYPE to the info of GROUP.
6404   ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
6405   ;; add, but replace marked articles of TYPE with ARTICLES.
6406   (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
6407         marked m)
6408     (or (not info)
6409         (and (not (setq marked (nthcdr 3 info)))
6410              (setcdr (nthcdr 2 info) (list (list (cons type articles)))))
6411         (and (not (setq m (assq type (car marked))))
6412              (setcar marked (cons (cons type articles) (car marked))))
6413         (if force
6414             (setcdr m articles)
6415           (nconc m articles)))))
6416          
6417 (defun gnus-set-mode-line (where)
6418   "This function sets the mode line of the article or summary buffers.
6419 If WHERE is `summary', the summary mode line format will be used."
6420   (if (memq where gnus-updated-mode-lines)
6421       (let (mode-string)
6422         (save-excursion
6423           (set-buffer gnus-summary-buffer)
6424           (let* ((mformat (if (eq where 'article) 
6425                               gnus-article-mode-line-format-spec
6426                             gnus-summary-mode-line-format-spec))
6427                  (group-name gnus-newsgroup-name)
6428                  (article-number (or gnus-current-article 0))
6429                  (unread (- (length gnus-newsgroup-unreads)
6430                             (length gnus-newsgroup-dormant)))
6431                  (unread-and-unticked 
6432                   (- unread (length gnus-newsgroup-marked)))
6433                  (unselected (length gnus-newsgroup-unselected))
6434                  (unread-and-unselected
6435                   (cond ((and (zerop unread-and-unticked)
6436                               (zerop unselected)) "")
6437                         ((zerop unselected) 
6438                          (format "{%d more}" unread-and-unticked))
6439                         (t (format "{%d(+%d) more}"
6440                                    unread-and-unticked unselected))))
6441                  (subject
6442                   (if gnus-current-headers
6443                       (header-subject gnus-current-headers) ""))
6444                  (max-len (and gnus-mode-non-string-length
6445                                (- (frame-width) gnus-mode-non-string-length)))
6446                  header) ;; passed as argument to any user-format-funcs
6447             (setq mode-string (eval mformat))
6448             (or (numberp max-len)
6449                 (setq max-len (length mode-string)))
6450             (if (< max-len 4) (setq max-len 4))
6451             (if (> (length mode-string) max-len)
6452                 (setq mode-string 
6453                       (concat (substring mode-string 0 (- max-len 3))
6454                               "...")))
6455             (setq mode-string (format (format "%%-%ds" max-len)
6456                                       mode-string))))
6457         (setq mode-line-buffer-identification mode-string)
6458         (set-buffer-modified-p t))))
6459
6460 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
6461   "Go through the HEADERS list and add all Xrefs to a hash table.
6462 The resulting hash table is returned, or nil if no Xrefs were found."
6463   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
6464          (prefix (if (and 
6465                       (gnus-group-foreign-p from-newsgroup)
6466                       (not (memq 'virtual 
6467                                  (assoc (symbol-name (car from-method))
6468                                         gnus-valid-select-methods))))
6469                      (gnus-group-real-prefix from-newsgroup)))
6470          (xref-hashtb (make-vector 63 0))
6471          start group entry number xrefs header)
6472     (while headers
6473       (setq header (car headers))
6474       (if (and (setq xrefs (header-xref header))
6475                (not (memq (header-number header) unreads)))
6476           (progn
6477             (setq start 0)
6478             (while (string-match "\\([^ ]+\\):\\([0-9]+\\)" xrefs start)
6479               (setq start (match-end 0))
6480               (setq group (concat prefix (substring xrefs (match-beginning 1) 
6481                                                     (match-end 1))))
6482               (setq number 
6483                     (string-to-int (substring xrefs (match-beginning 2) 
6484                                               (match-end 2))))
6485               (if (setq entry (gnus-gethash group xref-hashtb))
6486                   (setcdr entry (cons number (cdr entry)))
6487                 (gnus-sethash group (cons number nil) xref-hashtb)))))
6488       (setq headers (cdr headers)))
6489     (if start xref-hashtb nil)))
6490
6491 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable)
6492   "Look through all the headers and mark the Xrefs as read."
6493   (let ((virtual (memq 'virtual 
6494                        (assoc (symbol-name (car (gnus-find-method-for-group 
6495                                                  from-newsgroup)))
6496                               gnus-valid-select-methods)))
6497         name entry read info xref-hashtb idlist active num range exps method
6498         nth4)
6499     (save-excursion
6500       (set-buffer gnus-group-buffer)
6501       (if (setq xref-hashtb 
6502                 (gnus-create-xref-hashtb from-newsgroup headers unreads))
6503           (mapatoms 
6504            (lambda (group)
6505              (if (string= from-newsgroup (setq name (symbol-name group)))
6506                  ()
6507                (setq idlist (symbol-value group))
6508                ;; Dead groups are not updated.
6509                (if (and (prog1 
6510                             (setq entry (gnus-gethash name gnus-newsrc-hashtb)
6511                                   info (nth 2 entry))
6512                           (if (stringp (setq nth4 (nth 4 info)))
6513                               (setq nth4 (gnus-server-to-method nth4))))
6514                         ;; Only do the xrefs if the group has the same
6515                         ;; select method as the group we have just read.
6516                         (or (gnus-methods-equal-p 
6517                              nth4 (gnus-find-method-for-group from-newsgroup))
6518                             virtual
6519                             (equal nth4 
6520                                    (setq method (gnus-find-method-for-group 
6521                                                  from-newsgroup)))
6522                             (and (equal (car nth4) (car method))
6523                                  (equal (nth 1 nth4) (nth 1 method))))
6524                         gnus-use-cross-reference
6525                         (or (not (eq gnus-use-cross-reference t))
6526                             virtual
6527                             ;; Only do cross-references on subscribed
6528                             ;; groups, if that is what is wanted.  
6529                             (<= (nth 1 info) gnus-level-subscribed)))
6530                    (progn
6531                      (setq num 0)
6532                      ;; Set the new list of read articles in this group.
6533                      (setq active (gnus-gethash name gnus-active-hashtb))
6534                      ;; First peel off all illegal article numbers.
6535                      (if active
6536                          (let ((ids idlist)
6537                                (ticked (cdr (assq 'tick (nth 3 info))))
6538                                (dormant (cdr (assq 'dormant (nth 3 info))))
6539                                id)
6540                            (setq exps nil)
6541                            (while ids
6542                              (setq id (car ids))
6543                              (if (or (> id (cdr active))
6544                                      (< id (car active))
6545                                      (memq id ticked)
6546                                      (memq id dormant))
6547                                  (setq idlist (delq id idlist)))
6548                              (and (memq id expirable)
6549                                   (setq exps (cons id exps)))
6550                              (setq ids (cdr ids)))))
6551                      ;; Update expirable articles.
6552                      (gnus-add-marked-articles nil 'expirable exps info)
6553                      (and active
6554                           (null (nth 2 info))
6555                           (> (car active) 1)
6556                           (setcar (nthcdr 2 info) (cons 1 (1- (car active)))))
6557                      (setcar (nthcdr 2 info)
6558                              (setq range
6559                                    (gnus-add-to-range 
6560                                     (nth 2 info) 
6561                                     (setq idlist (sort idlist '<)))))
6562                      ;; Then we have to re-compute how many unread
6563                      ;; articles there are in this group.
6564                      (if active
6565                          (progn
6566                            (cond 
6567                             ((not range)
6568                              (setq num (- (1+ (cdr active)) (car active))))
6569                             ((not (listp (cdr range)))
6570                              (setq num (- (cdr active) (- (1+ (cdr range)) 
6571                                                           (car range)))))
6572                             (t
6573                              (while range
6574                                (if (numberp (car range))
6575                                    (setq num (1+ num))
6576                                  (setq num (+ num (- (1+ (cdr (car range)))
6577                                                      (car (car range))))))
6578                                (setq range (cdr range)))
6579                              (setq num (- (cdr active) num))))
6580                            ;; Update the number of unread articles.
6581                            (setcar 
6582                             entry 
6583                             (max 0 (- num 
6584                                       (length (cdr (assq 'tick (nth 3 info))))
6585                                       (length 
6586                                        (cdr (assq 'dormant (nth 3 info)))))))
6587                            ;; Update the group buffer.
6588                            (gnus-group-update-group name t)))))))
6589            xref-hashtb)))))
6590
6591 (defun gnus-methods-equal-p (m1 m2)
6592   (let ((m1 (or m1 gnus-select-method))
6593         (m2 (or m2 gnus-select-method)))
6594     (or (equal m1 m2)
6595         (and (eq (car m1) (car m2))
6596              (or (not (memq 'address (assoc (symbol-name (car m1))
6597                                             gnus-valid-select-methods)))
6598                  (equal (nth 1 m1) (nth 1 m2)))))))
6599
6600 (defsubst gnus-header-value ()
6601   (buffer-substring (match-end 0) (gnus-point-at-eol)))
6602
6603 (defvar gnus-newsgroup-none-id 0)
6604
6605 (defun gnus-get-newsgroup-headers ()
6606   (setq gnus-article-internal-prepare-hook nil)
6607   (let ((cur nntp-server-buffer)
6608         (dependencies gnus-newsgroup-dependencies)
6609         headers char article id dep end)
6610     (save-excursion
6611       (set-buffer nntp-server-buffer)
6612       (goto-char (point-min))
6613       ;; Search to the beginning of the next header. Error messages
6614       ;; do not begin with 2 or 3.
6615       (while (re-search-forward "^[23][0-9]+ " nil t)
6616         (let ((header (make-vector 9 nil))
6617               (c (following-char))
6618               (case-fold-search t)
6619               (p (point))
6620               from subject in-reply-to references ref)
6621           (setq id nil
6622                 ref nil
6623                 references nil
6624                 subject nil
6625                 from nil)
6626           (header-set-number header (setq article (read cur)))
6627           ;; This implementation of this function, with nine
6628           ;; search-forwards instead of the one re-search-forward and
6629           ;; a case (which basically was the old function) is actually
6630           ;; about twice as fast, even though it looks messier. You
6631           ;; can't have everything, I guess. Speed and elegance
6632           ;; doesn't always come hand in hand.
6633           (save-restriction
6634             (narrow-to-region (point) (or (save-excursion 
6635                                             (search-forward "\n.\n" nil t))
6636                                           (point)))
6637             (if (search-forward "\nfrom: " nil t)
6638                 (header-set-from header (gnus-header-value))
6639               (header-set-from header "(nobody)"))
6640             (goto-char p)
6641             (if (search-forward "\nsubject: " nil t)
6642                 (header-set-subject header (gnus-header-value))
6643               (header-set-subject header "(none)"))
6644             (goto-char p)
6645             (and (search-forward "\nxref: " nil t)
6646                  (header-set-xref header (gnus-header-value)))
6647             (goto-char p)
6648             (or (numberp (and (search-forward "\nlines: " nil t)
6649                               (header-set-lines header (read cur))))
6650                 (header-set-lines header 0))
6651             (goto-char p)
6652             (and (search-forward "\ndate: " nil t)
6653                  (header-set-date header (gnus-header-value)))
6654             (goto-char p)
6655             (if (search-forward "\nmessage-id: " nil t)
6656                 (header-set-id header (setq id (gnus-header-value)))
6657               ;; If there was no message-id, we just fake one to make
6658               ;; subsequent routines simpler.
6659               (header-set-id 
6660                header 
6661                (setq id (concat "none+" 
6662                                 (int-to-string 
6663                                  (setq gnus-newsgroup-none-id 
6664                                        (1+ gnus-newsgroup-none-id)))))))
6665             (goto-char p)
6666             (if (search-forward "\nreferences: " nil t)
6667                 (progn
6668                   (header-set-references header (gnus-header-value))
6669                   (setq end (match-end 0))
6670                   (save-excursion
6671                     (setq ref 
6672                           (downcase
6673                            (buffer-substring
6674                             (progn 
6675                               (end-of-line)
6676                               (search-backward ">" end t)
6677                               (1+ (point)))
6678                             (progn
6679                               (search-backward "<" end t)
6680                               (point)))))))
6681               ;; Get the references from the in-reply-to header if there
6682               ;; ware no references and the in-reply-to header looks
6683               ;; promising. 
6684               (if (and (search-forward "\nin-reply-to: " nil t)
6685                        (setq in-reply-to (gnus-header-value))
6686                        (string-match "<[^>]+>" in-reply-to))
6687                   (progn
6688                     (header-set-references 
6689                      header 
6690                      (setq ref (substring in-reply-to (match-beginning 0)
6691                                           (match-end 0))))
6692                     (setq ref (downcase ref)))
6693                 (setq ref "none")))
6694             ;; We do some threading while we read the headers. The
6695             ;; message-id and the last reference are both entered into
6696             ;; the same hash table. Some tippy-toeing around has to be
6697             ;; done in case an article has arrived before the article
6698             ;; which it refers to.
6699             (if (boundp (setq dep (intern (downcase id) dependencies)))
6700                 (if (car (symbol-value dep))
6701                     ;; An article with this Message-ID has already
6702                     ;; been seen, so we ignore this one, except we add
6703                     ;; any additional Xrefs (in case the two articles
6704                     ;; came from different servers.
6705                     (progn
6706                       (header-set-xref 
6707                        (car (symbol-value dep))
6708                        (concat (or (header-xref (car (symbol-value dep))) "")
6709                                (or (header-xref header) "")))
6710                       (setq header nil))
6711                   (setcar (symbol-value dep) header))
6712               (set dep (list header)))
6713             (if header
6714                 (progn
6715                   (if (boundp (setq dep (intern ref dependencies)))
6716                       (setcdr (symbol-value dep) 
6717                               (cons header (cdr (symbol-value dep))))
6718                     (set dep (list nil header)))
6719                   (setq headers (cons header headers))))
6720             (goto-char (point-max))))))
6721     (nreverse headers)))
6722
6723 ;; The following macros and functions were written by Felix Lee
6724 ;; <flee@cse.psu.edu>. 
6725
6726 (defmacro gnus-nov-read-integer ()
6727   '(prog1
6728        (if (= (following-char) ?\t)
6729            0
6730          (let ((num (condition-case nil (read buffer) (error nil))))
6731            (if (numberp num) num 0)))
6732      (or (eobp) (forward-char 1))))
6733
6734 (defmacro gnus-nov-skip-field ()
6735   '(search-forward "\t" eol 'move))
6736
6737 (defmacro gnus-nov-field ()
6738   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
6739
6740 ;; Goes through the xover lines and returns a list of vectors
6741 (defun gnus-get-newsgroup-headers-xover (sequence)
6742   "Parse the news overview data in the server buffer, and return a
6743 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
6744   ;; Get the Xref when the users reads the articles since most/some
6745   ;; NNTP servers do not include Xrefs when using XOVER.
6746   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
6747   (let ((cur nntp-server-buffer)
6748         (dependencies gnus-newsgroup-dependencies)
6749         (none 0)
6750         number headers header)
6751     (save-excursion
6752       (set-buffer nntp-server-buffer)
6753       (goto-char (point-min))
6754       (while (and sequence (not (eobp)))
6755         (setq number (read cur))
6756         (while (and sequence (< (car sequence) number))
6757           (setq sequence (cdr sequence)))
6758         (and sequence 
6759              (eq number (car sequence))
6760              (progn
6761                (setq sequence (cdr sequence))
6762                (if (setq header 
6763                          (inline (gnus-nov-parse-line number dependencies)))
6764                    (setq headers (cons header headers)))))
6765         (forward-line 1))
6766       (setq headers (nreverse headers)))
6767     headers))
6768
6769 ;; This function has to be called with point after the article number
6770 ;; on the beginning of the line.
6771 (defun gnus-nov-parse-line (number dependencies)
6772   (let ((none 0)
6773         (eol (gnus-point-at-eol)) 
6774         (buffer (current-buffer))
6775         header ref id dep)
6776
6777     ;; overview: [num subject from date id refs chars lines misc]
6778     (narrow-to-region (point) eol)
6779     (forward-char)
6780
6781     (condition-case nil
6782         (setq header
6783               (vector 
6784                number                   ; number
6785                (gnus-nov-field)         ; subject
6786                (gnus-nov-field)         ; from
6787                (gnus-nov-field)         ; date
6788                (setq id (or (gnus-nov-field)
6789                             (concat "none+"
6790                                     (int-to-string 
6791                                      (setq none (1+ none)))))) ; id
6792                (progn
6793                  (save-excursion
6794                    (let ((beg (point)))
6795                      (search-forward "\t" eol)
6796                      (if (search-backward ">" beg t)
6797                          (setq ref 
6798                                (downcase 
6799                                 (buffer-substring 
6800                                  (1+ (point))
6801                                  (progn
6802                                    (search-backward "<" beg t)
6803                                    (point)))))
6804                        (setq ref nil))))
6805                  (gnus-nov-field))      ; refs
6806                (gnus-nov-read-integer)  ; chars
6807                (gnus-nov-read-integer)  ; lines
6808                (if (= (following-char) ?\n)
6809                    nil
6810                  (gnus-nov-field))      ; misc
6811                ))
6812       (error (progn 
6813                (ding)
6814                (message "Strange nov line.")
6815                (setq header nil)
6816                (goto-char eol))))
6817
6818     (widen)
6819
6820     ;; We build the thread tree.
6821     (and header
6822          (if (boundp (setq dep (intern (downcase id) dependencies)))
6823              (if (car (symbol-value dep))
6824                  ;; An article with this Message-ID has already been seen,
6825                  ;; so we ignore this one, except we add any additional
6826                  ;; Xrefs (in case the two articles came from different
6827                  ;; servers.
6828                  (progn
6829                    (header-set-xref 
6830                     (car (symbol-value dep))
6831                     (concat (or (header-xref (car (symbol-value dep))) "")
6832                             (or (header-xref header) "")))
6833                    (setq header nil))
6834                (setcar (symbol-value dep) header))
6835            (set dep (list header))))
6836     (if header
6837         (progn
6838           (if (boundp (setq dep (intern (or ref "none") 
6839                                         dependencies)))
6840               (setcdr (symbol-value dep) 
6841                       (cons header (cdr (symbol-value dep))))
6842             (set dep (list nil header)))))
6843     header))
6844
6845 (defun gnus-article-get-xrefs ()
6846   "Fill in the Xref value in `gnus-current-headers', if necessary.
6847 This is meant to be called in `gnus-article-internal-prepare-hook'."
6848   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
6849                                  gnus-current-headers)))
6850     (or (not gnus-use-cross-reference)
6851         (not headers)
6852         (and (header-xref headers)
6853              (not (string= (header-xref headers) "")))
6854         (let ((case-fold-search t)
6855               xref)
6856           (save-restriction
6857             (gnus-narrow-to-headers)
6858             (goto-char (point-min))
6859             (if (or (and (eq (downcase (following-char)) ?x)
6860                          (looking-at "Xref:"))
6861                     (search-forward "\nXref:" nil t))
6862                 (progn
6863                   (goto-char (1+ (match-end 0)))
6864                   (setq xref (buffer-substring (point) 
6865                                                (progn (end-of-line) (point))))
6866                   (header-set-xref headers xref))))))))
6867
6868 (defalias 'gnus-find-header-by-number 'gnus-get-header-by-number)
6869 (make-obsolete 'gnus-find-header-by-number 'gnus-get-header-by-number)
6870
6871 ;; Return a header specified by a NUMBER.
6872 (defun gnus-get-header-by-number (number)
6873   (save-excursion
6874     (set-buffer gnus-summary-buffer)
6875     (or gnus-newsgroup-headers-hashtb-by-number
6876         (gnus-make-headers-hashtable-by-number))
6877     (gnus-gethash (int-to-string number)
6878                   gnus-newsgroup-headers-hashtb-by-number)))
6879
6880 (defun gnus-make-headers-hashtable-by-number ()
6881   "Make hashtable for the variable gnus-newsgroup-headers by number."
6882   (save-excursion
6883     (set-buffer gnus-summary-buffer)
6884     (let ((headers gnus-newsgroup-headers)
6885           header)
6886       (setq gnus-newsgroup-headers-hashtb-by-number
6887             (gnus-make-hashtable (length headers)))
6888       (while headers
6889         (setq header (car headers))
6890         (gnus-sethash (int-to-string (header-number header))
6891                       header gnus-newsgroup-headers-hashtb-by-number)
6892         (setq headers (cdr headers))))))
6893
6894 (defun gnus-more-header-backward ()
6895   "Find new header backward."
6896   (let ((first (car (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
6897         (artnum gnus-newsgroup-begin)
6898         (header nil))
6899     (while (and (not header)
6900                 (> artnum first))
6901       (setq artnum (1- artnum))
6902       (setq header (gnus-read-header artnum)))
6903     header))
6904
6905 (defun gnus-more-header-forward (&optional backward)
6906   "Find new header forward.
6907 If BACKWARD, find new header backward instead."
6908   (if backward
6909       (gnus-more-header-backward)
6910     (let ((last (cdr (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
6911           (artnum gnus-newsgroup-end)
6912           (header nil))
6913       (while (and (not header)
6914                   (< artnum last))
6915         (setq artnum (1+ artnum))
6916         (setq header (gnus-read-header artnum)))
6917       header)))
6918
6919 (defun gnus-extend-newsgroup (header &optional backward)
6920   "Extend newsgroup selection with HEADER.
6921 Optional argument BACKWARD means extend toward backward."
6922   (if header
6923       (let ((artnum (header-number header)))
6924         (setq gnus-newsgroup-headers
6925               (if backward
6926                   (cons header gnus-newsgroup-headers)
6927                 (nconc gnus-newsgroup-headers (list header))))
6928         (setq gnus-newsgroup-unselected
6929               (delq artnum gnus-newsgroup-unselected))
6930         (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
6931         (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum)))))
6932
6933 (defun gnus-summary-work-articles (n)
6934   "Return a list of articles to be worked upon. The prefix argument,
6935 the list of process marked articles, and the current article will be
6936 taken into consideration."
6937   (let (articles)
6938     (if (and n (numberp n))
6939         (let ((backward (< n 0))
6940               (n (abs n)))
6941           (save-excursion
6942             (while (and (> n 0)
6943                         (setq articles (cons (gnus-summary-article-number) 
6944                                              articles))
6945                         (gnus-summary-search-forward nil nil backward))
6946               (setq n (1- n))))
6947           (sort articles (function <)))
6948       (or (reverse gnus-newsgroup-processable)
6949           (list (gnus-summary-article-number))))))
6950
6951 (defun gnus-summary-search-group (&optional backward use-level)
6952   "Search for next unread newsgroup.
6953 If optional argument BACKWARD is non-nil, search backward instead."
6954   (save-excursion
6955     (set-buffer gnus-group-buffer)
6956     (if (gnus-group-search-forward 
6957          backward nil (if use-level (gnus-group-group-level) nil))
6958         (gnus-group-group-name))))
6959
6960 (defun gnus-summary-best-group (&optional exclude-group)
6961   "Find the name of the best unread group.
6962 If EXCLUDE-GROUP, do not go to this group."
6963   (save-excursion
6964     (set-buffer gnus-group-buffer)
6965     (save-excursion
6966       (gnus-group-best-unread-group exclude-group))))
6967
6968 (defun gnus-summary-search-subject (&optional backward unread subject)
6969   "Search for article forward.
6970 If BACKWARD is non-nil, search backward.
6971 If UNREAD is non-nil, only unread articles are selected.
6972 If SUBJECT is non-nil, the article which has the same subject will be
6973 searched for." 
6974   (let ((func (if backward 'previous-single-property-change
6975                 'next-single-property-change))
6976         (beg (point))
6977         (did t)
6978         pos psubject)
6979     (beginning-of-line)
6980     (and gnus-summary-check-current unread
6981          (eq (get-text-property (point) 'gnus-mark) gnus-unread-mark)
6982          (setq did nil))
6983     (if (not did)
6984         ()
6985       (forward-char (if backward (if (bobp) 0 -1) (if (eobp) 0 1)))
6986       (while
6987           (and 
6988            (setq pos (funcall func (point) 'gnus-number))
6989            (goto-char (if backward (1- pos) pos))
6990            (setq did
6991                  (not (and
6992                        (or (not unread)
6993                            (eq (get-text-property (point) 'gnus-mark)
6994                                gnus-unread-mark))
6995                        (or (not subject)
6996                            (and (setq psubject (gnus-summary-subject-string))
6997                                 (equal (gnus-simplify-subject-re subject)
6998                                        (gnus-simplify-subject-re
6999                                         psubject)))))))
7000            (if backward (if (bobp) nil (forward-char -1) t)
7001              (if (eobp) nil (forward-char 1) t)))))
7002     (if did
7003         (progn (goto-char beg) nil)
7004       (prog1
7005           (get-text-property (point) 'gnus-number)
7006         (gnus-summary-position-cursor)))))
7007
7008 (defun gnus-summary-search-forward (&optional unread subject backward)
7009   "Search for article forward.
7010 If UNREAD is non-nil, only unread articles are selected.
7011 If SUBJECT is non-nil, the article which has the same subject will be
7012 searched for. 
7013 If BACKWARD is non-nil, the search will be performed backwards instead."
7014   (gnus-summary-search-subject backward unread subject))
7015
7016 (defun gnus-summary-search-backward (&optional unread subject)
7017   "Search for article backward.
7018 If 1st optional argument UNREAD is non-nil, only unread article is selected.
7019 If 2nd optional argument SUBJECT is non-nil, the article which has
7020 the same subject will be searched for."
7021   (gnus-summary-search-forward unread subject t))
7022
7023 (defun gnus-summary-article-number (&optional number-or-nil)
7024   "The article number of the article on the current line.
7025 If there isn's an article number here, then we return the current
7026 article number."
7027   (let* ((number (get-text-property (gnus-point-at-bol) 'gnus-number)))
7028     (if number-or-nil number (or number gnus-current-article))))
7029
7030 (defun gnus-summary-thread-level ()
7031   "The thread level of the article on the current line."
7032   (or (get-text-property (gnus-point-at-bol) 'gnus-level)
7033       0))
7034
7035 (defun gnus-summary-pseudo-article ()
7036   "The thread level of the article on the current line."
7037   (get-text-property (gnus-point-at-bol) 'gnus-pseudo))
7038
7039 (defun gnus-summary-article-mark ()
7040   "The mark on the current line."
7041   (get-text-property (gnus-point-at-bol) 'gnus-mark))
7042
7043 (defun gnus-summary-subject-string ()
7044   "Return current subject string or nil if nothing."
7045   (let ((article (gnus-summary-article-number))
7046         header)
7047     (and article 
7048          (setq header (gnus-get-header-by-number article))
7049          (vectorp header)
7050          (header-subject header))))
7051
7052 (defalias 'gnus-summary-score 'gnus-summary-article-score)
7053 (make-obsolete 'gnus-summary-score 'gnus-summary-article-score)
7054 (defun gnus-summary-article-score ()
7055   "Return current article score."
7056   (or (cdr (assq (gnus-summary-article-number) gnus-newsgroup-scored))
7057       gnus-summary-default-score 0))
7058
7059 ;; Written by Sudish Joseph <joseph@cis.ohio-state.edu>.
7060
7061 (defun gnus-summary-recenter ()
7062   "Center point in the summary window.
7063 If `gnus-auto-center-summary' is nil, or the article buffer isn't
7064 displayed, no centering will be performed." 
7065   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
7066   ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
7067   (let* ((top (cond ((< (window-height) 4) 0)
7068                     ((< (window-height) 6) 1)
7069                     (t 2)))
7070          (height (1- (window-height)))
7071          (bottom (save-excursion (goto-char (point-max))
7072                                  (forward-line (- height))
7073                                  (point)))
7074          (window (get-buffer-window (current-buffer))))
7075     (and 
7076      ;; The user has to want it,
7077      gnus-auto-center-summary 
7078      ;; the article buffer must be displayed,
7079      (get-buffer-window gnus-article-buffer)
7080      ;; Set the window start to either `bottom', which is the biggest
7081      ;; possible valid number, or the second line from the top,
7082      ;; whichever is the least.
7083      (set-window-start
7084       window (min bottom (save-excursion (forward-line (- top)) (point)))))))
7085
7086 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
7087 (defun gnus-short-group-name (group &optional levels)
7088   "Collapse GROUP name LEVELS."
7089   (let* ((name "") (foreign "") (depth -1) (skip 1)
7090          (levels (or levels
7091                      (progn
7092                        (while (string-match "\\." group skip)
7093                          (setq skip (match-end 0)
7094                                depth (+ depth 1)))
7095                        depth))))
7096     (if (string-match ":" group)
7097         (setq foreign (substring group 0 (match-end 0))
7098               group (substring group (match-end 0))))
7099     (while group
7100       (if (and (string-match "\\." group) (> levels 0))
7101           (setq name (concat name (substring group 0 1))
7102                 group (substring group (match-end 0))
7103                 levels (- levels 1)
7104                 name (concat name "."))
7105         (setq name (concat foreign name group)
7106               group nil)))
7107     name))
7108
7109 (defun gnus-summary-jump-to-group (newsgroup)
7110   "Move point to NEWSGROUP in group mode buffer."
7111   ;; Keep update point of group mode buffer if visible.
7112   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
7113       (save-window-excursion
7114         ;; Take care of tree window mode.
7115         (if (get-buffer-window gnus-group-buffer)
7116             (pop-to-buffer gnus-group-buffer))
7117         (gnus-group-jump-to-group newsgroup))
7118     (save-excursion
7119       ;; Take care of tree window mode.
7120       (if (get-buffer-window gnus-group-buffer)
7121           (pop-to-buffer gnus-group-buffer)
7122         (set-buffer gnus-group-buffer))
7123       (gnus-group-jump-to-group newsgroup))))
7124
7125 ;; This function returns a list of article numbers based on the
7126 ;; difference between the ranges of read articles in this group and
7127 ;; the range of active articles.
7128 (defun gnus-list-of-unread-articles (group)
7129   (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
7130          (active (gnus-gethash group gnus-active-hashtb))
7131          (last (cdr active))
7132          unread first nlast unread)
7133     ;; If none are read, then all are unread. 
7134     (if (not read)
7135         (setq first (car active))
7136       ;; If the range of read articles is a single range, then the
7137       ;; first unread article is the article after the last read
7138       ;; article. Sounds logical, doesn't it?
7139       (if (not (listp (cdr read)))
7140           (setq first (1+ (cdr read)))
7141         ;; `read' is a list of ranges.
7142         (if (/= (setq nlast (or (and (numberp (car read)) (car read)) 
7143                                 (car (car read)))) 1)
7144             (setq first 1))
7145         (while read
7146           (if first 
7147               (while (< first nlast)
7148                 (setq unread (cons first unread))
7149                 (setq first (1+ first))))
7150           (setq first (1+ (if (atom (car read)) (car read) (cdr (car read)))))
7151           (setq nlast (if (atom (car (cdr read))) 
7152                           (car (cdr read))
7153                         (car (car (cdr read)))))
7154           (setq read (cdr read)))))
7155     ;; And add the last unread articles.
7156     (while (<= first last)
7157       (setq unread (cons first unread))
7158       (setq first (1+ first)))
7159     ;; Return the list of unread articles.
7160     (nreverse unread)))
7161
7162 (defun gnus-list-of-read-articles (group)
7163   (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
7164         (active (gnus-gethash group gnus-active-hashtb)))
7165     (and info active
7166          (gnus-sorted-complement 
7167           (gnus-uncompress-range active) 
7168           (gnus-list-of-unread-articles group)))))
7169
7170 ;; Various summary commands
7171
7172 (defun gnus-summary-universal-argument ()
7173   "Perform any operation on all articles marked with the process mark."
7174   (interactive)
7175   (gnus-set-global-variables)
7176   (let ((articles (reverse gnus-newsgroup-processable))
7177         key func)
7178     (or articles (error "No articles marked"))
7179     (or (setq func (key-binding (read-key-sequence "C-c C-u")))
7180         (error "Undefined key"))
7181     (while articles
7182       (gnus-summary-goto-subject (car articles))
7183       (command-execute func)
7184       (gnus-summary-remove-process-mark (car articles))
7185       (setq articles (cdr articles)))))
7186
7187 (defun gnus-summary-toggle-truncation (arg)
7188   "Toggle truncation of summary lines.
7189 With arg, turn line truncation on iff arg is positive."
7190   (interactive "P")
7191   (setq truncate-lines
7192         (if (null arg) (not truncate-lines)
7193           (> (prefix-numeric-value arg) 0)))
7194   (redraw-display))
7195
7196 (defun gnus-summary-reselect-current-group (all)
7197   "Once exit and then reselect the current newsgroup.
7198 The prefix argument ALL means to select all articles."
7199   (interactive "P")
7200   (gnus-set-global-variables)
7201   (let ((current-subject (gnus-summary-article-number))
7202         (group gnus-newsgroup-name))
7203     (setq gnus-newsgroup-begin nil)
7204     (gnus-summary-exit t)
7205     ;; We have to adjust the point of group mode buffer because the
7206     ;; current point was moved to the next unread newsgroup by
7207     ;; exiting.
7208     (gnus-summary-jump-to-group group)
7209     (gnus-group-read-group all t)
7210     (gnus-summary-goto-subject current-subject)))
7211
7212 (defun gnus-summary-rescan-group (all)
7213   "Exit the newsgroup, ask for new articles, and select the newsgroup."
7214   (interactive "P")
7215   (gnus-set-global-variables)
7216   ;; Fix by Ilja Weis <kult@uni-paderborn.de>.
7217   (let ((group gnus-newsgroup-name))
7218     (gnus-summary-exit)
7219     (gnus-summary-jump-to-group group)
7220     (save-excursion
7221       (set-buffer gnus-group-buffer)
7222       (gnus-group-get-new-news-this-group 1))
7223     (gnus-summary-jump-to-group group)
7224     (gnus-group-read-group all)))
7225
7226 (defun gnus-summary-update-info ()
7227   (let* ((group gnus-newsgroup-name)
7228          (method (car (gnus-find-method-for-group group))))
7229     (if gnus-newsgroup-kill-headers
7230         (setq gnus-newsgroup-killed
7231               (gnus-compress-sequence
7232                (nconc
7233                 (gnus-set-sorted-intersection
7234                  (gnus-uncompress-range gnus-newsgroup-killed)
7235                  (setq gnus-newsgroup-unselected
7236                        (sort gnus-newsgroup-unselected '<)))
7237                 (setq gnus-newsgroup-unreads
7238                       (sort gnus-newsgroup-unreads '<))) t)))
7239     (or (listp (cdr gnus-newsgroup-killed))
7240         (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
7241     (let ((updated nil)
7242           (headers gnus-newsgroup-headers))
7243       (gnus-close-group group)
7244       (run-hooks 'gnus-exit-group-hook)
7245       (gnus-update-read-articles 
7246        group gnus-newsgroup-unreads gnus-newsgroup-unselected 
7247        gnus-newsgroup-marked
7248        t gnus-newsgroup-replied gnus-newsgroup-expirable
7249        gnus-newsgroup-killed gnus-newsgroup-dormant
7250        gnus-newsgroup-bookmarks 
7251        (and gnus-save-score gnus-newsgroup-scored))
7252       (and gnus-use-cross-reference
7253            (gnus-mark-xrefs-as-read 
7254             group headers gnus-newsgroup-unreads gnus-newsgroup-expirable))
7255       ;; Do adaptive scoring, and possibly save score files.
7256       (and gnus-newsgroup-adaptive
7257            (gnus-score-adaptive))
7258       (and gnus-use-scoring 
7259            (fboundp 'gnus-score-save)
7260            (funcall 'gnus-score-save))
7261       ;; Do not switch windows but change the buffer to work.
7262       (set-buffer gnus-group-buffer)
7263       (or (assoc 'quit-config (gnus-find-method-for-group gnus-newsgroup-name))
7264           (gnus-group-update-group group)))))
7265   
7266 (defun gnus-summary-exit (&optional temporary)
7267   "Exit reading current newsgroup, and then return to group selection mode.
7268 gnus-exit-group-hook is called with no arguments if that value is non-nil."
7269   (interactive)
7270   (gnus-set-global-variables)
7271   (gnus-kill-save-kill-buffer)
7272   (let* ((group gnus-newsgroup-name)
7273          (quit-config (nth 1 (assoc 'quit-config (gnus-find-method-for-group
7274                                                   gnus-newsgroup-name))))
7275          (mode major-mode)
7276          (method (car (gnus-find-method-for-group group)))
7277          (buf (current-buffer)))
7278     (gnus-summary-update-info) ; Make all changes in this group permanent.
7279     ;; Make sure where I was, and go to next newsgroup.
7280     (or quit-config
7281         (progn
7282           (gnus-group-jump-to-group group)
7283           (gnus-group-next-unread-group 1)))
7284     (if temporary
7285         nil                             ;Nothing to do.
7286       ;; We set all buffer-local variables to nil. It is unclear why
7287       ;; this is needed, but if we don't, buffer-local variables are
7288       ;; not garbage-collected, it seems. This would the lead to en
7289       ;; ever-growing Emacs.
7290       (set-buffer buf)
7291       (gnus-summary-clear-local-variables)
7292       ;; We clear the global counterparts of the buffer-local
7293       ;; variables as well, just to be on the safe side.
7294       (gnus-configure-windows 'group)
7295       (gnus-summary-clear-local-variables)
7296       ;; Return to group mode buffer. 
7297       (if (eq mode 'gnus-summary-mode)
7298           (gnus-kill-buffer buf))
7299       (if (get-buffer gnus-article-buffer)
7300           (bury-buffer gnus-article-buffer))
7301       (setq gnus-current-select-method gnus-select-method)
7302       (pop-to-buffer gnus-group-buffer)
7303       (if (not quit-config)
7304           (progn
7305             (gnus-group-jump-to-group group)
7306             (gnus-group-next-unread-group 1))
7307         (if (not (buffer-name (car quit-config)))
7308             (gnus-configure-windows 'group)
7309           (set-buffer (car quit-config))
7310           (and (eq major-mode 'gnus-summary-mode)
7311                (gnus-set-global-variables))
7312           (gnus-configure-windows (cdr quit-config)))))))
7313
7314 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
7315 (defun gnus-summary-exit-no-update (&optional no-questions)
7316   "Quit reading current newsgroup without updating read article info."
7317   (interactive)
7318   (let* ((group gnus-newsgroup-name)
7319          (quit-config (nth 1 (assoc 'quit-config 
7320                                     (gnus-find-method-for-group group)))))
7321     (if (or no-questions
7322             gnus-expert-user
7323             (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
7324         (progn
7325           (gnus-close-group group)
7326           (gnus-summary-clear-local-variables)
7327           (set-buffer gnus-group-buffer)
7328           (gnus-summary-clear-local-variables)
7329           ;; Return to group selection mode.
7330           (gnus-configure-windows 'group)
7331           (if (get-buffer gnus-summary-buffer)
7332               (kill-buffer gnus-summary-buffer))
7333           (if (get-buffer gnus-article-buffer)
7334               (bury-buffer gnus-article-buffer))
7335           (if (equal (gnus-group-group-name) group)
7336               (gnus-group-next-unread-group 1))
7337           (if quit-config
7338               (progn
7339                 (if (not (buffer-name (car quit-config)))
7340                     (gnus-configure-windows 'group)
7341                   (set-buffer (car quit-config))
7342                   (and (eq major-mode 'gnus-summary-mode)
7343                        (gnus-set-global-variables))
7344                   (gnus-configure-windows (cdr quit-config)))))))))
7345
7346 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
7347 (defun gnus-summary-fetch-faq (group)
7348   "Fetch the FAQ for the current group."
7349   (interactive (list gnus-newsgroup-name))
7350   (gnus-configure-windows 'summary-faq)
7351   (find-file (concat gnus-group-faq-directory group)))
7352
7353 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
7354 (defun gnus-summary-describe-group (force)
7355   "Describe the current newsgroup."
7356   (interactive "P")
7357   (gnus-group-describe-group force gnus-newsgroup-name))
7358
7359 (defun gnus-summary-describe-briefly ()
7360   "Describe summary mode commands briefly."
7361   (interactive)
7362   (gnus-message 6
7363     (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")))
7364
7365 ;; Walking around group mode buffer from summary mode.
7366
7367 (defun gnus-summary-next-group (&optional no-article group backward)
7368   "Exit current newsgroup and then select next unread newsgroup.
7369 If prefix argument NO-ARTICLE is non-nil, no article is selected initially.
7370 If BACKWARD, go to previous group instead."
7371   (interactive "P")
7372   (gnus-set-global-variables)
7373   (let ((ingroup gnus-newsgroup-name)
7374         (sumbuf (current-buffer))
7375         num)
7376     (gnus-summary-exit t)               ;Update all information.
7377     (if (and group
7378              (or (and (numberp (setq num (car (gnus-gethash
7379                                                group gnus-newsrc-hashtb))))
7380                       (< num 1))
7381                  (null num)))
7382         (progn
7383           (gnus-group-jump-to-group group)
7384           (setq group nil))
7385       (gnus-group-jump-to-group ingroup))
7386     (gnus-summary-search-group backward)
7387     (let ((group (or group (gnus-summary-search-group backward)))
7388           (buf gnus-summary-buffer))
7389       (if (null group)
7390           (gnus-summary-exit-no-update t)
7391         (gnus-message 5 "Selecting %s..." group)
7392         ;; We are now in group mode buffer.
7393         ;; Make sure group mode buffer point is on GROUP.
7394         (gnus-group-jump-to-group group)
7395         (if (not (eq gnus-auto-select-next 'quietly))
7396             (progn
7397               (gnus-summary-read-group group nil no-article buf)
7398               (and (string= gnus-newsgroup-name ingroup)
7399                    (bufferp sumbuf) (buffer-name sumbuf)
7400                    (progn
7401                      (set-buffer (setq gnus-summary-buffer sumbuf))
7402                      (gnus-summary-exit-no-update t))))
7403           (let ((prevgroup group))
7404             (gnus-summary-read-group group nil no-article buf)
7405             (while (and (string= gnus-newsgroup-name ingroup)
7406                         (bufferp sumbuf) 
7407                         (buffer-name sumbuf)
7408                         (not (string= prevgroup (gnus-group-group-name))))
7409               (set-buffer gnus-group-buffer)
7410               (gnus-summary-read-group 
7411                (setq prevgroup (gnus-group-group-name)) 
7412                nil no-article buf))
7413             (and (string= prevgroup (gnus-group-group-name))
7414                  ;; We have reached the final group in the group
7415                  ;; buffer.
7416                  (progn
7417                    (if (buffer-name sumbuf)
7418                        (progn
7419                          (set-buffer sumbuf)
7420                          (gnus-summary-exit)))))))))))
7421
7422 (defun gnus-summary-prev-group (no-article)
7423   "Exit current newsgroup and then select previous unread newsgroup.
7424 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
7425   (interactive "P")
7426   (gnus-summary-next-group no-article nil t))
7427
7428 ;; Walking around summary lines.
7429
7430 (defun gnus-summary-first-subject (unread)
7431   "Go to the first unread subject.
7432 If UNREAD is non-nil, go to the first unread article.
7433 Returns nil if there are no unread articles."
7434   (interactive "P")
7435   (prog1
7436       (if (or (not unread)
7437               (gnus-goto-char 
7438                (text-property-any 
7439                 (point-min) (point-max) 'gnus-mark gnus-unread-mark)))
7440           t 
7441         ;; If there are no unread articles.
7442         (gnus-message 3 "No more unread articles")
7443         nil)
7444     (gnus-summary-position-cursor)))
7445
7446 (defun gnus-summary-next-subject (n &optional unread dont-display)
7447   "Go to next N'th summary line.
7448 If N is negative, go to the previous N'th subject line.
7449 If UNREAD is non-nil, only unread articles are selected.
7450 The difference between N and the actual number of steps taken is
7451 returned."
7452   (interactive "p")
7453   (let ((backward (< n 0))
7454         (n (abs n)))
7455     (while (and (> n 0)
7456                 (gnus-summary-search-forward unread nil backward))
7457       (setq n (1- n)))
7458     (if (/= 0 n) (gnus-message 7 "No more%s articles"
7459                                (if unread " unread" "")))
7460     (or dont-display
7461         (progn
7462           (gnus-summary-recenter)
7463           (gnus-summary-position-cursor)))
7464   n))
7465
7466 (defun gnus-summary-next-unread-subject (n)
7467   "Go to next N'th unread summary line."
7468   (interactive "p")
7469   (gnus-summary-next-subject n t))
7470
7471 (defun gnus-summary-prev-subject (n &optional unread)
7472   "Go to previous N'th summary line.
7473 If optional argument UNREAD is non-nil, only unread article is selected."
7474   (interactive "p")
7475   (gnus-summary-next-subject (- n) unread))
7476
7477 (defun gnus-summary-prev-unread-subject (n)
7478   "Go to previous N'th unread summary line."
7479   (interactive "p")
7480   (gnus-summary-next-subject (- n) t))
7481
7482 (defun gnus-summary-goto-subject (article)
7483   "Go the subject line of ARTICLE."
7484   (interactive
7485    (list
7486     (string-to-int
7487      (completing-read "Article number: "
7488                       (mapcar
7489                        (lambda (headers)
7490                          (list
7491                           (int-to-string (header-number headers))))
7492                        gnus-newsgroup-headers)
7493                       nil 'require-match))))
7494   (or article (error "No article number"))
7495   (let ((b (point)))
7496     (if (not (gnus-goto-char (text-property-any (point-min) (point-max)
7497                                                 'gnus-number article)))
7498         ()
7499       (gnus-summary-show-thread)
7500       ;; Skip dummy articles. 
7501       (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
7502           (forward-line 1))
7503       (prog1
7504           (if (not (eobp))
7505               article
7506             (goto-char b)
7507             nil)
7508         (gnus-summary-position-cursor)))))
7509
7510 ;; Walking around summary lines with displaying articles.
7511
7512 (defun gnus-summary-expand-window ()
7513   "Make the summary buffer take up the entire Emacs frame."
7514   (interactive)
7515   (gnus-set-global-variables)
7516   (gnus-configure-windows 'summary))
7517
7518 (defun gnus-summary-display-article (article &optional all-header)
7519   "Display ARTICLE in article buffer."
7520   (gnus-set-global-variables)
7521   (if (null article)
7522       nil
7523     (gnus-article-prepare article all-header)
7524     (gnus-summary-show-thread)
7525     (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
7526         (progn
7527           (forward-line 1)
7528           (gnus-summary-position-cursor)))
7529     (run-hooks 'gnus-select-article-hook)
7530     (gnus-summary-recenter)
7531 ;    (set-window-point (get-buffer-window (current-buffer)) (point-max))
7532 ;    (sit-for 0)
7533     (gnus-summary-goto-subject article)
7534     ;; Successfully display article.
7535     (gnus-summary-update-line)
7536     (gnus-article-set-window-start 
7537      (cdr (assq article gnus-newsgroup-bookmarks)))
7538     t))
7539
7540 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
7541   "Select the current article.
7542 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
7543 non-nil, the article will be re-fetched even if it already present in
7544 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
7545 be displayed."
7546   (and (not pseudo) (gnus-summary-pseudo-article)
7547        (error "This is a pseudo-article."))
7548   (let ((article (or article (gnus-summary-article-number)))
7549         (all-headers (not (not all-headers))) ;Must be T or NIL.
7550         did) 
7551     (prog1
7552         (save-excursion
7553           (set-buffer gnus-summary-buffer)
7554           (if (or (null gnus-current-article)
7555                   (null gnus-article-current)
7556                   (not (eq article (cdr gnus-article-current)))
7557                   (not (equal (car gnus-article-current) gnus-newsgroup-name))
7558                   force)
7559               ;; The requested article is different from the current article.
7560               (progn
7561                 (gnus-summary-display-article article all-headers)
7562                 (setq did article))
7563             (if all-headers (gnus-article-show-all-headers))
7564             nil))
7565       (if did 
7566           (gnus-article-set-window-start 
7567            (cdr (assq article gnus-newsgroup-bookmarks)))))))
7568
7569 (defun gnus-summary-set-current-mark (&optional current-mark)
7570   "Obsolete function."
7571   nil)
7572
7573 (defun gnus-summary-next-article (unread &optional subject backward)
7574   "Select the next article.
7575 If UNREAD, only unread articles are selected.
7576 If SUBJECT, only articles with SUBJECT are selected.
7577 If BACKWARD, the previous article is selected instead of the next."
7578   (interactive "P")
7579   (gnus-set-global-variables)
7580   (let ((opoint (point))
7581         (method (car (gnus-find-method-for-group gnus-newsgroup-name)))
7582         header)
7583     (cond
7584      ;; Is there such an article?
7585      ((gnus-summary-display-article 
7586        (gnus-summary-search-forward unread subject backward))
7587       (gnus-summary-position-cursor))
7588      ;; If not, we try the first unread, if that is wanted.
7589      ((and subject
7590            gnus-auto-select-same
7591            (gnus-summary-first-unread-article))
7592       (gnus-message 6 "Wrapped"))
7593      ;; Try to get next/previous article not displayed in this group.
7594      ((and gnus-auto-extend-newsgroup
7595            (not unread) (not subject)
7596            (setq header (gnus-more-header-forward backward)))
7597       (gnus-extend-newsgroup header backward)
7598       (let ((buffer-read-only nil))
7599         (goto-char (if backward (point-min) (point-max)))
7600         (gnus-summary-prepare-threads (list header) 0))
7601       (gnus-summary-goto-article (if backward gnus-newsgroup-begin
7602                                    gnus-newsgroup-end)))
7603      ;; Go to next/previous group.
7604      (t
7605       (or (assoc 'quit-config (gnus-find-method-for-group gnus-newsgroup-name))
7606           (gnus-summary-jump-to-group gnus-newsgroup-name))
7607       (let ((cmd (aref (this-command-keys) 0))
7608             (group 
7609              (if (eq gnus-keep-same-level 'best) 
7610                  (gnus-summary-best-group gnus-newsgroup-name)
7611                (gnus-summary-search-group backward gnus-keep-same-level))))
7612         ;; For some reason, the group window gets selected. We change
7613         ;; it back.  
7614         (select-window (get-buffer-window (current-buffer)))
7615         ;; Keep just the event type of CMD.
7616         (and (listp cmd) (setq cmd (car cmd)))
7617         ;; Select next unread newsgroup automagically.
7618         (cond 
7619          ((not gnus-auto-select-next)
7620           (gnus-message 7 "No more%s articles" (if unread " unread" "")))
7621          ((eq gnus-auto-select-next 'quietly)
7622           ;; Select quietly.
7623           (if (assoc 'quit-config (gnus-find-method-for-group 
7624                                    gnus-newsgroup-name))
7625               (gnus-summary-exit)
7626             (gnus-message 7 "No more%s articles (%s)..."
7627                           (if unread " unread" "") 
7628                           (if group (concat "selecting " group)
7629                             "exiting"))
7630             (gnus-summary-next-group nil group backward)))
7631          (t
7632           (let ((keystrokes '(?\C-n ?\C-p))
7633                 key)
7634             (while (or (null key) (memq key keystrokes))
7635               (gnus-message 
7636                7 "No more%s articles%s" (if unread " unread" "")
7637                (if (and group (not (assoc 'quit-config
7638                                           (gnus-find-method-for-group 
7639                                            gnus-newsgroup-name))))
7640                    (format " (Type %s for %s [%s])"
7641                            (single-key-description cmd) group
7642                            (car (gnus-gethash group gnus-newsrc-hashtb)))
7643                  (format " (Type %s to exit %s)"
7644                          (single-key-description cmd)
7645                          gnus-newsgroup-name)))
7646               ;; Confirm auto selection.
7647               (let* ((event (read-event)))
7648                 (setq key (if (listp event) (car event) event))
7649                 (if (memq key keystrokes)
7650                     (let ((obuf (current-buffer)))
7651                       (switch-to-buffer gnus-group-buffer)
7652                       (gnus-group-jump-to-group group)
7653                       (execute-kbd-macro (char-to-string key))
7654                       (setq group (gnus-group-group-name))
7655                       (switch-to-buffer obuf)))))
7656             (if (equal key cmd)
7657                 (if (or (not group) (assoc 'quit-config
7658                                            (gnus-find-method-for-group
7659                                             gnus-newsgroup-name)))
7660                     (gnus-summary-exit)
7661                   (gnus-summary-next-group nil group backward))
7662               (setq unread-command-events (list key)))))))))))
7663
7664 (defun gnus-summary-next-unread-article ()
7665   "Select unread article after current one."
7666   (interactive)
7667   (gnus-summary-next-article t (and gnus-auto-select-same
7668                                     (gnus-summary-subject-string))))
7669
7670 (defun gnus-summary-prev-article (unread &optional subject)
7671   "Select the article after the current one.
7672 If UNREAD is non-nil, only unread articles are selected."
7673   (interactive "P")
7674   (gnus-summary-next-article unread subject t))
7675
7676 (defun gnus-summary-prev-unread-article ()
7677   "Select unred article before current one."
7678   (interactive)
7679   (gnus-summary-prev-article t (and gnus-auto-select-same
7680                                     (gnus-summary-subject-string))))
7681
7682 (defun gnus-summary-next-page (lines &optional circular)
7683   "Show next page of selected article.
7684 If end of article, select next article.
7685 Argument LINES specifies lines to be scrolled up.
7686 If CIRCULAR is non-nil, go to the start of the article instead of 
7687 instead of selecting the next article when reaching the end of the
7688 current article." 
7689   (interactive "P")
7690   (setq gnus-summary-buffer (current-buffer))
7691   (gnus-set-global-variables)
7692   (let ((article (gnus-summary-article-number))
7693         (endp nil))
7694     (gnus-configure-windows 'article)
7695     (if (or (null gnus-current-article)
7696             (null gnus-article-current)
7697             (/= article (cdr gnus-article-current))
7698             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7699         ;; Selected subject is different from current article's.
7700         (gnus-summary-display-article article)
7701       (gnus-eval-in-buffer-window
7702        gnus-article-buffer
7703        (setq endp (gnus-article-next-page lines)))
7704       (if endp
7705           (cond (circular
7706                  (gnus-summary-beginning-of-article))
7707                 (lines
7708                  (gnus-message 3 "End of message"))
7709                 ((null lines)
7710                  (gnus-summary-next-unread-article)))))
7711     (gnus-summary-recenter)
7712     (gnus-summary-position-cursor)))
7713
7714 (defun gnus-summary-prev-page (lines)
7715   "Show previous page of selected article.
7716 Argument LINES specifies lines to be scrolled down."
7717   (interactive "P")
7718   (gnus-set-global-variables)
7719   (let ((article (gnus-summary-article-number)))
7720     (gnus-configure-windows 'article)
7721     (if (or (null gnus-current-article)
7722             (null gnus-article-current)
7723             (/= article (cdr gnus-article-current))
7724             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7725         ;; Selected subject is different from current article's.
7726         (gnus-summary-display-article article)
7727       (gnus-summary-recenter)
7728       (gnus-eval-in-buffer-window gnus-article-buffer
7729         (gnus-article-prev-page lines))))
7730   (gnus-summary-position-cursor))
7731
7732 (defun gnus-summary-scroll-up (lines)
7733   "Scroll up (or down) one line current article.
7734 Argument LINES specifies lines to be scrolled up (or down if negative)."
7735   (interactive "p")
7736   (gnus-set-global-variables)
7737   (gnus-configure-windows 'article)
7738   (or (gnus-summary-select-article nil nil 'pseudo)
7739       (gnus-eval-in-buffer-window 
7740        gnus-article-buffer
7741        (cond ((> lines 0)
7742               (if (gnus-article-next-page lines)
7743                   (gnus-message 3 "End of message")))
7744              ((< lines 0)
7745               (gnus-article-prev-page (- lines))))))
7746   (gnus-summary-recenter)
7747   (gnus-summary-position-cursor))
7748
7749 (defun gnus-summary-next-same-subject ()
7750   "Select next article which has the same subject as current one."
7751   (interactive)
7752   (gnus-set-global-variables)
7753   (gnus-summary-next-article nil (gnus-summary-subject-string)))
7754
7755 (defun gnus-summary-prev-same-subject ()
7756   "Select previous article which has the same subject as current one."
7757   (interactive)
7758   (gnus-set-global-variables)
7759   (gnus-summary-prev-article nil (gnus-summary-subject-string)))
7760
7761 (defun gnus-summary-next-unread-same-subject ()
7762   "Select next unread article which has the same subject as current one."
7763   (interactive)
7764   (gnus-set-global-variables)
7765   (gnus-summary-next-article t (gnus-summary-subject-string)))
7766
7767 (defun gnus-summary-prev-unread-same-subject ()
7768   "Select previous unread article which has the same subject as current one."
7769   (interactive)
7770   (gnus-set-global-variables)
7771   (gnus-summary-prev-article t (gnus-summary-subject-string)))
7772
7773 (defun gnus-summary-first-unread-article ()
7774   "Select the first unread article. 
7775 Return nil if there are no unread articles."
7776   (interactive)
7777   (gnus-set-global-variables)
7778   (prog1
7779       (if (gnus-summary-first-subject t)
7780           (gnus-summary-display-article (gnus-summary-article-number)))
7781     (gnus-summary-position-cursor)))
7782
7783 (defun gnus-summary-best-unread-article ()
7784   "Select the unread article with the highest score."
7785   (interactive)
7786   (gnus-set-global-variables)
7787   (let ((scored gnus-newsgroup-scored)
7788         (best -1000000)
7789         article art)
7790     (while scored
7791       (or (> best (cdr (car scored)))
7792           (and (memq (setq art (car (car scored))) gnus-newsgroup-unreads)
7793                (not (memq art gnus-newsgroup-marked))
7794                (not (memq art gnus-newsgroup-dormant))
7795                (if (= best (cdr (car scored)))
7796                    (setq article (min art article))
7797                  (setq article art)
7798                  (setq best (cdr (car scored))))))
7799       (setq scored (cdr scored)))
7800     (if article 
7801         (gnus-summary-goto-article article)
7802       (gnus-summary-first-unread-article))
7803     (gnus-summary-position-cursor)))
7804
7805 (defun gnus-summary-goto-article (article &optional all-headers)
7806   "Fetch ARTICLE and display it if it exists.
7807 If ALL-HEADERS is non-nil, no header lines are hidden."
7808   (interactive
7809    (list
7810     (string-to-int
7811      (completing-read 
7812       "Article number: "
7813       (mapcar (lambda (headers) (list (int-to-string (header-number headers))))
7814               gnus-newsgroup-headers) 
7815       nil 'require-match))))
7816   (prog1
7817       (and (gnus-summary-goto-subject article)
7818            (gnus-summary-display-article article all-headers))
7819     (gnus-summary-position-cursor)))
7820
7821 (defun gnus-summary-goto-last-article ()
7822   "Go to the last article."
7823   (interactive)
7824   (prog1
7825       (and gnus-last-article
7826            (gnus-summary-goto-article gnus-last-article))
7827     (gnus-summary-position-cursor)))
7828
7829 (defun gnus-summary-pop-article (number)
7830   "Pop one article off the history and go to the previous.
7831 NUMBER articles will be popped off."
7832   (interactive "p")
7833   (let (to)
7834     (setq gnus-newsgroup-history
7835           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
7836     (if to
7837         (gnus-summary-goto-article (car to))
7838       (error "Article history empty")))
7839   (gnus-summary-position-cursor))
7840
7841 ;; Summary article oriented commands
7842
7843 (defun gnus-summary-refer-parent-article (n)
7844   "Refer parent article N times.
7845 The difference between N and the number of articles fetched is returned."
7846   (interactive "p")
7847   (gnus-set-global-variables)
7848   (while 
7849       (and 
7850        (> n 0)
7851        (let ((ref (header-references (gnus-get-header-by-number
7852                                       (gnus-summary-article-number)))))
7853          (if (and ref (not (equal ref ""))
7854                   (string-match "<[^<>]*>[ \t]*$" ref))
7855              (gnus-summary-refer-article 
7856               (substring ref (match-beginning 0) (match-end 0))))))
7857     (setq n (1- n)))
7858   (or (zerop n) 
7859       (gnus-message 1 "No references in article or expired article."))
7860   (gnus-summary-position-cursor)
7861   n)
7862     
7863 (defun gnus-summary-refer-article (message-id)
7864   "Refer article specified by MESSAGE-ID.
7865 NOTE: This command only works with newsgroups that use real or simulated NNTP."
7866   (interactive "sMessage-ID: ")
7867   (if (or (not (stringp message-id))
7868           (zerop (length message-id)))
7869       ()
7870     ;; Construct the correct Message-ID if necessary.
7871     ;; Suggested by tale@pawl.rpi.edu.
7872     (or (string-match "^<" message-id)
7873         (setq message-id (concat "<" message-id)))
7874     (or (string-match ">$" message-id)
7875         (setq message-id (concat message-id ">")))
7876     (let ((header (car (gnus-gethash (downcase message-id)
7877                                      gnus-newsgroup-dependencies))))
7878       (if header
7879           (or (gnus-summary-goto-article (header-number header))
7880               ;; The header has been read, but the article had been
7881               ;; expunged, so we insert it again.
7882               (progn
7883                 (gnus-summary-insert-line
7884                  nil header 0 nil gnus-read-mark nil nil
7885                  (header-subject header))
7886                 (forward-line -1)
7887                 (header-number header)))
7888         (let ((gnus-override-method gnus-refer-article-method)
7889               (gnus-ancient-mark gnus-read-mark)
7890               number)
7891           (and gnus-refer-article-method
7892                (or (gnus-server-opened gnus-refer-article-method)
7893                    (gnus-open-server gnus-refer-article-method)))
7894           (if (gnus-article-prepare 
7895                message-id nil (gnus-read-header message-id))
7896               (progn
7897                 (setq number (header-number gnus-current-headers))
7898                 (gnus-rebuild-thread message-id)
7899                 (gnus-summary-goto-subject number)
7900                 (gnus-article-set-window-start 
7901                  (cdr (assq number gnus-newsgroup-bookmarks)))
7902                 message-id)
7903             (gnus-message 1 "No such references")
7904             nil))))))
7905
7906 (defun gnus-summary-enter-digest-group ()
7907   "Enter a digest group based on the current article."
7908   (interactive)
7909   (gnus-set-global-variables)
7910   (gnus-summary-select-article)
7911   ;; We do not want a narrowed article.
7912   (gnus-summary-stop-page-breaking)
7913   (let ((name (format "%s-%d" 
7914                       (gnus-group-prefixed-name 
7915                        gnus-newsgroup-name (list 'nndoc "")) 
7916                       gnus-current-article))
7917         (ogroup gnus-newsgroup-name)
7918         (buf (current-buffer)))
7919     (if (gnus-group-read-ephemeral-group 
7920          name (list 'nndoc name
7921                     (list 'nndoc-address (get-buffer gnus-article-buffer))
7922                     '(nndoc-article-type digest))
7923          t)
7924         (setcdr (nthcdr 4 (nth 2 (gnus-gethash name gnus-newsrc-hashtb)))
7925                 (list (list (cons 'to-group ogroup))))
7926       (switch-to-buffer buf)
7927       (gnus-set-global-variables)
7928       (gnus-configure-windows 'summary)
7929       (gnus-message 3 "Article not a digest?"))))
7930
7931 (defun gnus-summary-isearch-article ()
7932   "Do incremental search forward on current article."
7933   (interactive)
7934   (gnus-set-global-variables)
7935   (gnus-summary-select-article)
7936   (gnus-eval-in-buffer-window 
7937    gnus-article-buffer (isearch-forward)))
7938
7939 (defun gnus-summary-search-article-forward (regexp)
7940   "Search for an article containing REGEXP forward.
7941 gnus-select-article-hook is not called during the search."
7942   (interactive
7943    (list (read-string
7944           (concat "Search forward (regexp): "
7945                   (if gnus-last-search-regexp
7946                       (concat "(default " gnus-last-search-regexp ") "))))))
7947   (gnus-set-global-variables)
7948   (if (string-equal regexp "")
7949       (setq regexp (or gnus-last-search-regexp ""))
7950     (setq gnus-last-search-regexp regexp))
7951   (if (gnus-summary-search-article regexp nil)
7952       (gnus-eval-in-buffer-window 
7953        gnus-article-buffer
7954        (recenter 0))
7955     (error "Search failed: \"%s\"" regexp)))
7956
7957 (defun gnus-summary-search-article-backward (regexp)
7958   "Search for an article containing REGEXP backward.
7959 gnus-select-article-hook is not called during the search."
7960   (interactive
7961    (list (read-string
7962           (concat "Search backward (regexp): "
7963                   (if gnus-last-search-regexp
7964                       (concat "(default " gnus-last-search-regexp ") "))))))
7965   (gnus-set-global-variables)
7966   (if (string-equal regexp "")
7967       (setq regexp (or gnus-last-search-regexp ""))
7968     (setq gnus-last-search-regexp regexp))
7969   (if (gnus-summary-search-article regexp t)
7970       (gnus-eval-in-buffer-window
7971        gnus-article-buffer
7972        (recenter 0))
7973     (error "Search failed: \"%s\"" regexp)))
7974
7975 (defun gnus-summary-search-article (regexp &optional backward)
7976   "Search for an article containing REGEXP.
7977 Optional argument BACKWARD means do search for backward.
7978 gnus-select-article-hook is not called during the search."
7979   (let ((gnus-select-article-hook nil)  ;Disable hook.
7980         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
7981         (re-search
7982          (if backward
7983              (function re-search-backward) (function re-search-forward)))
7984         (found nil)
7985         (last nil))
7986     ;; Hidden thread subtrees must be searched for ,too.
7987     (gnus-summary-show-all-threads)
7988     (if (eobp) (forward-line -1))
7989     ;; First of all, search current article.
7990     ;; We don't want to read article again from NNTP server nor reset
7991     ;; current point.
7992     (gnus-summary-select-article)
7993     (gnus-message 9 "Searching article: %d..." gnus-current-article)
7994     (setq last gnus-current-article)
7995     (gnus-eval-in-buffer-window gnus-article-buffer
7996       (save-restriction
7997         (widen)
7998         ;; Begin search from current point.
7999         (setq found (funcall re-search regexp nil t))))
8000     ;; Then search next articles.
8001     (while (and (not found)
8002                 (gnus-summary-display-article 
8003                  (gnus-summary-search-subject backward nil nil)))
8004       (gnus-message 9 "Searching article: %d..." gnus-current-article)
8005       (gnus-eval-in-buffer-window gnus-article-buffer
8006         (save-restriction
8007           (widen)
8008           (goto-char (if backward (point-max) (point-min)))
8009           (setq found (funcall re-search regexp nil t)))))
8010     (message "")
8011     ;; Adjust article pointer.
8012     (or (eq last gnus-current-article)
8013         (setq gnus-last-article last))
8014     ;; Return T if found such article.
8015     found))
8016
8017 (defun gnus-summary-execute-command (header regexp command &optional backward)
8018   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
8019 If HEADER is an empty string (or nil), the match is done on the entire
8020 article. If BACKWARD (the prefix) is non-nil, search backward instead."
8021   (interactive
8022    (list (let ((completion-ignore-case t))
8023            (completing-read 
8024             "Header name: "
8025             (mapcar (lambda (string) (list string))
8026                     '("Number" "Subject" "From" "Lines" "Date"
8027                       "Message-ID" "Xref" "References"))
8028             nil 'require-match))
8029          (read-string "Regexp: ")
8030          (read-key-sequence "Command: ")
8031          current-prefix-arg))
8032   (gnus-set-global-variables)
8033   ;; Hidden thread subtrees must be searched as well.
8034   (gnus-summary-show-all-threads)
8035   ;; We don't want to change current point nor window configuration.
8036   (save-excursion
8037     (save-window-excursion
8038       (gnus-message 6 "Executing %s..." (key-description command))
8039       ;; We'd like to execute COMMAND interactively so as to give arguments.
8040       (gnus-execute header regexp
8041                     (` (lambda ()
8042                          (call-interactively '(, (key-binding command)))))
8043                     backward)
8044       (gnus-message 6 "Executing %s...done" (key-description command)))))
8045
8046 (defun gnus-summary-beginning-of-article ()
8047   "Scroll the article back to the beginning."
8048   (interactive)
8049   (gnus-set-global-variables)
8050   (gnus-summary-select-article)
8051   (gnus-eval-in-buffer-window
8052    gnus-article-buffer
8053    (widen)
8054    (goto-char (point-min))
8055    (and gnus-break-pages (gnus-narrow-to-page))))
8056
8057 (defun gnus-summary-end-of-article ()
8058   "Scroll to the end of the article."
8059   (interactive)
8060   (gnus-set-global-variables)
8061   (gnus-summary-select-article)
8062   (gnus-eval-in-buffer-window 
8063    gnus-article-buffer
8064    (widen)
8065    (goto-char (point-max))
8066    (and gnus-break-pages (gnus-narrow-to-page))))
8067
8068 (defun gnus-summary-show-article ()
8069   "Force re-fetching of the current article."
8070   (interactive)
8071   (gnus-set-global-variables)
8072   (gnus-summary-select-article gnus-have-all-headers t))
8073
8074 (defun gnus-summary-toggle-header (arg)
8075   "Show the headers if they are hidden, or hide them if they are shown.
8076 If ARG is a positive number, show the entire header.
8077 If ARG is a negative number, hide the unwanted header lines."
8078   (interactive "P")
8079   (gnus-set-global-variables)
8080   (save-excursion
8081     (set-buffer gnus-article-buffer)
8082     (let ((buffer-read-only nil))
8083       (if (numberp arg) 
8084           (if (> arg 0) (remove-text-properties (point-min) (point-max) 
8085                                                 gnus-hidden-properties)
8086             (if (< arg 0) (run-hooks 'gnus-article-display-hook)))
8087         (if (text-property-any (point-min) (point-max) 'invisible t)
8088             (remove-text-properties (point-min) (point-max)
8089                                     gnus-hidden-properties)
8090           (let ((gnus-have-all-headers nil))
8091             (run-hooks 'gnus-article-display-hook))))
8092       (set-window-point (get-buffer-window (current-buffer)) (point-min)))))
8093
8094 (defun gnus-summary-show-all-headers ()
8095   "Make all header lines visible."
8096   (interactive)
8097   (gnus-set-global-variables)
8098   (gnus-article-show-all-headers))
8099
8100 (defun gnus-summary-toggle-mime (arg)
8101   "Toggle MIME processing.
8102 If ARG is a positive number, turn MIME processing on."
8103   (interactive "P")
8104   (gnus-set-global-variables)
8105   (setq gnus-show-mime
8106         (if (null arg) (not gnus-show-mime)
8107           (> (prefix-numeric-value arg) 0)))
8108   (gnus-summary-select-article t 'force))
8109
8110 (defun gnus-summary-caesar-message (rotnum)
8111   "Caesar rotates all letters of current message by 13/47 places.
8112 With prefix arg, specifies the number of places to rotate each letter forward.
8113 Caesar rotates Japanese letters by 47 places in any case."
8114   (interactive "P")
8115   (gnus-set-global-variables)
8116   (gnus-summary-select-article)
8117   (let ((mail-header-separator "")) ; !!! Is this necessary?
8118     (gnus-overload-functions)
8119     (gnus-eval-in-buffer-window 
8120      gnus-article-buffer
8121      (save-restriction
8122        (widen)
8123        ;; We don't want to jump to the beginning of the message.
8124        ;; `save-excursion' does not do its job.
8125        (move-to-window-line 0)
8126        (let ((last (point)))
8127          (news-caesar-buffer-body rotnum)
8128          (goto-char last)
8129          (recenter 0))))))
8130
8131 (defun gnus-summary-stop-page-breaking ()
8132   "Stop page breaking in the current article."
8133   (interactive)
8134   (gnus-set-global-variables)
8135   (gnus-summary-select-article)
8136   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
8137
8138 ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
8139
8140 (defun gnus-summary-move-article (n &optional to-newsgroup select-method)
8141   "Move the current article to a different newsgroup.
8142 If N is a positive number, move the N next articles.
8143 If N is a negative number, move the N previous articles.
8144 If N is nil and any articles have been marked with the process mark,
8145 move those articles instead.
8146 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
8147 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
8148 re-spool using this method.
8149 For this function to work, both the current newsgroup and the
8150 newsgroup that you want to move to have to support the `request-move'
8151 and `request-accept' functions. (Ie. mail newsgroups at present.)"
8152   (interactive "P")
8153   (gnus-set-global-variables)
8154   (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)
8155       (error "The current newsgroup does not support article moving"))
8156   (let ((articles (gnus-summary-work-articles n))
8157         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
8158         art-group)
8159     (if (and (not to-newsgroup) (not select-method))
8160         (setq to-newsgroup
8161               (completing-read 
8162                (format "Where do you want to move %s? %s"
8163                        (if (> (length articles) 1)
8164                            (format "these %d articles" (length articles))
8165                          "this article")
8166                        (if gnus-current-move-group
8167                            (format "(%s default) " gnus-current-move-group)
8168                          ""))
8169                gnus-active-hashtb nil nil prefix)))
8170     (if to-newsgroup
8171         (progn
8172           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
8173               (setq to-newsgroup (or gnus-current-move-group "")))
8174           (or (gnus-gethash to-newsgroup gnus-active-hashtb)
8175               (gnus-activate-newsgroup to-newsgroup)
8176               (error "No such group: %s" to-newsgroup))
8177           (setq gnus-current-move-group to-newsgroup)))
8178     (or (gnus-check-backend-function 'request-accept-article 
8179                                      (or select-method to-newsgroup))
8180         (error "%s does not support article moving" to-newsgroup))
8181     (gnus-message 6 "Moving to %s: %s..." 
8182                   (or select-method to-newsgroup) articles)
8183     (while articles
8184       (if (setq art-group
8185                 (gnus-request-move-article 
8186                  (car articles)                   ; Article to move
8187                  gnus-newsgroup-name              ; From newsgrouo
8188                  (nth 1 (gnus-find-method-for-group 
8189                          gnus-newsgroup-name))    ; Server
8190                  (list 'gnus-request-accept-article 
8191                        (if select-method
8192                            (list 'quote select-method)
8193                          to-newsgroup)
8194                        (not (cdr articles)))     ; Accept form
8195                  (not (cdr articles))))          ; Only save nov last time
8196           (let* ((buffer-read-only nil)
8197                  (entry 
8198                   (or
8199                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
8200                    (gnus-gethash 
8201                     (gnus-group-prefixed-name 
8202                      (car art-group) 
8203                      (if select-method (list select-method "")
8204                        (gnus-find-method-for-group to-newsgroup)))
8205                     gnus-newsrc-hashtb)))
8206                  (info (nth 2 entry))
8207                  (article (car articles))
8208                  (marked (nth 3 info)))
8209             (gnus-summary-goto-subject article)
8210             (beginning-of-line)
8211             (delete-region (point)
8212                            (progn (forward-line 1) (point)))
8213             (if (not (memq article gnus-newsgroup-unreads))
8214                 (setcar (cdr (cdr info))
8215                         (gnus-add-to-range (nth 2 info) 
8216                                            (list (cdr art-group)))))
8217             ;; Copy any marks over to the new group.
8218             (let ((marks '((tick . gnus-newsgroup-marked)
8219                            (dormant . gnus-newsgroup-dormant)
8220                            (expire . gnus-newsgroup-expirable)
8221                            (bookmark . gnus-newsgroup-bookmarks)
8222                         ;   (score . gnus-newsgroup-scored)
8223                            (reply . gnus-newsgroup-replied)))
8224                   (to-article (cdr art-group)))
8225               (while marks
8226                 (if (memq article (symbol-value (cdr (car marks))))
8227                     (gnus-add-marked-articles 
8228                      (car info) (car (car marks)) (list to-article) info))
8229                 (setq marks (cdr marks))))
8230             (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
8231             (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
8232             (setq gnus-newsgroup-dormant
8233                   (delq article gnus-newsgroup-dormant)))
8234         (gnus-message 1 "Couldn't move article %s" (car articles)))
8235       (gnus-summary-remove-process-mark (car articles))
8236       (setq articles (cdr articles)))))
8237
8238 (defun gnus-summary-respool-article (n &optional respool-method)
8239   "Respool the current article.
8240 The article will be squeezed through the mail spooling process again,
8241 which means that it will be put in some mail newsgroup or other
8242 depending on `nnmail-split-methods'.
8243 If N is a positive number, respool the N next articles.
8244 If N is a negative number, respool the N previous articles.
8245 If N is nil and any articles have been marked with the process mark,
8246 respool those articles instead.
8247
8248 Respooling can be done both from mail groups and \"real\" newsgroups.
8249 In the former case, the articles in question will be moved from the
8250 current group into whatever groups they are destined to.  In the
8251 latter case, they will be copied into the relevant groups."
8252   (interactive "P")
8253   (gnus-set-global-variables)
8254   (let ((respool-methods (gnus-methods-using 'respool))
8255         (methname 
8256          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
8257     (or respool-method
8258         (setq respool-method
8259               (completing-read
8260                "What method do you want to use when respooling? "
8261                respool-methods nil t methname)))
8262     (or (string= respool-method "")
8263         (if (assoc (symbol-name
8264                     (car (gnus-find-method-for-group gnus-newsgroup-name)))
8265                    respool-methods)
8266             (gnus-summary-move-article n nil (intern respool-method))
8267           (gnus-summary-copy-article n nil (intern respool-method))))))
8268
8269 ;; Suggested by gregj@unidata.com (Gregory J. Grubbs).
8270 (defun gnus-summary-copy-article (n &optional to-newsgroup select-method)
8271   "Move the current article to a different newsgroup.
8272 If N is a positive number, move the N next articles.
8273 If N is a negative number, move the N previous articles.
8274 If N is nil and any articles have been marked with the process mark,
8275 move those articles instead.
8276 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
8277 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
8278 re-spool using this method.
8279 For this function to work, the newsgroup that you want to move to have
8280 to support the `request-move' and `request-accept'
8281 functions. (Ie. mail newsgroups at present.)"
8282   (interactive "P")
8283   (gnus-set-global-variables)
8284   (let ((articles (gnus-summary-work-articles n))
8285         (copy-buf (get-buffer-create "*copy work*"))
8286         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
8287         art-group)
8288     (buffer-disable-undo copy-buf)
8289     (if (and (not to-newsgroup) (not select-method))
8290         (setq to-newsgroup
8291               (completing-read 
8292                (format "Where do you want to copy %s? %s"
8293                        (if (> (length articles) 1)
8294                            (format "these %d articles" (length articles))
8295                          "this article")
8296                        (if gnus-current-move-group
8297                            (format "(%s default) " gnus-current-move-group)
8298                          ""))
8299                gnus-active-hashtb nil nil prefix)))
8300     (if to-newsgroup
8301         (progn
8302           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
8303               (setq to-newsgroup (or gnus-current-move-group "")))
8304           (or (gnus-gethash to-newsgroup gnus-active-hashtb)
8305               (gnus-activate-newsgroup to-newsgroup)
8306               (error "No such group: %s" to-newsgroup))
8307           (setq gnus-current-move-group to-newsgroup)))
8308     (or (gnus-check-backend-function 'request-accept-article 
8309                                      (or select-method to-newsgroup))
8310         (error "%s does not support article copying" to-newsgroup))
8311     (gnus-message 6 "Copying to %s: %s..." 
8312                   (or select-method to-newsgroup) articles)
8313     (while articles
8314       (if (setq art-group
8315                 (save-excursion
8316                   (set-buffer copy-buf)
8317                   (gnus-request-article-this-buffer
8318                    (car articles) gnus-newsgroup-name)
8319                   (gnus-request-accept-article
8320                    (if select-method (quote select-method) to-newsgroup)
8321                    (not (cdr articles)))))
8322           (let* ((entry 
8323                   (or
8324                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
8325                    (gnus-gethash 
8326                     (gnus-group-prefixed-name 
8327                      (car art-group) 
8328                      (if select-method (list select-method "")
8329                        (gnus-find-method-for-group to-newsgroup)))
8330                     gnus-newsrc-hashtb)))
8331                  (info (nth 2 entry))
8332                  (article (car articles))
8333                  (marked (nth 3 info)))
8334             (if (not (memq article gnus-newsgroup-unreads))
8335                 (setcar (cdr (cdr info))
8336                         (gnus-add-to-range (nth 2 info) 
8337                                            (list (cdr art-group)))))
8338             ;; Copy any marks over to the new group.
8339             (let ((marks '((tick . gnus-newsgroup-marked)
8340                            (dormant . gnus-newsgroup-dormant)
8341                            (expire . gnus-newsgroup-expirable)
8342                            (bookmark . gnus-newsgroup-bookmarks)
8343                         ;   (score . gnus-newsgroup-scored)
8344                            (reply . gnus-newsgroup-replied)))
8345                   (to-article (cdr art-group)))
8346               (while marks
8347                 (if (memq article (symbol-value (cdr (car marks))))
8348                     (gnus-add-marked-articles 
8349                      (car info) (car (car marks)) (list to-article) info))
8350                 (setq marks (cdr marks)))))
8351         (gnus-message 1 "Couldn't copy article %s" (car articles)))
8352       (gnus-summary-remove-process-mark (car articles))
8353       (setq articles (cdr articles)))
8354     (kill-buffer copy-buf)))
8355
8356 (defun gnus-summary-import-article (file)
8357   "Import a random file into a mail newsgroup."
8358   (interactive "fImport file: ")
8359   (let ((group gnus-newsgroup-name)
8360         atts)
8361     (or (gnus-check-backend-function 'request-accept-article group)
8362         (error "%s does not support article importing" group))
8363     (or (file-readable-p file)
8364         (not (file-regular-p file))
8365         (error "Can't read %s" file))
8366     (save-excursion
8367       (set-buffer (get-buffer-create " *import file*"))
8368       (buffer-disable-undo (current-buffer))
8369       (erase-buffer)
8370       (insert-file-contents file)
8371       (goto-char (point-min))
8372       (if (nnheader-article-p)
8373           ()
8374         (setq atts (file-attributes file))
8375         (insert "From: " (read-string "From: ") "\n"
8376                 "Subject: " (read-string "Subject: ") "\n"
8377                 "Date: " (current-time-string (nth 5 atts)) "\n"
8378                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
8379       (gnus-request-accept-article group t)
8380       (kill-buffer (current-buffer)))))
8381
8382 (defun gnus-summary-expire-articles ()
8383   "Expire all articles that are marked as expirable in the current group."
8384   (interactive)
8385   (if (and gnus-newsgroup-expirable
8386            (gnus-check-backend-function 
8387             'request-expire-articles gnus-newsgroup-name))
8388       (let ((expirable gnus-newsgroup-expirable))
8389         ;; The list of articles that weren't expired is returned.
8390         (setq gnus-newsgroup-expirable 
8391               (gnus-request-expire-articles gnus-newsgroup-expirable
8392                                             gnus-newsgroup-name))
8393         ;; We go through the old list of expirable, and mark all
8394         ;; really expired articles as non-existent.
8395         (while expirable
8396           (or (memq (car expirable) gnus-newsgroup-expirable)
8397               (gnus-summary-mark-as-read (car expirable) gnus-canceled-mark))
8398           (setq expirable (cdr expirable))))))
8399
8400 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
8401 (defun gnus-summary-delete-article (n)
8402   "Delete the N next (mail) articles.
8403 This command actually deletes articles. This is not a marking
8404 command. The article will disappear forever from you life, never to
8405 return. 
8406 If N is negative, delete backwards.
8407 If N is nil and articles have been marked with the process mark,
8408 delete these instead."
8409   (interactive "P")
8410   (or (gnus-check-backend-function 'request-expire-articles 
8411                                    gnus-newsgroup-name)
8412       (error "The current newsgroup does not support article deletion."))
8413   ;; Compute the list of articles to delete.
8414   (let ((articles (gnus-summary-work-articles n))
8415         not-deleted)
8416     (if (and gnus-novice-user
8417              (not (gnus-y-or-n-p 
8418                    (format "Do you really want to delete %s forever? "
8419                            (if (> (length articles) 1) "these articles"
8420                              "this article")))))
8421         ()
8422       ;; Delete the articles.
8423       (setq not-deleted (gnus-request-expire-articles 
8424                          articles gnus-newsgroup-name 'force))
8425       (while articles
8426         (gnus-summary-remove-process-mark (car articles))       
8427         ;; The backend might not have been able to delete the article
8428         ;; after all.  
8429         (or (memq (car articles) not-deleted)
8430             (gnus-summary-mark-as-read (car articles) gnus-canceled-mark))
8431         (setq articles (cdr articles))))
8432     (gnus-summary-position-cursor)
8433     not-deleted))
8434
8435 (defun gnus-summary-edit-article ()
8436   "Enter into a buffer and edit the current article.
8437 This will have permanent effect only in mail groups."
8438   (interactive)
8439   (or (gnus-check-backend-function 
8440        'request-replace-article gnus-newsgroup-name)
8441       (error "The current newsgroup does not support article editing."))
8442   (gnus-summary-select-article t)
8443   (other-window 1)
8444   (gnus-message 6 "C-c C-c to end edits")
8445   (setq buffer-read-only nil)
8446   (text-mode)
8447   (use-local-map (copy-keymap (current-local-map)))
8448   (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
8449   (goto-char (point-min))
8450   (search-forward "\n\n" nil t))
8451
8452 (defun gnus-summary-edit-article-done ()
8453   "Make edits to the current article permanent."
8454   (interactive)
8455   (if (not (gnus-request-replace-article 
8456             (cdr gnus-article-current) (car gnus-article-current) 
8457             (current-buffer)))
8458       (error "Couldn't replace article.")
8459     (gnus-article-mode)
8460     (use-local-map gnus-article-mode-map)
8461     (setq buffer-read-only t)
8462     (pop-to-buffer gnus-summary-buffer)))      
8463
8464 (defun gnus-summary-fancy-query ()
8465   "Query where the fancy respool algorithm would put this article."
8466   (interactive)
8467   (gnus-summary-select-article)
8468   (save-excursion
8469     (set-buffer gnus-article-buffer)
8470     (save-restriction
8471       (goto-char (point-min))
8472       (search-forward "\n\n")
8473       (narrow-to-region (point-min) (point))
8474       (pp-eval-expression (list 'quote (nnmail-split-fancy))))))
8475
8476 ;; Summary score commands.
8477
8478 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
8479
8480 (defun gnus-summary-raise-score (n)
8481   "Raise the score of the current article by N."
8482   (interactive "p")
8483   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
8484
8485 (defun gnus-summary-lower-score (n)
8486   "Lower the score of the current article by N."
8487   (interactive "p")
8488   (gnus-summary-raise-score (- n)))
8489
8490 (defun gnus-summary-set-score (n)
8491   "Set the score of the current article to N."
8492   (interactive "p")
8493   ;; Skip dummy header line.
8494   (save-excursion
8495     (gnus-summary-show-thread)
8496     (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
8497         (forward-line 1))
8498     (let ((buffer-read-only nil))
8499       ;; Set score.
8500       (gnus-summary-update-mark
8501        (if (= n (or gnus-summary-default-score 0)) ? 
8502          (if (< n (or gnus-summary-default-score 0)) 
8503              gnus-score-below-mark gnus-score-over-mark)) 'score))
8504     (let* ((article (gnus-summary-article-number))
8505            (score (assq article gnus-newsgroup-scored)))
8506       (if score (setcdr score n)
8507         (setq gnus-newsgroup-scored 
8508               (cons (cons article n) gnus-newsgroup-scored))))
8509     (gnus-summary-update-line)))
8510
8511 (defun gnus-summary-current-score ()
8512   "Return the score of the current article."
8513   (interactive)
8514   (message "%s" (gnus-summary-article-score)))
8515
8516 ;; Summary marking commands.
8517
8518 (defun gnus-summary-raise-same-subject-and-select (score)
8519   "Raise articles which has the same subject with SCORE and select the next."
8520   (interactive "p")
8521   (let ((subject (gnus-summary-subject-string)))
8522     (gnus-summary-raise-score score)
8523     (while (gnus-summary-search-subject nil nil subject)
8524       (gnus-summary-raise-score score))
8525     (gnus-summary-next-article t)))
8526
8527 (defun gnus-summary-raise-same-subject (score)
8528   "Raise articles which has the same subject with SCORE."
8529   (interactive "p")
8530   (let ((subject (gnus-summary-subject-string)))
8531     (gnus-summary-raise-score score)
8532     (while (gnus-summary-search-subject nil nil subject)
8533       (gnus-summary-raise-score score))
8534     (gnus-summary-next-subject 1 t)))
8535
8536 (defun gnus-score-default (level)
8537   (if level (prefix-numeric-value level) 
8538     gnus-score-interactive-default-score))
8539
8540 (defun gnus-summary-raise-thread (score)
8541   "Raise articles under current thread with SCORE."
8542   (interactive "P")
8543   (setq score (1- (gnus-score-default score)))
8544   (let (e)
8545     (save-excursion
8546       (let ((level (gnus-summary-thread-level)))
8547         (gnus-summary-raise-score score)
8548         (while (and (zerop (gnus-summary-next-subject 1 nil t))
8549                     (> (gnus-summary-thread-level) level))
8550           (gnus-summary-raise-score score))
8551         (setq e (point))))
8552     (let ((gnus-summary-check-current t))
8553       (or (zerop (gnus-summary-next-subject 1 t))
8554           (goto-char e))))
8555   (gnus-summary-recenter)
8556   (gnus-summary-position-cursor)
8557   (gnus-set-mode-line 'summary))
8558
8559 (defun gnus-summary-lower-same-subject-and-select (score)
8560   "Raise articles which has the same subject with SCORE and select the next."
8561   (interactive "p")
8562   (gnus-summary-raise-same-subject-and-select (- score)))
8563
8564 (defun gnus-summary-lower-same-subject (score)
8565   "Raise articles which has the same subject with SCORE."
8566   (interactive "p")
8567   (gnus-summary-raise-same-subject (- score)))
8568
8569 (defun gnus-summary-lower-thread (score)
8570   "Raise articles under current thread with SCORE."
8571   (interactive "P")
8572   (gnus-summary-raise-thread (- (1- (gnus-score-default score)))))
8573
8574 (defun gnus-summary-kill-same-subject-and-select (unmark)
8575   "Mark articles which has the same subject as read, and then select the next.
8576 If UNMARK is positive, remove any kind of mark.
8577 If UNMARK is negative, tick articles."
8578   (interactive "P")
8579   (if unmark
8580       (setq unmark (prefix-numeric-value unmark)))
8581   (let ((count
8582          (gnus-summary-mark-same-subject
8583           (gnus-summary-subject-string) unmark)))
8584     ;; Select next unread article. If auto-select-same mode, should
8585     ;; select the first unread article.
8586     (gnus-summary-next-article t (and gnus-auto-select-same
8587                                       (gnus-summary-subject-string)))
8588     (gnus-message 7 "%d articles are marked as %s"
8589                   count (if unmark "unread" "read"))))
8590
8591 (defun gnus-summary-kill-same-subject (unmark)
8592   "Mark articles which has the same subject as read. 
8593 If UNMARK is positive, remove any kind of mark.
8594 If UNMARK is negative, tick articles."
8595   (interactive "P")
8596   (if unmark
8597       (setq unmark (prefix-numeric-value unmark)))
8598   (let ((count
8599          (gnus-summary-mark-same-subject
8600           (gnus-summary-subject-string) unmark)))
8601     ;; If marked as read, go to next unread subject.
8602     (if (null unmark)
8603         ;; Go to next unread subject.
8604         (gnus-summary-next-subject 1 t))
8605     (gnus-message 7 "%d articles are marked as %s"
8606                   count (if unmark "unread" "read"))))
8607
8608 (defun gnus-summary-mark-same-subject (subject &optional unmark)
8609   "Mark articles with same SUBJECT as read, and return marked number.
8610 If optional argument UNMARK is positive, remove any kinds of marks.
8611 If optional argument UNMARK is negative, mark articles as unread instead."
8612   (let ((count 1))
8613     (save-excursion
8614       (cond ((null unmark)
8615              (gnus-summary-mark-as-read nil gnus-killed-mark))
8616             ((> unmark 0)
8617              (gnus-summary-tick-article nil t))
8618             (t
8619              (gnus-summary-tick-article)))
8620       (while (and subject
8621                   (gnus-summary-search-forward nil subject))
8622         (cond ((null unmark)
8623                (gnus-summary-mark-as-read nil gnus-killed-mark))
8624               ((> unmark 0)
8625                (gnus-summary-tick-article nil t))
8626               (t
8627                (gnus-summary-tick-article)))
8628         (setq count (1+ count))))
8629     ;; Hide killed thread subtrees.  Does not work properly always.
8630     ;;(and (null unmark)
8631     ;;     gnus-thread-hide-killed
8632     ;;     (gnus-summary-hide-thread))
8633     ;; Return number of articles marked as read.
8634     count))
8635
8636 (defun gnus-summary-mark-as-processable (n &optional unmark)
8637   "Set the process mark on the next N articles.
8638 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
8639 the process mark instead.  The difference between N and the actual
8640 number of articles marked is returned."
8641   (interactive "p")
8642   (let ((backward (< n 0))
8643         (n (abs n)))
8644   (while (and 
8645           (> n 0)
8646           (if unmark
8647               (gnus-summary-remove-process-mark (gnus-summary-article-number))
8648             (gnus-summary-set-process-mark (gnus-summary-article-number)))
8649           (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
8650     (setq n (1- n)))
8651   (if (/= 0 n) (gnus-message 7 "No more articles"))
8652   (gnus-summary-recenter)
8653   (gnus-summary-position-cursor)
8654   n))
8655
8656 (defun gnus-summary-unmark-as-processable (n)
8657   "Remove the process mark from the next N articles.
8658 If N is negative, mark backward instead.  The difference between N and
8659 the actual number of articles marked is returned."
8660   (interactive "p")
8661   (gnus-summary-mark-as-processable n t))
8662
8663 (defun gnus-summary-unmark-all-processable ()
8664   "Remove the process mark from all articles."
8665   (interactive)
8666   (save-excursion
8667     (while gnus-newsgroup-processable
8668       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
8669   (gnus-summary-position-cursor))
8670
8671 (defun gnus-summary-mark-as-expirable (n)
8672   "Mark N articles forward as expirable.
8673 If N is negative, mark backward instead. The difference between N and
8674 the actual number of articles marked is returned."
8675   (interactive "p")
8676   (gnus-summary-mark-forward n gnus-expirable-mark))
8677
8678 (defun gnus-summary-mark-article-as-replied (article)
8679   "Mark ARTICLE replied and update the summary line."
8680   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
8681   (let ((buffer-read-only nil))
8682     (if (gnus-summary-goto-subject article)
8683         (progn
8684           (gnus-summary-update-mark gnus-replied-mark 'replied)
8685           t))))
8686
8687 (defun gnus-summary-set-bookmark (article)
8688   "Set a bookmark in current article."
8689   (interactive (list (gnus-summary-article-number)))
8690   (if (or (not (get-buffer gnus-article-buffer))
8691           (not gnus-current-article)
8692           (not gnus-article-current)
8693           (not (equal gnus-newsgroup-name (car gnus-article-current))))
8694       (error "No current article selected"))
8695   ;; Remove old bookmark, if one exists.
8696   (let ((old (assq article gnus-newsgroup-bookmarks)))
8697     (if old (setq gnus-newsgroup-bookmarks 
8698                   (delq old gnus-newsgroup-bookmarks))))
8699   ;; Set the new bookmark, which is on the form 
8700   ;; (article-number . line-number-in-body).
8701   (setq gnus-newsgroup-bookmarks 
8702         (cons 
8703          (cons article 
8704                (save-excursion
8705                  (set-buffer gnus-article-buffer)
8706                  (count-lines
8707                   (min (point)
8708                        (save-excursion
8709                          (goto-char (point-min))
8710                          (search-forward "\n\n" nil t)
8711                          (point)))
8712                   (point))))
8713          gnus-newsgroup-bookmarks))
8714   (gnus-message 6 "A bookmark has been added to the current article."))
8715
8716 (defun gnus-summary-remove-bookmark (article)
8717   "Remove the bookmark from the current article."
8718   (interactive (list (gnus-summary-article-number)))
8719   ;; Remove old bookmark, if one exists.
8720   (let ((old (assq article gnus-newsgroup-bookmarks)))
8721     (if old 
8722         (progn
8723           (setq gnus-newsgroup-bookmarks 
8724                 (delq old gnus-newsgroup-bookmarks))
8725           (gnus-message 6 "Removed bookmark."))
8726       (gnus-message 6 "No bookmark in current article."))))
8727
8728 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
8729 (defun gnus-summary-mark-as-dormant (n)
8730   "Mark N articles forward as dormant.
8731 If N is negative, mark backward instead.  The difference between N and
8732 the actual number of articles marked is returned."
8733   (interactive "p")
8734   (gnus-summary-mark-forward n gnus-dormant-mark))
8735
8736 (defun gnus-summary-set-process-mark (article)
8737   "Set the process mark on ARTICLE and update the summary line."
8738   (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable))
8739   (let ((buffer-read-only nil))
8740     (if (gnus-summary-goto-subject article)
8741         (progn
8742           (gnus-summary-show-thread)
8743           (and (eq (gnus-summary-article-mark) gnus-dummy-mark)
8744                (forward-line 1))
8745           (gnus-summary-update-mark gnus-process-mark 'replied)
8746           t))))
8747
8748 (defun gnus-summary-remove-process-mark (article)
8749   "Remove the process mark from ARTICLE and update the summary line."
8750   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
8751   (let ((buffer-read-only nil))
8752     (if (gnus-summary-goto-subject article)
8753         (progn
8754           (gnus-summary-show-thread)
8755           (and (eq (gnus-summary-article-mark) gnus-dummy-mark)
8756                (forward-line 1))
8757           (gnus-summary-update-mark ?  'replied)
8758           (if (memq article gnus-newsgroup-replied) 
8759               (gnus-summary-update-mark gnus-replied-mark 'replied))
8760           t))))
8761
8762 (defun gnus-summary-mark-forward (n &optional mark no-expire)
8763   "Mark N articles as read forwards.
8764 If N is negative, mark backwards instead.
8765 Mark with MARK. If MARK is ? , ?! or ??, articles will be
8766 marked as unread. 
8767 The difference between N and the actual number of articles marked is
8768 returned."
8769   (interactive "p")
8770   (gnus-set-global-variables)
8771   (let ((backward (< n 0))
8772         (n (abs n))
8773         (mark (or mark gnus-del-mark)))
8774   (while (and (> n 0)
8775               (gnus-summary-mark-article nil mark no-expire)
8776               (zerop (gnus-summary-next-subject 
8777                       (if backward -1 1) gnus-summary-goto-unread t)))
8778     (setq n (1- n)))
8779   (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
8780   (gnus-summary-recenter)
8781   (gnus-summary-position-cursor)
8782   (gnus-set-mode-line 'summary)
8783   n))
8784
8785 (defun gnus-summary-mark-article (&optional article mark no-expire)
8786   "Mark ARTICLE with MARK.
8787 MARK can be any character.
8788 Five MARK strings are reserved: ?  (unread), 
8789 ?! (ticked), ?? (dormant), ?D (read), ?E (expirable).
8790 If MARK is nil, then the default character ?D is used.
8791 If ARTICLE is nil, then the article on the current line will be
8792 marked." 
8793   ;; If no mark is given, then we check auto-expiring.
8794   (and (not no-expire)
8795        gnus-newsgroup-auto-expire 
8796        (or (not mark)
8797            (and (numberp mark) (or (= mark gnus-killed-mark)
8798                                    (= mark gnus-del-mark)
8799                                    (= mark gnus-catchup-mark)
8800                                    (= mark gnus-low-score-mark)
8801                                    (= mark gnus-read-mark))))
8802        (setq mark gnus-expirable-mark))
8803   (let* ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-del-mark))
8804          (article (or article (gnus-summary-article-number))))
8805     (if (or (= mark gnus-unread-mark) 
8806             (= mark gnus-ticked-mark) 
8807             (= mark gnus-dormant-mark))
8808         (gnus-mark-article-as-unread article mark)
8809       (gnus-mark-article-as-read article mark))
8810
8811     ;; See whether the article is to be put in the cache.
8812     (and gnus-use-cache
8813          (save-excursion
8814            (gnus-cache-possibly-enter-article 
8815             gnus-newsgroup-name article 
8816             (gnus-get-header-by-number article)
8817             (= mark gnus-ticked-mark)
8818             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
8819
8820     (if (gnus-summary-goto-subject article)
8821         (let ((buffer-read-only nil))
8822           (gnus-summary-show-thread)
8823           (and (eq (gnus-summary-article-mark) gnus-dummy-mark)
8824                (forward-line 1))
8825           ;; Fix the mark.
8826           (gnus-summary-update-mark mark 'unread)
8827           t))))
8828
8829 (defun gnus-summary-update-mark (mark type)
8830   (beginning-of-line)
8831   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
8832         plist)
8833     (if (not forward)
8834         ()
8835       (forward-char forward)
8836       (setq plist (text-properties-at (point)))
8837       (delete-char 1)
8838       (insert mark)
8839       (and plist (add-text-properties (1- (point)) (point) plist))
8840       (and (eq type 'unread)
8841            (add-text-properties (1- (point)) (point) (list 'gnus-mark mark)))
8842       (gnus-summary-update-line (eq mark gnus-unread-mark)))))
8843   
8844 (defun gnus-mark-article-as-read (article &optional mark)
8845   "Enter ARTICLE in the pertinent lists and remove it from others."
8846   ;; Make the article expirable.
8847   (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-del-mark)))
8848     (if (= mark gnus-expirable-mark)
8849         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
8850       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
8851     ;; Remove from unread and marked lists.
8852     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
8853     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
8854     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
8855     ;; Possibly remove from cache, if that is used. 
8856     (and gnus-use-cache 
8857          (gnus-cache-possibly-remove-article
8858           gnus-newsgroup-name article 
8859           (memq article gnus-newsgroup-marked)
8860           (memq article gnus-newsgroup-dormant)
8861           (or (memq article gnus-newsgroup-unreads)
8862               (memq article gnus-newsgroup-unselected))))))
8863
8864 (defun gnus-mark-article-as-unread (article &optional mark)
8865   "Enter ARTICLE in the pertinent lists and remove it from others."
8866   (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-ticked-mark)))
8867     ;; Add to unread list.
8868     (or (memq article gnus-newsgroup-unreads)
8869         (setq gnus-newsgroup-unreads (cons article gnus-newsgroup-unreads)))
8870     ;; If CLEAR-MARK is non-nil, the article must be removed from mark
8871     ;; lists.  Otherwise, it must be added to the list.
8872     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
8873     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
8874     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
8875     (if (= mark gnus-ticked-mark)
8876         (setq gnus-newsgroup-marked (cons article gnus-newsgroup-marked)))
8877     (if (= mark gnus-dormant-mark)
8878         (setq gnus-newsgroup-dormant (cons article gnus-newsgroup-dormant)))))
8879
8880 (defalias 'gnus-summary-mark-as-unread-forward 
8881   'gnus-summary-tick-article-forward)
8882 (make-obsolete 'gnus-summary-mark-as-unread-forward 
8883                'gnus-summary-tick-article-forward)
8884 (defun gnus-summary-tick-article-forward (n)
8885   "Tick N articles forwards.
8886 If N is negative, tick backwards instead.
8887 The difference between N and the number of articles ticked is returned."
8888   (interactive "p")
8889   (gnus-summary-mark-forward n gnus-ticked-mark))
8890
8891 (defalias 'gnus-summary-mark-as-unread-backward 
8892   'gnus-summary-tick-article-backward)
8893 (make-obsolete 'gnus-summary-mark-as-unread-backward 
8894                'gnus-summary-tick-article-backward)
8895 (defun gnus-summary-tick-article-backward (n)
8896   "Tick N articles backwards.
8897 The difference between N and the number of articles ticked is returned."
8898   (interactive "p")
8899   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
8900
8901 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
8902 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
8903 (defun gnus-summary-tick-article (&optional article clear-mark)
8904   "Mark current article as unread.
8905 Optional 1st argument ARTICLE specifies article number to be marked as unread.
8906 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
8907   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
8908                                        gnus-ticked-mark)))
8909
8910 (defun gnus-summary-mark-as-read-forward (n)
8911   "Mark N articles as read forwards.
8912 If N is negative, mark backwards instead.
8913 The difference between N and the actual number of articles marked is
8914 returned."
8915   (interactive "p")
8916   (gnus-summary-mark-forward n gnus-del-mark t))
8917
8918 (defun gnus-summary-mark-as-read-backward (n)
8919   "Mark the N articles as read backwards.
8920 The difference between N and the actual number of articles marked is
8921 returned."
8922   (interactive "p")
8923   (gnus-summary-mark-forward (- n) gnus-del-mark t))
8924
8925 (defun gnus-summary-mark-as-read (&optional article mark)
8926   "Mark current article as read.
8927 ARTICLE specifies the article to be marked as read.
8928 MARK specifies a string to be inserted at the beginning of the line."
8929   (gnus-summary-mark-article article mark))
8930
8931 (defun gnus-summary-clear-mark-forward (n)
8932   "Clear marks from N articles forward.
8933 If N is negative, clear backward instead.
8934 The difference between N and the number of marks cleared is returned."
8935   (interactive "p")
8936   (gnus-summary-mark-forward n gnus-unread-mark))
8937
8938 (defun gnus-summary-clear-mark-backward (n)
8939   "Clear marks from N articles backward.
8940 The difference between N and the number of marks cleared is returned."
8941   (interactive "p")
8942   (gnus-summary-mark-forward (- n) gnus-unread-mark))
8943
8944 (defun gnus-summary-mark-unread-as-read ()
8945   "Intended to be used by `gnus-summary-mark-article-hook'."
8946   (or (memq gnus-current-article gnus-newsgroup-marked)
8947       (memq gnus-current-article gnus-newsgroup-dormant)
8948       (memq gnus-current-article gnus-newsgroup-expirable)
8949       (gnus-summary-mark-as-read gnus-current-article gnus-read-mark)))
8950
8951 (defun gnus-summary-mark-region-as-read (point mark all)
8952   "Mark all unread articles between point and mark as read.
8953 If given a prefix, mark all articles between point and mark as read,
8954 even ticked and dormant ones."
8955   (interactive "r\nP")
8956   (save-excursion
8957     (goto-char point)
8958     (beginning-of-line)
8959     (while (and 
8960             (< (point) mark)
8961             (progn
8962               (and
8963                (or all
8964                    (and
8965                     (not (memq (gnus-summary-article-number)
8966                                gnus-newsgroup-marked))
8967                     (not (memq (gnus-summary-article-number)
8968                                gnus-newsgroup-dormant))))
8969                (gnus-summary-mark-article
8970                 (gnus-summary-article-number) gnus-del-mark))
8971               t)
8972             (zerop (forward-line 1))))))
8973
8974 ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
8975 (defalias 'gnus-summary-delete-marked-as-read 
8976   'gnus-summary-remove-lines-marked-as-read)
8977 (make-obsolete 'gnus-summary-delete-marked-as-read 
8978                'gnus-summary-remove-lines-marked-as-read)
8979 (defun gnus-summary-remove-lines-marked-as-read ()
8980   "Remove lines that are marked as read."
8981   (interactive)
8982   (gnus-summary-remove-lines-marked-with 
8983    (concat (mapconcat
8984             (lambda (char) (char-to-string (symbol-value char)))
8985             '(gnus-del-mark gnus-read-mark gnus-ancient-mark
8986               gnus-killed-mark gnus-kill-file-mark
8987               gnus-low-score-mark gnus-expirable-mark)
8988             ""))))
8989
8990 (defalias 'gnus-summary-delete-marked-with 
8991   'gnus-summary-remove-lines-marked-with)
8992 (make-obsolete 'gnus-summary-delete-marked-with 
8993                'gnus-summary-remove-lines-marked-with)
8994 ;; Rewrite by Daniel Quinlan <quinlan@best.com>.
8995 (defun gnus-summary-remove-lines-marked-with (marks)
8996   "Remove lines that are marked with MARKS (e.g. \"DK\")."
8997   (interactive "sMarks: ")
8998   ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
8999   (gnus-set-global-variables)
9000   (let ((buffer-read-only nil)
9001         (marks (concat "^[" marks "]")))
9002     (goto-char (point-min))
9003     (if gnus-newsgroup-adaptive
9004         (gnus-score-remove-lines-adaptive marks)
9005       (while (re-search-forward marks nil t)
9006         (gnus-delete-line)))
9007     ;; If we use dummy roots, we have to do an additional sweep over
9008     ;; the buffer.
9009     (if (not (eq gnus-summary-make-false-root 'dummy))
9010         ()
9011       (goto-char (point-min))
9012       (setq marks (concat "^[" (char-to-string gnus-dummy-mark) "]"))
9013       (while (re-search-forward marks nil t)
9014         (if (gnus-subject-equal
9015              (gnus-summary-subject-string)
9016              (progn
9017                (forward-line 1)
9018                (gnus-summary-subject-string)))
9019             ()
9020           (forward-line -1)
9021           (gnus-delete-line)))))
9022   (or (zerop (buffer-size))
9023       (if (eobp)
9024           (gnus-summary-prev-subject 1)
9025         (gnus-summary-position-cursor))))
9026
9027 (defun gnus-summary-expunge-below (score)
9028   "Remove articles with score less than SCORE."
9029   (interactive "P")
9030   (gnus-set-global-variables)
9031   (setq score (if score
9032                   (prefix-numeric-value score)
9033                 (or gnus-summary-default-score 0)))
9034   (save-excursion
9035     (set-buffer gnus-summary-buffer)
9036     (goto-char (point-min))
9037     (let ((buffer-read-only nil)
9038           beg)
9039       (while (not (eobp))
9040         (if (< (gnus-summary-article-score) score)
9041             (progn
9042               (setq beg (point))
9043               (forward-line 1)
9044               (delete-region beg (point)))
9045           (forward-line 1)))
9046       ;; Adjust point.
9047       (or (zerop (buffer-size))
9048           (if (eobp)
9049               (gnus-summary-prev-subject 1)
9050             (gnus-summary-position-cursor))))))
9051
9052 (defun gnus-summary-mark-below (score mark)
9053   "Mark articles with score less than SCORE with MARK."
9054   (interactive "P\ncMark: ")
9055   (gnus-set-global-variables)
9056   (setq score (if score
9057                   (prefix-numeric-value score)
9058                 (or gnus-summary-default-score 0)))
9059   (save-excursion
9060     (set-buffer gnus-summary-buffer)
9061     (goto-char (point-min))
9062     (while (not (eobp))
9063       (and (< (gnus-summary-article-score) score)
9064            (gnus-summary-mark-article nil mark))
9065       (forward-line 1))))
9066
9067 (defun gnus-summary-kill-below (score)
9068   "Mark articles with score below SCORE as read."
9069   (interactive "P")
9070   (gnus-summary-mark-below score gnus-killed-mark))
9071
9072 (defun gnus-summary-clear-above (score)
9073   "Clear all marks from articles with score above SCORE."
9074   (interactive "P")
9075   (gnus-summary-mark-above score gnus-unread-mark))
9076
9077 (defun gnus-summary-tick-above (score)
9078   "Tick all articles with score above SCORE."
9079   (interactive "P")
9080   (gnus-summary-mark-above score gnus-ticked-mark))
9081
9082 (defun gnus-summary-mark-above (score mark)
9083   "Mark articles with score over SCORE with MARK."
9084   (interactive "P\ncMark: ")
9085   (setq score (if score
9086                   (prefix-numeric-value score)
9087                 (or gnus-summary-default-score 0)))
9088   (save-excursion
9089     (set-buffer gnus-summary-buffer)
9090     (goto-char (point-min))
9091     (while (not (eobp))
9092       (if (> (gnus-summary-article-score) score)
9093           (progn
9094             (gnus-summary-mark-article nil mark)
9095             (forward-line 1))
9096         (forward-line 1)))))
9097
9098 ;; Suggested by Daniel Quinlan <quinlan@best.com>.  
9099 (defun gnus-summary-show-all-expunged ()
9100   "Display all the hidden articles that were expunged for low scores."
9101   (interactive)
9102   (let ((buffer-read-only nil))
9103     (let ((scored gnus-newsgroup-scored)
9104           headers h)
9105       (while scored
9106         (or (gnus-summary-goto-subject (car (car scored)))
9107             (and (setq h (gnus-get-header-by-number (car (car scored))))
9108                  (< (cdr (car scored)) gnus-summary-expunge-below)
9109                  (setq headers (cons h headers))))
9110         (setq scored (cdr scored)))
9111       (or headers (error "No expunged articles hidden."))
9112       (goto-char (point-min))
9113       (save-excursion 
9114         (gnus-summary-update-lines 
9115          (point)
9116          (progn
9117            (gnus-summary-prepare-threads (nreverse headers) 0)
9118            (point)))))
9119     (goto-char (point-min))
9120     (gnus-summary-position-cursor)))
9121
9122 (defun gnus-summary-show-all-dormant ()
9123   "Display all the hidden articles that are marked as dormant."
9124   (interactive)
9125   (let ((buffer-read-only nil))
9126     (goto-char (point-min))
9127     (let ((dormant gnus-newsgroup-dormant)
9128           headers h)
9129       (while dormant
9130         (or (gnus-summary-goto-subject (car dormant))
9131             (and (setq h (gnus-get-header-by-number (car dormant)))
9132                  (setq headers (cons h headers))))
9133         (setq dormant (cdr dormant)))
9134       (or headers (error "No dormant articles hidden."))
9135       (save-excursion 
9136         (gnus-summary-update-lines 
9137          (point)
9138          (progn
9139            (gnus-summary-prepare-threads (nreverse headers) 0)
9140            (point)))))
9141     (goto-char (point-min))
9142     (gnus-summary-position-cursor)))
9143
9144 (defun gnus-summary-hide-all-dormant ()
9145   "Hide all dormant articles."
9146   (interactive)
9147   (gnus-summary-remove-lines-marked-with (char-to-string gnus-dormant-mark))
9148   (gnus-summary-position-cursor))
9149
9150 (defun gnus-summary-catchup (all &optional quietly to-here not-mark)
9151   "Mark all articles not marked as unread in this newsgroup as read.
9152 If prefix argument ALL is non-nil, all articles are marked as read.
9153 If QUIETLY is non-nil, no questions will be asked.
9154 If TO-HERE is non-nil, it should be a point in the buffer. All
9155 articles before this point will be marked as read.
9156 The number of articles marked as read is returned."
9157   (interactive "P")
9158   (prog1
9159       (if (or quietly
9160               (not gnus-interactive-catchup) ;Without confirmation?
9161               gnus-expert-user
9162               (gnus-y-or-n-p
9163                (if all
9164                    "Mark absolutely all articles as read? "
9165                  "Mark all unread articles as read? ")))
9166           (if (and not-mark 
9167                    (not gnus-newsgroup-adaptive)
9168                    (not gnus-newsgroup-auto-expire))
9169               (progn
9170                 (and all (setq gnus-newsgroup-marked nil
9171                                gnus-newsgroup-dormant nil))
9172                 (setq gnus-newsgroup-unreads 
9173                       (append gnus-newsgroup-marked gnus-newsgroup-dormant)))
9174             ;; We actually mark all articles as cancelled, which we
9175             ;; have to do when using auto-expiry or adaptive scoring. 
9176             (let ((unreads (length gnus-newsgroup-unreads)))
9177               (if (gnus-summary-first-subject (not all))
9178                   (while (and (gnus-summary-mark-as-read nil gnus-catchup-mark)
9179                               (if to-here (< (point) to-here) t)
9180                               (gnus-summary-search-subject nil (not all)))))
9181               (- unreads (length gnus-newsgroup-unreads))
9182               (or to-here
9183                   (setq gnus-newsgroup-unreads gnus-newsgroup-marked)))))
9184     (gnus-summary-position-cursor)))
9185
9186 (defun gnus-summary-catchup-to-here (&optional all)
9187   "Mark all unticked articles before the current one as read.
9188 If ALL is non-nil, also mark ticked and dormant articles as read."
9189   (interactive)
9190   (beginning-of-line)
9191   (gnus-summary-catchup all t (point))
9192   (gnus-set-mode-line 'summary)
9193   (gnus-summary-position-cursor))
9194
9195 (defun gnus-summary-catchup-all (&optional quietly)
9196   "Mark all articles in this newsgroup as read."
9197   (interactive)
9198   (gnus-summary-catchup t quietly))
9199
9200 (defun gnus-summary-catchup-and-exit (all &optional quietly)
9201   "Mark all articles not marked as unread in this newsgroup as read, then exit.
9202 If prefix argument ALL is non-nil, all articles are marked as read."
9203   (interactive "P")
9204   (gnus-summary-catchup all quietly nil 'fast)
9205   ;; Select next newsgroup or exit.
9206   (if (eq gnus-auto-select-next 'quietly)
9207       (gnus-summary-next-group nil)
9208     (gnus-summary-exit)))
9209
9210 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
9211   "Mark all articles in this newsgroup as read, and then exit."
9212   (interactive)
9213   (gnus-summary-catchup-and-exit t quietly))
9214
9215 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
9216 (defun gnus-summary-catchup-and-goto-next-group (all)
9217   "Mark all articles in this group as read and select the next group.
9218 If given a prefix, mark all articles, unread as well as ticked, as
9219 read." 
9220   (interactive "P")
9221   (gnus-summary-catchup all)
9222   (gnus-summary-next-group))
9223
9224 ;; Thread-based commands.
9225
9226 (defun gnus-summary-toggle-threads (arg)
9227   "Toggle showing conversation threads.
9228 If ARG is positive number, turn showing conversation threads on."
9229   (interactive "P")
9230   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
9231     (setq gnus-show-threads
9232           (if (null arg) (not gnus-show-threads)
9233             (> (prefix-numeric-value arg) 0)))
9234     (gnus-summary-prepare)
9235     (gnus-summary-goto-subject current)
9236     (gnus-summary-position-cursor)))
9237
9238 (defun gnus-summary-show-all-threads ()
9239   "Show all threads."
9240   (interactive)
9241   (save-excursion
9242     (let ((buffer-read-only nil))
9243       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
9244   (gnus-summary-position-cursor))
9245
9246 (defun gnus-summary-show-thread ()
9247   "Show thread subtrees.
9248 Returns nil if no thread was there to be shown."
9249   (interactive)
9250   (prog1
9251       (save-excursion
9252         (let ((buffer-read-only nil)
9253               ;; first goto end then to beg, to have point at beg after let
9254               (end (progn (end-of-line) (point)))
9255               (beg (progn (beginning-of-line) (point))))
9256           (prog1
9257               ;; Any hidden lines here?
9258               (search-forward "\r" end t)
9259             (subst-char-in-region beg end ?\^M ?\n t))))
9260     (gnus-summary-position-cursor)))
9261
9262 (defun gnus-summary-hide-all-threads ()
9263   "Hide all thread subtrees."
9264   (interactive)
9265   (save-excursion
9266     (goto-char (point-min))
9267     (gnus-summary-hide-thread)
9268     (while (and (not (eobp)) (zerop (forward-line 1)))
9269       (gnus-summary-hide-thread)))
9270   (gnus-summary-position-cursor))
9271
9272 (defun gnus-summary-hide-thread ()
9273   "Hide thread subtrees.
9274 Returns nil if no threads were there to be hidden."
9275   (interactive)
9276   (let ((buffer-read-only nil)
9277         (start (point))
9278         (level (gnus-summary-thread-level))
9279         (end (point)))
9280     ;; Go forward until either the buffer ends or the subthread
9281     ;; ends. 
9282     (if (eobp)
9283         ()
9284       (while (and (zerop (forward-line 1))
9285                   (> (gnus-summary-thread-level) level))
9286         (setq end (point)))
9287       (prog1
9288           (save-excursion
9289             (goto-char end)
9290             (search-backward "\n" start t))
9291         (subst-char-in-region start end ?\n ?\^M t)
9292         (forward-line -1)))))
9293
9294 (defun gnus-summary-go-to-next-thread (&optional previous)
9295   "Go to the same level (or less) next thread.
9296 If PREVIOUS is non-nil, go to previous thread instead.
9297 Return the article number moved to, or nil if moving was impossible."
9298   (let ((level (gnus-summary-thread-level))
9299         (article (gnus-summary-article-number)))
9300     (if previous 
9301         (while (and (zerop (gnus-summary-prev-subject 1))
9302                     (> (gnus-summary-thread-level) level)))
9303       (while (and (zerop (gnus-summary-next-subject 1))
9304                   (> (gnus-summary-thread-level) level))))
9305     (gnus-summary-recenter)
9306     (gnus-summary-position-cursor)
9307     (let ((oart (gnus-summary-article-number)))
9308       (and (/= oart article) oart))))
9309
9310 (defun gnus-summary-next-thread (n)
9311   "Go to the same level next N'th thread.
9312 If N is negative, search backward instead.
9313 Returns the difference between N and the number of skips actually
9314 done."
9315   (interactive "p")
9316   (let ((backward (< n 0))
9317         (n (abs n)))
9318   (while (and (> n 0)
9319               (gnus-summary-go-to-next-thread backward))
9320     (setq n (1- n)))
9321   (gnus-summary-position-cursor)
9322   (if (/= 0 n) (gnus-message 7 "No more threads"))
9323   n))
9324
9325 (defun gnus-summary-prev-thread (n)
9326   "Go to the same level previous N'th thread.
9327 Returns the difference between N and the number of skips actually
9328 done."
9329   (interactive "p")
9330   (gnus-summary-next-thread (- n)))
9331
9332 (defun gnus-summary-go-down-thread (&optional same)
9333   "Go down one level in the current thread.
9334 If SAME is non-nil, also move to articles of the same level."
9335   (let ((level (gnus-summary-thread-level))
9336         (start (point)))
9337     (if (and (zerop (forward-line 1))
9338              (> (gnus-summary-thread-level) level))
9339         t
9340       (goto-char start)
9341       nil)))
9342
9343 (defun gnus-summary-go-up-thread ()
9344   "Go up one level in the current thread."
9345   (let ((level (gnus-summary-thread-level))
9346         (start (point)))
9347     (while (and (zerop (forward-line -1))
9348                 (>= (gnus-summary-thread-level) level)))
9349     (if (>= (gnus-summary-thread-level) level)
9350         (progn
9351           (goto-char start)
9352           nil)
9353       t)))
9354
9355 (defun gnus-summary-down-thread (n)
9356   "Go down thread N steps.
9357 If N is negative, go up instead.
9358 Returns the difference between N and how many steps down that were
9359 taken."
9360   (interactive "p")
9361   (let ((up (< n 0))
9362         (n (abs n)))
9363   (while (and (> n 0)
9364               (if up (gnus-summary-go-up-thread)
9365                 (gnus-summary-go-down-thread)))
9366     (setq n (1- n)))
9367   (gnus-summary-position-cursor)
9368   (if (/= 0 n) (gnus-message 7 "Can't go further"))
9369   n))
9370
9371 (defun gnus-summary-up-thread (n)
9372   "Go up thread N steps.
9373 If N is negative, go up instead.
9374 Returns the difference between N and how many steps down that were
9375 taken."
9376   (interactive "p")
9377   (gnus-summary-down-thread (- n)))
9378
9379 (defun gnus-summary-kill-thread (unmark)
9380   "Mark articles under current thread as read.
9381 If the prefix argument is positive, remove any kinds of marks.
9382 If the prefix argument is negative, tick articles instead."
9383   (interactive "P")
9384   (if unmark
9385       (setq unmark (prefix-numeric-value unmark)))
9386   (let ((killing t)
9387         (level (gnus-summary-thread-level)))
9388     (save-excursion
9389       (while killing
9390         ;; Mark the article...
9391         (cond ((null unmark) (gnus-summary-mark-as-read nil gnus-killed-mark))
9392               ((> unmark 0) (gnus-summary-tick-article nil t))
9393               (t (gnus-summary-tick-article)))
9394         ;; ...and go forward until either the buffer ends or the subtree
9395         ;; ends. 
9396         (if (not (and (zerop (forward-line 1))
9397                       (> (gnus-summary-thread-level) level)))
9398             (setq killing nil))))
9399     ;; Hide killed subtrees.
9400     (and (null unmark)
9401          gnus-thread-hide-killed
9402          (gnus-summary-hide-thread))
9403     ;; If marked as read, go to next unread subject.
9404     (if (null unmark)
9405         ;; Go to next unread subject.
9406         (gnus-summary-next-subject 1 t)))
9407   (gnus-set-mode-line 'summary))
9408
9409 ;; Summary sorting commands
9410
9411 (defun gnus-summary-sort-by-number (&optional reverse)
9412   "Sort summary buffer by article number.
9413 Argument REVERSE means reverse order."
9414   (interactive "P")
9415   (gnus-summary-sort 
9416    (cons 'gnus-summary-article-number 'gnus-thread-sort-by-number) reverse))
9417
9418 (defun gnus-summary-sort-by-author (&optional reverse)
9419   "Sort summary buffer by author name alphabetically.
9420 If case-fold-search is non-nil, case of letters is ignored.
9421 Argument REVERSE means reverse order."
9422   (interactive "P")
9423   (gnus-summary-sort
9424    (cons
9425     (lambda ()
9426       (let ((extract (funcall
9427                       gnus-extract-address-components
9428                       (header-from (gnus-get-header-by-number
9429                                     (gnus-summary-article-number))))))
9430         (or (car extract) (cdr extract))))
9431     'gnus-thread-sort-by-author)
9432    reverse))
9433
9434 (defun gnus-summary-sort-by-subject (&optional reverse)
9435   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
9436 If case-fold-search is non-nil, case of letters is ignored.
9437 Argument REVERSE means reverse order."
9438   (interactive "P")
9439   (gnus-summary-sort
9440    (cons
9441     (lambda ()
9442       (downcase (gnus-simplify-subject (gnus-summary-subject-string))))
9443     'gnus-thread-sort-by-subject)
9444    reverse))
9445
9446 (defun gnus-summary-sort-by-date (&optional reverse)
9447   "Sort summary buffer by date.
9448 Argument REVERSE means reverse order."
9449   (interactive "P")
9450   (gnus-summary-sort
9451    (cons
9452     (lambda ()
9453       (gnus-sortable-date
9454        (header-date 
9455         (gnus-get-header-by-number (gnus-summary-article-number)))))
9456     'gnus-thread-sort-by-date)
9457    reverse))
9458
9459 (defun gnus-summary-sort-by-score (&optional reverse)
9460   "Sort summary buffer by score.
9461 Argument REVERSE means reverse order."
9462   (interactive "P")
9463   (gnus-summary-sort 
9464    (cons 'gnus-summary-article-score 'gnus-thread-sort-by-score)
9465    (not reverse)))
9466
9467 (defvar gnus-summary-already-sorted nil)
9468 (defun gnus-summary-sort (predicate reverse)
9469   ;; Sort summary buffer by PREDICATE.  REVERSE means reverse order. 
9470   (if gnus-summary-already-sorted
9471       ()
9472     (let (buffer-read-only)
9473       (if (not gnus-show-threads)
9474           (progn
9475             (goto-char (point-min))
9476             (sort-subr reverse 'forward-line 'end-of-line (car predicate)))
9477         (let ((gnus-thread-sort-functions (list (cdr predicate)))
9478               (gnus-summary-prepare-hook nil)
9479               (gnus-summary-already-sorted nil))
9480           (gnus-summary-prepare)
9481           (and gnus-show-threads
9482                gnus-thread-hide-subtree
9483                (gnus-summary-hide-all-threads))
9484           ;; If in async mode, we send some info to the backend.
9485           (and gnus-newsgroup-async
9486                (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads))
9487                (gnus-request-asynchronous 
9488                 gnus-newsgroup-name
9489                 (if (and gnus-asynchronous-article-function
9490                          (fboundp gnus-asynchronous-article-function))
9491                     (funcall gnus-asynchronous-article-function
9492                              gnus-newsgroup-threads)))))))))
9493
9494   
9495 (defun gnus-sortable-date (date)
9496   "Make sortable string by string-lessp from DATE.
9497 Timezone package is used."
9498   (let* ((date   (timezone-fix-time date nil nil)) ;[Y M D H M S]
9499          (year   (aref date 0))
9500          (month  (aref date 1))
9501          (day    (aref date 2)))
9502     (timezone-make-sortable-date 
9503      year month day 
9504      (timezone-make-time-string
9505       (aref date 3) (aref date 4) (aref date 5)))))
9506
9507
9508 ;; Summary saving commands.
9509
9510 (defun gnus-summary-save-article (n)
9511   "Save the current article using the default saver function.
9512 If N is a positive number, save the N next articles.
9513 If N is a negative number, save the N previous articles.
9514 If N is nil and any articles have been marked with the process mark,
9515 save those articles instead.
9516 The variable `gnus-default-article-saver' specifies the saver function."
9517   (interactive "P")
9518   (let ((articles (gnus-summary-work-articles n)))
9519     (while articles
9520       (let ((header (gnus-get-header-by-number (car articles))))
9521         (if (vectorp header)
9522             (progn
9523               (gnus-summary-select-article t nil nil (car articles))
9524               (or gnus-save-all-headers
9525                   (gnus-article-hide-headers t))
9526               ;; Remove any X-Gnus lines.
9527               (save-excursion
9528                 (save-restriction
9529                   (set-buffer gnus-article-buffer)
9530                   (let ((buffer-read-only nil))
9531                     (goto-char (point-min))
9532                     (narrow-to-region (point) (or (search-forward "\n\n" nil t)
9533                                                   (point-max)))
9534                     (while (re-search-forward "^X-Gnus" nil t)
9535                       (beginning-of-line)
9536                       (delete-region (point)
9537                                      (progn (forward-line 1) (point))))
9538                     (widen))))
9539               (save-excursion
9540                 (if gnus-default-article-saver
9541                     (funcall gnus-default-article-saver)
9542                   (error "No default saver is defined."))))
9543           (if (assq 'name header)
9544               (gnus-copy-file (cdr (assq 'name header)))
9545             (gnus-message 1 "Article %d is unsaveable" (car articles)))))
9546       (gnus-summary-remove-process-mark (car articles))
9547       (setq articles (cdr articles)))
9548     (gnus-summary-position-cursor)
9549     n))
9550
9551 (defun gnus-summary-pipe-output (arg)
9552   "Pipe the current article to a subprocess.
9553 If N is a positive number, pipe the N next articles.
9554 If N is a negative number, pipe the N previous articles.
9555 If N is nil and any articles have been marked with the process mark,
9556 pipe those articles instead."
9557   (interactive "P")
9558   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
9559     (gnus-summary-save-article arg)))
9560
9561 (defun gnus-summary-save-article-mail (arg)
9562   "Append the current article to an mail file.
9563 If N is a positive number, save the N next articles.
9564 If N is a negative number, save the N previous articles.
9565 If N is nil and any articles have been marked with the process mark,
9566 save those articles instead."
9567   (interactive "P")
9568   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
9569     (gnus-summary-save-article arg)))
9570
9571 (defun gnus-summary-save-article-rmail (arg)
9572   "Append the current article to an rmail file.
9573 If N is a positive number, save the N next articles.
9574 If N is a negative number, save the N previous articles.
9575 If N is nil and any articles have been marked with the process mark,
9576 save those articles instead."
9577   (interactive "P")
9578   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
9579     (gnus-summary-save-article arg)))
9580
9581 (defun gnus-summary-save-article-file (arg)
9582   "Append the current article to a file.
9583 If N is a positive number, save the N next articles.
9584 If N is a negative number, save the N previous articles.
9585 If N is nil and any articles have been marked with the process mark,
9586 save those articles instead."
9587   (interactive "P")
9588   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
9589     (gnus-summary-save-article arg)))
9590
9591 (defun gnus-read-save-file-name (prompt default-name)
9592   (let ((methods gnus-split-methods)
9593         split-name)
9594     (if (not gnus-split-methods)
9595         ()
9596       (save-excursion
9597         (set-buffer gnus-article-buffer)
9598         (gnus-narrow-to-headers)
9599         (while methods
9600           (goto-char (point-min))
9601           (and (condition-case () 
9602                    (re-search-forward (car (car methods)) nil t)
9603                  (error nil))
9604                (setq split-name (cons (nth 1 (car methods)) split-name)))
9605           (setq methods (cdr methods)))
9606         (widen)))
9607     (cond ((null split-name)
9608            (read-file-name
9609             (concat prompt " (default "
9610                     (file-name-nondirectory default-name) ") ")
9611             (file-name-directory default-name)
9612             default-name))
9613           ((= 1 (length split-name))
9614            (read-file-name
9615             (concat prompt " (default " (car split-name) ") ")
9616             gnus-article-save-directory
9617             (concat gnus-article-save-directory (car split-name))))
9618           (t
9619            (setq split-name (mapcar (lambda (el) (list el))
9620                                     (nreverse split-name)))
9621            (let ((result (completing-read 
9622                           (concat prompt " ")
9623                           split-name nil nil)))
9624              (concat gnus-article-save-directory
9625                      (if (string= result "")
9626                          (car (car split-name))
9627                        result)))))))
9628
9629 (defun gnus-summary-save-in-rmail (&optional filename)
9630   "Append this article to Rmail file.
9631 Optional argument FILENAME specifies file name.
9632 Directory to save to is default to `gnus-article-save-directory' which
9633 is initialized from the SAVEDIR environment variable."
9634   (interactive)
9635   (let ((default-name
9636           (funcall gnus-rmail-save-name gnus-newsgroup-name
9637                    gnus-current-headers gnus-newsgroup-last-rmail)))
9638     (or filename
9639         (setq filename (gnus-read-save-file-name 
9640                         "Save in rmail file:" default-name)))
9641     (gnus-make-directory (file-name-directory filename))
9642     (gnus-eval-in-buffer-window 
9643      gnus-article-buffer
9644      (save-excursion
9645        (save-restriction
9646          (widen)
9647          (gnus-output-to-rmail filename))))
9648     ;; Remember the directory name to save articles.
9649     (setq gnus-newsgroup-last-rmail filename)))
9650
9651 (defun gnus-summary-save-in-mail (&optional filename)
9652   "Append this article to Unix mail file.
9653 Optional argument FILENAME specifies file name.
9654 Directory to save to is default to `gnus-article-save-directory' which
9655 is initialized from the SAVEDIR environment variable."
9656   (interactive)
9657   (let ((default-name
9658           (funcall gnus-mail-save-name gnus-newsgroup-name
9659                    gnus-current-headers gnus-newsgroup-last-mail)))
9660     (or filename
9661         (setq filename (gnus-read-save-file-name 
9662                         "Save in Unix mail file:" default-name)))
9663     (setq filename
9664           (expand-file-name filename
9665                             (and default-name
9666                                  (file-name-directory default-name))))
9667     (gnus-make-directory (file-name-directory filename))
9668     (gnus-eval-in-buffer-window 
9669      gnus-article-buffer
9670      (save-excursion
9671        (save-restriction
9672          (widen)
9673          (if (and (file-readable-p filename) (rmail-file-p filename))
9674              (gnus-output-to-rmail filename)
9675            (rmail-output filename 1 t t)))))
9676     ;; Remember the directory name to save articles.
9677     (setq gnus-newsgroup-last-mail filename)))
9678
9679 (defun gnus-summary-save-in-file (&optional filename)
9680   "Append this article to file.
9681 Optional argument FILENAME specifies file name.
9682 Directory to save to is default to `gnus-article-save-directory' which
9683 is initialized from the SAVEDIR environment variable."
9684   (interactive)
9685   (let ((default-name
9686           (funcall gnus-file-save-name gnus-newsgroup-name
9687                    gnus-current-headers gnus-newsgroup-last-file)))
9688     (or filename
9689         (setq filename (gnus-read-save-file-name 
9690                         "Save in file:" default-name)))
9691     (gnus-make-directory (file-name-directory filename))
9692     (gnus-eval-in-buffer-window 
9693      gnus-article-buffer
9694      (save-excursion
9695        (save-restriction
9696          (widen)
9697          (gnus-output-to-file filename))))
9698     ;; Remember the directory name to save articles.
9699     (setq gnus-newsgroup-last-file filename)))
9700
9701 (defun gnus-summary-save-in-pipe (&optional command)
9702   "Pipe this article to subprocess."
9703   (interactive)
9704   (let ((command (read-string "Shell command on article: "
9705                               gnus-last-shell-command)))
9706     (if (string-equal command "")
9707         (setq command gnus-last-shell-command))
9708     (gnus-eval-in-buffer-window 
9709      gnus-article-buffer
9710      (save-restriction
9711        (widen)
9712        (shell-command-on-region (point-min) (point-max) command nil)))
9713     (setq gnus-last-shell-command command)))
9714
9715 ;; Summary extract commands
9716
9717 (defun gnus-summary-insert-pseudos (pslist)
9718   (let ((buffer-read-only nil)
9719         (article (gnus-summary-article-number))
9720         b)
9721     (or (gnus-summary-goto-subject article)
9722         (error (format "No such article: %d" article)))
9723     (or gnus-newsgroup-headers-hashtb-by-number
9724         (gnus-make-headers-hashtable-by-number))
9725     (gnus-summary-position-cursor)
9726     ;; If all commands are to be bunched up on one line, we collect
9727     ;; them here.  
9728     (if gnus-view-pseudos-separately
9729         ()
9730       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
9731             files action)
9732         (while ps
9733           (setq action (cdr (assq 'action (car ps))))
9734           (setq files (list (cdr (assq 'name (car ps)))))
9735           (while (and ps (cdr ps)
9736                       (string= (or action "1")
9737                                (or (cdr (assq 'action (car (cdr ps)))) "2")))
9738             (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
9739             (setcdr ps (cdr (cdr ps))))
9740           (if (not files)
9741               ()
9742             (if (not (string-match "%s" action))
9743                 (setq files (cons " " files)))
9744             (setq files (cons " " files))
9745             (and (assq 'execute (car ps))
9746                  (setcdr (assq 'execute (car ps))
9747                          (funcall (if (string-match "%s" action)
9748                                       'format 'concat)
9749                                   action 
9750                                   (mapconcat (lambda (f) f) files " ")))))
9751           (setq ps (cdr ps)))))
9752     (if gnus-view-pseudos
9753         (while pslist
9754           (and (assq 'execute (car pslist))
9755                (gnus-execute-command (cdr (assq 'execute (car pslist)))
9756                                      (eq gnus-view-pseudos 'not-confirm)))
9757           (setq pslist (cdr pslist)))
9758       (save-excursion
9759         (while pslist
9760           (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist)))
9761                                          (gnus-summary-article-number)))
9762           (forward-line 1)
9763           (setq b (point))
9764           (insert "          " (file-name-nondirectory 
9765                                 (cdr (assq 'name (car pslist))))
9766                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
9767           (add-text-properties 
9768            b (1+ b) (list 'gnus-number gnus-reffed-article-number
9769                           'gnus-mark gnus-unread-mark 
9770                           'gnus-level 0
9771                           'gnus-pseudo (car pslist)))
9772           (forward-line -1)
9773           (gnus-sethash (int-to-string gnus-reffed-article-number)
9774                         (car pslist) gnus-newsgroup-headers-hashtb-by-number)
9775           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
9776           (setq pslist (cdr pslist)))))))
9777
9778 (defun gnus-pseudos< (p1 p2)
9779   (let ((c1 (cdr (assq 'action p1)))
9780         (c2 (cdr (assq 'action p2))))
9781     (and c1 c2 (string< c1 c2))))
9782
9783 (defun gnus-request-pseudo-article (props)
9784   (cond ((assq 'execute props)
9785          (gnus-execute-command (cdr (assq 'execute props)))))
9786   (let ((gnus-current-article (gnus-summary-article-number)))
9787     (run-hooks 'gnus-mark-article-hook)))
9788
9789 (defun gnus-execute-command (command &optional automatic)
9790   (save-excursion
9791     (gnus-article-setup-buffer)
9792     (set-buffer gnus-article-buffer)
9793     (let ((command (if automatic command (read-string "Command: " command)))
9794           (buffer-read-only nil))
9795       (erase-buffer)
9796       (insert "$ " command "\n\n")
9797       (if gnus-view-pseudo-asynchronously
9798           (start-process "gnus-execute" nil "sh" "-c" command)
9799         (call-process "sh" nil t nil "-c" command)))))
9800
9801 (defun gnus-copy-file (file &optional to)
9802   "Copy FILE to TO."
9803   (interactive
9804    (list (read-file-name "Copy file: " default-directory)
9805          (read-file-name "Copy file to: " default-directory)))
9806   (or to (setq to (read-file-name "Copy file to: " default-directory)))
9807   (and (file-directory-p to) 
9808        (setq to (concat (file-name-as-directory to)
9809                         (file-name-nondirectory file))))
9810   (copy-file file to))
9811
9812 ;; Summary kill commands.
9813
9814 (defun gnus-summary-edit-global-kill (article)
9815   "Edit the \"global\" kill file."
9816   (interactive (list (gnus-summary-article-number)))
9817   (gnus-group-edit-global-kill article))
9818
9819 (defun gnus-summary-edit-local-kill ()
9820   "Edit a local kill file applied to the current newsgroup."
9821   (interactive)
9822   (setq gnus-current-headers 
9823         (gnus-gethash 
9824          (int-to-string (gnus-summary-article-number))
9825          gnus-newsgroup-headers-hashtb-by-number))
9826   (gnus-set-global-variables)
9827   (gnus-group-edit-local-kill 
9828    (gnus-summary-article-number) gnus-newsgroup-name))
9829
9830 \f
9831 ;;;
9832 ;;; Gnus article mode
9833 ;;;
9834
9835 (put 'gnus-article-mode 'mode-class 'special)
9836
9837 (if gnus-article-mode-map
9838     nil
9839   (setq gnus-article-mode-map (make-keymap))
9840   (suppress-keymap gnus-article-mode-map)
9841   (define-key gnus-article-mode-map " " 'gnus-article-next-page)
9842   (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
9843   (define-key gnus-article-mode-map "\C-c^" 'gnus-article-refer-article)
9844   (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
9845   (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
9846   (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail)
9847   (define-key gnus-article-mode-map "\C-c\C-M" 'gnus-article-mail-with-original)
9848   (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
9849   (define-key gnus-article-mode-map gnus-mouse-2 'gnus-article-push-button)
9850   (define-key gnus-article-mode-map "\r" 'gnus-article-press-button)
9851   (define-key gnus-article-mode-map "\t" 'gnus-article-next-button)
9852   
9853   ;; Duplicate almost all summary keystrokes in the article mode map.
9854   (let ((commands 
9855          (list "#" "\M-#" "\C-c\M-#" "n" "p"
9856                "N" "P" "\M-\C-n" "\M-\C-p" "." "\M-s" "\M-r"
9857                "<" ">" "l" "j" "^" "\M-^" "-" "u" "U" "d" "D"
9858                "\M-u" "\M-U" "k" "\C-k" "\M-\C-k""x" "X" 
9859                "\M-\C-x" "\M-\177" "b" "B" "$" "w" "\C-c\C-r"
9860                "t" "\M-t" "C" "S"
9861                "m" "o" "\C-o" "|" "\M-m" "\M-\C-m" "\M-k" "M"
9862                "V" "\C-c\C-d")))
9863     (while commands
9864       (define-key gnus-article-mode-map (car commands) 
9865         'gnus-article-summary-command)
9866       (setq commands (cdr commands))))
9867
9868   (let ((commands (list "q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F")))
9869     (while commands
9870       (define-key gnus-article-mode-map (car commands) 
9871         'gnus-article-summary-command-nosave)
9872       (setq commands (cdr commands)))))
9873
9874
9875 (defun gnus-article-mode ()
9876   "Major mode for displaying an article.
9877
9878 All normal editing commands are switched off.
9879
9880 The following commands are available:
9881
9882 \\<gnus-article-mode-map>
9883 \\[gnus-article-next-page]\t Scroll the article one page forwards
9884 \\[gnus-article-prev-page]\t Scroll the article one page backwards
9885 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
9886 \\[gnus-article-show-summary]\t Display the summary buffer
9887 \\[gnus-article-mail]\t Send a reply to the address near point
9888 \\[gnus-article-mail-with-original]\t Send a reply to the address near point; include the original article
9889 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
9890 \\[gnus-info-find-node]\t Go to the Gnus info node"
9891   (interactive)
9892   (if gnus-visual (gnus-article-make-menu-bar))
9893   (kill-all-local-variables)
9894   (setq mode-line-modified "-- ")
9895   (make-local-variable 'mode-line-format)
9896   (setq mode-line-format (copy-sequence mode-line-format))
9897   (and (equal (nth 3 mode-line-format) "   ")
9898        (setcar (nthcdr 3 mode-line-format) ""))
9899   (setq mode-name "Article")
9900   (setq major-mode 'gnus-article-mode)
9901   (make-local-variable 'minor-mode-alist)
9902   (or (assq 'gnus-show-mime minor-mode-alist)
9903       (setq minor-mode-alist
9904             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
9905   (use-local-map gnus-article-mode-map)
9906   (make-local-variable 'page-delimiter)
9907   (setq page-delimiter gnus-page-delimiter)
9908   (buffer-disable-undo (current-buffer))
9909   (setq buffer-read-only t)             ;Disable modification
9910   (run-hooks 'gnus-article-mode-hook))
9911
9912 (defun gnus-article-setup-buffer ()
9913   "Initialize article mode buffer."
9914   (if (get-buffer gnus-article-buffer)
9915       (save-excursion
9916         (set-buffer gnus-article-buffer)
9917         (gnus-add-current-to-buffer-list)
9918         (or (eq major-mode 'gnus-article-mode)
9919             (gnus-article-mode)))
9920     (save-excursion
9921       (set-buffer (get-buffer-create gnus-article-buffer))
9922       (gnus-add-current-to-buffer-list)
9923       (gnus-article-mode))))
9924
9925 ;; Set article window start at LINE, where LINE is the number of lines
9926 ;; from the head of the article.
9927 (defun gnus-article-set-window-start (&optional line)
9928   (set-window-start 
9929    (get-buffer-window gnus-article-buffer)
9930    (save-excursion
9931      (set-buffer gnus-article-buffer)
9932      (goto-char (point-min))
9933      (if (not line)
9934          (point-min)
9935        (gnus-message 6 "Moved to bookmark")
9936        (search-forward "\n\n" nil t)
9937        (forward-line line)
9938        (point)))))
9939
9940 (defun gnus-request-article-this-buffer (article group)
9941   "Get an article and insert it into this buffer."
9942   (setq group (or group gnus-newsgroup-name))
9943
9944   ;; Open server if it has closed.
9945   (gnus-check-news-server (gnus-find-method-for-group group))
9946
9947   ;; Using `gnus-request-article' directly will insert the article into
9948   ;; `nntp-server-buffer' - so we'll save some time by not having to
9949   ;; copy it from the server buffer into the article buffer.
9950
9951   ;; We only request an article by message-id when we do not have the
9952   ;; headers for it, so we'll have to get those.
9953   (and (stringp article) 
9954        (let ((gnus-override-method gnus-refer-article-method))
9955          (gnus-read-header article)))
9956
9957   ;; If the article number is negative, that means that this article
9958   ;; doesn't belong in this newsgroup (possibly), so we find its
9959   ;; message-id and request it by id instead of number.
9960   (if (not (numberp article))
9961       ()
9962     (save-excursion
9963       (set-buffer gnus-summary-buffer)
9964       (let ((header (gnus-get-header-by-number article)))
9965         (if (< article 0)
9966             (if (vectorp header)
9967                 ;; It's a real article.
9968                 (setq article (header-id header))
9969               ;; It is an extracted pseudo-article.
9970               (setq article 'pseudo)
9971               (gnus-request-pseudo-article header)))
9972
9973         (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
9974           (if (not (eq (car method) 'nneething))
9975               ()
9976             (let ((dir (concat (file-name-as-directory (nth 1 method))
9977                                (header-subject header))))
9978               (if (file-directory-p dir)
9979                   (progn
9980                     (setq article 'nneething)
9981                     (gnus-group-enter-directory dir)))))))))
9982
9983   ;; Check the cache.
9984   (if (and gnus-use-cache
9985            (numberp article)
9986            (gnus-cache-request-article article group))
9987       'article
9988     ;; Get the article and into the article buffer.
9989     (if (or (stringp article) (numberp article))
9990         (progn
9991           (erase-buffer)
9992           (let ((gnus-override-method 
9993                  (and (stringp article) gnus-refer-article-method)))
9994             (and (gnus-request-article article group (current-buffer))
9995                  'article)))
9996       article)))
9997
9998 (defun gnus-read-header (id)
9999   "Read the headers of article ID and enter them into the Gnus system."
10000   (or gnus-newsgroup-headers-hashtb-by-number
10001       (gnus-make-headers-hashtable-by-number))
10002   (let (header)
10003     (if (not (setq header 
10004                    (car (if (let ((gnus-nov-is-evil t))
10005                               (gnus-retrieve-headers 
10006                                (list id) gnus-newsgroup-name))
10007                             (gnus-get-newsgroup-headers)))))
10008         nil
10009       (if (stringp id)
10010           (header-set-number header gnus-reffed-article-number))
10011       (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers))
10012       (gnus-sethash (int-to-string (header-number header)) header
10013                     gnus-newsgroup-headers-hashtb-by-number)
10014       (if (stringp id)
10015           (setq gnus-reffed-article-number (1- gnus-reffed-article-number)))
10016       (setq gnus-current-headers header)
10017       header)))
10018
10019 (defun gnus-article-prepare (article &optional all-headers header)
10020   "Prepare ARTICLE in article mode buffer.
10021 ARTICLE should either be an article number or a Message-ID.
10022 If ARTICLE is an id, HEADER should be the article headers.
10023 If ALL-HEADERS is non-nil, no headers are hidden."
10024   (save-excursion
10025     ;; Make sure we start in a summary buffer.
10026     (or (eq major-mode 'gnus-summary-mode)
10027         (set-buffer gnus-summary-buffer))
10028     (setq gnus-summary-buffer (current-buffer))
10029     ;; Make sure the connection to the server is alive.
10030     (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name))
10031         (progn
10032           (gnus-check-news-server 
10033            (gnus-find-method-for-group gnus-newsgroup-name))
10034           (gnus-request-group gnus-newsgroup-name t)))
10035     (or gnus-newsgroup-headers-hashtb-by-number
10036         (gnus-make-headers-hashtable-by-number))
10037     (let* ((article (if header (header-number header) article))
10038            (summary-buffer (current-buffer))
10039            (internal-hook gnus-article-internal-prepare-hook)
10040            (group gnus-newsgroup-name)
10041            result)
10042       (save-excursion
10043         (gnus-article-setup-buffer)
10044         (set-buffer gnus-article-buffer)
10045         (if (not (setq result (let ((buffer-read-only nil))
10046                                 (gnus-request-article-this-buffer 
10047                                  article group))))
10048             ;; There is no such article.
10049             (progn
10050               (save-excursion
10051                 (set-buffer gnus-summary-buffer)
10052                 (setq gnus-current-article 0)
10053                 (and (numberp article) 
10054                      (gnus-summary-mark-as-read article gnus-canceled-mark))
10055                 (gnus-message 1 "No such article (may be canceled)")
10056                 (and (numberp article)
10057                      (setq gnus-current-article article))
10058                 (ding))
10059               (and (numberp article)
10060                    (setq gnus-article-current 
10061                          (cons gnus-newsgroup-name article)))
10062               nil)
10063           (if (or (eq result 'pseudo) (eq result 'nneething))
10064               (progn
10065                 (save-excursion
10066                   (set-buffer summary-buffer)
10067                   (setq gnus-last-article gnus-current-article
10068                         gnus-newsgroup-history (cons gnus-current-article
10069                                                      gnus-newsgroup-history)
10070                         gnus-current-article 0
10071                         gnus-current-headers nil
10072                         gnus-article-current nil)
10073                   (if (eq result 'nneething)
10074                       (gnus-configure-windows 'summary)
10075                     (gnus-configure-windows 'article))
10076                   (gnus-set-global-variables))
10077                 (gnus-set-mode-line 'article))
10078             ;; The result from the `request' was an actual article -
10079             ;; or at least some text that is now displayed in the
10080             ;; article buffer.
10081             (if (and (numberp article)
10082                      (not (eq article gnus-current-article)))
10083                 ;; Seems like a new article has been selected.
10084                 ;; `gnus-current-article' must be an article number.
10085                 (save-excursion
10086                   (set-buffer summary-buffer)
10087                   (setq gnus-last-article gnus-current-article
10088                         gnus-newsgroup-history (cons gnus-current-article
10089                                                      gnus-newsgroup-history)
10090                         gnus-current-article article
10091                         gnus-current-headers 
10092                         (gnus-get-header-by-number gnus-current-article)
10093                         gnus-article-current 
10094                         (cons gnus-newsgroup-name gnus-current-article))
10095                   (gnus-summary-show-thread)
10096                   (run-hooks 'gnus-mark-article-hook)
10097                   (gnus-set-mode-line 'summary)
10098                   (and gnus-visual 
10099                        (run-hooks 'gnus-visual-mark-article-hook))
10100                   ;; Set the global newsgroup variables here.
10101                   ;; Suggested by Jim Sisolak
10102                   ;; <sisolak@trans4.neep.wisc.edu>.
10103                   (gnus-set-global-variables)
10104                   (and gnus-use-cache 
10105                        (gnus-cache-possibly-enter-article
10106                         group article
10107                         (gnus-get-header-by-number article)
10108                         (memq article gnus-newsgroup-marked)
10109                         (memq article gnus-newsgroup-dormant)
10110                         (memq article gnus-newsgroup-unreads)))))
10111             ;; gnus-have-all-headers must be either T or NIL.
10112             (setq gnus-have-all-headers
10113                   (not (not (or all-headers gnus-show-all-headers))))
10114             ;; Hooks for getting information from the article.
10115             ;; This hook must be called before being narrowed.
10116             (let (buffer-read-only)
10117               (run-hooks 'internal-hook)
10118               (run-hooks 'gnus-article-prepare-hook)
10119               ;; Decode MIME message.
10120               (if (and gnus-show-mime
10121                        (or (not gnus-strict-mime)
10122                            (gnus-fetch-field "Mime-Version")))
10123                   (funcall gnus-show-mime-method))
10124               ;; Perform the article display hooks.
10125               (run-hooks 'gnus-article-display-hook))
10126             ;; Do page break.
10127             (goto-char (point-min))
10128             (and gnus-break-pages (gnus-narrow-to-page))
10129             (gnus-set-mode-line 'article)
10130             (gnus-configure-windows 'article)
10131             (goto-char (point-min))
10132             t))))))
10133
10134 (defun gnus-article-show-all-headers ()
10135   "Show all article headers in article mode buffer."
10136   (save-excursion 
10137     (gnus-article-setup-buffer)
10138     (set-buffer gnus-article-buffer)
10139     (let ((buffer-read-only nil))
10140       (remove-text-properties (point-min) (point-max) 
10141                               gnus-hidden-properties))))
10142
10143 (defun gnus-article-hide-headers-if-wanted ()
10144   "Hide unwanted headers if `gnus-have-all-headers' is nil.
10145 Provided for backwards compatability."
10146   (or gnus-have-all-headers
10147       (gnus-article-hide-headers)))
10148
10149 (defun gnus-article-hide-headers (&optional delete)
10150   "Hide unwanted headers and possibly sort them as well."
10151   (interactive "P")
10152   (save-excursion
10153     (set-buffer gnus-article-buffer)
10154     (save-restriction
10155       (let ((sorted gnus-sorted-header-list)
10156             (buffer-read-only nil)
10157             want want-list beg want-l)
10158         ;; First we narrow to just the headers.
10159         (widen)
10160         (goto-char (point-min))
10161         ;; Hide any "From " lines at the beginning of (mail) articles. 
10162         (while (looking-at "From ")
10163           (forward-line 1))
10164         (if (bobp) 
10165             (add-text-properties (point-min) (point) gnus-hidden-properties))
10166         ;; Then treat the rest of the header lines.
10167         (narrow-to-region 
10168          (point) 
10169          (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
10170         ;; Then we use the two regular expressions
10171         ;; `gnus-ignored-headers' and `gnus-visible-headers' to
10172         ;; select which header lines is to remain visible in the
10173         ;; article buffer.
10174         (goto-char (point-min))
10175         (while (re-search-forward "^[^ \t]*:" nil t)
10176           (beginning-of-line)
10177           ;; We add the headers we want to keep to a list and delete
10178           ;; them from the buffer.
10179           (if (or (and (stringp gnus-visible-headers)
10180                        (looking-at gnus-visible-headers))
10181                   (and (not (stringp gnus-visible-headers))
10182                        (stringp gnus-ignored-headers)
10183                        (not (looking-at gnus-ignored-headers))))
10184               (progn
10185                 (setq beg (point))
10186                 (forward-line 1)
10187                 ;; Be sure to get multi-line headers...
10188                 (re-search-forward "^[^ \t]*:" nil t)
10189                 (beginning-of-line)
10190                 (setq want-list 
10191                       (cons (buffer-substring beg (point)) want-list))
10192                 (delete-region beg (point))
10193                 (goto-char beg))
10194             (forward-line 1)))
10195         ;; Next we perform the sorting by looking at
10196         ;; `gnus-sorted-header-list'. 
10197         (goto-char (point-min))
10198         (while (and sorted want-list)
10199           (setq want-l want-list)
10200           (while (and want-l
10201                       (not (string-match (car sorted) (car want-l))))
10202             (setq want-l (cdr want-l)))
10203           (if want-l 
10204               (progn
10205                 (insert (car want-l))
10206                 (setq want-list (delq (car want-l) want-list))))
10207           (setq sorted (cdr sorted)))
10208         ;; Any headers that were not matched by the sorted list we
10209         ;; just tack on the end of the visible header list.
10210         (while want-list
10211           (insert (car want-list))
10212           (setq want-list (cdr want-list)))
10213         ;; And finally we make the unwanted headers invisible.
10214         (if delete
10215             (delete-region (point) (point-max))
10216           ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
10217           (add-text-properties (point) (point-max) gnus-hidden-properties))))))
10218
10219 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
10220 (defun gnus-article-treat-overstrike ()
10221   "Translate overstrikes into bold text."
10222   (interactive)
10223   (save-excursion
10224     (set-buffer gnus-article-buffer)
10225     (let ((buffer-read-only nil))
10226       (while (search-forward "\b" nil t)
10227         (let ((next (following-char))
10228               (previous (char-after (- (point) 2))))
10229           (cond ((eq next previous)
10230                  (delete-region (- (point) 2) (point))
10231                  (put-text-property (point) (1+ (point))
10232                                     'face 'bold))
10233                 ((eq next ?_)
10234                  (delete-region (1- (point)) (1+ (point)))
10235                  (put-text-property (1- (point)) (point)
10236                                     'face 'underline))
10237                 ((eq previous ?_)
10238                  (delete-region (- (point) 2) (point))
10239                  (put-text-property (point) (1+ (point))
10240                                     'face 'underline))))))))
10241
10242 (defun gnus-article-word-wrap ()
10243   "Format too long lines."
10244   (interactive)
10245   (save-excursion
10246     (set-buffer gnus-article-buffer)
10247     (let ((buffer-read-only nil))
10248       (goto-char (point-min))
10249       (search-forward "\n\n" nil t)
10250       (end-of-line 1)
10251       (let ((paragraph-start "^\\W"))
10252         (while (not (eobp))
10253           (and (>= (current-column) (min fill-column (window-width)))
10254                (/= (preceding-char) ?:)
10255                (fill-paragraph nil))
10256           (end-of-line 2))))))
10257
10258 (defun gnus-article-remove-cr ()
10259   "Remove carriage returns from an article."
10260   (interactive)
10261   (save-excursion
10262     (set-buffer gnus-article-buffer)
10263     (let ((buffer-read-only nil))
10264       (goto-char (point-min))
10265       (while (search-forward "\r" nil t)
10266         (replace-match "" t t)))))
10267
10268 (defun gnus-article-display-x-face (&optional force)
10269   "Look for an X-Face header and display it if present."
10270   (interactive (list 'force))
10271   (save-excursion
10272     (set-buffer gnus-article-buffer)
10273     (let ((inhibit-point-motion-hooks t)
10274           (case-fold-search nil))
10275       (save-restriction
10276         (goto-char (point-min))
10277         (search-forward "\n\n")
10278         (narrow-to-region (point-min) (point))
10279         (goto-char (point-min))
10280         (if (or (not gnus-article-x-face-command)
10281                 (and (not force)
10282                      (or (not gnus-article-x-face-too-ugly)
10283                          (string-match gnus-article-x-face-too-ugly
10284                                        (mail-fetch-field "from"))))
10285                 (progn
10286                   (goto-char (point-min))
10287                   (not (re-search-forward "^X-Face: " nil t))))
10288             nil
10289           (let ((beg (point))
10290                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
10291             (if (symbolp gnus-article-x-face-command)
10292                 (and (or (fboundp gnus-article-x-face-command)
10293                          (error "%s is not a function"
10294                                 gnus-article-x-face-command))
10295                      (funcall gnus-article-x-face-command beg end))
10296               (call-process-region beg end "sh" nil 0 nil
10297                                    "-c" gnus-article-x-face-command))))))))
10298
10299 (defun gnus-article-de-quoted-unreadable (&optional force)
10300   "Do a naïve translation of a quoted-printable-encoded article.
10301 This is in no way, shape or form meant as a replacement for real MIME
10302 processing, but is simply a stop-gap measure until MIME support is
10303 written.
10304 If FORCE, decode the article whether it is marked as quoted-printable
10305 or not." 
10306   (interactive (list 'force))
10307   (save-excursion
10308     (set-buffer gnus-article-buffer)
10309     (let ((case-fold-search t)
10310           (buffer-read-only nil)
10311           (type (gnus-fetch-field "content-transfer-encoding")))
10312       (if (or force (and type (string-match "quoted-printable" type)))
10313           (progn
10314             (goto-char (point-min))
10315             (search-forward "\n\n" nil 'move)
10316             (gnus-mime-decode-quoted-printable (point) (point-max)))))))
10317
10318 (defun gnus-mime-decode-quoted-printable (from to)
10319   ;; Decode quoted-printable from region between FROM and TO.
10320   (save-excursion
10321     (goto-char from)
10322     (while (search-forward "=" to t)
10323       (cond ((eq (following-char) ?\n)
10324              (delete-char -1)
10325              (delete-char 1))
10326             ((looking-at "[0-9A-F][0-9A-F]")
10327              (delete-char -1)
10328              (insert (hexl-hex-string-to-integer
10329                       (buffer-substring (point) (+ 2 (point)))))
10330              (delete-char 2))
10331             ((gnus-message 3 "Malformed MIME quoted-printable message"))))))
10332
10333 (defvar gnus-article-time-units
10334   (list (cons 'year (* 365.25 24 60 60))
10335         (cons 'week (* 7 24 60 60))
10336         (cons 'day (* 24 60 60))
10337         (cons 'hour (* 60 60))
10338         (cons 'minute 60)
10339         (cons 'second 1)))
10340
10341 (defun gnus-article-date-ut (&optional type)
10342   "Convert DATE date to universal time in the current article.
10343 If TYPE is `local', convert to local time; if it is `lapsed', output
10344 how much time has lapsed since DATE."
10345   (interactive (list 'ut))
10346   (let ((date (header-date (or gnus-current-headers 
10347                                (gnus-get-header-by-number
10348                                 (gnus-summary-article-number))"")))
10349         (date-regexp "^Date: \\|^X-Sent: "))
10350     (if (or (not date)
10351             (string= date ""))
10352         ()
10353       (save-excursion
10354         (set-buffer gnus-article-buffer)
10355         (let ((buffer-read-only nil))
10356           (goto-char (point-min))
10357           (if (and (re-search-forward date-regexp nil t)
10358                    (progn 
10359                      (beginning-of-line)
10360                      (looking-at date-regexp)))
10361               (delete-region (gnus-point-at-bol)
10362                              (progn (end-of-line) (1+ (point))))
10363             (goto-char (point-min))
10364             (goto-char (- (search-forward "\n\n") 2)))
10365           (insert
10366            (cond 
10367             ((eq type 'local)
10368              (concat "Date: " (timezone-make-date-arpa-standard date) "\n"))
10369             ((eq type 'ut)
10370              (concat "Date: " (timezone-make-date-arpa-standard date nil "UT")
10371                      "\n"))
10372             ((eq type 'lapsed)
10373              (let* ((sec (max (- (gnus-seconds-since-epoch 
10374                                   (timezone-make-date-arpa-standard
10375                                    (current-time-string) 
10376                                    (current-time-zone) "UT"))
10377                                  (gnus-seconds-since-epoch 
10378                                   (timezone-make-date-arpa-standard 
10379                                    date nil "UT")))
10380                               0))
10381                     num prev)
10382                (concat
10383                 "X-Sent: "
10384                 (mapconcat 
10385                  (lambda (unit)
10386                    (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
10387                        ""
10388                      (setq sec (- sec (* num (cdr unit))))
10389                      (prog1
10390                          (concat (if prev ", " "") (int-to-string (floor num))
10391                                  " " (symbol-name (car unit))
10392                                  (if (> num 1) "s" ""))
10393                        (setq prev t))))
10394                  gnus-article-time-units "")
10395                 " ago\n")))
10396             (t
10397              (error "Unknown conversion type: %s" type)))))))))
10398
10399 (defun gnus-article-date-local ()
10400   "Convert the current article date to the local timezone."
10401   (interactive)
10402   (gnus-article-date-ut 'local))
10403
10404 (defun gnus-article-date-lapsed ()
10405   "Convert the current article date to time lapsed since it was sent."
10406   (interactive)
10407   (gnus-article-date-ut 'lapsed))
10408
10409 (defun gnus-article-maybe-highlight ()
10410   (if gnus-visual (gnus-article-highlight)))
10411
10412 ;; Article savers.
10413
10414 (defun gnus-output-to-rmail (file-name)
10415   "Append the current article to an Rmail file named FILE-NAME."
10416   (require 'rmail)
10417   ;; Most of these codes are borrowed from rmailout.el.
10418   (setq file-name (expand-file-name file-name))
10419   (setq rmail-default-rmail-file file-name)
10420   (let ((artbuf (current-buffer))
10421         (tmpbuf (get-buffer-create " *Gnus-output*")))
10422     (save-excursion
10423       (or (get-file-buffer file-name)
10424           (file-exists-p file-name)
10425           (if (gnus-yes-or-no-p
10426                (concat "\"" file-name "\" does not exist, create it? "))
10427               (let ((file-buffer (create-file-buffer file-name)))
10428                 (save-excursion
10429                   (set-buffer file-buffer)
10430                   (rmail-insert-rmail-file-header)
10431                   (let ((require-final-newline nil))
10432                     (write-region (point-min) (point-max) file-name t 1)))
10433                 (kill-buffer file-buffer))
10434             (error "Output file does not exist")))
10435       (set-buffer tmpbuf)
10436       (buffer-disable-undo (current-buffer))
10437       (erase-buffer)
10438       (insert-buffer-substring artbuf)
10439       (gnus-convert-article-to-rmail)
10440       ;; Decide whether to append to a file or to an Emacs buffer.
10441       (let ((outbuf (get-file-buffer file-name)))
10442         (if (not outbuf)
10443             (append-to-file (point-min) (point-max) file-name)
10444           ;; File has been visited, in buffer OUTBUF.
10445           (set-buffer outbuf)
10446           (let ((buffer-read-only nil)
10447                 (msg (and (boundp 'rmail-current-message)
10448                           (symbol-value 'rmail-current-message))))
10449             ;; If MSG is non-nil, buffer is in RMAIL mode.
10450             (if msg
10451                 (progn (widen)
10452                        (narrow-to-region (point-max) (point-max))))
10453             (insert-buffer-substring tmpbuf)
10454             (if msg
10455                 (progn
10456                   (goto-char (point-min))
10457                   (widen)
10458                   (search-backward "\^_")
10459                   (narrow-to-region (point) (point-max))
10460                   (goto-char (1+ (point-min)))
10461                   (rmail-count-new-messages t)
10462                   (rmail-show-message msg)))))))
10463     (kill-buffer tmpbuf)))
10464
10465 (defun gnus-output-to-file (file-name)
10466   "Append the current article to a file named FILE-NAME."
10467   (setq file-name (expand-file-name file-name))
10468   (let ((artbuf (current-buffer))
10469         (tmpbuf (get-buffer-create " *Gnus-output*")))
10470     (save-excursion
10471       (set-buffer tmpbuf)
10472       (buffer-disable-undo (current-buffer))
10473       (erase-buffer)
10474       (insert-buffer-substring artbuf)
10475       ;; Append newline at end of the buffer as separator, and then
10476       ;; save it to file.
10477       (goto-char (point-max))
10478       (insert "\n")
10479       (append-to-file (point-min) (point-max) file-name))
10480     (kill-buffer tmpbuf)))
10481
10482 (defun gnus-convert-article-to-rmail ()
10483   "Convert article in current buffer to Rmail message format."
10484   (let ((buffer-read-only nil))
10485     ;; Convert article directly into Babyl format.
10486     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
10487     (goto-char (point-min))
10488     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
10489     (while (search-forward "\n\^_" nil t) ;single char
10490       (replace-match "\n^_" t t))               ;2 chars: "^" and "_"
10491     (goto-char (point-max))
10492     (insert "\^_")))
10493
10494 (defun gnus-narrow-to-page (&optional arg)
10495   "Make text outside current page invisible except for page delimiter.
10496 A numeric arg specifies to move forward or backward by that many pages,
10497 thus showing a page other than the one point was originally in."
10498   (interactive "P")
10499   (setq arg (if arg (prefix-numeric-value arg) 0))
10500   (save-excursion
10501     (forward-page -1)                   ;Beginning of current page.
10502     (widen)
10503     (if (> arg 0)
10504         (forward-page arg)
10505       (if (< arg 0)
10506           (forward-page (1- arg))))
10507     ;; Find the end of the page.
10508     (forward-page)
10509     ;; If we stopped due to end of buffer, stay there.
10510     ;; If we stopped after a page delimiter, put end of restriction
10511     ;; at the beginning of that line.
10512     ;; These are commented out.
10513     ;;    (if (save-excursion (beginning-of-line)
10514     ;;                  (looking-at page-delimiter))
10515     ;;  (beginning-of-line))
10516     (narrow-to-region (point)
10517                       (progn
10518                         ;; Find the top of the page.
10519                         (forward-page -1)
10520                         ;; If we found beginning of buffer, stay there.
10521                         ;; If extra text follows page delimiter on same line,
10522                         ;; include it.
10523                         ;; Otherwise, show text starting with following line.
10524                         (if (and (eolp) (not (bobp)))
10525                             (forward-line 1))
10526                         (point)))))
10527
10528 (defun gnus-gmt-to-local ()
10529   "Rewrite Date header described in GMT to local in current buffer.
10530 Intended to be used with gnus-article-prepare-hook."
10531   (save-excursion
10532     (save-restriction
10533       (widen)
10534       (goto-char (point-min))
10535       (narrow-to-region (point-min)
10536                         (progn (search-forward "\n\n" nil 'move) (point)))
10537       (goto-char (point-min))
10538       (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
10539           (let ((buffer-read-only nil)
10540                 (date (buffer-substring-no-properties
10541                        (match-beginning 1) (match-end 1))))
10542             (delete-region (match-beginning 1) (match-end 1))
10543             (insert
10544              (timezone-make-date-arpa-standard 
10545               date nil (current-time-zone))))))))
10546
10547
10548 ;; Article mode commands
10549
10550 (defun gnus-article-next-page (lines)
10551   "Show next page of current article.
10552 If end of article, return non-nil. Otherwise return nil.
10553 Argument LINES specifies lines to be scrolled up."
10554   (interactive "P")
10555   (move-to-window-line -1)
10556   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
10557   (if (save-excursion
10558         (end-of-line)
10559         (and (pos-visible-in-window-p)  ;Not continuation line.
10560              (eobp)))
10561       ;; Nothing in this page.
10562       (if (or (not gnus-break-pages)
10563               (save-excursion
10564                 (save-restriction
10565                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
10566           t                             ;Nothing more.
10567         (gnus-narrow-to-page 1)         ;Go to next page.
10568         nil)
10569     ;; More in this page.
10570     (condition-case ()
10571         (scroll-up lines)
10572       (end-of-buffer
10573        ;; Long lines may cause an end-of-buffer error.
10574        (goto-char (point-max))))
10575     nil))
10576
10577 (defun gnus-article-prev-page (lines)
10578   "Show previous page of current article.
10579 Argument LINES specifies lines to be scrolled down."
10580   (interactive "P")
10581   (move-to-window-line 0)
10582   (if (and gnus-break-pages
10583            (bobp)
10584            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
10585       (progn
10586         (gnus-narrow-to-page -1) ;Go to previous page.
10587         (goto-char (point-max))
10588         (recenter -1))
10589     (scroll-down lines)))
10590
10591 (defun gnus-article-refer-article ()
10592   "Read article specified by message-id around point."
10593   (interactive)
10594   (search-forward ">" nil t)    ;Move point to end of "<....>".
10595   (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
10596       (let ((message-id
10597              (buffer-substring (match-beginning 1) (match-end 1))))
10598         (set-buffer gnus-summary-buffer)
10599         (gnus-summary-refer-article message-id))
10600     (error "No references around point")))
10601
10602 (defun gnus-article-show-summary ()
10603   "Reconfigure windows to show summary buffer."
10604   (interactive)
10605   (gnus-configure-windows 'article)
10606   (gnus-summary-goto-subject gnus-current-article))
10607
10608 (defun gnus-article-describe-briefly ()
10609   "Describe article mode commands briefly."
10610   (interactive)
10611   (gnus-message 6
10612    (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")))
10613
10614 (defun gnus-article-summary-command ()
10615   "Execute the last keystroke in the summary buffer."
10616   (interactive)
10617   (let ((obuf (current-buffer))
10618         (owin (current-window-configuration))
10619         func)
10620     (switch-to-buffer gnus-summary-buffer 'norecord)
10621     (setq func (lookup-key (current-local-map) (this-command-keys)))
10622     (call-interactively func)
10623     (set-buffer obuf)
10624     (let ((npoint (point)))
10625       (set-window-configuration owin)
10626       (set-window-start (get-buffer-window (current-buffer)) (point)))))
10627
10628 (defun gnus-article-summary-command-nosave ()
10629   "Execute the last keystroke in the summary buffer."
10630   (interactive)
10631   (let ((obuf (current-buffer))
10632         (owin (current-window-configuration))
10633         func)
10634     (switch-to-buffer gnus-summary-buffer 'norecord)
10635     (setq func (lookup-key (current-local-map) (this-command-keys)))
10636     (call-interactively func)))
10637
10638 ;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
10639 ;; Modified by tower@prep Nov 86
10640 ;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
10641
10642 (defun gnus-caesar-region (&optional n)
10643   "Caesar rotation of region by N, default 13, for decrypting netnews.
10644 ROT47 will be performed for Japanese text in any case."
10645   (interactive (if current-prefix-arg   ; Was there a prefix arg?
10646                    (list (prefix-numeric-value current-prefix-arg))
10647                  (list nil)))
10648   (cond ((not (numberp n)) (setq n 13))
10649         (t (setq n (mod n 26))))        ;canonicalize N
10650   (if (not (zerop n))           ; no action needed for a rot of 0
10651       (progn
10652         (if (or (not (boundp 'caesar-translate-table))
10653                 (not caesar-translate-table)
10654                 (/= (aref caesar-translate-table ?a) (+ ?a n)))
10655             (let ((i 0) 
10656                   (lower "abcdefghijklmnopqrstuvwxyz")
10657                   upper)
10658               (gnus-message 9 "Building caesar-translate-table...")
10659               (setq caesar-translate-table (make-vector 256 0))
10660               (while (< i 256)
10661                 (aset caesar-translate-table i i)
10662                 (setq i (1+ i)))
10663               (setq lower (concat lower lower)
10664                     upper (upcase lower)
10665                     i 0)
10666               (while (< i 26)
10667                 (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
10668                 (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
10669                 (setq i (1+ i)))
10670               ;; ROT47 for Japanese text.
10671               ;; Thanks to ichikawa@flab.fujitsu.junet.
10672               (setq i 161)
10673               (let ((t1 (logior ?O 128))
10674                     (t2 (logior ?! 128))
10675                     (t3 (logior ?~ 128)))
10676                 (while (< i 256)
10677                   (aset caesar-translate-table i
10678                         (let ((v (aref caesar-translate-table i)))
10679                           (if (<= v t1) (if (< v t2) v (+ v 47))
10680                             (if (<= v t3) (- v 47) v))))
10681                   (setq i (1+ i))))
10682               (gnus-message 9 "Building caesar-translate-table...done")))
10683         (let ((from (region-beginning))
10684               (to (region-end))
10685               (i 0) str len)
10686           (setq str (buffer-substring from to))
10687           (setq len (length str))
10688           (while (< i len)
10689             (aset str i (aref caesar-translate-table (aref str i)))
10690             (setq i (1+ i)))
10691           (goto-char from)
10692           (delete-region from to)
10693           (insert str)))))
10694
10695 \f
10696 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
10697
10698 ;;;###autoload
10699 (defalias 'gnus-batch-kill 'gnus-batch-score)
10700 ;;;###autoload
10701 (defun gnus-batch-score ()
10702   "Run batched scoring.
10703 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
10704 Newsgroups is a list of strings in Bnews format.  If you want to score
10705 the comp hierarchy, you'd say \"comp.all\". If you would not like to
10706 score the alt hierarchy, you'd say \"!alt.all\"."
10707   (interactive)
10708   (let* ((yes-and-no
10709           (gnus-newsrc-parse-options
10710            (apply (function concat)
10711                   (mapcar (lambda (g) (concat g " "))
10712                           command-line-args-left))))
10713          (gnus-expert-user t)
10714          (nnmail-spool-file nil)
10715          (gnus-use-dribble-file nil)
10716          (yes (car yes-and-no))
10717          (no (cdr yes-and-no))
10718          group subscribed newsrc entry
10719          ;; Disable verbose message.
10720          gnus-novice-user gnus-large-newsgroup)
10721     ;; Eat all arguments.
10722     (setq command-line-args-left nil)
10723     ;; Start Gnus.
10724     (gnus)
10725     ;; Apply kills to specified newsgroups in command line arguments.
10726     (setq newsrc (cdr gnus-newsrc-alist))
10727     (while newsrc
10728       (setq group (car (car newsrc)))
10729       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
10730       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
10731                (and (car entry)
10732                     (or (eq (car entry) t)
10733                         (not (zerop (car entry)))))
10734                (if yes (string-match yes group) t)
10735                (or (null no) (not (string-match no group))))
10736           (progn
10737             (gnus-summary-read-group group nil t)
10738             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
10739                  (gnus-summary-exit))))
10740       (setq newsrc (cdr newsrc)))
10741     ;; Exit Emacs.
10742     (switch-to-buffer gnus-group-buffer)
10743     (gnus-group-save-newsrc)))
10744
10745 (defun gnus-apply-kill-file ()
10746   "Apply a kill file to the current newsgroup.
10747 Returns the number of articles marked as read."
10748   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
10749           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
10750       (gnus-apply-kill-file-internal)
10751     0))
10752
10753 (defun gnus-kill-save-kill-buffer ()
10754   (save-excursion
10755     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
10756       (if (get-file-buffer file)
10757           (progn
10758             (set-buffer (get-file-buffer file))
10759             (and (buffer-modified-p) (save-buffer))
10760             (kill-buffer (current-buffer)))))))
10761
10762 (defvar gnus-kill-file-name "KILL"
10763   "Suffix of the kill files.")
10764
10765 (defun gnus-newsgroup-kill-file (newsgroup)
10766   "Return the name of a kill file name for NEWSGROUP.
10767 If NEWSGROUP is nil, return the global kill file name instead."
10768   (cond ((or (null newsgroup)
10769              (string-equal newsgroup ""))
10770          ;; The global KILL file is placed at top of the directory.
10771          (expand-file-name gnus-kill-file-name
10772                            (or gnus-kill-files-directory "~/News")))
10773         ((gnus-use-long-file-name 'not-kill)
10774          ;; Append ".KILL" to newsgroup name.
10775          (expand-file-name (concat newsgroup "." gnus-kill-file-name)
10776                            (or gnus-kill-files-directory "~/News")))
10777         (t
10778          ;; Place "KILL" under the hierarchical directory.
10779          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
10780                                    "/" gnus-kill-file-name)
10781                            (or gnus-kill-files-directory "~/News")))))
10782
10783 \f
10784 ;;;
10785 ;;; Dribble file
10786 ;;;
10787
10788 (defvar gnus-dribble-ignore nil)
10789
10790 (defun gnus-dribble-file-name ()
10791   (concat gnus-startup-file "-dribble"))
10792
10793 (defun gnus-dribble-open ()
10794   (save-excursion 
10795     (set-buffer 
10796      (setq gnus-dribble-buffer (find-file-noselect (gnus-dribble-file-name))))
10797     (buffer-disable-undo (current-buffer))
10798     (bury-buffer gnus-dribble-buffer)
10799     (auto-save-mode t)
10800     (goto-char (point-max))))
10801
10802 (defun gnus-dribble-enter (string)
10803   (if (and (not gnus-dribble-ignore)
10804            gnus-dribble-buffer
10805            (buffer-name gnus-dribble-buffer))
10806       (let ((obuf (current-buffer)))
10807         (set-buffer gnus-dribble-buffer)
10808         (insert string "\n")
10809         (set-window-point (get-buffer-window (current-buffer)) (point-max))
10810         (set-buffer obuf))))
10811
10812 (defun gnus-dribble-read-file ()
10813   (let ((dribble-file (gnus-dribble-file-name)))
10814     (save-excursion 
10815       (set-buffer (setq gnus-dribble-buffer 
10816                         (get-buffer-create 
10817                          (file-name-nondirectory dribble-file))))
10818       (gnus-add-current-to-buffer-list)
10819       (erase-buffer)
10820       (set-visited-file-name dribble-file)
10821       (buffer-disable-undo (current-buffer))
10822       (bury-buffer (current-buffer))
10823       (set-buffer-modified-p nil)
10824       (let ((auto (make-auto-save-file-name))
10825             (gnus-dribble-ignore t))
10826         (if (or (file-exists-p auto) (file-exists-p dribble-file))
10827             (progn
10828               (if (file-newer-than-file-p auto dribble-file)
10829                   (setq dribble-file auto))
10830               (insert-file-contents dribble-file)
10831               (if (not (zerop (buffer-size)))
10832                   (set-buffer-modified-p t))
10833               (if (gnus-y-or-n-p 
10834                    "Auto-save file exists. Do you want to read it? ")
10835                   (progn
10836                     (gnus-message 5 "Reading %s..." dribble-file) 
10837                     (eval-current-buffer)
10838                     (gnus-message 5 "Reading %s...done" dribble-file)))))))))
10839
10840 (defun gnus-dribble-delete-file ()
10841   (if (file-exists-p (gnus-dribble-file-name))
10842       (delete-file (gnus-dribble-file-name)))
10843   (if gnus-dribble-buffer
10844       (save-excursion
10845         (set-buffer gnus-dribble-buffer)
10846         (let ((auto (make-auto-save-file-name)))
10847           (if (file-exists-p auto)
10848               (delete-file auto))
10849           (erase-buffer)
10850           (set-buffer-modified-p nil)))))
10851
10852 (defun gnus-dribble-save ()
10853   (if (and gnus-dribble-buffer
10854            (buffer-name gnus-dribble-buffer))
10855       (save-excursion
10856         (set-buffer gnus-dribble-buffer)
10857         (save-buffer))))
10858
10859 (defun gnus-dribble-clear ()
10860   (save-excursion
10861     (if (gnus-buffer-exists-p gnus-dribble-buffer)
10862         (progn
10863           (set-buffer gnus-dribble-buffer)
10864           (erase-buffer)
10865           (set-buffer-modified-p nil)
10866           (setq buffer-saved-size (buffer-size))))))
10867
10868 ;;;
10869 ;;; Server Communication
10870 ;;;
10871
10872 ;; All the Gnus backends have the same interface, and should return
10873 ;; data in a similar format. Below is an overview of what functions
10874 ;; these packages must supply and what results they should return.
10875 ;;
10876 ;; Variables:
10877 ;;
10878 ;; `nntp-server-buffer' - All data should be returned to Gnus in this
10879 ;; buffer. 
10880 ;;
10881 ;; Functions for the imaginary backend `choke':
10882 ;;
10883 ;; `choke-retrieve-headers ARTICLES &optional GROUP SERVER'
10884 ;; Should return all headers for all ARTICLES, or return NOV lines for
10885 ;; the same.
10886 ;;
10887 ;; `choke-request-group GROUP &optional SERVER DISCARD'
10888 ;; Switch to GROUP. If DISCARD is nil, active information on the group
10889 ;; must be returned.
10890 ;;
10891 ;; `choke-close-group GROUP &optional SERVER'
10892 ;; Close group. Most backends won't have to do anything with this
10893 ;; call, but it is an opportunity to clean up, if that is needed. It
10894 ;; is called when Gnus exits a group.
10895 ;;
10896 ;; `choke-request-article ARTICLE &optional GROUP SERVER'
10897 ;; Return ARTICLE, which is either an article number or
10898 ;; message-id. Note that not all backends can return articles based on
10899 ;; message-id. 
10900 ;;
10901 ;; `choke-request-list SERVER'
10902 ;; Return a list of all newsgroups on SERVER.
10903 ;;
10904 ;; `choke-request-list-newsgroups SERVER'
10905 ;; Return a list of descriptions of all newsgroups on SERVER.
10906 ;;
10907 ;; `choke-request-newgroups DATE &optional SERVER'
10908 ;; Return a list of all groups that have arrived after DATE on
10909 ;; SERVER. Note that the date doesn't have to be respected - Gnus will
10910 ;; always check whether the groups are old or not. Backends that do
10911 ;; not store date information may just return the entire list of
10912 ;; groups, although this might not be a good idea in general.
10913 ;;
10914 ;; `choke-request-post-buffer METHOD HEADER ARTICLE-BUFFER GROUP INFO'
10915 ;; Should return a buffer that is suitable for "posting". nnspool and
10916 ;; nntp return a `*post-buffer*', and nnmail return a `*mail*'
10917 ;; buffer. This function should fill out the appropriate headers. 
10918 ;;
10919 ;; `choke-request-post &optional SERVER'
10920 ;; Function that will be called from a buffer to be posted. 
10921 ;;
10922 ;; `choke-open-server SERVER &optional ARGUMENT'
10923 ;; Open a connection to SERVER.
10924 ;;
10925 ;; `choke-close-server &optional SERVER'
10926 ;; Close the connection to SERVER.
10927 ;;
10928 ;; `choke-server-opened &optional SERVER'
10929 ;; Whether the conenction to SERVER is opened or not.
10930 ;;
10931 ;; `choke-server-status &optional SERVER'
10932 ;; Should return a status string (not in the nntp buffer, but as the
10933 ;; result of the function).
10934 ;;
10935 ;; `choke-retrieve-groups GROUPS &optional SERVER'
10936 ;; Optional function for retrieving active file info on all groups in
10937 ;; GROUPS.  Two return formats are supported: The normal active file
10938 ;; format, and a list of GROUP lines.  This function should return (as
10939 ;; a function value) either `active' or `group', depending on what
10940 ;; format it returns.
10941 ;;
10942 ;; The following functions are optional and apply only to backends
10943 ;; that are able to control the contents of their groups totally
10944 ;; (ie. mail backends.)  Backends that aren't able to do that
10945 ;; shouldn't define these functions at all. Gnus will check for their
10946 ;; presence before attempting to call them.
10947 ;;
10948 ;; `choke-request-expire-articles ARTICLES &optional NEWSGROUP SERVER'
10949 ;; Should expire (according to some aging scheme) all ARTICLES. Most
10950 ;; backends will not be able to expire articles. Should return a list
10951 ;; of all articles that were not expired.
10952 ;;
10953 ;; `choke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM &optional LAST'
10954 ;; Should move ARTICLE from GROUP on SERVER by using ACCEPT-FORM.
10955 ;; Removes any information it has added to the article (extra headers,
10956 ;; whatever - make it as clean as possible), and then passes the
10957 ;; article on by evaling ACCEPT-FORM, which is normally a call to the
10958 ;; function described below. If the ACCEPT-FORM returns a non-nil
10959 ;; value, the article should then be deleted. If LAST is nil, that
10960 ;; means that there will be further calls to this function. This might
10961 ;; be taken as an advice not to save buffers/internal variables just
10962 ;; yet, but wait until the last call to speed things up.
10963 ;;
10964 ;; `choke-request-accept-article GROUP &optional LAST' 
10965 ;; The contents of the current buffer will be put into GROUP.  There
10966 ;; should, of course, be an article in the current buffer.  This
10967 ;; function is normally only called by the function described above,
10968 ;; and LAST works the same way as in that function.
10969 ;;
10970 ;; `choke-request-replace-article ARTICLE GROUP BUFFER'
10971 ;; Replace ARTICLE in GROUP with the contents of BUFFER.
10972 ;; This provides an easy interface for allowing editing of
10973 ;; articles. Note that even headers may be edited, so the backend has
10974 ;; to update any tables (nov buffers, etc) that it maintains after
10975 ;; replacing the article.
10976 ;;
10977 ;; `choke-request-create-group GROUP &optional SERVER'
10978 ;; Create GROUP on SERVER.  This might be a new, empty group, or it
10979 ;; might be a group that already exists, but hasn't been registered
10980 ;; yet. 
10981 ;;
10982 ;; All these functions must return nil if they couldn't service the
10983 ;; request. If the optional arguments are not supplied, some "current"
10984 ;; or "default" values should be used. In short, one should emulate an
10985 ;; NNTP server, in a way.
10986 ;;
10987 ;; If you want to write a new backend, you just have to supply the
10988 ;; functions listed above. In addition, you must enter the new backend
10989 ;; into the list of valid select methods:
10990 ;; (setq gnus-valid-select-methods 
10991 ;;       (cons '("choke" mail) gnus-valid-select-methods))
10992 ;; The first element in this list is the name of the backend. Other
10993 ;; elemnets may be `mail' (for mail groups),  `post' (for news
10994 ;; groups), `none' (neither), `respool' (for groups that can control
10995 ;; their contents). 
10996
10997 (defun gnus-start-news-server (&optional confirm)
10998   "Open a method for getting news.
10999 If CONFIRM is non-nil, the user will be asked for an NNTP server."
11000   (let (how where)
11001     (if gnus-current-select-method
11002         ;; Stream is already opened.
11003         nil
11004       ;; Open NNTP server.
11005       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
11006       (if confirm
11007           (progn
11008             ;; Read server name with completion.
11009             (setq gnus-nntp-server
11010                   (completing-read "NNTP server: "
11011                                    (mapcar (lambda (server) (list server))
11012                                            (cons (list gnus-nntp-server)
11013                                                  gnus-secondary-servers))
11014                                    nil nil gnus-nntp-server))))
11015
11016       (if (and gnus-nntp-server 
11017                (stringp gnus-nntp-server)
11018                (not (string= gnus-nntp-server "")))
11019           (setq gnus-select-method
11020                 (cond ((or (string= gnus-nntp-server "")
11021                            (string= gnus-nntp-server "::"))
11022                        (list 'nnspool (system-name)))
11023                       ((string-match "^:" gnus-nntp-server)
11024                        (list 'nnmh gnus-nntp-server 
11025                              (list 'nnmh-directory 
11026                                    (file-name-as-directory
11027                                     (expand-file-name
11028                                      (concat "~/" (substring
11029                                                    gnus-nntp-server 1)))))
11030                              (list 'nnmh-get-new-mail nil)))
11031                       (t
11032                        (list 'nntp gnus-nntp-server)))))
11033
11034       (setq how (car gnus-select-method))
11035       (setq where (car (cdr gnus-select-method)))
11036       (cond ((eq how 'nnspool)
11037              (require 'nnspool)
11038              (gnus-message 5 "Looking up local news spool..."))
11039             ((eq how 'nnmh)
11040              (require 'nnmh)
11041              (gnus-message 5 "Looking up mh spool..."))
11042             (t
11043              (require 'nntp)))
11044       (setq gnus-current-select-method gnus-select-method)
11045       (run-hooks 'gnus-open-server-hook)
11046       (or 
11047        ;; gnus-open-server-hook might have opened it
11048        (gnus-server-opened gnus-select-method)  
11049        (gnus-open-server gnus-select-method)
11050        (gnus-y-or-n-p
11051         (format
11052          "%s server on %s can't be opened. Continue? "
11053          (car gnus-select-method) (nth 1 gnus-select-method)))
11054        (progn
11055          (gnus-message 1 "Couldn't open server on %s" 
11056                        (nth 1 gnus-select-method))
11057          (ding)
11058          nil)))))
11059
11060 (defun gnus-check-news-server (&optional method)
11061   "If the news server is down, start it up again."
11062   (let ((method (if method method gnus-select-method)))
11063     (and (stringp method)
11064          (setq method (gnus-server-to-method method)))
11065     (if (gnus-server-opened method)
11066         ;; Stream is already opened.
11067         t
11068       ;; Open server.
11069       (gnus-message 5 "Opening server %s on %s..." (car method) (nth 1 method))
11070       (run-hooks 'gnus-open-server-hook)
11071       (or (gnus-server-opened method)
11072           (gnus-open-server method))
11073       (message ""))))
11074
11075 (defun gnus-nntp-message (&optional message)
11076   "Check the status of the NNTP server.
11077 If the status of the server is clear and MESSAGE is non-nil, MESSAGE
11078 is returned insted of the status string."
11079   (let ((status (gnus-status-message (gnus-find-method-for-group 
11080                                       gnus-newsgroup-name)))
11081         (message (or message "")))
11082     (if (and (stringp status) (> (length status) 0))
11083         status message)))
11084
11085 (defun gnus-get-function (method function)
11086   (and (stringp method)
11087        (setq method (gnus-server-to-method method)))
11088   (let ((func (intern (format "%s-%s" (car method) function))))
11089     (if (not (fboundp func)) 
11090         (progn
11091           (require (car method))
11092           (if (not (fboundp func)) 
11093               (error "No such function: %s" func))))
11094     func))
11095
11096 ;;; Interface functions to the backends.
11097
11098 (defun gnus-open-server (method)
11099   (funcall (gnus-get-function method 'open-server)
11100            (nth 1 method) (nthcdr 2 method)))
11101
11102 (defun gnus-close-server (method)
11103   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
11104
11105 (defun gnus-request-list (method)
11106   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
11107
11108 (defun gnus-request-list-newsgroups (method)
11109   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
11110
11111 (defun gnus-request-newgroups (date method)
11112   (funcall (gnus-get-function method 'request-newgroups) 
11113            date (nth 1 method)))
11114
11115 (defun gnus-server-opened (method)
11116   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
11117
11118 (defun gnus-status-message (method)
11119   (let ((method (if (stringp method) (gnus-find-method-for-group method)
11120                   method)))
11121     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
11122
11123 (defun gnus-request-group (group &optional dont-check)
11124   (let ((method (gnus-find-method-for-group group)))
11125 ;    (and t (message "%s GROUP %s" (car method) group))
11126     (funcall (gnus-get-function method 'request-group) 
11127              (gnus-group-real-name group) (nth 1 method) dont-check)))
11128
11129 (defun gnus-request-asynchronous (group &optional articles)
11130   (let ((method (gnus-find-method-for-group group)))
11131     (funcall (gnus-get-function method 'request-asynchronous) 
11132              (gnus-group-real-name group) (nth 1 method) articles)))
11133
11134 (defun gnus-list-active-group (group)
11135   (let ((method (gnus-find-method-for-group group))
11136         (func 'list-active-group))
11137     (and (gnus-check-backend-function func group)
11138          (funcall (gnus-get-function method func) 
11139                   (gnus-group-real-name group) (nth 1 method)))))
11140
11141 (defun gnus-request-group-description (group)
11142   (let ((method (gnus-find-method-for-group group))
11143         (func 'request-group-description))
11144     (and (gnus-check-backend-function func group)
11145          (funcall (gnus-get-function method func) 
11146                   (gnus-group-real-name group) (nth 1 method)))))
11147
11148 (defun gnus-close-group (group)
11149   (let ((method (gnus-find-method-for-group group)))
11150     (funcall (gnus-get-function method 'close-group) 
11151              (gnus-group-real-name group) (nth 1 method))))
11152
11153 (defun gnus-retrieve-headers (articles group)
11154   (let ((method (gnus-find-method-for-group group)))
11155     (if (and gnus-use-cache (numberp (car articles)))
11156         (gnus-cache-retrieve-headers articles group)
11157       (funcall (gnus-get-function method 'retrieve-headers) 
11158                articles (gnus-group-real-name group) (nth 1 method)))))
11159
11160 (defun gnus-retrieve-groups (groups method)
11161   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
11162
11163 (defun gnus-request-article (article group &optional buffer)
11164   (let ((method (gnus-find-method-for-group group)))
11165     (funcall (gnus-get-function method 'request-article) 
11166              article (gnus-group-real-name group) (nth 1 method) buffer)))
11167
11168 (defun gnus-request-head (article group)
11169   (let ((method (gnus-find-method-for-group group)))
11170     (funcall (gnus-get-function method 'request-head) 
11171              article (gnus-group-real-name group) (nth 1 method))))
11172
11173 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11174 (defun gnus-request-post-buffer (post group subject header artbuf
11175                                       info follow-to respect-poster)
11176    (let* ((info (or info (and group (nth 2 (gnus-gethash 
11177                                             group gnus-newsrc-hashtb)))))
11178           (method
11179            (if (and gnus-post-method
11180                     ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11181                     (memq 'post (assoc
11182                                  (format "%s" (car (gnus-find-method-for-group
11183                                                     gnus-newsgroup-name)))
11184                                         gnus-valid-select-methods)))
11185                gnus-post-method
11186              (gnus-find-method-for-group gnus-newsgroup-name))))
11187      (or (gnus-server-opened method)
11188          (gnus-open-server method)
11189          (error "Can't open server %s:%s" (car method) (nth 1 method)))
11190      (let ((mail-self-blind nil)
11191            (mail-archive-file-name nil))
11192        (funcall (gnus-get-function method 'request-post-buffer) 
11193                 post group subject header artbuf info follow-to
11194                 respect-poster))))
11195
11196 (defun gnus-request-post (method &optional force)
11197   (and (stringp method)
11198        (setq method (gnus-server-to-method method)))
11199   (and (not force) gnus-post-method
11200        (memq 'post (assoc (format "%s" (car method))
11201                           gnus-valid-select-methods))
11202        (setq method gnus-post-method))
11203   (funcall (gnus-get-function method 'request-post) 
11204            (nth 1 method)))
11205
11206 (defun gnus-request-expire-articles (articles group &optional force)
11207   (let ((method (gnus-find-method-for-group group)))
11208     (funcall (gnus-get-function method 'request-expire-articles) 
11209              articles (gnus-group-real-name group) (nth 1 method)
11210              force)))
11211
11212 (defun gnus-request-move-article 
11213   (article group server accept-function &optional last)
11214   (let ((method (gnus-find-method-for-group group)))
11215     (funcall (gnus-get-function method 'request-move-article) 
11216              article (gnus-group-real-name group) 
11217              (nth 1 method) accept-function last)))
11218
11219 (defun gnus-request-accept-article (group &optional last)
11220   (let ((func (if (symbolp group) group
11221                 (car (gnus-find-method-for-group group)))))
11222     (funcall (intern (format "%s-request-accept-article" func))
11223              (if (stringp group) (gnus-group-real-name group) group)
11224              last)))
11225
11226 (defun gnus-request-replace-article (article group buffer)
11227   (let ((func (car (gnus-find-method-for-group group))))
11228     (funcall (intern (format "%s-request-replace-article" func))
11229              article (gnus-group-real-name group) buffer)))
11230
11231 (defun gnus-request-create-group (group)
11232   (let ((method (gnus-find-method-for-group group)))
11233     (funcall (gnus-get-function method 'request-create-group) 
11234              (gnus-group-real-name group) (nth 1 method))))
11235
11236 (defun gnus-member-of-valid (symbol group)
11237   (memq symbol (assoc
11238                 (format "%s" (car (gnus-find-method-for-group group)))
11239                 gnus-valid-select-methods)))
11240
11241 (defsubst gnus-secondary-method-p (method)
11242   (member method gnus-secondary-select-methods))
11243
11244 (defun gnus-find-method-for-group (group &optional info)
11245   (or gnus-override-method
11246       (and (not group)
11247            gnus-select-method)
11248       (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
11249             method)
11250         (if (or (not info)
11251                 (not (setq method (nth 4 info))))
11252             (setq method gnus-select-method)
11253           (setq method
11254                 (cond ((stringp method)
11255                        (gnus-server-to-method method))
11256                       ((stringp (car method))
11257                        (gnus-server-extend-method group method))
11258                       (t
11259                        method))))
11260         (gnus-server-add-address method))))
11261
11262 (defun gnus-check-backend-function (func group)
11263   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
11264                  group)))
11265     (fboundp (intern (format "%s-%s" method func)))))
11266
11267 (defun gnus-methods-using (method)
11268   (let ((valids gnus-valid-select-methods)
11269         outs)
11270     (while valids
11271       (if (memq method (car valids)) 
11272           (setq outs (cons (car valids) outs)))
11273       (setq valids (cdr valids)))
11274     outs))
11275
11276 ;;; 
11277 ;;; Active & Newsrc File Handling
11278 ;;;
11279
11280 ;; Newsrc related functions.
11281 ;; Gnus internal format of gnus-newsrc-alist:
11282 ;; (("alt.general" 3 (1 . 1))
11283 ;;  ("alt.misc"    3 ((1 . 10) (12 . 15)))
11284 ;;  ("alt.test"    7 (1 . 99) (45 57 93)) ...)
11285 ;; The first item is the group name; the second is the subscription
11286 ;; level; the third is either a range of a list of ranges of read
11287 ;; articles, the optional fourth element is a list of marked articles,
11288 ;; the optional fifth element is the select method.
11289 ;;
11290 ;; Gnus internal format of gnus-newsrc-hashtb:
11291 ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...)
11292 ;; This is the entry for "alt.misc". The first element is the number
11293 ;; of unread articles in "alt.misc". The cdr of this entry is the
11294 ;; element *before* "alt.misc" in gnus-newsrc-alist, which makes is
11295 ;; trivial to remove or add new elements into gnus-newsrc-alist
11296 ;; without scanning the entire list. So, to get the actual information
11297 ;; of "alt.misc", you'd say something like 
11298 ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb))
11299 ;;
11300 ;; Gnus internal format of gnus-active-hashtb:
11301 ;; ((1 . 1))
11302 ;;  (5 . 10))
11303 ;;  (67 . 99)) ...)
11304 ;; The only element in each entry in this hash table is a range of
11305 ;; (possibly) available articles. (Articles in this range may have
11306 ;; been expired or cancelled.)
11307 ;;
11308 ;; Gnus internal format of gnus-killed-list and gnus-zombie-list:
11309 ;; ("alt.misc" "alt.test" "alt.general" ...)
11310
11311 (defun gnus-setup-news (&optional rawfile level)
11312   "Setup news information.
11313 If RAWFILE is non-nil, the .newsrc file will also be read.
11314 If LEVEL is non-nil, the news will be set up at level LEVEL."
11315   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
11316     ;; Clear some variables to re-initialize news information.
11317     (if init (setq gnus-newsrc-alist nil gnus-active-hashtb nil))
11318
11319     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
11320     (if init (gnus-read-newsrc-file rawfile))
11321
11322     ;; Read the active file and create `gnus-active-hashtb'.
11323     ;; If `gnus-read-active-file' is nil, then we just create an empty
11324     ;; hash table. The partial filling out of the hash table will be
11325     ;; done in `gnus-get-unread-articles'.
11326     (if (and gnus-read-active-file 
11327              (not level)
11328              (gnus-server-opened gnus-select-method))
11329         (gnus-read-active-file)
11330       (setq gnus-active-hashtb (make-vector 4095 0)))
11331
11332     (and init gnus-use-dribble-file (gnus-dribble-read-file))
11333
11334     ;; Find the number of unread articles in each non-dead group.
11335     (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))
11336     ;; Find new newsgroups and treat them.
11337     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
11338              (gnus-server-opened gnus-select-method))
11339         (gnus-find-new-newsgroups))
11340     (if (and init gnus-check-bogus-newsgroups 
11341              gnus-read-active-file (not level)
11342              (gnus-server-opened gnus-select-method))
11343         (gnus-check-bogus-newsgroups))))
11344
11345 (defun gnus-find-new-newsgroups ()
11346   "Search for new newsgroups and add them.
11347 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
11348 The `-n' option line from .newsrc is respected."
11349   (interactive)
11350   (or (gnus-check-first-time-used)
11351       (if (or (consp gnus-check-new-newsgroups)
11352               (eq gnus-check-new-newsgroups 'ask-server))
11353           (gnus-ask-server-for-new-groups)
11354         (let ((groups 0)
11355               group new-newsgroups)
11356           (or gnus-have-read-active-file (gnus-read-active-file))
11357           (setq gnus-newsrc-last-checked-date (current-time-string))
11358           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
11359           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
11360           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
11361           (mapatoms
11362            (lambda (sym)
11363              (setq group (symbol-name sym))
11364              (if (or (gnus-gethash group gnus-killed-hashtb)
11365                      (gnus-gethash group gnus-newsrc-hashtb))
11366                  ()
11367                (let ((do-sub (gnus-matches-options-n group)))
11368                  (cond ((eq do-sub 'subscribe)
11369                         (setq groups (1+ groups))
11370                         (gnus-sethash group group gnus-killed-hashtb)
11371                         (funcall 
11372                          gnus-subscribe-options-newsgroup-method group))
11373                        ((eq do-sub 'ignore)
11374                         nil)
11375                        (t
11376                         (setq groups (1+ groups))
11377                         (gnus-sethash group group gnus-killed-hashtb)
11378                         (if gnus-subscribe-hierarchical-interactive
11379                             (setq new-newsgroups (cons group new-newsgroups))
11380                           (funcall gnus-subscribe-newsgroup-method group)))))))
11381            gnus-active-hashtb)
11382           (if new-newsgroups 
11383               (gnus-subscribe-hierarchical-interactive new-newsgroups))
11384           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
11385           (if (> groups 0)
11386               (gnus-message 6 "%d new newsgroup%s arrived." 
11387                             groups (if (> groups 1) "s have" " has")))))))
11388
11389 (defun gnus-matches-options-n (group)
11390   ;; Returns `subscribe' if the group is to be uncoditionally
11391   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
11392   ;; no match for the group.
11393
11394   ;; First we check the two user variables.
11395   (cond
11396    ((and gnus-options-subscribe
11397          (string-match gnus-options-subscribe group))
11398     'subscribe)
11399    ((and gnus-options-not-subscribe
11400          (string-match gnus-options-not-subscribe group))
11401     'ignore)
11402    ;; Then we go through the list that was retrieved from the .newsrc
11403    ;; file.  This list has elements on the form 
11404    ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list
11405    ;; is in the reverse order of the options line) is returned.
11406    (t
11407     (let ((regs gnus-newsrc-options-n))
11408       (while (and regs
11409                   (not (string-match (car (car regs)) group)))
11410         (setq regs (cdr regs)))
11411       (and regs (cdr (car regs)))))))
11412
11413 (defun gnus-ask-server-for-new-groups ()
11414   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
11415          (methods (cons gnus-select-method 
11416                         (append
11417                          (and (consp gnus-check-new-newsgroups)
11418                               gnus-check-new-newsgroups)
11419                          gnus-secondary-select-methods)))
11420          (groups 0)
11421          (new-date (current-time-string))
11422          hashtb group new-newsgroups got-new)
11423     ;; Go thorugh both primary and secondary select methods and
11424     ;; request new newsgroups.  
11425     (while methods
11426       (and (or (gnus-server-opened (car methods))
11427                (gnus-open-server (car methods)))
11428            (gnus-request-newgroups date (car methods))
11429            (save-excursion
11430              (setq got-new t)
11431              (set-buffer nntp-server-buffer)
11432              (or hashtb (setq hashtb (gnus-make-hashtable 
11433                                       (count-lines (point-min) (point-max)))))
11434              ;; Enter all the new groups in a hashtable.
11435              (gnus-active-to-gnus-format (car methods) hashtb 'ignore)))
11436       (setq methods (cdr methods)))
11437     (and got-new (setq gnus-newsrc-last-checked-date new-date))
11438     ;; Now all new groups from all select methods are in `hashtb'.
11439     (mapatoms
11440      (lambda (group-sym)
11441        (setq group (symbol-name group-sym))
11442        (if (or (gnus-gethash group gnus-newsrc-hashtb)
11443                (member group gnus-zombie-list)
11444                (member group gnus-killed-list))
11445            ;; The group is already known.
11446            ()
11447          (and (symbol-value group-sym)
11448               (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb))
11449          (let ((do-sub (gnus-matches-options-n group)))
11450            (cond ((eq do-sub 'subscribe)
11451                   (setq groups (1+ groups))
11452                   (gnus-sethash group group gnus-killed-hashtb)
11453                   (funcall 
11454                    gnus-subscribe-options-newsgroup-method group))
11455                  ((eq do-sub 'ignore)
11456                   nil)
11457                  (t
11458                   (setq groups (1+ groups))
11459                   (gnus-sethash group group gnus-killed-hashtb)
11460                   (if gnus-subscribe-hierarchical-interactive
11461                       (setq new-newsgroups (cons group new-newsgroups))
11462                     (funcall gnus-subscribe-newsgroup-method group)))))))
11463      hashtb)
11464     (if new-newsgroups 
11465         (gnus-subscribe-hierarchical-interactive new-newsgroups))
11466     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
11467     (if (> groups 0)
11468         (gnus-message 6 "%d new newsgroup%s arrived." 
11469                       groups (if (> groups 1) "s have" " has")))
11470     got-new))
11471
11472 (defun gnus-check-first-time-used ()
11473   (if (or (> (length gnus-newsrc-alist) 1)
11474           (file-exists-p gnus-startup-file)
11475           (file-exists-p (concat gnus-startup-file ".el"))
11476           (file-exists-p (concat gnus-startup-file ".eld")))
11477       nil
11478     (gnus-message 6 "First time user; subscribing you to default groups")
11479     (or gnus-have-read-active-file (gnus-read-active-file))
11480     (setq gnus-newsrc-last-checked-date (current-time-string))
11481     (let ((groups gnus-default-subscribed-newsgroups)
11482           group)
11483       (if (eq groups t)
11484           nil
11485         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
11486         (mapatoms
11487          (lambda (sym)
11488            (setq group (symbol-name sym))
11489            (let ((do-sub (gnus-matches-options-n group)))
11490              (cond ((eq do-sub 'subscribe)
11491                     (gnus-sethash group group gnus-killed-hashtb)
11492                     (funcall 
11493                      gnus-subscribe-options-newsgroup-method group))
11494                    ((eq do-sub 'ignore)
11495                     nil)
11496                    (t
11497                     (setq gnus-killed-list (cons group gnus-killed-list))))))
11498          gnus-active-hashtb)
11499         (while groups
11500           (if (gnus-gethash (car groups) gnus-active-hashtb)
11501               (gnus-group-change-level 
11502                (car groups) gnus-level-default-subscribed gnus-level-killed))
11503           (setq groups (cdr groups)))
11504         (gnus-group-make-help-group)
11505         (and gnus-novice-user
11506              (gnus-message 7 "`A k' to list killed groups"))))))
11507
11508 (defun gnus-subscribe-group (group previous &optional method)
11509   (gnus-group-change-level 
11510    (if method
11511        (list t group gnus-level-default-subscribed nil nil method)
11512      group) 
11513    gnus-level-default-subscribed gnus-level-killed previous t))
11514
11515 ;; `gnus-group-change-level' is the fundamental function for changing
11516 ;; subscription levels of newsgroups. This might mean just changing
11517 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
11518 ;; again, which subscribes/unsubscribes a group, which is equally
11519 ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and
11520 ;; from 8-9 to 1-7 means that you remove the group from the list of
11521 ;; killed (or zombie) groups and add them to the (kinda) subscribed
11522 ;; groups. And last but not least, moving from 8 to 9 and 9 to 8,
11523 ;; which is trivial.
11524 ;; ENTRY can either be a string (newsgroup name) or a list (if
11525 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
11526 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
11527 ;; entries. 
11528 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
11529 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
11530 ;; after. 
11531 (defun gnus-group-change-level (entry level &optional oldlevel
11532                                       previous fromkilled)
11533   (let ((pinfo entry)
11534         group info active num)
11535     ;; Glean what info we can from the arguments
11536     (if (consp entry)
11537         (if fromkilled (setq group (nth 1 entry))
11538           (setq group (car (nth 2 entry))))
11539       (setq group entry))
11540     (if (and (stringp entry)
11541              oldlevel 
11542              (< oldlevel gnus-level-zombie))
11543         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
11544     (if (and (not oldlevel)
11545              (consp entry))
11546         (setq oldlevel (car (cdr (nth 2 entry)))))
11547     (if (stringp previous)
11548         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
11549
11550     (gnus-dribble-enter
11551      (format "(gnus-group-change-level %S %S %S %S %S)" 
11552              group level oldlevel (car (nth 2 previous)) fromkilled))
11553     
11554     ;; Then we remove the newgroup from any old structures, if needed.
11555     ;; If the group was killed, we remove it from the killed or zombie
11556     ;; list. If not, and it is in fact going to be killed, we remove
11557     ;; it from the newsrc hash table and assoc.
11558     (cond ((>= oldlevel gnus-level-zombie)
11559            (if (= oldlevel gnus-level-zombie)
11560                (setq gnus-zombie-list (delete group gnus-zombie-list))
11561              (setq gnus-killed-list (delete group gnus-killed-list))))
11562           (t
11563            (if (>= level gnus-level-zombie)
11564                (progn
11565                  (gnus-sethash (car (nth 2 entry))
11566                                nil gnus-newsrc-hashtb)
11567                  (if (nth 3 entry)
11568                      (setcdr (gnus-gethash (car (nth 3 entry))
11569                                            gnus-newsrc-hashtb)
11570                              (cdr entry)))
11571                  (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
11572
11573     ;; Finally we enter (if needed) the list where it is supposed to
11574     ;; go, and change the subscription level. If it is to be killed,
11575     ;; we enter it into the killed or zombie list.
11576     (cond ((>= level gnus-level-zombie)
11577            ;; Remove from the hash table.
11578            (gnus-sethash group nil gnus-newsrc-hashtb)
11579            (or (gnus-group-foreign-p group)
11580                ;; We do not enter foreign groups into the list of dead
11581                ;; groups.  
11582                (if (= level gnus-level-zombie)
11583                    (setq gnus-zombie-list (cons group gnus-zombie-list))
11584                  (setq gnus-killed-list (cons group gnus-killed-list)))))
11585           (t
11586            ;; If the list is to be entered into the newsrc assoc, and
11587            ;; it was killed, we have to create an entry in the newsrc
11588            ;; hashtb format and fix the pointers in the newsrc assoc.
11589            (if (>= oldlevel gnus-level-zombie)
11590                (progn
11591                  (if (listp entry)
11592                      (progn
11593                        (setq info (cdr entry))
11594                        (setq num (car entry)))
11595                    (setq active (gnus-gethash group gnus-active-hashtb))
11596                    (setq num (if active (- (1+ (cdr active)) (car active)) t))
11597                    ;; Check whether the group is foreign. If so, the
11598                    ;; foreign select method has to be entered into the
11599                    ;; info. 
11600                    (let ((method (gnus-group-method-name group)))
11601                      (if (eq method gnus-select-method)
11602                          (setq info (list group level nil))
11603                        (setq info (list group level nil nil method)))))
11604                  (or previous 
11605                      (setq previous 
11606                            (let ((p gnus-newsrc-alist))
11607                              (while (cdr (cdr p))
11608                                (setq p (cdr p)))
11609                              p)))
11610                  (setq entry (cons info (cdr (cdr previous))))
11611                  (if (cdr previous)
11612                      (progn
11613                        (setcdr (cdr previous) entry)
11614                        (gnus-sethash group (cons num (cdr previous)) 
11615                                      gnus-newsrc-hashtb))
11616                    (setcdr previous entry)
11617                    (gnus-sethash group (cons num previous)
11618                                  gnus-newsrc-hashtb))
11619                  (if (cdr entry)
11620                      (setcdr (gnus-gethash (car (car (cdr entry)))
11621                                            gnus-newsrc-hashtb)
11622                              entry)))
11623              ;; It was alive, and it is going to stay alive, so we
11624              ;; just change the level and don't change any pointers or
11625              ;; hash table entries.
11626              (setcar (cdr (car (cdr (cdr entry)))) level))))))
11627
11628 (defun gnus-kill-newsgroup (newsgroup)
11629   "Obsolete function. Kills a newsgroup."
11630   (gnus-group-change-level
11631    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
11632
11633 (defun gnus-check-bogus-newsgroups (&optional confirm)
11634   "Remove bogus newsgroups.
11635 If CONFIRM is non-nil, the user has to confirm the deletion of every
11636 newsgroup." 
11637   (let ((newsrc (cdr gnus-newsrc-alist))
11638         bogus group entry)
11639     (gnus-message 5 "Checking bogus newsgroups...")
11640     (or gnus-have-read-active-file (gnus-read-active-file))
11641     ;; Find all bogus newsgroup that are subscribed.
11642     (while newsrc
11643       (setq group (car (car newsrc)))
11644       (if (or (gnus-gethash group gnus-active-hashtb) ; Active
11645               (nth 4 (car newsrc))      ; Foreign
11646               (and confirm
11647                    (not (gnus-y-or-n-p
11648                          (format "Remove bogus newsgroup: %s " group)))))
11649           ;; Don't remove.
11650           ()
11651         ;; Found a bogus newsgroup.
11652         (setq bogus (cons group bogus)))
11653       (setq newsrc (cdr newsrc)))
11654     ;; Remove all bogus subscribed groups by first killing them, and
11655     ;; then removing them from the list of killed groups.
11656     (while bogus
11657       (and (setq entry (gnus-gethash (car bogus) gnus-newsrc-hashtb))
11658            (progn
11659              (gnus-group-change-level entry gnus-level-killed)
11660              (setq gnus-killed-list (delete (car bogus) gnus-killed-list))))
11661       (setq bogus (cdr bogus)))
11662     ;; Then we remove all bogus groups from the list of killed and
11663     ;; zombie groups. They are are removed without confirmation.
11664     (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
11665           killed)
11666       (while dead-lists
11667         (setq killed (symbol-value (car dead-lists)))
11668         (while killed
11669           (setq group (car killed))
11670           (or (gnus-gethash group gnus-active-hashtb)
11671               ;; The group is bogus.
11672               (set (car dead-lists)
11673                    (delete group (symbol-value (car dead-lists)))))
11674           (setq killed (cdr killed)))
11675         (setq dead-lists (cdr dead-lists))))
11676     (gnus-message 5 "Checking bogus newsgroups...done")))
11677
11678 (defun gnus-check-duplicate-killed-groups ()
11679   "Remove duplicates from the list of killed groups."
11680   (interactive)
11681   (let ((killed gnus-killed-list))
11682     (while killed
11683       (gnus-message 9 "%d" (length killed))
11684       (setcdr killed (delete (car killed) (cdr killed)))
11685       (setq killed (cdr killed)))))
11686
11687 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
11688 ;; and compute how many unread articles there are in each group.
11689 (defun gnus-get-unread-articles (&optional level) 
11690   (let* ((newsrc (cdr gnus-newsrc-alist))
11691          (conditional level)
11692          (level (or level (1+ gnus-level-subscribed)))
11693          info group active virtuals method)
11694     (gnus-message 5 "Checking new news...")
11695     (while newsrc
11696       (setq info (car newsrc))
11697       (setq group (car info))
11698       (setq active (gnus-gethash group gnus-active-hashtb))
11699
11700       ;; Check newsgroups. If the user doesn't want to check them, or
11701       ;; they can't be checked (for instance, if the news server can't
11702       ;; be reached) we just set the number of unread articles in this
11703       ;; newsgroup to t. This means that Gnus thinks that there are
11704       ;; unread articles, but it has no idea how many.
11705       (if (and (setq method (nth 4 info))
11706                (not (gnus-server-equal gnus-select-method
11707                                        (gnus-server-get-method nil method))))
11708           ;; These groups are foreign.
11709           (if (or (and gnus-activate-foreign-newsgroups 
11710                        (not (numberp gnus-activate-foreign-newsgroups)))
11711                   (and (numberp gnus-activate-foreign-newsgroups)
11712                        (<= (nth 1 info) gnus-activate-foreign-newsgroups)
11713                        (<= (nth 1 info) level))
11714                   (gnus-secondary-method-p method))
11715               (if (eq (car (if (stringp method) 
11716                                (gnus-server-to-method method)
11717                              (nth 4 info))) 'nnvirtual)
11718                   (setq virtuals (cons info virtuals))
11719                 (setq active (gnus-activate-newsgroup (car info)))))
11720         ;; These groups are native.
11721         (if (and (not gnus-read-active-file)
11722                  (<= (nth 1 info) level))
11723             (progn
11724               (setq active (gnus-activate-newsgroup (car info))))))
11725       
11726       (or active (progn (gnus-sethash group nil gnus-active-hashtb)
11727                         (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
11728       (and active 
11729            (gnus-get-unread-articles-in-group info active)
11730            ;; Close the groups as we look at them!
11731            (gnus-close-group group))
11732       (setq newsrc (cdr newsrc)))
11733
11734     ;; Activate the virtual groups. This has to be done after all the
11735     ;; other groups. 
11736     ;; !!! If one virtual group contains another virtual group, even
11737     ;; doing it this way might cause problems.
11738    (while virtuals
11739       (and (setq active (gnus-activate-newsgroup (car (car virtuals))))
11740            (gnus-get-unread-articles-in-group (car virtuals) active))
11741       (setq virtuals (cdr virtuals)))
11742
11743     (gnus-message 5 "Checking new news...done")))
11744
11745 ;; Create a hash table out of the newsrc alist. The `car's of the
11746 ;; alist elements are used as keys.
11747 (defun gnus-make-hashtable-from-newsrc-alist ()
11748   (let ((alist gnus-newsrc-alist)
11749         (ohashtb gnus-newsrc-hashtb)
11750         prev)
11751     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
11752     (setq alist 
11753           (setq prev (setq gnus-newsrc-alist 
11754                            (if (equal (car (car gnus-newsrc-alist))
11755                                       "dummy.group")
11756                                gnus-newsrc-alist
11757                              (cons (list "dummy.group" 0 nil) alist)))))
11758     (while alist
11759       (gnus-sethash (car (car alist)) 
11760                     (cons (and ohashtb (car (gnus-gethash 
11761                                              (car (car alist)) ohashtb))) 
11762                           prev) gnus-newsrc-hashtb)
11763       (setq prev alist
11764             alist (cdr alist)))))
11765
11766 (defun gnus-make-hashtable-from-killed ()
11767   "Create a hash table from the killed and zombie lists."
11768   (let ((lists '(gnus-killed-list gnus-zombie-list))
11769         list)
11770     (setq gnus-killed-hashtb 
11771           (gnus-make-hashtable 
11772            (+ (length gnus-killed-list) (length gnus-zombie-list))))
11773     (while lists
11774       (setq list (symbol-value (car lists)))
11775       (setq lists (cdr lists))
11776       (while list
11777         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
11778         (setq list (cdr list))))))
11779
11780 (defun gnus-get-unread-articles-in-group (info active)
11781   (let* ((range (nth 2 info))
11782          (num 0)
11783          (marked (nth 3 info))
11784          srange lowest group highest)
11785     ;; If a cache is present, we may have to alter the active info.
11786     (and gnus-use-cache
11787          (gnus-cache-possibly-alter-active (car info) active))
11788     ;; Modify the list of read articles according to what articles 
11789     ;; are available; then tally the unread articles and add the
11790     ;; number to the group hash table entry.
11791     (cond ((zerop (cdr active))
11792            (setq num 0))
11793           ((not range)
11794            (setq num (- (1+ (cdr active)) (car active))))
11795           ((not (listp (cdr range)))
11796            ;; Fix a single (num . num) range according to the
11797            ;; active hash table.
11798            ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
11799            (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
11800            (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
11801            ;; Compute number of unread articles.
11802            (setq num (max 0 (- (cdr active) 
11803                                (- (1+ (cdr range)) (car range))))))
11804           (t
11805            ;; The read list is a list of ranges. Fix them according to
11806            ;; the active hash table.
11807            ;; First peel off any elements that are below the lower
11808            ;; active limit. 
11809            (while (and (cdr range) 
11810                        (>= (car active) 
11811                            (or (and (atom (car (cdr range))) (car (cdr range)))
11812                                (car (car (cdr range))))))
11813              (if (numberp (car range))
11814                  (setcar range 
11815                          (cons (car range) 
11816                                (or (and (numberp (car (cdr range)))
11817                                         (car (cdr range))) 
11818                                    (cdr (car (cdr range))))))
11819                (setcdr (car range) 
11820                        (or (and (numberp (nth 1 range)) (nth 1 range))
11821                            (cdr (car (cdr range))))))
11822              (setcdr range (cdr (cdr range))))
11823            ;; Adjust the first element to be the same as the lower limit. 
11824            (if (and (not (atom (car range))) 
11825                     (< (cdr (car range)) (car active)))
11826                (setcdr (car range) (1- (car active))))
11827            ;; Then we want to peel off any elements that are higher
11828            ;; than the upper active limit.  
11829            (let ((srange range))
11830              ;; Go past all legal elements.
11831              (while (and (cdr srange) 
11832                          (<= (or (and (atom (car (cdr srange)))
11833                                       (car (cdr srange)))
11834                                  (car (car (cdr srange)))) (cdr active)))
11835                (setq srange (cdr srange)))
11836              (if (cdr srange)
11837                  ;; Nuke all remaining illegal elements.
11838                  (setcdr srange nil))
11839
11840              ;; Adjust the final element.
11841              (if (and (not (atom (car srange)))
11842                       (> (cdr (car srange)) (cdr active)))
11843                  (setcdr (car srange) (cdr active))))
11844            ;; Compute the number of unread articles.
11845            (while range
11846              (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
11847                                          (cdr (car range))))
11848                                  (or (and (atom (car range)) (car range))
11849                                      (car (car range))))))
11850              (setq range (cdr range)))
11851            (setq num (max 0 (- (cdr active) num)))))
11852     (and info
11853          (progn
11854            (and (assq 'tick marked)
11855                 (inline (gnus-remove-illegal-marked-articles
11856                          (assq 'tick marked) (nth 2 info))))
11857            (and (assq 'dormant marked)
11858                 (inline (gnus-remove-illegal-marked-articles
11859                          (assq 'dormant marked) (nth 2 info))))
11860            (setcar
11861             (gnus-gethash (car info) gnus-newsrc-hashtb) 
11862             (setq num (max 0 (- num (length (cdr (assq 'tick marked)))
11863                                 (length (cdr (assq 'dormant marked)))))))))
11864     num))
11865
11866 (defun gnus-remove-illegal-marked-articles (marked ranges)
11867   (let ((m (cdr marked)))
11868     ;; Make sure that all ticked articles are a subset of the unread
11869     ;; articles. 
11870     (while m
11871       (if (gnus-member-of-range (car m) ranges)
11872           (setcdr marked (cdr m))
11873         (setq marked m))
11874       (setq m (cdr m)))))
11875
11876 (defun gnus-activate-newsgroup (group)
11877   (let ((method (gnus-find-method-for-group group))
11878         active)
11879     (and (or (gnus-server-opened method) (gnus-open-server method))
11880          (gnus-request-group group)
11881          (save-excursion
11882            (set-buffer nntp-server-buffer)
11883            (goto-char (point-min))
11884            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
11885                 (progn
11886                   (goto-char (match-beginning 1))
11887                   (gnus-sethash 
11888                    group (setq active (cons (read (current-buffer))
11889                                             (read (current-buffer))))
11890                    gnus-active-hashtb))
11891                 active)))))
11892
11893 (defun gnus-update-read-articles 
11894   (group unread unselected ticked &optional domarks replied expirable killed
11895          dormant bookmark score)
11896   "Update the list of read and ticked articles in GROUP using the
11897 UNREAD and TICKED lists.
11898 Note: UNSELECTED has to be sorted over `<'.
11899 Returns whether the updating was successful."
11900   (let* ((active (or gnus-newsgroup-active 
11901                      (gnus-gethash group gnus-active-hashtb)))
11902          (entry (gnus-gethash group gnus-newsrc-hashtb))
11903          (number (car entry))
11904          (info (nth 2 entry))
11905          (marked (nth 3 info))
11906          (prev 1)
11907          (unread (sort (copy-sequence unread) (function <)))
11908          last read)
11909     (if (or (not info) (not active))
11910         ;; There is no info on this group if it was, in fact,
11911         ;; killed. Gnus stores no information on killed groups, so
11912         ;; there's nothing to be done. 
11913         ;; One could store the information somewhere temporarily,
11914         ;; perhaps... Hmmm... 
11915         ()
11916       ;; Remove any negative articles numbers.
11917       (while (and unread (< (car unread) 0))
11918         (setq unread (cdr unread)))
11919       ;; Remove any expired article numbers
11920       (while (and unread (< (car unread) (car active)))
11921         (setq unread (cdr unread)))
11922       (while (and ticked (< (car ticked) (car active)))
11923         (setq ticked (cdr ticked)))
11924       (while (and dormant (< (car dormant) (car active)))
11925         (setq dormant (cdr dormant)))
11926       (setq unread (sort (append unselected unread) '<))
11927       ;; Set the number of unread articles in gnus-newsrc-hashtb.
11928       (setcar entry (max 0 (- (length unread) (length ticked) 
11929                               (length dormant))))
11930       ;; Compute the ranges of read articles by looking at the list of
11931       ;; unread articles.  
11932       (while unread
11933         (if (/= (car unread) prev)
11934             (setq read (cons (if (= prev (1- (car unread))) prev
11935                                (cons prev (1- (car unread)))) read)))
11936         (setq prev (1+ (car unread)))
11937         (setq unread (cdr unread)))
11938       (if (<= prev (cdr active))
11939           (setq read (cons (cons prev (cdr active)) read)))
11940       ;; Enter this list into the group info.
11941       (setcar (cdr (cdr info)) 
11942               (if (> (length read) 1) (nreverse read) read))
11943       ;; Enter the list of ticked articles.
11944       (gnus-set-marked-articles 
11945        info ticked
11946        (if domarks replied (cdr (assq 'reply marked)))
11947        (if domarks expirable (cdr (assq 'expire marked)))
11948        (if domarks killed (cdr (assq 'killed marked)))
11949        (if domarks dormant (cdr (assq 'dormant marked)))
11950        (if domarks bookmark (cdr (assq 'bookmark marked)))
11951        (if domarks score (cdr (assq 'score marked))))
11952       t)))
11953
11954 (defun gnus-make-articles-unread (group articles)
11955   "Mark ARTICLES in GROUP as unread."
11956   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
11957                           (gnus-gethash (gnus-group-real-name group)
11958                                         gnus-newsrc-hashtb))))
11959          (ranges (nth 2 info))
11960          news)
11961     (while articles
11962       (and (gnus-member-of-range (car articles) ranges)
11963            (setq news (cons (car articles) news)))
11964       (setq articles (cdr articles)))
11965     (if (not news)
11966         ()
11967       (setcar (nthcdr 2 info)
11968               (gnus-remove-from-range (nth 2 info) (nreverse news)))
11969       (gnus-group-update-group group t))))
11970
11971 (defun gnus-read-active-file ()
11972   "Get active file from NNTP server."
11973   (gnus-group-set-mode-line)
11974   (let ((methods (cons gnus-select-method gnus-secondary-select-methods))
11975         (not-first nil)
11976         list-type)
11977     (setq gnus-have-read-active-file nil)
11978     (save-excursion
11979       (set-buffer nntp-server-buffer)
11980       (while methods
11981         (let* ((where (nth 1 (car methods)))
11982                (mesg (format "Reading active file%s via %s..."
11983                              (if (and where (not (zerop (length where))))
11984                                  (concat " from " where) "")
11985                              (car (car methods)))))
11986           (gnus-message 5 mesg)
11987           (gnus-check-news-server (car methods))
11988           (cond 
11989            ((and (eq gnus-read-active-file 'some)
11990                  (gnus-check-backend-function
11991                   'retrieve-groups (car (car methods))))
11992             (let ((newsrc (cdr gnus-newsrc-alist))
11993                   groups)
11994               (while newsrc
11995                 (and (gnus-server-equal 
11996                       (gnus-find-method-for-group
11997                        (car (car newsrc)) (car newsrc))
11998                       (gnus-server-get-method nil (car methods)))
11999                      (setq groups (cons (car (car newsrc)) groups)))
12000                 (setq newsrc (cdr newsrc)))
12001               (setq list-type (gnus-retrieve-groups groups (car methods)))
12002               (cond ((not list-type)
12003                      (gnus-message 
12004                       1 "Cannot read partial active file from %s server." 
12005                       (car (car methods)))
12006                      (ding)
12007                      (sit-for 2))
12008                     ((eq list-type 'active)
12009                      (gnus-active-to-gnus-format (and not-first (car methods)))
12010                      (setq not-first t))
12011                     (t
12012                      (gnus-groups-to-gnus-format (and not-first (car methods)))
12013                      (setq not-first t)))))
12014            (t
12015             (if (not (gnus-request-list (car methods)))
12016                 (progn
12017                   (gnus-message 1 "Cannot read active file from %s server." 
12018                                 (car (car methods)))
12019                   (ding))
12020               (gnus-active-to-gnus-format 
12021                (and gnus-have-read-active-file (car methods)))
12022               (setq gnus-have-read-active-file t)
12023               (gnus-message 5 "%sdone" mesg)))))
12024         (setq methods (cdr methods))))))
12025
12026 ;; Read an active file and place the results in `gnus-active-hashtb'.
12027 (defun gnus-active-to-gnus-format (method &optional hashtb ignore-errors)
12028   (let ((cur (current-buffer))
12029         (hashtb (or hashtb 
12030                     (if method
12031                         gnus-active-hashtb
12032                       (setq gnus-active-hashtb
12033                             (gnus-make-hashtable 
12034                              (count-lines (point-min) (point-max))))))))
12035     ;; Delete unnecessary lines.
12036     (goto-char (point-min))
12037     (while (search-forward "\nto." nil t)
12038       (delete-region (1+ (match-beginning 0)) 
12039                      (progn (forward-line 1) (point))))
12040     (or (string= gnus-ignored-newsgroups "")
12041         (progn
12042           (goto-char (point-min))
12043           (delete-matching-lines gnus-ignored-newsgroups)))
12044     ;; If these are groups from a foreign select method, we insert the
12045     ;; group prefix in front of the group names. 
12046     (and method (not (eq method gnus-select-method))
12047          (let ((prefix (gnus-group-prefixed-name "" method)))
12048            (goto-char (point-min))
12049            (while (and (not (eobp))
12050                        (progn (insert prefix)
12051                               (zerop (forward-line 1)))))))
12052     (goto-char (point-min))
12053     ;; Store active file in hashtable.
12054     (goto-char (point-min))
12055     (if (string-match "%[oO]" gnus-group-line-format)
12056         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
12057         ;; If we want information on moderated groups, we use this
12058         ;; loop...   
12059         (let* ((mod-hashtb (make-vector 7 0))
12060                (m (intern "m" mod-hashtb))
12061                group max mod min)
12062           (while (not (eobp))
12063             (condition-case nil
12064                 (progn
12065                   (narrow-to-region (point) (gnus-point-at-eol))
12066                   (setq group (let ((obarray hashtb)) (read cur)))
12067                   (if (and (numberp (setq max (read cur)))
12068                            (numberp (setq min (read cur))))
12069                       (set group (cons min max))
12070                     (set group nil))
12071                   ;; Enter moderated groups into a list.
12072                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
12073                       (setq gnus-moderated-list 
12074                             (cons (symbol-name group) gnus-moderated-list))))
12075               (error nil))
12076             (widen)
12077             (forward-line 1)))
12078       ;; And if we do not care about moderation, we use this loop,
12079       ;; which is faster.
12080       (let (group max min)
12081         (while (not (eobp))
12082           (condition-case ()
12083               (progn
12084                 (narrow-to-region (point) (gnus-point-at-eol))
12085                 ;; group gets set to a symbol interned in the hash table
12086                 ;; (what a hack!!)
12087                 (setq group (let ((obarray hashtb)) (read cur)))
12088                 (if (and (numberp (setq max (read cur)))
12089                          (numberp (setq min (read cur))))
12090                     (set group (cons min max))
12091                   (set group nil)))
12092             (error 
12093              (progn 
12094                (if ignore-errors
12095                    (set group nil)
12096                  (ding) 
12097                  (gnus-message 3 "Warning - illegal active: %s"
12098                                (buffer-substring 
12099                                 (gnus-point-at-bol) (gnus-point-at-eol)))
12100                  nil))))
12101           (widen)
12102           (forward-line 1))))))
12103
12104 (defun gnus-groups-to-gnus-format (method &optional hashtb)
12105   ;; Parse a "groups" active file.
12106   (let ((cur (current-buffer))
12107         (hashtb (or hashtb 
12108                     (if method
12109                         gnus-active-hashtb
12110                       (setq gnus-active-hashtb
12111                             (gnus-make-hashtable 
12112                              (count-lines (point-min) (point-max)))))))
12113         (prefix (and method (not (eq method gnus-select-method))
12114                      (gnus-group-prefixed-name "" method))))
12115
12116     (goto-char (point-min))
12117     (condition-case ()
12118         ;; We split this into to separate loops, one with the prefix
12119         ;; and one without to speed the reading up somewhat.
12120         (if prefix
12121             (let (min max opoint)
12122               (while (not (eobp))
12123                 (read cur) (read cur)
12124                 (setq min (read cur)
12125                       max (read cur)
12126                       opoint (point))
12127                 (skip-chars-forward " \t")
12128                 (insert prefix)
12129                 (goto-char opoint)
12130                 (set (let ((obarray hashtb)) (read cur)) 
12131                      (cons min max))
12132                 (forward-line 1)))
12133           (let (min max opoint)
12134             (while (not (eobp))
12135               (if (= (following-char) ?2)
12136                   (progn
12137                     (read cur) (read cur)
12138                     (setq min (read cur)
12139                           max (read cur))
12140                     (set (let ((obarray hashtb)) (read cur)) 
12141                          (cons min max))))
12142               (forward-line 1))))
12143       (error 
12144        (progn (ding) (gnus-message 3 "Possible error in active file."))))))
12145
12146 (defun gnus-read-newsrc-file (&optional force)
12147   "Read startup file.
12148 If FORCE is non-nil, the .newsrc file is read."
12149   (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
12150   ;; Reset variables that might be defined in the .newsrc.eld file.
12151   (let ((variables gnus-variable-list))
12152     (while variables
12153       (set (car variables) nil)
12154       (setq variables (cdr variables))))
12155   (let* ((newsrc-file gnus-current-startup-file)
12156          (quick-file (concat newsrc-file ".el")))
12157     (save-excursion
12158       ;; We always load the .newsrc.eld file. If always contains
12159       ;; much information that can not be gotten from the .newsrc
12160       ;; file (ticked articles, killed groups, foreign methods, etc.)
12161       (gnus-read-newsrc-el-file quick-file)
12162  
12163       (if (or force
12164               (and (file-newer-than-file-p newsrc-file quick-file)
12165                    (file-newer-than-file-p newsrc-file 
12166                                            (concat quick-file "d")))
12167               (not gnus-newsrc-alist))
12168           ;; We read the .newsrc file. Note that if there if a
12169           ;; .newsrc.eld file exists, it has already been read, and
12170           ;; the `gnus-newsrc-hashtb' has been created. While reading
12171           ;; the .newsrc file, Gnus will only use the information it
12172           ;; can find there for changing the data already read -
12173           ;; ie. reading the .newsrc file will not trash the data
12174           ;; already read (except for read articles).
12175           (save-excursion
12176             (gnus-message 5 "Reading %s..." newsrc-file)
12177             (set-buffer (find-file-noselect newsrc-file))
12178             (buffer-disable-undo (current-buffer))
12179             (gnus-newsrc-to-gnus-format)
12180             (kill-buffer (current-buffer))
12181             (gnus-message 5 "Reading %s...done" newsrc-file))))))
12182
12183 (defun gnus-read-newsrc-el-file (file)
12184   (let ((ding-file (concat file "d")))
12185     ;; We always, always read the .eld file.
12186     (gnus-message 5 "Reading %s..." ding-file)
12187     (let (gnus-newsrc-assoc)
12188       (condition-case nil
12189           (load ding-file t t t)
12190         (error nil))
12191       (and gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))
12192     (let ((inhibit-quit t))
12193       (gnus-uncompress-newsrc-assoc))
12194     (gnus-make-hashtable-from-newsrc-alist)
12195     (if (not (file-newer-than-file-p file ding-file))
12196         ()
12197       ;; Old format quick file
12198       (gnus-message 5 "Reading %s..." file)
12199       ;; The .el file is newer than the .eld file, so we read that one
12200       ;; as well. 
12201       (gnus-read-old-newsrc-el-file file))))
12202
12203 ;; Parse the old-style quick startup file
12204 (defun gnus-read-old-newsrc-el-file (file)
12205   (let (newsrc killed marked group g m len info)
12206     (prog1
12207         (let ((gnus-killed-assoc nil)
12208               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
12209           (prog1
12210               (condition-case nil
12211                   (load file t t t)
12212                 (error nil))
12213             (setq newsrc gnus-newsrc-assoc
12214                   killed gnus-killed-assoc
12215                   marked gnus-marked-assoc)))
12216       (setq gnus-newsrc-alist nil)
12217       (while newsrc
12218         (setq group (car newsrc))
12219         (let ((info (nth 2 (gnus-gethash (car group) gnus-newsrc-hashtb))))
12220           (if info
12221               (progn
12222                 (setcar (nthcdr 2 info) (cdr (cdr group)))
12223                 (setcar (cdr info)
12224                         (if (nth 1 group) gnus-level-default-subscribed 
12225                           gnus-level-default-unsubscribed))
12226                 (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
12227             (setq gnus-newsrc-alist
12228                   (cons 
12229                    (setq info
12230                          (list (car group)
12231                                (if (nth 1 group) gnus-level-default-subscribed
12232                                  gnus-level-default-unsubscribed) 
12233                                (cdr (cdr group))))
12234                    gnus-newsrc-alist)))
12235           (if (setq m (assoc (car group) marked))
12236             (setcdr (cdr (cdr info)) (cons (list (cons 'tick (cdr m))) nil))))
12237         (setq newsrc (cdr newsrc)))
12238       (setq newsrc killed)
12239       (while newsrc
12240         (setcar newsrc (car (car newsrc)))
12241         (setq newsrc (cdr newsrc)))
12242       (setq gnus-killed-list killed))
12243     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
12244     (gnus-make-hashtable-from-newsrc-alist)))
12245       
12246 (defun gnus-make-newsrc-file (file)
12247   "Make server dependent file name by catenating FILE and server host name."
12248   (let* ((file (expand-file-name file nil))
12249          (real-file (concat file "-" (nth 1 gnus-select-method))))
12250     (if (file-exists-p real-file)
12251         real-file file)))
12252
12253 (defun gnus-uncompress-newsrc-assoc ()
12254   ;; Uncompress all lists of marked articles in the newsrc assoc.
12255   (let ((newsrc gnus-newsrc-alist)
12256         marked)
12257     (while newsrc
12258       (if (not (setq marked (nth 3 (car newsrc))))
12259           ()
12260         (while marked
12261           (or (eq 'score (car (car marked)))
12262               (eq 'bookmark (car (car marked)))
12263               (eq 'killed (car (car marked)))
12264               (setcdr (car marked) (gnus-uncompress-range (cdr (car marked)))))
12265           (setq marked (cdr marked))))
12266       (setq newsrc (cdr newsrc)))))
12267
12268 (defun gnus-compress-newsrc-assoc ()
12269   ;; Compress all lists of marked articles in the newsrc assoc.
12270   (let ((newsrc gnus-newsrc-alist)
12271         marked)
12272     (while newsrc
12273       (if (not (setq marked (nth 3 (car newsrc))))
12274           ()
12275         (while marked
12276           (or (eq 'score (car (car marked)))
12277               (eq 'bookmark (car (car marked)))
12278               (eq 'killed (car (car marked)))
12279               (setcdr (car marked) 
12280                       (gnus-compress-sequence (sort (cdr (car marked)) '<) t)))
12281           (setq marked (cdr marked))))
12282       (setq newsrc (cdr newsrc)))))
12283
12284 (defun gnus-newsrc-to-gnus-format ()
12285   (setq gnus-newsrc-options "")
12286   (or gnus-active-hashtb
12287       (setq gnus-active-hashtb (make-vector 4095 0)))
12288   (let ((buf (current-buffer))
12289         (already-read (> (length gnus-newsrc-alist) 1))
12290         group level subscribed info options-symbol newsrc
12291         symbol reads num1)
12292     (goto-char (point-min))
12293     ;; We intern the symbol `options' in the active hashtb so that we
12294     ;; can `eq' against it later.
12295     (setq options-symbol (intern "options" gnus-active-hashtb))
12296   
12297     (while (not (eobp))
12298       ;; We first read the first word on the line by narrowing and
12299       ;; then reading into `gnus-active-hashtb'.  Most groups will
12300       ;; already exist in that hashtb, so this will save some string
12301       ;; space.
12302       (narrow-to-region
12303        (point)
12304        (progn (skip-chars-forward "^ \t!:\n") (point)))
12305       (goto-char (point-min))
12306       (setq symbol 
12307             (and (/= (point-min) (point-max))
12308                  (let ((obarray gnus-active-hashtb)) (read buf))))
12309       (widen)
12310       ;; Now, the symbol we have read is either `options' or a group
12311       ;; name.  If it is an options line, we just add it to a string. 
12312       (cond 
12313        ((eq symbol options-symbol)
12314         (setq gnus-newsrc-options
12315               ;; This concatting is quite inefficient, but since our
12316               ;; thorough studies show that approx 99.37% of all
12317               ;; .newsrc files only contain a single options line, we
12318               ;; don't give a damn, frankly, my dear.
12319               (concat gnus-newsrc-options
12320                       (buffer-substring 
12321                        (gnus-point-at-bol)
12322                        ;; Options may continue on the next line.
12323                        (or (and (re-search-forward "^[^ \t]" nil 'move)
12324                                 (progn (beginning-of-line) (point)))
12325                            (point))))))
12326        (symbol
12327         ;; It was a group name.
12328         (setq subscribed (= (following-char) ?:)
12329               group (symbol-name symbol)
12330               reads nil)
12331         (if (eolp)
12332             ;; If the line ends here, this is clearly a buggy line, so
12333             ;; we put point a the beginning of line and let the cond
12334             ;; below do the error handling.
12335             (beginning-of-line)
12336           ;; We skip to the beginning of the ranges.
12337           (skip-chars-forward "!: \t"))
12338         ;; We are now at the beginning of the list of read articles.
12339         ;; We read them range by range.
12340         (while
12341             (cond 
12342              ((looking-at "[0-9]+")
12343               ;; We narrow and read a number instead of buffer-substring/
12344               ;; string-to-int because it's faster. narrow/widen is
12345               ;; faster than save-restriction/narrow, and save-restriction
12346               ;; produces a garbage object.
12347               (setq num1 (progn
12348                            (narrow-to-region (match-beginning 0) (match-end 0))
12349                            (read buf)))
12350               (widen)
12351               ;; If the next character is a dash, then this is a range.
12352               (if (= (following-char) ?-)
12353                   (progn
12354                     ;; We read the upper bound of the range.
12355                     (forward-char 1)
12356                     (if (not (looking-at "[0-9]+"))
12357                         ;; This is a buggy line, by we pretend that
12358                         ;; it's kinda OK. Perhaps the user should be
12359                         ;; dinged? 
12360                         (setq reads (cons num1 reads))
12361                       (setq reads 
12362                             (cons 
12363                              (cons num1 (progn
12364                                           (narrow-to-region (match-beginning 0) 
12365                                                             (match-end 0))
12366                                           (read buf)))
12367                              reads))
12368                       (widen)))
12369                 ;; It was just a simple number, so we add it to the
12370                 ;; list of ranges.
12371                 (setq reads (cons num1 reads)))
12372               ;; If the next char in ?\n, then we have reached the end
12373               ;; of the line and return nil.
12374               (/= (following-char) ?\n))
12375              ((= (following-char) ?\n)
12376               ;; End of line, so we end.
12377               nil)
12378              (t
12379               ;; Not numbers and not eol, so this might be a buggy
12380               ;; line... 
12381               (or (eobp) ; If it was eob instead of ?\n, we allow it.
12382                   (progn
12383                     ;; The line was buggy.
12384                     (setq group nil)
12385                     (gnus-message 3 "Mangled line: %s" 
12386                                   (buffer-substring (gnus-point-at-bol) 
12387                                                     (gnus-point-at-eol)))
12388                     (ding)
12389                     (sit-for 1)))
12390               nil))
12391           ;; Skip past ", ". Spaces are illegal in these ranges, but
12392           ;; we allow them, because it's a common mistake to put a
12393           ;; space after the comma.
12394           (skip-chars-forward ", "))
12395
12396         ;; We have already read .newsrc.eld, so we gently update the
12397         ;; data in the hash table with the information we have just
12398         ;; read. 
12399         (if (not group)
12400             ()
12401           (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
12402                 level)
12403             (if info
12404                 ;; There is an entry for this file in the alist.
12405                 (progn
12406                   (setcar (nthcdr 2 info) (nreverse reads))
12407                   ;; We update the level very gently.  In fact, we
12408                   ;; only change it if there's been a status change
12409                   ;; from subscribed to unsubscribed, or vice versa.
12410                   (setq level (nth 1 info))
12411                   (cond ((and (<= level gnus-level-subscribed)
12412                               (not subscribed))
12413                          (setq level (if reads
12414                                          gnus-level-default-unsubscribed 
12415                                        (1+ gnus-level-default-unsubscribed))))
12416                         ((and (> level gnus-level-subscribed) subscribed)
12417                          (setq level gnus-level-default-subscribed)))
12418                   (setcar (cdr info) level))
12419               ;; This is a new group.
12420               (setq info (list group 
12421                                (if subscribed
12422                                    gnus-level-default-subscribed 
12423                                  (if reads
12424                                      (1+ gnus-level-subscribed)
12425                                    gnus-level-default-unsubscribed))
12426                                (nreverse reads))))
12427             (setq newsrc (cons info newsrc))))))
12428       (forward-line 1))
12429     
12430     (setq newsrc (nreverse newsrc))
12431
12432     (if (not already-read)
12433         ()
12434       ;; We now have two newsrc lists - `newsrc', which is what we
12435       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
12436       ;; what we've read from .newsrc.eld. We have to merge these
12437       ;; lists. We do this by "attaching" any (foreign) groups in the
12438       ;; gnus-newsrc-alist to the (native) group that precedes them. 
12439       (let ((rc (cdr gnus-newsrc-alist))
12440             (prev gnus-newsrc-alist)
12441             entry mentry)
12442         (while rc
12443           (or (assoc (car (car rc)) newsrc) ; It's already in the alist.
12444               (null (nth 4 (car rc))) ; It's a native group.
12445               (if (setq entry (assoc (car (car prev)) newsrc))
12446                   (setcdr (setq mentry (memq entry newsrc))
12447                           (cons (car rc) (cdr mentry)))
12448                 (setq newsrc (cons (car rc) newsrc))))
12449           (setq prev rc
12450                 rc (cdr rc)))))
12451
12452     (setq gnus-newsrc-alist newsrc)
12453     ;; We make the newsrc hashtb.
12454     (gnus-make-hashtable-from-newsrc-alist)
12455
12456     ;; Finally, if we read some options lines, we parse them.
12457     (or (string= gnus-newsrc-options "")
12458         (gnus-newsrc-parse-options gnus-newsrc-options))))
12459
12460 ;; Parse options lines to find "options -n !all rec.all" and stuff.
12461 ;; The return value will be a list on the form
12462 ;; ((regexp1 . ignore)
12463 ;;  (regexp2 . subscribe)...)
12464 ;; When handling new newsgroups, groups that match a `ignore' regexp
12465 ;; will be ignored, and groups that match a `subscribe' regexp will be
12466 ;; subscribed. A line like
12467 ;; options -n !all rec.all
12468 ;; will lead to a list that looks like
12469 ;; (("^rec\\..+" . subscribe) 
12470 ;;  ("^.+" . ignore))
12471 ;; So all "rec.*" groups will be subscribed, while all the other
12472 ;; groups will be ignored. Note that "options -n !all rec.all" is very
12473 ;; different from "options -n rec.all !all". 
12474 (defun gnus-newsrc-parse-options (options)
12475   (let (out eol)
12476     (save-excursion
12477       (gnus-set-work-buffer)
12478       (insert (regexp-quote options))
12479       ;; First we treat all continuation lines.
12480       (goto-char (point-min))
12481       (while (re-search-forward "\n[ \t]+" nil t)
12482         (replace-match " " t t))
12483       ;; Then we transform all "all"s into ".+"s.
12484       (goto-char (point-min))
12485       (while (re-search-forward "\\ball\\b" nil t)
12486         (replace-match ".+" t t))
12487       (goto-char (point-min))
12488       ;; We remove all other options than the "-n" ones.
12489       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
12490         (replace-match " ")
12491         (forward-char -1))
12492       (goto-char (point-min))
12493
12494       ;; We are only interested in "options -n" lines - we
12495       ;; ignore the other option lines.
12496       (while (re-search-forward "[ \t]-n" nil t)
12497         (setq eol 
12498               (or (save-excursion
12499                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
12500                          (- (point) 2)))
12501                   (gnus-point-at-eol)))
12502         ;; Search for all "words"...
12503         (while (re-search-forward "[^ \t,\n-]+" eol t)
12504           (if (= (char-after (match-beginning 0)) ?!)
12505               ;; If the word begins with a bang (!), this is a "not"
12506               ;; spec. We put this spec (minus the bang) and the
12507               ;; symbol `ignore' into the list.
12508               (setq out (cons (cons (concat 
12509                                      "^" (buffer-substring 
12510                                           (1+ (match-beginning 0))
12511                                           (match-end 0)))
12512                                     'ignore) out))
12513             ;; There was no bang, so this is a "yes" spec.
12514             (setq out (cons (cons (concat 
12515                                    "^" (buffer-substring (match-beginning 0)
12516                                                          (match-end 0)))
12517                                   'subscribe) out)))))
12518     
12519       (setq gnus-newsrc-options-n out))))
12520                
12521
12522 (defun gnus-save-newsrc-file ()
12523   "Save .newsrc file."
12524   ;; Note: We cannot save .newsrc file if all newsgroups are removed
12525   ;; from the variable gnus-newsrc-alist.
12526   (and (or gnus-newsrc-alist gnus-killed-list)
12527        gnus-current-startup-file
12528        (let ((make-backup-files t)
12529              (version-control nil)
12530              (require-final-newline t)) ;Don't ask even if requested.
12531          ;; You can stop or change version control of backup file.
12532          ;; Suggested by jason@violet.berkeley.edu.
12533          (run-hooks 'gnus-save-newsrc-hook)
12534          (save-excursion
12535            (if (or (not gnus-dribble-buffer)
12536                    (not (buffer-name gnus-dribble-buffer))
12537                    (zerop (save-excursion
12538                             (set-buffer gnus-dribble-buffer)
12539                             (buffer-size))))
12540                (gnus-message 4 "(No changes need to be saved)")
12541              (if gnus-save-newsrc-file
12542                  (progn
12543                    (gnus-message 5 "Saving %s..." gnus-current-startup-file)
12544                    ;; Make backup file of master newsrc.
12545                    (gnus-gnus-to-newsrc-format)
12546                    (gnus-message 5 "Saving %s...done"
12547                                  gnus-current-startup-file)))
12548              ;; Quickly loadable .newsrc.
12549              (set-buffer (get-buffer-create " *Gnus-newsrc*"))
12550              (gnus-add-current-to-buffer-list)
12551              (buffer-disable-undo (current-buffer))
12552              (erase-buffer)
12553              (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
12554              (gnus-gnus-to-quick-newsrc-format)
12555              (write-region 1 (point-max) 
12556                            (concat gnus-current-startup-file ".eld") 
12557                            nil 'nomesg)
12558              (kill-buffer (current-buffer))
12559              (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)
12560              (gnus-dribble-delete-file))))))
12561
12562 (defun gnus-gnus-to-quick-newsrc-format ()
12563   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
12564   (insert ";; (ding) Gnus startup file.\n")
12565   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
12566   (insert ";; to read .newsrc.\n")
12567   (let ((variables gnus-variable-list)
12568         (inhibit-quit t)
12569         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
12570         variable)
12571     ;; insert lisp expressions.
12572     (gnus-compress-newsrc-assoc)
12573     (while variables
12574       (setq variable (car variables))
12575       (and (boundp variable)
12576            (symbol-value variable)
12577            (or gnus-save-killed-list (not (eq variable 'gnus-killed-list)))
12578            (insert "(setq " (symbol-name variable) " '"
12579                    (prin1-to-string (symbol-value variable))
12580                    ")\n"))
12581       (setq variables (cdr variables)))
12582     (gnus-uncompress-newsrc-assoc)))
12583
12584
12585 (defun gnus-gnus-to-newsrc-format ()
12586   ;; Generate and save the .newsrc file.
12587   (let ((newsrc (cdr gnus-newsrc-alist))
12588         info ranges range)
12589     (save-excursion
12590       (set-buffer (create-file-buffer gnus-startup-file))
12591       (buffer-disable-undo (current-buffer))
12592       (erase-buffer)
12593       ;; Write options.
12594       (if gnus-newsrc-options (insert gnus-newsrc-options))
12595       ;; Write subscribed and unsubscribed.
12596       (while newsrc
12597         (setq info (car newsrc))
12598         (if (not (nth 4 info))          ;Don't write foreign groups to .newsrc.
12599             (progn
12600               (insert (car info) (if (> (nth 1 info) gnus-level-subscribed)
12601                                      "!" ":"))
12602               (if (setq ranges (nth 2 info))
12603                   (progn
12604                     (insert " ")
12605                     (if (not (listp (cdr ranges)))
12606                         (if (= (car ranges) (cdr ranges))
12607                             (insert (int-to-string (car ranges)))
12608                           (insert (int-to-string (car ranges)) "-" 
12609                                   (int-to-string (cdr ranges))))
12610                       (while ranges
12611                         (setq range (car ranges)
12612                               ranges (cdr ranges))
12613                         (if (or (atom range) (= (car range) (cdr range)))
12614                             (insert (int-to-string 
12615                                      (or (and (atom range) range) 
12616                                          (car range))))
12617                           (insert (int-to-string (car range)) "-"
12618                                   (int-to-string (cdr range))))
12619                         (if ranges (insert ","))))))
12620               (insert "\n")))
12621         (setq newsrc (cdr newsrc)))
12622       (write-region 1 (point-max) gnus-current-startup-file nil 'nomesg)
12623       (kill-buffer (current-buffer)))))
12624
12625 (defun gnus-read-all-descriptions-files ()
12626   (let ((methods (nconc (list gnus-select-method) 
12627                         gnus-secondary-select-methods)))
12628     (while methods
12629       (gnus-read-descriptions-file (car methods))
12630       (setq methods (cdr methods)))
12631     t))
12632
12633 (defun gnus-read-descriptions-file (&optional method)
12634   (let ((method (or method gnus-select-method)))
12635     ;; We create the hashtable whether we manage to read the desc file
12636     ;; to avoid trying to re-read after a failed read.
12637     (or gnus-description-hashtb
12638         (setq gnus-description-hashtb 
12639               (gnus-make-hashtable (length gnus-active-hashtb))))
12640     ;; Mark this method's desc file as read.
12641     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
12642                   gnus-description-hashtb)
12643
12644     (gnus-message 5 "Reading descriptions file via %s..." (car method))
12645     (cond 
12646      ((not (or (gnus-server-opened method)
12647                (gnus-open-server method)))
12648       (gnus-message 1 "Couldn't open server")
12649       nil)
12650      ((not (gnus-request-list-newsgroups method))
12651       (gnus-message 1 "Couldn't read newsgroups descriptions")
12652       nil)
12653      (t
12654       (let (group)
12655         (save-excursion
12656           (save-restriction
12657             (set-buffer nntp-server-buffer)
12658             (goto-char (point-min))
12659             (if (or (search-forward "\n.\n" nil t)
12660                     (goto-char (point-max)))
12661                 (progn
12662                   (beginning-of-line)
12663                   (narrow-to-region (point-min) (point))))
12664             (goto-char (point-min))
12665             (while (not (eobp))
12666               ;; If we get an error, we set group to 0, which is not a
12667               ;; symbol... 
12668               (setq group 
12669                     (condition-case ()
12670                         (let ((obarray gnus-description-hashtb))
12671                           ;; Group is set to a symbol interned in this
12672                           ;; hash table.
12673                           (read nntp-server-buffer))
12674                       (error 0)))
12675               (skip-chars-forward " \t")
12676               ;; ... which leads to this line being effectively ignored.
12677               (and (symbolp group)
12678                    (set group (buffer-substring 
12679                                (point) (progn (end-of-line) (point)))))
12680               (forward-line 1))))
12681         (gnus-message 5 "Reading descriptions file...done")
12682         t)))))
12683
12684 (defun gnus-group-get-description (group)
12685   ;; Get the description of a group by sending XGTITLE to the server.
12686   (and (gnus-request-group-description group)
12687        (save-excursion
12688          (set-buffer nntp-server-buffer)
12689          (goto-char (point-min))
12690          (and (looking-at "[^ \t]+[ \t]+\\(.*\\)")
12691               (buffer-substring (match-beginning 1) (match-end 1))))))
12692
12693 ;;;
12694 ;;; Server
12695 ;;;
12696
12697 (defvar gnus-server-mode-hook nil
12698   "Hook run in `gnus-server-mode' buffers.")
12699
12700 (defconst gnus-server-line-format "     {%(%h:%w%)}\n"
12701   "Format of server lines.
12702 It works along the same lines as a normal formatting string,
12703 with some simple extensions.")
12704
12705 (defvar gnus-server-mode-line-format "(ding) List of servers"
12706   "The format specification for the server mode line.")
12707
12708 (defconst gnus-server-line-format-alist
12709   (list (list ?h 'how ?s)
12710         (list ?n 'name ?s)
12711         (list ?w 'where ?s)
12712         ))
12713
12714 (defconst gnus-server-mode-line-format-alist 
12715   (list (list ?S 'news-server ?s)
12716         (list ?M 'news-method ?s)
12717         (list ?u 'user-defined ?s)))
12718
12719 (defvar gnus-server-line-format-spec nil)
12720 (defvar gnus-server-mode-line-format-spec nil)
12721 (defvar gnus-server-killed-servers nil)
12722
12723 (defvar gnus-server-mode-map nil)
12724 (put 'gnus-server-mode 'mode-class 'special)
12725
12726 (if gnus-server-mode-map
12727     nil
12728   (setq gnus-server-mode-map (make-sparse-keymap))
12729   (suppress-keymap gnus-server-mode-map)
12730   (define-key gnus-server-mode-map " " 'gnus-server-read-server)
12731   (define-key gnus-server-mode-map "\r" 'gnus-server-read-server)
12732   (define-key gnus-server-mode-map gnus-mouse-2 'gnus-server-pick-server)
12733   (define-key gnus-server-mode-map "q" 'gnus-server-exit)
12734   (define-key gnus-server-mode-map "l" 'gnus-server-list-servers)
12735   (define-key gnus-server-mode-map "k" 'gnus-server-kill-server)
12736   (define-key gnus-server-mode-map "y" 'gnus-server-yank-server)
12737   (define-key gnus-server-mode-map "c" 'gnus-server-copy-server)
12738   (define-key gnus-server-mode-map "a" 'gnus-server-add-server)
12739   (define-key gnus-server-mode-map "e" 'gnus-server-edit-server))
12740
12741 (defun gnus-server-mode ()
12742   "Major mode for listing and editing servers.
12743
12744 All normal editing commands are switched off.
12745 \\<gnus-server-mode-map>
12746
12747 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). 
12748
12749 The following commands are available:
12750
12751 \\{gnus-server-mode-map}"
12752   (interactive)
12753   (if gnus-visual (gnus-server-make-menu-bar))
12754   (kill-all-local-variables)
12755   (setq mode-line-modified "-- ")
12756   (make-local-variable 'mode-line-format)
12757   (setq mode-line-format (copy-sequence mode-line-format))
12758   (and (equal (nth 3 mode-line-format) "   ")
12759        (setcar (nthcdr 3 mode-line-format) ""))
12760   (setq major-mode 'gnus-server-mode)
12761   (setq mode-name "Server")
12762 ;  (gnus-group-set-mode-line)
12763   (setq mode-line-process nil)
12764   (use-local-map gnus-server-mode-map)
12765   (buffer-disable-undo (current-buffer))
12766   (setq truncate-lines t)
12767   (setq buffer-read-only t)
12768   (run-hooks 'gnus-server-mode-hook))
12769
12770 (defun gnus-server-insert-server-line (sformat name method)
12771   (let* ((sformat (or sformat gnus-server-line-format-spec))
12772          (how (car method))
12773          (where (nth 1 method))
12774          b)
12775     (beginning-of-line)
12776     (setq b (point))
12777     ;; Insert the text.
12778     (insert (eval sformat))
12779     (add-text-properties 
12780      b (1+ b) (list 'gnus-server (intern name)))))
12781
12782 (defun gnus-server-setup-buffer ()
12783   (if (get-buffer gnus-server-buffer)
12784       ()
12785     (save-excursion
12786       (set-buffer (get-buffer-create gnus-server-buffer))
12787       (gnus-server-mode)
12788       (and gnus-carpal (gnus-carpal-setup-buffer 'server)))))
12789
12790 (defun gnus-server-prepare ()
12791   (setq gnus-server-mode-line-format-spec 
12792         (gnus-parse-format gnus-server-mode-line-format 
12793                            gnus-server-mode-line-format-alist))
12794   (setq gnus-server-line-format-spec 
12795         (gnus-parse-format gnus-server-line-format 
12796                            gnus-server-line-format-alist))
12797   (let ((alist gnus-server-alist)
12798         (buffer-read-only nil))
12799     (erase-buffer)
12800     (while alist
12801       (gnus-server-insert-server-line nil (car (car alist)) (cdr (car alist)))
12802       (setq alist (cdr alist))))
12803   (goto-char (point-min))
12804   (gnus-server-position-cursor))
12805
12806 (defun gnus-server-server-name ()
12807   (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server)))
12808     (and server (symbol-name server))))
12809
12810 (defalias 'gnus-server-position-cursor 'gnus-goto-colon)
12811
12812 (defconst gnus-server-edit-buffer "*Gnus edit server*")
12813
12814 (defun gnus-server-update-server (server)
12815   (save-excursion
12816     (set-buffer gnus-server-buffer)
12817     (let ((buffer-read-only nil)
12818           (info (cdr (assoc server gnus-server-alist))))
12819       (gnus-dribble-enter 
12820        (concat "(gnus-server-set-info \"" server "\" '"
12821                (prin1-to-string info) ")"))
12822       ;; Buffer may be narrowed.
12823       (save-restriction
12824         (widen)
12825         (if (gnus-server-goto-server server)
12826             (delete-region (progn (beginning-of-line) (point))
12827                            (progn (forward-line 1) (point))))
12828         (let ((entry (assoc server gnus-server-alist)))
12829           (gnus-server-insert-server-line nil (car entry) (cdr entry))
12830           (gnus-server-position-cursor))))))
12831
12832 (defun gnus-server-set-info (server info)
12833   ;; Enter a select method into the virtual server alist.
12834   (gnus-dribble-enter 
12835    (concat "(gnus-server-set-info \"" server "\" '"
12836            (prin1-to-string info) ")"))
12837   (let* ((server (nth 1 info))
12838          (entry (assoc server gnus-server-alist)))
12839     (if entry (setcdr entry info)
12840       (setq gnus-server-alist
12841             (nconc gnus-server-alist (list (cons server info)))))))
12842
12843 (defun gnus-server-to-method (server)
12844   ;; Map virtual server names to select methods.
12845   (or (and (equal server "native") gnus-select-method)
12846       (cdr (assoc server gnus-server-alist))))
12847
12848 (defun gnus-server-extend-method (group method)
12849   ;; This function "extends" a virtual server.  If the server is
12850   ;; "hello", and the select method is ("hello" (my-var "something")) 
12851   ;; in the group "alt.alt", this will result in a new virtual server
12852   ;; called "helly+alt.alt".
12853   (let ((entry
12854          (gnus-copy-sequence 
12855           (if (equal (car method) "native") gnus-select-method
12856               (cdr (assoc (car method) gnus-server-alist))))))
12857     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
12858     (nconc entry (cdr method))))
12859
12860 (defun gnus-server-get-method (group method)
12861   ;; Input either a server name, and extended server name, or a
12862   ;; select method, and return a select method. 
12863   (cond ((stringp method)
12864          (gnus-server-to-method method))
12865         ((stringp (car method))
12866          (gnus-server-extend-method group method))
12867         (t
12868          (gnus-server-add-address method))))
12869
12870 (defun gnus-server-add-address (method)
12871   (let ((method-name (symbol-name (car method))))
12872     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
12873              (not (assq (intern (concat method-name "-address")) method)))
12874         (append method (list (list (intern (concat method-name "-address"))
12875                                    (nth 1 method))))
12876       method)))
12877
12878 (defun gnus-server-equal (s1 s2)
12879   (or (equal s1 s2)
12880       (and (= (length s1) (length s2))
12881            (progn
12882              (while (and s1 (member (car s1) s2))
12883                (setq s1 (cdr s1)))
12884              (null s1)))))
12885
12886 ;;; Interactive server functions.
12887
12888 (defun gnus-server-kill-server (server)
12889   "Kill the server on the current line."
12890   (interactive (list (gnus-server-server-name)))
12891   (or (gnus-server-goto-server server)
12892       (if server (error "No such server: %s" server)
12893         (error "No server on the current line")))
12894   (let ((buffer-read-only nil))
12895     (delete-region (progn (beginning-of-line) (point))
12896                    (progn (forward-line 1) (point))))
12897   (setq gnus-server-killed-servers 
12898         (cons (assoc server gnus-server-alist) gnus-server-killed-servers))
12899   (setq gnus-server-alist (delq (car gnus-server-killed-servers)
12900                                 gnus-server-alist))
12901   (gnus-server-position-cursor))
12902
12903 (defun gnus-server-yank-server ()
12904   "Yank the previously killed server."
12905   (interactive)
12906   (or gnus-server-killed-servers
12907       (error "No killed servers to be yanked"))
12908   (let ((alist gnus-server-alist)
12909         (server (gnus-server-server-name))
12910         (killed (car gnus-server-killed-servers)))
12911     (if (not server) 
12912         (setq gnus-server-alist (nconc gnus-server-alist (list killed)))
12913       (if (string= server (car (car gnus-server-alist)))
12914           (setq gnus-server-alist (cons killed gnus-server-alist))
12915         (while (and (cdr alist)
12916                     (not (string= server (car (car (cdr alist))))))
12917           (setq alist (cdr alist)))
12918         (setcdr alist (cons killed (cdr alist)))))
12919     (gnus-server-update-server (car killed))
12920     (setq gnus-server-killed-servers (cdr gnus-server-killed-servers))
12921     (gnus-server-position-cursor)))
12922
12923 (defun gnus-server-exit ()
12924   "Return to the group buffer."
12925   (interactive)
12926   (kill-buffer (current-buffer))
12927   (switch-to-buffer gnus-group-buffer))
12928
12929 (defun gnus-server-list-servers ()
12930   "List all available servers."
12931   (interactive)
12932   (let ((cur (gnus-server-server-name)))
12933     (gnus-server-prepare)
12934     (if cur (gnus-server-goto-server cur)
12935       (goto-char (point-max))
12936       (forward-line -1))
12937     (gnus-server-position-cursor)))
12938
12939 (defun gnus-server-copy-server (from to)
12940   (interactive
12941    (list
12942     (or (gnus-server-server-name)
12943         (error "No server on the current line"))
12944     (read-string "Copy to: ")))
12945   (or from (error "No server on current line"))
12946   (or (and to (not (string= to ""))) (error "No name to copy to"))
12947   (and (assoc to gnus-server-alist) (error "%s already exists" to))
12948   (or (assoc from gnus-server-alist) 
12949       (error "%s: no such server" from))
12950   (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist))))
12951     (setcar to-entry to)
12952     (setcar (nthcdr 2 to-entry) to)
12953     (setq gnus-server-killed-servers 
12954           (cons to-entry gnus-server-killed-servers))
12955     (gnus-server-yank-server)))
12956
12957 (defun gnus-server-add-server (how where)
12958   (interactive 
12959    (list (intern (completing-read "Server method: "
12960                                   gnus-valid-select-methods nil t))
12961          (read-string "Server name: ")))
12962   (setq gnus-server-killed-servers 
12963         (cons (list where how where) gnus-server-killed-servers))
12964   (gnus-server-yank-server))
12965
12966 (defun gnus-server-goto-server (server)
12967   "Jump to a server line."
12968   (interactive
12969    (list (completing-read "Goto server: " gnus-server-alist nil t)))
12970   (let ((to (text-property-any (point-min) (point-max) 
12971                                'gnus-server (intern server))))
12972     (and to
12973          (progn
12974            (goto-char to) 
12975            (gnus-server-position-cursor)))))
12976
12977 (defun gnus-server-edit-server (server)
12978   "Edit the server on the current line."
12979   (interactive (list (gnus-server-server-name)))
12980   (or server
12981       (error "No server on current line"))
12982   (let ((winconf (current-window-configuration)))
12983     (get-buffer-create gnus-server-edit-buffer)
12984     (gnus-configure-windows 'edit-server)
12985     (gnus-add-current-to-buffer-list)
12986     (emacs-lisp-mode)
12987     (make-local-variable 'gnus-prev-winconf)
12988     (setq gnus-prev-winconf winconf)
12989     (use-local-map (copy-keymap (current-local-map)))
12990     (let ((done-func '(lambda () 
12991                         "Exit editing mode and update the information."
12992                         (interactive)
12993                         (gnus-server-edit-server-done 'group))))
12994       (setcar (cdr (nth 4 done-func)) server)
12995       (local-set-key "\C-c\C-c" done-func))
12996     (erase-buffer)
12997     (insert ";; Type `C-c C-c' after you have edited the server.\n\n")
12998     (insert (pp-to-string (cdr (assoc server gnus-server-alist))))))
12999
13000 (defun gnus-server-edit-server-done (server)
13001   (interactive)
13002   (set-buffer (get-buffer-create gnus-server-edit-buffer))
13003   (goto-char (point-min))
13004   (let ((form (read (current-buffer)))
13005         (winconf gnus-prev-winconf))
13006     (gnus-server-set-info server form)
13007     (kill-buffer (current-buffer))
13008     (and winconf (set-window-configuration winconf))
13009     (set-buffer gnus-server-buffer)
13010     (gnus-server-update-server (gnus-server-server-name))
13011     (gnus-server-position-cursor)))
13012
13013 (defun gnus-server-read-server (server)
13014   "Browse a server."
13015   (interactive (list (gnus-server-server-name)))
13016   (gnus-browse-foreign-server (gnus-server-to-method server) (current-buffer)))
13017
13018 (defun gnus-mouse-pick-server (e)
13019   (interactive "e")
13020   (mouse-set-point e)
13021   (gnus-server-read-server (gnus-server-server-name)))
13022
13023 ;;;
13024 ;;; entry points into gnus-score.el
13025 ;;;
13026
13027 ;;; Finding score files. 
13028
13029 (defvar gnus-global-score-files nil
13030   "*List of global score files and directories.
13031 Set this variable if you want to use people's score files.  One entry
13032 for each score file or each score file directory.  Gnus will decide
13033 by itself what score files are applicable to which group.
13034
13035 Say you want to use the single score file
13036 \"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
13037 score files in the \"/ftp.some-where:/pub/score\" directory.
13038
13039  (setq gnus-global-score-files
13040        '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
13041          \"/ftp.some-where:/pub/score\"))")
13042
13043 (defun gnus-score-score-files (group)
13044   "Return a list of all possible score files."
13045   ;; Search and set any global score files.
13046   (and gnus-global-score-files 
13047        (or gnus-internal-global-score-files
13048            (gnus-score-search-global-directories gnus-global-score-files)))
13049   ;; Fix the kill-file dir variable.
13050   (setq gnus-kill-files-directory 
13051         (file-name-as-directory
13052          (or gnus-kill-files-directory "~/News/")))
13053   ;; If we can't read it, there are no score files.
13054   (if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
13055       (setq gnus-score-file-list nil)
13056     (if (gnus-use-long-file-name 'not-score)
13057         ;; We want long file names.
13058         (if (or (not gnus-score-file-list)
13059                 (not (car gnus-score-file-list))
13060                 (gnus-file-newer-than gnus-kill-files-directory
13061                                       (car gnus-score-file-list)))
13062               (setq gnus-score-file-list 
13063                     (cons (nth 5 (file-attributes gnus-kill-files-directory))
13064                           (nreverse 
13065                            (directory-files 
13066                             gnus-kill-files-directory t 
13067                             (gnus-score-file-regexp))))))
13068       ;; We do not use long file names, so we have to do some
13069       ;; directory traversing.  
13070       (let ((mdir (length (expand-file-name gnus-kill-files-directory)))
13071             (suffixes (list gnus-score-file-suffix gnus-adaptive-file-suffix))
13072             dir files suffix)
13073         (while suffixes
13074           (setq dir (expand-file-name
13075                      (concat gnus-kill-files-directory
13076                              (gnus-replace-chars-in-string group ?. ?/))))
13077           (setq suffix (car suffixes)
13078                 suffixes (cdr suffixes))
13079           (if (file-exists-p (concat dir "/" suffix))
13080               (setq files (cons (concat dir "/" suffix) files)))
13081           (while (>= (1+ (length dir)) mdir)
13082             (and (file-exists-p (concat dir "/all/" suffix))
13083                  (setq files (cons (concat dir "/all/" suffix) files)))
13084             (string-match "/[^/]*$" dir)
13085             (setq dir (substring dir 0 (match-beginning 0)))))
13086         (setq gnus-score-file-list 
13087               (cons nil (nreverse files)))))
13088     (cdr gnus-score-file-list)))
13089
13090 (defun gnus-score-file-regexp ()
13091   (concat "\\(" gnus-score-file-suffix 
13092           "\\|" gnus-adaptive-file-suffix "\\)$"))
13093         
13094 (defun gnus-score-find-bnews (group)
13095   "Return a list of score files for GROUP.
13096 The score files are those files in the ~/News directory which matches
13097 GROUP using BNews sys file syntax."
13098   (let* ((sfiles (append (gnus-score-score-files group)
13099                          gnus-internal-global-score-files))
13100          (kill-dir (file-name-as-directory 
13101                     (expand-file-name gnus-kill-files-directory)))
13102          (klen (length kill-dir))
13103          ofiles not-match regexp)
13104     (save-excursion
13105       (set-buffer (get-buffer-create "*gnus score files*"))
13106       (buffer-disable-undo (current-buffer))
13107       ;; Go through all score file names and create regexp with them
13108       ;; as the source.  
13109       (while sfiles
13110         (erase-buffer)
13111         (insert (car sfiles))
13112         (goto-char (point-min))
13113         ;; First remove the suffix itself.
13114         (re-search-forward (concat "." (gnus-score-file-regexp)))
13115         (replace-match "" t t) 
13116         (goto-char (point-min))
13117         (if (looking-at (regexp-quote kill-dir))
13118             ;; If the file name was just "SCORE", `klen' is one character
13119             ;; too much.
13120             (delete-char (min (1- (point-max)) klen))
13121           (goto-char (point-max))
13122           (search-backward "/")
13123           (delete-region (1+ (point)) (point-min)))
13124         ;; If short file names were used, we have to translate slashes.
13125         (goto-char (point-min))
13126         (while (search-forward "/" nil t)
13127           (replace-match "." t t))
13128         ;; Translate "all" to ".*".
13129         (while (search-forward "all" nil t)
13130           (replace-match ".*" t t))
13131         (goto-char (point-min))
13132         ;; Deal with "not."s.
13133         (if (looking-at "not.")
13134             (progn
13135               (setq not-match t)
13136               (setq regexp (buffer-substring 5 (point-max))))
13137           (setq regexp (buffer-substring 1 (point-max)))
13138           (setq not-match nil))
13139         ;; Finally - if this resulting regexp matches the group name,
13140         ;; we add this score file to the list of score files
13141         ;; applicable to this group.
13142         (if (or (and not-match
13143                      (not (string-match regexp group)))
13144                 (and (not not-match)
13145                      (string-match regexp group)))
13146             (setq ofiles (cons (car sfiles) ofiles)))
13147         (setq sfiles (cdr sfiles)))
13148       (kill-buffer (current-buffer))
13149       ;; Slight kludge here - the last score file returned should be
13150       ;; the local score file, whether it exists or not. This is so
13151       ;; that any score commands the user enters will go to the right
13152       ;; file, and not end up in some global score file.
13153       (let ((localscore
13154              (expand-file-name
13155               (if (gnus-use-long-file-name 'not-score)
13156                   (concat gnus-kill-files-directory group "." 
13157                           gnus-score-file-suffix)
13158                 (concat gnus-kill-files-directory
13159                         (gnus-replace-chars-in-string group ?. ?/)
13160                         "/" gnus-score-file-suffix)))))
13161         (and (member localscore ofiles)
13162              (delete localscore ofiles))
13163         (setq ofiles (cons localscore ofiles)))
13164       (nreverse ofiles))))
13165
13166 (defun gnus-score-find-single (group)
13167   "Return list containing the score file for GROUP."
13168   (list (gnus-score-file-name group gnus-adaptive-file-suffix)
13169         (gnus-score-file-name group)))
13170
13171 (defun gnus-score-find-hierarchical (group)
13172   "Return list of score files for GROUP.
13173 This includes the score file for the group and all its parents."
13174   (let ((all (copy-sequence '(nil)))
13175         (start 0))
13176     (while (string-match "\\." group (1+ start))
13177       (setq start (match-beginning 0))
13178       (setq all (cons (substring group 0 start) all)))
13179     (setq all (cons group all))
13180     (nconc
13181      (mapcar 'gnus-score-file-name (setq all (nreverse all))
13182              gnus-adaptive-file-suffix)
13183      (mapcar 'gnus-score-file-name all))))
13184
13185 (defvar gnus-score-file-alist-cache nil)
13186
13187 (defun gnus-score-find-alist (group)
13188   "Return list of score files for GROUP.
13189 The list is determined from the variable gnus-score-file-alist."
13190   (let ((alist gnus-score-file-multiple-match-alist)
13191         score-files)
13192     ;; if this group has been seen before, return the cached entry
13193     (if (setq score-files (assoc group gnus-score-file-alist-cache))
13194         (cdr score-files)       ; ensures caching of groups with no matches
13195       ;; handle the multiple match alist
13196       (while alist
13197         (and (string-match (car (car alist)) group)
13198              (setq score-files
13199                    (nconc score-files (cdr (car alist)))))
13200         (setq alist (cdr alist)))
13201       (setq alist gnus-score-file-single-match-alist)
13202       ;; handle the single match alist
13203       (catch 'done
13204         (while alist
13205           (and (string-match (car (car alist)) group)
13206                ;; progn used just in case ("regexp") has no files
13207                ;; and score-files is still nil. -sj
13208                ;; this can be construed as a "stop searching here" feature :>
13209                ;; and used to simplify regexps in the single-alist 
13210                (progn
13211                  (setq score-files
13212                        (nconc score-files (cdr (car alist))))
13213                  (throw 'done nil)))
13214           (setq alist (cdr alist))))
13215       ;; cache the score files
13216       (setq gnus-score-file-alist-cache
13217             (cons (cons group score-files) gnus-score-file-alist-cache))
13218       score-files)))
13219
13220
13221 (defun gnus-possibly-score-headers (&optional trace)
13222   (let ((func gnus-score-find-score-files-function)
13223         score-files scores)
13224     (and func (not (listp func))
13225          (setq func (list func)))
13226     ;; Go through all the functions for finding score files (or actual
13227     ;; scores) and add them to a list.
13228     (setq score-files (gnus-score-find-alist gnus-newsgroup-name))
13229     (while func
13230       (and (symbolp (car func))
13231            (fboundp (car func))
13232            (setq score-files 
13233                  (nconc score-files (funcall (car func) gnus-newsgroup-name))))
13234       (setq func (cdr func)))
13235     (if score-files (gnus-score-headers score-files trace))))
13236
13237 (defun gnus-score-file-name (newsgroup &optional suffix)
13238   "Return the name of a score file for NEWSGROUP."
13239   (let ((suffix (or suffix gnus-score-file-suffix)))
13240     (cond  ((or (null newsgroup)
13241                 (string-equal newsgroup ""))
13242             ;; The global score file is placed at top of the directory.
13243             (expand-file-name 
13244              suffix (or gnus-kill-files-directory "~/News")))
13245            ((gnus-use-long-file-name 'not-score)
13246             ;; Append ".SCORE" to newsgroup name.
13247             (expand-file-name (concat newsgroup "." suffix)
13248                               (or gnus-kill-files-directory "~/News")))
13249            (t
13250             ;; Place "SCORE" under the hierarchical directory.
13251             (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
13252                                       "/" suffix)
13253                               (or gnus-kill-files-directory "~/News"))))))
13254
13255 (defun gnus-score-search-global-directories (files)
13256   "Scan all global score directories for score files."
13257   ;; Set the variable `gnus-internal-global-score-files' to all
13258   ;; available global score files.
13259   (interactive (list gnus-global-score-files))
13260   (let (out)
13261     (while files
13262       (if (string-match "/$" (car files))
13263           (setq out (nconc (directory-files 
13264                             (car files) t
13265                             (concat (gnus-score-file-regexp) "$"))))
13266         (setq out (cons (car files) out)))
13267       (setq files (cdr files)))
13268     (setq gnus-internal-global-score-files out)))
13269
13270 ;; Allow redefinition of Gnus functions.
13271
13272 (gnus-ems-redefine)
13273
13274 (provide 'gnus)
13275
13276 ;;; gnus.el ends here