*** 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-simplify-subject-fuzzy-regexp nil
546   "*Regular expression that will be removed from subject strings if
547 fuzzy subject simplification is selected.")
548
549 (defvar gnus-group-default-list-level gnus-level-subscribed
550   "*Default listing level. 
551 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
552
553 (defvar gnus-group-use-permanent-levels nil
554   "*If non-nil, once you set a level, Gnus will use this level.")
555
556 (defvar gnus-show-mime nil
557   "*If non-nil, do mime processing of articles.
558 The articles will simply be fed to the function given by
559 `gnus-show-mime-method'.")
560
561 (defvar gnus-strict-mime t
562   "*If nil, decode MIME header even if there is not Mime-Version field.")
563  
564 (defvar gnus-show-mime-method (function metamail-buffer)
565   "*Function to process a MIME message.
566 The function is called from the article buffer.")
567
568 (defvar gnus-show-threads t
569   "*If non-nil, display threads in summary mode.")
570
571 (defvar gnus-thread-hide-subtree nil
572   "*If non-nil, hide all threads initially.
573 If threads are hidden, you have to run the command
574 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
575 to expose hidden threads.")
576
577 (defvar gnus-thread-hide-killed t
578   "*If non-nil, hide killed threads automatically.")
579
580 (defvar gnus-thread-ignore-subject nil
581   "*If non-nil, ignore subjects and do all threading based on the Reference header.
582 If nil, which is the default, articles that have different subjects
583 from their parents will start separate threads.")
584
585 (defvar gnus-thread-indent-level 4
586   "*Number that says how much each sub-thread should be indented.")
587
588 (defvar gnus-ignored-newsgroups ""
589   "*A regexp to match uninteresting newsgroups in the active file.
590 Any lines in the active file matching this regular expression are
591 removed from the newsgroup list before anything else is done to it,
592 thus making them effectively non-existent.")
593
594 (defvar gnus-ignored-headers
595   "^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:"
596   "*All headers that match this regexp will be hidden.
597 Also see `gnus-visible-headers'.")
598
599 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:"
600   "*All headers that do not match this regexp will be hidden.
601 Also see `gnus-ignored-headers'.")
602
603 (defvar gnus-sorted-header-list
604   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" 
605     "^Cc:" "^Date:" "^Organization:")
606   "*This variable is a list of regular expressions.
607 If it is non-nil, headers that match the regular expressions will
608 be placed first in the article buffer in the sequence specified by
609 this list.")
610
611 (defvar gnus-show-all-headers nil
612   "*If non-nil, don't hide any headers.")
613
614 (defvar gnus-save-all-headers t
615   "*If non-nil, don't remove any headers before saving.")
616
617 (defvar gnus-inhibit-startup-message nil
618   "*If non-nil, the startup message will not be displayed.")
619
620 (defvar gnus-signature-separator "^-- *$"
621   "Regexp matching signature separator.")
622
623 (defvar gnus-auto-extend-newsgroup t
624   "*If non-nil, extend newsgroup forward and backward when requested.")
625
626 (defvar gnus-auto-select-first t
627   "*If non-nil, select the first unread article when entering a group.
628 If you want to prevent automatic selection of the first unread article
629 in some newsgroups, set the variable to nil in
630 `gnus-select-group-hook'.") 
631
632 (defvar gnus-auto-select-next t
633   "*If non-nil, offer to go to the next group from the end of the previous.
634 If the value is t and the next newsgroup is empty, Gnus will exit
635 summary mode and go back to group mode.  If the value is neither nil
636 nor t, Gnus will select the following unread newsgroup.  In
637 particular, if the value is the symbol `quietly', the next unread
638 newsgroup will be selected without any confirmations.")
639
640 (defvar gnus-auto-select-same nil
641   "*If non-nil, select the next article with the same subject.")
642
643 (defvar gnus-summary-check-current nil
644   "*If non-nil, consider the current article when moving.
645 The \"unread\" movement commands will stay on the same line if the
646 current article is unread.")
647
648 (defvar gnus-auto-center-summary t
649   "*If non-nil, always center the current summary buffer.")
650
651 (defvar gnus-break-pages t
652   "*If non-nil, do page breaking on articles.
653 The page delimiter is specified by the `gnus-page-delimiter'
654 variable.")
655
656 (defvar gnus-page-delimiter "^\^L"
657   "*Regexp describing what to use as article page delimiters.
658 The default value is \"^\^L\", which is a form linefeed at the
659 beginning of a line.")
660
661 (defvar gnus-use-full-window t
662   "*If non-nil, use the entire Emacs screen.")
663
664 (defvar gnus-window-configuration nil
665   "Obsolete variable.  See `gnus-buffer-configuration'.")
666
667 (defvar gnus-buffer-configuration
668   '((group ([group 1.0 point] 
669             (if gnus-carpal [group-carpal 4])))
670     (summary ([summary 1.0 point]
671               (if gnus-carpal [summary-carpal 4])))
672     (article ([summary 0.25 point] 
673               (if gnus-carpal [summary-carpal 4]) 
674               [article 1.0]))
675     (server ([server 1.0 point]
676              (if gnus-carpal [server-carpal 2])))
677     (browse ([browse 1.0 point]
678              (if gnus-carpal [browse-carpal 2])))
679     (group-mail ([mail 1.0 point]))
680     (summary-mail ([mail 1.0 point]))
681     (summary-reply ([article 0.5]
682                     [mail 1.0 point]))
683     (info ([nil 1.0 point]))
684     (summary-faq ([summary 0.25]
685                   [faq 1.0 point]))
686     (edit-group ([group 0.5]
687                  [edit-group 1.0 point]))
688     (edit-server ([server 0.5]
689                   [edit-server 1.0 point]))
690     (edit-score ([summary 0.25]
691                  [edit-score 1.0 point]))
692     (post ([post 1.0 point]))
693     (reply ([article 0.5]
694             [mail 1.0 point]))
695     (mail-forward ([mail 1.0 point]))
696     (post-forward ([post 1.0 point]))
697     (reply-yank ([mail 1.0 point]))
698     (followup ([article 0.5]
699                [post 1.0 point]))
700     (followup-yank ([post 1.0 point])))
701   "Window configuration for all possible Gnus buffers.
702 This variable is a list of lists.  Each of these lists has a NAME and
703 a RULE.  The NAMEs are commonsense names like `group', which names a
704 rule used when displaying the group buffer; `summary', which names a
705 rule for what happens when you enter a group and do not display an
706 article buffer; and so on.  See the value of this variable for a
707 complete list of NAMEs.
708
709 Each RULE is a list of vectors.  The first element in this vector is
710 the name of the buffer to be displayed; the second element is the
711 percentage of the screen this buffer is to occupy (a number in the
712 0.0-0.99 range); the optional third element is `point', which should
713 be present to denote which buffer point is to go to after making this
714 buffer configuration.")
715
716 (defvar gnus-window-to-buffer
717   '((group . gnus-group-buffer)
718     (summary . gnus-summary-buffer)
719     (article . gnus-article-buffer)
720     (server . gnus-server-buffer)
721     (browse . "*Gnus Browse Server*")
722     (edit-group . gnus-group-edit-buffer)
723     (edit-server . gnus-server-edit-buffer)
724     (group-carpal . gnus-carpal-group-buffer)
725     (summary-carpal . gnus-carpal-summary-buffer)
726     (server-carpal . gnus-carpal-server-buffer)
727     (browse-carpal . gnus-carpal-browse-buffer)
728     (edit-score . gnus-score-edit-buffer)
729     (mail . gnus-mail-buffer)
730     (post . gnus-post-news-buffer)
731     (faq . gnus-faq-buffer))
732   "Mapping from short symbols to buffer names or buffer variables.")
733
734 (defvar gnus-carpal nil
735   "*If non-nil, display clickable icons.")
736
737 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
738   "*Function called with a group name when new group is detected.
739 A few pre-made functions are supplied: `gnus-subscribe-randomly'
740 inserts new groups at the beginning of the list of groups;
741 `gnus-subscribe-alphabetically' inserts new groups in strict
742 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
743 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
744 for your decision.")
745
746 ;; Suggested by a bug report by Hallvard B Furuseth.
747 ;; <h.b.furuseth@usit.uio.no>. 
748 (defvar gnus-subscribe-options-newsgroup-method
749   (function gnus-subscribe-alphabetically)
750   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
751 If, for instance, you want to subscribe to all newsgroups in the
752 \"no\" and \"alt\" hierarchies, you'd put the following in your
753 .newsrc file:
754
755 options -n no.all alt.all
756
757 Gnus will the subscribe all new newsgroups in these hierarchies with
758 the subscription method in this variable.")
759
760 (defvar gnus-subscribe-hierarchical-interactive nil
761   "*If non-nil, Gnus will offer to subscribe hierarchically.
762 When a new hierarchy appears, Gnus will ask the user:
763
764 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
765
766 If the user pressed `d', Gnus will descend the hierarchy, `y' will
767 subscribe to all newsgroups in the hierarchy and `s' will skip this
768 hierarchy in its entirety.")
769
770 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
771   "*Function used for sorting the group buffer.
772 This function will be called with group info entries as the arguments
773 for the groups to be sorted.  Pre-made functions include
774 `gnus-sort-by-alphabet', `gnus-sort-by-unread' and
775 `gnus-sort-by-level'")
776
777 ;; Mark variables suggested by Thomas Michanek
778 ;; <Thomas.Michanek@telelogic.se>. 
779 (defvar gnus-unread-mark ? 
780   "*Mark used for unread articles.")
781 (defvar gnus-ticked-mark ?!
782   "*Mark used for ticked articles.")
783 (defvar gnus-dormant-mark ??
784   "*Mark used for dormant articles.")
785 (defvar gnus-del-mark ?D
786   "*Mark used for del'd articles.")
787 (defvar gnus-read-mark ?d
788   "*Mark used for read articles.")
789 (defvar gnus-expirable-mark ?E
790   "*Mark used for expirable articles.")
791 (defvar gnus-killed-mark ?K
792   "*Mark used for killed articles.")
793 (defvar gnus-kill-file-mark ?X
794   "*Mark used for articles killed by kill files.")
795 (defvar gnus-low-score-mark ?Y
796   "*Mark used for articles with a low score.")
797 (defvar gnus-catchup-mark ?C
798   "*Mark used for articles that are caught up.")
799 (defvar gnus-replied-mark ?R
800   "*Mark used for articles that have been replied to.")
801 (defvar gnus-process-mark ?# 
802   "*Process mark.")
803 (defvar gnus-ancient-mark ?A
804   "*Mark used for ancient articles.")
805 (defvar gnus-canceled-mark ?G
806   "*Mark used for canceled articles.")
807 (defvar gnus-score-over-mark ?+
808   "*Score mark used for articles with high scores.")
809 (defvar gnus-score-below-mark ?-
810   "*Score mark used for articles with low scores.")
811 (defvar gnus-empty-thread-mark ? 
812   "*There is no thread under the article.")
813 (defvar gnus-not-empty-thread-mark ?=
814   "*There is a thread under the article.")
815 (defvar gnus-dummy-mark ?Z
816   "*This is a dummy article.")
817
818 (defvar gnus-view-pseudo-asynchronously nil
819   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
820
821 (defvar gnus-view-pseudos nil
822   "*If `automatic', pseudo-articles will be viewed automatically.
823 If `not-confirm', pseudos will be viewed automatically, and the user
824 will not be asked to confirm the command.")
825
826 (defvar gnus-view-pseudos-separately t
827   "*If non-nil, one pseudo-article will be created for each file to be viewed.
828 If nil, all files that use the same viewing command will be given as a
829 list of parameters to that command.")
830
831 (defvar gnus-group-line-format "%M%S%p%5y: %(%g%)\n"
832   "*Format of group lines.
833 It works along the same lines as a normal formatting string,
834 with some simple extensions.
835
836 %M    Only marked articles (character, \"*\" or \" \")
837 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
838 %L    Level of subscribedness (integer)
839 %N    Number of unread articles (integer)
840 %I    Number of dormant articles (integer)
841 %i    Number of ticked and dormant (integer)
842 %T    Number of ticked articles (integer)
843 %R    Number of read articles (integer)
844 %t    Total number of articles (integer)
845 %y    Number of unread, unticked articles (integer)
846 %G    Group name (string)
847 %g    Qualified group name (string)
848 %D    Group description (string)
849 %s    Select method (string)
850 %o    Moderated group (char, \"m\")
851 %p    Process mark (char)
852 %O    Moderated group (string, \"(m)\" or \"\")
853 %n    Select from where (string)
854 %z    A string that look like `<%s:%n>' if a foreign select method is used
855 %u    User defined specifier. The next character in the format string should
856       be a letter.  Gnus will call the function gnus-user-format-function-X,
857       where X is the letter following %u. The function will be passed the
858       current header as argument. The function should return a string, which
859       will be inserted into the buffer just like information from any other
860       group specifier.
861
862 Text between %( and %) will be highlighted with `gnus-mouse-face' when
863 the mouse point move inside the area.  There can only be one such area.
864
865 Note that this format specification is not always respected. For
866 reasons of efficiency, when listing killed groups, this specification
867 is ignored altogether. If the spec is changed considerably, your
868 output may end up looking strange when listing both alive and killed
869 groups.
870
871 If you use %o or %O, reading the active file will be slower and quite
872 a bit of extra memory will be used. %D will also worsen performance.
873 Also note that if you change the format specification to include any
874 of these specs, you must probably re-start Gnus to see them go into
875 effect.") 
876
877 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
878   "*The format specification of the lines in the summary buffer.
879
880 It works along the same lines as a normal formatting string,
881 with some simple extensions.
882
883 %N   Article number, left padded with spaces (string)
884 %S   Subject (string)
885 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
886 %n   Name of the poster (string)
887 %A   Address of the poster (string)
888 %F   Contents of the From: header (string)
889 %x   Contents of the Xref: header (string)
890 %D   Date of the article (string)
891 %d   Date of the article (string) in DD-MMM format
892 %M   Message-id of the article (string)
893 %r   References of the article (string)
894 %c   Number of characters in the article (integer)
895 %L   Number of lines in the article (integer)
896 %I   Indentation based on thread level (a string of spaces)
897 %T   A string with two possible values: 80 spaces if the article
898      is on thread level two or larger and 0 spaces on level one
899 %R   \"R\" if this article has been replied to, \" \" otherwise (character)
900 %U   Status of this article (character, \"D\", \"K\", \"-\" or \" \")
901 %[   Opening bracket (character, \"[\" or \"<\")
902 %]   Closing bracket (character, \"]\" or \">\")
903 %>   Spaces of length thread-level (string)
904 %<   Spaces of length (- 20 thread-level) (string)
905 %i   Article score (number)
906 %z   Article zcore (character)
907 %t   Number of articles under the current thread (number).
908 %e   Whether the thread is empty or not (character).
909 %u   User defined specifier. The next character in the format string should
910      be a letter.  Gnus will call the function gnus-user-format-function-X,
911      where X is the letter following %u. The function will be passed the
912      current header as argument. The function should return a string, which
913      will be inserted into the summary just like information from any other
914      summary specifier.
915
916 Text between %( and %) will be highlighted with `gnus-mouse-face'
917 when the mouse point is placed inside the area.  There can only be one
918 such area.
919
920 The %U (status), %R (replied) and %z (zcore) specs have to be handled
921 with care. For reasons of efficiency, Gnus will compute what column
922 these characters will end up in, and \"hard-code\" that. This means that
923 it is illegal to have these specs after a variable-length spec. Well,
924 you might not be arrested, but your summary buffer will look strange,
925 which is bad enough.
926
927 The smart choice is to have these specs as for to the left as
928 possible. 
929
930 This restriction may disappear in later versions of Gnus.")
931
932 (defvar gnus-summary-dummy-line-format "*  :                          : %S\n"
933   "*The format specification for the dummy roots in the summary buffer.
934 It works along the same lines as a normal formatting string,
935 with some simple extensions.
936
937 %S  The subject")
938
939 (defvar gnus-summary-mode-line-format "(ding) %G/%A %Z"
940   "*The format specification for the summary mode line.")
941
942 (defvar gnus-article-mode-line-format "(ding) %G/%A %S"
943   "*The format specification for the article mode line.")
944
945 (defvar gnus-group-mode-line-format "(ding) List of groups   {%M:%S}  "
946   "*The format specification for the group mode line.")
947
948 (defvar gnus-valid-select-methods
949   '(("nntp" post address prompt-address)
950     ("nnspool" post)
951     ("nnvirtual" none virtual prompt-address) 
952     ("nnmbox" mail respool) 
953     ("nnml" mail respool)
954     ("nnmh" mail respool) 
955     ("nndir" none prompt-address address)
956     ("nneething" none prompt-address)
957     ("nndigest" none) 
958     ("nndoc" none prompt-address) 
959     ("nnbabyl" mail respool) 
960     ("nnkiboze" post virtual) 
961     ("nnsoup" post)
962     ("nnfolder" mail respool))
963   "An alist of valid select methods.
964 The first element of each list lists should be a string with the name
965 of the select method. The other elements may be be the category of
966 this method (ie. `post', `mail', `none' or whatever) or other
967 properties that this method has (like being respoolable).
968 If you implement a new select method, all you should have to change is
969 this variable. I think.")
970
971 (defvar gnus-updated-mode-lines '(group article summary)
972   "*List of buffers that should update their mode lines.
973 The list may contain the symbols `group', `article' and `summary'. If
974 the corresponding symbol is present, Gnus will keep that mode line
975 updated with information that may be pertinent. 
976 If this variable is nil, screen refresh may be quicker.")
977
978 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
979 (defvar gnus-mode-non-string-length 21
980   "*Max length of mode-line non-string contents.
981 If this is nil, Gnus will take space as is needed, leaving the rest
982 of the modeline intact.")
983
984 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
985 (defvar gnus-display-type 
986   (condition-case nil
987       (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
988         (cond (display-resource (intern (downcase display-resource)))
989               ((x-display-color-p) 'color)
990               ((x-display-grayscale-p) 'grayscale)
991               (t 'mono)))
992     (error 'mono))
993   "A symbol indicating the display Emacs is running under.
994 The symbol should be one of `color', `grayscale' or `mono'. If Emacs
995 guesses this display attribute wrongly, either set this variable in
996 your `~/.emacs' or set the resource `Emacs.displayType' in your
997 `~/.Xdefaults'. See also `gnus-background-mode'.")
998
999 (defvar gnus-background-mode 
1000   (condition-case nil
1001       (let ((bg-resource (x-get-resource ".backgroundMode"
1002                                          "BackgroundMode"))
1003             (params (frame-parameters)))
1004         (cond (bg-resource (intern (downcase bg-resource)))
1005               ((< (apply '+ (x-color-values
1006                              (cdr (assq 'background-color params))))
1007                   (/ (apply '+ (x-color-values "white")) 3))
1008                'dark)
1009               (t 'light)))
1010     (error 'light))
1011   "A symbol indicating the Emacs background brightness.
1012 The symbol should be one of `light' or `dark'.
1013 If Emacs guesses this frame attribute wrongly, either set this variable in
1014 your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
1015 `~/.Xdefaults'.
1016 See also `gnus-display-type'.")
1017
1018 (defvar gnus-mouse-face 'highlight
1019   "*Face used for mouse highlighting in Gnus.
1020 No mouse highlights will be done if `gnus-visual' is nil.")
1021
1022 (defvar gnus-summary-mark-below nil
1023   "*Mark all articles with a score below this variable as read.
1024 This variable is local to each summary buffer and usually set by the
1025 score file.")  
1026
1027 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1028   "*List of functions used for sorting threads in the summary buffer.
1029 By default, threads are sorted by article number.
1030
1031 Each function takes two threads and return non-nil if the first thread
1032 should be sorted before the other.  If you use more than one function,
1033 the primary sort function should be the last.
1034
1035 Ready-mady functions include `gnus-thread-sort-by-number',
1036 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1037 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1038 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1039
1040 (defvar gnus-thread-score-function '+
1041   "*Function used for calculating the total score of a thread.
1042
1043 The function is called with the scores of the article and each
1044 subthread and should then return the score of the thread.
1045
1046 Some functions you can use are `+', `max', or `min'.")
1047
1048 (defvar gnus-options-subscribe nil
1049   "*All new groups matching this regexp will be subscribed unconditionally.
1050 Note that this variable deals only with new newsgroups.  This variable
1051 does not affect old newsgroups.")
1052
1053 (defvar gnus-options-not-subscribe nil
1054   "*All new groups matching this regexp will be ignored.
1055 Note that this variable deals only with new newsgroups.  This variable
1056 does not affect old (already subscribed) newsgroups.")
1057
1058 (defvar gnus-auto-expirable-newsgroups nil
1059   "*Groups in which to automatically mark read articles as expirable.
1060 If non-nil, this should be a regexp that should match all groups in
1061 which to perform auto-expiry.  This only makes sense for mail groups.")
1062
1063 (defvar gnus-hidden-properties '(invisible t intangible t)
1064   "Property list to use for hiding text.")
1065
1066 ;; Hooks.
1067
1068 (defvar gnus-group-mode-hook nil
1069   "*A hook for Gnus group mode.")
1070
1071 (defvar gnus-summary-mode-hook nil
1072   "*A hook for Gnus summary mode.
1073 This hook is run before any variables are set in the summary buffer.")
1074
1075 (defvar gnus-article-mode-hook nil
1076   "*A hook for Gnus article mode.")
1077
1078 (defun gnus-summary-exit-hook nil
1079   "*A hook called on exit from the summary buffer.
1080 It calls `gnus-summary-expire-articles' by default.")
1081 (add-hook 'gnus-summary-exit-hook 'gnus-summary-expire-articles)
1082
1083 (defvar gnus-open-server-hook nil
1084   "*A hook called just before opening connection to the news server.")
1085
1086 (defvar gnus-startup-hook nil
1087   "*A hook called at startup.
1088 This hook is called after Gnus is connected to the NNTP server.")
1089
1090 (defvar gnus-get-new-news-hook nil
1091   "*A hook run just before Gnus checks for new news.")
1092
1093 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1094   "*A function that is called to generate the group buffer.
1095 The function is called with three arguments: The first is a number;
1096 all group with a level less or equal to that number should be listed,
1097 if the second is non-nil, empty groups should also be displayed. If
1098 the third is non-nil, it is a number. No groups with a level lower
1099 than this number should be displayed.
1100
1101 The only current function implemented is `gnus-group-prepare-flat'.")
1102
1103 (defvar gnus-group-prepare-hook nil
1104   "*A hook called after the group buffer has been generated.
1105 If you want to modify the group buffer, you can use this hook.")
1106
1107 (defvar gnus-summary-prepare-hook nil
1108   "*A hook called after the summary buffer has been generated.
1109 If you want to modify the summary buffer, you can use this hook.")
1110
1111 (defvar gnus-article-prepare-hook nil
1112   "*A hook called after an article has been prepared in the article buffer.
1113 If you want to run a special decoding program like nkf, use this hook.")
1114
1115 (defvar gnus-article-display-hook nil
1116   "*A hook called after the article is displayed in the article buffer.
1117 The hook is designed to change the contents of the article
1118 buffer. Typical functions that this hook may contain are
1119 `gnus-article-hide-headers' (hide selected headers),
1120 `gnus-article-maybe-highlight' (perform fancy article highlighting), 
1121 `gnus-article-hide-signature' (hide signature) and
1122 `gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1123 (add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1124 (add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1125
1126 (defvar gnus-article-x-face-command
1127   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1128   "String or function to be executed to display an X-Face header.
1129 If it is a string, the command will be executed in a sub-shell
1130 asynchronously. The compressed face will be piped to this command.") 
1131
1132 (defvar gnus-article-x-face-too-ugly nil
1133   "Regexp matching posters whose face shouldn't be shown automatically.")
1134
1135 (defvar gnus-select-group-hook nil
1136   "*A hook called when a newsgroup is selected.
1137
1138 If you'd like to simplify subjects like the
1139 `gnus-summary-next-same-subject' command does, you can use the
1140 following hook:
1141
1142  (setq gnus-select-group-hook
1143       (list
1144         (lambda ()
1145           (mapcar (lambda (header)
1146                      (header-set-subject
1147                       header
1148                       (gnus-simplify-subject
1149                        (header-subject header) 're-only)))
1150                   gnus-newsgroup-headers))))")
1151
1152 (defvar gnus-select-article-hook
1153   '(gnus-summary-show-thread)
1154   "*A hook called when an article is selected.
1155 The default hook shows conversation thread subtrees of the selected
1156 article automatically using `gnus-summary-show-thread'.")
1157
1158 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1159   "*A hook called to apply kill files to a group.
1160 This hook is intended to apply a kill file to the selected newsgroup.
1161 The function `gnus-apply-kill-file' is called by default.
1162
1163 Since a general kill file is too heavy to use only for a few
1164 newsgroups, I recommend you to use a lighter hook function. For
1165 example, if you'd like to apply a kill file to articles which contains
1166 a string `rmgroup' in subject in newsgroup `control', you can use the
1167 following hook:
1168
1169 \(setq gnus-apply-kill-hook
1170       (list
1171         (lambda ()
1172           (cond ((string-match \"control\" gnus-newsgroup-name)
1173                  (gnus-kill \"Subject\" \"rmgroup\")
1174                  (gnus-expunge \"X\"))))))")
1175
1176 (defvar gnus-visual-mark-article-hook 
1177   (list 'gnus-highlight-selected-summary)
1178   "*Hook run after selecting an article in the summary buffer.
1179 It is meant to be used for highlighting the article in some way.  It
1180 is not run if `gnus-visual' is nil.")
1181
1182 (defvar gnus-prepare-article-hook (list 'gnus-inews-insert-signature)
1183   "*A hook called after preparing body, but before preparing header headers.
1184 The default hook (`gnus-inews-insert-signature') inserts a signature
1185 file specified by the variable `gnus-signature-file'.")
1186
1187 (defvar gnus-exit-group-hook nil
1188   "*A hook called when exiting (not quitting) summary mode.")
1189
1190 (defvar gnus-suspend-gnus-hook nil
1191   "*A hook called when suspending (not exiting) Gnus.")
1192
1193 (defvar gnus-exit-gnus-hook nil
1194   "*A hook called when exiting Gnus.")
1195
1196 (defvar gnus-save-newsrc-hook nil
1197   "*A hook called when saving the newsrc file.")
1198
1199 (defvar gnus-summary-update-hook 
1200   (list 'gnus-summary-highlight-line)
1201   "*A hook called when a summary line is changed.
1202 The hook will not be called if `gnus-visual' is nil.
1203
1204 The default function `gnus-summary-highlight-line' will
1205 highlight the line according to the `gnus-summary-highlight'
1206 variable.")
1207
1208 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1209   "*A hook called when an article is selected for the first time.
1210 The hook is intended to mark an article as read (or unread)
1211 automatically when it is selected.")
1212
1213 ;; Remove any hilit infestation.
1214 (add-hook 'gnus-startup-hook
1215           (lambda ()
1216             (remove-hook 'gnus-summary-prepare-hook
1217                          'hilit-rehighlight-buffer-quietly)
1218             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1219             (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
1220             (remove-hook 'gnus-article-prepare-hook
1221                          'hilit-rehighlight-buffer-quietly)))
1222
1223
1224 \f
1225 ;; Internal variables
1226
1227 ;; Avoid highlighting in kill files.
1228 (defvar gnus-summary-inhibit-highlight nil)
1229 (defvar gnus-newsgroup-selected-overlay nil)
1230
1231 (defvar gnus-article-mode-map nil)
1232 (defvar gnus-dribble-buffer nil)
1233 (defvar gnus-headers-retrieved-by nil)
1234 (defvar gnus-article-reply nil)
1235 (defvar gnus-override-method nil)
1236 (defvar gnus-article-check-size nil)
1237
1238 (defvar gnus-current-score-file nil)
1239 (defvar gnus-internal-global-score-files nil)
1240 (defvar gnus-score-file-list nil)
1241
1242
1243 (defvar gnus-current-move-group nil)
1244
1245 (defvar gnus-newsgroup-dependencies nil)
1246 (defvar gnus-newsgroup-threads nil)
1247 (defvar gnus-newsgroup-async nil)
1248 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1249
1250 (defvar gnus-newsgroup-adaptive nil)
1251
1252 (defvar gnus-summary-display-table nil)
1253
1254 (defconst gnus-group-line-format-alist
1255   (list (list ?M 'marked ?c)
1256         (list ?S 'subscribed ?c)
1257         (list ?L 'level ?d)
1258         (list ?N 'number ?s)
1259         (list ?I 'number-of-dormant ?d)
1260         (list ?T 'number-of-ticked ?d)
1261         (list ?R 'number-of-read ?s)
1262         (list ?t 'number-total ?d)
1263         (list ?y 'number-of-unread-unticked ?s)
1264         (list ?i 'number-of-ticked-and-dormant ?d)
1265         (list ?g 'group ?s)
1266         (list ?G 'qualified-group ?s)
1267         (list ?D 'newsgroup-description ?s)
1268         (list ?o 'moderated ?c)
1269         (list ?O 'moderated-string ?s)
1270         (list ?p 'process-marked ?c)
1271         (list ?s 'news-server ?s)
1272         (list ?n 'news-method ?s)
1273         (list ?z 'news-method-string ?s)
1274         (list ?u 'user-defined ?s)))
1275
1276 (defconst gnus-summary-line-format-alist 
1277   (list (list ?N 'number ?d)
1278         (list ?S 'subject ?s)
1279         (list ?s 'subject-or-nil ?s)
1280         (list ?n 'name ?s)
1281         (list ?A 'address ?s)
1282         (list ?F 'from ?s)
1283         (list ?x (macroexpand '(header-xref header)) ?s)
1284         (list ?D (macroexpand '(header-date header)) ?s)
1285         (list ?d '(gnus-dd-mmm (header-date header)) ?s)
1286         (list ?M (macroexpand '(header-id header)) ?s)
1287         (list ?r (macroexpand '(header-references header)) ?s)
1288         (list ?c '(or (header-chars header) 0) ?d)
1289         (list ?L 'lines ?d)
1290         (list ?I 'indentation ?s)
1291         (list ?T '(if (= level 0) "" (make-string (frame-width) ? )) ?s)
1292         (list ?R 'replied ?c)
1293         (list ?\[ 'opening-bracket ?c)
1294         (list ?\] 'closing-bracket ?c)
1295         (list ?\> '(make-string level ? ) ?s)
1296         (list ?\< '(make-string (max 0 (- 20 level)) ? ) ?s)
1297         (list ?i 'score ?d)
1298         (list ?z 'score-char ?c)
1299         (list ?U 'unread ?c)
1300         (list ?t '(gnus-summary-number-of-articles-in-thread 
1301                    (or (prog1 gnus-tmp-adopt-thread 
1302                          (setq gnus-tmp-adopt-thread nil))
1303                        (if (boundp 'thread) (symbol-value 'thread)
1304                          thread nil)))
1305                    ?d)
1306         (list ?e '(gnus-summary-number-of-articles-in-thread 
1307                    (or gnus-tmp-adopt-thread 
1308                        (if (boundp 'thread) (symbol-value 'thread)
1309                          thread nil)) t)
1310                    ?c)
1311         (list ?u 'user-defined ?s))
1312   "An alist of format specifications that can appear in summary lines,
1313 and what variables they correspond with, along with the type of the
1314 variable (string, integer, character, etc).")
1315
1316 (defconst gnus-summary-dummy-line-format-alist
1317   (list (list ?S 'subject ?s)
1318         (list ?N 'number ?d)
1319         (list ?u 'user-defined ?s)))
1320
1321 (defconst gnus-summary-mode-line-format-alist 
1322   (list (list ?G 'group-name ?s)
1323         (list ?g '(gnus-short-group-name group-name) ?s)
1324         (list ?A 'article-number ?d)
1325         (list ?Z 'unread-and-unselected ?s)
1326         (list ?V 'gnus-version ?s)
1327         (list ?U 'unread ?d)
1328         (list ?S 'subject ?s)
1329         (list ?e 'unselected ?d)
1330         (list ?u 'user-defined ?s)
1331         (list ?s '(gnus-current-score-file-nondirectory) ?s)))
1332
1333 (defconst gnus-group-mode-line-format-alist 
1334   (list (list ?S 'news-server ?s)
1335         (list ?M 'news-method ?s)
1336         (list ?u 'user-defined ?s)))
1337
1338 (defvar gnus-have-read-active-file nil)
1339
1340 (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1341   "The mail address of the Gnus maintainers.")
1342
1343 (defconst gnus-version "(ding) Gnus v0.94"
1344   "Version number for this version of Gnus.")
1345
1346 (defvar gnus-info-nodes
1347   '((gnus-group-mode            "(gnus)The Group Buffer")
1348     (gnus-summary-mode          "(gnus)The Summary Buffer")
1349     (gnus-article-mode          "(gnus)The Article Buffer"))
1350   "Assoc list of major modes and related Info nodes.")
1351
1352 (defvar gnus-documentation-group-file "~/dgnus/lisp/doc.txt"
1353   "The location of the (ding) Gnus documentation group.")
1354
1355 (defvar gnus-group-buffer "*Group*")
1356 (defvar gnus-summary-buffer "*Summary*")
1357 (defvar gnus-article-buffer "*Article*")
1358 (defvar gnus-server-buffer "*Server*")
1359
1360 (defvar gnus-work-buffer " *gnus work*")
1361
1362 (defvar gnus-buffer-list nil
1363   "Gnus buffers that should be killed on exit.")
1364
1365 (defvar gnus-server-alist nil
1366   "List of available servers.")
1367
1368 (defvar gnus-variable-list
1369   '(gnus-newsrc-options gnus-newsrc-options-n
1370     gnus-newsrc-last-checked-date 
1371     gnus-newsrc-alist gnus-server-alist
1372     gnus-killed-list gnus-zombie-list)
1373   "Gnus variables saved in the quick startup file.")
1374
1375 (defvar gnus-overload-functions
1376   '((news-inews gnus-inews-news "rnewspost"))
1377   "Functions overloaded by gnus.
1378 It is a list of `(original overload &optional file)'.")
1379
1380 (defvar gnus-newsrc-options nil
1381   "Options line in the .newsrc file.")
1382
1383 (defvar gnus-newsrc-options-n nil
1384   "List of regexps representing groups to be subscribed/ignored unconditionally.") 
1385
1386 (defvar gnus-newsrc-last-checked-date nil
1387   "Date Gnus last asked server for new newsgroups.")
1388
1389 (defvar gnus-newsrc-alist nil
1390   "Assoc list of read articles.
1391 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1392
1393 (defvar gnus-newsrc-hashtb nil
1394   "Hashtable of gnus-newsrc-alist.")
1395
1396 (defvar gnus-killed-list nil
1397   "List of killed newsgroups.")
1398
1399 (defvar gnus-killed-hashtb nil
1400   "Hash table equivalent of gnus-killed-list.")
1401
1402 (defvar gnus-zombie-list nil
1403   "List of almost dead newsgroups.")
1404
1405 (defvar gnus-description-hashtb nil
1406   "Descriptions of newsgroups.")
1407
1408 (defvar gnus-list-of-killed-groups nil
1409   "List of newsgroups that have recently been killed by the user.")
1410
1411 (defvar gnus-active-hashtb nil
1412   "Hashtable of active articles.")
1413
1414 (defvar gnus-moderated-list nil
1415   "List of moderated newsgroups.")
1416
1417 (defvar gnus-group-marked nil)
1418
1419 (defvar gnus-current-startup-file nil
1420   "Startup file for the current host.")
1421
1422 (defvar gnus-last-search-regexp nil
1423   "Default regexp for article search command.")
1424
1425 (defvar gnus-last-shell-command nil
1426   "Default shell command on article.")
1427
1428 (defvar gnus-current-select-method nil
1429   "The current method for selecting a newsgroup.")
1430
1431 (defvar gnus-have-all-newsgroups nil)
1432
1433 (defvar gnus-article-internal-prepare-hook nil)
1434
1435 (defvar gnus-newsgroup-name nil)
1436 (defvar gnus-newsgroup-begin nil)
1437 (defvar gnus-newsgroup-end nil)
1438 (defvar gnus-newsgroup-last-rmail nil)
1439 (defvar gnus-newsgroup-last-mail nil)
1440 (defvar gnus-newsgroup-last-folder nil)
1441 (defvar gnus-newsgroup-last-file nil)
1442 (defvar gnus-newsgroup-auto-expire nil)
1443 (defvar gnus-newsgroup-active nil)
1444
1445 (defvar gnus-newsgroup-unreads nil
1446   "List of unread articles in the current newsgroup.")
1447
1448 (defvar gnus-newsgroup-unselected nil
1449   "List of unselected unread articles in the current newsgroup.")
1450
1451 (defvar gnus-newsgroup-marked nil
1452   "List of ticked articles in the current newsgroup (a subset of unread art).")
1453
1454 (defvar gnus-newsgroup-killed nil
1455   "List of ranges of articles that have been through the scoring process.")
1456
1457 (defvar gnus-newsgroup-kill-headers nil)
1458
1459 (defvar gnus-newsgroup-replied nil
1460   "List of articles that have been replied to in the current newsgroup.")
1461
1462 (defvar gnus-newsgroup-expirable nil
1463   "List of articles in the current newsgroup that can be expired.")
1464
1465 (defvar gnus-newsgroup-processable nil
1466   "List of articles in the current newsgroup that can be processed.")
1467
1468 (defvar gnus-newsgroup-bookmarks nil
1469   "List of articles in the current newsgroup that have bookmarks.")
1470
1471 (defvar gnus-newsgroup-dormant nil
1472   "List of dormant articles in the current newsgroup.")
1473
1474 (defvar gnus-newsgroup-scored nil
1475   "List of scored articles in the current newsgroup.")
1476
1477 (defvar gnus-newsgroup-headers nil
1478   "List of article headers in the current newsgroup.")
1479 (defvar gnus-newsgroup-headers-hashtb-by-number nil)
1480
1481 (defvar gnus-newsgroup-ancient nil
1482   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1483
1484 (defvar gnus-current-article nil)
1485 (defvar gnus-article-current nil)
1486 (defvar gnus-current-headers nil)
1487 (defvar gnus-have-all-headers nil)
1488 (defvar gnus-last-article nil)
1489 (defvar gnus-newsgroup-history nil)
1490 (defvar gnus-current-kill-article nil)
1491
1492 ;; Save window configuration.
1493 (defvar gnus-prev-winconf nil)
1494
1495 ;; Format specs
1496 (defvar gnus-summary-line-format-spec nil)
1497 (defvar gnus-summary-dummy-line-format-spec nil)
1498 (defvar gnus-group-line-format-spec nil)
1499 (defvar gnus-summary-mode-line-format-spec nil)
1500 (defvar gnus-article-mode-line-format-spec nil)
1501 (defvar gnus-group-mode-line-format-spec nil)
1502 (defvar gnus-summary-mark-positions nil)
1503
1504 (defvar gnus-summary-expunge-below nil)
1505 (defvar gnus-reffed-article-number nil)
1506
1507 (defvar rmail-default-file (expand-file-name "~/XMBOX"))
1508 (defvar rmail-default-rmail-file (expand-file-name "~/XNEWS"))
1509
1510 (defconst gnus-summary-local-variables 
1511   '(gnus-newsgroup-name 
1512     gnus-newsgroup-begin gnus-newsgroup-end 
1513     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail 
1514     gnus-newsgroup-last-folder gnus-newsgroup-last-file 
1515     gnus-newsgroup-auto-expire gnus-newsgroup-unreads 
1516     gnus-newsgroup-unselected gnus-newsgroup-marked
1517     gnus-newsgroup-replied gnus-newsgroup-expirable
1518     gnus-newsgroup-processable gnus-newsgroup-killed
1519     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1520     gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number
1521     gnus-current-article gnus-current-headers gnus-have-all-headers
1522     gnus-last-article gnus-article-internal-prepare-hook
1523     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1524     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1525     gnus-newsgroup-threads gnus-newsgroup-async
1526     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below 
1527     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1528     gnus-newsgroup-history gnus-newsgroup-ancient
1529     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring))
1530   "Variables that are buffer-local to the summary buffers.")
1531
1532 (defconst gnus-bug-message
1533   "Sending a bug report to the Gnus Towers.
1534 ========================================
1535
1536 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1537 be sent to the Gnus Bug Exterminators. 
1538
1539 At the bottom of the buffer you'll see lots of variable settings.
1540 Please do not delete those.  They will tell the Bug People what your
1541 environment is, so that it will be easier to locate the bugs.
1542
1543 If you have found a bug that makes Emacs go \"beep\", set
1544 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') 
1545 and include the backtrace in your bug report.
1546
1547 Please describe the bug in annoying, painstaking detail.
1548
1549 Thank you for your help in stamping out bugs.
1550 ")
1551
1552 ;;; End of variables.
1553
1554 ;; Define some autoload functions Gnus might use.
1555 (eval-and-compile
1556
1557   ;; Various 
1558   (autoload 'metamail-buffer "metamail")
1559   (autoload 'Info-goto-node "info")
1560   (autoload 'hexl-hex-string-to-integer "hexl")
1561   (autoload 'pp "pp")
1562   (autoload 'pp-to-string "pp")
1563   (autoload 'pp-eval-expression "pp")
1564   (autoload 'mail-extract-address-components "mail-extr")
1565
1566   (autoload 'nnmail-split-fancy "nnmail")
1567   (autoload 'nnvirtual-catchup-group "nnvirtual")
1568
1569   ;; timezone
1570   (autoload 'timezone-make-date-arpa-standard "timezone")
1571   (autoload 'timezone-fix-time "timezone")
1572   (autoload 'timezone-make-sortable-date "timezone")
1573   (autoload 'timezone-make-time-string "timezone")
1574
1575   ;; rmail & friends
1576   (autoload 'mail-position-on-field "sendmail")
1577   (autoload 'mail-setup "sendmail")
1578   (autoload 'rmail-output "rmailout")
1579   (autoload 'news-mail-other-window "rnewspost")
1580   (autoload 'news-reply-yank-original "rnewspost")
1581   (autoload 'news-caesar-buffer-body "rnewspost")
1582   (autoload 'rmail-insert-rmail-file-header "rmail")
1583   (autoload 'rmail-count-new-messages "rmail")
1584   (autoload 'rmail-show-message "rmail")
1585
1586   ;; gnus-soup
1587   (autoload 'gnus-group-brew-soup "gnus-soup" nil t)
1588   (autoload 'gnus-brew-soup "gnus-soup" nil t)
1589   (autoload 'gnus-soup-add-article "gnus-soup" nil t)
1590   (autoload 'gnus-soup-send-replies "gnus-soup" nil t)
1591   (autoload 'gnus-soup-save-areas "gnus-soup" nil t)
1592   (autoload 'gnus-soup-pack-packet "gnus-soup" nil t)
1593   (autoload 'nnsoup-pack-replies "nnsoup" nil t)
1594
1595   ;; gnus-mh
1596   (autoload 'gnus-mail-reply-using-mhe "gnus-mh")
1597   (autoload 'gnus-mail-forward-using-mhe "gnus-mh")
1598   (autoload 'gnus-mail-other-window-using-mhe "gnus-mh")
1599   (autoload 'gnus-summary-save-in-folder "gnus-mh")
1600   (autoload 'gnus-summary-save-article-folder "gnus-mh")
1601   (autoload 'gnus-Folder-save-name "gnus-mh")
1602   (autoload 'gnus-folder-save-name "gnus-mh")
1603
1604   ;; gnus-vis misc
1605   (autoload 'gnus-group-make-menu-bar "gnus-vis")
1606   (autoload 'gnus-summary-make-menu-bar "gnus-vis")
1607   (autoload 'gnus-server-make-menu-bar "gnus-vis")
1608   (autoload 'gnus-article-make-menu-bar "gnus-vis")
1609   (autoload 'gnus-browse-make-menu-bar "gnus-vis")
1610   (autoload 'gnus-highlight-selected-summary "gnus-vis")
1611   (autoload 'gnus-summary-highlight-line "gnus-vis")
1612   (autoload 'gnus-carpal-setup-buffer "gnus-vis")
1613
1614   ;; gnus-vis article
1615   (autoload 'gnus-article-push-button "gnus-vis" nil t)
1616   (autoload 'gnus-article-press-button "gnus-vis" nil t)
1617   (autoload 'gnus-article-highlight "gnus-vis" nil t)
1618   (autoload 'gnus-article-hide "gnus-vis" nil t)
1619   (autoload 'gnus-article-hide-signature "gnus-vis" nil t)
1620   (autoload 'gnus-article-highlight-headers "gnus-vis" nil t)
1621   (autoload 'gnus-article-highlight-signature "gnus-vis" nil t)
1622   (autoload 'gnus-article-add-buttons "gnus-vis" nil t)
1623   (autoload 'gnus-article-next-button "gnus-vis" nil t)
1624   (autoload 'gnus-article-add-button "gnus-vis")
1625
1626   ;; gnus-cite
1627   (autoload 'gnus-article-highlight-citation "gnus-cite" nil t)
1628   (autoload 'gnus-article-hide-citation-maybe "gnus-cite" nil t)
1629   (autoload 'gnus-article-hide-citation "gnus-cite" nil t)
1630
1631   ;; gnus-kill
1632   (autoload 'gnus-kill "gnus-kill")
1633   (autoload 'gnus-apply-kill-file-internal "gnus-kill")
1634   (autoload 'gnus-kill-file-edit-file "gnus-kill")
1635   (autoload 'gnus-kill-file-raise-followups-to-author "gnus-kill")
1636   (autoload 'gnus-execute "gnus-kill")
1637   (autoload 'gnus-expunge "gnus-kill")
1638
1639   ;; gnus-cache
1640   (autoload 'gnus-cache-possibly-enter-article "gnus-cache")
1641   (autoload 'gnus-cache-save-buffers "gnus-cache")
1642   (autoload 'gnus-cache-possibly-remove-articles "gnus-cache")
1643   (autoload 'gnus-cache-request-article "gnus-cache")
1644   (autoload 'gnus-cache-retrieve-headers "gnus-cache")
1645   (autoload 'gnus-cache-possibly-alter-active "gnus-cache")
1646   (autoload 'gnus-jog-cache "gnus-cache" nil t)
1647   (autoload 'gnus-cache-enter-remove-article "gnus-cache")
1648
1649   ;; gnus-score
1650   (autoload 'gnus-summary-increase-score "gnus-score" nil t)
1651   (autoload 'gnus-summary-lower-score "gnus-score" nil t)
1652   (autoload 'gnus-summary-score-map "gnus-score" nil nil 'keymap)
1653   (autoload 'gnus-score-save "gnus-score")
1654   (autoload 'gnus-score-headers "gnus-score")
1655   (autoload 'gnus-current-score-file-nondirectory "gnus-score")
1656   (autoload 'gnus-score-adaptive "gnus-score")
1657   (autoload 'gnus-score-remove-lines-adaptive "gnus-score")
1658   (autoload 'gnus-score-find-trace "gnus-score")
1659
1660   ;; gnus-edit
1661   (autoload 'gnus-score-customize "gnus-edit" nil t)
1662
1663   ;; gnus-uu
1664   (autoload 'gnus-uu-extract-map "gnus-uu" nil nil 'keymap)
1665   (autoload 'gnus-uu-mark-map "gnus-uu" nil nil 'keymap)
1666   (autoload 'gnus-uu-digest-mail-forward "gnus-uu" nil t)
1667   (autoload 'gnus-uu-digest-post-forward "gnus-uu" nil t)
1668   (autoload 'gnus-uu-mark-series "gnus-uu" nil t)
1669   (autoload 'gnus-uu-mark-region "gnus-uu" nil t)
1670   (autoload 'gnus-uu-mark-by-regexp "gnus-uu" nil t)
1671   (autoload 'gnus-uu-mark-all "gnus-uu" nil t)
1672   (autoload 'gnus-uu-mark-sparse "gnus-uu" nil t)
1673   (autoload 'gnus-uu-mark-thread "gnus-uu" nil t)
1674   (autoload 'gnus-uu-decode-uu "gnus-uu" nil t)
1675   (autoload 'gnus-uu-decode-uu-and-save "gnus-uu" nil t)
1676   (autoload 'gnus-uu-decode-unshar "gnus-uu" nil t)
1677   (autoload 'gnus-uu-decode-unshar-and-save "gnus-uu" nil t)
1678   (autoload 'gnus-uu-decode-save "gnus-uu" nil t)
1679   (autoload 'gnus-uu-decode-binhex "gnus-uu" nil t)
1680   (autoload 'gnus-uu-decode-uu-view "gnus-uu" nil t)
1681   (autoload 'gnus-uu-decode-uu-and-save-view "gnus-uu" nil t)
1682   (autoload 'gnus-uu-decode-unshar-view "gnus-uu" nil t)
1683   (autoload 'gnus-uu-decode-unshar-and-save-view "gnus-uu" nil t)
1684   (autoload 'gnus-uu-decode-save-view "gnus-uu" nil t)
1685   (autoload 'gnus-uu-decode-binhex-view "gnus-uu" nil t)
1686
1687   ;; gnus-msg
1688   (autoload 'gnus-summary-send-map "gnus-msg" nil nil 'keymap)
1689   (autoload 'gnus-group-post-news "gnus-msg" nil t)
1690   (autoload 'gnus-group-mail "gnus-msg" nil t)
1691   (autoload 'gnus-summary-post-news "gnus-msg" nil t)
1692   (autoload 'gnus-summary-followup "gnus-msg" nil t)
1693   (autoload 'gnus-summary-followup-with-original "gnus-msg" nil t)
1694   (autoload 'gnus-summary-followup-and-reply "gnus-msg" nil t)
1695   (autoload 'gnus-summary-followup-and-reply-with-original "gnus-msg" nil t)
1696   (autoload 'gnus-summary-cancel-article "gnus-msg" nil t)
1697   (autoload 'gnus-summary-supersede-article "gnus-msg" nil t)
1698   (autoload 'gnus-post-news "gnus-msg" nil t)
1699   (autoload 'gnus-inews-news "gnus-msg" nil t)
1700   (autoload 'gnus-cancel-news "gnus-msg" nil t)
1701   (autoload 'gnus-summary-reply "gnus-msg" nil t)
1702   (autoload 'gnus-summary-reply-with-original "gnus-msg" nil t)
1703   (autoload 'gnus-summary-mail-forward "gnus-msg" nil t)
1704   (autoload 'gnus-summary-mail-other-window "gnus-msg" nil t)
1705   (autoload 'gnus-mail-reply-using-mail "gnus-msg")
1706   (autoload 'gnus-mail-yank-original "gnus-msg")
1707   (autoload 'gnus-mail-send-and-exit "gnus-msg")
1708   (autoload 'gnus-mail-forward-using-mail "gnus-msg")
1709   (autoload 'gnus-mail-other-window-using-mail "gnus-msg")
1710   (autoload 'gnus-article-mail-with-original "gnus-msg")
1711   (autoload 'gnus-article-mail "gnus-msg")
1712   (autoload 'gnus-bug "gnus-msg" nil t)
1713
1714   ;; gnus-vm
1715   (autoload 'gnus-summary-save-in-vm "gnus-vm" nil t)
1716   (autoload 'gnus-summary-save-article-vm "gnus-vm" nil t)
1717   (autoload 'gnus-mail-forward-using-vm "gnus-vm")
1718   (autoload 'gnus-mail-reply-using-vm "gnus-vm")
1719   (autoload 'gnus-mail-other-window-using-vm "gnus-vm" nil t)
1720   (autoload 'gnus-yank-article "gnus-vm" nil t)
1721
1722   )
1723
1724 \f
1725
1726 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1727 ;; If you want the cursor to go somewhere else, set these two
1728 ;; functions in some startup hook to whatever you want.
1729 (defalias 'gnus-summary-position-cursor 'gnus-goto-colon)
1730 (defalias 'gnus-group-position-cursor 'gnus-goto-colon)
1731
1732 ;;; Various macros and substs.
1733
1734 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
1735   "Pop to BUFFER, evaluate FORMS, and then returns to original window."
1736   (` (let ((GnusStartBufferWindow (selected-window)))
1737        (unwind-protect
1738            (progn
1739              (pop-to-buffer (, buffer))
1740              (,@ forms))
1741          (select-window GnusStartBufferWindow)))))
1742
1743 (defmacro gnus-gethash (string hashtable)
1744   "Get hash value of STRING in HASHTABLE."
1745   ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
1746   ;;(` (abbrev-expansion (, string) (, hashtable)))
1747   (` (symbol-value (intern-soft (, string) (, hashtable)))))
1748
1749 (defmacro gnus-sethash (string value hashtable)
1750   "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
1751   ;; We cannot use define-abbrev since it only accepts string as value.
1752   ;; (set (intern string hashtable) value))
1753   (` (set (intern (, string) (, hashtable)) (, value))))
1754
1755 (defsubst gnus-buffer-substring (beg end)
1756   (buffer-substring (match-beginning beg) (match-end end)))
1757
1758 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
1759 ;;   function `substring' might cut on a middle of multi-octet
1760 ;;   character.
1761
1762 (defun gnus-truncate-string (str width)
1763   (substring str 0 width))
1764
1765 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way
1766 ;; to limit the length of a string. This function is necessary since
1767 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
1768 (defsubst gnus-limit-string (str width)
1769   (if (> (length str) width)
1770       (substring str 0 width)
1771     str))
1772
1773 (defsubst gnus-simplify-subject-re (subject)
1774   "Remove \"Re:\" from subject lines."
1775   (let ((case-fold-search t))
1776     (if (string-match "^re: *" subject)
1777         (substring subject (match-end 0))
1778       subject)))
1779
1780 (defsubst gnus-goto-char (point)
1781   (and point (goto-char point)))
1782
1783 (defmacro gnus-buffer-exists-p (buffer)
1784   (` (and (, buffer)
1785           (funcall (if (stringp (, buffer)) 'get-buffer 'buffer-name)
1786                    (, buffer)))))
1787
1788 (defmacro gnus-kill-buffer (buffer)
1789   (` (if (gnus-buffer-exists-p (, buffer))
1790          (kill-buffer (, buffer)))))
1791
1792 (defsubst gnus-point-at-bol ()
1793   "Return point at the beginning of line."
1794   (let ((p (point)))
1795     (beginning-of-line)
1796     (prog1
1797         (point)
1798       (goto-char p))))
1799
1800 (defsubst gnus-point-at-eol ()
1801   "Return point at the beginning of line."
1802   (let ((p (point)))
1803     (end-of-line)
1804     (prog1
1805         (point)
1806       (goto-char p))))
1807
1808 ;; Delete the current line (and the next N lines.);
1809 (defmacro gnus-delete-line (&optional n)
1810   (` (delete-region (progn (beginning-of-line) (point))
1811                     (progn (forward-line (, (or n 1))) (point)))))
1812
1813 ;;; Load the compatability functions. 
1814
1815 (require 'gnus-ems)
1816
1817 \f
1818 ;;;
1819 ;;; Gnus Utility Functions
1820 ;;;
1821
1822 (defun gnus-extract-address-components (from)
1823   (let (name address)
1824     ;; First find the address - the thing with the @ in it.  This may
1825     ;; not be accurate in mail addresses, but does the trick most of
1826     ;; the time in news messages.
1827     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
1828         (setq address (substring from (match-beginning 0) (match-end 0))))
1829     ;; Then we check whether the "name <address>" format is used.
1830     (and address
1831          (string-match (concat "<" (regexp-quote address) ">") from)
1832          (and (setq name (substring from 0 (1- (match-beginning 0))))
1833               ;; Strip any quotes from the name.
1834               (string-match "\".*\"" name)
1835               (setq name (substring name 1 (1- (match-end 0))))))
1836     ;; If not, then "address (name)" is used.
1837     (or name
1838         (and (string-match "(.+)" from)
1839              (setq name (substring from (1+ (match-beginning 0)) 
1840                                    (1- (match-end 0)))))
1841         (and (string-match "()" from)
1842              (setq name address))
1843         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
1844         ;; XOVER might not support folded From headers.
1845         (and (string-match "(.*" from)
1846              (setq name (substring from (1+ (match-beginning 0)) 
1847                                    (match-end 0)))))
1848     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1849     (list (or name from) (or address from))))
1850
1851 (defun gnus-fetch-field (field)
1852   "Return the value of the header FIELD of current article."
1853   (save-excursion
1854     (save-restriction
1855       (let ((case-fold-search t))
1856         (gnus-narrow-to-headers)
1857         (mail-fetch-field field)))))
1858
1859 (defun gnus-goto-colon ()
1860   (beginning-of-line)
1861   (search-forward ":" (gnus-point-at-eol) t))
1862
1863 (defun gnus-narrow-to-headers ()
1864   (widen)
1865   (save-excursion
1866     (narrow-to-region
1867      (goto-char (point-min))
1868      (if (search-forward "\n\n" nil t)
1869          (1- (point))
1870        (point-max)))))
1871
1872 (defun gnus-update-format-specifications ()
1873   (gnus-make-thread-indent-array)
1874   (setq gnus-summary-line-format-spec 
1875         (gnus-parse-format
1876          gnus-summary-line-format gnus-summary-line-format-alist))
1877   (gnus-update-summary-mark-positions)
1878   (setq gnus-summary-dummy-line-format-spec 
1879         (gnus-parse-format gnus-summary-dummy-line-format 
1880                            gnus-summary-dummy-line-format-alist))
1881   (setq gnus-group-line-format-spec
1882         (gnus-parse-format 
1883          gnus-group-line-format 
1884          gnus-group-line-format-alist))
1885   (if (and (string-match "%D" gnus-group-line-format)
1886            (not gnus-description-hashtb)
1887            gnus-read-active-file)
1888       (gnus-read-all-descriptions-files))
1889   (setq gnus-summary-mode-line-format-spec 
1890         (gnus-parse-format gnus-summary-mode-line-format 
1891                            gnus-summary-mode-line-format-alist))
1892   (setq gnus-article-mode-line-format-spec 
1893         (gnus-parse-format gnus-article-mode-line-format 
1894                            gnus-summary-mode-line-format-alist))
1895   (setq gnus-group-mode-line-format-spec 
1896         (gnus-parse-format gnus-group-mode-line-format 
1897                            gnus-group-mode-line-format-alist)))
1898
1899 (defun gnus-update-summary-mark-positions ()
1900   (save-excursion
1901     (let ((gnus-replied-mark 129)
1902           (gnus-score-below-mark 130)
1903           (gnus-score-over-mark 130)
1904           (thread nil)
1905           pos)
1906       (gnus-set-work-buffer)
1907       (gnus-summary-insert-line 
1908        nil [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
1909       (goto-char (point-min))
1910       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
1911                                          (- (point) 2)))))
1912       (goto-char (point-min))
1913       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
1914                                           (- (point) 2))) pos))
1915       (goto-char (point-min))
1916       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
1917                                         (- (point) 2))) pos))
1918       (setq gnus-summary-mark-positions pos))))
1919
1920 (defun gnus-format-max-width (form length)
1921   (let* ((val (eval form))
1922          (valstr (if (numberp val) (int-to-string val) val)))
1923     (gnus-limit-string valstr length)))
1924
1925 (defun gnus-set-mouse-face (string)
1926   ;; Set mouse face property on STRING.
1927   (put-text-property 0 (length string) 'mouse-face gnus-mouse-face string)
1928   string)
1929
1930 (defun gnus-parse-format (format spec-alist)
1931   ;; This function parses the FORMAT string with the help of the
1932   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1933   ;; string.  If the FORMAT string contains the specifiers %( and %)
1934   ;; the text between them will have the mouse-face text property.
1935   (if (string-match "\\`\\(.*\\)%(\\(.*\\)%)\\(.*\n?\\)\\'" format)
1936       (if (and gnus-visual gnus-mouse-face)
1937           (let ((pre (substring format (match-beginning 1) (match-end 1)))
1938                 (button (substring format (match-beginning 2) (match-end 2)))
1939                 (post (substring format (match-beginning 3) (match-end 3))))
1940             (list 'concat
1941                   (gnus-parse-simple-format pre spec-alist)
1942                   (list 'gnus-set-mouse-face
1943                         (gnus-parse-simple-format button spec-alist))
1944                   (gnus-parse-simple-format post spec-alist)))
1945         (gnus-parse-simple-format
1946          (concat (substring format (match-beginning 1) (match-end 1))
1947                  (substring format (match-beginning 2) (match-end 2))
1948                  (substring format (match-beginning 3) (match-end 3)))
1949          spec-alist))
1950     (gnus-parse-simple-format format spec-alist)))
1951
1952 (defun gnus-parse-simple-format (format spec-alist)
1953   ;; This function parses the FORMAT string with the help of the
1954   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1955   ;; string. The list will consist of the symbol `format', a format
1956   ;; specification string, and a list of forms depending on the
1957   ;; SPEC-ALIST.
1958   (let ((max-width 0)
1959         spec flist fstring newspec elem beg)
1960     (save-excursion
1961       (gnus-set-work-buffer)
1962       (insert format)
1963       (goto-char (point-min))
1964       (while (re-search-forward "%[-0-9]*\\(,[0-9]*\\)*\\(.\\)\\(.\\)?" nil t)
1965         (setq spec (string-to-char (buffer-substring (match-beginning 2)
1966                                                      (match-end 2))))
1967         ;; First check if there are any specs that look anything like
1968         ;; "%12,12A", ie. with a "max width specification". These have
1969         ;; to be treated specially.
1970         (if (setq beg (match-beginning 1))
1971             (setq max-width 
1972                   (string-to-int 
1973                    (buffer-substring (1+ (match-beginning 1)) (match-end 1))))
1974           (setq max-width 0)
1975           (setq beg (match-beginning 2)))
1976         ;; Find the specification from `spec-alist'.
1977         (if (not (setq elem (cdr (assq spec spec-alist))))
1978             (setq elem '("*" ?s)))
1979         ;; Treat user defined format specifiers specially
1980         (and (eq (car elem) 'user-defined)
1981              (setq elem
1982                    (list 
1983                     (list (intern (concat "gnus-user-format-function-"
1984                                           (buffer-substring
1985                                            (match-beginning 3)
1986                                            (match-end 3))))
1987                           'header)
1988                     ?s))
1989              (delete-region (match-beginning 3) (match-end 3)))
1990         (if (not (zerop max-width))
1991             (let ((el (car elem)))
1992               (cond ((= (car (cdr elem)) ?c) 
1993                      (setq el (list 'char-to-string el)))
1994                     ((= (car (cdr elem)) ?d)
1995                      (numberp el) (setq el (list 'int-to-string el))))
1996               (setq flist (cons (list 'gnus-format-max-width el max-width) 
1997                                 flist))
1998               (setq newspec ?s))
1999           (setq flist (cons (car elem) flist))
2000           (setq newspec (car (cdr elem))))
2001         ;; Remove the old specification (and possibly a ",12" string).
2002         (delete-region beg (match-end 2))
2003         ;; Insert the new specification.
2004         (goto-char beg)
2005         (insert newspec))
2006       (setq fstring (buffer-substring 1 (point-max))))
2007     (cons 'format (cons fstring (nreverse flist)))))
2008
2009 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2010 (defun gnus-read-init-file ()
2011   (and gnus-init-file
2012        (or (and (file-exists-p gnus-init-file) 
2013                 ;; Don't try to load a directory.
2014                 (not (file-directory-p gnus-init-file)))
2015            (file-exists-p (concat gnus-init-file ".el"))
2016            (file-exists-p (concat gnus-init-file ".elc")))
2017        (load gnus-init-file nil t)))
2018
2019 (defun gnus-set-work-buffer ()
2020   (if (get-buffer gnus-work-buffer)
2021       (progn
2022         (set-buffer gnus-work-buffer)
2023         (erase-buffer))
2024     (set-buffer (get-buffer-create gnus-work-buffer))
2025     (kill-all-local-variables)
2026     (buffer-disable-undo (current-buffer))
2027     (gnus-add-current-to-buffer-list)))
2028
2029 ;; Article file names when saving.
2030
2031 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2032   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2033 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2034 Otherwise, it is like ~/News/news/group/num."
2035   (let ((default
2036           (expand-file-name
2037            (concat (if (gnus-use-long-file-name 'not-save)
2038                        (gnus-capitalize-newsgroup newsgroup)
2039                      (gnus-newsgroup-directory-form newsgroup))
2040                    "/" (int-to-string (header-number headers)))
2041            (or gnus-article-save-directory "~/News"))))
2042     (if (and last-file
2043              (string-equal (file-name-directory default)
2044                            (file-name-directory last-file))
2045              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2046         default
2047       (or last-file default))))
2048
2049 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2050   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2051 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
2052 Otherwise, it is like ~/News/news/group/num."
2053   (let ((default
2054           (expand-file-name
2055            (concat (if (gnus-use-long-file-name 'not-save)
2056                        newsgroup
2057                      (gnus-newsgroup-directory-form newsgroup))
2058                    "/" (int-to-string (header-number headers)))
2059            (or gnus-article-save-directory "~/News"))))
2060     (if (and last-file
2061              (string-equal (file-name-directory default)
2062                            (file-name-directory last-file))
2063              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2064         default
2065       (or last-file default))))
2066
2067 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2068   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2069 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
2070 Otherwise, it is like ~/News/news/group/news."
2071   (or last-file
2072       (expand-file-name
2073        (if (gnus-use-long-file-name 'not-save)
2074            (gnus-capitalize-newsgroup newsgroup)
2075          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2076        (or gnus-article-save-directory "~/News"))))
2077
2078 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2079   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2080 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
2081 Otherwise, it is like ~/News/news/group/news."
2082   (or last-file
2083       (expand-file-name
2084        (if (gnus-use-long-file-name 'not-save)
2085            newsgroup
2086          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2087        (or gnus-article-save-directory "~/News"))))
2088
2089 ;; For subscribing new newsgroup
2090
2091 (defun gnus-subscribe-hierarchical-interactive (groups)
2092   (let ((groups (sort groups 'string<))
2093         prefixes prefix start ans group starts)
2094     (while groups
2095       (setq prefixes (list "^"))
2096       (while (and groups prefixes)
2097         (while (not (string-match (car prefixes) (car groups)))
2098           (setq prefixes (cdr prefixes)))
2099         (setq prefix (car prefixes))
2100         (setq start (1- (length prefix)))
2101         (if (and (string-match "[^\\.]\\." (car groups) start)
2102                  (cdr groups)
2103                  (setq prefix 
2104                        (concat "^" (substring (car groups) 0 (match-end 0))))
2105                  (string-match prefix (car (cdr groups))))
2106             (progn
2107               (setq prefixes (cons prefix prefixes))
2108               (message "Descend hierarchy %s? ([y]nsq): " 
2109                        (substring prefix 1 (1- (length prefix))))
2110               (setq ans (read-char))
2111               (cond ((= ans ?n)
2112                      (while (and groups 
2113                                  (string-match prefix 
2114                                                (setq group (car groups))))
2115                        (setq gnus-killed-list 
2116                              (cons group gnus-killed-list))
2117                        (gnus-sethash group group gnus-killed-hashtb)
2118                        (setq groups (cdr groups)))
2119                      (setq starts (cdr starts)))
2120                     ((= ans ?s)
2121                      (while (and groups 
2122                                  (string-match prefix 
2123                                                (setq group (car groups))))
2124                        (gnus-sethash group group gnus-killed-hashtb)
2125                        (gnus-subscribe-alphabetically (car groups))
2126                        (setq groups (cdr groups)))
2127                      (setq starts (cdr starts)))
2128                     ((= ans ?q)
2129                      (while groups
2130                        (setq group (car groups))
2131                        (setq gnus-killed-list (cons group gnus-killed-list))
2132                        (gnus-sethash group group gnus-killed-hashtb)
2133                        (setq groups (cdr groups))))
2134                     (t nil)))
2135           (message "Subscribe %s? ([n]yq)" (car groups))
2136           (setq ans (read-char))
2137           (setq group (car groups))
2138           (cond ((= ans ?y)
2139                  (gnus-subscribe-alphabetically (car groups))
2140                  (gnus-sethash group group gnus-killed-hashtb))
2141                 ((= ans ?q)
2142                  (while groups
2143                    (setq group (car groups))
2144                    (setq gnus-killed-list (cons group gnus-killed-list))
2145                    (gnus-sethash group group gnus-killed-hashtb)
2146                    (setq groups (cdr groups))))
2147                 (t 
2148                  (setq gnus-killed-list (cons group gnus-killed-list))
2149                  (gnus-sethash group group gnus-killed-hashtb)))
2150           (setq groups (cdr groups)))))))
2151
2152 (defun gnus-subscribe-randomly (newsgroup)
2153   "Subscribe new NEWSGROUP by making it the first newsgroup."
2154   (gnus-subscribe-newsgroup newsgroup))
2155
2156 (defun gnus-subscribe-alphabetically (newgroup)
2157   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2158   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2159   (let ((groups (cdr gnus-newsrc-alist))
2160         before)
2161     (while (and (not before) groups)
2162       (if (string< newgroup (car (car groups)))
2163           (setq before (car (car groups)))
2164         (setq groups (cdr groups))))
2165     (gnus-subscribe-newsgroup newgroup before)))
2166
2167 (defun gnus-subscribe-hierarchically (newgroup)
2168   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2169   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2170   (save-excursion
2171     (set-buffer (find-file-noselect gnus-current-startup-file))
2172     (let ((groupkey newgroup)
2173           before)
2174       (while (and (not before) groupkey)
2175         (goto-char (point-min))
2176         (let ((groupkey-re
2177                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2178           (while (and (re-search-forward groupkey-re nil t)
2179                       (progn
2180                         (setq before (buffer-substring
2181                                       (match-beginning 1) (match-end 1)))
2182                         (string< before newgroup)))))
2183         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2184         (setq groupkey
2185               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2186                   (substring groupkey (match-beginning 1) (match-end 1)))))
2187       (gnus-subscribe-newsgroup newgroup before))))
2188
2189 (defun gnus-subscribe-interactively (newsgroup)
2190   "Subscribe new NEWSGROUP interactively.
2191 It is inserted in hierarchical newsgroup order if subscribed. If not,
2192 it is killed."
2193   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
2194       (gnus-subscribe-hierarchically newsgroup)
2195     (setq gnus-killed-list (cons newsgroup gnus-killed-list))))
2196
2197 (defun gnus-subscribe-zombies (newsgroup)
2198   "Make new NEWSGROUP a zombie group."
2199   (setq gnus-zombie-list (cons newsgroup gnus-zombie-list)))
2200
2201 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2202   "Subscribe new NEWSGROUP.
2203 If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
2204 the first newsgroup."
2205   ;; We subscribe the group by changing its level to `subscribed'.
2206   (gnus-group-change-level 
2207    newsgroup gnus-level-default-subscribed
2208    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2209   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2210
2211 ;; For directories
2212
2213 (defun gnus-newsgroup-directory-form (newsgroup)
2214   "Make hierarchical directory name from NEWSGROUP name."
2215   (let ((newsgroup (substring newsgroup 0)) ;Copy string.
2216         (len (length newsgroup))
2217         idx)
2218     ;; If this is a foreign group, we don't want to translate the
2219     ;; entire name.  
2220     (if (setq idx (string-match ":" newsgroup))
2221         (aset newsgroup idx ?/)
2222       (setq idx 0))
2223     ;; Replace all occurrences of `.' with `/'.
2224     (while (< idx len)
2225       (if (= (aref newsgroup idx) ?.)
2226           (aset newsgroup idx ?/))
2227       (setq idx (1+ idx)))
2228     newsgroup))
2229
2230 (defun gnus-make-directory (dir)
2231   "Make DIRECTORY recursively."
2232   (let* ((dir (expand-file-name dir default-directory))
2233          dirs)
2234     (if (string-match "/$" dir)
2235         (setq dir (substring dir 0 (match-beginning 0))))
2236     (while (not (file-exists-p dir))
2237       (setq dirs (cons dir dirs))
2238       (string-match "/[^/]+$" dir)
2239       (setq dir (substring dir 0 (match-beginning 0))))
2240     (while dirs
2241       (make-directory (car dirs))
2242       (setq dirs (cdr dirs)))))
2243
2244 (defun gnus-capitalize-newsgroup (newsgroup)
2245   "Capitalize NEWSGROUP name."
2246   (and (not (zerop (length newsgroup)))
2247        (concat (char-to-string (upcase (aref newsgroup 0)))
2248                (substring newsgroup 1))))
2249
2250 ;; Var
2251
2252 (defun gnus-simplify-subject (subject &optional re-only)
2253   "Remove `Re:' and words in parentheses.
2254 If optional argument RE-ONLY is non-nil, strip `Re:' only."
2255   (let ((case-fold-search t))           ;Ignore case.
2256     ;; Remove `Re:' and `Re^N:'.
2257     (if (string-match "^re:[ \t]*" subject)
2258         (setq subject (substring subject (match-end 0))))
2259     ;; Remove words in parentheses from end.
2260     (or re-only
2261         (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2262           (setq subject (substring subject 0 (match-beginning 0)))))
2263     ;; Return subject string.
2264     subject))
2265
2266 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2267 ;; all whitespace.
2268 (defun gnus-simplify-subject-fuzzy (subject)
2269   (let ((case-fold-search t))
2270     (save-excursion
2271       (gnus-set-work-buffer)
2272       (insert subject)
2273       (inline (gnus-simplify-buffer-fuzzy))
2274       (buffer-string))))
2275
2276 (defun gnus-simplify-buffer-fuzzy ()
2277   (goto-char (point-min))
2278   ;; Fix by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2279   (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2280                             nil t)
2281     (replace-match "" t t))
2282   (goto-char (point-min))
2283   (while (re-search-forward "[ \t\n]*([^()]*)[ \t\n]*$" nil t)
2284     (replace-match "" t t))
2285   (goto-char (point-min))
2286   (while (re-search-forward "[ \t]+" nil t)
2287     (replace-match " " t t))
2288   (goto-char (point-min))
2289   (while (re-search-forward "[ \t]+$" nil t)
2290     (replace-match "" t t))
2291   (goto-char (point-min))
2292   (while (re-search-forward "^[ \t]+" nil t)
2293     (replace-match "" t t))
2294   (if gnus-simplify-subject-fuzzy-regexp
2295       (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
2296         (replace-match "" t t)))
2297     )
2298
2299 ;; Add the current buffer to the list of buffers to be killed on exit. 
2300 (defun gnus-add-current-to-buffer-list ()
2301   (or (memq (current-buffer) gnus-buffer-list)
2302       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
2303
2304 (defun gnus-string> (s1 s2)
2305   (not (or (string< s1 s2)
2306            (string= s1 s2))))
2307
2308 ;; Functions accessing headers.
2309 ;; Functions are more convenient than macros in some cases.
2310
2311 (defun gnus-header-number (header)
2312   (header-number header))
2313
2314 (defun gnus-header-subject (header)
2315   (header-subject header))
2316
2317 (defun gnus-header-from (header)
2318   (header-from header))
2319
2320 (defun gnus-header-xref (header)
2321   (header-xref header))
2322
2323 (defun gnus-header-lines (header)
2324   (header-lines header))
2325
2326 (defun gnus-header-date (header)
2327   (header-date header))
2328
2329 (defun gnus-header-id (header)
2330   (header-id header))
2331
2332 (defun gnus-header-references (header)
2333   (header-references header))
2334
2335 ;;; General various misc type functions.
2336
2337 (defun gnus-clear-system ()
2338   "Clear all variables and buffers."
2339   ;; Clear Gnus variables.
2340   (let ((variables gnus-variable-list))
2341     (while variables
2342       (set (car variables) nil)
2343       (setq variables (cdr variables))))
2344   ;; Clear other internal variables.
2345   (setq gnus-list-of-killed-groups nil
2346         gnus-have-read-active-file nil
2347         gnus-newsrc-alist nil
2348         gnus-newsrc-hashtb nil
2349         gnus-killed-list nil
2350         gnus-zombie-list nil
2351         gnus-killed-hashtb nil
2352         gnus-active-hashtb nil
2353         gnus-moderated-list nil
2354         gnus-description-hashtb nil
2355         gnus-newsgroup-headers nil
2356         gnus-newsgroup-headers-hashtb-by-number nil
2357         gnus-newsgroup-name nil
2358         gnus-server-alist nil
2359         gnus-current-select-method nil)
2360   ;; Reset any score variables.
2361   (and (boundp 'gnus-score-cache)
2362        (set 'gnus-score-cache nil))
2363   (and (boundp 'gnus-internal-global-score-files)
2364        (set 'gnus-internal-global-score-files nil))
2365   ;; Kill the startup file.
2366   (and gnus-current-startup-file
2367        (get-file-buffer gnus-current-startup-file)
2368        (kill-buffer (get-file-buffer gnus-current-startup-file)))
2369   ;; Save any cache buffers.
2370   (and gnus-use-cache (gnus-cache-save-buffers))
2371   ;; Clear the dribble buffer.
2372   (gnus-dribble-clear)
2373   ;; Kill global KILL file buffer.
2374   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
2375       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
2376   (gnus-kill-buffer nntp-server-buffer)
2377   ;; Kill Gnus buffers.
2378   (while gnus-buffer-list
2379     (gnus-kill-buffer (car gnus-buffer-list))
2380     (setq gnus-buffer-list (cdr gnus-buffer-list))))
2381
2382 (defun gnus-windows-old-to-new (setting)
2383   (if (symbolp setting)
2384       (setq setting 
2385             (cond ((eq setting 'SelectArticle)
2386                    'article)
2387                   ((eq setting 'SelectSubject)
2388                    'summary)
2389                   ((eq setting 'SelectNewsgroup)
2390                    'group)
2391                   (t setting))))
2392   (if (or (listp setting)
2393           (not (and gnus-window-configuration
2394                     (memq setting '(group summary article)))))
2395       setting
2396     (let* ((setting (if (eq setting 'group) 
2397                         (if (assq 'newsgroup gnus-window-configuration)
2398                             'newsgroup
2399                           'newsgroups) setting))
2400            (elem (car (cdr (assq setting gnus-window-configuration))))
2401            (total (apply '+ elem))
2402            (types '(group summary article))
2403            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
2404            (i 0)
2405            perc
2406            out)
2407       (while (< i 3)
2408         (or (zerop (nth i elem))
2409             (progn
2410               (setq perc  (/ (* 1.0 (nth 0 elem)) total))
2411               (setq out (cons (if (eq pbuf (nth i types))
2412                                   (vector (nth i types) perc 'point)
2413                                 (vector (nth i types) perc))
2414                               out))))
2415         (setq i (1+ i)))
2416       (list (nreverse out)))))
2417            
2418 (defun gnus-add-configuration (conf)
2419   (setq gnus-buffer-configuration 
2420         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
2421                          gnus-buffer-configuration))))
2422
2423 (defun gnus-configure-windows (setting)
2424   (setq setting (gnus-windows-old-to-new setting))
2425   (let ((r (if (symbolp setting)
2426                   (cdr (assq setting gnus-buffer-configuration))
2427                 setting))
2428         (in-buf (current-buffer))
2429         rule val w height hor ohor heights sub jump-buffer
2430         rel total to-buf)
2431     (or r (error "No such setting: %s" setting))
2432
2433     ;; Either remove all windows or just remove all Gnus windows.
2434     (if gnus-use-full-window
2435         (delete-other-windows)
2436       (gnus-remove-some-windows)
2437       (switch-to-buffer nntp-server-buffer))
2438
2439     (while r
2440       (setq hor (car r)
2441             ohor nil)
2442
2443       ;; We have to do the (possible) horizontal splitting before the
2444       ;; vertical. 
2445       (if (and (listp (car hor)) 
2446                (eq (car (car hor)) 'horizontal))
2447           (progn
2448             (split-window 
2449              nil
2450              (if (integerp (nth 1 (car hor)))
2451                  (nth 1 (car hor))
2452                (- (frame-width) (floor (* (frame-width) (nth 1 (car hor))))))
2453              t)
2454             (setq hor (cdr hor))))
2455
2456       ;; Go through the rules and eval the elements that are to be
2457       ;; evaled.  
2458       (while hor
2459         (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor))))
2460             (progn
2461               ;; Expand short buffer name.
2462               (setq w (aref val 0))
2463               (and (setq w (cdr (assq w gnus-window-to-buffer)))
2464                    (progn
2465                      (setq val (apply 'vector (mapcar (lambda (v) v) val)))
2466                      (aset val 0 w)))
2467               (setq ohor (cons val ohor))))
2468         (setq hor (cdr hor)))
2469       (setq rule (cons (nreverse ohor) rule))
2470       (setq r (cdr r)))
2471     (setq rule (nreverse rule))
2472
2473     ;; We tally the window sizes.
2474     (setq total (window-height))
2475     (while rule
2476       (setq hor (car rule))
2477       (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal))
2478           (setq hor (cdr hor)))
2479       (setq sub 0)
2480       (while hor
2481         (setq rel (aref (car hor) 1)
2482               heights (cons
2483                        (cond ((and (floatp rel) (= 1.0 rel))
2484                               'x)
2485                              ((integerp rel)
2486                               rel)
2487                              (t
2488                               (max (floor (* total rel)) 4)))
2489                        heights)
2490               sub (+ sub (if (numberp (car heights)) (car heights) 0))
2491               hor (cdr hor)))
2492       (setq heights (nreverse heights)
2493             hor (car rule))
2494
2495       ;; We then go through these heighs and create windows for them.
2496       (while heights
2497         (setq height (car heights)
2498               heights (cdr heights))
2499         (and (eq height 'x)
2500              (setq height (- total sub)))
2501         (and heights
2502              (split-window nil height))
2503         (setq to-buf (aref (car hor) 0))
2504         (switch-to-buffer 
2505          (cond ((not to-buf)
2506                 in-buf)
2507                ((symbolp to-buf)
2508                 (symbol-value (aref (car hor) 0)))
2509                (t
2510                 (aref (car hor) 0))))
2511         (and (> (length (car hor)) 2)
2512              (eq (aref (car hor) 2) 'point)
2513              (setq jump-buffer (current-buffer)))
2514         (other-window 1)
2515         (setq hor (cdr hor)))
2516       
2517       (setq rule (cdr rule)))
2518
2519     ;; Finally, we pop to the buffer that's supposed to have point. 
2520     (or jump-buffer (error "Missing `point' in spec for %s" setting))
2521
2522     (select-window (get-buffer-window jump-buffer))
2523     (set-buffer jump-buffer)))
2524       
2525 (defun gnus-remove-some-windows ()
2526   (let ((buffers gnus-window-to-buffer)
2527         (first t)
2528         buf)
2529     (save-excursion
2530       ;; Remove windows on all known Gnus buffers.
2531       (while buffers
2532         (setq buf (cdr (car buffers)))
2533         (if (symbolp buf)
2534             (setq buf (and (boundp buf) (symbol-value buf))))
2535         (and buf 
2536              (get-buffer-window buf)
2537              (progn
2538                (if first
2539                    (progn
2540                      (pop-to-buffer buf)
2541                      (switch-to-buffer nntp-server-buffer)
2542                      (setq first nil))
2543                  (delete-window (get-buffer-window buf)))))
2544         (setq buffers (cdr buffers)))
2545       ;; Remove windows on *all* summary buffers.
2546       (let ((buffers (buffer-list)))
2547         (while buffers
2548           (if (and (string-match 
2549                     "^\\*Summary" (or (buffer-name (car buffers)) ""))
2550                    (get-buffer-window (car buffers)))
2551               (delete-window (get-buffer-window (car buffers))))
2552           (setq buffers (cdr buffers)))))))
2553                           
2554 (defun gnus-version ()
2555   "Version numbers of this version of Gnus."
2556   (interactive)
2557   (let ((methods gnus-valid-select-methods)
2558         (mess gnus-version)
2559         meth)
2560     ;; Go through all the legal select methods and add their version
2561     ;; numbers to the total version string. Only the backends that are
2562     ;; currently in use will have their message numbers taken into
2563     ;; consideration. 
2564     (while methods
2565       (setq meth (intern (concat (car (car methods)) "-version")))
2566       (and (boundp meth)
2567            (stringp (symbol-value meth))
2568            (setq mess (concat mess "; " (symbol-value meth))))
2569       (setq methods (cdr methods)))
2570     (gnus-message 2 mess)))
2571
2572 (defun gnus-info-find-node ()
2573   "Find Info documentation of Gnus."
2574   (interactive)
2575   ;; Enlarge info window if needed.
2576   (let ((mode major-mode))
2577     (gnus-configure-windows 'info)
2578     (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))))
2579
2580 (defun gnus-overload-functions (&optional overloads)
2581   "Overload functions specified by optional argument OVERLOADS.
2582 If nothing is specified, use the variable gnus-overload-functions."
2583   (let ((defs nil)
2584         (overloads (or overloads gnus-overload-functions)))
2585     (while overloads
2586       (setq defs (car overloads))
2587       (setq overloads (cdr overloads))
2588       ;; Load file before overloading function if necessary.  Make
2589       ;; sure we cannot use `require' always.
2590       (and (not (fboundp (car defs)))
2591            (car (cdr (cdr defs)))
2592            (load (car (cdr (cdr defs))) nil 'nomessage))
2593       (fset (car defs) (car (cdr defs))))))
2594
2595 (defun gnus-replace-chars-in-string (string from to)
2596   "Replace characters in STRING from FROM to TO."
2597   (let ((string (substring string 0))   ;Copy string.
2598         (len (length string))
2599         (idx 0))
2600     ;; Replace all occurrences of FROM with TO.
2601     (while (< idx len)
2602       (if (= (aref string idx) from)
2603           (aset string idx to))
2604       (setq idx (1+ idx)))
2605     string))
2606
2607 (defun gnus-days-between (date1 date2)
2608   ;; Return the number of days between date1 and date2.
2609   (- (gnus-day-number date1) (gnus-day-number date2)))
2610
2611 (defun gnus-day-number (date)
2612   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
2613                      (timezone-parse-date date))))
2614     (timezone-absolute-from-gregorian 
2615      (nth 1 dat) (nth 2 dat) (car dat))))
2616
2617 ;; Returns a floating point number that says how many seconds have
2618 ;; lapsed between Jan 1 12:00:00 1970 and DATE.
2619 (defun gnus-seconds-since-epoch (date)
2620   (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
2621                         (timezone-parse-date date)))
2622          (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
2623                         (timezone-parse-time
2624                          (aref (timezone-parse-date date) 3))))
2625          (edate (mapcar (lambda (ti) (and ti (string-to-int ti)))
2626                         (timezone-parse-date "Jan 1 12:00:00 1970")))
2627          (tday (- (timezone-absolute-from-gregorian 
2628                    (nth 1 tdate) (nth 2 tdate) (nth 0 tdate))
2629                   (timezone-absolute-from-gregorian 
2630                    (nth 1 edate) (nth 2 edate) (nth 0 edate)))))
2631     (+ (nth 2 ttime)
2632        (* (nth 1 ttime) 60)
2633        (* 1.0 (nth 0 ttime) 60 60)
2634        (* 1.0 tday 60 60 24))))
2635
2636 (defun gnus-file-newer-than (file date)
2637   (let ((fdate (nth 5 (file-attributes file))))
2638     (or (> (car fdate) (car date))
2639         (and (= (car fdate) (car date))
2640              (> (nth 1 fdate) (nth 1 date))))))
2641
2642 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
2643 ;; the echo area.
2644 (defun gnus-y-or-n-p (prompt)
2645   (prog1
2646       (y-or-n-p prompt)
2647     (message "")))
2648
2649 (defun gnus-yes-or-no-p (prompt)
2650   (prog1
2651       (yes-or-no-p prompt)
2652     (message "")))
2653
2654 ;; Check whether to use long file names.
2655 (defun gnus-use-long-file-name (symbol)
2656   ;; The variable has to be set...
2657   (and gnus-use-long-file-name
2658        ;; If it isn't a list, then we return t.
2659        (or (not (listp gnus-use-long-file-name))
2660            ;; If it is a list, and the list contains `symbol', we
2661            ;; return nil.  
2662            (not (memq symbol gnus-use-long-file-name)))))
2663
2664 ;; I suspect there's a better way, but I haven't taken the time to do
2665 ;; it yet. -erik selberg@cs.washington.edu
2666 (defun gnus-dd-mmm (messy-date)
2667   "Return a string like DD-MMM from a big messy string"
2668   (let ((datevec (timezone-parse-date messy-date)))
2669     (format "%2s-%s"
2670             (or (aref datevec 2) "??")
2671             (capitalize
2672              (or (car 
2673                   (nth (1- (string-to-number (aref datevec 1)))
2674                        timezone-months-assoc))
2675                  "???")))))
2676
2677 ;; Make a hash table (default and minimum size is 255).
2678 ;; Optional argument HASHSIZE specifies the table size.
2679 (defun gnus-make-hashtable (&optional hashsize)
2680   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
2681
2682 ;; Make a number that is suitable for hashing; bigger than MIN and one
2683 ;; less than 2^x.
2684 (defun gnus-create-hash-size (min)
2685   (let ((i 1))
2686     (while (< i min)
2687       (setq i (* 2 i)))
2688     (1- i)))
2689
2690 ;; Show message if message has a lower level than `gnus-verbose'. 
2691 ;; Guide-line for numbers:
2692 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
2693 ;; for things that take a long time, 7 - not very important messages
2694 ;; on stuff, 9 - messages inside loops.
2695 (defun gnus-message (level &rest args)
2696   (if (<= level gnus-verbose)
2697       (apply 'message args)
2698     ;; We have to do this format thingie here even if the result isn't
2699     ;; shown - the return value has to be the same as the return value
2700     ;; from `message'.
2701     (apply 'format args)))
2702
2703 ;; Generate a unique new group name.
2704 (defun gnus-generate-new-group-name (leaf)
2705   (let ((name leaf)
2706         (num 0))
2707     (while (gnus-gethash name gnus-newsrc-hashtb)
2708       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
2709     name))
2710
2711 (defun gnus-find-file-noselect (file &optional force)
2712   "Does vaguely the same as find-file-noselect. No hooks are run."
2713   (let (buf insert)
2714     (if (setq buf (get-file-buffer file))
2715         (setq insert force)
2716       (setq buf (create-file-buffer file))
2717       (setq insert t))
2718     (if (not insert)
2719         buf
2720       (save-excursion
2721         (set-buffer buf)
2722         (erase-buffer)
2723         (and (file-readable-p file)
2724              (insert-file-contents file))
2725         (set-visited-file-name file)
2726         (set-buffer-modified-p nil)
2727         (current-buffer)))))
2728
2729 ;;; List and range functions
2730
2731 (defun gnus-last-element (list)
2732   "Return last element of LIST."
2733   (while (cdr list)
2734     (setq list (cdr list)))
2735   (car list))
2736
2737 (defun gnus-copy-sequence (list)
2738   "Do a complete, total copy of a list."
2739   (if (and (consp list) (not (consp (cdr list))))
2740       (cons (car list) (cdr list))
2741     (mapcar (lambda (elem) (if (consp elem) 
2742                                (if (consp (cdr elem))
2743                                    (gnus-copy-sequence elem)
2744                                  (cons (car elem) (cdr elem)))
2745                              elem))
2746             list)))
2747
2748 (defun gnus-set-difference (list1 list2)
2749   "Return a list of elements of LIST1 that do not appear in LIST2."
2750   (let ((list1 (copy-sequence list1)))
2751     (while list2
2752       (setq list1 (delq (car list2) list1))
2753       (setq list2 (cdr list2)))
2754     list1))
2755
2756 (defun gnus-sorted-complement (list1 list2)
2757   "Return a list of elements of LIST1 that do not appear in LIST2.
2758 Both lists have to be sorted over <."
2759   (let (out)
2760     (if (or (null list1) (null list2))
2761         (or list1 list2)
2762       (while (and list1 list2)
2763         (cond ((= (car list1) (car list2))
2764                (setq list1 (cdr list1)
2765                      list2 (cdr list2)))
2766               ((< (car list1) (car list2))
2767                (setq out (cons (car list1) out))
2768                (setq list1 (cdr list1)))
2769               (t
2770                (setq out (cons (car list2) out))
2771                (setq list2 (cdr list2)))))
2772       (nconc (nreverse out) (or list1 list2)))))
2773
2774 (defun gnus-intersection (list1 list2)      
2775   (let ((result nil))
2776     (while list2
2777       (if (memq (car list2) list1)
2778           (setq result (cons (car list2) result)))
2779       (setq list2 (cdr list2)))
2780     result))
2781
2782 (defun gnus-sorted-intersection (list1 list2)
2783   ;; LIST1 and LIST2 have to be sorted over <.
2784   (let (out)
2785     (while (and list1 list2)
2786       (cond ((= (car list1) (car list2))
2787              (setq out (cons (car list1) out)
2788                    list1 (cdr list1)
2789                    list2 (cdr list2)))
2790             ((< (car list1) (car list2))
2791              (setq list1 (cdr list1)))
2792             (t
2793              (setq list2 (cdr list2)))))
2794     (nreverse out)))
2795
2796 (defun gnus-set-sorted-intersection (list1 list2)
2797   ;; LIST1 and LIST2 have to be sorted over <.
2798   ;; This function modifies LIST1.
2799   (let* ((top (cons nil list1))
2800          (prev top))
2801   (while (and list1 list2)
2802     (cond ((= (car list1) (car list2))
2803            (setq prev list1
2804                  list1 (cdr list1)
2805                  list2 (cdr list2)))
2806           ((< (car list1) (car list2))
2807            (setcdr prev (cdr list1))
2808            (setq list1 (cdr list1)))
2809           (t
2810            (setq list2 (cdr list2)))))
2811   (setcdr prev nil)
2812   (cdr top)))
2813
2814 (defun gnus-compress-sequence (numbers &optional always-list)
2815   "Convert list of numbers to a list of ranges or a single range.
2816 If ALWAYS-LIST is non-nil, this function will always release a list of
2817 ranges."
2818   (let* ((first (car numbers))
2819          (last (car numbers))
2820          result)
2821     (if (null numbers)
2822         nil
2823       (if (not (listp (cdr numbers)))
2824           numbers
2825         (while numbers
2826           (cond ((= last (car numbers)) nil) ;Omit duplicated number
2827                 ((= (1+ last) (car numbers)) ;Still in sequence
2828                  (setq last (car numbers)))
2829                 (t                      ;End of one sequence
2830                  (setq result 
2831                        (cons (if (= first last) first
2832                                (cons first last)) result))
2833                  (setq first (car numbers))
2834                  (setq last  (car numbers))))
2835           (setq numbers (cdr numbers)))
2836         (if (and (not always-list) (null result))
2837             (if (= first last) (list first) (cons first last))
2838           (nreverse (cons (if (= first last) first (cons first last))
2839                           result)))))))
2840
2841 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
2842 (defun gnus-uncompress-range (ranges)
2843   "Expand a list of ranges into a list of numbers.
2844 RANGES is either a single range on the form `(num . num)' or a list of
2845 these ranges."
2846   (let (first last result)
2847     (cond 
2848      ((null ranges)
2849       nil)
2850      ((not (listp (cdr ranges)))
2851       (setq first (car ranges))
2852       (setq last (cdr ranges))
2853       (while (<= first last)
2854         (setq result (cons first result))
2855         (setq first (1+ first)))
2856       (nreverse result))
2857      (t
2858       (while ranges
2859         (if (atom (car ranges))
2860             (if (numberp (car ranges))
2861                 (setq result (cons (car ranges) result)))
2862           (setq first (car (car ranges)))
2863           (setq last  (cdr (car ranges)))
2864           (while (<= first last)
2865             (setq result (cons first result))
2866             (setq first (1+ first))))
2867         (setq ranges (cdr ranges)))
2868       (nreverse result)))))
2869
2870 (defun gnus-add-to-range (ranges list)
2871   "Return a list of ranges that has all articles from both RANGES and LIST.
2872 Note: LIST has to be sorted over `<'."
2873   (if (not ranges)
2874       (gnus-compress-sequence list t)
2875     (setq list (copy-sequence list))
2876     (or (listp (cdr ranges))
2877         (setq ranges (list ranges)))
2878     (let ((out ranges)
2879           ilist lowest highest temp)
2880       (while (and ranges list)
2881         (setq ilist list)
2882         (setq lowest (or (and (atom (car ranges)) (car ranges))
2883                          (car (car ranges))))
2884         (while (and list (cdr list) (< (car (cdr list)) lowest))
2885           (setq list (cdr list)))
2886         (if (< (car ilist) lowest)
2887             (progn
2888               (setq temp list)
2889               (setq list (cdr list))
2890               (setcdr temp nil)
2891               (setq out (nconc (gnus-compress-sequence ilist t) out))))
2892         (setq highest (or (and (atom (car ranges)) (car ranges))
2893                           (cdr (car ranges))))
2894         (while (and list (<= (car list) highest))
2895           (setq list (cdr list)))
2896         (setq ranges (cdr ranges)))
2897       (if list
2898           (setq out (nconc (gnus-compress-sequence list t) out)))
2899       (setq out (sort out (lambda (r1 r2) 
2900                             (< (or (and (atom r1) r1) (car r1))
2901                                (or (and (atom r2) r2) (car r2))))))
2902       (setq ranges out)
2903       (while ranges
2904         (if (atom (car ranges))
2905             (if (cdr ranges)
2906                 (if (atom (car (cdr ranges)))
2907                     (if (= (1+ (car ranges)) (car (cdr ranges)))
2908                         (progn
2909                           (setcar ranges (cons (car ranges) 
2910                                                (car (cdr ranges))))
2911                           (setcdr ranges (cdr (cdr ranges)))))
2912                   (if (= (1+ (car ranges)) (car (car (cdr ranges))))
2913                       (progn
2914                         (setcar (car (cdr ranges)) (car ranges))
2915                         (setcar ranges (car (cdr ranges)))
2916                         (setcdr ranges (cdr (cdr ranges)))))))
2917           (if (cdr ranges)
2918               (if (atom (car (cdr ranges)))
2919                   (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
2920                       (progn
2921                         (setcdr (car ranges) (car (cdr ranges)))
2922                         (setcdr ranges (cdr (cdr ranges)))))
2923                 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
2924                     (progn
2925                       (setcdr (car ranges) (cdr (car (cdr ranges))))
2926                       (setcdr ranges (cdr (cdr ranges))))))))
2927         (setq ranges (cdr ranges)))
2928       out)))
2929
2930 (defun gnus-remove-from-range (ranges list)
2931   "Return a list of ranges that has all articles from LIST removed from RANGES.
2932 Note: LIST has to be sorted over `<'."
2933   ;; !!! This function shouldn't look like this, but I've got a headache.
2934   (gnus-compress-sequence 
2935    (gnus-sorted-complement
2936     (gnus-uncompress-range ranges) list)))
2937
2938 (defun gnus-member-of-range (number ranges)
2939   (if (not (listp (cdr ranges)))
2940       (and (>= number (car ranges)) 
2941            (<= number (cdr ranges)))
2942     (let ((not-stop t))
2943       (while (and ranges 
2944                   (if (numberp (car ranges))
2945                       (>= number (car ranges))
2946                     (>= number (car (car ranges))))
2947                   not-stop)
2948         (if (if (numberp (car ranges))
2949                 (= number (car ranges))
2950               (and (>= number (car (car ranges)))
2951                    (<= number (cdr (car ranges)))))
2952             (setq not-stop nil))
2953         (setq ranges (cdr ranges)))
2954       (not not-stop))))
2955
2956 \f
2957 ;;;
2958 ;;; Gnus group mode
2959 ;;;
2960
2961 (defvar gnus-group-mode-map nil)
2962 (defvar gnus-group-group-map nil)
2963 (defvar gnus-group-mark-map nil)
2964 (defvar gnus-group-list-map nil)
2965 (defvar gnus-group-sub-map nil)
2966 (put 'gnus-group-mode 'mode-class 'special)
2967
2968 (if gnus-group-mode-map
2969     nil
2970   (setq gnus-group-mode-map (make-keymap))
2971   (suppress-keymap gnus-group-mode-map)
2972   (define-key gnus-group-mode-map " " 'gnus-group-read-group)
2973   (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
2974   (define-key gnus-group-mode-map "\r" 'gnus-group-select-group)
2975   (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
2976   (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
2977   (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
2978   (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
2979   (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
2980   (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
2981   (define-key gnus-group-mode-map "\M-n" 'gnus-group-next-unread-group-same-level)
2982   (define-key gnus-group-mode-map "\M-p" 'gnus-group-prev-unread-group-same-level)
2983   (define-key gnus-group-mode-map "," 'gnus-group-best-unread-group)
2984   (define-key gnus-group-mode-map "." 'gnus-group-first-unread-group)
2985   (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
2986   (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
2987   (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current)
2988   (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all)
2989   (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
2990   (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
2991   (define-key gnus-group-mode-map "m" 'gnus-group-mail)
2992   (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
2993   (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group)
2994   (define-key gnus-group-mode-map "R" 'gnus-group-restart)
2995   (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file)
2996   (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server)
2997   (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
2998   (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups)
2999   (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group)
3000   (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups)
3001   (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos)
3002   (define-key gnus-group-mode-map "\C-c\M-C-a" 'gnus-group-description-apropos)
3003   (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
3004   (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
3005   (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
3006   (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
3007   (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
3008   (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
3009   (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
3010   (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed)
3011   (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles)
3012   (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups)
3013   (define-key gnus-group-mode-map "V" 'gnus-version)
3014   (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc)
3015   (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
3016   (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble)
3017   (define-key gnus-group-mode-map "q" 'gnus-group-exit)
3018   (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
3019   (define-key gnus-group-mode-map "\M-f" 'gnus-group-fetch-faq)
3020   (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
3021   (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
3022   (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method)
3023   (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode)
3024   (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group)
3025   (define-key gnus-group-mode-map "<" 'beginning-of-buffer)
3026   (define-key gnus-group-mode-map ">" 'end-of-buffer)
3027   (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug)
3028   (define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups)
3029
3030   (define-key gnus-group-mode-map "#" 'gnus-group-mark-group)
3031   (define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group)
3032   (define-prefix-command 'gnus-group-mark-map)
3033   (define-key gnus-group-mode-map "M" 'gnus-group-mark-map)
3034   (define-key gnus-group-mark-map "m" 'gnus-group-mark-group)
3035   (define-key gnus-group-mark-map "u" 'gnus-group-unmark-group)
3036   (define-key gnus-group-mark-map "w" 'gnus-group-mark-region)
3037
3038   (define-prefix-command 'gnus-group-group-map)
3039   (define-key gnus-group-mode-map "G" 'gnus-group-group-map)
3040   (define-key gnus-group-group-map "d" 'gnus-group-make-directory-group)
3041   (define-key gnus-group-group-map "h" 'gnus-group-make-help-group)
3042   (define-key gnus-group-group-map "a" 'gnus-group-make-archive-group)
3043   (define-key gnus-group-group-map "k" 'gnus-group-make-kiboze-group)
3044   (define-key gnus-group-group-map "m" 'gnus-group-make-group)
3045   (define-key gnus-group-group-map "E" 'gnus-group-edit-group)
3046   (define-key gnus-group-group-map "e" 'gnus-group-edit-group-method)
3047   (define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters)
3048   (define-key gnus-group-group-map "v" 'gnus-group-add-to-virtual)
3049   (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual)
3050   (define-key gnus-group-group-map "D" 'gnus-group-enter-directory)
3051   (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group)
3052   (define-key gnus-group-group-map "sb" 'gnus-group-brew-soup)
3053   (define-key gnus-group-group-map "sw" 'gnus-soup-save-areas)
3054   (define-key gnus-group-group-map "ss" 'gnus-soup-send-replies)
3055   (define-key gnus-group-group-map "sp" 'gnus-soup-pack-packet)
3056   (define-key gnus-group-group-map "sr" 'nnsoup-pack-replies)
3057
3058   (define-prefix-command 'gnus-group-list-map)
3059   (define-key gnus-group-mode-map "A" 'gnus-group-list-map)
3060   (define-key gnus-group-list-map "k" 'gnus-group-list-killed)
3061   (define-key gnus-group-list-map "z" 'gnus-group-list-zombies)
3062   (define-key gnus-group-list-map "s" 'gnus-group-list-groups)
3063   (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups)
3064   (define-key gnus-group-list-map "a" 'gnus-group-apropos)
3065   (define-key gnus-group-list-map "d" 'gnus-group-description-apropos)
3066   (define-key gnus-group-list-map "m" 'gnus-group-list-matching)
3067   (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching)
3068
3069   (define-prefix-command 'gnus-group-sub-map)
3070   (define-key gnus-group-mode-map "S" 'gnus-group-sub-map)
3071   (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level)
3072   (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group)
3073   (define-key gnus-group-sub-map "s" 'gnus-group-unsubscribe-group)
3074   (define-key gnus-group-sub-map "k" 'gnus-group-kill-group)
3075   (define-key gnus-group-sub-map "y" 'gnus-group-yank-group)
3076   (define-key gnus-group-sub-map "w" 'gnus-group-kill-region)
3077   (define-key gnus-group-sub-map "z" 'gnus-group-kill-all-zombies))
3078
3079 (defun gnus-group-mode ()
3080   "Major mode for reading news.
3081
3082 All normal editing commands are switched off.
3083 \\<gnus-group-mode-map>
3084 The group buffer lists (some of) the groups available.  For instance,
3085 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
3086 lists all zombie groups. 
3087
3088 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe 
3089 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. 
3090
3091 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). 
3092
3093 The following commands are available:
3094
3095 \\{gnus-group-mode-map}"
3096   (interactive)
3097   (if gnus-visual (gnus-group-make-menu-bar))
3098   (kill-all-local-variables)
3099   (setq mode-line-modified "-- ")
3100   (make-local-variable 'mode-line-format)
3101   (setq mode-line-format (copy-sequence mode-line-format))
3102   (and (equal (nth 3 mode-line-format) "   ")
3103        (setcar (nthcdr 3 mode-line-format) ""))
3104   (setq major-mode 'gnus-group-mode)
3105   (setq mode-name "Group")
3106   (gnus-group-set-mode-line)
3107   (setq mode-line-process nil)
3108   (use-local-map gnus-group-mode-map)
3109   (buffer-disable-undo (current-buffer))
3110   (setq truncate-lines t)
3111   (setq buffer-read-only t)
3112   (run-hooks 'gnus-group-mode-hook))
3113
3114 (defun gnus-mouse-pick-group (e)
3115   (interactive "e")
3116   (mouse-set-point e)
3117   (gnus-group-read-group nil))
3118
3119 ;;;###autoload
3120 (defun gnus-no-server (&optional arg)
3121   "Read network news.
3122 If ARG is a positive number, Gnus will use that as the
3123 startup level. If ARG is nil, Gnus will be started at level 2. 
3124 If ARG is non-nil and not a positive number, Gnus will
3125 prompt the user for the name of an NNTP server to use.
3126 As opposed to `gnus', this command will not connect to the local server."
3127   (interactive "P")
3128   (setq gnus-group-use-permanent-levels t)
3129   (gnus (or arg (1- gnus-level-default-subscribed)) t))
3130
3131 (defalias '\(ding\) 'gnus)
3132
3133 ;;;###autoload
3134 (defun gnus (&optional arg dont-connect)
3135   "Read network news.
3136 If ARG is non-nil and a positive number, Gnus will use that as the
3137 startup level. If ARG is non-nil and not a positive number, Gnus will
3138 prompt the user for the name of an NNTP server to use."
3139   (interactive "P")
3140   (if (get-buffer gnus-group-buffer)
3141       (progn
3142         (switch-to-buffer gnus-group-buffer)
3143         (gnus-group-get-new-news))
3144     (gnus-clear-system)
3145     (nnheader-init-server-buffer)
3146     (gnus-read-init-file)
3147     (let ((level (and arg (numberp arg) (> arg 0) arg))
3148           did-connect)
3149       (unwind-protect
3150           (progn
3151             (gnus-group-setup-buffer)
3152             (or dont-connect 
3153                 (setq did-connect
3154                       (gnus-start-news-server (and arg (not level))))))
3155         (if (and (not dont-connect) 
3156                  (not did-connect))
3157             (gnus-group-quit)
3158           (run-hooks 'gnus-startup-hook)
3159           ;; NNTP server is successfully open. 
3160           (gnus-update-format-specifications)
3161           (gnus-summary-make-display-table)
3162           (let ((buffer-read-only nil))
3163             (erase-buffer)
3164             (if (not gnus-inhibit-startup-message)
3165                 (progn
3166                   (gnus-group-startup-message)
3167                   (sit-for 0))))
3168           (gnus-setup-news nil level)
3169           (and gnus-use-dribble-file (gnus-dribble-open))
3170           (gnus-group-list-groups level)
3171           (gnus-configure-windows 'group))))))
3172
3173 (defun gnus-group-startup-message (&optional x y)
3174   "Insert startup message in current buffer."
3175   ;; Insert the message.
3176   (erase-buffer)
3177   (insert
3178    (format "
3179      %s
3180            A newsreader 
3181       for GNU Emacs
3182
3183         Based on GNUS 
3184              written by 
3185      Masanobu UMEDA
3186
3187        A Praxis Release
3188       larsi@ifi.uio.no
3189
3190            gnus-version))
3191   ;; And then hack it.
3192   ;; 18 is the longest line.
3193   (indent-rigidly (point-min) (point-max) 
3194                   (/ (max (- (window-width) (or x 28)) 0) 2))
3195   (goto-char (point-min))
3196   ;; +4 is fuzzy factor.
3197   (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))
3198
3199   ;; Fontify some.
3200   (goto-char (point-min))
3201   (search-forward "Praxis")
3202   (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
3203   (goto-char (point-min)))
3204
3205 (defun gnus-group-setup-buffer ()
3206   (or (get-buffer gnus-group-buffer)
3207       (progn
3208         (switch-to-buffer gnus-group-buffer)
3209         (gnus-add-current-to-buffer-list)
3210         (gnus-group-mode)
3211         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
3212
3213 (defun gnus-group-list-groups (level &optional unread)
3214   "List newsgroups with level LEVEL or lower that have unread articles.
3215 Default is all subscribed groups.
3216 If argument UNREAD is non-nil, groups with no unread articles are also listed."
3217   (interactive (list (and current-prefix-arg
3218                           (prefix-numeric-value current-prefix-arg))))
3219   (if gnus-group-use-permanent-levels
3220       (progn
3221         (setq gnus-group-default-list-level 
3222               (or level gnus-group-default-list-level))
3223         (setq level (or gnus-group-default-list-level gnus-level-subscribed)))
3224     (setq level (or level gnus-group-default-list-level 
3225                     gnus-level-subscribed)))
3226   (gnus-group-setup-buffer)     ;May call from out of group buffer
3227   (let ((case-fold-search nil)
3228         (group (gnus-group-group-name)))
3229     (funcall gnus-group-prepare-function level unread nil)
3230     (if (zerop (buffer-size))
3231         (gnus-message 5 gnus-no-groups-message)
3232       (goto-char (point-min))
3233       (if (not group)
3234           ;; Go to the first group with unread articles.
3235           (gnus-group-search-forward nil nil nil t)
3236         ;; Find the right group to put point on. If the current group
3237         ;; has disapeared in the new listing, try to find the next
3238         ;; one. If no next one can be found, just leave point at the
3239         ;; first newsgroup in the buffer.
3240         (if (not (gnus-goto-char
3241                   (text-property-any (point-min) (point-max) 
3242                                      'gnus-group (intern group))))
3243             (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
3244               (while (and newsrc
3245                           (not (gnus-goto-char 
3246                                 (text-property-any 
3247                                  (point-min) (point-max) 'gnus-group 
3248                                  (intern (car (car newsrc)))))))
3249                 (setq newsrc (cdr newsrc)))
3250               (or newsrc (progn (goto-char (point-max))
3251                                 (forward-line -1))))))
3252       ;; Adjust cursor point.
3253       (gnus-group-position-cursor))))
3254
3255 (defun gnus-group-prepare-flat (level &optional all lowest regexp) 
3256   "List all newsgroups with unread articles of level LEVEL or lower.
3257 If ALL is non-nil, list groups that have no unread articles.
3258 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
3259 If REGEXP, only list groups matching REGEXP."
3260   (set-buffer gnus-group-buffer)
3261   (let ((buffer-read-only nil)
3262         (newsrc (cdr gnus-newsrc-alist))
3263         (lowest (or lowest 1))
3264         info clevel unread group)
3265     (erase-buffer)
3266     (if (< lowest gnus-level-zombie)
3267         ;; List living groups.
3268         (while newsrc
3269           (setq info (car newsrc)
3270                 group (car info)
3271                 newsrc (cdr newsrc)
3272                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
3273           (and unread ; This group might be bogus
3274                (or (not regexp)
3275                    (string-match regexp group))
3276                (<= (setq clevel (car (cdr info))) level) 
3277                (>= clevel lowest)
3278                (or all            ; We list all groups?
3279                    (eq unread t)  ; We list unactivated groups
3280                    (> unread 0)   ; We list groups with unread articles
3281                    (cdr (assq 'tick (nth 3 info)))) ; And groups with tickeds
3282                (gnus-group-insert-group-line 
3283                 nil group (car (cdr info)) (nth 3 info) unread (nth 4 info)))))
3284
3285     ;; List dead groups.
3286     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
3287          (gnus-group-prepare-flat-list-dead 
3288           (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 
3289           gnus-level-zombie ?Z
3290           regexp))
3291     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
3292          (gnus-group-prepare-flat-list-dead 
3293           (setq gnus-killed-list (sort gnus-killed-list 'string<)) 
3294           gnus-level-killed ?K regexp))
3295
3296     (gnus-group-set-mode-line)
3297     (setq gnus-have-all-newsgroups all)
3298     (run-hooks 'gnus-group-prepare-hook)))
3299
3300 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
3301   ;; List zombies and killed lists somehwat faster, which was
3302   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
3303   ;; this by ignoring the group format specification altogether.
3304   (let (group beg)
3305     (while groups
3306       (setq group (car groups)
3307             groups (cdr groups))
3308       (if (or (not regexp)
3309               (string-match regexp group))
3310           (progn
3311             (setq beg (point))
3312             (insert (format " %c     *: %s\n" mark group))
3313             (add-text-properties 
3314              beg (1+ beg) 
3315              (list 'gnus-group (intern group)
3316                    'gnus-unread t
3317                    'gnus-level level)))))))
3318
3319 (defun gnus-group-real-name (group)
3320   "Find the real name of a foreign newsgroup."
3321   (if (string-match ":[^:]+$" group)
3322       (substring group (1+ (match-beginning 0)))
3323     group))
3324
3325 (defun gnus-group-prefixed-name (group method)
3326   "Return the whole name from GROUP and METHOD."
3327   (and (stringp method) (setq method (gnus-server-to-method method)))
3328   (concat (format "%s" (car method))
3329           (if (and 
3330                (assoc (format "%s" (car method)) (gnus-methods-using 'address))
3331                (not (string= (nth 1 method) "")))
3332               (concat "+" (nth 1 method)))
3333           ":" group))
3334
3335 (defun gnus-group-real-prefix (group)
3336   "Return the prefix of the current group name."
3337   (if (string-match "^[^:]+:" group)
3338       (substring group 0 (match-end 0))
3339     ""))
3340
3341 (defun gnus-group-method-name (group)
3342   "Return the method used for selecting GROUP."
3343   (let ((prefix (gnus-group-real-prefix group)))
3344     (if (equal prefix "")
3345         gnus-select-method
3346       (if (string-match "^[^\\+]+\\+" prefix)
3347           (list (intern (substring prefix 0 (1- (match-end 0))))
3348                 (substring prefix (match-end 0) (1- (length prefix))))
3349         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
3350
3351 (defun gnus-group-foreign-p (group)
3352   "Return nil if GROUP is native, non-nil if it is foreign."
3353   (string-match ":" group))
3354
3355 (defun gnus-group-set-info (info &optional method-only-group part)
3356   (let* ((entry (gnus-gethash
3357                  (or method-only-group (car info)) gnus-newsrc-hashtb))
3358          (part-info info)
3359          (info (if method-only-group (nth 2 entry) info)))
3360     (if (not method-only-group)
3361         ()
3362       (or entry
3363           (error "Trying to change non-existent group %s" method-only-group))
3364       ;; We have recevied parts of the actual group info - either the
3365       ;; select method or the group parameters.  We first check
3366       ;; whether we have to extend the info, and if so, do that.
3367       (let ((len (length info))
3368             (total (if (eq part 'method) 5 6)))
3369         (and (< len total)
3370              (setcdr (nthcdr (1- len) info)
3371                      (make-list (- total len) nil)))
3372         ;; Then we enter the new info.
3373         (setcar (nthcdr (1- total) info) part-info)))
3374     ;; We uncompress some lists of marked articles.
3375     (let (marked)
3376       (if (not (setq marked (nth 3 info)))
3377           ()
3378         (while marked
3379           (or (eq 'score (car (car marked)))
3380               (eq 'bookmark (car (car marked)))
3381               (eq 'killed (car (car marked)))
3382               (setcdr (car marked) 
3383                       (gnus-uncompress-range (cdr (car marked)))))
3384           (setq marked (cdr marked)))))
3385     (if entry
3386         ()
3387       ;; This is a new group, so we just create it.
3388       (save-excursion
3389         (set-buffer gnus-group-buffer)
3390         (if (nth 4 info)
3391             ;; It's a foreign group...
3392             (gnus-group-make-group 
3393              (gnus-group-real-name (car info))
3394              (prin1-to-string (car (nth 4 info)))
3395              (nth 1 (nth 4 info)))
3396           ;; It's a native group.
3397           (gnus-group-make-group
3398            (car info)
3399            (prin1-to-string (car gnus-select-method))
3400            (nth 1 gnus-select-method)))
3401         (gnus-message 6 "Note: New group created")
3402         (setq entry 
3403               (gnus-gethash (gnus-group-prefixed-name 
3404                              (gnus-group-real-name (car info))
3405                              (or (nth 4 info) gnus-select-method))
3406                             gnus-newsrc-hashtb))))
3407     ;; Whether it was a new group or not, we now have the entry, so we
3408     ;; can do the update.
3409     (if entry
3410         (progn
3411           (setcar (nthcdr 2 entry) info)
3412           (if (and (not (eq (car entry) t)) 
3413                    (gnus-gethash (car info) gnus-active-hashtb))
3414               (let ((marked (nth 3 info)))
3415                 (setcar entry 
3416                         (max 0 (- (length (gnus-list-of-unread-articles 
3417                                            (car info)))
3418                                   (length (cdr (assq 'tick marked)))
3419                                   (length (cdr (assq 'dormant marked)))))))))
3420       (error "No such group: %s" (car info)))))
3421
3422 (defun gnus-group-set-method-info (group select-method)
3423   (gnus-group-set-info select-method group 'method))
3424
3425 (defun gnus-group-set-params-info (group params)
3426   (gnus-group-set-info params group 'params))
3427
3428 (defun gnus-group-update-group-line ()
3429   "This function updates the current line in the newsgroup buffer and
3430 moves the point to the colon."
3431   (let* ((buffer-read-only nil)
3432          (group (gnus-group-group-name))
3433          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
3434     (if entry
3435         (gnus-dribble-enter 
3436          (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
3437                  ")")))
3438     (beginning-of-line)
3439     (delete-region (point) (progn (forward-line 1) (point)))
3440     (gnus-group-insert-group-line-info group)
3441     (forward-line -1)
3442     (gnus-group-position-cursor)))
3443
3444 (defun gnus-group-insert-group-line-info (group)
3445   (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) 
3446         active info)
3447     (if entry
3448         (progn
3449           (setq info (nth 2 entry))
3450           (gnus-group-insert-group-line 
3451            nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
3452       (setq active (gnus-gethash group gnus-active-hashtb))
3453       (gnus-group-insert-group-line 
3454        nil group 
3455        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
3456        nil (if active (- (1+ (cdr active)) (car active)) 0) nil))))
3457
3458 (defun gnus-group-insert-group-line (gformat group level marked number method)
3459   (let* ((gformat (or gformat gnus-group-line-format-spec))
3460          (active (gnus-gethash group gnus-active-hashtb))
3461          (number-total (if active (1+ (- (cdr active) (car active))) 0))
3462          (number-of-dormant (length (cdr (assq 'dormant marked))))
3463          (number-of-ticked (length (cdr (assq 'tick marked))))
3464          (number-of-ticked-and-dormant
3465           (+ number-of-ticked number-of-dormant))
3466          (number-of-unread-unticked 
3467           (if (numberp number) (int-to-string (max 0 number))
3468             "*"))
3469          (number-of-read
3470           (if (numberp number)
3471               (max 0 (- number-total number))
3472             "*"))
3473          (subscribed (cond ((<= level gnus-level-subscribed) ? )
3474                            ((<= level gnus-level-unsubscribed) ?U)
3475                            ((= level gnus-level-zombie) ?Z)
3476                            (t ?K)))
3477          (qualified-group (gnus-group-real-name group))
3478          (newsgroup-description 
3479           (if gnus-description-hashtb
3480               (or (gnus-gethash group gnus-description-hashtb) "")
3481             ""))
3482          (moderated (if (member group gnus-moderated-list) ?m ? ))
3483          (moderated-string (if (eq moderated ?m) "(m)" ""))
3484          (method (gnus-server-get-method group method))
3485          (news-server (or (car (cdr method)) ""))
3486          (news-method (or (car method) ""))
3487          (news-method-string 
3488           (if method (format "(%s:%s)" (car method) (car (cdr method))) ""))
3489          (marked (if (and 
3490                       (numberp number) 
3491                       (zerop number)
3492                       (> number-of-ticked 0))
3493                      ?* ? ))
3494          (number (if (eq number t) "*" (+ number number-of-dormant 
3495                                           number-of-ticked)))
3496          (process-marked (if (member qualified-group gnus-group-marked)
3497                              gnus-process-mark ? ))
3498          (buffer-read-only nil)
3499          b)
3500     (beginning-of-line)
3501     (setq b (point))
3502     ;; Insert the text.
3503     (insert (eval gformat))
3504
3505     (add-text-properties 
3506      b (1+ b) (list 'gnus-group (intern group)
3507                     'gnus-unread (if (numberp number)
3508                                      (string-to-int number-of-unread-unticked)
3509                                    t)
3510                     'gnus-marked marked
3511                     'gnus-level level))))
3512
3513 (defun gnus-group-update-group (group &optional visible-only)
3514   "Update newsgroup info of GROUP.
3515 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already."
3516   (save-excursion
3517     (set-buffer gnus-group-buffer)
3518     (let ((buffer-read-only nil)
3519           visible)
3520       (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
3521         (if entry
3522             (gnus-dribble-enter 
3523              (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
3524                      ")"))))
3525       ;; Buffer may be narrowed.
3526       (save-restriction
3527         (widen)
3528         ;; Search a line to modify.  If the buffer is large, the search
3529         ;; takes long time.  In most cases, current point is on the line
3530         ;; we are looking for.  So, first of all, check current line. 
3531         (if (or (progn
3532                   (beginning-of-line)
3533                   (eq (get-text-property (point) 'gnus-group)
3534                       (intern group)))
3535                 (progn
3536                   (gnus-goto-char 
3537                    (text-property-any 
3538                     (point-min) (point-max) 'gnus-group (intern group)))))
3539             ;; GROUP is listed in current buffer. So, delete old line.
3540             (progn
3541               (setq visible t)
3542               (beginning-of-line)
3543               (delete-region (point) (progn (forward-line 1) (point))))
3544           ;; No such line in the buffer, find out where it's supposed to
3545           ;; go, and insert it there (or at the end of the buffer).
3546           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
3547           (or visible-only
3548               (let ((entry 
3549                      (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
3550                 (while (and entry
3551                             (car entry)
3552                             (not
3553                              (gnus-goto-char
3554                               (text-property-any
3555                                (point-min) (point-max) 
3556                                'gnus-group (intern (car (car entry)))))))
3557                   (setq entry (cdr entry)))
3558                 (or entry (goto-char (point-max)))))))
3559       (if (or visible (not visible-only))
3560           (gnus-group-insert-group-line-info group))
3561       (gnus-group-set-mode-line))))
3562
3563 (defun gnus-group-set-mode-line ()
3564   (if (memq 'group gnus-updated-mode-lines)
3565       (let* ((gformat (or gnus-group-mode-line-format-spec
3566                           (setq gnus-group-mode-line-format-spec
3567                                 (gnus-parse-format 
3568                                  gnus-group-mode-line-format 
3569                                  gnus-group-mode-line-format-alist))))
3570              (news-server (car (cdr gnus-select-method)))
3571              (news-method (car gnus-select-method))
3572              (max-len 60)
3573              (mode-string (eval gformat)))
3574         (setq mode-string (eval gformat))
3575         (if (> (length mode-string) max-len) 
3576             (setq mode-string (substring mode-string 0 (- max-len 4))))
3577         (setq mode-line-buffer-identification mode-string)
3578         (set-buffer-modified-p t))))
3579
3580 (defun gnus-group-group-name ()
3581   "Get the name of the newsgroup on the current line."
3582   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
3583     (and group (symbol-name group))))
3584
3585 (defun gnus-group-group-level ()
3586   "Get the level of the newsgroup on the current line."
3587   (get-text-property (gnus-point-at-bol) 'gnus-level))
3588
3589 (defun gnus-group-group-unread ()
3590   "Get the number of unread articles of the newsgroup on the current line."
3591   (get-text-property (gnus-point-at-bol) 'gnus-unread))
3592
3593 (defun gnus-group-search-forward (&optional backward all level first-too)
3594   "Find the next newsgroup with unread articles.
3595 If BACKWARD is non-nil, find the previous newsgroup instead.
3596 If ALL is non-nil, just find any newsgroup.
3597 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
3598 group exists.
3599 If FIRST-TOO, the current line is also eligible as a target."
3600   (let ((way (if backward -1 1))
3601         (low 10)
3602         (beg (point))
3603         pos found)
3604     (if (and backward (progn (beginning-of-line)) (bobp))
3605         nil
3606       (or first-too (forward-line way))
3607       (while (and 
3608               (not (eobp))
3609               (not (setq 
3610                     found 
3611                     (and (or all
3612                              (and
3613                               (let ((unread 
3614                                      (get-text-property (point) 'gnus-unread)))
3615                                 (or (eq unread t) (and unread (> unread 0))))
3616                               (let ((lev (get-text-property
3617                                           (point) 'gnus-level)))
3618                                 (and lev (<= (get-text-property 
3619                                               (point) 'gnus-level)
3620                                              gnus-level-subscribed)))))
3621                          (or (not level)
3622                              (let ((lev (get-text-property (point) 'gnus-level)))
3623                                (if (and lev (<= lev level))
3624                                    t
3625                                  (if (< lev low)
3626                                      (progn
3627                                        (setq low lev)
3628                                        (setq pos (point))))
3629                                  nil))))))
3630               (zerop (forward-line way)))))
3631     (if found 
3632         (progn (gnus-group-position-cursor) t)
3633       (if pos (goto-char pos) (goto-char beg))
3634       nil)))
3635
3636 ;;; Gnus group mode commands
3637
3638 ;; Group marking.
3639
3640 (defun gnus-group-mark-group (n &optional unmark no-advance)
3641   "Mark the current group."
3642   (interactive "p")
3643   (let ((buffer-read-only nil)
3644         group)
3645     (while 
3646         (and (> n 0) 
3647              (setq group (gnus-group-group-name))
3648              (progn
3649                (beginning-of-line)
3650                (forward-char 2)
3651                (delete-char 1)
3652                (if unmark
3653                    (progn
3654                      (insert " ")
3655                      (setq gnus-group-marked (delete group gnus-group-marked)))
3656                  (insert "#")
3657                  (setq gnus-group-marked
3658                        (cons group (delete group gnus-group-marked))))
3659                t)
3660              (or no-advance (zerop (gnus-group-next-group 1))))
3661       (setq n (1- n)))
3662     (gnus-summary-position-cursor)
3663     n))
3664
3665 (defun gnus-group-unmark-group (n)
3666   "Remove the mark from the current group."
3667   (interactive "p")
3668   (gnus-group-mark-group n 'unmark))
3669
3670 (defun gnus-group-mark-region (unmark beg end)
3671   "Mark all groups between point and mark.
3672 If UNMARK, remove the mark instead."
3673   (interactive "P\nr")
3674   (let ((num (count-lines beg end)))
3675     (save-excursion
3676       (goto-char beg)
3677       (- num (gnus-group-mark-group num unmark)))))
3678
3679 (defun gnus-group-remove-mark (group)
3680   (and (gnus-group-goto-group group)
3681        (save-excursion
3682          (gnus-group-mark-group 1 'unmark t))))
3683
3684 ;; Return a list of groups to work on.  Take into consideration N (the
3685 ;; prefix) and the list of marked groups.
3686 (defun gnus-group-process-prefix (n)
3687   (cond (n
3688          (setq n (prefix-numeric-value n))
3689          ;; There is a prefix, so we return a list of the N next
3690          ;; groups. 
3691          (let ((way (if (< n 0) -1 1))
3692                (n (abs n))
3693                group groups)
3694            (save-excursion
3695              (while (and (> n 0)
3696                          (setq group (gnus-group-group-name)))
3697                (setq groups (cons group groups))
3698                (setq n (1- n))
3699                (forward-line way)))
3700            (nreverse groups)))
3701         (gnus-group-marked
3702          ;; No prefix, but a list of marked articles.
3703          (reverse gnus-group-marked))
3704         (t
3705          ;; Neither marked articles or a prefix, so we return the
3706          ;; current group.
3707          (let ((group (gnus-group-group-name)))
3708            (and group (list group))))))
3709
3710 ;; Selecting groups.
3711
3712 (defun gnus-group-read-group (all &optional no-article group)
3713   "Read news in this newsgroup.
3714 If argument ALL is non-nil, already read articles become readable.
3715 If optional argument NO-ARTICLE is non-nil, no article body is displayed."
3716   (interactive "P")
3717   (let ((group (or group (gnus-group-group-name)))
3718         number active marked entry)
3719     (or group (error "No group on current line"))
3720     (setq marked 
3721           (nth 3 (nth 2 (setq entry (gnus-gethash group gnus-newsrc-hashtb)))))
3722     ;; This group might be a dead group. In that case we have to get
3723     ;; the number of unread articles from `gnus-active-hashtb'.
3724     (if entry
3725         (setq number (car entry))
3726       (if (setq active (gnus-gethash group gnus-active-hashtb))
3727           (setq number (- (1+ (cdr active)) (car active)))))
3728     (gnus-summary-read-group 
3729      group (or all (and (numberp number) 
3730                         (zerop (+ number (length (cdr (assq 'tick marked)))
3731                                   (length (cdr (assq 'dormant marked)))))))
3732      no-article)))
3733
3734 (defun gnus-group-select-group (all)
3735   "Select this newsgroup.
3736 No article is selected automatically.
3737 If argument ALL is non-nil, already read articles become readable."
3738   (interactive "P")
3739   (gnus-group-read-group all t))
3740
3741 ;; Enter a group that is not in the group buffer. Non-nil is returned
3742 ;; if selection was successful.
3743 (defun gnus-group-read-ephemeral-group 
3744   (group method &optional activate quit-config)
3745   (let ((group (if (gnus-group-foreign-p group) group
3746                  (gnus-group-prefixed-name group method))))
3747     (gnus-sethash 
3748      group
3749      (list t nil (list group gnus-level-default-subscribed nil nil 
3750                        (append method
3751                                (list
3752                                 (list 'quit-config 
3753                                       (if quit-config quit-config
3754                                         (cons (current-buffer) 'summary)))))))
3755      gnus-newsrc-hashtb)
3756     (set-buffer gnus-group-buffer)
3757     (or (gnus-server-opened method)
3758         (gnus-open-server method)
3759         (error "Unable to contact server: %s" (gnus-status-message method)))
3760     (if activate (gnus-request-group group))
3761     (condition-case ()
3762         (gnus-group-read-group t t group)
3763       (error nil)
3764       (quit nil))
3765     (not (equal major-mode 'gnus-group-mode))))
3766   
3767 (defun gnus-group-jump-to-group (group)
3768   "Jump to newsgroup GROUP."
3769   (interactive 
3770    (list (completing-read 
3771           "Group: " gnus-active-hashtb nil (not (not gnus-read-active-file)))))
3772
3773   (if (equal group "")
3774       (error "Empty group name"))
3775
3776   (let ((b (text-property-any 
3777             (point-min) (point-max) 'gnus-group (intern group))))
3778     (if b
3779         ;; Either go to the line in the group buffer...
3780         (goto-char b)
3781       ;; ... or insert the line.
3782       (or
3783        (gnus-gethash group gnus-active-hashtb)
3784        (gnus-activate-newsgroup group)
3785        (error "%s error: %s" group (gnus-status-message group)))
3786
3787       (gnus-group-update-group group)
3788       (goto-char (text-property-any 
3789                   (point-min) (point-max) 'gnus-group (intern group)))))
3790   ;; Adjust cursor point.
3791   (gnus-group-position-cursor))
3792
3793 (defun gnus-group-goto-group (group)
3794   "Goto to newsgroup GROUP."
3795   (let ((b (text-property-any (point-min) (point-max) 
3796                               'gnus-group (intern group))))
3797     (and b (goto-char b))))
3798
3799 (defun gnus-group-next-group (n)
3800   "Go to next N'th newsgroup.
3801 If N is negative, search backward instead.
3802 Returns the difference between N and the number of skips actually
3803 done."
3804   (interactive "p")
3805   (gnus-group-next-unread-group n t))
3806
3807 (defun gnus-group-next-unread-group (n &optional all level)
3808   "Go to next N'th unread newsgroup.
3809 If N is negative, search backward instead.
3810 If ALL is non-nil, choose any newsgroup, unread or not.
3811 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
3812 such group can be found, the next group with a level higher than
3813 LEVEL.
3814 Returns the difference between N and the number of skips actually
3815 made."
3816   (interactive "p")
3817   (let ((backward (< n 0))
3818         (n (abs n)))
3819     (while (and (> n 0)
3820                 (gnus-group-search-forward 
3821                  backward (or (not gnus-group-goto-unread) all) level))
3822       (setq n (1- n)))
3823     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
3824                                (if level " on this level or higher" "")))
3825     n))
3826
3827 (defun gnus-group-prev-group (n)
3828   "Go to previous N'th newsgroup.
3829 Returns the difference between N and the number of skips actually
3830 done."
3831   (interactive "p")
3832   (gnus-group-next-unread-group (- n) t))
3833
3834 (defun gnus-group-prev-unread-group (n)
3835   "Go to previous N'th unread newsgroup.
3836 Returns the difference between N and the number of skips actually
3837 done."  
3838   (interactive "p")
3839   (gnus-group-next-unread-group (- n)))
3840
3841 (defun gnus-group-next-unread-group-same-level (n)
3842   "Go to next N'th unread newsgroup on the same level.
3843 If N is negative, search backward instead.
3844 Returns the difference between N and the number of skips actually
3845 done."
3846   (interactive "p")
3847   (gnus-group-next-unread-group n t (gnus-group-group-level))
3848   (gnus-group-position-cursor))
3849
3850 (defun gnus-group-prev-unread-group-same-level (n)
3851   "Go to next N'th unread newsgroup on the same level.
3852 Returns the difference between N and the number of skips actually
3853 done."
3854   (interactive "p")
3855   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
3856   (gnus-group-position-cursor))
3857
3858 (defun gnus-group-best-unread-group (&optional exclude-group)
3859   "Go to the group with the highest level.
3860 If EXCLUDE-GROUP, do not go to that group."
3861   (interactive)
3862   (goto-char (point-min))
3863   (let ((best 100000)
3864         unread best-point)
3865     (while (setq unread (get-text-property (point) 'gnus-unread))
3866       (if (and (numberp unread) (> unread 0))
3867           (progn
3868             (if (and (< (get-text-property (point) 'gnus-level) best)
3869                      (or (not exclude-group)
3870                          (not (equal exclude-group (gnus-group-group-name)))))
3871                 (progn 
3872                   (setq best (get-text-property (point) 'gnus-level))
3873                   (setq best-point (point))))))
3874       (forward-line 1))
3875     (if best-point (goto-char best-point))
3876     (gnus-summary-position-cursor)
3877     (and best-point (gnus-group-group-name))))
3878
3879 (defun gnus-group-first-unread-group ()
3880   "Go to the first group with unread articles."
3881   (interactive)
3882   (goto-char (point-min))
3883   (or (not (zerop (or (get-text-property (point) 'gnus-unread) 0)))
3884       (gnus-group-next-unread-group 1))
3885   (gnus-group-position-cursor))
3886
3887 (defun gnus-group-enter-server-mode ()
3888   "Jump to the server buffer."
3889   (interactive)
3890   (gnus-server-setup-buffer)
3891   (gnus-configure-windows 'server)
3892   (gnus-server-prepare))
3893
3894 (defun gnus-group-make-group (name method &optional address)
3895   "Add a new newsgroup.
3896 The user will be prompted for a NAME, for a select METHOD, and an
3897 ADDRESS."
3898   (interactive
3899    (cons 
3900     (read-string "Group name: ")
3901     (let ((method
3902            (completing-read 
3903             "Method: " (append gnus-valid-select-methods gnus-server-alist)
3904             nil t)))
3905       (if (assoc method gnus-valid-select-methods)
3906           (list method
3907                 (if (memq 'prompt-address
3908                           (assoc method gnus-valid-select-methods))
3909                     (read-string "Address: ")
3910                   ""))
3911         (list method nil)))))
3912   
3913   (let* ((meth (if address (list (intern method) address) method))
3914          (nname (gnus-group-prefixed-name name meth))
3915          info)
3916     (and (gnus-gethash nname gnus-newsrc-hashtb)
3917          (error "Group %s already exists" nname))
3918     (gnus-group-change-level 
3919      (setq info (list t nname gnus-level-default-subscribed nil nil meth))
3920      gnus-level-default-subscribed gnus-level-killed 
3921      (and (gnus-group-group-name)
3922           (gnus-gethash (gnus-group-group-name)
3923                         gnus-newsrc-hashtb))
3924      t)
3925     (gnus-sethash nname (cons 1 0) gnus-active-hashtb)
3926     (gnus-dribble-enter 
3927      (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))
3928     (gnus-group-insert-group-line-info nname)
3929
3930     (require (intern method))
3931     (and (gnus-check-backend-function 'request-create-group nname)
3932          (gnus-request-create-group nname))))
3933
3934 (defun gnus-group-edit-group (group &optional part)
3935   "Edit the group on the current line."
3936   (interactive (list (gnus-group-group-name)))
3937   (let ((done-func '(lambda () 
3938                       "Exit editing mode and update the information."
3939                       (interactive)
3940                       (gnus-group-edit-group-done 'part 'group)))
3941         (part (or part 'info))
3942         (winconf (current-window-configuration))
3943         info)
3944     (or group (error "No group on current line"))
3945     (or (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
3946         (error "Killed group; can't be edited"))
3947     (set-buffer (get-buffer-create gnus-group-edit-buffer))
3948     (gnus-configure-windows 'edit-group)
3949     (gnus-add-current-to-buffer-list)
3950     (emacs-lisp-mode)
3951     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
3952     (use-local-map (copy-keymap emacs-lisp-mode-map))
3953     (local-set-key "\C-c\C-c" done-func)
3954     (make-local-variable 'gnus-prev-winconf)
3955     (setq gnus-prev-winconf winconf)
3956     ;; We modify the func to let it know what part it is editing.
3957     (setcar (cdr (nth 4 done-func)) (list 'quote part))
3958     (setcar (cdr (cdr (nth 4 done-func))) group)
3959     (erase-buffer)
3960     (insert
3961      (cond 
3962       ((eq part 'method)
3963        ";; Type `C-c C-c' after editing the select method.\n\n")
3964       ((eq part 'params)
3965        ";; Type `C-c C-c' after editing the group parameters.\n\n")
3966       ((eq part 'info)
3967        ";; Type `C-c C-c' after editing the group info.\n\n")))
3968     (let ((cinfo (gnus-copy-sequence info))
3969           marked)
3970       (if (not (setq marked (nth 3 cinfo)))
3971           ()
3972         (while marked
3973           (or (eq 'score (car (car marked)))
3974               (eq 'bookmark (car (car marked)))
3975               (eq 'killed (car (car marked)))
3976               (not (numberp (car (cdr (car marked)))))
3977               (setcdr (car marked) 
3978                       (gnus-compress-sequence (sort (cdr (car marked)) '<) t)))
3979           (setq marked (cdr marked))))
3980       (insert 
3981        (pp-to-string
3982         (cond ((eq part 'method)
3983                (or (nth 4 info) "native"))
3984               ((eq part 'params)
3985                (nth 5 info))
3986               (t
3987                cinfo)))
3988        "\n"))))
3989
3990 (defun gnus-group-edit-group-method (group)
3991   "Edit the select method of GROUP."
3992   (interactive (list (gnus-group-group-name)))
3993   (gnus-group-edit-group group 'method))
3994
3995 (defun gnus-group-edit-group-parameters (group)
3996   "Edit the group parameters of GROUP."
3997   (interactive (list (gnus-group-group-name)))
3998   (gnus-group-edit-group group 'params))
3999
4000 (defun gnus-group-edit-group-done (part group)
4001   "Get info from buffer, update variables and jump to the group buffer."
4002   (set-buffer (get-buffer-create gnus-group-edit-buffer))
4003   (goto-char (point-min))
4004   (let ((form (read (current-buffer)))
4005         (winconf gnus-prev-winconf))
4006     (if (eq part 'info) 
4007         (gnus-group-set-info form)
4008       (gnus-group-set-info form group part))
4009     (kill-buffer (current-buffer))
4010     (and winconf (set-window-configuration winconf))
4011     (set-buffer gnus-group-buffer)
4012     (gnus-group-update-group (gnus-group-group-name))
4013     (gnus-group-position-cursor)))
4014
4015 (defun gnus-group-make-help-group ()
4016   "Create the (ding) Gnus documentation group."
4017   (interactive)
4018   (let ((path load-path)
4019         name)
4020     (and (gnus-gethash (setq name (gnus-group-prefixed-name
4021                                    "gnus-help" '(nndoc "gnus-help")))
4022                        gnus-newsrc-hashtb)
4023          (error "Documentation group already exists"))
4024     (while (and path
4025                 (not (file-exists-p (concat (file-name-as-directory (car path))
4026                                             "doc.txt"))))
4027       (setq path (cdr path)))
4028     (or path (error "Couldn't find doc group"))
4029     (gnus-group-make-group 
4030      (gnus-group-real-name name)
4031      (list 'nndoc name
4032            (list 'nndoc-address (concat (file-name-as-directory (car path)) "doc.txt"))
4033            (list 'nndoc-article-type 'mbox))))
4034   (gnus-group-position-cursor))
4035
4036 (defun gnus-group-make-doc-group (file type)
4037   "Create a group that uses a single file as the source."
4038   (interactive 
4039    (list (read-file-name "File name: ") 
4040          (let ((err "")
4041                found char)
4042            (while (not found)
4043              (message "%sFile type (mbox, babyl, digest) [mbd]: " err)
4044              (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
4045                                ((= char ?b) 'babyl)
4046                                ((= char ?d) 'digest)
4047                                (t (setq err "%c unknown. " char)
4048                                   nil))))
4049            found)))
4050   (let* ((file (expand-file-name file))
4051          (name (gnus-generate-new-group-name
4052                 (gnus-group-prefixed-name
4053                  (file-name-nondirectory file) '(nndoc "")))))
4054     (gnus-group-make-group 
4055      (gnus-group-real-name name)
4056      (list 'nndoc name
4057            (list 'nndoc-address file)
4058            (list 'nndoc-article-type type)))))
4059
4060 (defun gnus-group-make-archive-group ()
4061   "Create the (ding) Gnus archive group."
4062   (interactive)
4063   (and (gnus-gethash (gnus-group-prefixed-name "ding.archives" '(nndir ""))
4064                      gnus-newsrc-hashtb)
4065        (error "Archive group already exists"))
4066   (gnus-group-make-group "ding.archives" "nndir" gnus-group-archive-directory)
4067   (gnus-group-position-cursor))
4068
4069 (defun gnus-group-make-directory-group (dir)
4070   "Create an nndir group.
4071 The user will be prompted for a directory. The contents of this
4072 directory will be used as a newsgroup. The directory should contain
4073 mail messages or news articles in files that have numeric names."
4074   (interactive
4075    (list (read-file-name "Create group from directory: ")))
4076   (or (file-exists-p dir) (error "No such directory"))
4077   (or (file-directory-p dir) (error "Not a directory"))
4078   (gnus-group-make-group dir "nndir" dir)
4079   (gnus-group-position-cursor))
4080
4081 (defun gnus-group-make-kiboze-group (group address scores)
4082   "Create an nnkiboze group.
4083 The user will be prompted for a name, a regexp to match groups, and
4084 score file entries for articles to include in the group."
4085   (interactive
4086    (list
4087     (read-string "nnkiboze group name: ")
4088     (read-string "Source groups (regexp): ")
4089     (let ((headers (mapcar (lambda (group) (list group))
4090                            '("subject" "from" "number" "date" "message-id"
4091                              "references" "chars" "lines" "xref")))
4092           scores header regexp regexps)
4093       (while (not (equal "" (setq header (completing-read 
4094                                           "Match on header: " headers nil t))))
4095         (setq regexps nil)
4096         (while (not (equal "" (setq regexp (read-string 
4097                                             (format "Match on %s (string): "
4098                                                     header)))))
4099           (setq regexps (cons (list regexp nil nil 'r) regexps)))
4100         (setq scores (cons (cons header regexps) scores)))
4101       scores)))
4102   (gnus-group-make-group group "nnkiboze" address)
4103   (save-excursion
4104     (gnus-set-work-buffer)
4105     (let (emacs-lisp-mode-hook)
4106       (pp scores (current-buffer)))
4107     (write-region (point-min) (point-max) 
4108                   (concat (or gnus-kill-files-directory "~/News")
4109                           "nnkiboze:" group "." gnus-score-file-suffix)))
4110   (gnus-group-position-cursor))
4111
4112 (defun gnus-group-add-to-virtual (n vgroup)
4113   "Add the current group to a virtual group."
4114   (interactive
4115    (list current-prefix-arg
4116          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
4117                           "nnvirtual:")))
4118   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
4119       (error "%s is not an nnvirtual group" vgroup))
4120   (let* ((groups (gnus-group-process-prefix n))
4121          (method (nth 4 (nth 2 (gnus-gethash vgroup gnus-newsrc-hashtb)))))
4122     (setcar (cdr method)
4123             (concat 
4124              (nth 1 method) "\\|"
4125              (mapconcat 
4126               (lambda (s) 
4127                 (gnus-group-remove-mark s)
4128                 (concat "\\(^" (regexp-quote s) "$\\)"))
4129               groups "\\|"))))
4130   (gnus-group-position-cursor))
4131
4132 (defun gnus-group-make-empty-virtual (group)
4133   "Create a new, fresh, empty virtual group."
4134   (interactive "sCreate new, empty virtual group: ")
4135   (let* ((method (list 'nnvirtual "^$"))
4136          (pgroup (gnus-group-prefixed-name group method)))
4137     ;; Check whether it exists already.
4138     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
4139          (error "Group %s already exists." pgroup))
4140     ;; Subscribe the new group after the group on the current line.
4141     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
4142     (gnus-group-update-group pgroup)
4143     (forward-line -1)
4144     (gnus-group-position-cursor)))
4145
4146 (defun gnus-group-enter-directory (dir)
4147   "Enter an ephemeral nneething group."
4148   (interactive "DDirectory to read: ")
4149   (let* ((method (list 'nneething dir))
4150          (leaf (gnus-group-prefixed-name
4151                 (file-name-nondirectory (directory-file-name dir))
4152                 method))
4153          (name (gnus-generate-new-group-name leaf)))
4154     (let ((nneething-read-only t))
4155       (or (gnus-group-read-ephemeral-group 
4156            name method t
4157            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
4158                                       'summary 'group)))
4159           (error "Couldn't enter %s" dir)))))
4160
4161 ;; Group sorting commands
4162 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
4163
4164 (defun gnus-group-sort-groups ()
4165   "Sort the group buffer using `gnus-group-sort-function'."
4166   (interactive)
4167   (setq gnus-newsrc-alist 
4168         (sort (cdr gnus-newsrc-alist) gnus-group-sort-function))
4169   (gnus-make-hashtable-from-newsrc-alist)
4170   (gnus-group-list-groups nil gnus-have-all-newsgroups))
4171
4172 (defun gnus-group-sort-by-alphabet (info1 info2)
4173   (string< (car info1) (car info2)))
4174
4175 (defun gnus-group-sort-by-unread (info1 info2)
4176   (let ((n1 (car (gnus-gethash (car info1) gnus-newsrc-hashtb)))
4177         (n2 (car (gnus-gethash (car info2) gnus-newsrc-hashtb))))
4178     (< (or (and (numberp n1) n1) 0)
4179        (or (and (numberp n2) n2) 0))))
4180
4181 (defun gnus-group-sort-by-level (info1 info2)
4182   (< (nth 1 info1) (nth 1 info2)))
4183
4184 ;; Group catching up.
4185
4186 (defun gnus-group-catchup-current (n &optional all)
4187   "Mark all articles not marked as unread in current newsgroup as read.
4188 If prefix argument N is numeric, the ARG next newsgroups will be
4189 caught up. If ALL is non-nil, marked articles will also be marked as
4190 read. Cross references (Xref: header) of articles are ignored.
4191 The difference between N and actual number of newsgroups that were
4192 caught up is returned."
4193   (interactive "P")
4194   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
4195                gnus-expert-user
4196                (gnus-y-or-n-p
4197                 (if all
4198                     "Do you really want to mark all articles as read? "
4199                   "Mark all unread articles as read? "))))
4200       n
4201     (let ((groups (gnus-group-process-prefix n))
4202           (ret 0))
4203       (while groups
4204         ;; Virtual groups have to be given special treatment. 
4205         (let ((method (gnus-find-method-for-group (car groups))))
4206           (if (eq 'nnvirtual (car method))
4207               (nnvirtual-catchup-group
4208                (gnus-group-real-name (car groups)) (nth 1 method) all)))
4209         (gnus-group-remove-mark (car groups))
4210         (if (prog1
4211                 (gnus-group-goto-group (car groups))
4212               (gnus-group-catchup (car groups) all))
4213             (gnus-group-update-group-line)
4214           (setq ret (1+ ret)))
4215         (setq groups (cdr groups)))
4216       (gnus-group-next-unread-group 1)
4217       ret)))
4218
4219 (defun gnus-group-catchup-current-all (n)
4220   "Mark all articles in current newsgroup as read.
4221 Cross references (Xref: header) of articles are ignored."
4222   (interactive "P")
4223   (gnus-group-catchup-current n 'all))
4224
4225 (defun gnus-group-catchup (group &optional all)
4226   "Mark all articles in GROUP as read.
4227 If ALL is non-nil, all articles are marked as read.
4228 The return value is the number of articles that were marked as read,
4229 or nil if no action could be taken."
4230   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
4231          (num (car entry))
4232          (marked (nth 3 (nth 2 entry))))
4233     (if (not (numberp (car entry)))
4234         (gnus-message 1 "Can't catch up; non-active group")
4235       ;; Do the updating only if the newsgroup isn't killed.
4236       (if (not entry)
4237           ()
4238         (gnus-update-read-articles 
4239          group (and (not all) (append (cdr (assq 'tick marked))
4240                                       (cdr (assq 'dormant marked))))
4241          nil (and (not all) (cdr (assq 'tick marked))))
4242         (and all marked
4243              (setcar (nthcdr 3 (nth 2 entry)) 
4244                      (delq (assq 'dormant marked) 
4245                            (nth 3 (nth 2 entry)))))))
4246     num))
4247
4248 (defun gnus-group-expire-articles (n)
4249   "Expire all expirable articles in the current newsgroup."
4250   (interactive "P")
4251   (let ((groups (gnus-group-process-prefix n))
4252         group)
4253     (or groups (error "No groups to expire"))
4254     (while groups
4255       (setq group (car groups)
4256             groups (cdr groups))
4257       (gnus-group-remove-mark group)
4258       (if (not (gnus-check-backend-function 'request-expire-articles group))
4259           ()
4260         (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
4261                (expirable (if (memq 'total-expire (nth 5 info))
4262                               (cons nil (gnus-list-of-read-articles group))
4263                             (assq 'expire (nth 3 info)))))
4264           (and expirable 
4265                (setcdr expirable
4266                        (gnus-request-expire-articles 
4267                         (cdr expirable) group))))))))
4268
4269 (defun gnus-group-expire-all-groups ()
4270   "Expire all expirable articles in all newsgroups."
4271   (interactive)
4272   (save-excursion
4273     (gnus-message 5 "Expiring...")
4274     (let ((gnus-group-marked (mapcar (lambda (info) (car info))
4275                                      (cdr gnus-newsrc-alist))))
4276       (gnus-group-expire-articles nil)))
4277   (gnus-group-position-cursor)
4278   (gnus-message 5 "Expiring...done"))
4279
4280 (defun gnus-group-set-current-level (n level)
4281   "Set the level of the next N groups to LEVEL."
4282   (interactive "P\nnLevel: ")
4283   (or (and (>= level 1) (<= level gnus-level-killed))
4284       (error "Illegal level: %d" level))
4285   (let ((groups (gnus-group-process-prefix n))
4286         group)
4287     (while groups
4288       (setq group (car groups)
4289             groups (cdr groups))
4290       (gnus-group-remove-mark group)
4291       (gnus-message 6 "Changed level of %s from %d to %d" 
4292                     group (gnus-group-group-level) level)
4293       (gnus-group-change-level group level
4294                                (gnus-group-group-level))
4295       (gnus-group-update-group-line)))
4296   (gnus-group-position-cursor))
4297
4298 (defun gnus-group-unsubscribe-current-group (n)
4299   "Toggle subscription of the current group.
4300 If given numerical prefix, toggle the N next groups."
4301   (interactive "P")
4302   (let ((groups (gnus-group-process-prefix n))
4303         group)
4304     (while groups
4305       (setq group (car groups)
4306             groups (cdr groups))
4307       (gnus-group-remove-mark group)
4308       (gnus-group-unsubscribe-group
4309        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
4310                  gnus-level-default-unsubscribed
4311                gnus-level-default-subscribed))
4312       (gnus-group-update-group-line))
4313     (gnus-group-next-group 1)))
4314
4315 (defun gnus-group-unsubscribe-group (group &optional level)
4316   "Toggle subscribe from/to unsubscribe GROUP.
4317 New newsgroup is added to .newsrc automatically."
4318   (interactive
4319    (list (completing-read "Group: " gnus-active-hashtb nil 
4320                           gnus-have-read-active-file)))
4321   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
4322     (cond (newsrc
4323            ;; Toggle subscription flag.
4324            (gnus-group-change-level 
4325             newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) 
4326                                            gnus-level-subscribed) 
4327                                        (1+ gnus-level-subscribed)
4328                                      gnus-level-default-subscribed)))
4329            (gnus-group-update-group group))
4330           ((and (stringp group)
4331                 (or (not gnus-have-read-active-file)
4332                     (gnus-gethash group gnus-active-hashtb)))
4333            ;; Add new newsgroup.
4334            (gnus-group-change-level 
4335             group 
4336             (if level level gnus-level-default-subscribed) 
4337             (or (and (member group gnus-zombie-list) 
4338                      gnus-level-zombie) 
4339                 gnus-level-killed)
4340             (and (gnus-group-group-name)
4341                  (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
4342            (gnus-group-update-group group))
4343           (t (error "No such newsgroup: %s" group)))
4344     (gnus-group-position-cursor)))
4345
4346 (defun gnus-group-transpose-groups (n)
4347   "Move the current newsgroup up N places.
4348 If given a negative prefix, move down instead. The difference between
4349 N and the number of steps taken is returned." 
4350   (interactive "p")
4351   (or (gnus-group-group-name)
4352       (error "No group on current line"))
4353   (gnus-group-kill-group 1)
4354   (prog1
4355       (forward-line (- n))
4356     (gnus-group-yank-group)
4357     (gnus-group-position-cursor)))
4358
4359 (defun gnus-group-kill-all-zombies ()
4360   "Kill all zombie newsgroups."
4361   (interactive)
4362   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
4363   (setq gnus-zombie-list nil)
4364   (funcall gnus-group-prepare-function gnus-level-subscribed nil nil)
4365   (goto-char (point-min))
4366   (gnus-group-position-cursor))
4367
4368 (defun gnus-group-kill-region (begin end)
4369   "Kill newsgroups in current region (excluding current point).
4370 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
4371   (interactive "r")
4372   (let ((lines
4373          ;; Count lines.
4374          (save-excursion
4375            (count-lines
4376             (progn
4377               (goto-char begin)
4378               (beginning-of-line)
4379               (point))
4380             (progn
4381               (goto-char end)
4382               (beginning-of-line)
4383               (point))))))
4384     (goto-char begin)
4385     (beginning-of-line)                 ;Important when LINES < 1
4386     (gnus-group-kill-group lines)))
4387
4388 (defun gnus-group-kill-group (n)
4389   "The the next N groups.
4390 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
4391 However, only groups that were alive can be yanked; already killed 
4392 groups or zombie groups can't be yanked.
4393 The return value is the name of the (last) group that was killed."
4394   (interactive "P")
4395   (let ((buffer-read-only nil)
4396         (groups (gnus-group-process-prefix n))
4397         group entry level)
4398     (while groups
4399       (setq group (car groups)
4400             groups (cdr groups))
4401       (gnus-group-remove-mark group)
4402       (setq level (gnus-group-group-level))
4403       (gnus-delete-line)
4404       (if (setq entry (gnus-gethash group gnus-newsrc-hashtb))
4405           (setq gnus-list-of-killed-groups 
4406                 (cons (cons (car entry) (nth 2 entry)) 
4407                       gnus-list-of-killed-groups)))
4408       (gnus-group-change-level 
4409        (if entry entry group) gnus-level-killed (if entry nil level)))
4410     (gnus-group-position-cursor)
4411     group))
4412
4413 (defun gnus-group-yank-group (&optional arg)
4414   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
4415 inserting it before the current newsgroup.  The numeric ARG specifies
4416 how many newsgroups are to be yanked.  The name of the (last)
4417 newsgroup yanked is returned."
4418   (interactive "p")
4419   (if (not arg) (setq arg 1))
4420   (let (info group prev)
4421     (while (>= (setq arg (1- arg)) 0)
4422       (if (not (setq info (car gnus-list-of-killed-groups)))
4423           (error "No more newsgroups to yank"))
4424       (setq group (nth 2 info))
4425       ;; Find which newsgroup to insert this one before - search
4426       ;; backward until something suitable is found. If there are no
4427       ;; other newsgroups in this buffer, just make this newsgroup the
4428       ;; first newsgroup.
4429       (setq prev (gnus-group-group-name))
4430       (gnus-group-change-level 
4431        info (nth 2 info) gnus-level-killed 
4432        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
4433        t)
4434       (gnus-group-insert-group-line-info (nth 1 info))
4435       (setq gnus-list-of-killed-groups 
4436             (cdr gnus-list-of-killed-groups)))
4437     (forward-line -1)
4438     (gnus-group-position-cursor)
4439     group))
4440       
4441 (defun gnus-group-list-all-groups (arg)
4442   "List all newsgroups with level ARG or lower.
4443 Default is gnus-level-unsubscribed, which lists all subscribed and most
4444 unsubscribed groups."
4445   (interactive "P")
4446   (setq arg (or arg gnus-level-unsubscribed))
4447   (gnus-group-list-groups arg t))
4448
4449 (defun gnus-group-list-killed ()
4450   "List all killed newsgroups in the group buffer."
4451   (interactive)
4452   (if (not gnus-killed-list)
4453       (gnus-message 6 "No killed groups")
4454     (funcall gnus-group-prepare-function gnus-level-killed t gnus-level-killed)
4455     (goto-char (point-min)))
4456   (gnus-group-position-cursor))
4457
4458 (defun gnus-group-list-zombies ()
4459   "List all zombie newsgroups in the group buffer."
4460   (interactive)
4461   (if (not gnus-zombie-list)
4462       (gnus-message 6 "No zombie groups")
4463     (funcall gnus-group-prepare-function gnus-level-zombie t gnus-level-zombie)
4464     (goto-char (point-min)))
4465   (gnus-group-position-cursor))
4466
4467 (defun gnus-group-get-new-news (&optional arg)
4468   "Get newly arrived articles.
4469 If ARG is non-nil, it should be a number between one and nine to
4470 specify which levels you are interested in re-scanning."
4471   (interactive "P")
4472   (run-hooks 'gnus-get-new-news-hook)
4473   (let ((level arg))
4474     (if gnus-group-use-permanent-levels
4475         (if level
4476             (setq gnus-group-default-list-level level)
4477           (setq level (or gnus-group-default-list-level 
4478                           gnus-level-subscribed))))
4479     (if (and gnus-read-active-file (not level))
4480         (progn
4481           (gnus-read-active-file)
4482           (gnus-get-unread-articles (or level (1+ gnus-level-subscribed))))
4483       (let ((gnus-read-active-file nil)
4484             (gnus-have-read-active-file (not arg)))
4485         (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))))
4486     (gnus-group-list-groups (or (and gnus-group-use-permanent-levels level)
4487                                 gnus-group-default-list-level
4488                                 gnus-level-subscribed)
4489                             gnus-have-all-newsgroups)))
4490
4491 (defun gnus-group-get-new-news-this-group (n)
4492   "Check for newly arrived news in the current group (and the N-1 next groups).
4493 The difference between N and the number of newsgroup checked is returned.
4494 If N is negative, this group and the N-1 previous groups will be checked."
4495   (interactive "P")
4496   (let* ((groups (gnus-group-process-prefix n))
4497          (ret (if (numberp n) (- n (length groups)) 0))
4498          group)
4499     (while groups
4500       (setq group (car groups)
4501             groups (cdr groups))
4502       (gnus-group-remove-mark group)
4503       (or (gnus-get-new-news-in-group group)
4504           (progn 
4505             (ding) 
4506             (message "%s error: %s" group (gnus-status-message group))
4507             (sit-for 2))))
4508     ;; !!! I don't know why the buffer scrolls forward when updating
4509     ;; the first line in the group buffer, but it does. So we set the
4510     ;; window start forcibly.
4511 ;    (set-window-start (get-buffer-window (current-buffer)) w-p)
4512     (gnus-group-next-unread-group 1 t)
4513     (gnus-summary-position-cursor)
4514     ret))
4515
4516 (defun gnus-get-new-news-in-group (group)
4517   (and group 
4518        (gnus-activate-newsgroup group)
4519        (progn
4520          (gnus-get-unread-articles-in-group 
4521           (nth 2 (gnus-gethash group gnus-newsrc-hashtb))
4522           (gnus-gethash group gnus-active-hashtb))
4523          (gnus-group-update-group-line)
4524          t)))
4525
4526 (defun gnus-group-fetch-faq (group)
4527   "Fetch the FAQ for the current group."
4528   (interactive (list (gnus-group-real-name (gnus-group-group-name))))
4529   (or group (error "No group name given"))
4530   (let ((file (concat gnus-group-faq-directory group))) 
4531     (if (not (file-exists-p file))
4532         (error "No such file: %s" file)
4533       (find-file file))))
4534   
4535 (defun gnus-group-describe-group (force &optional group)
4536   "Display a description of the current newsgroup."
4537   (interactive (list current-prefix-arg (gnus-group-group-name)))
4538   (and force (setq gnus-description-hashtb nil))
4539   (let ((method (gnus-find-method-for-group group))
4540         desc)
4541     (or group (error "No group name given"))
4542     (and (or (and gnus-description-hashtb
4543                   ;; We check whether this group's method has been
4544                   ;; queried for a description file.  
4545                   (gnus-gethash 
4546                    (gnus-group-prefixed-name "" method) 
4547                    gnus-description-hashtb))
4548              (setq desc (gnus-group-get-description group))
4549              (gnus-read-descriptions-file method))
4550          (message
4551           (or desc (gnus-gethash group gnus-description-hashtb)
4552               "No description available")))))
4553
4554 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
4555 (defun gnus-group-describe-all-groups (force)
4556   "Pop up a buffer with descriptions of all newsgroups."
4557   (interactive "P")
4558   (and force (setq gnus-description-hashtb nil))
4559   (if (not (or gnus-description-hashtb
4560                (gnus-read-all-descriptions-files)))
4561       (error "Couldn't request descriptions file"))
4562   (let ((buffer-read-only nil)
4563         b)
4564     (erase-buffer)
4565     (mapatoms
4566      (lambda (group)
4567        (setq b (point))
4568        (insert (format "      *: %-20s %s\n" (symbol-name group)
4569                        (symbol-value group)))
4570        (add-text-properties 
4571         b (1+ b) (list 'gnus-group group
4572                        'gnus-unread t 'gnus-marked nil
4573                        'gnus-level (1+ gnus-level-subscribed))))
4574      gnus-description-hashtb)
4575     (goto-char (point-min))
4576     (gnus-group-position-cursor)))
4577
4578 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
4579 (defun gnus-group-apropos (regexp &optional search-description)
4580   "List all newsgroups that have names that match a regexp."
4581   (interactive "sGnus apropos (regexp): ")
4582   (let ((prev "")
4583         (obuf (current-buffer))
4584         groups des)
4585     ;; Go through all newsgroups that are known to Gnus.
4586     (mapatoms 
4587      (lambda (group)
4588        (and (string-match regexp (symbol-name group))
4589             (setq groups (cons (symbol-name group) groups))))
4590      gnus-active-hashtb)
4591     ;; Go through all descriptions that are known to Gnus. 
4592     (if search-description
4593         (mapatoms 
4594          (lambda (group)
4595            (and (string-match regexp (symbol-value group))
4596                 (gnus-gethash (symbol-name group) gnus-active-hashtb)
4597                 (setq groups (cons (symbol-name group) groups))))
4598          gnus-description-hashtb))
4599     (if (not groups)
4600         (gnus-message 3 "No groups matched \"%s\"." regexp)
4601       ;; Print out all the groups.
4602       (save-excursion
4603         (pop-to-buffer "*Gnus Help*")
4604         (buffer-disable-undo (current-buffer))
4605         (erase-buffer)
4606         (setq groups (sort groups 'string<))
4607         (while groups
4608           ;; Groups may be entered twice into the list of groups.
4609           (if (not (string= (car groups) prev))
4610               (progn
4611                 (insert (setq prev (car groups)) "\n")
4612                 (if (and gnus-description-hashtb
4613                          (setq des (gnus-gethash (car groups) 
4614                                                  gnus-description-hashtb)))
4615                     (insert "  " des "\n"))))
4616           (setq groups (cdr groups)))
4617         (goto-char (point-min))))
4618     (pop-to-buffer obuf)))
4619
4620 (defun gnus-group-description-apropos (regexp)
4621   "List all newsgroups that have names or descriptions that match a regexp."
4622   (interactive "sGnus description apropos (regexp): ")
4623   (if (not (or gnus-description-hashtb
4624                (gnus-read-all-descriptions-files)))
4625       (error "Couldn't request descriptions file"))
4626   (gnus-group-apropos regexp t))
4627
4628 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
4629 (defun gnus-group-list-matching (level regexp &optional all lowest) 
4630   "List all groups with unread articles that match REGEXP.
4631 If the prefix LEVEL is non-nil, it should be a number that says which
4632 level to cut off listing groups. 
4633 If ALL, also list groups with no unread articles.
4634 If LOWEST, don't list groups with level lower than LOWEST."
4635   (interactive "P\nsList newsgroups matching: ")
4636   (gnus-group-prepare-flat (or level gnus-level-subscribed)
4637                            all (or lowest 1) regexp)
4638   (goto-char (point-min))
4639   (gnus-group-position-cursor))
4640
4641 (defun gnus-group-list-all-matching (level regexp &optional lowest) 
4642   "List all groups that match REGEXP.
4643 If the prefix LEVEL is non-nil, it should be a number that says which
4644 level to cut off listing groups. 
4645 If LOWEST, don't list groups with level lower than LOWEST."
4646   (interactive "P\nsList newsgroups matching: ")
4647   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
4648
4649 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
4650 (defun gnus-group-save-newsrc ()
4651   "Save the Gnus startup files."
4652   (interactive)
4653   (gnus-save-newsrc-file))
4654
4655 (defun gnus-group-restart (&optional arg)
4656   "Force Gnus to read the .newsrc file."
4657   (interactive "P")
4658   (gnus-save-newsrc-file)
4659   (gnus-setup-news 'force)
4660   (gnus-group-list-groups arg gnus-have-all-newsgroups))
4661
4662 (defun gnus-group-read-init-file ()
4663   "Read the Gnus elisp init file."
4664   (interactive)
4665   (gnus-read-init-file))
4666
4667 (defun gnus-group-check-bogus-groups (silent)
4668   "Check bogus newsgroups.
4669 If given a prefix, don't ask for confirmation before removing a bogus
4670 group."
4671   (interactive "P")
4672   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
4673   (gnus-group-list-groups nil gnus-have-all-newsgroups))
4674
4675 (defun gnus-group-edit-global-kill (article &optional group)
4676   "Edit the global kill file.
4677 If GROUP, edit that local kill file instead."
4678   (interactive "P")
4679   (setq gnus-current-kill-article article)
4680   (gnus-kill-file-edit-file group)
4681   (gnus-message 6
4682    (substitute-command-keys
4683     "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)")))
4684
4685 (defun gnus-group-edit-local-kill (article group)
4686   "Edit a local kill file."
4687   (interactive (list nil (gnus-group-group-name)))
4688   (gnus-group-edit-global-kill article group))
4689
4690 (defun gnus-group-force-update ()
4691   "Update `.newsrc' file."
4692   (interactive)
4693   (gnus-save-newsrc-file))
4694
4695 (defun gnus-group-suspend ()
4696   "Suspend the current Gnus session.
4697 In fact, cleanup buffers except for group mode buffer.
4698 The hook gnus-suspend-gnus-hook is called before actually suspending."
4699   (interactive)
4700   (run-hooks 'gnus-suspend-gnus-hook)
4701   ;; Kill Gnus buffers except for group mode buffer.
4702   (let ((group-buf (get-buffer gnus-group-buffer)))
4703     ;; Do this on a separate list in case the user does a ^G before we finish
4704     (let ((gnus-buffer-list
4705            (delq group-buf (delq gnus-dribble-buffer
4706                                  (append gnus-buffer-list nil)))))
4707       (while gnus-buffer-list
4708         (gnus-kill-buffer (car gnus-buffer-list))
4709         (setq gnus-buffer-list (cdr gnus-buffer-list))))
4710     (if group-buf
4711         (progn
4712           (setq gnus-buffer-list (list group-buf))
4713           (bury-buffer group-buf)
4714           (delete-windows-on group-buf t)))))
4715
4716 (defun gnus-group-clear-dribble ()
4717   "Clear all information from the dribble buffer."
4718   (interactive)
4719   (gnus-dribble-clear))
4720
4721 (defun gnus-group-exit ()
4722   "Quit reading news after updating .newsrc.eld and .newsrc.
4723 The hook `gnus-exit-gnus-hook' is called before actually exiting."
4724   (interactive)
4725   (if (or noninteractive                ;For gnus-batch-kill
4726           (zerop (buffer-size))         ;No news is good news.
4727           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
4728           (not gnus-interactive-exit)   ;Without confirmation
4729           gnus-expert-user
4730           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
4731       (progn
4732         (if gnus-use-full-window
4733             (delete-other-windows)
4734           (gnus-remove-some-windows))
4735         (run-hooks 'gnus-exit-gnus-hook)
4736         (gnus-offer-save-summaries)
4737         (gnus-save-newsrc-file)
4738         (gnus-close-backends)
4739         (gnus-clear-system))))
4740
4741 (defun gnus-close-backends ()
4742   ;; Send a close request to all backends that support such a request. 
4743   (let ((methods gnus-valid-select-methods)
4744         func)
4745     (while methods
4746       (if (fboundp (setq func (intern (concat (car (car methods))
4747                                               "-request-close"))))
4748           (funcall func))
4749       (setq methods (cdr methods)))))
4750
4751 (defun gnus-group-quit ()
4752   "Quit reading news without updating .newsrc.eld or .newsrc.
4753 The hook `gnus-exit-gnus-hook' is called before actually exiting."
4754   (interactive)
4755   (if (or noninteractive                ;For gnus-batch-kill
4756           (zerop (buffer-size))
4757           (not (gnus-server-opened gnus-select-method))
4758           gnus-expert-user
4759           (not gnus-current-startup-file)
4760           (gnus-yes-or-no-p
4761            (format "Quit reading news without saving %s? "
4762                    (file-name-nondirectory gnus-current-startup-file))))
4763       (progn
4764         (run-hooks 'gnus-exit-gnus-hook)
4765         (if gnus-use-full-window
4766             (delete-other-windows)
4767           (gnus-remove-some-windows))
4768         (gnus-dribble-save)
4769         (gnus-close-backends)
4770         (gnus-clear-system))))
4771
4772 (defun gnus-offer-save-summaries ()
4773   (let ((buffers (buffer-list)))
4774     (save-excursion
4775       (while buffers
4776         (and 
4777          ;; We look for buffers with "Summary" in the name.
4778          (string-match "Summary" (or (buffer-name (car buffers)) ""))
4779          (progn
4780            (set-buffer (car buffers))
4781            ;; We check that this is, indeed, a summary buffer.
4782            (eq major-mode 'gnus-summary-mode)) 
4783          ;; We ask the user whether she wants to save the info.
4784          (gnus-y-or-n-p
4785                (format "Update summary buffer %s? " (buffer-name)))
4786          ;; We do it by simply exiting.
4787          (gnus-summary-exit))
4788         (setq buffers (cdr buffers))))))
4789
4790 (defun gnus-group-describe-briefly ()
4791   "Give a one line description of the group mode commands."
4792   (interactive)
4793   (gnus-message 6
4794    (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")))
4795
4796 (defun gnus-group-browse-foreign-server (method)
4797   "Browse a foreign news server.
4798 If called interactively, this function will ask for a select method
4799  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). 
4800 If not, METHOD should be a list where the first element is the method
4801 and the second element is the address."
4802   (interactive
4803    (list (let ((how (completing-read 
4804                      "Which backend: "
4805                      (append gnus-valid-select-methods gnus-server-alist)
4806                      nil t "nntp")))
4807            ;; We either got a backend name or a virtual server name.
4808            ;; If the first, we also need an address.
4809            (if (assoc how gnus-valid-select-methods)
4810                (list (intern how)
4811                      ;; Suggested by mapjph@bath.ac.uk.
4812                      (completing-read 
4813                       "Address: " 
4814                       (mapcar (lambda (server) (list server))
4815                               gnus-secondary-servers)))
4816              ;; We got a server name, so we find the method.
4817              (gnus-server-to-method how)))))
4818   (gnus-browse-foreign-server method))
4819
4820 \f
4821 ;;;
4822 ;;; Browse Server Mode
4823 ;;;
4824
4825 (defvar gnus-browse-mode-hook nil)
4826 (defvar gnus-browse-mode-map nil)
4827 (put 'gnus-browse-mode 'mode-class 'special)
4828
4829 (if gnus-browse-mode-map
4830     nil
4831   (setq gnus-browse-mode-map (make-keymap))
4832   (suppress-keymap gnus-browse-mode-map)
4833   (define-key gnus-browse-mode-map " " 'gnus-browse-read-group)
4834   (define-key gnus-browse-mode-map "=" 'gnus-browse-select-group)
4835   (define-key gnus-browse-mode-map "n" 'gnus-browse-next-group)
4836   (define-key gnus-browse-mode-map "p" 'gnus-browse-prev-group)
4837   (define-key gnus-browse-mode-map "\177" 'gnus-browse-prev-group)
4838   (define-key gnus-browse-mode-map "N" 'gnus-browse-next-group)
4839   (define-key gnus-browse-mode-map "P" 'gnus-browse-prev-group)
4840   (define-key gnus-browse-mode-map "\M-n" 'gnus-browse-next-group)
4841   (define-key gnus-browse-mode-map "\M-p" 'gnus-browse-prev-group)
4842   (define-key gnus-browse-mode-map "\r" 'gnus-browse-select-group)
4843   (define-key gnus-browse-mode-map "u" 'gnus-browse-unsubscribe-current-group)
4844   (define-key gnus-browse-mode-map "l" 'gnus-browse-exit)
4845   (define-key gnus-browse-mode-map "L" 'gnus-browse-exit)
4846   (define-key gnus-browse-mode-map "q" 'gnus-browse-exit)
4847   (define-key gnus-browse-mode-map "Q" 'gnus-browse-exit)
4848   (define-key gnus-browse-mode-map "\C-c\C-c" 'gnus-browse-exit)
4849   (define-key gnus-browse-mode-map "?" 'gnus-browse-describe-briefly)
4850   (define-key gnus-browse-mode-map "\C-c\C-i" 'gnus-info-find-node)
4851   )
4852
4853 (defvar gnus-browse-current-method nil)
4854 (defvar gnus-browse-return-buffer nil)
4855
4856 (defvar gnus-browse-buffer "*Gnus Browse Server*")
4857
4858 (defun gnus-browse-foreign-server (method &optional return-buffer)
4859   (setq gnus-browse-current-method method)
4860   (setq gnus-browse-return-buffer return-buffer)
4861   (let ((gnus-select-method method)
4862         groups group)
4863     (gnus-message 5 "Connecting to %s..." (nth 1 method))
4864     (or (gnus-server-opened method)
4865         (gnus-open-server method)
4866         (error "Unable to contact server: %s" (gnus-status-message method)))
4867     (or (gnus-request-list method)
4868         (error "Couldn't request list: %s" (gnus-status-message method)))
4869     (get-buffer-create gnus-browse-buffer)
4870     (gnus-add-current-to-buffer-list)
4871     (and gnus-carpal (gnus-carpal-setup-buffer 'browse))
4872     (gnus-configure-windows 'browse)
4873     (buffer-disable-undo (current-buffer))
4874     (let ((buffer-read-only nil))
4875       (erase-buffer))
4876     (gnus-browse-mode)
4877     (setq mode-line-buffer-identification
4878           (format
4879            "(ding) Browse Server {%s:%s}" (car method) (car (cdr method))))
4880     (save-excursion
4881       (set-buffer nntp-server-buffer)
4882       (let ((cur (current-buffer)))
4883         (goto-char (point-min))
4884         (or (string= gnus-ignored-newsgroups "")
4885             (delete-matching-lines gnus-ignored-newsgroups))
4886         (while (re-search-forward 
4887                 "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
4888           (goto-char (match-end 1))
4889           (setq groups (cons (cons (buffer-substring (match-beginning 1)
4890                                                      (match-end 1))
4891                                    (max 0 (- (1+ (read cur)) (read cur))))
4892                              groups)))))
4893     (setq groups (sort groups 
4894                        (lambda (l1 l2)
4895                          (string< (car l1) (car l2)))))
4896     (let ((buffer-read-only nil))
4897       (while groups
4898         (setq group (car groups))
4899         (insert 
4900          (format "K%7d: %s\n" (cdr group) (car group)))
4901         (setq groups (cdr groups))))
4902     (switch-to-buffer (current-buffer))
4903     (goto-char (point-min))
4904     (gnus-group-position-cursor)))
4905
4906 (defun gnus-browse-mode ()
4907   "Major mode for browsing a foreign server.
4908
4909 All normal editing commands are switched off.
4910
4911 \\<gnus-browse-mode-map>
4912 The only things you can do in this buffer is
4913
4914 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
4915 The group will be inserted into the group buffer upon exit from this
4916 buffer.  
4917
4918 2) `\\[gnus-browse-read-group]' to read a group ephemerally.
4919
4920 3) `\\[gnus-browse-exit]' to return to the group buffer."
4921   (interactive)
4922   (kill-all-local-variables)
4923   (if gnus-visual (gnus-browse-make-menu-bar))
4924   (setq mode-line-modified "-- ")
4925   (make-local-variable 'mode-line-format)
4926   (setq mode-line-format (copy-sequence mode-line-format))
4927   (and (equal (nth 3 mode-line-format) "   ")
4928        (setcar (nthcdr 3 mode-line-format) ""))
4929   (setq major-mode 'gnus-browse-mode)
4930   (setq mode-name "Browse Server")
4931   (setq mode-line-process nil)
4932   (use-local-map gnus-browse-mode-map)
4933   (buffer-disable-undo (current-buffer))
4934   (setq truncate-lines t)
4935   (setq buffer-read-only t)
4936   (run-hooks 'gnus-browse-mode-hook))
4937
4938 (defun gnus-browse-read-group (&optional no-article)
4939   "Enter the group at the current line."
4940   (interactive)
4941   (let ((group (gnus-browse-group-name)))
4942     (or (gnus-group-read-ephemeral-group 
4943          group gnus-browse-current-method nil
4944          (cons (current-buffer) 'browse))
4945         (error "Couldn't enter %s" group))))
4946
4947 (defun gnus-browse-select-group ()
4948   "Select the current group."
4949   (interactive)
4950   (gnus-browse-read-group 'no))
4951
4952 (defun gnus-browse-next-group (n)
4953   "Go to the next group."
4954   (interactive "p")
4955   (prog1
4956       (forward-line n)
4957     (gnus-group-position-cursor)))
4958
4959 (defun gnus-browse-prev-group (n)
4960   "Go to the next group."
4961   (interactive "p")
4962   (gnus-browse-next-group (- n)))
4963
4964 (defun gnus-browse-unsubscribe-current-group (arg)
4965   "(Un)subscribe to the next ARG groups."
4966   (interactive "p")
4967   (and (eobp)
4968        (error "No group at current line."))
4969   (let ((ward (if (< arg 0) -1 1))
4970         (arg (abs arg)))
4971     (while (and (> arg 0)
4972                 (not (eobp))
4973                 (gnus-browse-unsubscribe-group)
4974                 (zerop (gnus-browse-next-group ward)))
4975       (setq arg (1- arg)))
4976     (gnus-group-position-cursor)
4977     (if (/= 0 arg) (gnus-message 7 "No more newsgroups"))
4978     arg))
4979
4980 (defun gnus-browse-group-name ()
4981   (save-excursion
4982     (beginning-of-line)
4983     (if (not (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t))
4984         ()
4985       (gnus-group-prefixed-name 
4986        (buffer-substring (match-beginning 1) (match-end 1))
4987        gnus-browse-current-method))))
4988   
4989 (defun gnus-browse-unsubscribe-group ()
4990   (let ((sub nil)
4991         (buffer-read-only nil)
4992         group)
4993     (save-excursion
4994       (beginning-of-line)
4995       (if (= (following-char) ?K) (setq sub t))
4996       (setq group (gnus-browse-group-name))
4997       (beginning-of-line)
4998       (delete-char 1)
4999       (if sub
5000           (progn
5001             (gnus-group-change-level 
5002              (list t group gnus-level-default-subscribed
5003                    nil nil gnus-browse-current-method) 
5004              gnus-level-default-subscribed gnus-level-killed
5005              (gnus-gethash (car (nth 1 gnus-newsrc-alist)) gnus-newsrc-hashtb)
5006              t)
5007             (insert ? ))
5008         (gnus-group-change-level 
5009          group gnus-level-killed gnus-level-default-subscribed)
5010         (insert ?K)))
5011     t))
5012
5013 (defun gnus-browse-exit ()
5014   "Quit browsing and return to the group buffer."
5015   (interactive)
5016   (if (eq major-mode 'gnus-browse-mode)
5017       (kill-buffer (current-buffer)))
5018   (if gnus-browse-return-buffer
5019       (gnus-configure-windows 'server)
5020     (gnus-configure-windows 'group)
5021     (gnus-group-list-groups nil)))
5022
5023 (defun gnus-browse-describe-briefly ()
5024   "Give a one line description of the group mode commands."
5025   (interactive)
5026   (gnus-message 6
5027    (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")))
5028       
5029 \f
5030 ;;;
5031 ;;; Gnus summary mode
5032 ;;;
5033
5034 (defvar gnus-summary-mode-map nil)
5035 (defvar gnus-summary-mark-map nil)
5036 (defvar gnus-summary-mscore-map nil)
5037 (defvar gnus-summary-article-map nil)
5038 (defvar gnus-summary-thread-map nil)
5039 (defvar gnus-summary-goto-map nil)
5040 (defvar gnus-summary-exit-map nil)
5041 (defvar gnus-summary-various-map nil)
5042 (defvar gnus-summary-interest-map nil)
5043 (defvar gnus-summary-sort-map nil)
5044 (defvar gnus-summary-backend-map nil)
5045 (defvar gnus-summary-save-map nil)
5046 (defvar gnus-summary-wash-map nil)
5047 (defvar gnus-summary-help-map nil)
5048
5049 (put 'gnus-summary-mode 'mode-class 'special)
5050
5051 (if gnus-summary-mode-map
5052     nil
5053   (setq gnus-summary-mode-map (make-keymap))
5054   (suppress-keymap gnus-summary-mode-map)
5055
5056   ;; Non-orthogonal keys
5057
5058   (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
5059   (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
5060   (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
5061   (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
5062   (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
5063   (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
5064   (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
5065   (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject)
5066   (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject)
5067   (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject)
5068   (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject)
5069   (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
5070   (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article)
5071   (define-key gnus-summary-mode-map "\M-s" 'gnus-summary-search-article-forward)
5072   (define-key gnus-summary-mode-map "\M-r" 'gnus-summary-search-article-backward)
5073   (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
5074   (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
5075   (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
5076   (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
5077   (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article)
5078   (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward)
5079   (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward)
5080   (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward)
5081   (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
5082   (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
5083   (define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable)
5084   (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward)
5085   (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward)
5086   (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
5087   (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
5088   (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread)
5089   (define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread)
5090   (define-key gnus-summary-mode-map "e" 'gnus-summary-edit-article)
5091   (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable)
5092   (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable)
5093   (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads)
5094   (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread)
5095   (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread)
5096   (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread)
5097   (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread)
5098   (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread)
5099   (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread)
5100   (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
5101   (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
5102   (define-key gnus-summary-mode-map "\C-w" 'gnus-summary-mark-region-as-read)
5103   (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
5104   (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant)
5105   (define-key gnus-summary-mode-map "\C-c\M-\C-s" 'gnus-summary-show-all-expunged)
5106   (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
5107   (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
5108   (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
5109   (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
5110   (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score)
5111   (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
5112   (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
5113   (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group)
5114   (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
5115   (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
5116   (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime)
5117   (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
5118   (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
5119   (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
5120   (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
5121   (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
5122   (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
5123   (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
5124   (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail)
5125   (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
5126   (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill)
5127   (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill)
5128   (define-key gnus-summary-mode-map "V" 'gnus-version)
5129   (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group)
5130   (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
5131   (define-key gnus-summary-mode-map "Q" 'gnus-summary-exit-no-update)
5132   (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
5133   (define-key gnus-summary-mode-map gnus-mouse-2 'gnus-mouse-pick-article)
5134   (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
5135   (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
5136   (define-key gnus-summary-mode-map "x" 'gnus-summary-remove-lines-marked-as-read)
5137 ; (define-key gnus-summary-mode-map "X" 'gnus-summary-remove-lines-marked-with)
5138   (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
5139   (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
5140   (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
5141 ;  (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
5142   (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
5143   (define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu-view)
5144   (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-enter-digest-group)
5145   (define-key gnus-summary-mode-map "v" 'gnus-summary-verbose-headers)
5146   (define-key gnus-summary-mode-map "\C-c\C-b" 'gnus-bug)
5147
5148
5149   ;; Sort of orthogonal keymap
5150   (define-prefix-command 'gnus-summary-mark-map)
5151   (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map)
5152   (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward)
5153   (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward)
5154   (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward)
5155   (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward)
5156   (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward)
5157   (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward)
5158   (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable)
5159   (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable)
5160   (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant)
5161   (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark)
5162   (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark)
5163   (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable)
5164   (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable)
5165   (define-key gnus-summary-mark-map "\M-r" 'gnus-summary-remove-lines-marked-as-read)
5166   (define-key gnus-summary-mark-map "\M-\C-r" 'gnus-summary-remove-lines-marked-with)
5167   (define-key gnus-summary-mark-map "D" 'gnus-summary-show-all-dormant)
5168   (define-key gnus-summary-mark-map "\M-D" 'gnus-summary-hide-all-dormant)
5169   (define-key gnus-summary-mark-map "S" 'gnus-summary-show-all-expunged)
5170   (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup)
5171   (define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here)
5172   (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all)
5173   (define-key gnus-summary-mark-map "k" 'gnus-summary-kill-same-subject-and-select)
5174   (define-key gnus-summary-mark-map "K" 'gnus-summary-kill-same-subject)
5175
5176   (define-prefix-command 'gnus-summary-mscore-map)
5177   (define-key gnus-summary-mark-map "s" 'gnus-summary-mscore-map)
5178   (define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above)
5179   (define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above)
5180   (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above)
5181   (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below)
5182
5183   (define-key gnus-summary-mark-map "p" 'gnus-uu-mark-map)
5184   
5185   (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
5186   
5187   (define-prefix-command 'gnus-summary-goto-map)
5188   (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map)
5189   (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article)
5190   (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article)
5191   (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article)
5192   (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article)
5193   (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject)
5194   (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject)
5195   (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject)
5196   (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject)
5197   (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article)
5198   (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article)
5199   (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject)
5200   (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article)
5201   (define-key gnus-summary-goto-map "p" 'gnus-summary-pop-article)
5202
5203
5204   (define-prefix-command 'gnus-summary-thread-map)
5205   (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map)
5206   (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread)
5207   (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread)
5208   (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread)
5209   (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads)
5210   (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread)
5211   (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads)
5212   (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread)
5213   (define-key gnus-summary-thread-map "H" 'gnus-summary-hide-all-threads)
5214   (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread)
5215   (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread)
5216   (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread)
5217   (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread)
5218   (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread)
5219
5220   
5221   (define-prefix-command 'gnus-summary-exit-map)
5222   (define-key gnus-summary-mode-map "Z" 'gnus-summary-exit-map)
5223   (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit)
5224   (define-key gnus-summary-exit-map "C" 'gnus-summary-catchup-all-and-exit)
5225   (define-key gnus-summary-exit-map "E" 'gnus-summary-exit-no-update)
5226   (define-key gnus-summary-exit-map "Q" 'gnus-summary-exit)
5227   (define-key gnus-summary-exit-map "Z" 'gnus-summary-exit)
5228   (define-key gnus-summary-exit-map "n" 'gnus-summary-catchup-and-goto-next-group)
5229   (define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group)
5230   (define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group)
5231   (define-key gnus-summary-exit-map "N" 'gnus-summary-next-group)
5232   (define-key gnus-summary-exit-map "P" 'gnus-summary-prev-group)
5233
5234
5235   (define-prefix-command 'gnus-summary-article-map)
5236   (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map)
5237   (define-key gnus-summary-article-map " " 'gnus-summary-next-page)
5238   (define-key gnus-summary-article-map "n" 'gnus-summary-next-page)
5239   (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page)
5240   (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page)
5241   (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up)
5242   (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article)
5243   (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article)
5244   (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article)
5245   (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article)
5246   (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article)
5247   (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article)
5248   (define-key gnus-summary-article-map "w" 'gnus-summary-stop-page-breaking)
5249   (define-key gnus-summary-article-map "c" 'gnus-summary-caesar-message)
5250   (define-key gnus-summary-article-map "g" 'gnus-summary-show-article)
5251   (define-key gnus-summary-article-map "t" 'gnus-summary-toggle-header)
5252   (define-key gnus-summary-article-map "m" 'gnus-summary-toggle-mime)
5253   (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article)
5254
5255
5256   (define-prefix-command 'gnus-summary-wash-map)
5257   (define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map)
5258   (define-key gnus-summary-wash-map "h" 'gnus-article-hide-headers)
5259   (define-key gnus-summary-wash-map "s" 'gnus-article-hide-signature)
5260   (define-key gnus-summary-wash-map "c" 'gnus-article-hide-citation)
5261   (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike)
5262   (define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap)
5263   (define-key gnus-summary-wash-map "d" 'gnus-article-remove-cr)
5264   (define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable)
5265   (define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face)
5266   (define-key gnus-summary-wash-map "t" 'gnus-article-date-ut)
5267   (define-key gnus-summary-wash-map "\C-t" 'gnus-article-date-local)
5268   (define-key gnus-summary-wash-map "T" 'gnus-article-date-lapsed)
5269
5270   (define-key gnus-summary-wash-map "A" 'gnus-article-highlight)
5271   (define-key gnus-summary-wash-map "a" 'gnus-article-hide)
5272   (define-key gnus-summary-wash-map "H" 'gnus-article-highlight-headers)
5273   (define-key gnus-summary-wash-map "C" 'gnus-article-highlight-citation)
5274   (define-key gnus-summary-wash-map "S" 'gnus-article-highlight-signature)
5275   (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons)
5276
5277
5278   (define-prefix-command 'gnus-summary-help-map)
5279   (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map)
5280   (define-key gnus-summary-help-map "v" 'gnus-version)
5281   (define-key gnus-summary-help-map "f" 'gnus-summary-fetch-faq)
5282   (define-key gnus-summary-help-map "d" 'gnus-summary-describe-group)
5283   (define-key gnus-summary-help-map "h" 'gnus-summary-describe-briefly)
5284   (define-key gnus-summary-help-map "i" 'gnus-info-find-node)
5285
5286
5287   (define-prefix-command 'gnus-summary-backend-map)
5288   (define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map)
5289   (define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles)
5290   (define-key gnus-summary-backend-map "\M-\C-e" 
5291     'gnus-summary-expire-articles-now)
5292   (define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article)
5293   (define-key gnus-summary-backend-map "m" 'gnus-summary-move-article)
5294   (define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article)
5295   (define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article)
5296   (define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article)
5297   (define-key gnus-summary-backend-map "q" 'gnus-summary-fancy-query)
5298   (define-key gnus-summary-backend-map "i" 'gnus-summary-import-article)
5299
5300
5301   (define-prefix-command 'gnus-summary-save-map)
5302   (define-key gnus-summary-mode-map "O" 'gnus-summary-save-map)
5303   (define-key gnus-summary-save-map "o" 'gnus-summary-save-article)
5304   (define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail)
5305   (define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail)
5306   (define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file)
5307   (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder)
5308   (define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm)
5309   (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output)
5310 ;  (define-key gnus-summary-save-map "s" 'gnus-soup-add-article)
5311
5312   (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map)
5313   
5314   (define-prefix-command 'gnus-summary-various-map)
5315   (define-key gnus-summary-mode-map "V" 'gnus-summary-various-map)
5316   (define-key gnus-summary-various-map "u" 'gnus-summary-universal-argument)
5317   (define-key gnus-summary-various-map "\C-s" 'gnus-summary-search-article-forward)
5318   (define-key gnus-summary-various-map "\C-r" 'gnus-summary-search-article-backward)
5319   (define-key gnus-summary-various-map "r" 'gnus-summary-refer-article)
5320   (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command)
5321   (define-key gnus-summary-various-map "T" 'gnus-summary-toggle-truncation)
5322   (define-key gnus-summary-various-map "e" 'gnus-summary-expand-window)
5323   (define-key gnus-summary-various-map "D" 'gnus-summary-enter-digest-group)
5324   (define-key gnus-summary-various-map "k" 'gnus-summary-edit-local-kill)
5325   (define-key gnus-summary-various-map "K" 'gnus-summary-edit-global-kill)
5326
5327   (define-key gnus-summary-various-map "S" 'gnus-summary-score-map)
5328
5329   (define-prefix-command 'gnus-summary-sort-map)
5330   (define-key gnus-summary-various-map "s" 'gnus-summary-sort-map)
5331   (define-key gnus-summary-sort-map "n" 'gnus-summary-sort-by-number)
5332   (define-key gnus-summary-sort-map "a" 'gnus-summary-sort-by-author)
5333   (define-key gnus-summary-sort-map "s" 'gnus-summary-sort-by-subject)
5334   (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date)
5335   (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score)
5336
5337   (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-score)
5338   (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-score)
5339   )
5340
5341
5342 \f
5343
5344 (defun gnus-summary-mode (&optional group)
5345   "Major mode for reading articles.
5346
5347 All normal editing commands are switched off.
5348 \\<gnus-summary-mode-map>
5349 Each line in this buffer represents one article.  To read an
5350 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
5351 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', 
5352 respectively.
5353
5354 You can also post articles and send mail from this buffer.  To 
5355 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author 
5356 of an article, type `\\[gnus-summary-reply]'.
5357
5358 There are approx. one gazillion commands you can execute in this 
5359 buffer; read the info pages for more information (`\\[gnus-info-find-node]'). 
5360
5361 The following commands are available:
5362
5363 \\{gnus-summary-mode-map}"
5364   (interactive)
5365   (if gnus-visual (gnus-summary-make-menu-bar))
5366   (kill-all-local-variables)
5367   (let ((locals gnus-summary-local-variables))
5368     (while locals
5369       (if (consp (car locals))
5370           (progn
5371             (make-local-variable (car (car locals)))
5372             (set (car (car locals)) (eval (cdr (car locals)))))
5373         (make-local-variable (car locals))
5374         (set (car locals) nil))
5375       (setq locals (cdr locals))))
5376   (gnus-make-thread-indent-array)
5377   (gnus-update-format-specifications)
5378   (setq mode-line-modified "-- ")
5379   (make-local-variable 'mode-line-format)
5380   (setq mode-line-format (copy-sequence mode-line-format))
5381   (and (equal (nth 3 mode-line-format) "   ")
5382        (setcar (nthcdr 3 mode-line-format) ""))
5383   (setq major-mode 'gnus-summary-mode)
5384   (setq mode-name "Summary")
5385   (make-local-variable 'minor-mode-alist)
5386   (use-local-map gnus-summary-mode-map)
5387   (buffer-disable-undo (current-buffer))
5388   (setq buffer-read-only t)             ;Disable modification
5389   (setq truncate-lines t)
5390   (setq selective-display t)
5391   (setq selective-display-ellipses t)   ;Display `...'
5392   (setq buffer-display-table gnus-summary-display-table)
5393   (setq gnus-newsgroup-name group)
5394   (run-hooks 'gnus-summary-mode-hook))
5395
5396 (defun gnus-summary-make-display-table ()
5397   ;; Change the display table.  Odd characters have a tendency to mess
5398   ;; up nicely formatted displays - we make all possible glyphs
5399   ;; display only a single character.
5400
5401   ;; We start from the standard display table, if any.
5402   (setq gnus-summary-display-table 
5403         (or (copy-sequence standard-display-table)
5404             (make-display-table)))
5405   ;; Nix out all the control chars...
5406   (let ((i 32))
5407     (while (>= (setq i (1- i)) 0)
5408       (aset gnus-summary-display-table i [??])))
5409   ;; ... but not newline and cr, of course. (cr is necessary for the
5410   ;; selective display).  
5411   (aset gnus-summary-display-table ?\n nil)
5412   (aset gnus-summary-display-table ?\r nil)
5413   ;; We nix out any glyphs over 126 that are not set already.  
5414   (let ((i 256))
5415     (while (>= (setq i (1- i)) 127)
5416       ;; Only modify if the entry is nil.
5417       (or (aref gnus-summary-display-table i) 
5418           (aset gnus-summary-display-table i [??])))))
5419
5420 (defun gnus-summary-clear-local-variables ()
5421   (let ((locals gnus-summary-local-variables))
5422     (while locals
5423       (if (consp (car locals))
5424           (and (vectorp (car (car locals)))
5425                (set (car (car locals)) nil))
5426         (and (vectorp (car locals))
5427              (set (car locals) nil)))
5428       (setq locals (cdr locals)))))
5429
5430 (defun gnus-mouse-pick-article (e)
5431   (interactive "e")
5432   (mouse-set-point e)
5433   (gnus-summary-next-page nil t))
5434
5435 (defun gnus-summary-setup-buffer (group)
5436   "Initialize summary buffer."
5437   (let ((buffer (concat "*Summary " group "*")))
5438     (if (get-buffer buffer)
5439         (progn
5440           (set-buffer buffer)
5441           (not gnus-newsgroup-begin))
5442       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
5443       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
5444       (gnus-add-current-to-buffer-list)
5445       (gnus-summary-mode group)
5446       (and gnus-carpal (gnus-carpal-setup-buffer 'summary))
5447       (setq gnus-newsgroup-name group)
5448       t)))
5449
5450 (defun gnus-set-global-variables ()
5451   ;; Set the global equivalents of the summary buffer-local variables
5452   ;; to the latest values they had. These reflect the summary buffer
5453   ;; that was in action when the last article was fetched.
5454   (if (eq major-mode 'gnus-summary-mode) 
5455       (progn
5456         (setq gnus-summary-buffer (current-buffer))
5457         (let ((name gnus-newsgroup-name)
5458               (marked gnus-newsgroup-marked)
5459               (unread gnus-newsgroup-unreads)
5460               (headers gnus-current-headers)
5461               (score-file gnus-current-score-file))
5462           (save-excursion
5463             (set-buffer gnus-group-buffer)
5464             (setq gnus-newsgroup-name name)
5465             (setq gnus-newsgroup-marked marked)
5466             (setq gnus-newsgroup-unreads unread)
5467             (setq gnus-current-headers headers)
5468             (setq gnus-current-score-file score-file))))))
5469
5470 (defun gnus-summary-insert-dummy-line (sformat subject number)
5471   (if (not sformat) 
5472       (setq sformat gnus-summary-dummy-line-format-spec))
5473   (let (b)
5474     (beginning-of-line)
5475     (setq b (point))
5476     (insert (eval sformat))
5477     (add-text-properties
5478      b (1+ b)
5479      (list 'gnus-number number 
5480            'gnus-mark gnus-dummy-mark
5481            'gnus-level 0))))
5482
5483 (defvar gnus-thread-indent-array nil)
5484 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
5485 (defun gnus-make-thread-indent-array ()
5486   (let ((n 200))
5487     (if (and gnus-thread-indent-array
5488              (= gnus-thread-indent-level gnus-thread-indent-array-level))
5489         nil
5490       (setq gnus-thread-indent-array (make-vector 201 "")
5491             gnus-thread-indent-array-level gnus-thread-indent-level)
5492       (while (>= n 0)
5493         (aset gnus-thread-indent-array n
5494               (make-string (* n gnus-thread-indent-level) ? ))
5495         (setq n (1- n))))))
5496
5497 (defun gnus-summary-insert-line 
5498   (sformat header level current unread replied expirable subject-or-nil
5499            &optional dummy score)
5500   (or sformat (setq sformat gnus-summary-line-format-spec))
5501   (let* ((indentation (aref gnus-thread-indent-array level))
5502          (lines (header-lines header))
5503          (score (or score gnus-summary-default-score 0))
5504          (score-char
5505           (if (or (null gnus-summary-default-score)
5506                   (<= (abs (- score gnus-summary-default-score))
5507                       gnus-summary-zcore-fuzz)) ? 
5508             (if (< score gnus-summary-default-score)
5509                 gnus-score-below-mark gnus-score-over-mark)))
5510          (replied (if replied gnus-replied-mark ? ))
5511          (from (header-from header))
5512          (name-address (funcall gnus-extract-address-components from))
5513          (address (car (cdr name-address)))
5514          (name (or (car name-address) (car (cdr name-address))))
5515          (subject (header-subject header))
5516          (number (header-number header))
5517          (opening-bracket (if dummy ?\< ?\[))
5518          (closing-bracket (if dummy ?\> ?\]))
5519          (buffer-read-only nil)
5520          (b (progn (beginning-of-line) (point))))
5521     (or (numberp lines) (setq lines 0))
5522     (insert (eval sformat))
5523     (add-text-properties
5524      b (1+ b) (list 'gnus-number number 
5525                     'gnus-mark (or unread gnus-unread-mark)
5526                     'gnus-level level))))
5527
5528 (defun gnus-summary-update-line (&optional dont-update)
5529   ;; Update summary line after change.
5530   (or (not gnus-summary-default-score)
5531       gnus-summary-inhibit-highlight
5532       (let ((gnus-summary-inhibit-highlight t)
5533             (article (gnus-summary-article-number)))
5534         (progn
5535           (or dont-update
5536               (if (and gnus-summary-mark-below
5537                        (< (gnus-summary-article-score)
5538                           gnus-summary-mark-below))
5539                   (and (not (memq article gnus-newsgroup-marked))
5540                        (not (memq article gnus-newsgroup-dormant))
5541                        (memq article gnus-newsgroup-unreads)
5542                        (gnus-summary-mark-article nil gnus-low-score-mark))
5543                 (and (eq (gnus-summary-article-mark) gnus-low-score-mark)
5544                      (gnus-summary-mark-article nil gnus-unread-mark))))
5545           (and gnus-visual
5546                (run-hooks 'gnus-summary-update-hook))))))
5547
5548 (defun gnus-summary-update-lines (&optional beg end)
5549   ;; Rehighlight summary buffer according to `gnus-summary-highlight'.
5550   (let ((beg (or beg (point-min)))
5551         (end (or end (point-max))))
5552     (save-excursion
5553       (set-buffer gnus-summary-buffer)
5554       (goto-char beg)
5555       (while (and (not (eobp)) (< (point) end))
5556         (gnus-summary-update-line)
5557         (forward-line 1)))))
5558
5559 (defun gnus-summary-number-of-articles-in-thread (thread &optional char)
5560   ;; Sum up all elements (and sub-elements) in a list.
5561   (let ((number 
5562          (if (listp thread) 
5563              (apply 
5564               '+ (mapcar 'gnus-summary-number-of-articles-in-thread thread))
5565            1)))
5566     (if char 
5567         (if (> number 1) gnus-not-empty-thread-mark
5568           gnus-empty-thread-mark)
5569       number)))
5570
5571 (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer)
5572   "Start reading news in newsgroup GROUP.
5573 If SHOW-ALL is non-nil, already read articles are also listed.
5574 If NO-ARTICLE is non-nil, no article is selected initially."
5575   (gnus-message 5 "Retrieving newsgroup: %s..." group)
5576   (let* ((new-group (gnus-summary-setup-buffer group))
5577          (quit-config (nth 1 (assoc 'quit-config (gnus-find-method-for-group
5578                                                   group))))
5579          (did-select (and new-group (gnus-select-newsgroup group show-all))))
5580     (cond 
5581      ((not new-group)
5582       (gnus-set-global-variables)
5583       (gnus-kill-buffer kill-buffer)
5584       (gnus-configure-windows 'summary)
5585       (gnus-set-mode-line 'summary)
5586       (gnus-summary-position-cursor)
5587       (message "")
5588       t)
5589      ((null did-select) 
5590       (and (eq major-mode 'gnus-summary-mode)
5591            (not (equal (current-buffer) kill-buffer))
5592            (progn
5593              (kill-buffer (current-buffer))
5594              (if (not quit-config)
5595                  (progn
5596                    (set-buffer gnus-group-buffer)
5597                    (gnus-group-jump-to-group group)
5598                    (gnus-group-next-unread-group 1))
5599                (if (not (buffer-name (car quit-config)))
5600                    (gnus-configure-windows 'group)
5601                  (set-buffer (car quit-config))
5602                  (and (eq major-mode 'gnus-summary-mode)
5603                       (gnus-set-global-variables))
5604                  (gnus-configure-windows (cdr quit-config))))))
5605       (message "Can't select group")
5606       nil)
5607      ((eq did-select 'quit)
5608       (and (eq major-mode 'gnus-summary-mode)
5609            (not (equal (current-buffer) kill-buffer))
5610            (kill-buffer (current-buffer)))
5611       (gnus-kill-buffer kill-buffer)
5612       (if (not quit-config)
5613           (progn
5614             (set-buffer gnus-group-buffer)
5615             (gnus-group-jump-to-group group)
5616             (gnus-group-next-unread-group 1))
5617         (if (not (buffer-name (car quit-config)))
5618             (gnus-configure-windows 'group)
5619           (set-buffer (car quit-config))
5620           (and (eq major-mode 'gnus-summary-mode)
5621                (gnus-set-global-variables))
5622           (gnus-configure-windows (cdr quit-config))))
5623       (signal 'quit nil))
5624      (t
5625       (gnus-set-global-variables)
5626       ;; Save the active value in effect when the group was entered.
5627       (setq gnus-newsgroup-active 
5628             (gnus-copy-sequence
5629              (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
5630       ;; You can change the subjects in this hook.
5631       (run-hooks 'gnus-select-group-hook)
5632       ;; Do score processing.
5633       (and gnus-use-scoring (gnus-possibly-score-headers))
5634       ;; Update the format specifiers.
5635       (gnus-update-format-specifications)
5636       ;; Generate the summary buffer.
5637       (gnus-summary-prepare)
5638       (if (zerop (buffer-size))
5639           (cond (gnus-newsgroup-dormant
5640                  (gnus-summary-show-all-dormant))
5641                 ((and gnus-newsgroup-scored show-all)
5642                  (gnus-summary-show-all-expunged))))
5643       ;; Function `gnus-apply-kill-file' must be called in this hook.
5644       (run-hooks 'gnus-apply-kill-hook)
5645       (if (zerop (buffer-size))
5646           (progn
5647             ;; This newsgroup is empty.
5648             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
5649             (gnus-message 6 "No unread news")
5650             (gnus-kill-buffer kill-buffer)
5651             nil)
5652         ;;(save-excursion
5653         ;;  (if kill-buffer
5654         ;;      (let ((gnus-summary-buffer kill-buffer))
5655         ;;      (gnus-configure-windows 'group))))
5656         ;; Hide conversation thread subtrees.  We cannot do this in
5657         ;; gnus-summary-prepare-hook since kill processing may not
5658         ;; work with hidden articles.
5659         (and gnus-show-threads
5660              gnus-thread-hide-subtree
5661              (gnus-summary-hide-all-threads))
5662         ;; Show first unread article if requested.
5663         (goto-char (point-min))
5664         (if (and (not no-article)
5665                  gnus-auto-select-first
5666                  (gnus-summary-first-unread-article))
5667             ()
5668           (gnus-configure-windows 'summary))
5669         (gnus-set-mode-line 'summary)
5670         (gnus-summary-position-cursor)
5671         ;; If in async mode, we send some info to the backend.
5672         (and gnus-newsgroup-async
5673              (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads))
5674              (gnus-request-asynchronous 
5675               gnus-newsgroup-name
5676               (if (and gnus-asynchronous-article-function
5677                        (fboundp gnus-asynchronous-article-function))
5678                   (funcall gnus-asynchronous-article-function
5679                            gnus-newsgroup-threads)
5680                 gnus-newsgroup-threads)))
5681         (gnus-kill-buffer kill-buffer)
5682         (if (not (get-buffer-window gnus-group-buffer))
5683             ()
5684           ;; gotta use windows, because recenter does wierd stuff if
5685           ;; the current buffer ain't the displayed window.
5686           (let ((owin (selected-window))) 
5687             (select-window (get-buffer-window gnus-group-buffer))
5688             (and (gnus-group-goto-group group)
5689                  (recenter))
5690             (select-window owin))))
5691       t))))
5692
5693 (defun gnus-summary-prepare ()
5694   ;; Generate the summary buffer.
5695   (let ((buffer-read-only nil))
5696     (erase-buffer)
5697     (gnus-summary-prepare-threads 
5698      (if gnus-show-threads
5699          (gnus-gather-threads 
5700           (gnus-sort-threads 
5701            (if (and gnus-summary-expunge-below
5702                     (not gnus-fetch-old-headers))
5703                (gnus-make-threads-and-expunge)
5704              (gnus-make-threads))))
5705        gnus-newsgroup-headers)
5706      0 nil nil t)
5707     ;; Erase header retrieval message.
5708     (gnus-summary-update-lines)
5709     (message "")
5710     ;; Remove the final newline.
5711     ;;(goto-char (point-max))
5712     ;;(delete-char -1)
5713     ;; Call hooks for modifying summary buffer.
5714     ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
5715     (goto-char (point-min))
5716     (run-hooks 'gnus-summary-prepare-hook)))
5717
5718 (defun gnus-gather-threads (threads)
5719   "Gather threads that have lost their roots."
5720   (if (not gnus-summary-make-false-root)
5721       threads 
5722     (let ((hashtb (gnus-make-hashtable 1023))
5723           (prev threads)
5724           (result threads)
5725           subject hthread whole-subject)
5726       (while threads
5727         (setq whole-subject 
5728               (setq subject (header-subject (car (car threads)))))
5729         (if gnus-summary-gather-subject-limit
5730             (or (and (numberp gnus-summary-gather-subject-limit)
5731                      (> (length subject) gnus-summary-gather-subject-limit)
5732                      (setq subject
5733                            (substring subject 0 
5734                                       gnus-summary-gather-subject-limit)))
5735                 (and (eq 'fuzzy gnus-summary-gather-subject-limit)
5736                      (setq subject (gnus-simplify-subject-fuzzy subject))))
5737           (setq subject (gnus-simplify-subject-re subject)))
5738         (if (setq hthread 
5739                   (gnus-gethash subject hashtb))
5740             (progn
5741               (or (stringp (car (car hthread)))
5742                   (setcar hthread (list whole-subject (car hthread))))
5743               (setcdr (car hthread) (nconc (cdr (car hthread)) 
5744                                            (list (car threads))))
5745               (setcdr prev (cdr threads))
5746               (setq threads prev))
5747           (gnus-sethash subject threads hashtb))
5748         (setq prev threads)
5749         (setq threads (cdr threads)))
5750       result)))
5751
5752 (defun gnus-make-threads ()
5753   ;; This function takes the dependencies already made by 
5754   ;; `gnus-get-newsgroup-headers' and builds the trees. First we go
5755   ;; through the dependecies in the hash table and finds all the
5756   ;; roots. Roots do not refer back to any valid articles.
5757   (let (roots)
5758     (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
5759          (gnus-build-old-threads))
5760     (mapatoms
5761      (lambda (refs)
5762        (if (not (car (symbol-value refs)))
5763            (setq roots (append (cdr (symbol-value refs)) roots))
5764          ;; Ok, these refer back to valid articles, but if
5765          ;; `gnus-thread-ignore-subject' is nil, we have to check that
5766          ;; the root has the same subject as its children. The children
5767          ;; that do not are made into roots and removed from the list
5768          ;; of children. 
5769          (or gnus-thread-ignore-subject
5770              (let* ((prev (symbol-value refs))
5771                     (subject (gnus-simplify-subject-re 
5772                               (header-subject (car prev))))
5773                     (headers (cdr prev)))
5774                (while headers
5775                  (if (not (string= subject
5776                                    (gnus-simplify-subject-re 
5777                                     (header-subject (car headers)))))
5778                      (progn
5779                        (setq roots (cons (car headers) roots))
5780                        (setcdr prev (cdr headers)))
5781                    (setq prev headers))
5782                  (setq headers (cdr headers)))))))
5783      gnus-newsgroup-dependencies)
5784     
5785     (mapcar 'gnus-trim-thread
5786             (apply 'append
5787                    (mapcar 'gnus-cut-thread
5788                            (mapcar 'gnus-make-sub-thread roots))))))
5789   
5790 (defun gnus-make-threads-and-expunge ()
5791   ;; This function takes the dependencies already made by 
5792   ;; `gnus-get-newsgroup-headers' and builds the trees. First we go
5793   ;; through the dependecies in the hash table and finds all the
5794   ;; roots. Roots do not refer back to any valid articles.
5795   (let ((default (or gnus-summary-default-score 0))
5796         (below gnus-summary-expunge-below)
5797         roots article)
5798     (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
5799          (gnus-build-old-threads))
5800     (mapatoms
5801      (lambda (refs)
5802        (if (not (car (symbol-value refs)))
5803            ;; These articles do not refer back to any other articles -
5804            ;; they are roots.
5805            (let ((headers (cdr (symbol-value refs))))
5806              ;; We weed out the low-scored articles.
5807              (while headers
5808                (if (not (< (or (cdr (assq (header-number (car headers))
5809                                           gnus-newsgroup-scored)) default)
5810                            below))
5811                    ;; It is over.
5812                    (setq roots (cons (car headers) roots))
5813                  ;; It is below, so we mark it as read.
5814                  (setq gnus-newsgroup-unreads
5815                        (delq (header-number (car headers))
5816                              gnus-newsgroup-unreads)))
5817                (setq headers (cdr headers))))
5818          ;; Ok, these refer back to valid articles, but if
5819          ;; `gnus-thread-ignore-subject' is nil, we have to check that
5820          ;; the root has the same subject as its children. The children
5821          ;; that do not are made into roots and removed from the list
5822          ;; of children. 
5823          (or gnus-thread-ignore-subject
5824              (let* ((prev (symbol-value refs))
5825                     (subject (gnus-simplify-subject-re 
5826                               (header-subject (car prev))))
5827                     (headers (cdr prev)))
5828                (while headers
5829                  (if (not (string= subject
5830                                    (gnus-simplify-subject-re 
5831                                     (header-subject (car headers)))))
5832                      (progn
5833                        (if (not (< (or (cdr (assq (header-number (car headers))
5834                                                   gnus-newsgroup-scored))
5835                                        default) below))
5836                            (setq roots (cons (car headers) roots))
5837                          (setq gnus-newsgroup-unreads
5838                                (delq (header-number (car headers))
5839                                      gnus-newsgroup-unreads)))
5840                        (setcdr prev (cdr headers)))
5841                    (setq prev headers))
5842                  (setq headers (cdr headers)))))
5843          ;; If this article is expunged, some of the children might be
5844          ;; roots.  
5845          (if (< (or (cdr (assq (header-number (car (symbol-value refs)))
5846                                gnus-newsgroup-scored)) default)
5847                 below)
5848              (let* ((prev (symbol-value refs))
5849                     (headers (cdr prev)))
5850                (while headers
5851                  (setq article (header-number (car headers)))
5852                  (if (not (< (or (cdr (assq article gnus-newsgroup-scored))
5853                                  default) below))
5854                      (progn (setq roots (cons (car headers) roots))
5855                             (setq prev headers))
5856                    (setq gnus-newsgroup-unreads 
5857                          (delq article gnus-newsgroup-unreads))
5858                    (setcdr prev (cdr headers)))
5859                  (setq headers (cdr headers))))
5860            ;; It was not expunged, but we look at expunged children.
5861            (let* ((prev (symbol-value refs))
5862                   (headers (cdr prev))
5863                   article)
5864              (while headers
5865                (setq article (header-number (car headers)))
5866                (if (not (< (or (cdr (assq article gnus-newsgroup-scored))
5867                                default) below))
5868                    (setq prev headers)
5869                  (setq gnus-newsgroup-unreads 
5870                        (delq article gnus-newsgroup-unreads))
5871                  (setcdr prev (cdr headers)))
5872                (setq headers (cdr headers)))))))
5873      gnus-newsgroup-dependencies)
5874
5875     (mapcar 'gnus-trim-thread
5876             (apply 'append
5877                    (mapcar 'gnus-cut-thread
5878                            (mapcar 'gnus-make-sub-thread roots))))))
5879   
5880 (defun gnus-cut-thread (thread)
5881   ;; Remove leaf dormant or ancient articles from THREAD.
5882   (let ((head (car thread))
5883         (tail (apply 'append (mapcar 'gnus-cut-thread (cdr thread)))))
5884     (if (and (null tail)
5885              (let ((number (header-number head)))
5886                (or (memq number gnus-newsgroup-ancient)
5887                    (memq number gnus-newsgroup-dormant)
5888                    (and gnus-summary-expunge-below
5889                         (eq gnus-fetch-old-headers 'some)
5890                         (< (or (cdr (assq number gnus-newsgroup-scored))
5891                                gnus-summary-default-score 0)
5892                            gnus-summary-expunge-below)
5893                         (progn
5894                           (setq gnus-newsgroup-unreads
5895                                 (delq number gnus-newsgroup-unreads))
5896                           t)))))
5897         nil
5898       (list (cons head tail)))))
5899
5900 (defun gnus-trim-thread (thread)
5901   ;; Remove root ancient articles with only one child from THREAD.
5902   (if (and (eq gnus-fetch-old-headers 'some)
5903            (memq (header-number (car thread)) gnus-newsgroup-ancient)
5904            (= (length thread) 2))
5905       (gnus-trim-thread (nth 1 thread))
5906     thread))
5907
5908 (defun gnus-make-sub-thread (root)
5909   ;; This function makes a sub-tree for a node in the tree.
5910   (let ((children (reverse (cdr (gnus-gethash (downcase (header-id root))
5911                                               gnus-newsgroup-dependencies)))))
5912     (cons root (mapcar 'gnus-make-sub-thread children))))
5913
5914 (defun gnus-build-old-threads ()
5915   ;; Look at all the articles that refer back to old articles, and
5916   ;; fetch the headers for the articles that aren't there. This will
5917   ;; build complete threads - if the roots haven't been expired by the
5918   ;; server, that is.
5919   (let (id heads)
5920     (mapatoms
5921      (lambda (refs)
5922        (if (not (car (symbol-value refs)))
5923            (progn
5924              (setq heads (cdr (symbol-value refs)))
5925              (while heads
5926                (if (not (memq (header-number (car heads))
5927                               gnus-newsgroup-dormant))
5928                    (progn
5929                      (setq id (symbol-name refs))
5930                      (while (and (setq id (gnus-build-get-header id))
5931                                  (not (car (gnus-gethash 
5932                                             id gnus-newsgroup-dependencies)))))
5933                      (setq heads nil))
5934                  (setq heads (cdr heads)))))))
5935      gnus-newsgroup-dependencies)))
5936
5937 (defun gnus-build-get-header (id)
5938   ;; Look through the buffer of NOV lines and find the header to
5939   ;; ID. Enter this line into the dependencies hash table, and return
5940   ;; the id of the parent article (if any).
5941   (let ((deps gnus-newsgroup-dependencies)
5942         found header)
5943     (prog1
5944         (save-excursion
5945           (set-buffer nntp-server-buffer)
5946           (goto-char (point-min))
5947           (while (and (not found) (search-forward id nil t))
5948             (beginning-of-line)
5949             (setq found (looking-at 
5950                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
5951                                  (regexp-quote id))))
5952             (or found (beginning-of-line 2)))
5953           (if found
5954               (let (ref)
5955                 (beginning-of-line)
5956                 (and
5957                  (setq header (gnus-nov-parse-line 
5958                                (read (current-buffer)) deps))
5959                  (setq ref (header-references header))
5960                  (string-match "\\(<[^>]+>\\) *$" ref)
5961                  (substring ref (match-beginning 1) (match-end 1))))))
5962       (and header
5963            (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers)
5964                  gnus-newsgroup-ancient (cons (header-number header)
5965                                               gnus-newsgroup-ancient))))))
5966
5967 ;; Re-build the thread containing ID.
5968 (defun gnus-rebuild-thread (id)
5969   (let ((dep gnus-newsgroup-dependencies)
5970         (buffer-read-only nil)
5971         parent headers refs thread art)
5972     (while (and id (setq headers
5973                          (car (setq art (gnus-gethash (downcase id) dep)))))
5974       (setq parent art)
5975       (setq id (and (setq refs (header-references headers))
5976                     (string-match "\\(<[^>]+>\\) *$" refs)
5977                     (substring refs (match-beginning 1) (match-end 1)))))
5978     (setq thread (gnus-make-sub-thread (car parent)))
5979     (gnus-rebuild-remove-articles thread)
5980     (let ((beg (point)))
5981       (gnus-summary-prepare-threads (list thread) 0)
5982       (gnus-summary-update-lines beg (point)))))
5983
5984 ;; Delete all lines in the summary buffer that correspond to articles
5985 ;; in this thread.
5986 (defun gnus-rebuild-remove-articles (thread)
5987   (and (gnus-summary-goto-subject (header-number (car thread)))
5988        (gnus-delete-line))
5989   (mapcar (lambda (th) (gnus-rebuild-remove-articles th)) (cdr thread)))
5990
5991 (defun gnus-sort-threads (threads)
5992   ;; Sort threads as specified in `gnus-thread-sort-functions'.
5993   (let ((fun gnus-thread-sort-functions))
5994     (while fun
5995       (setq threads (sort threads (car fun))
5996             fun (cdr fun))))
5997   threads)
5998
5999 (defun gnus-thread-header (thread)
6000   ;; Return header of first article in THREAD.
6001   (if (consp thread)
6002       (if (stringp (car thread))
6003           (car (car (cdr thread)))
6004         (car thread))
6005     thread))
6006
6007 (defun gnus-thread-sort-by-number (h1 h2)
6008   "Sort threads by root article number."
6009   (let ((h1 (gnus-thread-header h1))
6010         (h2 (gnus-thread-header h2)))
6011     (< (header-number h1) (header-number h2))))
6012
6013 (defun gnus-thread-sort-by-author (h1 h2)
6014   "Sort threads by root author."
6015   (let ((h1 (gnus-thread-header h1))
6016         (h2 (gnus-thread-header h2)))
6017     (string-lessp
6018      (let ((extract (funcall 
6019                      gnus-extract-address-components (header-from h1))))
6020        (or (car extract) (cdr extract)))
6021      (let ((extract (funcall
6022                      gnus-extract-address-components (header-from h2))))
6023        (or (car extract) (cdr extract))))))
6024
6025 (defun gnus-thread-sort-by-subject (h1 h2)
6026   "Sort threads by root subject."
6027   (let ((h1 (gnus-thread-header h1))
6028         (h2 (gnus-thread-header h2)))
6029     (string-lessp
6030      (downcase (gnus-simplify-subject (header-subject h1)))
6031      (downcase (gnus-simplify-subject (header-subject h2))))))
6032
6033 (defun gnus-thread-sort-by-date (h1 h2)
6034   "Sort threads by root article date."
6035   (let ((h1 (gnus-thread-header h1))
6036         (h2 (gnus-thread-header h2)))
6037     (string-lessp
6038      (gnus-sortable-date (header-date h1))
6039      (gnus-sortable-date (header-date h2)))))
6040
6041 (defun gnus-thread-sort-by-score (h1 h2)
6042   "Sort threads by root article score.
6043 Unscored articles will be counted as having a score of zero."
6044   (let ((h1 (gnus-thread-header h1))
6045         (h2 (gnus-thread-header h2)))
6046     (let ((s1 (assq (header-number h1) gnus-newsgroup-scored))
6047           (s2 (assq (header-number h2) gnus-newsgroup-scored)))
6048       (> (or (cdr s1) gnus-summary-default-score 0)
6049          (or (cdr s2) gnus-summary-default-score 0)))))
6050
6051 (defun gnus-thread-sort-by-total-score (h1 h2)
6052   "Sort threads by the sum of all scores in the thread.
6053 Unscored articles will be counted as having a score of zero."
6054   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
6055
6056 (defun gnus-thread-total-score (thread)
6057   ;;  This function find the total score of THREAD.
6058   (if (consp thread)
6059       (if (stringp (car thread))
6060           (apply gnus-thread-score-function 0
6061                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
6062         (gnus-thread-total-score-1 thread))
6063     (gnus-thread-total-score-1 (list thread))))
6064
6065 (defun gnus-thread-total-score-1 (root)
6066   ;; This function find the total score of the thread below ROOT.
6067   (setq root (car root))
6068   (apply gnus-thread-score-function
6069          (or (cdr (assq (header-number root) gnus-newsgroup-scored))
6070              gnus-summary-default-score 0)
6071          (mapcar 'gnus-thread-total-score
6072                  (cdr (gnus-gethash (downcase (header-id root))
6073                                     gnus-newsgroup-dependencies)))))
6074
6075 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
6076 (defvar gnus-tmp-prev-subject "")
6077 (defvar gnus-tmp-adopt-thread nil)
6078
6079 ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>.
6080 (defun gnus-summary-prepare-threads 
6081   (threads level &optional not-child no-subject cull)
6082   "Prepare summary buffer from THREADS and indentation LEVEL.  
6083 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'  
6084 or a straight list of headers."
6085   (let (thread header number subject clevel)
6086     (while threads
6087       (setq thread (car threads)
6088             threads (cdr threads))
6089       ;; If `thread' is a cons, hierarchical threads are used.  If not,
6090       ;; `thread' is the header.
6091       (if (consp thread)
6092           (setq header (car thread))
6093         (setq header thread)
6094         (and cull
6095              (or (memq (setq number (header-number header))
6096                        gnus-newsgroup-dormant)
6097                  (and gnus-summary-expunge-below
6098                       (< (or (cdr (assq number gnus-newsgroup-scored))
6099                              gnus-summary-default-score 0)
6100                          gnus-summary-expunge-below)))
6101              (progn
6102                (setq header nil)
6103                (setq gnus-newsgroup-unreads 
6104                      (delq number gnus-newsgroup-unreads)))))
6105       (cond 
6106        ((stringp header)
6107         ;; The header is a dummy root.
6108         (cond ((eq gnus-summary-make-false-root 'adopt)
6109                ;; We let the first article adopt the rest.
6110                (let ((gnus-tmp-adopt-thread (list (cdr thread))))
6111                  (gnus-summary-prepare-threads (list (car (cdr thread))) 0))
6112                (setq thread (cdr (cdr thread)))
6113                (while thread
6114                  (gnus-summary-prepare-threads (list (car thread)) 1 t)
6115                  (setq thread (cdr thread))))
6116               ((eq gnus-summary-make-false-root 'dummy)
6117                ;; We output a dummy root.
6118                (gnus-summary-insert-dummy-line 
6119                 nil header (header-number (car (car (cdr thread)))))
6120                (setq clevel 1))
6121               ((eq gnus-summary-make-false-root 'empty)
6122                ;; We print the articles with empty subject fields. 
6123                (let ((gnus-tmp-adopt-thread (list (cdr thread))))
6124                  (gnus-summary-prepare-threads (list (car (cdr thread))) 0))
6125                (setq thread (cdr (cdr thread)))
6126                (while thread
6127                  (gnus-summary-prepare-threads 
6128                   (list (car thread)) 0 nil
6129                   (not (and (eq gnus-summary-gather-subject-limit 'fuzzy)
6130                             (not (string=  
6131                                   (gnus-simplify-subject-re 
6132                                    (header-subject (car (car thread))))
6133                                   (gnus-simplify-subject-re header))))))
6134                  (setq thread (cdr thread))))
6135               (t
6136                ;; We do not make a root for the gathered
6137                ;; sub-threads at all.  
6138                (setq clevel 0)))
6139         ;; Print the sub-threads.
6140         (and (consp thread) (cdr thread)
6141              (gnus-summary-prepare-threads (cdr thread) clevel)))
6142        ;; The header is a real article.
6143        (header
6144         (setq number (header-number header)
6145               subject (header-subject header))
6146         (and gnus-newsgroup-async
6147              (setq gnus-newsgroup-threads
6148                    (cons (cons (header-number header)
6149                                (header-lines header)) gnus-newsgroup-threads)))
6150         (gnus-summary-insert-line
6151          nil header level nil 
6152          (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
6153                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
6154                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
6155                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
6156                (t gnus-ancient-mark))
6157          (memq number gnus-newsgroup-replied)
6158          (memq number gnus-newsgroup-expirable)
6159          (if no-subject 
6160              gnus-summary-same-subject
6161            (if (or (zerop level)
6162                    (and gnus-thread-ignore-subject
6163                         (not (string= 
6164                               (gnus-simplify-subject-re gnus-tmp-prev-subject)
6165                               (gnus-simplify-subject-re subject)))))
6166                subject
6167              gnus-summary-same-subject))
6168          not-child
6169          (cdr (assq number gnus-newsgroup-scored)))
6170         (setq gnus-tmp-prev-subject subject)
6171         ;; Recursively print subthreads.
6172         (and (consp thread) (cdr thread)
6173              (gnus-summary-prepare-threads (cdr thread) (1+ level))))))))
6174
6175 (defun gnus-select-newsgroup (group &optional read-all)
6176   "Select newsgroup GROUP.
6177 If READ-ALL is non-nil, all articles in the group are selected."
6178   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
6179          (info (nth 2 entry))
6180          articles)
6181     (gnus-check-news-server
6182      (setq gnus-current-select-method (gnus-find-method-for-group group)))
6183
6184     (or (gnus-server-opened gnus-current-select-method)
6185         (gnus-open-server gnus-current-select-method)
6186         (error "Couldn't open server"))
6187     
6188     (or (and (eq (car entry) t)
6189              (gnus-activate-newsgroup (car info)))
6190         (gnus-request-group group t)
6191         (progn
6192           (kill-buffer (current-buffer))
6193           (error "Couldn't request group %s: %s" 
6194                  group (gnus-status-message group))))
6195
6196     (setq gnus-newsgroup-name group)
6197     (setq gnus-newsgroup-unselected nil)
6198     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
6199
6200     (and gnus-asynchronous
6201          (gnus-check-backend-function 
6202           'request-asynchronous gnus-newsgroup-name)
6203          (setq gnus-newsgroup-async
6204                (gnus-request-asynchronous gnus-newsgroup-name)))
6205
6206     (setq articles (gnus-articles-to-read group read-all))
6207
6208     (cond 
6209      ((null articles) 
6210       (gnus-message 3 "Couldn't select newsgroup")
6211       'quit)
6212      ((eq articles 0) nil)
6213      (t
6214       ;; Init the dependencies hash table.
6215       (setq gnus-newsgroup-dependencies 
6216             (gnus-make-hashtable (length articles)))
6217       ;; Retrieve the headers and read them in.
6218       (setq gnus-newsgroup-headers 
6219             (if (eq 'nov (setq gnus-headers-retrieved-by
6220                                (gnus-retrieve-headers 
6221                                 (if (and gnus-fetch-old-headers 
6222                                          (not (eq 1 (car articles))))
6223                                     (cons 1 articles)
6224                                   articles)
6225                                 gnus-newsgroup-name)))
6226                 (progn
6227                   (gnus-get-newsgroup-headers-xover articles))
6228               ;; If we were to fetch old headers, but the backend didn't
6229               ;; support XOVER, then it is possible we fetched one article
6230               ;; that we shouldn't have. If that's the case, we pop it off the
6231               ;; list of headers.
6232               (if (not gnus-fetch-old-headers)
6233                   ()
6234                 (save-excursion
6235                   (set-buffer nntp-server-buffer)
6236                   (goto-char (point-min))
6237                   (and (looking-at "[0-9]+[ \t]+1[ \t]")
6238                        (delete-region 
6239                         (point) 
6240                         (search-forward "\n.\n" nil t)))))
6241               (gnus-get-newsgroup-headers)))
6242       ;; Remove canceled articles from the list of unread articles.
6243       (setq gnus-newsgroup-unreads
6244             (gnus-set-sorted-intersection 
6245              gnus-newsgroup-unreads
6246              (mapcar (lambda (headers) (header-number headers))
6247                      gnus-newsgroup-headers)))
6248       ;; Adjust and set lists of article marks.
6249       (and info
6250            (let (marked)
6251              (gnus-adjust-marked-articles info)
6252              (setq gnus-newsgroup-marked 
6253                    (cdr (assq 'tick (setq marked (nth 3 info)))))
6254              (setq gnus-newsgroup-replied (cdr (assq 'reply marked)))
6255              (setq gnus-newsgroup-expirable (cdr (assq 'expire marked)))
6256              (setq gnus-newsgroup-killed (cdr (assq 'killed marked)))
6257              (setq gnus-newsgroup-bookmarks (cdr (assq 'bookmark marked)))
6258              (setq gnus-newsgroup-dormant (cdr (assq 'dormant marked)))
6259              (setq gnus-newsgroup-scored (cdr (assq 'score marked)))
6260              (setq gnus-newsgroup-processable nil)))
6261       ;; Check whether auto-expire is to be done in this group.
6262       (setq gnus-newsgroup-auto-expire
6263             (or (and (stringp gnus-auto-expirable-newsgroups)
6264                      (string-match gnus-auto-expirable-newsgroups group))
6265                 (memq 'auto-expire (nth 5 info))))
6266       ;; First and last article in this newsgroup.
6267       (and gnus-newsgroup-headers
6268            (setq gnus-newsgroup-begin 
6269                  (header-number (car gnus-newsgroup-headers)))
6270            (setq gnus-newsgroup-end
6271                  (header-number (gnus-last-element gnus-newsgroup-headers))))
6272       (setq gnus-reffed-article-number -1)
6273       ;; GROUP is successfully selected.
6274       (or gnus-newsgroup-headers t)))))
6275
6276 (defun gnus-articles-to-read (group read-all)
6277   ;; Find out what articles the user wants to read.
6278   (let* ((articles
6279           ;; Select all articles if `read-all' is non-nil, or if all the
6280           ;; unread articles are dormant articles.
6281           (if (or (and read-all (not (numberp read-all)))
6282                   (= (length gnus-newsgroup-unreads) 
6283                      (length gnus-newsgroup-dormant)))
6284               (gnus-uncompress-range 
6285                (gnus-gethash group gnus-active-hashtb))
6286             gnus-newsgroup-unreads))
6287          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
6288          (scored (length scored-list))
6289          (number (length articles))
6290          (marked (+ (length gnus-newsgroup-marked)
6291                     (length gnus-newsgroup-dormant)))
6292          (select
6293           (cond 
6294            ((numberp read-all)
6295             read-all)
6296            (t
6297             (condition-case ()
6298                 (cond ((and (or (<= scored marked)
6299                                 (= scored number))
6300                             (numberp gnus-large-newsgroup)
6301                             (> number gnus-large-newsgroup))
6302                        (let ((input
6303                               (read-string
6304                                (format
6305                                 "How many articles from %s (default %d): "
6306                                 gnus-newsgroup-name number))))
6307                          (if (string-match "^[ \t]*$" input)
6308                              number input)))
6309                       ((and (> scored marked) (< scored number))
6310                        (let ((input
6311                               (read-string
6312                                (format 
6313                                 "%s %s (%d scored, %d total): "
6314                                 "How many articles from"
6315                                 group scored number))))
6316                          (if (string-match "^[ \t]*$" input)
6317                              number input)))
6318                       (t number))
6319               (quit nil))))))
6320     (setq select (if (stringp select) (string-to-number select) select))
6321     (if (or (null select) (zerop select))
6322         select
6323       (if (and (not (zerop scored)) (<= (abs select) scored))
6324           (progn
6325             (setq articles (sort scored-list '<))
6326             (setq number (length articles)))
6327         (setq articles (copy-sequence articles)))
6328
6329       (if (< (abs select) number)
6330           (if (< select 0) 
6331               ;; Select the N oldest articles.
6332               (setcdr (nthcdr (1- (abs select)) articles) nil)
6333             ;; Select the N most recent articles.
6334             (setq articles (nthcdr (- number select) articles))))
6335       (setq gnus-newsgroup-unselected
6336             (gnus-sorted-intersection
6337              gnus-newsgroup-unreads
6338              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
6339       articles)))
6340
6341 (defun gnus-killed-articles (killed articles)
6342   (let (out)
6343     (while articles
6344       (if (inline (gnus-member-of-range (car articles) killed))
6345           (setq out (cons (car articles) out)))
6346       (setq articles (cdr articles)))
6347     out))
6348
6349 (defun gnus-adjust-marked-articles (info &optional active)
6350   "Remove all marked articles that are no longer legal."
6351   (let ((marked-lists (nth 3 info))
6352         (active (or active (gnus-gethash (car info) gnus-active-hashtb)))
6353         m prev)
6354     ;; There are many types of marked articles.
6355     (while marked-lists
6356       (setq m (cdr (setq prev (car marked-lists))))
6357       (cond ((or (eq 'tick (car prev)) (eq 'dormant (car prev)))
6358              ;; Make sure that all ticked articles are a subset of the
6359              ;; unread/unselected articles.
6360              (while m
6361                (if (or (memq (car m) gnus-newsgroup-unreads)
6362                        (memq (car m) gnus-newsgroup-unselected))
6363                    (setq prev m)
6364                  (setcdr prev (cdr m)))
6365                (setq m (cdr m))))
6366             ((eq 'score (car prev))
6367              ;; Scored articles should be a subset of
6368              ;; unread/unselected articles. 
6369              (while m
6370                (if (or (memq (car (car m)) gnus-newsgroup-unreads)
6371                        (memq (car (car m)) gnus-newsgroup-unreads))
6372                    (setq prev m)
6373                  (setcdr prev (cdr m)))
6374                (setq m (cdr m))))
6375             ((eq 'bookmark (car prev))
6376              ;; Bookmarks should be a subset of active articles.
6377              (while m
6378                (if (< (car (car m)) (car active))
6379                    (setcdr prev (cdr m))
6380                  (setq prev m))
6381                (setq m (cdr m))))
6382             ((eq 'killed (car prev))
6383              ;; Articles that have been through the kill process are
6384              ;; to be a subset of active articles.
6385              (while (and m (< (or (and (numberp (car m)) (car m))
6386                                   (cdr (car m)))
6387                               (car active)))
6388                (setcdr prev (cdr m))
6389                (setq m (cdr m)))
6390              (if (and m (< (or (and (numberp (car m)) (car m))
6391                                (car (car m)))
6392                            (car active))) 
6393                  (setcar (if (numberp (car m)) m (car m)) (car active))))
6394             ((or (eq 'reply (car prev)) (eq 'expire (car prev)))
6395              ;; The replied and expirable articles have to be articles
6396              ;; that are active. 
6397              (while m
6398                (if (< (car m) (car active))
6399                    (setcdr prev (cdr m))
6400                  (setq prev m))
6401                (setq m (cdr m)))))
6402       (setq marked-lists (cdr marked-lists)))
6403     ;; Remove all lists that are empty.
6404     (setq marked-lists (nth 3 info))
6405     (if marked-lists
6406         (progn
6407           (while (= 1 (length (car marked-lists)))
6408             (setq marked-lists (cdr marked-lists)))
6409           (setq m (cdr (setq prev marked-lists)))
6410           (while m
6411             (if (= 1 (length (car m)))
6412                 (setcdr prev (cdr m))
6413               (setq prev m))
6414             (setq m (cdr m)))
6415           (setcar (nthcdr 3 info) marked-lists)))
6416     ;; Finally, if there are no marked lists at all left, and if there
6417     ;; are no elements after the lists in the info list, we just chop
6418     ;; the info list off before the marked lists.
6419     (and (null marked-lists) 
6420          (not (nthcdr 4 info))
6421          (setcdr (nthcdr 2 info) nil)))
6422   info)
6423
6424 (defun gnus-set-marked-articles 
6425   (info ticked replied expirable killed dormant bookmark score) 
6426   "Enter the various lists of marked articles into the newsgroup info list."
6427   (let (newmarked)
6428     (and ticked (setq newmarked (cons (cons 'tick ticked) nil)))
6429     (and replied (setq newmarked (cons (cons 'reply replied) newmarked)))
6430     (and expirable (setq newmarked (cons (cons 'expire expirable) 
6431                                          newmarked)))
6432     (and killed (setq newmarked (cons (cons 'killed killed) newmarked)))
6433     (and dormant (setq newmarked (cons (cons 'dormant dormant) newmarked)))
6434     (and bookmark (setq newmarked (cons (cons 'bookmark bookmark) 
6435                                         newmarked)))
6436     (and score (setq newmarked (cons (cons 'score score) newmarked)))
6437     (if (nthcdr 3 info)
6438         (progn
6439           (setcar (nthcdr 3 info) newmarked)
6440           (and (not newmarked)
6441                (not (nthcdr 4 info))
6442                (setcdr (nthcdr 2 info) nil)))
6443       (if newmarked
6444           (setcdr (nthcdr 2 info) (list newmarked))))))
6445
6446 (defun gnus-add-marked-articles (group type articles &optional info force)
6447   ;; Add ARTICLES of TYPE to the info of GROUP.
6448   ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
6449   ;; add, but replace marked articles of TYPE with ARTICLES.
6450   (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
6451         marked m)
6452     (or (not info)
6453         (and (not (setq marked (nthcdr 3 info)))
6454              (setcdr (nthcdr 2 info) (list (list (cons type articles)))))
6455         (and (not (setq m (assq type (car marked))))
6456              (setcar marked (cons (cons type articles) (car marked))))
6457         (if force
6458             (setcdr m articles)
6459           (nconc m articles)))))
6460          
6461 (defun gnus-set-mode-line (where)
6462   "This function sets the mode line of the article or summary buffers.
6463 If WHERE is `summary', the summary mode line format will be used."
6464   (if (memq where gnus-updated-mode-lines)
6465       (let (mode-string)
6466         (save-excursion
6467           (set-buffer gnus-summary-buffer)
6468           (let* ((mformat (if (eq where 'article) 
6469                               gnus-article-mode-line-format-spec
6470                             gnus-summary-mode-line-format-spec))
6471                  (group-name gnus-newsgroup-name)
6472                  (article-number (or gnus-current-article 0))
6473                  (unread (- (length gnus-newsgroup-unreads)
6474                             (length gnus-newsgroup-dormant)))
6475                  (unread-and-unticked 
6476                   (- unread (length gnus-newsgroup-marked)))
6477                  (unselected (length gnus-newsgroup-unselected))
6478                  (unread-and-unselected
6479                   (cond ((and (zerop unread-and-unticked)
6480                               (zerop unselected)) "")
6481                         ((zerop unselected) 
6482                          (format "{%d more}" unread-and-unticked))
6483                         (t (format "{%d(+%d) more}"
6484                                    unread-and-unticked unselected))))
6485                  (subject
6486                   (if gnus-current-headers
6487                       (header-subject gnus-current-headers) ""))
6488                  (max-len (and gnus-mode-non-string-length
6489                                (- (frame-width) gnus-mode-non-string-length)))
6490                  header) ;; passed as argument to any user-format-funcs
6491             (setq mode-string (eval mformat))
6492             (or (numberp max-len)
6493                 (setq max-len (length mode-string)))
6494             (if (< max-len 4) (setq max-len 4))
6495             (if (> (length mode-string) max-len)
6496                 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
6497                 ;;  function `substring' might cut on a middle
6498                 ;;  of multi-octet character.
6499                 (setq mode-string 
6500                       (concat (gnus-truncate-string mode-string (- max-len 3))
6501                               "...")))
6502             (setq mode-string (format (format "%%-%ds" max-len)
6503                                       mode-string))))
6504         (setq mode-line-buffer-identification mode-string)
6505         (set-buffer-modified-p t))))
6506
6507 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
6508   "Go through the HEADERS list and add all Xrefs to a hash table.
6509 The resulting hash table is returned, or nil if no Xrefs were found."
6510   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
6511          (prefix (if (and 
6512                       (gnus-group-foreign-p from-newsgroup)
6513                       (not (memq 'virtual 
6514                                  (assoc (symbol-name (car from-method))
6515                                         gnus-valid-select-methods))))
6516                      (gnus-group-real-prefix from-newsgroup)))
6517          (xref-hashtb (make-vector 63 0))
6518          start group entry number xrefs header)
6519     (while headers
6520       (setq header (car headers))
6521       (if (and (setq xrefs (header-xref header))
6522                (not (memq (header-number header) unreads)))
6523           (progn
6524             (setq start 0)
6525             (while (string-match "\\([^ ]+\\):\\([0-9]+\\)" xrefs start)
6526               (setq start (match-end 0))
6527               (setq group (concat prefix (substring xrefs (match-beginning 1) 
6528                                                     (match-end 1))))
6529               (setq number 
6530                     (string-to-int (substring xrefs (match-beginning 2) 
6531                                               (match-end 2))))
6532               (if (setq entry (gnus-gethash group xref-hashtb))
6533                   (setcdr entry (cons number (cdr entry)))
6534                 (gnus-sethash group (cons number nil) xref-hashtb)))))
6535       (setq headers (cdr headers)))
6536     (if start xref-hashtb nil)))
6537
6538 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable)
6539   "Look through all the headers and mark the Xrefs as read."
6540   (let ((virtual (memq 'virtual 
6541                        (assoc (symbol-name (car (gnus-find-method-for-group 
6542                                                  from-newsgroup)))
6543                               gnus-valid-select-methods)))
6544         name entry info xref-hashtb idlist method
6545         nth4)
6546     (save-excursion
6547       (set-buffer gnus-group-buffer)
6548       (if (setq xref-hashtb 
6549                 (gnus-create-xref-hashtb from-newsgroup headers unreads))
6550           (mapatoms 
6551            (lambda (group)
6552              (if (string= from-newsgroup (setq name (symbol-name group)))
6553                  ()
6554                (setq idlist (symbol-value group))
6555                ;; Dead groups are not updated.
6556                (if (and (prog1 
6557                             (setq entry (gnus-gethash name gnus-newsrc-hashtb)
6558                                   info (nth 2 entry))
6559                           (if (stringp (setq nth4 (nth 4 info)))
6560                               (setq nth4 (gnus-server-to-method nth4))))
6561                         ;; Only do the xrefs if the group has the same
6562                         ;; select method as the group we have just read.
6563                         (or (gnus-methods-equal-p 
6564                              nth4 (gnus-find-method-for-group from-newsgroup))
6565                             virtual
6566                             (equal nth4 
6567                                    (setq method (gnus-find-method-for-group 
6568                                                  from-newsgroup)))
6569                             (and (equal (car nth4) (car method))
6570                                  (equal (nth 1 nth4) (nth 1 method))))
6571                         gnus-use-cross-reference
6572                         (or (not (eq gnus-use-cross-reference t))
6573                             virtual
6574                             ;; Only do cross-references on subscribed
6575                             ;; groups, if that is what is wanted.  
6576                             (<= (nth 1 info) gnus-level-subscribed)))
6577                    (gnus-group-make-articles-read name idlist expirable))))
6578            xref-hashtb)))))
6579
6580 (defun gnus-group-make-articles-read (group articles expirable)
6581   (let* ((num 0)
6582          (entry (gnus-gethash group gnus-newsrc-hashtb))
6583          (info (nth 2 entry))
6584          (active (gnus-gethash group gnus-active-hashtb))
6585          exps expirable range)
6586     ;; First peel off all illegal article numbers.
6587     (if active
6588         (let ((ids articles)
6589               (ticked (cdr (assq 'tick (nth 3 info))))
6590               (dormant (cdr (assq 'dormant (nth 3 info))))
6591               id)
6592           (setq exps nil)
6593           (while ids
6594             (setq id (car ids))
6595             (if (or (> id (cdr active))
6596                     (< id (car active))
6597                     (memq id ticked)
6598                     (memq id dormant))
6599                 (setq articles (delq id articles)))
6600             (and (memq id expirable)
6601                  (setq exps (cons id exps)))
6602             (setq ids (cdr ids)))))
6603     ;; Update expirable articles.
6604     (gnus-add-marked-articles nil 'expirable exps info)
6605     (and active
6606          (null (nth 2 info))
6607          (> (car active) 1)
6608          (setcar (nthcdr 2 info) (cons 1 (1- (car active)))))
6609     (setcar (nthcdr 2 info)
6610             (setq range
6611                   (gnus-add-to-range 
6612                    (nth 2 info) 
6613                    (setq articles (sort articles '<)))))
6614     ;; Then we have to re-compute how many unread
6615     ;; articles there are in this group.
6616     (if active
6617         (progn
6618           (cond 
6619            ((not range)
6620             (setq num (- (1+ (cdr active)) (car active))))
6621            ((not (listp (cdr range)))
6622             (setq num (- (cdr active) (- (1+ (cdr range)) 
6623                                          (car range)))))
6624            (t
6625             (while range
6626               (if (numberp (car range))
6627                   (setq num (1+ num))
6628                 (setq num (+ num (- (1+ (cdr (car range)))
6629                                     (car (car range))))))
6630               (setq range (cdr range)))
6631             (setq num (- (cdr active) num))))
6632           ;; Update the number of unread articles.
6633           (setcar 
6634            entry 
6635            (max 0 (- num 
6636                      (length (cdr (assq 'tick (nth 3 info))))
6637                      (length 
6638                       (cdr (assq 'dormant (nth 3 info)))))))
6639           ;; Update the group buffer.
6640           (gnus-group-update-group group t)))))
6641
6642 (defun gnus-methods-equal-p (m1 m2)
6643   (let ((m1 (or m1 gnus-select-method))
6644         (m2 (or m2 gnus-select-method)))
6645     (or (equal m1 m2)
6646         (and (eq (car m1) (car m2))
6647              (or (not (memq 'address (assoc (symbol-name (car m1))
6648                                             gnus-valid-select-methods)))
6649                  (equal (nth 1 m1) (nth 1 m2)))))))
6650
6651 (defsubst gnus-header-value ()
6652   (buffer-substring (match-end 0) (gnus-point-at-eol)))
6653
6654 (defvar gnus-newsgroup-none-id 0)
6655
6656 (defun gnus-get-newsgroup-headers ()
6657   (setq gnus-article-internal-prepare-hook nil)
6658   (let ((cur nntp-server-buffer)
6659         (dependencies gnus-newsgroup-dependencies)
6660         headers id dep end ref)
6661     (save-excursion
6662       (set-buffer nntp-server-buffer)
6663       (goto-char (point-min))
6664       ;; Search to the beginning of the next header. Error messages
6665       ;; do not begin with 2 or 3.
6666       (while (re-search-forward "^[23][0-9]+ " nil t)
6667         (let ((header (make-vector 9 nil))
6668               (case-fold-search t)
6669               (p (point))
6670               in-reply-to)
6671           (setq id nil
6672                 ref nil)
6673           (header-set-number header (read cur))
6674           ;; This implementation of this function, with nine
6675           ;; search-forwards instead of the one re-search-forward and
6676           ;; a case (which basically was the old function) is actually
6677           ;; about twice as fast, even though it looks messier. You
6678           ;; can't have everything, I guess. Speed and elegance
6679           ;; doesn't always come hand in hand.
6680           (save-restriction
6681             (narrow-to-region (point) (or (save-excursion 
6682                                             (search-forward "\n.\n" nil t))
6683                                           (point)))
6684             (if (search-forward "\nfrom: " nil t)
6685                 (header-set-from header (gnus-header-value))
6686               (header-set-from header "(nobody)"))
6687             (goto-char p)
6688             (if (search-forward "\nsubject: " nil t)
6689                 (header-set-subject header (gnus-header-value))
6690               (header-set-subject header "(none)"))
6691             (goto-char p)
6692             (and (search-forward "\nxref: " nil t)
6693                  (header-set-xref header (gnus-header-value)))
6694             (goto-char p)
6695             (or (numberp (and (search-forward "\nlines: " nil t)
6696                               (header-set-lines header (read cur))))
6697                 (header-set-lines header 0))
6698             (goto-char p)
6699             (and (search-forward "\ndate: " nil t)
6700                  (header-set-date header (gnus-header-value)))
6701             (goto-char p)
6702             (if (search-forward "\nmessage-id: " nil t)
6703                 (header-set-id header (setq id (gnus-header-value)))
6704               ;; If there was no message-id, we just fake one to make
6705               ;; subsequent routines simpler.
6706               (header-set-id 
6707                header 
6708                (setq id (concat "none+" 
6709                                 (int-to-string 
6710                                  (setq gnus-newsgroup-none-id 
6711                                        (1+ gnus-newsgroup-none-id)))))))
6712             (goto-char p)
6713             (if (search-forward "\nreferences: " nil t)
6714                 (progn
6715                   (header-set-references header (gnus-header-value))
6716                   (setq end (match-end 0))
6717                   (save-excursion
6718                     (setq ref 
6719                           (downcase
6720                            (buffer-substring
6721                             (progn 
6722                               (end-of-line)
6723                               (search-backward ">" end t)
6724                               (1+ (point)))
6725                             (progn
6726                               (search-backward "<" end t)
6727                               (point)))))))
6728               ;; Get the references from the in-reply-to header if there
6729               ;; ware no references and the in-reply-to header looks
6730               ;; promising. 
6731               (if (and (search-forward "\nin-reply-to: " nil t)
6732                        (setq in-reply-to (gnus-header-value))
6733                        (string-match "<[^>]+>" in-reply-to))
6734                   (progn
6735                     (header-set-references 
6736                      header 
6737                      (setq ref (substring in-reply-to (match-beginning 0)
6738                                           (match-end 0))))
6739                     (setq ref (downcase ref)))
6740                 (setq ref "none")))
6741             ;; We do some threading while we read the headers. The
6742             ;; message-id and the last reference are both entered into
6743             ;; the same hash table. Some tippy-toeing around has to be
6744             ;; done in case an article has arrived before the article
6745             ;; which it refers to.
6746             (if (boundp (setq dep (intern (downcase id) dependencies)))
6747                 (if (car (symbol-value dep))
6748                     ;; An article with this Message-ID has already
6749                     ;; been seen, so we ignore this one, except we add
6750                     ;; any additional Xrefs (in case the two articles
6751                     ;; came from different servers.
6752                     (progn
6753                       (header-set-xref 
6754                        (car (symbol-value dep))
6755                        (concat (or (header-xref (car (symbol-value dep))) "")
6756                                (or (header-xref header) "")))
6757                       (setq header nil))
6758                   (setcar (symbol-value dep) header))
6759               (set dep (list header)))
6760             (if header
6761                 (progn
6762                   (if (boundp (setq dep (intern ref dependencies)))
6763                       (setcdr (symbol-value dep) 
6764                               (cons header (cdr (symbol-value dep))))
6765                     (set dep (list nil header)))
6766                   (setq headers (cons header headers))))
6767             (goto-char (point-max))))))
6768     (nreverse headers)))
6769
6770 ;; The following macros and functions were written by Felix Lee
6771 ;; <flee@cse.psu.edu>. 
6772
6773 (defmacro gnus-nov-read-integer ()
6774   '(prog1
6775        (if (= (following-char) ?\t)
6776            0
6777          (let ((num (condition-case nil (read buffer) (error nil))))
6778            (if (numberp num) num 0)))
6779      (or (eobp) (forward-char 1))))
6780
6781 (defmacro gnus-nov-skip-field ()
6782   '(search-forward "\t" eol 'move))
6783
6784 (defmacro gnus-nov-field ()
6785   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
6786
6787 ;; Goes through the xover lines and returns a list of vectors
6788 (defun gnus-get-newsgroup-headers-xover (sequence)
6789   "Parse the news overview data in the server buffer, and return a
6790 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
6791   ;; Get the Xref when the users reads the articles since most/some
6792   ;; NNTP servers do not include Xrefs when using XOVER.
6793   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
6794   (let ((cur nntp-server-buffer)
6795         (dependencies gnus-newsgroup-dependencies)
6796         number headers header)
6797     (save-excursion
6798       (set-buffer nntp-server-buffer)
6799       (goto-char (point-min))
6800       (while (and sequence (not (eobp)))
6801         (setq number (read cur))
6802         (while (and sequence (< (car sequence) number))
6803           (setq sequence (cdr sequence)))
6804         (and sequence 
6805              (eq number (car sequence))
6806              (progn
6807                (setq sequence (cdr sequence))
6808                (if (setq header 
6809                          (inline (gnus-nov-parse-line number dependencies)))
6810                    (setq headers (cons header headers)))))
6811         (forward-line 1))
6812       (setq headers (nreverse headers)))
6813     headers))
6814
6815 ;; This function has to be called with point after the article number
6816 ;; on the beginning of the line.
6817 (defun gnus-nov-parse-line (number dependencies)
6818   (let ((none 0)
6819         (eol (gnus-point-at-eol)) 
6820         (buffer (current-buffer))
6821         header ref id dep)
6822
6823     ;; overview: [num subject from date id refs chars lines misc]
6824     (narrow-to-region (point) eol)
6825     (forward-char)
6826
6827     (condition-case nil
6828         (setq header
6829               (vector 
6830                number                   ; number
6831                (gnus-nov-field)         ; subject
6832                (gnus-nov-field)         ; from
6833                (gnus-nov-field)         ; date
6834                (setq id (or (gnus-nov-field)
6835                             (concat "none+"
6836                                     (int-to-string 
6837                                      (setq none (1+ none)))))) ; id
6838                (progn
6839                  (save-excursion
6840                    (let ((beg (point)))
6841                      (search-forward "\t" eol)
6842                      (if (search-backward ">" beg t)
6843                          (setq ref 
6844                                (downcase 
6845                                 (buffer-substring 
6846                                  (1+ (point))
6847                                  (progn
6848                                    (search-backward "<" beg t)
6849                                    (point)))))
6850                        (setq ref nil))))
6851                  (gnus-nov-field))      ; refs
6852                (gnus-nov-read-integer)  ; chars
6853                (gnus-nov-read-integer)  ; lines
6854                (if (= (following-char) ?\n)
6855                    nil
6856                  (gnus-nov-field))      ; misc
6857                ))
6858       (error (progn 
6859                (ding)
6860                (message "Strange nov line.")
6861                (setq header nil)
6862                (goto-char eol))))
6863
6864     (widen)
6865
6866     ;; We build the thread tree.
6867     (and header
6868          (if (boundp (setq dep (intern (downcase id) dependencies)))
6869              (if (car (symbol-value dep))
6870                  ;; An article with this Message-ID has already been seen,
6871                  ;; so we ignore this one, except we add any additional
6872                  ;; Xrefs (in case the two articles came from different
6873                  ;; servers.
6874                  (progn
6875                    (header-set-xref 
6876                     (car (symbol-value dep))
6877                     (concat (or (header-xref (car (symbol-value dep))) "")
6878                             (or (header-xref header) "")))
6879                    (setq header nil))
6880                (setcar (symbol-value dep) header))
6881            (set dep (list header))))
6882     (if header
6883         (progn
6884           (if (boundp (setq dep (intern (or ref "none") 
6885                                         dependencies)))
6886               (setcdr (symbol-value dep) 
6887                       (cons header (cdr (symbol-value dep))))
6888             (set dep (list nil header)))))
6889     header))
6890
6891 (defun gnus-article-get-xrefs ()
6892   "Fill in the Xref value in `gnus-current-headers', if necessary.
6893 This is meant to be called in `gnus-article-internal-prepare-hook'."
6894   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
6895                                  gnus-current-headers)))
6896     (or (not gnus-use-cross-reference)
6897         (not headers)
6898         (and (header-xref headers)
6899              (not (string= (header-xref headers) "")))
6900         (let ((case-fold-search t)
6901               xref)
6902           (save-restriction
6903             (gnus-narrow-to-headers)
6904             (goto-char (point-min))
6905             (if (or (and (eq (downcase (following-char)) ?x)
6906                          (looking-at "Xref:"))
6907                     (search-forward "\nXref:" nil t))
6908                 (progn
6909                   (goto-char (1+ (match-end 0)))
6910                   (setq xref (buffer-substring (point) 
6911                                                (progn (end-of-line) (point))))
6912                   (header-set-xref headers xref))))))))
6913
6914 (defalias 'gnus-find-header-by-number 'gnus-get-header-by-number)
6915 (make-obsolete 'gnus-find-header-by-number 'gnus-get-header-by-number)
6916
6917 ;; Return a header specified by a NUMBER.
6918 (defun gnus-get-header-by-number (number)
6919   (save-excursion
6920     (set-buffer gnus-summary-buffer)
6921     (or gnus-newsgroup-headers-hashtb-by-number
6922         (gnus-make-headers-hashtable-by-number))
6923     (gnus-gethash (int-to-string number)
6924                   gnus-newsgroup-headers-hashtb-by-number)))
6925
6926 (defun gnus-make-headers-hashtable-by-number ()
6927   "Make hashtable for the variable gnus-newsgroup-headers by number."
6928   (save-excursion
6929     (set-buffer gnus-summary-buffer)
6930     (let ((headers gnus-newsgroup-headers)
6931           header)
6932       (setq gnus-newsgroup-headers-hashtb-by-number
6933             (gnus-make-hashtable (length headers)))
6934       (while headers
6935         (setq header (car headers))
6936         (gnus-sethash (int-to-string (header-number header))
6937                       header gnus-newsgroup-headers-hashtb-by-number)
6938         (setq headers (cdr headers))))))
6939
6940 (defun gnus-more-header-backward ()
6941   "Find new header backward."
6942   (let ((first (car (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
6943         (artnum gnus-newsgroup-begin)
6944         (header nil))
6945     (while (and (not header)
6946                 (> artnum first))
6947       (setq artnum (1- artnum))
6948       (setq header (gnus-read-header artnum)))
6949     header))
6950
6951 (defun gnus-more-header-forward (&optional backward)
6952   "Find new header forward.
6953 If BACKWARD, find new header backward instead."
6954   (if backward
6955       (gnus-more-header-backward)
6956     (let ((last (cdr (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
6957           (artnum gnus-newsgroup-end)
6958           (header nil))
6959       (while (and (not header)
6960                   (< artnum last))
6961         (setq artnum (1+ artnum))
6962         (setq header (gnus-read-header artnum)))
6963       header)))
6964
6965 (defun gnus-extend-newsgroup (header &optional backward)
6966   "Extend newsgroup selection with HEADER.
6967 Optional argument BACKWARD means extend toward backward."
6968   (if header
6969       (let ((artnum (header-number header)))
6970         (setq gnus-newsgroup-headers
6971               (if backward
6972                   (cons header gnus-newsgroup-headers)
6973                 (nconc gnus-newsgroup-headers (list header))))
6974         (setq gnus-newsgroup-unselected
6975               (delq artnum gnus-newsgroup-unselected))
6976         (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
6977         (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum)))))
6978
6979 (defun gnus-summary-work-articles (n)
6980   "Return a list of articles to be worked upon. The prefix argument,
6981 the list of process marked articles, and the current article will be
6982 taken into consideration."
6983   (let (articles)
6984     (if (and n (numberp n))
6985         (let ((backward (< n 0))
6986               (n (abs n)))
6987           (save-excursion
6988             (while (and (> n 0)
6989                         (setq articles (cons (gnus-summary-article-number) 
6990                                              articles))
6991                         (gnus-summary-search-forward nil nil backward))
6992               (setq n (1- n))))
6993           (sort articles (function <)))
6994       (or (reverse gnus-newsgroup-processable)
6995           (list (gnus-summary-article-number))))))
6996
6997 (defun gnus-summary-search-group (&optional backward use-level)
6998   "Search for next unread newsgroup.
6999 If optional argument BACKWARD is non-nil, search backward instead."
7000   (save-excursion
7001     (set-buffer gnus-group-buffer)
7002     (if (gnus-group-search-forward 
7003          backward nil (if use-level (gnus-group-group-level) nil))
7004         (gnus-group-group-name))))
7005
7006 (defun gnus-summary-best-group (&optional exclude-group)
7007   "Find the name of the best unread group.
7008 If EXCLUDE-GROUP, do not go to this group."
7009   (save-excursion
7010     (set-buffer gnus-group-buffer)
7011     (save-excursion
7012       (gnus-group-best-unread-group exclude-group))))
7013
7014 (defun gnus-summary-search-subject (&optional backward unread subject)
7015   "Search for article forward.
7016 If BACKWARD is non-nil, search backward.
7017 If UNREAD is non-nil, only unread articles are selected.
7018 If SUBJECT is non-nil, the article which has the same subject will be
7019 searched for." 
7020   (let ((func (if backward 'previous-single-property-change
7021                 'next-single-property-change))
7022         (beg (point))
7023         (did t)
7024         pos psubject)
7025     (beginning-of-line)
7026     (and gnus-summary-check-current unread
7027          (eq (get-text-property (point) 'gnus-mark) gnus-unread-mark)
7028          (setq did nil))
7029     (if (not did)
7030         ()
7031       (forward-char (if backward (if (bobp) 0 -1) (if (eobp) 0 1)))
7032       (while
7033           (and 
7034            (setq pos (funcall func (point) 'gnus-number))
7035            (goto-char (if backward (1- pos) pos))
7036            (setq did
7037                  (not (and
7038                        (or (not unread)
7039                            (eq (get-text-property (point) 'gnus-mark)
7040                                gnus-unread-mark))
7041                        (or (not subject)
7042                            (and (setq psubject (gnus-summary-subject-string))
7043                                 (gnus-subject-equal subject psubject))))))
7044            (if backward (if (bobp) nil (forward-char -1) t)
7045              (if (eobp) nil (forward-char 1) t)))))
7046     (if did
7047         (progn (goto-char beg) nil)
7048       (prog1
7049           (get-text-property (point) 'gnus-number)
7050         (gnus-summary-position-cursor)))))
7051
7052 (defun gnus-subject-equal (s1 s2)
7053   (cond
7054    ((null gnus-summary-gather-subject-limit)
7055     (equal (gnus-simplify-subject-re s1)
7056            (gnus-simplify-subject-re s2)))
7057    ((eq gnus-summary-gather-subject-limit 'fuzzy)
7058     (equal (gnus-simplify-subject-fuzzy s1)
7059            (gnus-simplify-subject-fuzzy s2)))
7060    ((numberp gnus-summary-gather-subject-limit)
7061     (equal (gnus-limit-string s1 gnus-summary-gather-subject-limit)
7062            (gnus-limit-string s2 gnus-summary-gather-subject-limit)))
7063    (t
7064     (equal s1 s2))))
7065     
7066 (defun gnus-summary-search-forward (&optional unread subject backward)
7067   "Search for article forward.
7068 If UNREAD is non-nil, only unread articles are selected.
7069 If SUBJECT is non-nil, the article which has the same subject will be
7070 searched for. 
7071 If BACKWARD is non-nil, the search will be performed backwards instead."
7072   (gnus-summary-search-subject backward unread subject))
7073
7074 (defun gnus-summary-search-backward (&optional unread subject)
7075   "Search for article backward.
7076 If 1st optional argument UNREAD is non-nil, only unread article is selected.
7077 If 2nd optional argument SUBJECT is non-nil, the article which has
7078 the same subject will be searched for."
7079   (gnus-summary-search-forward unread subject t))
7080
7081 (defun gnus-summary-article-number (&optional number-or-nil)
7082   "The article number of the article on the current line.
7083 If there isn's an article number here, then we return the current
7084 article number."
7085   (let* ((number (get-text-property (gnus-point-at-bol) 'gnus-number)))
7086     (if number-or-nil number (or number gnus-current-article))))
7087
7088 (defun gnus-summary-thread-level ()
7089   "The thread level of the article on the current line."
7090   (or (get-text-property (gnus-point-at-bol) 'gnus-level)
7091       0))
7092
7093 (defun gnus-summary-pseudo-article ()
7094   "The thread level of the article on the current line."
7095   (get-text-property (gnus-point-at-bol) 'gnus-pseudo))
7096
7097 (defun gnus-summary-article-mark ()
7098   "The mark on the current line."
7099   (get-text-property (gnus-point-at-bol) 'gnus-mark))
7100
7101 (defun gnus-summary-subject-string ()
7102   "Return current subject string or nil if nothing."
7103   (let ((article (gnus-summary-article-number))
7104         header)
7105     (and article 
7106          (setq header (gnus-get-header-by-number article))
7107          (vectorp header)
7108          (header-subject header))))
7109
7110 (defalias 'gnus-summary-score 'gnus-summary-article-score)
7111 (make-obsolete 'gnus-summary-score 'gnus-summary-article-score)
7112 (defun gnus-summary-article-score ()
7113   "Return current article score."
7114   (or (cdr (assq (gnus-summary-article-number) gnus-newsgroup-scored))
7115       gnus-summary-default-score 0))
7116
7117 (defun gnus-summary-recenter ()
7118   "Center point in the summary window.
7119 If `gnus-auto-center-summary' is nil, or the article buffer isn't
7120 displayed, no centering will be performed." 
7121   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
7122   ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
7123   (let* ((top (cond ((< (window-height) 4) 0)
7124                     ((< (window-height) 7) 1)
7125                     (t 2)))
7126          (height (1- (window-height)))
7127          (bottom (save-excursion (goto-char (point-max))
7128                                  (forward-line (- height))
7129                                  (point)))
7130          (window (get-buffer-window (current-buffer))))
7131     (and 
7132      ;; The user has to want it,
7133      gnus-auto-center-summary 
7134      ;; the article buffer must be displayed,
7135      (get-buffer-window gnus-article-buffer)
7136      ;; Set the window start to either `bottom', which is the biggest
7137      ;; possible valid number, or the second line from the top,
7138      ;; whichever is the least.
7139      (set-window-start
7140       window (min bottom (save-excursion (forward-line (- top)) (point)))))))
7141
7142 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
7143 (defun gnus-short-group-name (group &optional levels)
7144   "Collapse GROUP name LEVELS."
7145   (let* ((name "") (foreign "") (depth -1) (skip 1)
7146          (levels (or levels
7147                      (progn
7148                        (while (string-match "\\." group skip)
7149                          (setq skip (match-end 0)
7150                                depth (+ depth 1)))
7151                        depth))))
7152     (if (string-match ":" group)
7153         (setq foreign (substring group 0 (match-end 0))
7154               group (substring group (match-end 0))))
7155     (while group
7156       (if (and (string-match "\\." group) (> levels 0))
7157           (setq name (concat name (substring group 0 1))
7158                 group (substring group (match-end 0))
7159                 levels (- levels 1)
7160                 name (concat name "."))
7161         (setq name (concat foreign name group)
7162               group nil)))
7163     name))
7164
7165 (defun gnus-summary-jump-to-group (newsgroup)
7166   "Move point to NEWSGROUP in group mode buffer."
7167   ;; Keep update point of group mode buffer if visible.
7168   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
7169       (save-window-excursion
7170         ;; Take care of tree window mode.
7171         (if (get-buffer-window gnus-group-buffer)
7172             (pop-to-buffer gnus-group-buffer))
7173         (gnus-group-jump-to-group newsgroup))
7174     (save-excursion
7175       ;; Take care of tree window mode.
7176       (if (get-buffer-window gnus-group-buffer)
7177           (pop-to-buffer gnus-group-buffer)
7178         (set-buffer gnus-group-buffer))
7179       (gnus-group-jump-to-group newsgroup))))
7180
7181 ;; This function returns a list of article numbers based on the
7182 ;; difference between the ranges of read articles in this group and
7183 ;; the range of active articles.
7184 (defun gnus-list-of-unread-articles (group)
7185   (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
7186          (active (gnus-gethash group gnus-active-hashtb))
7187          (last (cdr active))
7188          first nlast unread)
7189     ;; If none are read, then all are unread. 
7190     (if (not read)
7191         (setq first (car active))
7192       ;; If the range of read articles is a single range, then the
7193       ;; first unread article is the article after the last read
7194       ;; article. Sounds logical, doesn't it?
7195       (if (not (listp (cdr read)))
7196           (setq first (1+ (cdr read)))
7197         ;; `read' is a list of ranges.
7198         (if (/= (setq nlast (or (and (numberp (car read)) (car read)) 
7199                                 (car (car read)))) 1)
7200             (setq first 1))
7201         (while read
7202           (if first 
7203               (while (< first nlast)
7204                 (setq unread (cons first unread))
7205                 (setq first (1+ first))))
7206           (setq first (1+ (if (atom (car read)) (car read) (cdr (car read)))))
7207           (setq nlast (if (atom (car (cdr read))) 
7208                           (car (cdr read))
7209                         (car (car (cdr read)))))
7210           (setq read (cdr read)))))
7211     ;; And add the last unread articles.
7212     (while (<= first last)
7213       (setq unread (cons first unread))
7214       (setq first (1+ first)))
7215     ;; Return the list of unread articles.
7216     (nreverse unread)))
7217
7218 (defun gnus-list-of-read-articles (group)
7219   (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
7220         (active (gnus-gethash group gnus-active-hashtb)))
7221     (and info active
7222          (gnus-sorted-complement 
7223           (gnus-uncompress-range active) 
7224           (gnus-list-of-unread-articles group)))))
7225
7226 ;; Various summary commands
7227
7228 (defun gnus-summary-universal-argument ()
7229   "Perform any operation on all articles marked with the process mark."
7230   (interactive)
7231   (gnus-set-global-variables)
7232   (let ((articles (reverse gnus-newsgroup-processable))
7233         func)
7234     (or articles (error "No articles marked"))
7235     (or (setq func (key-binding (read-key-sequence "C-c C-u")))
7236         (error "Undefined key"))
7237     (while articles
7238       (gnus-summary-goto-subject (car articles))
7239       (command-execute func)
7240       (gnus-summary-remove-process-mark (car articles))
7241       (setq articles (cdr articles)))))
7242
7243 (defun gnus-summary-toggle-truncation (arg)
7244   "Toggle truncation of summary lines.
7245 With arg, turn line truncation on iff arg is positive."
7246   (interactive "P")
7247   (setq truncate-lines
7248         (if (null arg) (not truncate-lines)
7249           (> (prefix-numeric-value arg) 0)))
7250   (redraw-display))
7251
7252 (defun gnus-summary-reselect-current-group (all)
7253   "Once exit and then reselect the current newsgroup.
7254 The prefix argument ALL means to select all articles."
7255   (interactive "P")
7256   (gnus-set-global-variables)
7257   (let ((current-subject (gnus-summary-article-number))
7258         (group gnus-newsgroup-name))
7259     (setq gnus-newsgroup-begin nil)
7260     (gnus-summary-exit t)
7261     ;; We have to adjust the point of group mode buffer because the
7262     ;; current point was moved to the next unread newsgroup by
7263     ;; exiting.
7264     (gnus-summary-jump-to-group group)
7265     (gnus-group-read-group all t)
7266     (gnus-summary-goto-subject current-subject)))
7267
7268 (defun gnus-summary-rescan-group (all)
7269   "Exit the newsgroup, ask for new articles, and select the newsgroup."
7270   (interactive "P")
7271   (gnus-set-global-variables)
7272   ;; Fix by Ilja Weis <kult@uni-paderborn.de>.
7273   (let ((group gnus-newsgroup-name))
7274     (gnus-summary-exit)
7275     (gnus-summary-jump-to-group group)
7276     (save-excursion
7277       (set-buffer gnus-group-buffer)
7278       (gnus-group-get-new-news-this-group 1))
7279     (gnus-summary-jump-to-group group)
7280     (gnus-group-read-group all)))
7281
7282 (defun gnus-summary-update-info ()
7283   (let* ((group gnus-newsgroup-name))
7284     (if gnus-newsgroup-kill-headers
7285         (setq gnus-newsgroup-killed
7286               (gnus-compress-sequence
7287                (nconc
7288                 (gnus-set-sorted-intersection
7289                  (gnus-uncompress-range gnus-newsgroup-killed)
7290                  (setq gnus-newsgroup-unselected
7291                        (sort gnus-newsgroup-unselected '<)))
7292                 (setq gnus-newsgroup-unreads
7293                       (sort gnus-newsgroup-unreads '<))) t)))
7294     (or (listp (cdr gnus-newsgroup-killed))
7295         (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
7296     (let ((headers gnus-newsgroup-headers))
7297       (gnus-close-group group)
7298       (run-hooks 'gnus-exit-group-hook)
7299       (gnus-update-read-articles 
7300        group gnus-newsgroup-unreads gnus-newsgroup-unselected 
7301        gnus-newsgroup-marked
7302        t gnus-newsgroup-replied gnus-newsgroup-expirable
7303        gnus-newsgroup-killed gnus-newsgroup-dormant
7304        gnus-newsgroup-bookmarks 
7305        (and gnus-save-score gnus-newsgroup-scored))
7306       (and gnus-use-cross-reference
7307            (gnus-mark-xrefs-as-read 
7308             group headers gnus-newsgroup-unreads gnus-newsgroup-expirable))
7309       ;; Do adaptive scoring, and possibly save score files.
7310       (and gnus-newsgroup-adaptive
7311            (gnus-score-adaptive))
7312       (and gnus-use-scoring 
7313            (fboundp 'gnus-score-save)
7314            (funcall 'gnus-score-save))
7315       ;; Do not switch windows but change the buffer to work.
7316       (set-buffer gnus-group-buffer)
7317       (or (assoc 'quit-config (gnus-find-method-for-group gnus-newsgroup-name))
7318           (gnus-group-update-group group)))))
7319   
7320 (defun gnus-summary-exit (&optional temporary)
7321   "Exit reading current newsgroup, and then return to group selection mode.
7322 gnus-exit-group-hook is called with no arguments if that value is non-nil."
7323   (interactive)
7324   (gnus-set-global-variables)
7325   (gnus-kill-save-kill-buffer)
7326   (let* ((group gnus-newsgroup-name)
7327          (quit-config (nth 1 (assoc 'quit-config (gnus-find-method-for-group
7328                                                   gnus-newsgroup-name))))
7329          (mode major-mode)
7330          (buf (current-buffer)))
7331     (gnus-summary-update-info) ; Make all changes in this group permanent.
7332     (set-buffer buf)
7333     (run-hooks 'gnus-summary-exit-hook)
7334     (and gnus-use-cache (gnus-cache-possibly-remove-articles))
7335     ;; Make sure where I was, and go to next newsgroup.
7336     (set-buffer gnus-group-buffer)
7337     (or quit-config
7338         (progn
7339           (gnus-group-jump-to-group group)
7340           (gnus-group-next-unread-group 1)))
7341     (if temporary
7342         nil                             ;Nothing to do.
7343       ;; We set all buffer-local variables to nil. It is unclear why
7344       ;; this is needed, but if we don't, buffer-local variables are
7345       ;; not garbage-collected, it seems. This would the lead to en
7346       ;; ever-growing Emacs.
7347       (set-buffer buf)
7348       (gnus-summary-clear-local-variables)
7349       ;; We clear the global counterparts of the buffer-local
7350       ;; variables as well, just to be on the safe side.
7351       (gnus-configure-windows 'group)
7352       (gnus-summary-clear-local-variables)
7353       ;; Return to group mode buffer. 
7354       (if (eq mode 'gnus-summary-mode)
7355           (gnus-kill-buffer buf))
7356       (if (get-buffer gnus-article-buffer)
7357           (bury-buffer gnus-article-buffer))
7358       (setq gnus-current-select-method gnus-select-method)
7359       (pop-to-buffer gnus-group-buffer)
7360       (if (not quit-config)
7361           (progn
7362             (gnus-group-jump-to-group group)
7363             (gnus-group-next-unread-group 1))
7364         (if (not (buffer-name (car quit-config)))
7365             (gnus-configure-windows 'group)
7366           (set-buffer (car quit-config))
7367           (and (eq major-mode 'gnus-summary-mode)
7368                (gnus-set-global-variables))
7369           (gnus-configure-windows (cdr quit-config)))))))
7370
7371 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
7372 (defun gnus-summary-exit-no-update (&optional no-questions)
7373   "Quit reading current newsgroup without updating read article info."
7374   (interactive)
7375   (gnus-set-global-variables)
7376   (let* ((group gnus-newsgroup-name)
7377          (quit-config (nth 1 (assoc 'quit-config 
7378                                     (gnus-find-method-for-group group)))))
7379     (if (or no-questions
7380             gnus-expert-user
7381             (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
7382         (progn
7383           (and gnus-use-cache (gnus-cache-possibly-remove-articles))
7384           (gnus-close-group group)
7385           (gnus-summary-clear-local-variables)
7386           (set-buffer gnus-group-buffer)
7387           (gnus-summary-clear-local-variables)
7388           ;; Return to group selection mode.
7389           (gnus-configure-windows 'group)
7390           (if (get-buffer gnus-summary-buffer)
7391               (kill-buffer gnus-summary-buffer))
7392           (if (get-buffer gnus-article-buffer)
7393               (bury-buffer gnus-article-buffer))
7394           (if (equal (gnus-group-group-name) group)
7395               (gnus-group-next-unread-group 1))
7396           (if quit-config
7397               (progn
7398                 (if (not (buffer-name (car quit-config)))
7399                     (gnus-configure-windows 'group)
7400                   (set-buffer (car quit-config))
7401                   (and (eq major-mode 'gnus-summary-mode)
7402                        (gnus-set-global-variables))
7403                   (gnus-configure-windows (cdr quit-config)))))))))
7404
7405 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
7406 (defun gnus-summary-fetch-faq (group)
7407   "Fetch the FAQ for the current group."
7408   (interactive (list gnus-newsgroup-name))
7409   (let ((gnus-faq-buffer 
7410          (find-file (concat gnus-group-faq-directory 
7411                             (gnus-group-real-name group)))))
7412   (and gnus-faq-buffer (gnus-configure-windows 'summary-faq))))
7413
7414 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
7415 (defun gnus-summary-describe-group (force)
7416   "Describe the current newsgroup."
7417   (interactive "P")
7418   (gnus-group-describe-group force gnus-newsgroup-name))
7419
7420 (defun gnus-summary-describe-briefly ()
7421   "Describe summary mode commands briefly."
7422   (interactive)
7423   (gnus-message 6
7424     (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")))
7425
7426 ;; Walking around group mode buffer from summary mode.
7427
7428 (defun gnus-summary-next-group (&optional no-article target-group backward)
7429   "Exit current newsgroup and then select next unread newsgroup.
7430 If prefix argument NO-ARTICLE is non-nil, no article is selected
7431 initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
7432 previous group instead."
7433   (interactive "P")
7434   (gnus-set-global-variables)
7435   (let ((current-group gnus-newsgroup-name)
7436         (current-buffer (current-buffer))
7437         entered)
7438     ;; First we semi-exit this group to update Xrefs and all variables.
7439     ;; We can't do a real exit, because the window conf must remain
7440     ;; the same in case the user is prompted for info, and we don't
7441     ;; want the window conf to change before that...
7442     (gnus-summary-exit t)
7443     (while (not entered)
7444       ;; Then we find what group we are supposed to enter.
7445       (set-buffer gnus-group-buffer)
7446       (gnus-group-jump-to-group current-group)
7447       (setq target-group 
7448             (or target-group        
7449                 (if (eq gnus-keep-same-level 'best) 
7450                     (gnus-summary-best-group gnus-newsgroup-name)
7451                   (gnus-summary-search-group backward gnus-keep-same-level))))
7452       (if (not target-group)
7453           ;; There are no further groups, so we return to the group
7454           ;; buffer.
7455           (progn
7456             (gnus-message 5 "Returning to the group buffer")
7457             (setq entered t)
7458             (set-buffer current-buffer)
7459             (gnus-summary-exit))
7460         ;; We try to enter the target group.
7461         (gnus-group-jump-to-group target-group)
7462         (if (and (not (zerop (gnus-group-group-unread)))
7463                  (gnus-summary-read-group
7464                   target-group nil no-article current-buffer))
7465             (setq entered t)
7466           (setq current-group target-group
7467                 target-group nil))))))
7468
7469 (defun gnus-summary-next-group-old (&optional no-article group backward)
7470   "Exit current newsgroup and then select next unread newsgroup.
7471 If prefix argument NO-ARTICLE is non-nil, no article is selected initially.
7472 If BACKWARD, go to previous group instead."
7473   (interactive "P")
7474   (gnus-set-global-variables)
7475   (let ((ingroup gnus-newsgroup-name)
7476         (sumbuf (current-buffer))
7477         num)
7478     (set-buffer gnus-group-buffer)
7479     (if (and group
7480              (or (and (numberp (setq num (car (gnus-gethash
7481                                                group gnus-newsrc-hashtb))))
7482                       (< num 1))
7483                  (null num)))
7484         (progn
7485           (gnus-group-jump-to-group group)
7486           (setq group nil))
7487       (gnus-group-jump-to-group ingroup))
7488     (gnus-summary-search-group backward)
7489     (let ((group (or group (gnus-summary-search-group backward))))
7490       (set-buffer sumbuf)
7491       (gnus-summary-exit t)             ;Update all information.
7492       (if (null group)
7493           (gnus-summary-exit-no-update t)
7494         (gnus-group-jump-to-group ingroup)
7495         (setq group (gnus-summary-search-group backward))
7496         (gnus-message 5 "Selecting %s..." group)
7497         (set-buffer gnus-group-buffer)
7498         ;; We are now in group mode buffer.
7499         ;; Make sure group mode buffer point is on GROUP.
7500         (gnus-group-jump-to-group group)
7501         (if (not (eq gnus-auto-select-next 'quietly))
7502             (progn
7503               (gnus-summary-read-group group nil no-article sumbuf)
7504               (and (string= gnus-newsgroup-name ingroup)
7505                    (bufferp sumbuf) (buffer-name sumbuf)
7506                    (progn
7507                      (set-buffer (setq gnus-summary-buffer sumbuf))
7508                      (gnus-summary-exit-no-update t))))
7509           (let ((prevgroup group))
7510             (gnus-group-jump-to-group ingroup)
7511             (setq group (gnus-summary-search-group backward))
7512             (gnus-summary-read-group group nil no-article sumbuf)
7513             (while (and (string= gnus-newsgroup-name ingroup)
7514                         (bufferp sumbuf) 
7515                         (buffer-name sumbuf)
7516                         (not (string= prevgroup (gnus-group-group-name))))
7517               (set-buffer gnus-group-buffer)
7518               (gnus-summary-read-group 
7519                (setq prevgroup (gnus-group-group-name)) 
7520                nil no-article sumbuf))
7521             (and (string= prevgroup (gnus-group-group-name))
7522                  ;; We have reached the final group in the group
7523                  ;; buffer.
7524                  (progn
7525                    (if (buffer-name sumbuf)
7526                        (progn
7527                          (set-buffer sumbuf)
7528                          (gnus-summary-exit)))))))))))
7529
7530 (defun gnus-summary-prev-group (no-article)
7531   "Exit current newsgroup and then select previous unread newsgroup.
7532 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
7533   (interactive "P")
7534   (gnus-summary-next-group no-article nil t))
7535
7536 ;; Walking around summary lines.
7537
7538 (defun gnus-summary-first-subject (unread)
7539   "Go to the first unread subject.
7540 If UNREAD is non-nil, go to the first unread article.
7541 Returns nil if there are no unread articles."
7542   (interactive "P")
7543   (prog1
7544       (cond ((not unread)
7545              (goto-char (point-min)))
7546             ((gnus-goto-char 
7547               (text-property-any 
7548                (point-min) (point-max) 'gnus-mark gnus-unread-mark))
7549              t)
7550             (t 
7551              ;; There are no unread articles.
7552              (gnus-message 3 "No more unread articles")
7553              nil))
7554     (gnus-summary-position-cursor)))
7555
7556 (defun gnus-summary-next-subject (n &optional unread dont-display)
7557   "Go to next N'th summary line.
7558 If N is negative, go to the previous N'th subject line.
7559 If UNREAD is non-nil, only unread articles are selected.
7560 The difference between N and the actual number of steps taken is
7561 returned."
7562   (interactive "p")
7563   (let ((backward (< n 0))
7564         (n (abs n)))
7565     (while (and (> n 0)
7566                 (gnus-summary-search-forward unread nil backward))
7567       (setq n (1- n)))
7568     (if (/= 0 n) (gnus-message 7 "No more%s articles"
7569                                (if unread " unread" "")))
7570     (or dont-display
7571         (progn
7572           (gnus-summary-recenter)
7573           (gnus-summary-position-cursor)))
7574   n))
7575
7576 (defun gnus-summary-next-unread-subject (n)
7577   "Go to next N'th unread summary line."
7578   (interactive "p")
7579   (gnus-summary-next-subject n t))
7580
7581 (defun gnus-summary-prev-subject (n &optional unread)
7582   "Go to previous N'th summary line.
7583 If optional argument UNREAD is non-nil, only unread article is selected."
7584   (interactive "p")
7585   (gnus-summary-next-subject (- n) unread))
7586
7587 (defun gnus-summary-prev-unread-subject (n)
7588   "Go to previous N'th unread summary line."
7589   (interactive "p")
7590   (gnus-summary-next-subject (- n) t))
7591
7592 (defun gnus-summary-goto-subject (article)
7593   "Go the subject line of ARTICLE."
7594   (interactive
7595    (list
7596     (string-to-int
7597      (completing-read "Article number: "
7598                       (mapcar
7599                        (lambda (headers)
7600                          (list
7601                           (int-to-string (header-number headers))))
7602                        gnus-newsgroup-headers)
7603                       nil 'require-match))))
7604   (or article (error "No article number"))
7605   (let ((b (point)))
7606     (if (not (gnus-goto-char (text-property-any (point-min) (point-max)
7607                                                 'gnus-number article)))
7608         ()
7609       (gnus-summary-show-thread)
7610       ;; Skip dummy articles. 
7611       (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
7612           (forward-line 1))
7613       (prog1
7614           (if (not (eobp))
7615               article
7616             (goto-char b)
7617             nil)
7618         (gnus-summary-position-cursor)))))
7619
7620 ;; Walking around summary lines with displaying articles.
7621
7622 (defun gnus-summary-expand-window ()
7623   "Make the summary buffer take up the entire Emacs frame."
7624   (interactive)
7625   (gnus-set-global-variables)
7626   (gnus-configure-windows 'summary))
7627
7628 (defun gnus-summary-display-article (article &optional all-header)
7629   "Display ARTICLE in article buffer."
7630   (gnus-set-global-variables)
7631   (if (null article)
7632       nil
7633     (prog1
7634         (gnus-article-prepare article all-header)
7635       (gnus-summary-show-thread)
7636       (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
7637           (progn
7638             (forward-line 1)
7639             (gnus-summary-position-cursor)))
7640       (run-hooks 'gnus-select-article-hook)
7641       (gnus-summary-recenter)
7642       (gnus-summary-goto-subject article)
7643       ;; Successfully display article.
7644       (gnus-summary-update-line)
7645       (gnus-article-set-window-start 
7646        (cdr (assq article gnus-newsgroup-bookmarks)))
7647       t)))
7648
7649 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
7650   "Select the current article.
7651 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
7652 non-nil, the article will be re-fetched even if it already present in
7653 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
7654 be displayed."
7655   (and (not pseudo) (gnus-summary-pseudo-article)
7656        (error "This is a pseudo-article."))
7657   (let ((article (or article (gnus-summary-article-number)))
7658         (all-headers (not (not all-headers))) ;Must be T or NIL.
7659         did) 
7660     (prog1
7661         (save-excursion
7662           (set-buffer gnus-summary-buffer)
7663           (if (or (null gnus-current-article)
7664                   (null gnus-article-current)
7665                   (null (get-buffer gnus-article-buffer))
7666                   (not (eq article (cdr gnus-article-current)))
7667                   (not (equal (car gnus-article-current) gnus-newsgroup-name))
7668                   force)
7669               ;; The requested article is different from the current article.
7670               (progn
7671                 (gnus-summary-display-article article all-headers)
7672                 (setq did article))
7673             (if all-headers (gnus-article-show-all-headers))
7674             nil))
7675       (if did 
7676           (gnus-article-set-window-start 
7677            (cdr (assq article gnus-newsgroup-bookmarks)))))))
7678
7679 (defun gnus-summary-set-current-mark (&optional current-mark)
7680   "Obsolete function."
7681   nil)
7682
7683 (defun gnus-summary-next-article (unread &optional subject backward)
7684   "Select the next article.
7685 If UNREAD, only unread articles are selected.
7686 If SUBJECT, only articles with SUBJECT are selected.
7687 If BACKWARD, the previous article is selected instead of the next."
7688   (interactive "P")
7689   (gnus-set-global-variables)
7690   (let (header)
7691     (cond
7692      ;; Is there such an article?
7693      ((gnus-summary-display-article 
7694        (gnus-summary-search-forward unread subject backward))
7695       (gnus-summary-position-cursor))
7696      ;; If not, we try the first unread, if that is wanted.
7697      ((and subject
7698            gnus-auto-select-same
7699            (gnus-summary-first-unread-article))
7700       (gnus-message 6 "Wrapped"))
7701      ;; Try to get next/previous article not displayed in this group.
7702      ((and gnus-auto-extend-newsgroup
7703            (not unread) (not subject)
7704            (setq header (gnus-more-header-forward backward)))
7705       (gnus-extend-newsgroup header backward)
7706       (let ((buffer-read-only nil))
7707         (goto-char (if backward (point-min) (point-max)))
7708         (gnus-summary-prepare-threads (list header) 0))
7709       (gnus-summary-goto-article (if backward gnus-newsgroup-begin
7710                                    gnus-newsgroup-end)))
7711      ;; Go to next/previous group.
7712      (t
7713       (or (assoc 'quit-config (gnus-find-method-for-group gnus-newsgroup-name))
7714           (gnus-summary-jump-to-group gnus-newsgroup-name))
7715       (let ((cmd (aref (this-command-keys) 0))
7716             (group 
7717              (if (eq gnus-keep-same-level 'best) 
7718                  (gnus-summary-best-group gnus-newsgroup-name)
7719                (gnus-summary-search-group backward gnus-keep-same-level))))
7720         ;; For some reason, the group window gets selected. We change
7721         ;; it back.  
7722         (select-window (get-buffer-window (current-buffer)))
7723         ;; Keep just the event type of CMD.
7724         (and (listp cmd) (setq cmd (car cmd)))
7725         ;; Select next unread newsgroup automagically.
7726         (cond 
7727          ((not gnus-auto-select-next)
7728           (gnus-message 7 "No more%s articles" (if unread " unread" "")))
7729          ((eq gnus-auto-select-next 'quietly)
7730           ;; Select quietly.
7731           (if (assoc 'quit-config (gnus-find-method-for-group 
7732                                    gnus-newsgroup-name))
7733               (gnus-summary-exit)
7734             (gnus-message 7 "No more%s articles (%s)..."
7735                           (if unread " unread" "") 
7736                           (if group (concat "selecting " group)
7737                             "exiting"))
7738             (gnus-summary-next-group nil group backward)))
7739          (t
7740           (let ((keystrokes '(?\C-n ?\C-p))
7741                 key)
7742             (while (or (null key) (memq key keystrokes))
7743               (gnus-message 
7744                7 "No more%s articles%s" (if unread " unread" "")
7745                (if (and group (not (assoc 'quit-config
7746                                           (gnus-find-method-for-group 
7747                                            gnus-newsgroup-name))))
7748                    (format " (Type %s for %s [%s])"
7749                            (single-key-description cmd) group
7750                            (car (gnus-gethash group gnus-newsrc-hashtb)))
7751                  (format " (Type %s to exit %s)"
7752                          (single-key-description cmd)
7753                          gnus-newsgroup-name)))
7754               ;; Confirm auto selection.
7755               (let* ((event (read-event)))
7756                 (setq key (if (listp event) (car event) event))
7757                 (if (memq key keystrokes)
7758                     (let ((obuf (current-buffer)))
7759                       (switch-to-buffer gnus-group-buffer)
7760                       (gnus-group-jump-to-group group)
7761                       (execute-kbd-macro (char-to-string key))
7762                       (setq group (gnus-group-group-name))
7763                       (switch-to-buffer obuf)))))
7764             (if (equal key cmd)
7765                 (if (or (not group) (assoc 'quit-config
7766                                            (gnus-find-method-for-group
7767                                             gnus-newsgroup-name)))
7768                     (gnus-summary-exit)
7769                   (gnus-summary-next-group nil group backward))
7770               (setq unread-command-events (list key)))))))))))
7771
7772 (defun gnus-summary-next-unread-article ()
7773   "Select unread article after current one."
7774   (interactive)
7775   (gnus-summary-next-article t (and gnus-auto-select-same
7776                                     (gnus-summary-subject-string))))
7777
7778 (defun gnus-summary-prev-article (unread &optional subject)
7779   "Select the article after the current one.
7780 If UNREAD is non-nil, only unread articles are selected."
7781   (interactive "P")
7782   (gnus-summary-next-article unread subject t))
7783
7784 (defun gnus-summary-prev-unread-article ()
7785   "Select unred article before current one."
7786   (interactive)
7787   (gnus-summary-prev-article t (and gnus-auto-select-same
7788                                     (gnus-summary-subject-string))))
7789
7790 (defun gnus-summary-next-page (lines &optional circular)
7791   "Show next page of selected article.
7792 If end of article, select next article.
7793 Argument LINES specifies lines to be scrolled up.
7794 If CIRCULAR is non-nil, go to the start of the article instead of 
7795 instead of selecting the next article when reaching the end of the
7796 current article." 
7797   (interactive "P")
7798   (setq gnus-summary-buffer (current-buffer))
7799   (gnus-set-global-variables)
7800   (let ((article (gnus-summary-article-number))
7801         (endp nil))
7802     (gnus-configure-windows 'article)
7803     (if (or (null gnus-current-article)
7804             (null gnus-article-current)
7805             (/= article (cdr gnus-article-current))
7806             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7807         ;; Selected subject is different from current article's.
7808         (gnus-summary-display-article article)
7809       (gnus-eval-in-buffer-window
7810        gnus-article-buffer
7811        (setq endp (gnus-article-next-page lines)))
7812       (if endp
7813           (cond (circular
7814                  (gnus-summary-beginning-of-article))
7815                 (lines
7816                  (gnus-message 3 "End of message"))
7817                 ((null lines)
7818                  (gnus-summary-next-unread-article)))))
7819     (gnus-summary-recenter)
7820     (gnus-summary-position-cursor)))
7821
7822 (defun gnus-summary-prev-page (lines)
7823   "Show previous page of selected article.
7824 Argument LINES specifies lines to be scrolled down."
7825   (interactive "P")
7826   (gnus-set-global-variables)
7827   (let ((article (gnus-summary-article-number)))
7828     (gnus-configure-windows 'article)
7829     (if (or (null gnus-current-article)
7830             (null gnus-article-current)
7831             (/= article (cdr gnus-article-current))
7832             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
7833         ;; Selected subject is different from current article's.
7834         (gnus-summary-display-article article)
7835       (gnus-summary-recenter)
7836       (gnus-eval-in-buffer-window gnus-article-buffer
7837         (gnus-article-prev-page lines))))
7838   (gnus-summary-position-cursor))
7839
7840 (defun gnus-summary-scroll-up (lines)
7841   "Scroll up (or down) one line current article.
7842 Argument LINES specifies lines to be scrolled up (or down if negative)."
7843   (interactive "p")
7844   (gnus-set-global-variables)
7845   (gnus-configure-windows 'article)
7846   (or (gnus-summary-select-article nil nil 'pseudo)
7847       (gnus-eval-in-buffer-window 
7848        gnus-article-buffer
7849        (cond ((> lines 0)
7850               (if (gnus-article-next-page lines)
7851                   (gnus-message 3 "End of message")))
7852              ((< lines 0)
7853               (gnus-article-prev-page (- lines))))))
7854   (gnus-summary-recenter)
7855   (gnus-summary-position-cursor))
7856
7857 (defun gnus-summary-next-same-subject ()
7858   "Select next article which has the same subject as current one."
7859   (interactive)
7860   (gnus-set-global-variables)
7861   (gnus-summary-next-article nil (gnus-summary-subject-string)))
7862
7863 (defun gnus-summary-prev-same-subject ()
7864   "Select previous article which has the same subject as current one."
7865   (interactive)
7866   (gnus-set-global-variables)
7867   (gnus-summary-prev-article nil (gnus-summary-subject-string)))
7868
7869 (defun gnus-summary-next-unread-same-subject ()
7870   "Select next unread article which has the same subject as current one."
7871   (interactive)
7872   (gnus-set-global-variables)
7873   (gnus-summary-next-article t (gnus-summary-subject-string)))
7874
7875 (defun gnus-summary-prev-unread-same-subject ()
7876   "Select previous unread article which has the same subject as current one."
7877   (interactive)
7878   (gnus-set-global-variables)
7879   (gnus-summary-prev-article t (gnus-summary-subject-string)))
7880
7881 (defun gnus-summary-first-unread-article ()
7882   "Select the first unread article. 
7883 Return nil if there are no unread articles."
7884   (interactive)
7885   (gnus-set-global-variables)
7886   (prog1
7887       (if (gnus-summary-first-subject t)
7888           (gnus-summary-display-article (gnus-summary-article-number)))
7889     (gnus-summary-position-cursor)))
7890
7891 (defun gnus-summary-best-unread-article ()
7892   "Select the unread article with the highest score."
7893   (interactive)
7894   (gnus-set-global-variables)
7895   (let ((scored gnus-newsgroup-scored)
7896         (best -1000000)
7897         article art)
7898     (while scored
7899       (or (> best (cdr (car scored)))
7900           (and (memq (setq art (car (car scored))) gnus-newsgroup-unreads)
7901                (not (memq art gnus-newsgroup-marked))
7902                (not (memq art gnus-newsgroup-dormant))
7903                (if (= best (cdr (car scored)))
7904                    (setq article (min art article))
7905                  (setq article art)
7906                  (setq best (cdr (car scored))))))
7907       (setq scored (cdr scored)))
7908     (if article 
7909         (gnus-summary-goto-article article)
7910       (gnus-summary-first-unread-article))
7911     (gnus-summary-position-cursor)))
7912
7913 (defun gnus-summary-goto-article (article &optional all-headers)
7914   "Fetch ARTICLE and display it if it exists.
7915 If ALL-HEADERS is non-nil, no header lines are hidden."
7916   (interactive
7917    (list
7918     (string-to-int
7919      (completing-read 
7920       "Article number: "
7921       (mapcar (lambda (headers) (list (int-to-string (header-number headers))))
7922               gnus-newsgroup-headers) 
7923       nil 'require-match))))
7924   (prog1
7925       (and (gnus-summary-goto-subject article)
7926            (gnus-summary-display-article article all-headers))
7927     (gnus-summary-position-cursor)))
7928
7929 (defun gnus-summary-goto-last-article ()
7930   "Go to the previously read article."
7931   (interactive)
7932   (prog1
7933       (and gnus-last-article
7934            (gnus-summary-goto-article gnus-last-article))
7935     (gnus-summary-position-cursor)))
7936
7937 (defun gnus-summary-pop-article (number)
7938   "Pop one article off the history and go to the previous.
7939 NUMBER articles will be popped off."
7940   (interactive "p")
7941   (let (to)
7942     (setq gnus-newsgroup-history
7943           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
7944     (if to
7945         (gnus-summary-goto-article (car to))
7946       (error "Article history empty")))
7947   (gnus-summary-position-cursor))
7948
7949 ;; Summary article oriented commands
7950
7951 (defun gnus-summary-refer-parent-article (n)
7952   "Refer parent article N times.
7953 The difference between N and the number of articles fetched is returned."
7954   (interactive "p")
7955   (gnus-set-global-variables)
7956   (while 
7957       (and 
7958        (> n 0)
7959        (let ((ref (header-references (gnus-get-header-by-number
7960                                       (gnus-summary-article-number)))))
7961          (if (and ref (not (equal ref ""))
7962                   (string-match "<[^<>]*>[ \t]*$" ref))
7963              (gnus-summary-refer-article 
7964               (substring ref (match-beginning 0) (match-end 0)))
7965            (gnus-message 1 "No references in article %d"
7966                          (gnus-summary-article-number))
7967            nil)))
7968     (setq n (1- n)))
7969   (gnus-summary-position-cursor)
7970   n)
7971     
7972 (defun gnus-summary-refer-article (message-id)
7973   "Refer article specified by MESSAGE-ID.
7974 NOTE: This command only works with newsgroups that use real or simulated NNTP."
7975   (interactive "sMessage-ID: ")
7976   (if (or (not (stringp message-id))
7977           (zerop (length message-id)))
7978       ()
7979     ;; Construct the correct Message-ID if necessary.
7980     ;; Suggested by tale@pawl.rpi.edu.
7981     (or (string-match "^<" message-id)
7982         (setq message-id (concat "<" message-id)))
7983     (or (string-match ">$" message-id)
7984         (setq message-id (concat message-id ">")))
7985     (let ((header (car (gnus-gethash (downcase message-id)
7986                                      gnus-newsgroup-dependencies))))
7987       (if header
7988           (or (gnus-summary-goto-article (header-number header))
7989               ;; The header has been read, but the article had been
7990               ;; expunged, so we insert it again.
7991               (progn
7992                 (gnus-summary-insert-line
7993                  nil header 0 nil gnus-read-mark nil nil
7994                  (header-subject header))
7995                 (forward-line -1)
7996                 (header-number header)))
7997         (let ((gnus-override-method gnus-refer-article-method)
7998               (gnus-ancient-mark gnus-read-mark)
7999               (tmp-buf (get-buffer-create " *gnus refer"))
8000               (tmp-point (window-start
8001                           (get-buffer-window gnus-article-buffer)))
8002               number)
8003           (and gnus-refer-article-method
8004                (or (gnus-server-opened gnus-refer-article-method)
8005                    (gnus-open-server gnus-refer-article-method)))
8006           ;; Save the old article buffer.
8007           (save-excursion
8008             (set-buffer tmp-buf)
8009             (buffer-disable-undo (current-buffer))
8010             (insert-buffer-substring gnus-article-buffer))
8011           (prog1
8012               (if (gnus-article-prepare 
8013                    message-id nil (gnus-read-header message-id))
8014                   (progn
8015                     (setq number (header-number gnus-current-headers))
8016                     (gnus-rebuild-thread message-id)
8017                     (gnus-summary-goto-subject number)
8018                     (gnus-summary-recenter)
8019                     (gnus-article-set-window-start 
8020                      (cdr (assq number gnus-newsgroup-bookmarks)))
8021                     message-id)
8022                 ;; We restore the old article buffer.
8023                 (save-excursion
8024                   (set-buffer gnus-article-buffer)
8025                   (let ((buffer-read-only nil))
8026                     (insert-buffer-substring tmp-buf)
8027                     (and tmp-point
8028                          (set-window-start (get-buffer-window (current-buffer))
8029                                            tmp-point))))
8030                 nil)
8031             (kill-buffer tmp-buf)))))))
8032
8033 (defun gnus-summary-enter-digest-group ()
8034   "Enter a digest group based on the current article."
8035   (interactive)
8036   (gnus-set-global-variables)
8037   (gnus-summary-select-article)
8038   ;; We do not want a narrowed article.
8039   (gnus-summary-stop-page-breaking)
8040   (let ((name (format "%s-%d" 
8041                       (gnus-group-prefixed-name 
8042                        gnus-newsgroup-name (list 'nndoc "")) 
8043                       gnus-current-article))
8044         (ogroup gnus-newsgroup-name)
8045         (buf (current-buffer)))
8046     (if (gnus-group-read-ephemeral-group 
8047          name (list 'nndoc name
8048                     (list 'nndoc-address (get-buffer gnus-article-buffer))
8049                     '(nndoc-article-type digest))
8050          t)
8051         (setcdr (nthcdr 4 (nth 2 (gnus-gethash name gnus-newsrc-hashtb)))
8052                 (list (list (cons 'to-group ogroup))))
8053       (switch-to-buffer buf)
8054       (gnus-set-global-variables)
8055       (gnus-configure-windows 'summary)
8056       (gnus-message 3 "Article not a digest?"))))
8057
8058 (defun gnus-summary-isearch-article ()
8059   "Do incremental search forward on current article."
8060   (interactive)
8061   (gnus-set-global-variables)
8062   (gnus-summary-select-article)
8063   (gnus-eval-in-buffer-window 
8064    gnus-article-buffer (isearch-forward)))
8065
8066 (defun gnus-summary-search-article-forward (regexp &optional backward)
8067   "Search for an article containing REGEXP forward.
8068 If BACKWARD, search backward instead."
8069   (interactive
8070    (list (read-string
8071           (format "Search article %s (regexp%s): "
8072                   (if current-prefix-arg "backward" "forward")
8073                   (if gnus-last-search-regexp
8074                       (concat ", default " gnus-last-search-regexp)
8075                     "")))
8076          current-prefix-arg))
8077   (gnus-set-global-variables)
8078   (if (string-equal regexp "")
8079       (setq regexp (or gnus-last-search-regexp ""))
8080     (setq gnus-last-search-regexp regexp))
8081   (if (gnus-summary-search-article regexp backward)
8082       (gnus-article-set-window-start 
8083        (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
8084     (error "Search failed: \"%s\"" regexp)))
8085
8086 (defun gnus-summary-search-article-backward (regexp)
8087   "Search for an article containing REGEXP backward."
8088   (interactive
8089    (list (read-string
8090           (format "Search article backward (regexp%s): "
8091                   (if gnus-last-search-regexp
8092                       (concat ", default " gnus-last-search-regexp)
8093                     "")))))
8094   (gnus-summary-search-article-forward regexp 'backward))
8095
8096 (defun gnus-summary-search-article (regexp &optional backward)
8097   "Search for an article containing REGEXP.
8098 Optional argument BACKWARD means do search for backward.
8099 gnus-select-article-hook is not called during the search."
8100   (let ((gnus-select-article-hook nil)  ;Disable hook.
8101         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
8102         (re-search
8103          (if backward
8104              (function re-search-backward) (function re-search-forward)))
8105         (found nil)
8106         (last nil))
8107     ;; Hidden thread subtrees must be searched for ,too.
8108     (gnus-summary-show-all-threads)
8109     (if (eobp) (forward-line -1))
8110     ;; First of all, search current article.
8111     ;; We don't want to read article again from NNTP server nor reset
8112     ;; current point.
8113     (gnus-summary-select-article)
8114     (gnus-message 9 "Searching article: %d..." gnus-current-article)
8115     (setq last gnus-current-article)
8116     (gnus-eval-in-buffer-window gnus-article-buffer
8117       (save-restriction
8118         (widen)
8119         ;; Begin search from current point.
8120         (setq found (funcall re-search regexp nil t))))
8121     ;; Then search next articles.
8122     (while (and (not found)
8123                 (gnus-summary-display-article 
8124                  (gnus-summary-search-subject backward nil nil)))
8125       (gnus-message 9 "Searching article: %d..." gnus-current-article)
8126       (gnus-eval-in-buffer-window gnus-article-buffer
8127         (save-restriction
8128           (widen)
8129           (goto-char (if backward (point-max) (point-min)))
8130           (setq found (funcall re-search regexp nil t)))))
8131     (message "")
8132     ;; Adjust article pointer.
8133     (or (eq last gnus-current-article)
8134         (setq gnus-last-article last))
8135     ;; Return T if found such article.
8136     found))
8137
8138 (defun gnus-summary-execute-command (header regexp command &optional backward)
8139   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
8140 If HEADER is an empty string (or nil), the match is done on the entire
8141 article. If BACKWARD (the prefix) is non-nil, search backward instead."
8142   (interactive
8143    (list (let ((completion-ignore-case t))
8144            (completing-read 
8145             "Header name: "
8146             (mapcar (lambda (string) (list string))
8147                     '("Number" "Subject" "From" "Lines" "Date"
8148                       "Message-ID" "Xref" "References"))
8149             nil 'require-match))
8150          (read-string "Regexp: ")
8151          (read-key-sequence "Command: ")
8152          current-prefix-arg))
8153   (gnus-set-global-variables)
8154   ;; Hidden thread subtrees must be searched as well.
8155   (gnus-summary-show-all-threads)
8156   ;; We don't want to change current point nor window configuration.
8157   (save-excursion
8158     (save-window-excursion
8159       (gnus-message 6 "Executing %s..." (key-description command))
8160       ;; We'd like to execute COMMAND interactively so as to give arguments.
8161       (gnus-execute header regexp
8162                     (` (lambda ()
8163                          (call-interactively '(, (key-binding command)))))
8164                     backward)
8165       (gnus-message 6 "Executing %s...done" (key-description command)))))
8166
8167 (defun gnus-summary-beginning-of-article ()
8168   "Scroll the article back to the beginning."
8169   (interactive)
8170   (gnus-set-global-variables)
8171   (gnus-summary-select-article)
8172   (gnus-configure-windows 'article)
8173   (gnus-eval-in-buffer-window
8174    gnus-article-buffer
8175    (widen)
8176    (goto-char (point-min))
8177    (and gnus-break-pages (gnus-narrow-to-page))))
8178
8179 (defun gnus-summary-end-of-article ()
8180   "Scroll to the end of the article."
8181   (interactive)
8182   (gnus-set-global-variables)
8183   (gnus-summary-select-article)
8184   (gnus-configure-windows 'article)
8185   (gnus-eval-in-buffer-window 
8186    gnus-article-buffer
8187    (widen)
8188    (goto-char (point-max))
8189    (and gnus-break-pages (gnus-narrow-to-page))))
8190
8191 (defun gnus-summary-show-article (no-refetch)
8192   "Force re-fetching of the current article.
8193 If the prefix argument NO-REFETCH is non-nil, no actual refetch will
8194 be performed.  The current article will simply be redisplayed."
8195   (interactive "P")
8196   (gnus-set-global-variables)
8197   (if (not no-refetch)
8198       (gnus-summary-select-article gnus-have-all-headers t)
8199     (or gnus-current-article
8200         (error "There is no current article"))
8201     (gnus-summary-goto-subject gnus-current-article)
8202     (gnus-configure-windows 'article)
8203     (gnus-summary-position-cursor)))
8204
8205 (defun gnus-summary-verbose-headers (arg)
8206   "Toggle permanent full header display.
8207 If ARG is a positive number, turn header display on.
8208 If ARG is a negative number, turn header display off."
8209   (interactive "P")
8210   (gnus-set-global-variables)
8211   (gnus-summary-toggle-header arg)
8212   (setq gnus-have-all-headers
8213         (cond ((or (not (numberp arg))
8214                    (zerop arg))
8215                (not gnus-have-all-headers))
8216               ((natnump arg)
8217                t))))
8218
8219 (defun gnus-summary-toggle-header (arg)
8220   "Show the headers if they are hidden, or hide them if they are shown.
8221 If ARG is a positive number, show the entire header.
8222 If ARG is a negative number, hide the unwanted header lines."
8223   (interactive "P")
8224   (gnus-set-global-variables)
8225   (save-excursion
8226     (set-buffer gnus-article-buffer)
8227     (let ((buffer-read-only nil))
8228       (if (numberp arg) 
8229           (if (> arg 0) (remove-text-properties (point-min) (point-max) 
8230                                                 gnus-hidden-properties)
8231             (if (< arg 0) (run-hooks 'gnus-article-display-hook)))
8232         (if (text-property-any (point-min) (point-max) 'invisible t)
8233             (remove-text-properties (point-min) (point-max)
8234                                     gnus-hidden-properties)
8235           (let ((gnus-have-all-headers nil))
8236             (run-hooks 'gnus-article-display-hook))))
8237       (set-window-point (get-buffer-window (current-buffer)) (point-min)))))
8238
8239 (defun gnus-summary-show-all-headers ()
8240   "Make all header lines visible."
8241   (interactive)
8242   (gnus-set-global-variables)
8243   (gnus-article-show-all-headers))
8244
8245 (defun gnus-summary-toggle-mime (arg)
8246   "Toggle MIME processing.
8247 If ARG is a positive number, turn MIME processing on."
8248   (interactive "P")
8249   (gnus-set-global-variables)
8250   (setq gnus-show-mime
8251         (if (null arg) (not gnus-show-mime)
8252           (> (prefix-numeric-value arg) 0)))
8253   (gnus-summary-select-article t 'force))
8254
8255 (defun gnus-summary-caesar-message (arg)
8256   "Caesar rotate the current article by 13.
8257 The numerical prefix specifies how manu places to rotate each letter
8258 forward."
8259   (interactive "P")
8260   (gnus-set-global-variables)
8261   (gnus-summary-select-article)
8262   (let ((mail-header-separator ""))
8263     (gnus-eval-in-buffer-window 
8264      gnus-article-buffer
8265      (save-restriction
8266        (widen)
8267        (let ((last (point)))
8268          (news-caesar-buffer-body arg)
8269          (goto-char last)
8270          (recenter 0))))))
8271
8272 (defun gnus-summary-stop-page-breaking ()
8273   "Stop page breaking in the current article."
8274   (interactive)
8275   (gnus-set-global-variables)
8276   (gnus-summary-select-article)
8277   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
8278
8279 ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
8280
8281 (defun gnus-summary-move-article (n &optional to-newsgroup select-method)
8282   "Move the current article to a different newsgroup.
8283 If N is a positive number, move the N next articles.
8284 If N is a negative number, move the N previous articles.
8285 If N is nil and any articles have been marked with the process mark,
8286 move those articles instead.
8287 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
8288 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
8289 re-spool using this method.
8290 For this function to work, both the current newsgroup and the
8291 newsgroup that you want to move to have to support the `request-move'
8292 and `request-accept' functions. (Ie. mail newsgroups at present.)"
8293   (interactive "P")
8294   (gnus-set-global-variables)
8295   (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)
8296       (error "The current newsgroup does not support article moving"))
8297   (let ((articles (gnus-summary-work-articles n))
8298         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
8299         art-group to-method sel-met)
8300     (if (and (not to-newsgroup) (not select-method))
8301         (setq to-newsgroup
8302               (completing-read 
8303                (format "Where do you want to move %s? %s"
8304                        (if (> (length articles) 1)
8305                            (format "these %d articles" (length articles))
8306                          "this article")
8307                        (if gnus-current-move-group
8308                            (format "(%s default) " gnus-current-move-group)
8309                          ""))
8310                gnus-active-hashtb nil nil prefix)))
8311     (if to-newsgroup
8312         (progn
8313           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
8314               (setq to-newsgroup (or gnus-current-move-group "")))
8315           (or (gnus-gethash to-newsgroup gnus-active-hashtb)
8316               (gnus-activate-newsgroup to-newsgroup)
8317               (error "No such group: %s" to-newsgroup))
8318           (setq gnus-current-move-group to-newsgroup)))
8319     (setq to-method (if select-method (list select-method "")
8320                       (gnus-find-method-for-group to-newsgroup)))
8321     (or (gnus-check-backend-function 'request-accept-article (car to-method))
8322         (error "%s does not support article copying" (car to-method)))
8323     (or (gnus-server-opened to-method)
8324         (gnus-open-server to-method)
8325         (error "Can't open server %s" (car to-method)))
8326     (gnus-message 6 "Moving to %s: %s..." 
8327                   (or select-method to-newsgroup) articles)
8328     (while articles
8329       (if (setq art-group
8330                 (gnus-request-move-article 
8331                  (car articles)                   ; Article to move
8332                  gnus-newsgroup-name              ; From newsgrouo
8333                  (nth 1 (gnus-find-method-for-group 
8334                          gnus-newsgroup-name))    ; Server
8335                  (list 'gnus-request-accept-article 
8336                        (if select-method
8337                            (list 'quote select-method)
8338                          to-newsgroup)
8339                        (not (cdr articles)))     ; Accept form
8340                  (not (cdr articles))))          ; Only save nov last time
8341           (let* ((buffer-read-only nil)
8342                  (entry 
8343                   (or
8344                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
8345                    (gnus-gethash 
8346                     (gnus-group-prefixed-name 
8347                      (car art-group) 
8348                      (if select-method (list select-method "")
8349                        (gnus-find-method-for-group to-newsgroup)))
8350                     gnus-newsrc-hashtb)))
8351                  (info (nth 2 entry))
8352                  (article (car articles)))
8353             (gnus-summary-goto-subject article)
8354             (beginning-of-line)
8355             (delete-region (point)
8356                            (progn (forward-line 1) (point)))
8357             (if (not (memq article gnus-newsgroup-unreads))
8358                 (setcar (cdr (cdr info))
8359                         (gnus-add-to-range (nth 2 info) 
8360                                            (list (cdr art-group)))))
8361             ;; Copy any marks over to the new group.
8362             (let ((marks '((tick . gnus-newsgroup-marked)
8363                            (dormant . gnus-newsgroup-dormant)
8364                            (expire . gnus-newsgroup-expirable)
8365                            (bookmark . gnus-newsgroup-bookmarks)
8366                         ;   (score . gnus-newsgroup-scored)
8367                            (reply . gnus-newsgroup-replied)))
8368                   (to-article (cdr art-group)))
8369               (while marks
8370                 (if (memq article (symbol-value (cdr (car marks))))
8371                     (gnus-add-marked-articles 
8372                      (car info) (car (car marks)) (list to-article) info))
8373                 (setq marks (cdr marks))))
8374             (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
8375             (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
8376             (setq gnus-newsgroup-dormant
8377                   (delq article gnus-newsgroup-dormant)))
8378         (gnus-message 1 "Couldn't move article %s" (car articles)))
8379       (gnus-summary-remove-process-mark (car articles))
8380       (setq articles (cdr articles)))))
8381
8382 (defun gnus-summary-respool-article (n &optional respool-method)
8383   "Respool the current article.
8384 The article will be squeezed through the mail spooling process again,
8385 which means that it will be put in some mail newsgroup or other
8386 depending on `nnmail-split-methods'.
8387 If N is a positive number, respool the N next articles.
8388 If N is a negative number, respool the N previous articles.
8389 If N is nil and any articles have been marked with the process mark,
8390 respool those articles instead.
8391
8392 Respooling can be done both from mail groups and \"real\" newsgroups.
8393 In the former case, the articles in question will be moved from the
8394 current group into whatever groups they are destined to.  In the
8395 latter case, they will be copied into the relevant groups."
8396   (interactive "P")
8397   (gnus-set-global-variables)
8398   (let ((respool-methods (gnus-methods-using 'respool))
8399         (methname 
8400          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
8401     (or respool-method
8402         (setq respool-method
8403               (completing-read
8404                "What method do you want to use when respooling? "
8405                respool-methods nil t methname)))
8406     (or (string= respool-method "")
8407         (if (assoc (symbol-name
8408                     (car (gnus-find-method-for-group gnus-newsgroup-name)))
8409                    respool-methods)
8410             (gnus-summary-move-article n nil (intern respool-method))
8411           (gnus-summary-copy-article n nil (intern respool-method))))))
8412
8413 ;; Suggested by gregj@unidata.com (Gregory J. Grubbs).
8414 (defun gnus-summary-copy-article (n &optional to-newsgroup select-method)
8415   "Move the current article to a different newsgroup.
8416 If N is a positive number, move the N next articles.
8417 If N is a negative number, move the N previous articles.
8418 If N is nil and any articles have been marked with the process mark,
8419 move those articles instead.
8420 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
8421 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
8422 re-spool using this method.
8423 For this function to work, the newsgroup that you want to move to have
8424 to support the `request-move' and `request-accept'
8425 functions. (Ie. mail newsgroups at present.)"
8426   (interactive "P")
8427   (gnus-set-global-variables)
8428   (let ((articles (gnus-summary-work-articles n))
8429         (copy-buf (get-buffer-create "*copy work*"))
8430         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
8431         art-group to-method)
8432     (buffer-disable-undo copy-buf)
8433     (if (and (not to-newsgroup) (not select-method))
8434         (setq to-newsgroup
8435               (completing-read 
8436                (format "Where do you want to copy %s? %s"
8437                        (if (> (length articles) 1)
8438                            (format "these %d articles" (length articles))
8439                          "this article")
8440                        (if gnus-current-move-group
8441                            (format "(%s default) " gnus-current-move-group)
8442                          ""))
8443                gnus-active-hashtb nil nil prefix)))
8444     (if to-newsgroup
8445         (progn
8446           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
8447               (setq to-newsgroup (or gnus-current-move-group "")))
8448           (or (gnus-gethash to-newsgroup gnus-active-hashtb)
8449               (gnus-activate-newsgroup to-newsgroup)
8450               (error "No such group: %s" to-newsgroup))
8451           (setq gnus-current-move-group to-newsgroup)))
8452     (setq to-method (if select-method (list select-method "")
8453                       (gnus-find-method-for-group to-newsgroup)))
8454     (or (gnus-check-backend-function 'request-accept-article (car to-method))
8455         (error "%s does not support article copying" (car to-method)))
8456     (or (gnus-server-opened to-method)
8457         (gnus-open-server to-method)
8458         (error "Can't open server %s" (car to-method)))
8459     (gnus-message 6 "Copying to %s: %s..." 
8460                   (or select-method to-newsgroup) articles)
8461     (while articles
8462       (if (setq art-group
8463                 (save-excursion
8464                   (set-buffer copy-buf)
8465                   (gnus-request-article-this-buffer
8466                    (car articles) gnus-newsgroup-name)
8467                   (gnus-request-accept-article
8468                    (if select-method (quote select-method) to-newsgroup)
8469                    (not (cdr articles)))))
8470           (let* ((entry 
8471                   (or
8472                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
8473                    (gnus-gethash 
8474                     (gnus-group-prefixed-name 
8475                      (car art-group) 
8476                      (if select-method (list select-method "")
8477                        (gnus-find-method-for-group to-newsgroup)))
8478                     gnus-newsrc-hashtb)))
8479                  (info (nth 2 entry))
8480                  (article (car articles)))
8481             (if (not (memq article gnus-newsgroup-unreads))
8482                 (setcar (cdr (cdr info))
8483                         (gnus-add-to-range (nth 2 info) 
8484                                            (list (cdr art-group)))))
8485             ;; Copy any marks over to the new group.
8486             (let ((marks '((tick . gnus-newsgroup-marked)
8487                            (dormant . gnus-newsgroup-dormant)
8488                            (expire . gnus-newsgroup-expirable)
8489                            (bookmark . gnus-newsgroup-bookmarks)
8490                         ;   (score . gnus-newsgroup-scored)
8491                            (reply . gnus-newsgroup-replied)))
8492                   (to-article (cdr art-group)))
8493               (while marks
8494                 (if (memq article (symbol-value (cdr (car marks))))
8495                     (gnus-add-marked-articles 
8496                      (car info) (car (car marks)) (list to-article) info))
8497                 (setq marks (cdr marks)))))
8498         (gnus-message 1 "Couldn't copy article %s" (car articles)))
8499       (gnus-summary-remove-process-mark (car articles))
8500       (setq articles (cdr articles)))
8501     (kill-buffer copy-buf)))
8502
8503 (defun gnus-summary-import-article (file)
8504   "Import a random file into a mail newsgroup."
8505   (interactive "fImport file: ")
8506   (let ((group gnus-newsgroup-name)
8507         atts)
8508     (or (gnus-check-backend-function 'request-accept-article group)
8509         (error "%s does not support article importing" group))
8510     (or (file-readable-p file)
8511         (not (file-regular-p file))
8512         (error "Can't read %s" file))
8513     (save-excursion
8514       (set-buffer (get-buffer-create " *import file*"))
8515       (buffer-disable-undo (current-buffer))
8516       (erase-buffer)
8517       (insert-file-contents file)
8518       (goto-char (point-min))
8519       (if (nnheader-article-p)
8520           ()
8521         (setq atts (file-attributes file))
8522         (insert "From: " (read-string "From: ") "\n"
8523                 "Subject: " (read-string "Subject: ") "\n"
8524                 "Date: " (current-time-string (nth 5 atts)) "\n"
8525                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
8526       (gnus-request-accept-article group t)
8527       (kill-buffer (current-buffer)))))
8528
8529 (defun gnus-summary-expire-articles ()
8530   "Expire all articles that are marked as expirable in the current group."
8531   (interactive)
8532   (if (and gnus-newsgroup-expirable
8533            (gnus-check-backend-function 
8534             'request-expire-articles gnus-newsgroup-name))
8535       (let ((expirable gnus-newsgroup-expirable))
8536         ;; The list of articles that weren't expired is returned.
8537         (setq gnus-newsgroup-expirable 
8538               (gnus-request-expire-articles gnus-newsgroup-expirable
8539                                             gnus-newsgroup-name))
8540         ;; We go through the old list of expirable, and mark all
8541         ;; really expired articles as non-existent.
8542         (while expirable
8543           (or (memq (car expirable) gnus-newsgroup-expirable)
8544               (gnus-summary-mark-as-read (car expirable) gnus-canceled-mark))
8545           (setq expirable (cdr expirable))))))
8546
8547 (defun gnus-summary-expire-articles-now ()
8548   "Expunge all expirable articles in the current group.
8549 This means that *all* articles that are marked as expirable will be
8550 deleted forever, right now."
8551   (interactive)
8552   (or gnus-expert-user
8553       (gnus-y-or-n-p
8554        "Are you really, really, really sure you want to expunge? ")
8555       (error "Phew!"))
8556   (let ((nnmail-expiry-wait -1)
8557         (nnmail-expiry-wait-function nil))
8558     (gnus-summary-expire-articles)))
8559
8560 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
8561 (defun gnus-summary-delete-article (n)
8562   "Delete the N next (mail) articles.
8563 This command actually deletes articles. This is not a marking
8564 command. The article will disappear forever from you life, never to
8565 return. 
8566 If N is negative, delete backwards.
8567 If N is nil and articles have been marked with the process mark,
8568 delete these instead."
8569   (interactive "P")
8570   (or (gnus-check-backend-function 'request-expire-articles 
8571                                    gnus-newsgroup-name)
8572       (error "The current newsgroup does not support article deletion."))
8573   ;; Compute the list of articles to delete.
8574   (let ((articles (gnus-summary-work-articles n))
8575         not-deleted)
8576     (if (and gnus-novice-user
8577              (not (gnus-y-or-n-p 
8578                    (format "Do you really want to delete %s forever? "
8579                            (if (> (length articles) 1) "these articles"
8580                              "this article")))))
8581         ()
8582       ;; Delete the articles.
8583       (setq not-deleted (gnus-request-expire-articles 
8584                          articles gnus-newsgroup-name 'force))
8585       (while articles
8586         (gnus-summary-remove-process-mark (car articles))       
8587         ;; The backend might not have been able to delete the article
8588         ;; after all.  
8589         (or (memq (car articles) not-deleted)
8590             (gnus-summary-mark-as-read (car articles) gnus-canceled-mark))
8591         (setq articles (cdr articles))))
8592     (gnus-summary-position-cursor)
8593     not-deleted))
8594
8595 (defun gnus-summary-edit-article ()
8596   "Enter into a buffer and edit the current article.
8597 This will have permanent effect only in mail groups."
8598   (interactive)
8599   (or (gnus-check-backend-function 
8600        'request-replace-article gnus-newsgroup-name)
8601       (error "The current newsgroup does not support article editing."))
8602   (gnus-summary-select-article t)
8603   (gnus-configure-windows 'article)
8604   (select-window (get-buffer-window gnus-article-buffer))
8605   (gnus-message 6 "C-c C-c to end edits")
8606   (setq buffer-read-only nil)
8607   (text-mode)
8608   (use-local-map (copy-keymap (current-local-map)))
8609   (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
8610   (buffer-enable-undo)
8611   (goto-char (point-min))
8612   (search-forward "\n\n" nil t))
8613
8614 (defun gnus-summary-edit-article-done ()
8615   "Make edits to the current article permanent."
8616   (interactive)
8617   (if (not (gnus-request-replace-article 
8618             (cdr gnus-article-current) (car gnus-article-current) 
8619             (current-buffer)))
8620       (error "Couldn't replace article.")
8621     (gnus-article-mode)
8622     (use-local-map gnus-article-mode-map)
8623     (setq buffer-read-only t)
8624     (buffer-disable-undo (current-buffer))
8625     (pop-to-buffer gnus-summary-buffer)))      
8626
8627 (defun gnus-summary-fancy-query ()
8628   "Query where the fancy respool algorithm would put this article."
8629   (interactive)
8630   (gnus-summary-select-article)
8631   (save-excursion
8632     (set-buffer gnus-article-buffer)
8633     (save-restriction
8634       (goto-char (point-min))
8635       (search-forward "\n\n")
8636       (narrow-to-region (point-min) (point))
8637       (pp-eval-expression (list 'quote (nnmail-split-fancy))))))
8638
8639 ;; Summary score commands.
8640
8641 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
8642
8643 (defun gnus-summary-raise-score (n)
8644   "Raise the score of the current article by N."
8645   (interactive "p")
8646   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
8647
8648 (defun gnus-summary-lower-score (n)
8649   "Lower the score of the current article by N."
8650   (interactive "p")
8651   (gnus-summary-raise-score (- n)))
8652
8653 (defun gnus-summary-set-score (n)
8654   "Set the score of the current article to N."
8655   (interactive "p")
8656   ;; Skip dummy header line.
8657   (save-excursion
8658     (gnus-summary-show-thread)
8659     (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
8660         (forward-line 1))
8661     (let ((buffer-read-only nil))
8662       ;; Set score.
8663       (gnus-summary-update-mark
8664        (if (= n (or gnus-summary-default-score 0)) ? 
8665          (if (< n (or gnus-summary-default-score 0)) 
8666              gnus-score-below-mark gnus-score-over-mark)) 'score))
8667     (let* ((article (gnus-summary-article-number))
8668            (score (assq article gnus-newsgroup-scored)))
8669       (if score (setcdr score n)
8670         (setq gnus-newsgroup-scored 
8671               (cons (cons article n) gnus-newsgroup-scored))))
8672     (gnus-summary-update-line)))
8673
8674 (defun gnus-summary-current-score ()
8675   "Return the score of the current article."
8676   (interactive)
8677   (message "%s" (gnus-summary-article-score)))
8678
8679 ;; Summary marking commands.
8680
8681 (defun gnus-summary-raise-same-subject-and-select (score)
8682   "Raise articles which has the same subject with SCORE and select the next."
8683   (interactive "p")
8684   (let ((subject (gnus-summary-subject-string)))
8685     (gnus-summary-raise-score score)
8686     (while (gnus-summary-search-subject nil nil subject)
8687       (gnus-summary-raise-score score))
8688     (gnus-summary-next-article t)))
8689
8690 (defun gnus-summary-raise-same-subject (score)
8691   "Raise articles which has the same subject with SCORE."
8692   (interactive "p")
8693   (let ((subject (gnus-summary-subject-string)))
8694     (gnus-summary-raise-score score)
8695     (while (gnus-summary-search-subject nil nil subject)
8696       (gnus-summary-raise-score score))
8697     (gnus-summary-next-subject 1 t)))
8698
8699 (defun gnus-score-default (level)
8700   (if level (prefix-numeric-value level) 
8701     gnus-score-interactive-default-score))
8702
8703 (defun gnus-summary-raise-thread (score)
8704   "Raise the score of the articles in the current thread with SCORE."
8705   (interactive "P")
8706   (setq score (1- (gnus-score-default score)))
8707   (let (e)
8708     (save-excursion
8709       (let ((level (gnus-summary-thread-level)))
8710         (gnus-summary-raise-score score)
8711         (while (and (zerop (gnus-summary-next-subject 1 nil t))
8712                     (> (gnus-summary-thread-level) level))
8713           (gnus-summary-raise-score score))
8714         (setq e (point))))
8715     (let ((gnus-summary-check-current t))
8716       (or (zerop (gnus-summary-next-subject 1 t))
8717           (goto-char e))))
8718   (gnus-summary-recenter)
8719   (gnus-summary-position-cursor)
8720   (gnus-set-mode-line 'summary))
8721
8722 (defun gnus-summary-lower-same-subject-and-select (score)
8723   "Raise articles which has the same subject with SCORE and select the next."
8724   (interactive "p")
8725   (gnus-summary-raise-same-subject-and-select (- score)))
8726
8727 (defun gnus-summary-lower-same-subject (score)
8728   "Raise articles which has the same subject with SCORE."
8729   (interactive "p")
8730   (gnus-summary-raise-same-subject (- score)))
8731
8732 (defun gnus-summary-lower-thread (score)
8733   "Lower score of articles in the current thread with SCORE."
8734   (interactive "P")
8735   (gnus-summary-raise-thread (- (1- (gnus-score-default score)))))
8736
8737 (defun gnus-summary-kill-same-subject-and-select (unmark)
8738   "Mark articles which has the same subject as read, and then select the next.
8739 If UNMARK is positive, remove any kind of mark.
8740 If UNMARK is negative, tick articles."
8741   (interactive "P")
8742   (if unmark
8743       (setq unmark (prefix-numeric-value unmark)))
8744   (let ((count
8745          (gnus-summary-mark-same-subject
8746           (gnus-summary-subject-string) unmark)))
8747     ;; Select next unread article. If auto-select-same mode, should
8748     ;; select the first unread article.
8749     (gnus-summary-next-article t (and gnus-auto-select-same
8750                                       (gnus-summary-subject-string)))
8751     (gnus-message 7 "%d articles are marked as %s"
8752                   count (if unmark "unread" "read"))))
8753
8754 (defun gnus-summary-kill-same-subject (unmark)
8755   "Mark articles which has the same subject as read. 
8756 If UNMARK is positive, remove any kind of mark.
8757 If UNMARK is negative, tick articles."
8758   (interactive "P")
8759   (if unmark
8760       (setq unmark (prefix-numeric-value unmark)))
8761   (let ((count
8762          (gnus-summary-mark-same-subject
8763           (gnus-summary-subject-string) unmark)))
8764     ;; If marked as read, go to next unread subject.
8765     (if (null unmark)
8766         ;; Go to next unread subject.
8767         (gnus-summary-next-subject 1 t))
8768     (gnus-message 7 "%d articles are marked as %s"
8769                   count (if unmark "unread" "read"))))
8770
8771 (defun gnus-summary-mark-same-subject (subject &optional unmark)
8772   "Mark articles with same SUBJECT as read, and return marked number.
8773 If optional argument UNMARK is positive, remove any kinds of marks.
8774 If optional argument UNMARK is negative, mark articles as unread instead."
8775   (let ((count 1))
8776     (save-excursion
8777       (cond ((null unmark)
8778              (gnus-summary-mark-as-read nil gnus-killed-mark))
8779             ((> unmark 0)
8780              (gnus-summary-tick-article nil t))
8781             (t
8782              (gnus-summary-tick-article)))
8783       (while (and subject
8784                   (gnus-summary-search-forward nil subject))
8785         (cond ((null unmark)
8786                (gnus-summary-mark-as-read nil gnus-killed-mark))
8787               ((> unmark 0)
8788                (gnus-summary-tick-article nil t))
8789               (t
8790                (gnus-summary-tick-article)))
8791         (setq count (1+ count))))
8792     ;; Hide killed thread subtrees.  Does not work properly always.
8793     ;;(and (null unmark)
8794     ;;     gnus-thread-hide-killed
8795     ;;     (gnus-summary-hide-thread))
8796     ;; Return number of articles marked as read.
8797     count))
8798
8799 (defun gnus-summary-mark-as-processable (n &optional unmark)
8800   "Set the process mark on the next N articles.
8801 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
8802 the process mark instead.  The difference between N and the actual
8803 number of articles marked is returned."
8804   (interactive "p")
8805   (let ((backward (< n 0))
8806         (n (abs n)))
8807   (while (and 
8808           (> n 0)
8809           (if unmark
8810               (gnus-summary-remove-process-mark (gnus-summary-article-number))
8811             (gnus-summary-set-process-mark (gnus-summary-article-number)))
8812           (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
8813     (setq n (1- n)))
8814   (if (/= 0 n) (gnus-message 7 "No more articles"))
8815   (gnus-summary-recenter)
8816   (gnus-summary-position-cursor)
8817   n))
8818
8819 (defun gnus-summary-unmark-as-processable (n)
8820   "Remove the process mark from the next N articles.
8821 If N is negative, mark backward instead.  The difference between N and
8822 the actual number of articles marked is returned."
8823   (interactive "p")
8824   (gnus-summary-mark-as-processable n t))
8825
8826 (defun gnus-summary-unmark-all-processable ()
8827   "Remove the process mark from all articles."
8828   (interactive)
8829   (save-excursion
8830     (while gnus-newsgroup-processable
8831       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
8832   (gnus-summary-position-cursor))
8833
8834 (defun gnus-summary-mark-as-expirable (n)
8835   "Mark N articles forward as expirable.
8836 If N is negative, mark backward instead. The difference between N and
8837 the actual number of articles marked is returned."
8838   (interactive "p")
8839   (gnus-summary-mark-forward n gnus-expirable-mark))
8840
8841 (defun gnus-summary-mark-article-as-replied (article)
8842   "Mark ARTICLE replied and update the summary line."
8843   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
8844   (let ((buffer-read-only nil))
8845     (if (gnus-summary-goto-subject article)
8846         (progn
8847           (gnus-summary-update-mark gnus-replied-mark 'replied)
8848           t))))
8849
8850 (defun gnus-summary-set-bookmark (article)
8851   "Set a bookmark in current article."
8852   (interactive (list (gnus-summary-article-number)))
8853   (if (or (not (get-buffer gnus-article-buffer))
8854           (not gnus-current-article)
8855           (not gnus-article-current)
8856           (not (equal gnus-newsgroup-name (car gnus-article-current))))
8857       (error "No current article selected"))
8858   ;; Remove old bookmark, if one exists.
8859   (let ((old (assq article gnus-newsgroup-bookmarks)))
8860     (if old (setq gnus-newsgroup-bookmarks 
8861                   (delq old gnus-newsgroup-bookmarks))))
8862   ;; Set the new bookmark, which is on the form 
8863   ;; (article-number . line-number-in-body).
8864   (setq gnus-newsgroup-bookmarks 
8865         (cons 
8866          (cons article 
8867                (save-excursion
8868                  (set-buffer gnus-article-buffer)
8869                  (count-lines
8870                   (min (point)
8871                        (save-excursion
8872                          (goto-char (point-min))
8873                          (search-forward "\n\n" nil t)
8874                          (point)))
8875                   (point))))
8876          gnus-newsgroup-bookmarks))
8877   (gnus-message 6 "A bookmark has been added to the current article."))
8878
8879 (defun gnus-summary-remove-bookmark (article)
8880   "Remove the bookmark from the current article."
8881   (interactive (list (gnus-summary-article-number)))
8882   ;; Remove old bookmark, if one exists.
8883   (let ((old (assq article gnus-newsgroup-bookmarks)))
8884     (if old 
8885         (progn
8886           (setq gnus-newsgroup-bookmarks 
8887                 (delq old gnus-newsgroup-bookmarks))
8888           (gnus-message 6 "Removed bookmark."))
8889       (gnus-message 6 "No bookmark in current article."))))
8890
8891 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
8892 (defun gnus-summary-mark-as-dormant (n)
8893   "Mark N articles forward as dormant.
8894 If N is negative, mark backward instead.  The difference between N and
8895 the actual number of articles marked is returned."
8896   (interactive "p")
8897   (gnus-summary-mark-forward n gnus-dormant-mark))
8898
8899 (defun gnus-summary-set-process-mark (article)
8900   "Set the process mark on ARTICLE and update the summary line."
8901   (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable))
8902   (let ((buffer-read-only nil))
8903     (if (gnus-summary-goto-subject article)
8904         (progn
8905           (gnus-summary-show-thread)
8906           (and (eq (gnus-summary-article-mark) gnus-dummy-mark)
8907                (forward-line 1))
8908           (gnus-summary-update-mark gnus-process-mark 'replied)
8909           t))))
8910
8911 (defun gnus-summary-remove-process-mark (article)
8912   "Remove the process mark from ARTICLE and update the summary line."
8913   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
8914   (let ((buffer-read-only nil))
8915     (if (gnus-summary-goto-subject article)
8916         (progn
8917           (gnus-summary-show-thread)
8918           (and (eq (gnus-summary-article-mark) gnus-dummy-mark)
8919                (forward-line 1))
8920           (gnus-summary-update-mark ?  'replied)
8921           (if (memq article gnus-newsgroup-replied) 
8922               (gnus-summary-update-mark gnus-replied-mark 'replied))
8923           t))))
8924
8925 (defun gnus-summary-mark-forward (n &optional mark no-expire)
8926   "Mark N articles as read forwards.
8927 If N is negative, mark backwards instead.
8928 Mark with MARK. If MARK is ? , ?! or ??, articles will be
8929 marked as unread. 
8930 The difference between N and the actual number of articles marked is
8931 returned."
8932   (interactive "p")
8933   (gnus-set-global-variables)
8934   (let ((backward (< n 0))
8935         (n (abs n))
8936         (mark (or mark gnus-del-mark)))
8937   (while (and (> n 0)
8938               (gnus-summary-mark-article nil mark no-expire)
8939               (zerop (gnus-summary-next-subject 
8940                       (if backward -1 1) gnus-summary-goto-unread t)))
8941     (setq n (1- n)))
8942   (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
8943   (gnus-summary-recenter)
8944   (gnus-summary-position-cursor)
8945   (gnus-set-mode-line 'summary)
8946   n))
8947
8948 (defun gnus-summary-mark-article (&optional article mark no-expire)
8949   "Mark ARTICLE with MARK.
8950 MARK can be any character.
8951 Five MARK strings are reserved: ?  (unread), 
8952 ?! (ticked), ?? (dormant), ?D (read), ?E (expirable).
8953 If MARK is nil, then the default character ?D is used.
8954 If ARTICLE is nil, then the article on the current line will be
8955 marked." 
8956   ;; If no mark is given, then we check auto-expiring.
8957   (and (not no-expire)
8958        gnus-newsgroup-auto-expire 
8959        (or (not mark)
8960            (and (numberp mark) 
8961                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
8962                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
8963                     (= mark gnus-read-mark))))
8964        (setq mark gnus-expirable-mark))
8965   (let* ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-del-mark))
8966          (article (or article (gnus-summary-article-number))))
8967     (or article (error "No article on current line"))
8968     (if (or (= mark gnus-unread-mark) 
8969             (= mark gnus-ticked-mark) 
8970             (= mark gnus-dormant-mark))
8971         (gnus-mark-article-as-unread article mark)
8972       (gnus-mark-article-as-read article mark))
8973
8974     ;; See whether the article is to be put in the cache.
8975     (and gnus-use-cache
8976          (save-excursion
8977            (gnus-cache-possibly-enter-article 
8978             gnus-newsgroup-name article 
8979             (gnus-get-header-by-number article)
8980             (= mark gnus-ticked-mark)
8981             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
8982
8983     (if (gnus-summary-goto-subject article)
8984         (let ((buffer-read-only nil))
8985           (gnus-summary-show-thread)
8986           (and (eq (gnus-summary-article-mark) gnus-dummy-mark)
8987                (forward-line 1))
8988           ;; Fix the mark.
8989           (gnus-summary-update-mark mark 'unread)
8990           t))))
8991
8992 (defun gnus-summary-update-mark (mark type)
8993   (beginning-of-line)
8994   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
8995         plist)
8996     (if (not forward)
8997         ()
8998       (forward-char forward)
8999       (setq plist (text-properties-at (point)))
9000       (delete-char 1)
9001       (insert mark)
9002       (and plist (add-text-properties (1- (point)) (point) plist))
9003       (and (eq type 'unread)
9004            (add-text-properties (1- (point)) (point) (list 'gnus-mark mark)))
9005       (gnus-summary-update-line (eq mark gnus-unread-mark)))))
9006   
9007 (defun gnus-mark-article-as-read (article &optional mark)
9008   "Enter ARTICLE in the pertinent lists and remove it from others."
9009   ;; Make the article expirable.
9010   (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-del-mark)))
9011     (if (= mark gnus-expirable-mark)
9012         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
9013       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
9014     ;; Remove from unread and marked lists.
9015     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
9016     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
9017     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
9018     ;; Possibly remove from cache, if that is used. 
9019     (and gnus-use-cache (gnus-cache-enter-remove-article article))))
9020
9021 (defun gnus-mark-article-as-unread (article &optional mark)
9022   "Enter ARTICLE in the pertinent lists and remove it from others."
9023   (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-ticked-mark)))
9024     ;; Add to unread list.
9025     (or (memq article gnus-newsgroup-unreads)
9026         (setq gnus-newsgroup-unreads (cons article gnus-newsgroup-unreads)))
9027     ;; If CLEAR-MARK is non-nil, the article must be removed from mark
9028     ;; lists.  Otherwise, it must be added to the list.
9029     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
9030     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
9031     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
9032     (if (= mark gnus-ticked-mark)
9033         (setq gnus-newsgroup-marked (cons article gnus-newsgroup-marked)))
9034     (if (= mark gnus-dormant-mark)
9035         (setq gnus-newsgroup-dormant (cons article gnus-newsgroup-dormant)))))
9036
9037 (defalias 'gnus-summary-mark-as-unread-forward 
9038   'gnus-summary-tick-article-forward)
9039 (make-obsolete 'gnus-summary-mark-as-unread-forward 
9040                'gnus-summary-tick-article-forward)
9041 (defun gnus-summary-tick-article-forward (n)
9042   "Tick N articles forwards.
9043 If N is negative, tick backwards instead.
9044 The difference between N and the number of articles ticked is returned."
9045   (interactive "p")
9046   (gnus-summary-mark-forward n gnus-ticked-mark))
9047
9048 (defalias 'gnus-summary-mark-as-unread-backward 
9049   'gnus-summary-tick-article-backward)
9050 (make-obsolete 'gnus-summary-mark-as-unread-backward 
9051                'gnus-summary-tick-article-backward)
9052 (defun gnus-summary-tick-article-backward (n)
9053   "Tick N articles backwards.
9054 The difference between N and the number of articles ticked is returned."
9055   (interactive "p")
9056   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
9057
9058 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
9059 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
9060 (defun gnus-summary-tick-article (&optional article clear-mark)
9061   "Mark current article as unread.
9062 Optional 1st argument ARTICLE specifies article number to be marked as unread.
9063 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
9064   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
9065                                        gnus-ticked-mark)))
9066
9067 (defun gnus-summary-mark-as-read-forward (n)
9068   "Mark N articles as read forwards.
9069 If N is negative, mark backwards instead.
9070 The difference between N and the actual number of articles marked is
9071 returned."
9072   (interactive "p")
9073   (gnus-summary-mark-forward n gnus-del-mark t))
9074
9075 (defun gnus-summary-mark-as-read-backward (n)
9076   "Mark the N articles as read backwards.
9077 The difference between N and the actual number of articles marked is
9078 returned."
9079   (interactive "p")
9080   (gnus-summary-mark-forward (- n) gnus-del-mark t))
9081
9082 (defun gnus-summary-mark-as-read (&optional article mark)
9083   "Mark current article as read.
9084 ARTICLE specifies the article to be marked as read.
9085 MARK specifies a string to be inserted at the beginning of the line."
9086   (gnus-summary-mark-article article mark))
9087
9088 (defun gnus-summary-clear-mark-forward (n)
9089   "Clear marks from N articles forward.
9090 If N is negative, clear backward instead.
9091 The difference between N and the number of marks cleared is returned."
9092   (interactive "p")
9093   (gnus-summary-mark-forward n gnus-unread-mark))
9094
9095 (defun gnus-summary-clear-mark-backward (n)
9096   "Clear marks from N articles backward.
9097 The difference between N and the number of marks cleared is returned."
9098   (interactive "p")
9099   (gnus-summary-mark-forward (- n) gnus-unread-mark))
9100
9101 (defun gnus-summary-mark-unread-as-read ()
9102   "Intended to be used by `gnus-summary-mark-article-hook'."
9103   (or (memq gnus-current-article gnus-newsgroup-marked)
9104       (memq gnus-current-article gnus-newsgroup-dormant)
9105       (memq gnus-current-article gnus-newsgroup-expirable)
9106       (gnus-summary-mark-as-read gnus-current-article gnus-read-mark)))
9107
9108 (defun gnus-summary-mark-region-as-read (point mark all)
9109   "Mark all unread articles between point and mark as read.
9110 If given a prefix, mark all articles between point and mark as read,
9111 even ticked and dormant ones."
9112   (interactive "r\nP")
9113   (save-excursion
9114     (goto-char point)
9115     (beginning-of-line)
9116     (while (and 
9117             (< (point) mark)
9118             (progn
9119               (and
9120                (or all
9121                    (and
9122                     (not (memq (gnus-summary-article-number)
9123                                gnus-newsgroup-marked))
9124                     (not (memq (gnus-summary-article-number)
9125                                gnus-newsgroup-dormant))))
9126                (gnus-summary-mark-article
9127                 (gnus-summary-article-number) gnus-del-mark))
9128               t)
9129             (zerop (forward-line 1))))))
9130
9131 ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
9132 (defalias 'gnus-summary-delete-marked-as-read 
9133   'gnus-summary-remove-lines-marked-as-read)
9134 (make-obsolete 'gnus-summary-delete-marked-as-read 
9135                'gnus-summary-remove-lines-marked-as-read)
9136 (defun gnus-summary-remove-lines-marked-as-read ()
9137   "Remove lines that are marked as read."
9138   (interactive)
9139   (gnus-summary-remove-lines-marked-with 
9140    (concat (mapconcat
9141             (lambda (char) (char-to-string (symbol-value char)))
9142             '(gnus-del-mark gnus-read-mark gnus-ancient-mark
9143               gnus-killed-mark gnus-kill-file-mark
9144               gnus-low-score-mark gnus-expirable-mark
9145               gnus-canceled-mark)
9146             ""))))
9147
9148 (defalias 'gnus-summary-delete-marked-with 
9149   'gnus-summary-remove-lines-marked-with)
9150 (make-obsolete 'gnus-summary-delete-marked-with 
9151                'gnus-summary-remove-lines-marked-with)
9152 ;; Rewrite by Daniel Quinlan <quinlan@best.com>.
9153 (defun gnus-summary-remove-lines-marked-with (marks)
9154   "Remove lines that are marked with MARKS (e.g. \"DK\")."
9155   (interactive "sMarks: ")
9156   ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
9157   (gnus-set-global-variables)
9158   (let ((buffer-read-only nil)
9159         (marks (concat "^[" marks "]")))
9160     (goto-char (point-min))
9161     (if gnus-newsgroup-adaptive
9162         (gnus-score-remove-lines-adaptive marks)
9163       (while (re-search-forward marks nil t)
9164         (gnus-delete-line)))
9165     ;; If we use dummy roots, we have to do an additional sweep over
9166     ;; the buffer.
9167     (if (not (eq gnus-summary-make-false-root 'dummy))
9168         ()
9169       (goto-char (point-min))
9170       (setq marks (concat "^[" (char-to-string gnus-dummy-mark) "]"))
9171       (while (re-search-forward marks nil t)
9172         (if (gnus-subject-equal
9173              (gnus-summary-subject-string)
9174              (progn
9175                (forward-line 1)
9176                (gnus-summary-subject-string)))
9177             ()
9178           (forward-line -1)
9179           (gnus-delete-line)))))
9180   (or (zerop (buffer-size))
9181       (if (eobp)
9182           (gnus-summary-prev-subject 1)
9183         (gnus-summary-position-cursor))))
9184
9185 (defun gnus-summary-expunge-below (score)
9186   "Remove articles with score less than SCORE."
9187   (interactive "P")
9188   (gnus-set-global-variables)
9189   (setq score (if score
9190                   (prefix-numeric-value score)
9191                 (or gnus-summary-default-score 0)))
9192   (save-excursion
9193     (set-buffer gnus-summary-buffer)
9194     (goto-char (point-min))
9195     (let ((buffer-read-only nil)
9196           beg)
9197       (while (not (eobp))
9198         (if (< (gnus-summary-article-score) score)
9199             (progn
9200               (setq beg (point))
9201               (forward-line 1)
9202               (delete-region beg (point)))
9203           (forward-line 1)))
9204       ;; Adjust point.
9205       (or (zerop (buffer-size))
9206           (if (eobp)
9207               (gnus-summary-prev-subject 1)
9208             (gnus-summary-position-cursor))))))
9209
9210 (defun gnus-summary-mark-below (score mark)
9211   "Mark articles with score less than SCORE with MARK."
9212   (interactive "P\ncMark: ")
9213   (gnus-set-global-variables)
9214   (setq score (if score
9215                   (prefix-numeric-value score)
9216                 (or gnus-summary-default-score 0)))
9217   (save-excursion
9218     (set-buffer gnus-summary-buffer)
9219     (goto-char (point-min))
9220     (while (not (eobp))
9221       (and (< (gnus-summary-article-score) score)
9222            (gnus-summary-mark-article nil mark))
9223       (forward-line 1))))
9224
9225 (defun gnus-summary-kill-below (score)
9226   "Mark articles with score below SCORE as read."
9227   (interactive "P")
9228   (gnus-summary-mark-below score gnus-killed-mark))
9229
9230 (defun gnus-summary-clear-above (score)
9231   "Clear all marks from articles with score above SCORE."
9232   (interactive "P")
9233   (gnus-summary-mark-above score gnus-unread-mark))
9234
9235 (defun gnus-summary-tick-above (score)
9236   "Tick all articles with score above SCORE."
9237   (interactive "P")
9238   (gnus-summary-mark-above score gnus-ticked-mark))
9239
9240 (defun gnus-summary-mark-above (score mark)
9241   "Mark articles with score over SCORE with MARK."
9242   (interactive "P\ncMark: ")
9243   (setq score (if score
9244                   (prefix-numeric-value score)
9245                 (or gnus-summary-default-score 0)))
9246   (save-excursion
9247     (set-buffer gnus-summary-buffer)
9248     (goto-char (point-min))
9249     (while (not (eobp))
9250       (if (> (gnus-summary-article-score) score)
9251           (progn
9252             (gnus-summary-mark-article nil mark)
9253             (forward-line 1))
9254         (forward-line 1)))))
9255
9256 ;; Suggested by Daniel Quinlan <quinlan@best.com>.  
9257 (defun gnus-summary-show-all-expunged ()
9258   "Display all the hidden articles that were expunged for low scores."
9259   (interactive)
9260   (let ((buffer-read-only nil))
9261     (let ((scored gnus-newsgroup-scored)
9262           headers h)
9263       (while scored
9264         (or (gnus-summary-goto-subject (car (car scored)))
9265             (and (setq h (gnus-get-header-by-number (car (car scored))))
9266                  (< (cdr (car scored)) gnus-summary-expunge-below)
9267                  (setq headers (cons h headers))))
9268         (setq scored (cdr scored)))
9269       (or headers (error "No expunged articles hidden."))
9270       (goto-char (point-min))
9271       (save-excursion 
9272         (gnus-summary-update-lines 
9273          (point)
9274          (progn
9275            (gnus-summary-prepare-threads (nreverse headers) 0)
9276            (point)))))
9277     (goto-char (point-min))
9278     (gnus-summary-position-cursor)))
9279
9280 (defun gnus-summary-show-all-dormant ()
9281   "Display all the hidden articles that are marked as dormant."
9282   (interactive)
9283   (let ((buffer-read-only nil))
9284     (let ((dormant gnus-newsgroup-dormant)
9285           headers h)
9286       (while dormant
9287         (or (gnus-summary-goto-subject (car dormant))
9288             (and (setq h (gnus-get-header-by-number (car dormant)))
9289                  (setq headers (cons h headers))))
9290         (setq dormant (cdr dormant)))
9291       (or headers (error "No dormant articles hidden."))
9292       (goto-char (point-min))
9293       (save-excursion 
9294         (gnus-summary-update-lines 
9295          (point)
9296          (progn
9297            (gnus-summary-prepare-threads (nreverse headers) 0)
9298            (point)))))
9299     (goto-char (point-min))
9300     (gnus-summary-position-cursor)))
9301
9302 (defun gnus-summary-hide-all-dormant ()
9303   "Hide all dormant articles."
9304   (interactive)
9305   (gnus-summary-remove-lines-marked-with (char-to-string gnus-dormant-mark))
9306   (gnus-summary-position-cursor))
9307
9308 (defun gnus-summary-catchup (all &optional quietly to-here not-mark)
9309   "Mark all articles not marked as unread in this newsgroup as read.
9310 If prefix argument ALL is non-nil, all articles are marked as read.
9311 If QUIETLY is non-nil, no questions will be asked.
9312 If TO-HERE is non-nil, it should be a point in the buffer. All
9313 articles before this point will be marked as read.
9314 The number of articles marked as read is returned."
9315   (interactive "P")
9316   (prog1
9317       (if (or quietly
9318               (not gnus-interactive-catchup) ;Without confirmation?
9319               gnus-expert-user
9320               (gnus-y-or-n-p
9321                (if all
9322                    "Mark absolutely all articles as read? "
9323                  "Mark all unread articles as read? ")))
9324           (if (and not-mark 
9325                    (not gnus-newsgroup-adaptive)
9326                    (not gnus-newsgroup-auto-expire))
9327               (progn
9328                 (and all (setq gnus-newsgroup-marked nil
9329                                gnus-newsgroup-dormant nil))
9330                 (setq gnus-newsgroup-unreads 
9331                       (append gnus-newsgroup-marked gnus-newsgroup-dormant)))
9332             ;; We actually mark all articles as canceled, which we
9333             ;; have to do when using auto-expiry or adaptive scoring. 
9334             (let ((unreads (length gnus-newsgroup-unreads)))
9335               (if (gnus-summary-first-subject (not all))
9336                   (while (and (if to-here (< (point) to-here) t)
9337                               (gnus-summary-mark-as-read nil gnus-catchup-mark)
9338                               (gnus-summary-search-subject nil (not all)))))
9339               (- unreads (length gnus-newsgroup-unreads))
9340               (or to-here
9341                   (setq gnus-newsgroup-unreads gnus-newsgroup-marked)))))
9342     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
9343       (if (and (not to-here) (eq 'nnvirtual (car method)))
9344           (nnvirtual-catchup-group
9345            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
9346     (gnus-summary-position-cursor)))
9347
9348 (defun gnus-summary-catchup-to-here (&optional all)
9349   "Mark all unticked articles before the current one as read.
9350 If ALL is non-nil, also mark ticked and dormant articles as read."
9351   (interactive)
9352   (save-excursion
9353     (and (zerop (forward-line -1))
9354          (progn
9355            (end-of-line)
9356            (gnus-summary-catchup all t (point))
9357            (gnus-set-mode-line 'summary))))
9358   (gnus-summary-position-cursor))
9359
9360 (defun gnus-summary-catchup-all (&optional quietly)
9361   "Mark all articles in this newsgroup as read."
9362   (interactive)
9363   (gnus-summary-catchup t quietly))
9364
9365 (defun gnus-summary-catchup-and-exit (all &optional quietly)
9366   "Mark all articles not marked as unread in this newsgroup as read, then exit.
9367 If prefix argument ALL is non-nil, all articles are marked as read."
9368   (interactive "P")
9369   (gnus-summary-catchup all quietly nil 'fast)
9370   ;; Select next newsgroup or exit.
9371   (if (eq gnus-auto-select-next 'quietly)
9372       (gnus-summary-next-group nil)
9373     (gnus-summary-exit)))
9374
9375 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
9376   "Mark all articles in this newsgroup as read, and then exit."
9377   (interactive)
9378   (gnus-summary-catchup-and-exit t quietly))
9379
9380 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
9381 (defun gnus-summary-catchup-and-goto-next-group (all)
9382   "Mark all articles in this group as read and select the next group.
9383 If given a prefix, mark all articles, unread as well as ticked, as
9384 read." 
9385   (interactive "P")
9386   (gnus-summary-catchup all)
9387   (gnus-summary-next-group))
9388
9389 ;; Thread-based commands.
9390
9391 (defun gnus-summary-toggle-threads (arg)
9392   "Toggle showing conversation threads.
9393 If ARG is positive number, turn showing conversation threads on."
9394   (interactive "P")
9395   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
9396     (setq gnus-show-threads
9397           (if (null arg) (not gnus-show-threads)
9398             (> (prefix-numeric-value arg) 0)))
9399     (gnus-summary-prepare)
9400     (gnus-summary-goto-subject current)
9401     (gnus-summary-position-cursor)))
9402
9403 (defun gnus-summary-show-all-threads ()
9404   "Show all threads."
9405   (interactive)
9406   (save-excursion
9407     (let ((buffer-read-only nil))
9408       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
9409   (gnus-summary-position-cursor))
9410
9411 (defun gnus-summary-show-thread ()
9412   "Show thread subtrees.
9413 Returns nil if no thread was there to be shown."
9414   (interactive)
9415   (prog1
9416       (save-excursion
9417         (let ((buffer-read-only nil)
9418               ;; first goto end then to beg, to have point at beg after let
9419               (end (progn (end-of-line) (point)))
9420               (beg (progn (beginning-of-line) (point))))
9421           (prog1
9422               ;; Any hidden lines here?
9423               (search-forward "\r" end t)
9424             (subst-char-in-region beg end ?\^M ?\n t))))
9425     (gnus-summary-position-cursor)))
9426
9427 (defun gnus-summary-hide-all-threads ()
9428   "Hide all thread subtrees."
9429   (interactive)
9430   (save-excursion
9431     (goto-char (point-min))
9432     (gnus-summary-hide-thread)
9433     (while (and (not (eobp)) (zerop (forward-line 1)))
9434       (gnus-summary-hide-thread)))
9435   (gnus-summary-position-cursor))
9436
9437 (defun gnus-summary-hide-thread ()
9438   "Hide thread subtrees.
9439 Returns nil if no threads were there to be hidden."
9440   (interactive)
9441   (let ((buffer-read-only nil)
9442         (start (point))
9443         (level (gnus-summary-thread-level))
9444         (end (point)))
9445     ;; Go forward until either the buffer ends or the subthread
9446     ;; ends. 
9447     (if (eobp)
9448         ()
9449       (while (and (zerop (forward-line 1))
9450                   (> (gnus-summary-thread-level) level))
9451         (setq end (point)))
9452       (prog1
9453           (save-excursion
9454             (goto-char end)
9455             (search-backward "\n" start t))
9456         (subst-char-in-region start end ?\n ?\^M t)
9457         (forward-line -1)))))
9458
9459 (defun gnus-summary-go-to-next-thread (&optional previous)
9460   "Go to the same level (or less) next thread.
9461 If PREVIOUS is non-nil, go to previous thread instead.
9462 Return the article number moved to, or nil if moving was impossible."
9463   (let ((level (gnus-summary-thread-level))
9464         (article (gnus-summary-article-number)))
9465     (if previous 
9466         (while (and (zerop (forward-line -1))
9467                     (> (gnus-summary-thread-level) level)))
9468       (while (and (save-excursion
9469                     (forward-line 1)
9470                     (not (eobp)))
9471                   (zerop (forward-line 1))
9472                   (> (gnus-summary-thread-level) level))))
9473     (gnus-summary-recenter)
9474     (gnus-summary-position-cursor)
9475     (let ((oart (gnus-summary-article-number)))
9476       (and (/= oart article) oart))))
9477
9478 (defun gnus-summary-next-thread (n)
9479   "Go to the same level next N'th thread.
9480 If N is negative, search backward instead.
9481 Returns the difference between N and the number of skips actually
9482 done."
9483   (interactive "p")
9484   (let ((backward (< n 0))
9485         (n (abs n)))
9486   (while (and (> n 0)
9487               (gnus-summary-go-to-next-thread backward))
9488     (setq n (1- n)))
9489   (gnus-summary-position-cursor)
9490   (if (/= 0 n) (gnus-message 7 "No more threads"))
9491   n))
9492
9493 (defun gnus-summary-prev-thread (n)
9494   "Go to the same level previous N'th thread.
9495 Returns the difference between N and the number of skips actually
9496 done."
9497   (interactive "p")
9498   (gnus-summary-next-thread (- n)))
9499
9500 (defun gnus-summary-go-down-thread (&optional same)
9501   "Go down one level in the current thread.
9502 If SAME is non-nil, also move to articles of the same level."
9503   (let ((level (gnus-summary-thread-level))
9504         (start (point)))
9505     (if (and (zerop (forward-line 1))
9506              (> (gnus-summary-thread-level) level))
9507         t
9508       (goto-char start)
9509       nil)))
9510
9511 (defun gnus-summary-go-up-thread ()
9512   "Go up one level in the current thread."
9513   (let ((level (gnus-summary-thread-level))
9514         (start (point)))
9515     (while (and (zerop (forward-line -1))
9516                 (>= (gnus-summary-thread-level) level)))
9517     (if (>= (gnus-summary-thread-level) level)
9518         (progn
9519           (goto-char start)
9520           nil)
9521       t)))
9522
9523 (defun gnus-summary-down-thread (n)
9524   "Go down thread N steps.
9525 If N is negative, go up instead.
9526 Returns the difference between N and how many steps down that were
9527 taken."
9528   (interactive "p")
9529   (let ((up (< n 0))
9530         (n (abs n)))
9531   (while (and (> n 0)
9532               (if up (gnus-summary-go-up-thread)
9533                 (gnus-summary-go-down-thread)))
9534     (setq n (1- n)))
9535   (gnus-summary-position-cursor)
9536   (if (/= 0 n) (gnus-message 7 "Can't go further"))
9537   n))
9538
9539 (defun gnus-summary-up-thread (n)
9540   "Go up thread N steps.
9541 If N is negative, go up instead.
9542 Returns the difference between N and how many steps down that were
9543 taken."
9544   (interactive "p")
9545   (gnus-summary-down-thread (- n)))
9546
9547 (defun gnus-summary-kill-thread (unmark)
9548   "Mark articles under current thread as read.
9549 If the prefix argument is positive, remove any kinds of marks.
9550 If the prefix argument is negative, tick articles instead."
9551   (interactive "P")
9552   (if unmark
9553       (setq unmark (prefix-numeric-value unmark)))
9554   (let ((killing t)
9555         (level (gnus-summary-thread-level)))
9556     (save-excursion
9557       (while killing
9558         ;; Mark the article...
9559         (cond ((null unmark) (gnus-summary-mark-as-read nil gnus-killed-mark))
9560               ((> unmark 0) (gnus-summary-tick-article nil t))
9561               (t (gnus-summary-tick-article)))
9562         ;; ...and go forward until either the buffer ends or the subtree
9563         ;; ends. 
9564         (if (not (and (zerop (forward-line 1))
9565                       (> (gnus-summary-thread-level) level)))
9566             (setq killing nil))))
9567     ;; Hide killed subtrees.
9568     (and (null unmark)
9569          gnus-thread-hide-killed
9570          (gnus-summary-hide-thread))
9571     ;; If marked as read, go to next unread subject.
9572     (if (null unmark)
9573         ;; Go to next unread subject.
9574         (gnus-summary-next-subject 1 t)))
9575   (gnus-set-mode-line 'summary))
9576
9577 ;; Summary sorting commands
9578
9579 (defun gnus-summary-sort-by-number (&optional reverse)
9580   "Sort summary buffer by article number.
9581 Argument REVERSE means reverse order."
9582   (interactive "P")
9583   (gnus-summary-sort 
9584    (cons 'gnus-summary-article-number 'gnus-thread-sort-by-number) reverse))
9585
9586 (defun gnus-summary-sort-by-author (&optional reverse)
9587   "Sort summary buffer by author name alphabetically.
9588 If case-fold-search is non-nil, case of letters is ignored.
9589 Argument REVERSE means reverse order."
9590   (interactive "P")
9591   (gnus-summary-sort
9592    (cons
9593     (lambda ()
9594       (let ((extract (funcall
9595                       gnus-extract-address-components
9596                       (header-from (gnus-get-header-by-number
9597                                     (gnus-summary-article-number))))))
9598         (or (car extract) (cdr extract))))
9599     'gnus-thread-sort-by-author)
9600    reverse))
9601
9602 (defun gnus-summary-sort-by-subject (&optional reverse)
9603   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
9604 If case-fold-search is non-nil, case of letters is ignored.
9605 Argument REVERSE means reverse order."
9606   (interactive "P")
9607   (gnus-summary-sort
9608    (cons
9609     (lambda ()
9610       (downcase (gnus-simplify-subject (gnus-summary-subject-string))))
9611     'gnus-thread-sort-by-subject)
9612    reverse))
9613
9614 (defun gnus-summary-sort-by-date (&optional reverse)
9615   "Sort summary buffer by date.
9616 Argument REVERSE means reverse order."
9617   (interactive "P")
9618   (gnus-summary-sort
9619    (cons
9620     (lambda ()
9621       (gnus-sortable-date
9622        (header-date 
9623         (gnus-get-header-by-number (gnus-summary-article-number)))))
9624     'gnus-thread-sort-by-date)
9625    reverse))
9626
9627 (defun gnus-summary-sort-by-score (&optional reverse)
9628   "Sort summary buffer by score.
9629 Argument REVERSE means reverse order."
9630   (interactive "P")
9631   (gnus-summary-sort 
9632    (cons 'gnus-summary-article-score 'gnus-thread-sort-by-score)
9633    (not reverse)))
9634
9635 (defvar gnus-summary-already-sorted nil)
9636 (defun gnus-summary-sort (predicate reverse)
9637   ;; Sort summary buffer by PREDICATE.  REVERSE means reverse order. 
9638   (if gnus-summary-already-sorted
9639       ()
9640     (let (buffer-read-only)
9641       (if (not gnus-show-threads)
9642           (progn
9643             (goto-char (point-min))
9644             (sort-subr reverse 'forward-line 'end-of-line (car predicate)))
9645         (let ((gnus-thread-sort-functions (list (cdr predicate)))
9646               (gnus-summary-prepare-hook nil)
9647               (gnus-summary-already-sorted nil))
9648           (gnus-summary-prepare)
9649           (and gnus-show-threads
9650                gnus-thread-hide-subtree
9651                (gnus-summary-hide-all-threads))
9652           ;; If in async mode, we send some info to the backend.
9653           (and gnus-newsgroup-async
9654                (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads))
9655                (gnus-request-asynchronous 
9656                 gnus-newsgroup-name
9657                 (if (and gnus-asynchronous-article-function
9658                          (fboundp gnus-asynchronous-article-function))
9659                     (funcall gnus-asynchronous-article-function
9660                              gnus-newsgroup-threads)))))))))
9661
9662   
9663 (defun gnus-sortable-date (date)
9664   "Make sortable string by string-lessp from DATE.
9665 Timezone package is used."
9666   (let* ((date   (timezone-fix-time date nil nil)) ;[Y M D H M S]
9667          (year   (aref date 0))
9668          (month  (aref date 1))
9669          (day    (aref date 2)))
9670     (timezone-make-sortable-date 
9671      year month day 
9672      (timezone-make-time-string
9673       (aref date 3) (aref date 4) (aref date 5)))))
9674
9675
9676 ;; Summary saving commands.
9677
9678 (defun gnus-summary-save-article (n)
9679   "Save the current article using the default saver function.
9680 If N is a positive number, save the N next articles.
9681 If N is a negative number, save the N previous articles.
9682 If N is nil and any articles have been marked with the process mark,
9683 save those articles instead.
9684 The variable `gnus-default-article-saver' specifies the saver function."
9685   (interactive "P")
9686   (let ((articles (gnus-summary-work-articles n)))
9687     (while articles
9688       (let ((header (gnus-get-header-by-number (car articles))))
9689         (if (vectorp header)
9690             (progn
9691               (gnus-summary-select-article t nil nil (car articles))
9692               (or gnus-save-all-headers
9693                   (gnus-article-hide-headers t))
9694               ;; Remove any X-Gnus lines.
9695               (save-excursion
9696                 (save-restriction
9697                   (set-buffer gnus-article-buffer)
9698                   (let ((buffer-read-only nil))
9699                     (goto-char (point-min))
9700                     (narrow-to-region (point) (or (search-forward "\n\n" nil t)
9701                                                   (point-max)))
9702                     (while (re-search-forward "^X-Gnus" nil t)
9703                       (beginning-of-line)
9704                       (delete-region (point)
9705                                      (progn (forward-line 1) (point))))
9706                     (widen))))
9707               (save-excursion
9708                 (if gnus-default-article-saver
9709                     (funcall gnus-default-article-saver)
9710                   (error "No default saver is defined."))))
9711           (if (assq 'name header)
9712               (gnus-copy-file (cdr (assq 'name header)))
9713             (gnus-message 1 "Article %d is unsaveable" (car articles)))))
9714       (gnus-summary-remove-process-mark (car articles))
9715       (setq articles (cdr articles)))
9716     (gnus-summary-position-cursor)
9717     n))
9718
9719 (defun gnus-summary-pipe-output (arg)
9720   "Pipe the current article to a subprocess.
9721 If N is a positive number, pipe the N next articles.
9722 If N is a negative number, pipe the N previous articles.
9723 If N is nil and any articles have been marked with the process mark,
9724 pipe those articles instead."
9725   (interactive "P")
9726   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
9727     (gnus-summary-save-article arg)))
9728
9729 (defun gnus-summary-save-article-mail (arg)
9730   "Append the current article to an mail file.
9731 If N is a positive number, save the N next articles.
9732 If N is a negative number, save the N previous articles.
9733 If N is nil and any articles have been marked with the process mark,
9734 save those articles instead."
9735   (interactive "P")
9736   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
9737     (gnus-summary-save-article arg)))
9738
9739 (defun gnus-summary-save-article-rmail (arg)
9740   "Append the current article to an rmail file.
9741 If N is a positive number, save the N next articles.
9742 If N is a negative number, save the N previous articles.
9743 If N is nil and any articles have been marked with the process mark,
9744 save those articles instead."
9745   (interactive "P")
9746   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
9747     (gnus-summary-save-article arg)))
9748
9749 (defun gnus-summary-save-article-file (arg)
9750   "Append the current article to a file.
9751 If N is a positive number, save the N next articles.
9752 If N is a negative number, save the N previous articles.
9753 If N is nil and any articles have been marked with the process mark,
9754 save those articles instead."
9755   (interactive "P")
9756   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
9757     (gnus-summary-save-article arg)))
9758
9759 (defun gnus-read-save-file-name (prompt default-name)
9760   (let ((methods gnus-split-methods)
9761         split-name)
9762     (if (not gnus-split-methods)
9763         ()
9764       (save-excursion
9765         (set-buffer gnus-article-buffer)
9766         (gnus-narrow-to-headers)
9767         (while methods
9768           (goto-char (point-min))
9769           (and (condition-case () 
9770                    (re-search-forward (car (car methods)) nil t)
9771                  (error nil))
9772                (setq split-name (cons (nth 1 (car methods)) split-name)))
9773           (setq methods (cdr methods)))
9774         (widen)))
9775     (cond ((null split-name)
9776            (read-file-name
9777             (concat prompt " (default "
9778                     (file-name-nondirectory default-name) ") ")
9779             (file-name-directory default-name)
9780             default-name))
9781           ((= 1 (length split-name))
9782            (read-file-name
9783             (concat prompt " (default " (car split-name) ") ")
9784             gnus-article-save-directory
9785             (concat gnus-article-save-directory (car split-name))))
9786           (t
9787            (setq split-name (mapcar (lambda (el) (list el))
9788                                     (nreverse split-name)))
9789            (let ((result (completing-read 
9790                           (concat prompt " ")
9791                           split-name nil nil)))
9792              (concat gnus-article-save-directory
9793                      (if (string= result "")
9794                          (car (car split-name))
9795                        result)))))))
9796
9797 (defun gnus-summary-save-in-rmail (&optional filename)
9798   "Append this article to Rmail file.
9799 Optional argument FILENAME specifies file name.
9800 Directory to save to is default to `gnus-article-save-directory' which
9801 is initialized from the SAVEDIR environment variable."
9802   (interactive)
9803   (let ((default-name
9804           (funcall gnus-rmail-save-name gnus-newsgroup-name
9805                    gnus-current-headers gnus-newsgroup-last-rmail)))
9806     (or filename
9807         (setq filename (gnus-read-save-file-name 
9808                         "Save in rmail file:" default-name)))
9809     (gnus-make-directory (file-name-directory filename))
9810     (gnus-eval-in-buffer-window 
9811      gnus-article-buffer
9812      (save-excursion
9813        (save-restriction
9814          (widen)
9815          (gnus-output-to-rmail filename))))
9816     ;; Remember the directory name to save articles.
9817     (setq gnus-newsgroup-last-rmail filename)))
9818
9819 (defun gnus-summary-save-in-mail (&optional filename)
9820   "Append this article to Unix mail file.
9821 Optional argument FILENAME specifies file name.
9822 Directory to save to is default to `gnus-article-save-directory' which
9823 is initialized from the SAVEDIR environment variable."
9824   (interactive)
9825   (let ((default-name
9826           (funcall gnus-mail-save-name gnus-newsgroup-name
9827                    gnus-current-headers gnus-newsgroup-last-mail)))
9828     (or filename
9829         (setq filename (gnus-read-save-file-name 
9830                         "Save in Unix mail file:" default-name)))
9831     (setq filename
9832           (expand-file-name filename
9833                             (and default-name
9834                                  (file-name-directory default-name))))
9835     (gnus-make-directory (file-name-directory filename))
9836     (gnus-eval-in-buffer-window 
9837      gnus-article-buffer
9838      (save-excursion
9839        (save-restriction
9840          (widen)
9841          (if (and (file-readable-p filename) (rmail-file-p filename))
9842              (gnus-output-to-rmail filename)
9843            (rmail-output filename 1 t t)))))
9844     ;; Remember the directory name to save articles.
9845     (setq gnus-newsgroup-last-mail filename)))
9846
9847 (defun gnus-summary-save-in-file (&optional filename)
9848   "Append this article to file.
9849 Optional argument FILENAME specifies file name.
9850 Directory to save to is default to `gnus-article-save-directory' which
9851 is initialized from the SAVEDIR environment variable."
9852   (interactive)
9853   (let ((default-name
9854           (funcall gnus-file-save-name gnus-newsgroup-name
9855                    gnus-current-headers gnus-newsgroup-last-file)))
9856     (or filename
9857         (setq filename (gnus-read-save-file-name 
9858                         "Save in file:" default-name)))
9859     (gnus-make-directory (file-name-directory filename))
9860     (gnus-eval-in-buffer-window 
9861      gnus-article-buffer
9862      (save-excursion
9863        (save-restriction
9864          (widen)
9865          (gnus-output-to-file filename))))
9866     ;; Remember the directory name to save articles.
9867     (setq gnus-newsgroup-last-file filename)))
9868
9869 (defun gnus-summary-save-in-pipe (&optional command)
9870   "Pipe this article to subprocess."
9871   (interactive)
9872   (let ((command (read-string "Shell command on article: "
9873                               gnus-last-shell-command)))
9874     (if (string-equal command "")
9875         (setq command gnus-last-shell-command))
9876     (gnus-eval-in-buffer-window 
9877      gnus-article-buffer
9878      (save-restriction
9879        (widen)
9880        (shell-command-on-region (point-min) (point-max) command nil)))
9881     (setq gnus-last-shell-command command)))
9882
9883 ;; Summary extract commands
9884
9885 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
9886   (let ((buffer-read-only nil)
9887         (article (gnus-summary-article-number))
9888         b)
9889     (or (gnus-summary-goto-subject article)
9890         (error (format "No such article: %d" article)))
9891     (or gnus-newsgroup-headers-hashtb-by-number
9892         (gnus-make-headers-hashtable-by-number))
9893     (gnus-summary-position-cursor)
9894     ;; If all commands are to be bunched up on one line, we collect
9895     ;; them here.  
9896     (if gnus-view-pseudos-separately
9897         ()
9898       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
9899             files action)
9900         (while ps
9901           (setq action (cdr (assq 'action (car ps))))
9902           (setq files (list (cdr (assq 'name (car ps)))))
9903           (while (and ps (cdr ps)
9904                       (string= (or action "1")
9905                                (or (cdr (assq 'action (car (cdr ps)))) "2")))
9906             (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
9907             (setcdr ps (cdr (cdr ps))))
9908           (if (not files)
9909               ()
9910             (if (not (string-match "%s" action))
9911                 (setq files (cons " " files)))
9912             (setq files (cons " " files))
9913             (and (assq 'execute (car ps))
9914                  (setcdr (assq 'execute (car ps))
9915                          (funcall (if (string-match "%s" action)
9916                                       'format 'concat)
9917                                   action 
9918                                   (mapconcat (lambda (f) f) files " ")))))
9919           (setq ps (cdr ps)))))
9920     (if (and gnus-view-pseudos (not not-view))
9921         (while pslist
9922           (and (assq 'execute (car pslist))
9923                (gnus-execute-command (cdr (assq 'execute (car pslist)))
9924                                      (eq gnus-view-pseudos 'not-confirm)))
9925           (setq pslist (cdr pslist)))
9926       (save-excursion
9927         (while pslist
9928           (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist)))
9929                                          (gnus-summary-article-number)))
9930           (forward-line 1)
9931           (setq b (point))
9932           (insert "          " (file-name-nondirectory 
9933                                 (cdr (assq 'name (car pslist))))
9934                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
9935           (add-text-properties 
9936            b (1+ b) (list 'gnus-number gnus-reffed-article-number
9937                           'gnus-mark gnus-unread-mark 
9938                           'gnus-level 0
9939                           'gnus-pseudo (car pslist)))
9940           (forward-line -1)
9941           (gnus-sethash (int-to-string gnus-reffed-article-number)
9942                         (car pslist) gnus-newsgroup-headers-hashtb-by-number)
9943           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
9944           (setq pslist (cdr pslist)))))))
9945
9946 (defun gnus-pseudos< (p1 p2)
9947   (let ((c1 (cdr (assq 'action p1)))
9948         (c2 (cdr (assq 'action p2))))
9949     (and c1 c2 (string< c1 c2))))
9950
9951 (defun gnus-request-pseudo-article (props)
9952   (cond ((assq 'execute props)
9953          (gnus-execute-command (cdr (assq 'execute props)))))
9954   (let ((gnus-current-article (gnus-summary-article-number)))
9955     (run-hooks 'gnus-mark-article-hook)))
9956
9957 (defun gnus-execute-command (command &optional automatic)
9958   (save-excursion
9959     (gnus-article-setup-buffer)
9960     (set-buffer gnus-article-buffer)
9961     (let ((command (if automatic command (read-string "Command: " command)))
9962           (buffer-read-only nil))
9963       (erase-buffer)
9964       (insert "$ " command "\n\n")
9965       (if gnus-view-pseudo-asynchronously
9966           (start-process "gnus-execute" nil "sh" "-c" command)
9967         (call-process "sh" nil t nil "-c" command)))))
9968
9969 (defun gnus-copy-file (file &optional to)
9970   "Copy FILE to TO."
9971   (interactive
9972    (list (read-file-name "Copy file: " default-directory)
9973          (read-file-name "Copy file to: " default-directory)))
9974   (or to (setq to (read-file-name "Copy file to: " default-directory)))
9975   (and (file-directory-p to) 
9976        (setq to (concat (file-name-as-directory to)
9977                         (file-name-nondirectory file))))
9978   (copy-file file to))
9979
9980 ;; Summary kill commands.
9981
9982 (defun gnus-summary-edit-global-kill (article)
9983   "Edit the \"global\" kill file."
9984   (interactive (list (gnus-summary-article-number)))
9985   (gnus-group-edit-global-kill article))
9986
9987 (defun gnus-summary-edit-local-kill ()
9988   "Edit a local kill file applied to the current newsgroup."
9989   (interactive)
9990   (setq gnus-current-headers 
9991         (gnus-gethash 
9992          (int-to-string (gnus-summary-article-number))
9993          gnus-newsgroup-headers-hashtb-by-number))
9994   (gnus-set-global-variables)
9995   (gnus-group-edit-local-kill 
9996    (gnus-summary-article-number) gnus-newsgroup-name))
9997
9998 \f
9999 ;;;
10000 ;;; Gnus article mode
10001 ;;;
10002
10003 (put 'gnus-article-mode 'mode-class 'special)
10004
10005 (if gnus-article-mode-map
10006     nil
10007   (setq gnus-article-mode-map (make-keymap))
10008   (suppress-keymap gnus-article-mode-map)
10009   (define-key gnus-article-mode-map " " 'gnus-article-next-page)
10010   (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
10011   (define-key gnus-article-mode-map "\C-c^" 'gnus-article-refer-article)
10012   (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
10013   (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
10014   (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail)
10015   (define-key gnus-article-mode-map "\C-c\C-M" 'gnus-article-mail-with-original)
10016   (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
10017   (define-key gnus-article-mode-map gnus-mouse-2 'gnus-article-push-button)
10018   (define-key gnus-article-mode-map "\r" 'gnus-article-press-button)
10019   (define-key gnus-article-mode-map "\t" 'gnus-article-next-button)
10020   (define-key gnus-article-mode-map "\C-c\C-b" 'gnus-bug)
10021   
10022   ;; Duplicate almost all summary keystrokes in the article mode map.
10023   (let ((commands 
10024          (list 
10025           " " "\177" "\r" "n" "p" "N" "P" "\M-\C-n" "\M-\C-p"
10026           "\M-n" "\M-p" "." "," "\M-s" "\M-r" "<" ">" "j" "^" "\M-^"
10027           "u" "!" "U" "d" "D" "E" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k"
10028           "\M-\C-l" "e" "#" "\M-#" "\M-\C-t" "\M-\C-s" "\M-\C-h"
10029           "\M-\C-f" "\M-\C-b" "\M-\C-u" "\M-\C-d" "&" "\C-w"
10030           "\C-t" "?" "\C-c\M-\C-s" "\C-c\C-s\C-n" "\C-c\C-s\C-a"
10031           "\C-c\C-s\C-s" "\C-c\C-s\C-d" "\C-c\C-s\C-i" "\C-x\C-s"
10032           "\M-g" "w" "\C-c\C-r" "\M-t" "C"
10033           "o" "\C-o" "|" "\M-k" "\M-K" "V" "\C-c\C-d"
10034           "\C-c\C-i" "x" "X" "s" "t" "g" "?" "l"
10035           "\C-c\C-v\C-v" "\C-d" "v" 
10036 ;;        "Mt" "M!" "Md" "Mr"
10037 ;;        "Mc" "M " "Me" "Mx" "M?" "Mb" "MB" "M#" "M\M-#" "M\M-r"
10038 ;;        "M\M-\C-r" "MD" "M\M-D" "MS" "MC" "MH" "M\C-c" "Mk" "MK"
10039 ;;        "Ms" "Mc" "Mu" "Mm" "Mk" "Gn" "Gp" "GN" "GP" "G\C-n" "G\C-p"
10040 ;;        "G\M-n" "G\M-p" "Gf" "Gb" "Gg" "Gl" "Gp" "Tk" "Tl" "Ti" "TT"
10041 ;;        "Ts" "TS" "Th" "TH" "Tn" "Tp" "Tu" "Td" "T#" "A " "An" "A\177" "Ap"
10042 ;;        "A\r" "A<" "A>" "Ab" "Ae" "A^" "Ar" "Aw" "Ac" "Ag" "At" "Am"
10043 ;;        "As" "Wh" "Ws" "Wc" "Wo" "Ww" "Wd" "Wq" "Wf" "Wt" "W\C-t"
10044 ;;        "WT" "WA" "Wa" "WH" "WC" "WS" "Wb" "Hv" "Hf" "Hd" "Hh" "Hi"
10045 ;;        "Be" "B\177" "Bm" "Br" "Bw" "Bc" "Bq" "Bi" "Oo" "Om" "Or"
10046 ;;        "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve"
10047 ;;        "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi"
10048           )))
10049     (while commands
10050       (define-key gnus-article-mode-map (car commands) 
10051         'gnus-article-summary-command)
10052       (setq commands (cdr commands))))
10053
10054   (let ((commands (list "q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
10055 ;;                      "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" 
10056                          "=")))
10057     (while commands
10058       (define-key gnus-article-mode-map (car commands) 
10059         'gnus-article-summary-command-nosave)
10060       (setq commands (cdr commands)))))
10061
10062
10063 (defun gnus-article-mode ()
10064   "Major mode for displaying an article.
10065
10066 All normal editing commands are switched off.
10067
10068 The following commands are available:
10069
10070 \\<gnus-article-mode-map>
10071 \\[gnus-article-next-page]\t Scroll the article one page forwards
10072 \\[gnus-article-prev-page]\t Scroll the article one page backwards
10073 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
10074 \\[gnus-article-show-summary]\t Display the summary buffer
10075 \\[gnus-article-mail]\t Send a reply to the address near point
10076 \\[gnus-article-mail-with-original]\t Send a reply to the address near point; include the original article
10077 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
10078 \\[gnus-info-find-node]\t Go to the Gnus info node"
10079   (interactive)
10080   (if gnus-visual (gnus-article-make-menu-bar))
10081   (kill-all-local-variables)
10082   (setq mode-line-modified "-- ")
10083   (make-local-variable 'mode-line-format)
10084   (setq mode-line-format (copy-sequence mode-line-format))
10085   (and (equal (nth 3 mode-line-format) "   ")
10086        (setcar (nthcdr 3 mode-line-format) ""))
10087   (setq mode-name "Article")
10088   (setq major-mode 'gnus-article-mode)
10089   (make-local-variable 'minor-mode-alist)
10090   (or (assq 'gnus-show-mime minor-mode-alist)
10091       (setq minor-mode-alist
10092             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
10093   (use-local-map gnus-article-mode-map)
10094   (make-local-variable 'page-delimiter)
10095   (setq page-delimiter gnus-page-delimiter)
10096   (buffer-disable-undo (current-buffer))
10097   (setq buffer-read-only t)             ;Disable modification
10098   (run-hooks 'gnus-article-mode-hook))
10099
10100 (defun gnus-article-setup-buffer ()
10101   "Initialize article mode buffer."
10102   (if (get-buffer gnus-article-buffer)
10103       (save-excursion
10104         (set-buffer gnus-article-buffer)
10105         (buffer-disable-undo (current-buffer))
10106         (setq buffer-read-only t)
10107         (gnus-add-current-to-buffer-list)
10108         (or (eq major-mode 'gnus-article-mode)
10109             (gnus-article-mode)))
10110     (save-excursion
10111       (set-buffer (get-buffer-create gnus-article-buffer))
10112       (gnus-add-current-to-buffer-list)
10113       (gnus-article-mode))))
10114
10115 ;; Set article window start at LINE, where LINE is the number of lines
10116 ;; from the head of the article.
10117 (defun gnus-article-set-window-start (&optional line)
10118   (set-window-start 
10119    (get-buffer-window gnus-article-buffer)
10120    (save-excursion
10121      (set-buffer gnus-article-buffer)
10122      (goto-char (point-min))
10123      (if (not line)
10124          (point-min)
10125        (gnus-message 6 "Moved to bookmark")
10126        (search-forward "\n\n" nil t)
10127        (forward-line line)
10128        (point)))))
10129
10130 (defun gnus-request-article-this-buffer (article group)
10131   "Get an article and insert it into this buffer."
10132   (setq group (or group gnus-newsgroup-name))
10133
10134   ;; Open server if it has closed.
10135   (gnus-check-news-server (gnus-find-method-for-group group))
10136
10137   ;; Using `gnus-request-article' directly will insert the article into
10138   ;; `nntp-server-buffer' - so we'll save some time by not having to
10139   ;; copy it from the server buffer into the article buffer.
10140
10141   ;; We only request an article by message-id when we do not have the
10142   ;; headers for it, so we'll have to get those.
10143   (and (stringp article) 
10144        (let ((gnus-override-method gnus-refer-article-method))
10145          (gnus-read-header article)))
10146
10147   ;; If the article number is negative, that means that this article
10148   ;; doesn't belong in this newsgroup (possibly), so we find its
10149   ;; message-id and request it by id instead of number.
10150   (if (not (numberp article))
10151       ()
10152     (save-excursion
10153       (set-buffer gnus-summary-buffer)
10154       (let ((header (gnus-get-header-by-number article)))
10155         (if (< article 0)
10156             (if (vectorp header)
10157                 ;; It's a real article.
10158                 (setq article (header-id header))
10159               ;; It is an extracted pseudo-article.
10160               (setq article 'pseudo)
10161               (gnus-request-pseudo-article header)))
10162
10163         (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
10164           (if (not (eq (car method) 'nneething))
10165               ()
10166             (let ((dir (concat (file-name-as-directory (nth 1 method))
10167                                (header-subject header))))
10168               (if (file-directory-p dir)
10169                   (progn
10170                     (setq article 'nneething)
10171                     (gnus-group-enter-directory dir)))))))))
10172
10173   ;; Check the cache.
10174   (if (and gnus-use-cache
10175            (numberp article)
10176            (gnus-cache-request-article article group))
10177       'article
10178     ;; Get the article and into the article buffer.
10179     (if (or (stringp article) (numberp article))
10180         (progn
10181           (erase-buffer)
10182           (let ((gnus-override-method 
10183                  (and (stringp article) gnus-refer-article-method)))
10184             (and (gnus-request-article article group (current-buffer))
10185                  'article)))
10186       article)))
10187
10188 (defun gnus-read-header (id)
10189   "Read the headers of article ID and enter them into the Gnus system."
10190   (or gnus-newsgroup-headers-hashtb-by-number
10191       (gnus-make-headers-hashtable-by-number))
10192   (let (header)
10193     (if (not (setq header 
10194                    (car (if (let ((gnus-nov-is-evil t))
10195                               (gnus-retrieve-headers 
10196                                (list id) gnus-newsgroup-name))
10197                             (gnus-get-newsgroup-headers)))))
10198         nil
10199       (if (stringp id)
10200           (header-set-number header gnus-reffed-article-number))
10201       (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers))
10202       (gnus-sethash (int-to-string (header-number header)) header
10203                     gnus-newsgroup-headers-hashtb-by-number)
10204       (if (stringp id)
10205           (setq gnus-reffed-article-number (1- gnus-reffed-article-number)))
10206       (setq gnus-current-headers header)
10207       header)))
10208
10209 (defun gnus-article-prepare (article &optional all-headers header)
10210   "Prepare ARTICLE in article mode buffer.
10211 ARTICLE should either be an article number or a Message-ID.
10212 If ARTICLE is an id, HEADER should be the article headers.
10213 If ALL-HEADERS is non-nil, no headers are hidden."
10214   (save-excursion
10215     ;; Make sure we start in a summary buffer.
10216     (or (eq major-mode 'gnus-summary-mode)
10217         (set-buffer gnus-summary-buffer))
10218     (setq gnus-summary-buffer (current-buffer))
10219     ;; Make sure the connection to the server is alive.
10220     (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name))
10221         (progn
10222           (gnus-check-news-server 
10223            (gnus-find-method-for-group gnus-newsgroup-name))
10224           (gnus-request-group gnus-newsgroup-name t)))
10225     (or gnus-newsgroup-headers-hashtb-by-number
10226         (gnus-make-headers-hashtable-by-number))
10227     (let* ((article (if header (header-number header) article))
10228            (summary-buffer (current-buffer))
10229            (internal-hook gnus-article-internal-prepare-hook)
10230            (group gnus-newsgroup-name)
10231            result)
10232       (save-excursion
10233         (gnus-article-setup-buffer)
10234         (set-buffer gnus-article-buffer)
10235         (if (not (setq result (let ((buffer-read-only nil))
10236                                 (gnus-request-article-this-buffer 
10237                                  article group))))
10238             ;; There is no such article.
10239             (save-excursion
10240               (if (not (numberp article))
10241                   ()
10242                 (setq gnus-article-current 
10243                       (cons gnus-newsgroup-name article))
10244                 (set-buffer gnus-summary-buffer)
10245                 (setq gnus-current-article article)
10246                 (gnus-summary-mark-as-read article gnus-canceled-mark))
10247               (gnus-message 1 "No such article (may be canceled)")
10248               (ding)
10249               nil)
10250           (if (or (eq result 'pseudo) (eq result 'nneething))
10251               (progn
10252                 (save-excursion
10253                   (set-buffer summary-buffer)
10254                   (setq gnus-last-article gnus-current-article
10255                         gnus-newsgroup-history (cons gnus-current-article
10256                                                      gnus-newsgroup-history)
10257                         gnus-current-article 0
10258                         gnus-current-headers nil
10259                         gnus-article-current nil)
10260                   (if (eq result 'nneething)
10261                       (gnus-configure-windows 'summary)
10262                     (gnus-configure-windows 'article))
10263                   (gnus-set-global-variables))
10264                 (gnus-set-mode-line 'article))
10265             ;; The result from the `request' was an actual article -
10266             ;; or at least some text that is now displayed in the
10267             ;; article buffer.
10268             (if (and (numberp article)
10269                      (not (eq article gnus-current-article)))
10270                 ;; Seems like a new article has been selected.
10271                 ;; `gnus-current-article' must be an article number.
10272                 (save-excursion
10273                   (set-buffer summary-buffer)
10274                   (setq gnus-last-article gnus-current-article
10275                         gnus-newsgroup-history (cons gnus-current-article
10276                                                      gnus-newsgroup-history)
10277                         gnus-current-article article
10278                         gnus-current-headers 
10279                         (gnus-get-header-by-number gnus-current-article)
10280                         gnus-article-current 
10281                         (cons gnus-newsgroup-name gnus-current-article))
10282                   (gnus-summary-show-thread)
10283                   (run-hooks 'gnus-mark-article-hook)
10284                   (gnus-set-mode-line 'summary)
10285                   (and gnus-visual 
10286                        (run-hooks 'gnus-visual-mark-article-hook))
10287                   ;; Set the global newsgroup variables here.
10288                   ;; Suggested by Jim Sisolak
10289                   ;; <sisolak@trans4.neep.wisc.edu>.
10290                   (gnus-set-global-variables)
10291                   (and gnus-use-cache 
10292                        (gnus-cache-possibly-enter-article
10293                         group article
10294                         (gnus-get-header-by-number article)
10295                         (memq article gnus-newsgroup-marked)
10296                         (memq article gnus-newsgroup-dormant)
10297                         (memq article gnus-newsgroup-unreads)))))
10298             ;; gnus-have-all-headers must be either T or NIL.
10299             (setq gnus-have-all-headers
10300                   (not (not (or all-headers gnus-show-all-headers))))
10301             ;; Hooks for getting information from the article.
10302             ;; This hook must be called before being narrowed.
10303             (let (buffer-read-only)
10304               (run-hooks 'internal-hook)
10305               (run-hooks 'gnus-article-prepare-hook)
10306               ;; Decode MIME message.
10307               (if (and gnus-show-mime
10308                        (or (not gnus-strict-mime)
10309                            (gnus-fetch-field "Mime-Version")))
10310                   (funcall gnus-show-mime-method))
10311               ;; Perform the article display hooks.
10312               (run-hooks 'gnus-article-display-hook))
10313             ;; Do page break.
10314             (goto-char (point-min))
10315             (and gnus-break-pages (gnus-narrow-to-page))
10316             (gnus-set-mode-line 'article)
10317             (gnus-configure-windows 'article)
10318             (goto-char (point-min))
10319             t))))))
10320
10321 (defun gnus-article-show-all-headers ()
10322   "Show all article headers in article mode buffer."
10323   (save-excursion 
10324     (gnus-article-setup-buffer)
10325     (set-buffer gnus-article-buffer)
10326     (let ((buffer-read-only nil))
10327       (remove-text-properties (point-min) (point-max) 
10328                               gnus-hidden-properties))))
10329
10330 (defun gnus-article-hide-headers-if-wanted ()
10331   "Hide unwanted headers if `gnus-have-all-headers' is nil.
10332 Provided for backwards compatability."
10333   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
10334       (gnus-article-hide-headers)))
10335
10336 (defun gnus-article-hide-headers (&optional delete)
10337   "Hide unwanted headers and possibly sort them as well."
10338   (interactive "P")
10339   (save-excursion
10340     (set-buffer gnus-article-buffer)
10341     (save-restriction
10342       (let ((sorted gnus-sorted-header-list)
10343             (buffer-read-only nil)
10344             want-list beg want-l)
10345         ;; First we narrow to just the headers.
10346         (widen)
10347         (goto-char (point-min))
10348         ;; Hide any "From " lines at the beginning of (mail) articles. 
10349         (while (looking-at "From ")
10350           (forward-line 1))
10351         (if (bobp) 
10352             (add-text-properties (point-min) (point) gnus-hidden-properties))
10353         ;; Then treat the rest of the header lines.
10354         (narrow-to-region 
10355          (point) 
10356          (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
10357         ;; Then we use the two regular expressions
10358         ;; `gnus-ignored-headers' and `gnus-visible-headers' to
10359         ;; select which header lines is to remain visible in the
10360         ;; article buffer.
10361         (goto-char (point-min))
10362         (while (re-search-forward "^[^ \t]*:" nil t)
10363           (beginning-of-line)
10364           ;; We add the headers we want to keep to a list and delete
10365           ;; them from the buffer.
10366           (if (or (and (stringp gnus-visible-headers)
10367                        (looking-at gnus-visible-headers))
10368                   (and (not (stringp gnus-visible-headers))
10369                        (stringp gnus-ignored-headers)
10370                        (not (looking-at gnus-ignored-headers))))
10371               (progn
10372                 (setq beg (point))
10373                 (forward-line 1)
10374                 ;; Be sure to get multi-line headers...
10375                 (re-search-forward "^[^ \t]*:" nil t)
10376                 (beginning-of-line)
10377                 (setq want-list 
10378                       (cons (buffer-substring beg (point)) want-list))
10379                 (delete-region beg (point))
10380                 (goto-char beg))
10381             (forward-line 1)))
10382         ;; Next we perform the sorting by looking at
10383         ;; `gnus-sorted-header-list'. 
10384         (goto-char (point-min))
10385         (while (and sorted want-list)
10386           (setq want-l want-list)
10387           (while (and want-l
10388                       (not (string-match (car sorted) (car want-l))))
10389             (setq want-l (cdr want-l)))
10390           (if want-l 
10391               (progn
10392                 (insert (car want-l))
10393                 (setq want-list (delq (car want-l) want-list))))
10394           (setq sorted (cdr sorted)))
10395         ;; Any headers that were not matched by the sorted list we
10396         ;; just tack on the end of the visible header list.
10397         (while want-list
10398           (insert (car want-list))
10399           (setq want-list (cdr want-list)))
10400         ;; And finally we make the unwanted headers invisible.
10401         (if delete
10402             (delete-region (point) (point-max))
10403           ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
10404           (add-text-properties (point) (point-max) gnus-hidden-properties))))))
10405
10406 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
10407 (defun gnus-article-treat-overstrike ()
10408   "Translate overstrikes into bold text."
10409   (interactive)
10410   (save-excursion
10411     (set-buffer gnus-article-buffer)
10412     (let ((buffer-read-only nil))
10413       (while (search-forward "\b" nil t)
10414         (let ((next (following-char))
10415               (previous (char-after (- (point) 2))))
10416           (cond ((eq next previous)
10417                  (delete-region (- (point) 2) (point))
10418                  (put-text-property (point) (1+ (point))
10419                                     'face 'bold))
10420                 ((eq next ?_)
10421                  (delete-region (1- (point)) (1+ (point)))
10422                  (put-text-property (1- (point)) (point)
10423                                     'face 'underline))
10424                 ((eq previous ?_)
10425                  (delete-region (- (point) 2) (point))
10426                  (put-text-property (point) (1+ (point))
10427                                     'face 'underline))))))))
10428
10429 (defun gnus-article-word-wrap ()
10430   "Format too long lines."
10431   (interactive)
10432   (save-excursion
10433     (set-buffer gnus-article-buffer)
10434     (let ((buffer-read-only nil))
10435       (goto-char (point-min))
10436       (search-forward "\n\n" nil t)
10437       (end-of-line 1)
10438       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
10439             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
10440             (adaptive-fill-mode t))
10441         (while (not (eobp))
10442           (and (>= (current-column) (min fill-column (window-width)))
10443                (/= (preceding-char) ?:)
10444                (fill-paragraph nil))
10445           (end-of-line 2))))))
10446
10447 (defun gnus-article-remove-cr ()
10448   "Remove carriage returns from an article."
10449   (interactive)
10450   (save-excursion
10451     (set-buffer gnus-article-buffer)
10452     (let ((buffer-read-only nil))
10453       (goto-char (point-min))
10454       (while (search-forward "\r" nil t)
10455         (replace-match "" t t)))))
10456
10457 (defun gnus-article-display-x-face (&optional force)
10458   "Look for an X-Face header and display it if present."
10459   (interactive (list 'force))
10460   (save-excursion
10461     (set-buffer gnus-article-buffer)
10462     (let ((inhibit-point-motion-hooks t)
10463           (case-fold-search nil))
10464       (save-restriction
10465         (goto-char (point-min))
10466         (search-forward "\n\n")
10467         (narrow-to-region (point-min) (point))
10468         (goto-char (point-min))
10469         (if (or (not gnus-article-x-face-command)
10470                 (and (not force)
10471                      (or (not gnus-article-x-face-too-ugly)
10472                          (string-match gnus-article-x-face-too-ugly
10473                                        (mail-fetch-field "from"))))
10474                 (progn
10475                   (goto-char (point-min))
10476                   (not (re-search-forward "^X-Face: " nil t))))
10477             nil
10478           (let ((beg (point))
10479                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
10480             (if (symbolp gnus-article-x-face-command)
10481                 (and (or (fboundp gnus-article-x-face-command)
10482                          (error "%s is not a function"
10483                                 gnus-article-x-face-command))
10484                      (funcall gnus-article-x-face-command beg end))
10485               (call-process-region beg end "sh" nil 0 nil
10486                                    "-c" gnus-article-x-face-command))))))))
10487
10488 (defun gnus-article-de-quoted-unreadable (&optional force)
10489   "Do a naïve translation of a quoted-printable-encoded article.
10490 This is in no way, shape or form meant as a replacement for real MIME
10491 processing, but is simply a stop-gap measure until MIME support is
10492 written.
10493 If FORCE, decode the article whether it is marked as quoted-printable
10494 or not." 
10495   (interactive (list 'force))
10496   (save-excursion
10497     (set-buffer gnus-article-buffer)
10498     (let ((case-fold-search t)
10499           (buffer-read-only nil)
10500           (type (gnus-fetch-field "content-transfer-encoding")))
10501       (if (or force (and type (string-match "quoted-printable" type)))
10502           (progn
10503             (goto-char (point-min))
10504             (search-forward "\n\n" nil 'move)
10505             (gnus-mime-decode-quoted-printable (point) (point-max)))))))
10506
10507 (defun gnus-mime-decode-quoted-printable (from to)
10508   ;; Decode quoted-printable from region between FROM and TO.
10509   (save-excursion
10510     (goto-char from)
10511     (while (search-forward "=" to t)
10512       (cond ((eq (following-char) ?\n)
10513              (delete-char -1)
10514              (delete-char 1))
10515             ((looking-at "[0-9A-F][0-9A-F]")
10516              (delete-char -1)
10517              (insert (hexl-hex-string-to-integer
10518                       (buffer-substring (point) (+ 2 (point)))))
10519              (delete-char 2))
10520             ((gnus-message 3 "Malformed MIME quoted-printable message"))))))
10521
10522 (defvar gnus-article-time-units
10523   (list (cons 'year (* 365.25 24 60 60))
10524         (cons 'week (* 7 24 60 60))
10525         (cons 'day (* 24 60 60))
10526         (cons 'hour (* 60 60))
10527         (cons 'minute 60)
10528         (cons 'second 1)))
10529
10530 (defun gnus-article-date-ut (&optional type)
10531   "Convert DATE date to universal time in the current article.
10532 If TYPE is `local', convert to local time; if it is `lapsed', output
10533 how much time has lapsed since DATE."
10534   (interactive (list 'ut))
10535   (let ((date (header-date (or gnus-current-headers 
10536                                (gnus-get-header-by-number
10537                                 (gnus-summary-article-number))"")))
10538         (date-regexp "^Date: \\|^X-Sent: "))
10539     (if (or (not date)
10540             (string= date ""))
10541         ()
10542       (save-excursion
10543         (set-buffer gnus-article-buffer)
10544         (let ((buffer-read-only nil))
10545           (goto-char (point-min))
10546           (if (and (re-search-forward date-regexp nil t)
10547                    (progn 
10548                      (beginning-of-line)
10549                      (looking-at date-regexp)))
10550               (delete-region (gnus-point-at-bol)
10551                              (progn (end-of-line) (1+ (point))))
10552             (goto-char (point-min))
10553             (goto-char (- (search-forward "\n\n") 2)))
10554           (insert
10555            (cond 
10556             ((eq type 'local)
10557              (concat "Date: " (condition-case ()
10558                                   (timezone-make-date-arpa-standard date)
10559                                 (error date))
10560                      "\n"))
10561             ((eq type 'ut)
10562              (concat "Date: "
10563                      (condition-case ()
10564                          (timezone-make-date-arpa-standard date nil "UT")
10565                        (error date))
10566                      "\n"))
10567             ((eq type 'lapsed)
10568              ;; If the date is seriously mangled, the timezone
10569              ;; functions are liable to bug out, so we condition-case
10570              ;; the entire thing.  
10571              (let* ((sec (condition-case ()
10572                              (max (- (gnus-seconds-since-epoch 
10573                                       (timezone-make-date-arpa-standard
10574                                        (current-time-string) 
10575                                        (current-time-zone) "UT"))
10576                                      (gnus-seconds-since-epoch 
10577                                       (timezone-make-date-arpa-standard 
10578                                        date nil "UT")))
10579                                   0)
10580                            (error 0)))
10581                     num prev)
10582                (concat
10583                 "X-Sent: "
10584                 (mapconcat 
10585                  (lambda (unit)
10586                    (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
10587                        ""
10588                      (setq sec (- sec (* num (cdr unit))))
10589                      (prog1
10590                          (concat (if prev ", " "") (int-to-string (floor num))
10591                                  " " (symbol-name (car unit))
10592                                  (if (> num 1) "s" ""))
10593                        (setq prev t))))
10594                  gnus-article-time-units "")
10595                 " ago\n")))
10596             (t
10597              (error "Unknown conversion type: %s" type)))))))))
10598
10599 (defun gnus-article-date-local ()
10600   "Convert the current article date to the local timezone."
10601   (interactive)
10602   (gnus-article-date-ut 'local))
10603
10604 (defun gnus-article-date-lapsed ()
10605   "Convert the current article date to time lapsed since it was sent."
10606   (interactive)
10607   (gnus-article-date-ut 'lapsed))
10608
10609 (defun gnus-article-maybe-highlight ()
10610   (if gnus-visual (gnus-article-highlight)))
10611
10612 ;; Article savers.
10613
10614 (defun gnus-output-to-rmail (file-name)
10615   "Append the current article to an Rmail file named FILE-NAME."
10616   (require 'rmail)
10617   ;; Most of these codes are borrowed from rmailout.el.
10618   (setq file-name (expand-file-name file-name))
10619   (setq rmail-default-rmail-file file-name)
10620   (let ((artbuf (current-buffer))
10621         (tmpbuf (get-buffer-create " *Gnus-output*")))
10622     (save-excursion
10623       (or (get-file-buffer file-name)
10624           (file-exists-p file-name)
10625           (if (gnus-yes-or-no-p
10626                (concat "\"" file-name "\" does not exist, create it? "))
10627               (let ((file-buffer (create-file-buffer file-name)))
10628                 (save-excursion
10629                   (set-buffer file-buffer)
10630                   (rmail-insert-rmail-file-header)
10631                   (let ((require-final-newline nil))
10632                     (write-region (point-min) (point-max) file-name t 1)))
10633                 (kill-buffer file-buffer))
10634             (error "Output file does not exist")))
10635       (set-buffer tmpbuf)
10636       (buffer-disable-undo (current-buffer))
10637       (erase-buffer)
10638       (insert-buffer-substring artbuf)
10639       (gnus-convert-article-to-rmail)
10640       ;; Decide whether to append to a file or to an Emacs buffer.
10641       (let ((outbuf (get-file-buffer file-name)))
10642         (if (not outbuf)
10643             (append-to-file (point-min) (point-max) file-name)
10644           ;; File has been visited, in buffer OUTBUF.
10645           (set-buffer outbuf)
10646           (let ((buffer-read-only nil)
10647                 (msg (and (boundp 'rmail-current-message)
10648                           (symbol-value 'rmail-current-message))))
10649             ;; If MSG is non-nil, buffer is in RMAIL mode.
10650             (if msg
10651                 (progn (widen)
10652                        (narrow-to-region (point-max) (point-max))))
10653             (insert-buffer-substring tmpbuf)
10654             (if msg
10655                 (progn
10656                   (goto-char (point-min))
10657                   (widen)
10658                   (search-backward "\^_")
10659                   (narrow-to-region (point) (point-max))
10660                   (goto-char (1+ (point-min)))
10661                   (rmail-count-new-messages t)
10662                   (rmail-show-message msg)))))))
10663     (kill-buffer tmpbuf)))
10664
10665 (defun gnus-output-to-file (file-name)
10666   "Append the current article to a file named FILE-NAME."
10667   (setq file-name (expand-file-name file-name))
10668   (let ((artbuf (current-buffer))
10669         (tmpbuf (get-buffer-create " *Gnus-output*")))
10670     (save-excursion
10671       (set-buffer tmpbuf)
10672       (buffer-disable-undo (current-buffer))
10673       (erase-buffer)
10674       (insert-buffer-substring artbuf)
10675       ;; Append newline at end of the buffer as separator, and then
10676       ;; save it to file.
10677       (goto-char (point-max))
10678       (insert "\n")
10679       (append-to-file (point-min) (point-max) file-name))
10680     (kill-buffer tmpbuf)))
10681
10682 (defun gnus-convert-article-to-rmail ()
10683   "Convert article in current buffer to Rmail message format."
10684   (let ((buffer-read-only nil))
10685     ;; Convert article directly into Babyl format.
10686     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
10687     (goto-char (point-min))
10688     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
10689     (while (search-forward "\n\^_" nil t) ;single char
10690       (replace-match "\n^_" t t))               ;2 chars: "^" and "_"
10691     (goto-char (point-max))
10692     (insert "\^_")))
10693
10694 (defun gnus-narrow-to-page (&optional arg)
10695   "Make text outside current page invisible except for page delimiter.
10696 A numeric arg specifies to move forward or backward by that many pages,
10697 thus showing a page other than the one point was originally in."
10698   (interactive "P")
10699   (setq arg (if arg (prefix-numeric-value arg) 0))
10700   (save-excursion
10701     (forward-page -1)                   ;Beginning of current page.
10702     (widen)
10703     (if (> arg 0)
10704         (forward-page arg)
10705       (if (< arg 0)
10706           (forward-page (1- arg))))
10707     ;; Find the end of the page.
10708     (forward-page)
10709     ;; If we stopped due to end of buffer, stay there.
10710     ;; If we stopped after a page delimiter, put end of restriction
10711     ;; at the beginning of that line.
10712     ;; These are commented out.
10713     ;;    (if (save-excursion (beginning-of-line)
10714     ;;                  (looking-at page-delimiter))
10715     ;;  (beginning-of-line))
10716     (narrow-to-region (point)
10717                       (progn
10718                         ;; Find the top of the page.
10719                         (forward-page -1)
10720                         ;; If we found beginning of buffer, stay there.
10721                         ;; If extra text follows page delimiter on same line,
10722                         ;; include it.
10723                         ;; Otherwise, show text starting with following line.
10724                         (if (and (eolp) (not (bobp)))
10725                             (forward-line 1))
10726                         (point)))))
10727
10728 (defun gnus-gmt-to-local ()
10729   "Rewrite Date header described in GMT to local in current buffer.
10730 Intended to be used with gnus-article-prepare-hook."
10731   (save-excursion
10732     (save-restriction
10733       (widen)
10734       (goto-char (point-min))
10735       (narrow-to-region (point-min)
10736                         (progn (search-forward "\n\n" nil 'move) (point)))
10737       (goto-char (point-min))
10738       (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
10739           (let ((buffer-read-only nil)
10740                 (date (buffer-substring-no-properties
10741                        (match-beginning 1) (match-end 1))))
10742             (delete-region (match-beginning 1) (match-end 1))
10743             (insert
10744              (timezone-make-date-arpa-standard 
10745               date nil (current-time-zone))))))))
10746
10747
10748 ;; Article mode commands
10749
10750 (defun gnus-article-next-page (lines)
10751   "Show next page of current article.
10752 If end of article, return non-nil. Otherwise return nil.
10753 Argument LINES specifies lines to be scrolled up."
10754   (interactive "P")
10755   (move-to-window-line -1)
10756   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
10757   (if (save-excursion
10758         (end-of-line)
10759         (and (pos-visible-in-window-p)  ;Not continuation line.
10760              (eobp)))
10761       ;; Nothing in this page.
10762       (if (or (not gnus-break-pages)
10763               (save-excursion
10764                 (save-restriction
10765                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
10766           t                             ;Nothing more.
10767         (gnus-narrow-to-page 1)         ;Go to next page.
10768         nil)
10769     ;; More in this page.
10770     (condition-case ()
10771         (scroll-up lines)
10772       (end-of-buffer
10773        ;; Long lines may cause an end-of-buffer error.
10774        (goto-char (point-max))))
10775     nil))
10776
10777 (defun gnus-article-prev-page (lines)
10778   "Show previous page of current article.
10779 Argument LINES specifies lines to be scrolled down."
10780   (interactive "P")
10781   (move-to-window-line 0)
10782   (if (and gnus-break-pages
10783            (bobp)
10784            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
10785       (progn
10786         (gnus-narrow-to-page -1) ;Go to previous page.
10787         (goto-char (point-max))
10788         (recenter -1))
10789     (scroll-down lines)))
10790
10791 (defun gnus-article-refer-article ()
10792   "Read article specified by message-id around point."
10793   (interactive)
10794   (search-forward ">" nil t)    ;Move point to end of "<....>".
10795   (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
10796       (let ((message-id
10797              (buffer-substring (match-beginning 1) (match-end 1))))
10798         (set-buffer gnus-summary-buffer)
10799         (gnus-summary-refer-article message-id))
10800     (error "No references around point")))
10801
10802 (defun gnus-article-show-summary ()
10803   "Reconfigure windows to show summary buffer."
10804   (interactive)
10805   (gnus-configure-windows 'article)
10806   (gnus-summary-goto-subject gnus-current-article))
10807
10808 (defun gnus-article-describe-briefly ()
10809   "Describe article mode commands briefly."
10810   (interactive)
10811   (gnus-message 6
10812    (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")))
10813
10814 (defun gnus-article-summary-command ()
10815   "Execute the last keystroke in the summary buffer."
10816   (interactive)
10817   (let ((obuf (current-buffer))
10818         (owin (current-window-configuration))
10819         func)
10820     (switch-to-buffer gnus-summary-buffer 'norecord)
10821     (setq func (lookup-key (current-local-map) (this-command-keys)))
10822     (call-interactively func)
10823     (set-buffer obuf)
10824     (set-window-configuration owin)
10825     (set-window-start (get-buffer-window (current-buffer)) (point))))
10826
10827 (defun gnus-article-summary-command-nosave ()
10828   "Execute the last keystroke in the summary buffer."
10829   (interactive)
10830   (let (func)
10831     (switch-to-buffer gnus-summary-buffer 'norecord)
10832     (setq func (lookup-key (current-local-map) (this-command-keys)))
10833     (call-interactively func)))
10834
10835 \f
10836 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
10837
10838 ;;;###autoload
10839 (defalias 'gnus-batch-kill 'gnus-batch-score)
10840 ;;;###autoload
10841 (defun gnus-batch-score ()
10842   "Run batched scoring.
10843 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
10844 Newsgroups is a list of strings in Bnews format.  If you want to score
10845 the comp hierarchy, you'd say \"comp.all\". If you would not like to
10846 score the alt hierarchy, you'd say \"!alt.all\"."
10847   (interactive)
10848   (let* ((yes-and-no
10849           (gnus-newsrc-parse-options
10850            (apply (function concat)
10851                   (mapcar (lambda (g) (concat g " "))
10852                           command-line-args-left))))
10853          (gnus-expert-user t)
10854          (nnmail-spool-file nil)
10855          (gnus-use-dribble-file nil)
10856          (yes (car yes-and-no))
10857          (no (cdr yes-and-no))
10858          group newsrc entry
10859          ;; Disable verbose message.
10860          gnus-novice-user gnus-large-newsgroup)
10861     ;; Eat all arguments.
10862     (setq command-line-args-left nil)
10863     ;; Start Gnus.
10864     (gnus)
10865     ;; Apply kills to specified newsgroups in command line arguments.
10866     (setq newsrc (cdr gnus-newsrc-alist))
10867     (while newsrc
10868       (setq group (car (car newsrc)))
10869       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
10870       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
10871                (and (car entry)
10872                     (or (eq (car entry) t)
10873                         (not (zerop (car entry)))))
10874                (if yes (string-match yes group) t)
10875                (or (null no) (not (string-match no group))))
10876           (progn
10877             (gnus-summary-read-group group nil t)
10878             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
10879                  (gnus-summary-exit))))
10880       (setq newsrc (cdr newsrc)))
10881     ;; Exit Emacs.
10882     (switch-to-buffer gnus-group-buffer)
10883     (gnus-group-save-newsrc)))
10884
10885 (defun gnus-apply-kill-file ()
10886   "Apply a kill file to the current newsgroup.
10887 Returns the number of articles marked as read."
10888   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
10889           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
10890       (gnus-apply-kill-file-internal)
10891     0))
10892
10893 (defun gnus-kill-save-kill-buffer ()
10894   (save-excursion
10895     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
10896       (if (get-file-buffer file)
10897           (progn
10898             (set-buffer (get-file-buffer file))
10899             (and (buffer-modified-p) (save-buffer))
10900             (kill-buffer (current-buffer)))))))
10901
10902 (defvar gnus-kill-file-name "KILL"
10903   "Suffix of the kill files.")
10904
10905 (defun gnus-newsgroup-kill-file (newsgroup)
10906   "Return the name of a kill file name for NEWSGROUP.
10907 If NEWSGROUP is nil, return the global kill file name instead."
10908   (cond ((or (null newsgroup)
10909              (string-equal newsgroup ""))
10910          ;; The global KILL file is placed at top of the directory.
10911          (expand-file-name gnus-kill-file-name
10912                            (or gnus-kill-files-directory "~/News")))
10913         ((gnus-use-long-file-name 'not-kill)
10914          ;; Append ".KILL" to newsgroup name.
10915          (expand-file-name (concat newsgroup "." gnus-kill-file-name)
10916                            (or gnus-kill-files-directory "~/News")))
10917         (t
10918          ;; Place "KILL" under the hierarchical directory.
10919          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
10920                                    "/" gnus-kill-file-name)
10921                            (or gnus-kill-files-directory "~/News")))))
10922
10923 \f
10924 ;;;
10925 ;;; Dribble file
10926 ;;;
10927
10928 (defvar gnus-dribble-ignore nil)
10929
10930 (defun gnus-dribble-file-name ()
10931   (concat gnus-startup-file "-dribble"))
10932
10933 (defun gnus-dribble-open ()
10934   (save-excursion 
10935     (set-buffer 
10936      (setq gnus-dribble-buffer (find-file-noselect (gnus-dribble-file-name))))
10937     (buffer-disable-undo (current-buffer))
10938     (bury-buffer gnus-dribble-buffer)
10939     (auto-save-mode t)
10940     (goto-char (point-max))))
10941
10942 (defun gnus-dribble-enter (string)
10943   (if (and (not gnus-dribble-ignore)
10944            gnus-dribble-buffer
10945            (buffer-name gnus-dribble-buffer))
10946       (let ((obuf (current-buffer)))
10947         (set-buffer gnus-dribble-buffer)
10948         (insert string "\n")
10949         (set-window-point (get-buffer-window (current-buffer)) (point-max))
10950         (set-buffer obuf))))
10951
10952 (defun gnus-dribble-read-file ()
10953   (let ((dribble-file (gnus-dribble-file-name)))
10954     (save-excursion 
10955       (set-buffer (setq gnus-dribble-buffer 
10956                         (get-buffer-create 
10957                          (file-name-nondirectory dribble-file))))
10958       (gnus-add-current-to-buffer-list)
10959       (erase-buffer)
10960       (set-visited-file-name dribble-file)
10961       (buffer-disable-undo (current-buffer))
10962       (bury-buffer (current-buffer))
10963       (set-buffer-modified-p nil)
10964       (let ((auto (make-auto-save-file-name))
10965             (gnus-dribble-ignore t))
10966         (if (or (file-exists-p auto) (file-exists-p dribble-file))
10967             (progn
10968               (if (file-newer-than-file-p auto dribble-file)
10969                   (setq dribble-file auto))
10970               (insert-file-contents dribble-file)
10971               (if (not (zerop (buffer-size)))
10972                   (set-buffer-modified-p t))
10973               (if (gnus-y-or-n-p 
10974                    "Auto-save file exists. Do you want to read it? ")
10975                   (progn
10976                     (gnus-message 5 "Reading %s..." dribble-file) 
10977                     (eval-buffer (current-buffer))
10978                     (gnus-message 5 "Reading %s...done" dribble-file)))))))))
10979
10980 (defun gnus-dribble-delete-file ()
10981   (if (file-exists-p (gnus-dribble-file-name))
10982       (delete-file (gnus-dribble-file-name)))
10983   (if gnus-dribble-buffer
10984       (save-excursion
10985         (set-buffer gnus-dribble-buffer)
10986         (let ((auto (make-auto-save-file-name)))
10987           (if (file-exists-p auto)
10988               (delete-file auto))
10989           (erase-buffer)
10990           (set-buffer-modified-p nil)))))
10991
10992 (defun gnus-dribble-save ()
10993   (if (and gnus-dribble-buffer
10994            (buffer-name gnus-dribble-buffer))
10995       (save-excursion
10996         (set-buffer gnus-dribble-buffer)
10997         (save-buffer))))
10998
10999 (defun gnus-dribble-clear ()
11000   (save-excursion
11001     (if (gnus-buffer-exists-p gnus-dribble-buffer)
11002         (progn
11003           (set-buffer gnus-dribble-buffer)
11004           (erase-buffer)
11005           (set-buffer-modified-p nil)
11006           (setq buffer-saved-size (buffer-size))))))
11007
11008 ;;;
11009 ;;; Server Communication
11010 ;;;
11011
11012 ;; All the Gnus backends have the same interface, and should return
11013 ;; data in a similar format. Below is an overview of what functions
11014 ;; these packages must supply and what results they should return.
11015 ;;
11016 ;; Variables:
11017 ;;
11018 ;; `nntp-server-buffer' - All data should be returned to Gnus in this
11019 ;; buffer. 
11020 ;;
11021 ;; Functions for the imaginary backend `choke':
11022 ;;
11023 ;; `choke-retrieve-headers ARTICLES &optional GROUP SERVER'
11024 ;; Should return all headers for all ARTICLES, or return NOV lines for
11025 ;; the same.
11026 ;;
11027 ;; `choke-request-group GROUP &optional SERVER DISCARD'
11028 ;; Switch to GROUP. If DISCARD is nil, active information on the group
11029 ;; must be returned.
11030 ;;
11031 ;; `choke-close-group GROUP &optional SERVER'
11032 ;; Close group. Most backends won't have to do anything with this
11033 ;; call, but it is an opportunity to clean up, if that is needed. It
11034 ;; is called when Gnus exits a group.
11035 ;;
11036 ;; `choke-request-article ARTICLE &optional GROUP SERVER'
11037 ;; Return ARTICLE, which is either an article number or
11038 ;; message-id. Note that not all backends can return articles based on
11039 ;; message-id. 
11040 ;;
11041 ;; `choke-request-list SERVER'
11042 ;; Return a list of all newsgroups on SERVER.
11043 ;;
11044 ;; `choke-request-list-newsgroups SERVER'
11045 ;; Return a list of descriptions of all newsgroups on SERVER.
11046 ;;
11047 ;; `choke-request-newgroups DATE &optional SERVER'
11048 ;; Return a list of all groups that have arrived after DATE on
11049 ;; SERVER. Note that the date doesn't have to be respected - Gnus will
11050 ;; always check whether the groups are old or not. Backends that do
11051 ;; not store date information may just return the entire list of
11052 ;; groups, although this might not be a good idea in general.
11053 ;;
11054 ;; `choke-request-post-buffer METHOD HEADER ARTICLE-BUFFER GROUP INFO'
11055 ;; Should return a buffer that is suitable for "posting". nnspool and
11056 ;; nntp return a `*post-buffer*', and nnmail return a `*mail*'
11057 ;; buffer. This function should fill out the appropriate headers. 
11058 ;;
11059 ;; `choke-request-post &optional SERVER'
11060 ;; Function that will be called from a buffer to be posted. 
11061 ;;
11062 ;; `choke-open-server SERVER &optional ARGUMENT'
11063 ;; Open a connection to SERVER.
11064 ;;
11065 ;; `choke-close-server &optional SERVER'
11066 ;; Close the connection to SERVER.
11067 ;;
11068 ;; `choke-server-opened &optional SERVER'
11069 ;; Whether the conenction to SERVER is opened or not.
11070 ;;
11071 ;; `choke-server-status &optional SERVER'
11072 ;; Should return a status string (not in the nntp buffer, but as the
11073 ;; result of the function).
11074 ;;
11075 ;; `choke-retrieve-groups GROUPS &optional SERVER'
11076 ;; Optional function for retrieving active file info on all groups in
11077 ;; GROUPS.  Two return formats are supported: The normal active file
11078 ;; format, and a list of GROUP lines.  This function should return (as
11079 ;; a function value) either `active' or `group', depending on what
11080 ;; format it returns.
11081 ;;
11082 ;; The following functions are optional and apply only to backends
11083 ;; that are able to control the contents of their groups totally
11084 ;; (ie. mail backends.)  Backends that aren't able to do that
11085 ;; shouldn't define these functions at all. Gnus will check for their
11086 ;; presence before attempting to call them.
11087 ;;
11088 ;; `choke-request-expire-articles ARTICLES &optional NEWSGROUP SERVER'
11089 ;; Should expire (according to some aging scheme) all ARTICLES. Most
11090 ;; backends will not be able to expire articles. Should return a list
11091 ;; of all articles that were not expired.
11092 ;;
11093 ;; `choke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM &optional LAST'
11094 ;; Should move ARTICLE from GROUP on SERVER by using ACCEPT-FORM.
11095 ;; Removes any information it has added to the article (extra headers,
11096 ;; whatever - make it as clean as possible), and then passes the
11097 ;; article on by evaling ACCEPT-FORM, which is normally a call to the
11098 ;; function described below. If the ACCEPT-FORM returns a non-nil
11099 ;; value, the article should then be deleted. If LAST is nil, that
11100 ;; means that there will be further calls to this function. This might
11101 ;; be taken as an advice not to save buffers/internal variables just
11102 ;; yet, but wait until the last call to speed things up.
11103 ;;
11104 ;; `choke-request-accept-article GROUP &optional LAST' 
11105 ;; The contents of the current buffer will be put into GROUP.  There
11106 ;; should, of course, be an article in the current buffer.  This
11107 ;; function is normally only called by the function described above,
11108 ;; and LAST works the same way as in that function.
11109 ;;
11110 ;; `choke-request-replace-article ARTICLE GROUP BUFFER'
11111 ;; Replace ARTICLE in GROUP with the contents of BUFFER.
11112 ;; This provides an easy interface for allowing editing of
11113 ;; articles. Note that even headers may be edited, so the backend has
11114 ;; to update any tables (nov buffers, etc) that it maintains after
11115 ;; replacing the article.
11116 ;;
11117 ;; `choke-request-create-group GROUP &optional SERVER'
11118 ;; Create GROUP on SERVER.  This might be a new, empty group, or it
11119 ;; might be a group that already exists, but hasn't been registered
11120 ;; yet. 
11121 ;;
11122 ;; All these functions must return nil if they couldn't service the
11123 ;; request. If the optional arguments are not supplied, some "current"
11124 ;; or "default" values should be used. In short, one should emulate an
11125 ;; NNTP server, in a way.
11126 ;;
11127 ;; If you want to write a new backend, you just have to supply the
11128 ;; functions listed above. In addition, you must enter the new backend
11129 ;; into the list of valid select methods:
11130 ;; (setq gnus-valid-select-methods 
11131 ;;       (cons '("choke" mail) gnus-valid-select-methods))
11132 ;; The first element in this list is the name of the backend. Other
11133 ;; elemnets may be `mail' (for mail groups),  `post' (for news
11134 ;; groups), `none' (neither), `respool' (for groups that can control
11135 ;; their contents). 
11136
11137 (defun gnus-start-news-server (&optional confirm)
11138   "Open a method for getting news.
11139 If CONFIRM is non-nil, the user will be asked for an NNTP server."
11140   (let (how)
11141     (if gnus-current-select-method
11142         ;; Stream is already opened.
11143         nil
11144       ;; Open NNTP server.
11145       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
11146       (if confirm
11147           (progn
11148             ;; Read server name with completion.
11149             (setq gnus-nntp-server
11150                   (completing-read "NNTP server: "
11151                                    (mapcar (lambda (server) (list server))
11152                                            (cons (list gnus-nntp-server)
11153                                                  gnus-secondary-servers))
11154                                    nil nil gnus-nntp-server))))
11155
11156       (if (and gnus-nntp-server 
11157                (stringp gnus-nntp-server)
11158                (not (string= gnus-nntp-server "")))
11159           (setq gnus-select-method
11160                 (cond ((or (string= gnus-nntp-server "")
11161                            (string= gnus-nntp-server "::"))
11162                        (list 'nnspool (system-name)))
11163                       ((string-match "^:" gnus-nntp-server)
11164                        (list 'nnmh gnus-nntp-server 
11165                              (list 'nnmh-directory 
11166                                    (file-name-as-directory
11167                                     (expand-file-name
11168                                      (concat "~/" (substring
11169                                                    gnus-nntp-server 1)))))
11170                              (list 'nnmh-get-new-mail nil)))
11171                       (t
11172                        (list 'nntp gnus-nntp-server)))))
11173
11174       (setq how (car gnus-select-method))
11175       (cond ((eq how 'nnspool)
11176              (require 'nnspool)
11177              (gnus-message 5 "Looking up local news spool..."))
11178             ((eq how 'nnmh)
11179              (require 'nnmh)
11180              (gnus-message 5 "Looking up mh spool..."))
11181             (t
11182              (require 'nntp)))
11183       (setq gnus-current-select-method gnus-select-method)
11184       (run-hooks 'gnus-open-server-hook)
11185       (or 
11186        ;; gnus-open-server-hook might have opened it
11187        (gnus-server-opened gnus-select-method)  
11188        (gnus-open-server gnus-select-method)
11189        (gnus-y-or-n-p
11190         (format
11191          "%s server on %s can't be opened. Continue? "
11192          (car gnus-select-method) (nth 1 gnus-select-method)))
11193        (progn
11194          (gnus-message 1 "Couldn't open server on %s" 
11195                        (nth 1 gnus-select-method))
11196          (ding)
11197          nil)))))
11198
11199 (defun gnus-check-news-server (&optional method)
11200   "If the news server is down, start it up again."
11201   (let ((method (if method method gnus-select-method)))
11202     (and (stringp method)
11203          (setq method (gnus-server-to-method method)))
11204     (if (gnus-server-opened method)
11205         ;; Stream is already opened.
11206         t
11207       ;; Open server.
11208       (gnus-message 5 "Opening server %s on %s..." (car method) (nth 1 method))
11209       (run-hooks 'gnus-open-server-hook)
11210       (or (gnus-server-opened method)
11211           (gnus-open-server method))
11212       (message ""))))
11213
11214 (defun gnus-nntp-message (&optional message)
11215   "Check the status of the NNTP server.
11216 If the status of the server is clear and MESSAGE is non-nil, MESSAGE
11217 is returned insted of the status string."
11218   (let ((status (gnus-status-message (gnus-find-method-for-group 
11219                                       gnus-newsgroup-name)))
11220         (message (or message "")))
11221     (if (and (stringp status) (> (length status) 0))
11222         status message)))
11223
11224 (defun gnus-get-function (method function)
11225   (and (stringp method)
11226        (setq method (gnus-server-to-method method)))
11227   (let ((func (intern (format "%s-%s" (car method) function))))
11228     (if (not (fboundp func)) 
11229         (progn
11230           (require (car method))
11231           (if (not (fboundp func)) 
11232               (error "No such function: %s" func))))
11233     func))
11234
11235 ;;; Interface functions to the backends.
11236
11237 (defun gnus-open-server (method)
11238   (funcall (gnus-get-function method 'open-server)
11239            (nth 1 method) (nthcdr 2 method)))
11240
11241 (defun gnus-close-server (method)
11242   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
11243
11244 (defun gnus-request-list (method)
11245   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
11246
11247 (defun gnus-request-list-newsgroups (method)
11248   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
11249
11250 (defun gnus-request-newgroups (date method)
11251   (funcall (gnus-get-function method 'request-newgroups) 
11252            date (nth 1 method)))
11253
11254 (defun gnus-server-opened (method)
11255   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
11256
11257 (defun gnus-status-message (method)
11258   (let ((method (if (stringp method) (gnus-find-method-for-group method)
11259                   method)))
11260     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
11261
11262 (defun gnus-request-group (group &optional dont-check)
11263   (let ((method (gnus-find-method-for-group group)))
11264 ;    (and t (message "%s GROUP %s" (car method) group))
11265     (funcall (gnus-get-function method 'request-group) 
11266              (gnus-group-real-name group) (nth 1 method) dont-check)))
11267
11268 (defun gnus-request-asynchronous (group &optional articles)
11269   (let ((method (gnus-find-method-for-group group)))
11270     (funcall (gnus-get-function method 'request-asynchronous) 
11271              (gnus-group-real-name group) (nth 1 method) articles)))
11272
11273 (defun gnus-list-active-group (group)
11274   (let ((method (gnus-find-method-for-group group))
11275         (func 'list-active-group))
11276     (and (gnus-check-backend-function func group)
11277          (funcall (gnus-get-function method func) 
11278                   (gnus-group-real-name group) (nth 1 method)))))
11279
11280 (defun gnus-request-group-description (group)
11281   (let ((method (gnus-find-method-for-group group))
11282         (func 'request-group-description))
11283     (and (gnus-check-backend-function func group)
11284          (funcall (gnus-get-function method func) 
11285                   (gnus-group-real-name group) (nth 1 method)))))
11286
11287 (defun gnus-close-group (group)
11288   (let ((method (gnus-find-method-for-group group)))
11289     (funcall (gnus-get-function method 'close-group) 
11290              (gnus-group-real-name group) (nth 1 method))))
11291
11292 (defun gnus-retrieve-headers (articles group)
11293   (let ((method (gnus-find-method-for-group group)))
11294     (if (and gnus-use-cache (numberp (car articles)))
11295         (gnus-cache-retrieve-headers articles group)
11296       (funcall (gnus-get-function method 'retrieve-headers) 
11297                articles (gnus-group-real-name group) (nth 1 method)))))
11298
11299 (defun gnus-retrieve-groups (groups method)
11300   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
11301
11302 (defun gnus-request-article (article group &optional buffer)
11303   (let ((method (gnus-find-method-for-group group)))
11304     (funcall (gnus-get-function method 'request-article) 
11305              article (gnus-group-real-name group) (nth 1 method) buffer)))
11306
11307 (defun gnus-request-head (article group)
11308   (let ((method (gnus-find-method-for-group group)))
11309     (funcall (gnus-get-function method 'request-head) 
11310              article (gnus-group-real-name group) (nth 1 method))))
11311
11312 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11313 (defun gnus-request-post-buffer (post group subject header artbuf
11314                                       info follow-to respect-poster)
11315    (let* ((info (or info (and group (nth 2 (gnus-gethash 
11316                                             group gnus-newsrc-hashtb)))))
11317           (method
11318            (if (and gnus-post-method
11319                     ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11320                     (memq 'post (assoc
11321                                  (format "%s" (car (gnus-find-method-for-group
11322                                                     gnus-newsgroup-name)))
11323                                         gnus-valid-select-methods)))
11324                gnus-post-method
11325              (gnus-find-method-for-group gnus-newsgroup-name))))
11326      (or (gnus-server-opened method)
11327          (gnus-open-server method)
11328          (error "Can't open server %s:%s" (car method) (nth 1 method)))
11329      (let ((mail-self-blind nil)
11330            (mail-archive-file-name nil))
11331        (funcall (gnus-get-function method 'request-post-buffer) 
11332                 post group subject header artbuf info follow-to
11333                 respect-poster))))
11334
11335 (defun gnus-request-post (method &optional force)
11336   (and (stringp method)
11337        (setq method (gnus-server-to-method method)))
11338   (and (not force) gnus-post-method
11339        (memq 'post (assoc (format "%s" (car method))
11340                           gnus-valid-select-methods))
11341        (setq method gnus-post-method))
11342   (funcall (gnus-get-function method 'request-post) 
11343            (nth 1 method)))
11344
11345 (defun gnus-request-expire-articles (articles group &optional force)
11346   (let ((method (gnus-find-method-for-group group)))
11347     (funcall (gnus-get-function method 'request-expire-articles) 
11348              articles (gnus-group-real-name group) (nth 1 method)
11349              force)))
11350
11351 (defun gnus-request-move-article 
11352   (article group server accept-function &optional last)
11353   (let ((method (gnus-find-method-for-group group)))
11354     (funcall (gnus-get-function method 'request-move-article) 
11355              article (gnus-group-real-name group) 
11356              (nth 1 method) accept-function last)))
11357
11358 (defun gnus-request-accept-article (group &optional last)
11359   (let ((func (if (symbolp group) group
11360                 (car (gnus-find-method-for-group group)))))
11361     (funcall (intern (format "%s-request-accept-article" func))
11362              (if (stringp group) (gnus-group-real-name group) group)
11363              last)))
11364
11365 (defun gnus-request-replace-article (article group buffer)
11366   (let ((func (car (gnus-find-method-for-group group))))
11367     (funcall (intern (format "%s-request-replace-article" func))
11368              article (gnus-group-real-name group) buffer)))
11369
11370 (defun gnus-request-create-group (group)
11371   (let ((method (gnus-find-method-for-group group)))
11372     (funcall (gnus-get-function method 'request-create-group) 
11373              (gnus-group-real-name group) (nth 1 method))))
11374
11375 (defun gnus-member-of-valid (symbol group)
11376   (memq symbol (assoc
11377                 (format "%s" (car (gnus-find-method-for-group group)))
11378                 gnus-valid-select-methods)))
11379
11380 (defsubst gnus-secondary-method-p (method)
11381   (member method gnus-secondary-select-methods))
11382
11383 (defun gnus-find-method-for-group (group &optional info)
11384   (or gnus-override-method
11385       (and (not group)
11386            gnus-select-method)
11387       (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
11388             method)
11389         (if (or (not info)
11390                 (not (setq method (nth 4 info))))
11391             (setq method gnus-select-method)
11392           (setq method
11393                 (cond ((stringp method)
11394                        (gnus-server-to-method method))
11395                       ((stringp (car method))
11396                        (gnus-server-extend-method group method))
11397                       (t
11398                        method))))
11399         (gnus-server-add-address method))))
11400
11401 (defun gnus-check-backend-function (func group)
11402   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
11403                  group)))
11404     (fboundp (intern (format "%s-%s" method func)))))
11405
11406 (defun gnus-methods-using (method)
11407   (let ((valids gnus-valid-select-methods)
11408         outs)
11409     (while valids
11410       (if (memq method (car valids)) 
11411           (setq outs (cons (car valids) outs)))
11412       (setq valids (cdr valids)))
11413     outs))
11414
11415 ;;; 
11416 ;;; Active & Newsrc File Handling
11417 ;;;
11418
11419 ;; Newsrc related functions.
11420 ;; Gnus internal format of gnus-newsrc-alist:
11421 ;; (("alt.general" 3 (1 . 1))
11422 ;;  ("alt.misc"    3 ((1 . 10) (12 . 15)))
11423 ;;  ("alt.test"    7 (1 . 99) (45 57 93)) ...)
11424 ;; The first item is the group name; the second is the subscription
11425 ;; level; the third is either a range of a list of ranges of read
11426 ;; articles, the optional fourth element is a list of marked articles,
11427 ;; the optional fifth element is the select method.
11428 ;;
11429 ;; Gnus internal format of gnus-newsrc-hashtb:
11430 ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...)
11431 ;; This is the entry for "alt.misc". The first element is the number
11432 ;; of unread articles in "alt.misc". The cdr of this entry is the
11433 ;; element *before* "alt.misc" in gnus-newsrc-alist, which makes is
11434 ;; trivial to remove or add new elements into gnus-newsrc-alist
11435 ;; without scanning the entire list. So, to get the actual information
11436 ;; of "alt.misc", you'd say something like 
11437 ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb))
11438 ;;
11439 ;; Gnus internal format of gnus-active-hashtb:
11440 ;; ((1 . 1))
11441 ;;  (5 . 10))
11442 ;;  (67 . 99)) ...)
11443 ;; The only element in each entry in this hash table is a range of
11444 ;; (possibly) available articles. (Articles in this range may have
11445 ;; been expired or canceled.)
11446 ;;
11447 ;; Gnus internal format of gnus-killed-list and gnus-zombie-list:
11448 ;; ("alt.misc" "alt.test" "alt.general" ...)
11449
11450 (defun gnus-setup-news (&optional rawfile level)
11451   "Setup news information.
11452 If RAWFILE is non-nil, the .newsrc file will also be read.
11453 If LEVEL is non-nil, the news will be set up at level LEVEL."
11454   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
11455     ;; Clear some variables to re-initialize news information.
11456     (if init (setq gnus-newsrc-alist nil gnus-active-hashtb nil))
11457
11458     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
11459     (if init (gnus-read-newsrc-file rawfile))
11460
11461     ;; Read the active file and create `gnus-active-hashtb'.
11462     ;; If `gnus-read-active-file' is nil, then we just create an empty
11463     ;; hash table. The partial filling out of the hash table will be
11464     ;; done in `gnus-get-unread-articles'.
11465     (if (and gnus-read-active-file 
11466              (not level))
11467         (gnus-read-active-file)
11468       (setq gnus-active-hashtb (make-vector 4095 0)))
11469
11470     (and init gnus-use-dribble-file (gnus-dribble-read-file))
11471
11472     ;; Find the number of unread articles in each non-dead group.
11473     (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))
11474     ;; Find new newsgroups and treat them.
11475     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
11476              (gnus-server-opened gnus-select-method))
11477         (gnus-find-new-newsgroups))
11478     (if (and init gnus-check-bogus-newsgroups 
11479              gnus-read-active-file (not level)
11480              (gnus-server-opened gnus-select-method))
11481         (gnus-check-bogus-newsgroups))))
11482
11483 (defun gnus-find-new-newsgroups ()
11484   "Search for new newsgroups and add them.
11485 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
11486 The `-n' option line from .newsrc is respected."
11487   (interactive)
11488   (or (gnus-check-first-time-used)
11489       (if (or (consp gnus-check-new-newsgroups)
11490               (eq gnus-check-new-newsgroups 'ask-server))
11491           (gnus-ask-server-for-new-groups)
11492         (let ((groups 0)
11493               group new-newsgroups)
11494           (or gnus-have-read-active-file (gnus-read-active-file))
11495           (setq gnus-newsrc-last-checked-date (current-time-string))
11496           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
11497           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
11498           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
11499           (mapatoms
11500            (lambda (sym)
11501              (setq group (symbol-name sym))
11502              (if (or (gnus-gethash group gnus-killed-hashtb)
11503                      (gnus-gethash group gnus-newsrc-hashtb))
11504                  ()
11505                (let ((do-sub (gnus-matches-options-n group)))
11506                  (cond ((eq do-sub 'subscribe)
11507                         (setq groups (1+ groups))
11508                         (gnus-sethash group group gnus-killed-hashtb)
11509                         (funcall 
11510                          gnus-subscribe-options-newsgroup-method group))
11511                        ((eq do-sub 'ignore)
11512                         nil)
11513                        (t
11514                         (setq groups (1+ groups))
11515                         (gnus-sethash group group gnus-killed-hashtb)
11516                         (if gnus-subscribe-hierarchical-interactive
11517                             (setq new-newsgroups (cons group new-newsgroups))
11518                           (funcall gnus-subscribe-newsgroup-method group)))))))
11519            gnus-active-hashtb)
11520           (if new-newsgroups 
11521               (gnus-subscribe-hierarchical-interactive new-newsgroups))
11522           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
11523           (if (> groups 0)
11524               (gnus-message 6 "%d new newsgroup%s arrived." 
11525                             groups (if (> groups 1) "s have" " has")))))))
11526
11527 (defun gnus-matches-options-n (group)
11528   ;; Returns `subscribe' if the group is to be uncoditionally
11529   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
11530   ;; no match for the group.
11531
11532   ;; First we check the two user variables.
11533   (cond
11534    ((and gnus-options-subscribe
11535          (string-match gnus-options-subscribe group))
11536     'subscribe)
11537    ((and gnus-options-not-subscribe
11538          (string-match gnus-options-not-subscribe group))
11539     'ignore)
11540    ;; Then we go through the list that was retrieved from the .newsrc
11541    ;; file.  This list has elements on the form 
11542    ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list
11543    ;; is in the reverse order of the options line) is returned.
11544    (t
11545     (let ((regs gnus-newsrc-options-n))
11546       (while (and regs
11547                   (not (string-match (car (car regs)) group)))
11548         (setq regs (cdr regs)))
11549       (and regs (cdr (car regs)))))))
11550
11551 (defun gnus-ask-server-for-new-groups ()
11552   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
11553          (methods (cons gnus-select-method 
11554                         (append
11555                          (and (consp gnus-check-new-newsgroups)
11556                               gnus-check-new-newsgroups)
11557                          gnus-secondary-select-methods)))
11558          (groups 0)
11559          (new-date (current-time-string))
11560          hashtb group new-newsgroups got-new)
11561     ;; Go thorugh both primary and secondary select methods and
11562     ;; request new newsgroups.  
11563     (while methods
11564       (and (or (gnus-server-opened (car methods))
11565                (gnus-open-server (car methods)))
11566            (gnus-request-newgroups date (car methods))
11567            (save-excursion
11568              (setq got-new t)
11569              (set-buffer nntp-server-buffer)
11570              (or hashtb (setq hashtb (gnus-make-hashtable 
11571                                       (count-lines (point-min) (point-max)))))
11572              ;; Enter all the new groups in a hashtable.
11573              (gnus-active-to-gnus-format (car methods) hashtb 'ignore)))
11574       (setq methods (cdr methods)))
11575     (and got-new (setq gnus-newsrc-last-checked-date new-date))
11576     ;; Now all new groups from all select methods are in `hashtb'.
11577     (mapatoms
11578      (lambda (group-sym)
11579        (setq group (symbol-name group-sym))
11580        (if (or (gnus-gethash group gnus-newsrc-hashtb)
11581                (member group gnus-zombie-list)
11582                (member group gnus-killed-list))
11583            ;; The group is already known.
11584            ()
11585          (and (symbol-value group-sym)
11586               (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb))
11587          (let ((do-sub (gnus-matches-options-n group)))
11588            (cond ((eq do-sub 'subscribe)
11589                   (setq groups (1+ groups))
11590                   (gnus-sethash group group gnus-killed-hashtb)
11591                   (funcall 
11592                    gnus-subscribe-options-newsgroup-method group))
11593                  ((eq do-sub 'ignore)
11594                   nil)
11595                  (t
11596                   (setq groups (1+ groups))
11597                   (gnus-sethash group group gnus-killed-hashtb)
11598                   (if gnus-subscribe-hierarchical-interactive
11599                       (setq new-newsgroups (cons group new-newsgroups))
11600                     (funcall gnus-subscribe-newsgroup-method group)))))))
11601      hashtb)
11602     (if new-newsgroups 
11603         (gnus-subscribe-hierarchical-interactive new-newsgroups))
11604     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
11605     (if (> groups 0)
11606         (gnus-message 6 "%d new newsgroup%s arrived." 
11607                       groups (if (> groups 1) "s have" " has")))
11608     got-new))
11609
11610 (defun gnus-check-first-time-used ()
11611   (if (or (> (length gnus-newsrc-alist) 1)
11612           (file-exists-p gnus-startup-file)
11613           (file-exists-p (concat gnus-startup-file ".el"))
11614           (file-exists-p (concat gnus-startup-file ".eld")))
11615       nil
11616     (gnus-message 6 "First time user; subscribing you to default groups")
11617     (or gnus-have-read-active-file (gnus-read-active-file))
11618     (setq gnus-newsrc-last-checked-date (current-time-string))
11619     (let ((groups gnus-default-subscribed-newsgroups)
11620           group)
11621       (if (eq groups t)
11622           nil
11623         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
11624         (mapatoms
11625          (lambda (sym)
11626            (setq group (symbol-name sym))
11627            (let ((do-sub (gnus-matches-options-n group)))
11628              (cond ((eq do-sub 'subscribe)
11629                     (gnus-sethash group group gnus-killed-hashtb)
11630                     (funcall 
11631                      gnus-subscribe-options-newsgroup-method group))
11632                    ((eq do-sub 'ignore)
11633                     nil)
11634                    (t
11635                     (setq gnus-killed-list (cons group gnus-killed-list))))))
11636          gnus-active-hashtb)
11637         (while groups
11638           (if (gnus-gethash (car groups) gnus-active-hashtb)
11639               (gnus-group-change-level 
11640                (car groups) gnus-level-default-subscribed gnus-level-killed))
11641           (setq groups (cdr groups)))
11642         (gnus-group-make-help-group)
11643         (and gnus-novice-user
11644              (gnus-message 7 "`A k' to list killed groups"))))))
11645
11646 (defun gnus-subscribe-group (group previous &optional method)
11647   (gnus-group-change-level 
11648    (if method
11649        (list t group gnus-level-default-subscribed nil nil method)
11650      group) 
11651    gnus-level-default-subscribed gnus-level-killed previous t))
11652
11653 ;; `gnus-group-change-level' is the fundamental function for changing
11654 ;; subscription levels of newsgroups. This might mean just changing
11655 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
11656 ;; again, which subscribes/unsubscribes a group, which is equally
11657 ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and
11658 ;; from 8-9 to 1-7 means that you remove the group from the list of
11659 ;; killed (or zombie) groups and add them to the (kinda) subscribed
11660 ;; groups. And last but not least, moving from 8 to 9 and 9 to 8,
11661 ;; which is trivial.
11662 ;; ENTRY can either be a string (newsgroup name) or a list (if
11663 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
11664 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
11665 ;; entries. 
11666 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
11667 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
11668 ;; after. 
11669 (defun gnus-group-change-level (entry level &optional oldlevel
11670                                       previous fromkilled)
11671   (let (group info active num)
11672     ;; Glean what info we can from the arguments
11673     (if (consp entry)
11674         (if fromkilled (setq group (nth 1 entry))
11675           (setq group (car (nth 2 entry))))
11676       (setq group entry))
11677     (if (and (stringp entry)
11678              oldlevel 
11679              (< oldlevel gnus-level-zombie))
11680         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
11681     (if (and (not oldlevel)
11682              (consp entry))
11683         (setq oldlevel (car (cdr (nth 2 entry)))))
11684     (if (stringp previous)
11685         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
11686
11687     (gnus-dribble-enter
11688      (format "(gnus-group-change-level %S %S %S %S %S)" 
11689              group level oldlevel (car (nth 2 previous)) fromkilled))
11690     
11691     ;; Then we remove the newgroup from any old structures, if needed.
11692     ;; If the group was killed, we remove it from the killed or zombie
11693     ;; list. If not, and it is in fact going to be killed, we remove
11694     ;; it from the newsrc hash table and assoc.
11695     (cond ((>= oldlevel gnus-level-zombie)
11696            (if (= oldlevel gnus-level-zombie)
11697                (setq gnus-zombie-list (delete group gnus-zombie-list))
11698              (setq gnus-killed-list (delete group gnus-killed-list))))
11699           (t
11700            (if (>= level gnus-level-zombie)
11701                (progn
11702                  (gnus-sethash (car (nth 2 entry))
11703                                nil gnus-newsrc-hashtb)
11704                  (if (nth 3 entry)
11705                      (setcdr (gnus-gethash (car (nth 3 entry))
11706                                            gnus-newsrc-hashtb)
11707                              (cdr entry)))
11708                  (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
11709
11710     ;; Finally we enter (if needed) the list where it is supposed to
11711     ;; go, and change the subscription level. If it is to be killed,
11712     ;; we enter it into the killed or zombie list.
11713     (cond ((>= level gnus-level-zombie)
11714            ;; Remove from the hash table.
11715            (gnus-sethash group nil gnus-newsrc-hashtb)
11716            (or (gnus-group-foreign-p group)
11717                ;; We do not enter foreign groups into the list of dead
11718                ;; groups.  
11719                (if (= level gnus-level-zombie)
11720                    (setq gnus-zombie-list (cons group gnus-zombie-list))
11721                  (setq gnus-killed-list (cons group gnus-killed-list)))))
11722           (t
11723            ;; If the list is to be entered into the newsrc assoc, and
11724            ;; it was killed, we have to create an entry in the newsrc
11725            ;; hashtb format and fix the pointers in the newsrc assoc.
11726            (if (>= oldlevel gnus-level-zombie)
11727                (progn
11728                  (if (listp entry)
11729                      (progn
11730                        (setq info (cdr entry))
11731                        (setq num (car entry)))
11732                    (setq active (gnus-gethash group gnus-active-hashtb))
11733                    (setq num (if active (- (1+ (cdr active)) (car active)) t))
11734                    ;; Check whether the group is foreign. If so, the
11735                    ;; foreign select method has to be entered into the
11736                    ;; info. 
11737                    (let ((method (gnus-group-method-name group)))
11738                      (if (eq method gnus-select-method)
11739                          (setq info (list group level nil))
11740                        (setq info (list group level nil nil method)))))
11741                  (or previous 
11742                      (setq previous 
11743                            (let ((p gnus-newsrc-alist))
11744                              (while (cdr (cdr p))
11745                                (setq p (cdr p)))
11746                              p)))
11747                  (setq entry (cons info (cdr (cdr previous))))
11748                  (if (cdr previous)
11749                      (progn
11750                        (setcdr (cdr previous) entry)
11751                        (gnus-sethash group (cons num (cdr previous)) 
11752                                      gnus-newsrc-hashtb))
11753                    (setcdr previous entry)
11754                    (gnus-sethash group (cons num previous)
11755                                  gnus-newsrc-hashtb))
11756                  (if (cdr entry)
11757                      (setcdr (gnus-gethash (car (car (cdr entry)))
11758                                            gnus-newsrc-hashtb)
11759                              entry)))
11760              ;; It was alive, and it is going to stay alive, so we
11761              ;; just change the level and don't change any pointers or
11762              ;; hash table entries.
11763              (setcar (cdr (car (cdr (cdr entry)))) level))))))
11764
11765 (defun gnus-kill-newsgroup (newsgroup)
11766   "Obsolete function. Kills a newsgroup."
11767   (gnus-group-change-level
11768    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
11769
11770 (defun gnus-check-bogus-newsgroups (&optional confirm)
11771   "Remove bogus newsgroups.
11772 If CONFIRM is non-nil, the user has to confirm the deletion of every
11773 newsgroup." 
11774   (let ((newsrc (cdr gnus-newsrc-alist))
11775         bogus group entry)
11776     (gnus-message 5 "Checking bogus newsgroups...")
11777     (or gnus-have-read-active-file (gnus-read-active-file))
11778     ;; Find all bogus newsgroup that are subscribed.
11779     (while newsrc
11780       (setq group (car (car newsrc)))
11781       (if (or (gnus-gethash group gnus-active-hashtb) ; Active
11782               (nth 4 (car newsrc))      ; Foreign
11783               (and confirm
11784                    (not (gnus-y-or-n-p
11785                          (format "Remove bogus newsgroup: %s " group)))))
11786           ;; Don't remove.
11787           ()
11788         ;; Found a bogus newsgroup.
11789         (setq bogus (cons group bogus)))
11790       (setq newsrc (cdr newsrc)))
11791     ;; Remove all bogus subscribed groups by first killing them, and
11792     ;; then removing them from the list of killed groups.
11793     (while bogus
11794       (and (setq entry (gnus-gethash (car bogus) gnus-newsrc-hashtb))
11795            (progn
11796              (gnus-group-change-level entry gnus-level-killed)
11797              (setq gnus-killed-list (delete (car bogus) gnus-killed-list))))
11798       (setq bogus (cdr bogus)))
11799     ;; Then we remove all bogus groups from the list of killed and
11800     ;; zombie groups. They are are removed without confirmation.
11801     (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
11802           killed)
11803       (while dead-lists
11804         (setq killed (symbol-value (car dead-lists)))
11805         (while killed
11806           (setq group (car killed))
11807           (or (gnus-gethash group gnus-active-hashtb)
11808               ;; The group is bogus.
11809               (set (car dead-lists)
11810                    (delete group (symbol-value (car dead-lists)))))
11811           (setq killed (cdr killed)))
11812         (setq dead-lists (cdr dead-lists))))
11813     (gnus-message 5 "Checking bogus newsgroups...done")))
11814
11815 (defun gnus-check-duplicate-killed-groups ()
11816   "Remove duplicates from the list of killed groups."
11817   (interactive)
11818   (let ((killed gnus-killed-list))
11819     (while killed
11820       (gnus-message 9 "%d" (length killed))
11821       (setcdr killed (delete (car killed) (cdr killed)))
11822       (setq killed (cdr killed)))))
11823
11824 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
11825 ;; and compute how many unread articles there are in each group.
11826 (defun gnus-get-unread-articles (&optional level) 
11827   (let* ((newsrc (cdr gnus-newsrc-alist))
11828          (level (or level (1+ gnus-level-subscribed)))
11829          (foreign-level
11830           (min 
11831            (cond ((and gnus-activate-foreign-newsgroups 
11832                        (not (numberp gnus-activate-foreign-newsgroups)))
11833                   (1+ gnus-level-subscribed))
11834                  ((numberp gnus-activate-foreign-newsgroups)
11835                   gnus-activate-foreign-newsgroups)
11836                  (t 0))
11837            level))
11838          info group active virtuals method)
11839     (gnus-message 5 "Checking new news...")
11840
11841     (while newsrc
11842       (setq info (car newsrc)
11843             group (car info)
11844             active (gnus-gethash group gnus-active-hashtb))
11845
11846       ;; Check newsgroups. If the user doesn't want to check them, or
11847       ;; they can't be checked (for instance, if the news server can't
11848       ;; be reached) we just set the number of unread articles in this
11849       ;; newsgroup to t. This means that Gnus thinks that there are
11850       ;; unread articles, but it has no idea how many.
11851       (if (and (setq method (nth 4 info))
11852                (not (gnus-server-equal gnus-select-method
11853                                        (gnus-server-get-method nil method)))
11854                (not (gnus-secondary-method-p method)))
11855           ;; These groups are foreign. Check the level.
11856           (if (<= (nth 1 info) foreign-level)
11857               (if (eq (car (if (stringp method) 
11858                                (gnus-server-to-method method)
11859                              (nth 4 info))) 'nnvirtual)
11860                   ;; We have to activate the virtual groups after all
11861                   ;; the others, so we just pop them on a list for
11862                   ;; now. 
11863                   (setq virtuals (cons info virtuals))
11864                 (and (setq active (gnus-activate-newsgroup (car info)))
11865                      ;; Close the groups as we look at them!
11866                      (gnus-close-group group))))
11867                 
11868         ;; These groups are native or secondary. 
11869         (if (and (not gnus-have-read-active-file)
11870                  (<= (nth 1 info) level))
11871             (setq active (gnus-activate-newsgroup (car info)))))
11872       
11873       (if active
11874           (gnus-get-unread-articles-in-group info active)
11875         ;; The group couldn't be reached, so we nix out the number of
11876         ;; unread articles and stuff.
11877         (gnus-sethash group nil gnus-active-hashtb)
11878         (setcar (gnus-gethash group gnus-newsrc-hashtb) t))
11879
11880       (setq newsrc (cdr newsrc)))
11881
11882     ;; Activate the virtual groups. This has to be done after all the
11883     ;; other groups. 
11884     ;; !!! If one virtual group contains another virtual group, even
11885     ;; doing it this way might cause problems.
11886    (while virtuals
11887       (and (setq active (gnus-activate-newsgroup (car (car virtuals))))
11888            (gnus-get-unread-articles-in-group (car virtuals) active))
11889       (setq virtuals (cdr virtuals)))
11890
11891     (gnus-message 5 "Checking new news...done")))
11892
11893 ;; Create a hash table out of the newsrc alist. The `car's of the
11894 ;; alist elements are used as keys.
11895 (defun gnus-make-hashtable-from-newsrc-alist ()
11896   (let ((alist gnus-newsrc-alist)
11897         (ohashtb gnus-newsrc-hashtb)
11898         prev)
11899     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
11900     (setq alist 
11901           (setq prev (setq gnus-newsrc-alist 
11902                            (if (equal (car (car gnus-newsrc-alist))
11903                                       "dummy.group")
11904                                gnus-newsrc-alist
11905                              (cons (list "dummy.group" 0 nil) alist)))))
11906     (while alist
11907       (gnus-sethash (car (car alist)) 
11908                     (cons (and ohashtb (car (gnus-gethash 
11909                                              (car (car alist)) ohashtb))) 
11910                           prev) gnus-newsrc-hashtb)
11911       (setq prev alist
11912             alist (cdr alist)))))
11913
11914 (defun gnus-make-hashtable-from-killed ()
11915   "Create a hash table from the killed and zombie lists."
11916   (let ((lists '(gnus-killed-list gnus-zombie-list))
11917         list)
11918     (setq gnus-killed-hashtb 
11919           (gnus-make-hashtable 
11920            (+ (length gnus-killed-list) (length gnus-zombie-list))))
11921     (while lists
11922       (setq list (symbol-value (car lists)))
11923       (setq lists (cdr lists))
11924       (while list
11925         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
11926         (setq list (cdr list))))))
11927
11928 (defun gnus-get-unread-articles-in-group (info active)
11929   (let* ((range (nth 2 info))
11930          (num 0)
11931          (marked (nth 3 info)))
11932     ;; If a cache is present, we may have to alter the active info.
11933     (and gnus-use-cache
11934          (gnus-cache-possibly-alter-active (car info) active))
11935     ;; Modify the list of read articles according to what articles 
11936     ;; are available; then tally the unread articles and add the
11937     ;; number to the group hash table entry.
11938     (cond ((zerop (cdr active))
11939            (setq num 0))
11940           ((not range)
11941            (setq num (- (1+ (cdr active)) (car active))))
11942           ((not (listp (cdr range)))
11943            ;; Fix a single (num . num) range according to the
11944            ;; active hash table.
11945            ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
11946            (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
11947            (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
11948            ;; Compute number of unread articles.
11949            (setq num (max 0 (- (cdr active) 
11950                                (- (1+ (cdr range)) (car range))))))
11951           (t
11952            ;; The read list is a list of ranges. Fix them according to
11953            ;; the active hash table.
11954            ;; First peel off any elements that are below the lower
11955            ;; active limit. 
11956            (while (and (cdr range) 
11957                        (>= (car active) 
11958                            (or (and (atom (car (cdr range))) (car (cdr range)))
11959                                (car (car (cdr range))))))
11960              (if (numberp (car range))
11961                  (setcar range 
11962                          (cons (car range) 
11963                                (or (and (numberp (car (cdr range)))
11964                                         (car (cdr range))) 
11965                                    (cdr (car (cdr range))))))
11966                (setcdr (car range) 
11967                        (or (and (numberp (nth 1 range)) (nth 1 range))
11968                            (cdr (car (cdr range))))))
11969              (setcdr range (cdr (cdr range))))
11970            ;; Adjust the first element to be the same as the lower limit. 
11971            (if (and (not (atom (car range))) 
11972                     (< (cdr (car range)) (car active)))
11973                (setcdr (car range) (1- (car active))))
11974            ;; Then we want to peel off any elements that are higher
11975            ;; than the upper active limit.  
11976            (let ((srange range))
11977              ;; Go past all legal elements.
11978              (while (and (cdr srange) 
11979                          (<= (or (and (atom (car (cdr srange)))
11980                                       (car (cdr srange)))
11981                                  (car (car (cdr srange)))) (cdr active)))
11982                (setq srange (cdr srange)))
11983              (if (cdr srange)
11984                  ;; Nuke all remaining illegal elements.
11985                  (setcdr srange nil))
11986
11987              ;; Adjust the final element.
11988              (if (and (not (atom (car srange)))
11989                       (> (cdr (car srange)) (cdr active)))
11990                  (setcdr (car srange) (cdr active))))
11991            ;; Compute the number of unread articles.
11992            (while range
11993              (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
11994                                          (cdr (car range))))
11995                                  (or (and (atom (car range)) (car range))
11996                                      (car (car range))))))
11997              (setq range (cdr range)))
11998            (setq num (max 0 (- (cdr active) num)))))
11999     (and info
12000          (progn
12001            (and (assq 'tick marked)
12002                 (inline (gnus-remove-illegal-marked-articles
12003                          (assq 'tick marked) (nth 2 info))))
12004            (and (assq 'dormant marked)
12005                 (inline (gnus-remove-illegal-marked-articles
12006                          (assq 'dormant marked) (nth 2 info))))
12007            (setcar
12008             (gnus-gethash (car info) gnus-newsrc-hashtb) 
12009             (setq num (max 0 (- num (length (cdr (assq 'tick marked)))
12010                                 (length (cdr (assq 'dormant marked)))))))))
12011     num))
12012
12013 (defun gnus-remove-illegal-marked-articles (marked ranges)
12014   (let ((m (cdr marked)))
12015     ;; Make sure that all ticked articles are a subset of the unread
12016     ;; articles. 
12017     (while m
12018       (if (gnus-member-of-range (car m) ranges)
12019           (setcdr marked (cdr m))
12020         (setq marked m))
12021       (setq m (cdr m)))))
12022
12023 (defun gnus-activate-newsgroup (group)
12024   (let ((method (gnus-find-method-for-group group))
12025         active)
12026     (and (or (gnus-server-opened method) (gnus-open-server method))
12027          (gnus-request-group group)
12028          (save-excursion
12029            (set-buffer nntp-server-buffer)
12030            (goto-char (point-min))
12031            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
12032                 (progn
12033                   (goto-char (match-beginning 1))
12034                   (gnus-sethash 
12035                    group (setq active (cons (read (current-buffer))
12036                                             (read (current-buffer))))
12037                    gnus-active-hashtb))
12038                 active)))))
12039
12040 (defun gnus-update-read-articles 
12041   (group unread unselected ticked &optional domarks replied expirable killed
12042          dormant bookmark score)
12043   "Update the list of read and ticked articles in GROUP using the
12044 UNREAD and TICKED lists.
12045 Note: UNSELECTED has to be sorted over `<'.
12046 Returns whether the updating was successful."
12047   (let* ((active (or gnus-newsgroup-active 
12048                      (gnus-gethash group gnus-active-hashtb)))
12049          (entry (gnus-gethash group gnus-newsrc-hashtb))
12050          (info (nth 2 entry))
12051          (marked (nth 3 info))
12052          (prev 1)
12053          (unread (sort (copy-sequence unread) (function <)))
12054          read)
12055     (if (or (not info) (not active))
12056         ;; There is no info on this group if it was, in fact,
12057         ;; killed. Gnus stores no information on killed groups, so
12058         ;; there's nothing to be done. 
12059         ;; One could store the information somewhere temporarily,
12060         ;; perhaps... Hmmm... 
12061         ()
12062       ;; Remove any negative articles numbers.
12063       (while (and unread (< (car unread) 0))
12064         (setq unread (cdr unread)))
12065       ;; Remove any expired article numbers
12066       (while (and unread (< (car unread) (car active)))
12067         (setq unread (cdr unread)))
12068       (while (and ticked (< (car ticked) (car active)))
12069         (setq ticked (cdr ticked)))
12070       (while (and dormant (< (car dormant) (car active)))
12071         (setq dormant (cdr dormant)))
12072       (setq unread (sort (append unselected unread) '<))
12073       ;; Set the number of unread articles in gnus-newsrc-hashtb.
12074       (setcar entry (max 0 (- (length unread) (length ticked) 
12075                               (length dormant))))
12076       ;; Compute the ranges of read articles by looking at the list of
12077       ;; unread articles.  
12078       (while unread
12079         (if (/= (car unread) prev)
12080             (setq read (cons (if (= prev (1- (car unread))) prev
12081                                (cons prev (1- (car unread)))) read)))
12082         (setq prev (1+ (car unread)))
12083         (setq unread (cdr unread)))
12084       (if (<= prev (cdr active))
12085           (setq read (cons (cons prev (cdr active)) read)))
12086       ;; Enter this list into the group info.
12087       (setcar (cdr (cdr info)) 
12088               (if (> (length read) 1) (nreverse read) read))
12089       ;; Enter the list of ticked articles.
12090       (gnus-set-marked-articles 
12091        info ticked
12092        (if domarks replied (cdr (assq 'reply marked)))
12093        (if domarks expirable (cdr (assq 'expire marked)))
12094        (if domarks killed (cdr (assq 'killed marked)))
12095        (if domarks dormant (cdr (assq 'dormant marked)))
12096        (if domarks bookmark (cdr (assq 'bookmark marked)))
12097        (if domarks score (cdr (assq 'score marked))))
12098       t)))
12099
12100 (defun gnus-make-articles-unread (group articles)
12101   "Mark ARTICLES in GROUP as unread."
12102   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
12103                           (gnus-gethash (gnus-group-real-name group)
12104                                         gnus-newsrc-hashtb))))
12105          (ranges (nth 2 info))
12106          news)
12107     (while articles
12108       (and (gnus-member-of-range (car articles) ranges)
12109            (setq news (cons (car articles) news)))
12110       (setq articles (cdr articles)))
12111     (if (not news)
12112         ()
12113       (setcar (nthcdr 2 info)
12114               (gnus-remove-from-range (nth 2 info) (nreverse news)))
12115       (gnus-group-update-group group t))))
12116
12117 ;; Get the active file(s) from the backend(s).
12118 (defun gnus-read-active-file ()
12119   (gnus-group-set-mode-line)
12120   (let ((methods (if (or (gnus-server-opened gnus-select-method)
12121                          (gnus-open-server gnus-select-method))
12122                      ;; The native server is available.
12123                      (cons gnus-select-method gnus-secondary-select-methods)
12124                    ;; The native server is down, so we just do the
12125                    ;; secondary ones.   
12126                    gnus-secondary-select-methods))
12127         list-type)
12128     (setq gnus-have-read-active-file nil)
12129     (save-excursion
12130       (set-buffer nntp-server-buffer)
12131       (while methods
12132         (let* ((where (nth 1 (car methods)))
12133                (mesg (format "Reading active file%s via %s..."
12134                              (if (and where (not (zerop (length where))))
12135                                  (concat " from " where) "")
12136                              (car (car methods)))))
12137           (gnus-message 5 mesg)
12138           (gnus-check-news-server (car methods))
12139           (cond 
12140            ((and (eq gnus-read-active-file 'some)
12141                  (gnus-check-backend-function
12142                   'retrieve-groups (car (car methods))))
12143             (let ((newsrc (cdr gnus-newsrc-alist))
12144                   groups)
12145               (while newsrc
12146                 (and (gnus-server-equal 
12147                       (gnus-find-method-for-group
12148                        (car (car newsrc)) (car newsrc))
12149                       (gnus-server-get-method nil (car methods)))
12150                      (setq groups (cons (car (car newsrc)) groups)))
12151                 (setq newsrc (cdr newsrc)))
12152               (setq list-type (gnus-retrieve-groups groups (car methods)))
12153               (cond ((not list-type)
12154                      (gnus-message 
12155                       1 "Cannot read partial active file from %s server." 
12156                       (car (car methods)))
12157                      (ding)
12158                      (sit-for 2))
12159                     ((eq list-type 'active)
12160                      (gnus-active-to-gnus-format (car methods)))
12161                     (t
12162                      (gnus-groups-to-gnus-format (car methods))))))
12163            (t
12164             (if (not (gnus-request-list (car methods)))
12165                 (progn
12166                   (gnus-message 1 "Cannot read active file from %s server." 
12167                                 (car (car methods)))
12168                   (ding))
12169               (gnus-active-to-gnus-format (car methods))
12170               (setq gnus-have-read-active-file t)
12171               (gnus-message 5 "%sdone" mesg)))))
12172         (setq methods (cdr methods))))))
12173
12174 ;; Read an active file and place the results in `gnus-active-hashtb'.
12175 (defun gnus-active-to-gnus-format (method &optional hashtb ignore-errors)
12176   (let ((cur (current-buffer))
12177         (hashtb (or hashtb 
12178                     (if (and gnus-active-hashtb 
12179                              (not (equal method gnus-select-method)))
12180                         gnus-active-hashtb
12181                       (setq gnus-active-hashtb
12182                             (if (equal method gnus-select-method)
12183                                 (gnus-make-hashtable 
12184                                  (count-lines (point-min) (point-max)))
12185                               (gnus-make-hashtable 4096)))))))
12186     ;; Delete unnecessary lines.
12187     (goto-char (point-min))
12188     (while (search-forward "\nto." nil t)
12189       (delete-region (1+ (match-beginning 0)) 
12190                      (progn (forward-line 1) (point))))
12191     (or (string= gnus-ignored-newsgroups "")
12192         (progn
12193           (goto-char (point-min))
12194           (delete-matching-lines gnus-ignored-newsgroups)))
12195     ;; If these are groups from a foreign select method, we insert the
12196     ;; group prefix in front of the group names. 
12197     (and method (not (eq method gnus-select-method))
12198          (let ((prefix (gnus-group-prefixed-name "" method)))
12199            (goto-char (point-min))
12200            (while (and (not (eobp))
12201                        (progn (insert prefix)
12202                               (zerop (forward-line 1)))))))
12203     (goto-char (point-min))
12204     ;; Store active file in hashtable.
12205     (goto-char (point-min))
12206     (if (string-match "%[oO]" gnus-group-line-format)
12207         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
12208         ;; If we want information on moderated groups, we use this
12209         ;; loop...   
12210         (let* ((mod-hashtb (make-vector 7 0))
12211                (m (intern "m" mod-hashtb))
12212                group max min)
12213           (while (not (eobp))
12214             (condition-case nil
12215                 (progn
12216                   (narrow-to-region (point) (gnus-point-at-eol))
12217                   (setq group (let ((obarray hashtb)) (read cur)))
12218                   (if (and (numberp (setq max (read cur)))
12219                            (numberp (setq min (read cur))))
12220                       (set group (cons min max))
12221                     (set group nil))
12222                   ;; Enter moderated groups into a list.
12223                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
12224                       (setq gnus-moderated-list 
12225                             (cons (symbol-name group) gnus-moderated-list))))
12226               (error nil))
12227             (widen)
12228             (forward-line 1)))
12229       ;; And if we do not care about moderation, we use this loop,
12230       ;; which is faster.
12231       (let (group max min)
12232         (while (not (eobp))
12233           (condition-case ()
12234               (progn
12235                 (narrow-to-region (point) (gnus-point-at-eol))
12236                 ;; group gets set to a symbol interned in the hash table
12237                 ;; (what a hack!!)
12238                 (setq group (let ((obarray hashtb)) (read cur)))
12239                 (if (and (numberp (setq max (read cur)))
12240                          (numberp (setq min (read cur))))
12241                     (set group (cons min max))
12242                   (set group nil)))
12243             (error 
12244              (progn 
12245                (if ignore-errors
12246                    (set group nil)
12247                  (ding) 
12248                  (gnus-message 3 "Warning - illegal active: %s"
12249                                (buffer-substring 
12250                                 (gnus-point-at-bol) (gnus-point-at-eol)))
12251                  nil))))
12252           (widen)
12253           (forward-line 1))))))
12254
12255 (defun gnus-groups-to-gnus-format (method &optional hashtb)
12256   ;; Parse a "groups" active file.
12257   (let ((cur (current-buffer))
12258         (hashtb (or hashtb 
12259                     (if method
12260                         gnus-active-hashtb
12261                       (setq gnus-active-hashtb
12262                             (gnus-make-hashtable 
12263                              (count-lines (point-min) (point-max)))))))
12264         (prefix (and method (not (eq method gnus-select-method))
12265                      (gnus-group-prefixed-name "" method))))
12266
12267     (goto-char (point-min))
12268     (condition-case ()
12269         ;; We split this into to separate loops, one with the prefix
12270         ;; and one without to speed the reading up somewhat.
12271         (if prefix
12272             (let (min max opoint)
12273               (while (not (eobp))
12274                 (read cur) (read cur)
12275                 (setq min (read cur)
12276                       max (read cur)
12277                       opoint (point))
12278                 (skip-chars-forward " \t")
12279                 (insert prefix)
12280                 (goto-char opoint)
12281                 (set (let ((obarray hashtb)) (read cur)) 
12282                      (cons min max))
12283                 (forward-line 1)))
12284           (let (min max)
12285             (while (not (eobp))
12286               (if (= (following-char) ?2)
12287                   (progn
12288                     (read cur) (read cur)
12289                     (setq min (read cur)
12290                           max (read cur))
12291                     (set (let ((obarray hashtb)) (read cur)) 
12292                          (cons min max))))
12293               (forward-line 1))))
12294       (error 
12295        (progn (ding) (gnus-message 3 "Possible error in active file."))))))
12296
12297 (defun gnus-read-newsrc-file (&optional force)
12298   "Read startup file.
12299 If FORCE is non-nil, the .newsrc file is read."
12300   (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
12301   ;; Reset variables that might be defined in the .newsrc.eld file.
12302   (let ((variables gnus-variable-list))
12303     (while variables
12304       (set (car variables) nil)
12305       (setq variables (cdr variables))))
12306   (let* ((newsrc-file gnus-current-startup-file)
12307          (quick-file (concat newsrc-file ".el")))
12308     (save-excursion
12309       ;; We always load the .newsrc.eld file. If always contains
12310       ;; much information that can not be gotten from the .newsrc
12311       ;; file (ticked articles, killed groups, foreign methods, etc.)
12312       (gnus-read-newsrc-el-file quick-file)
12313  
12314       (if (or force
12315               (and (file-newer-than-file-p newsrc-file quick-file)
12316                    (file-newer-than-file-p newsrc-file 
12317                                            (concat quick-file "d")))
12318               (not gnus-newsrc-alist))
12319           ;; We read the .newsrc file. Note that if there if a
12320           ;; .newsrc.eld file exists, it has already been read, and
12321           ;; the `gnus-newsrc-hashtb' has been created. While reading
12322           ;; the .newsrc file, Gnus will only use the information it
12323           ;; can find there for changing the data already read -
12324           ;; ie. reading the .newsrc file will not trash the data
12325           ;; already read (except for read articles).
12326           (save-excursion
12327             (gnus-message 5 "Reading %s..." newsrc-file)
12328             (set-buffer (find-file-noselect newsrc-file))
12329             (buffer-disable-undo (current-buffer))
12330             (gnus-newsrc-to-gnus-format)
12331             (kill-buffer (current-buffer))
12332             (gnus-message 5 "Reading %s...done" newsrc-file))))))
12333
12334 (defun gnus-read-newsrc-el-file (file)
12335   (let ((ding-file (concat file "d")))
12336     ;; We always, always read the .eld file.
12337     (gnus-message 5 "Reading %s..." ding-file)
12338     (let (gnus-newsrc-assoc)
12339       (condition-case nil
12340           (load ding-file t t t)
12341         (error nil))
12342       (and gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))
12343     (let ((inhibit-quit t))
12344       (gnus-uncompress-newsrc-alist))
12345     (gnus-make-hashtable-from-newsrc-alist)
12346     (if (not (file-newer-than-file-p file ding-file))
12347         ()
12348       ;; Old format quick file
12349       (gnus-message 5 "Reading %s..." file)
12350       ;; The .el file is newer than the .eld file, so we read that one
12351       ;; as well. 
12352       (gnus-read-old-newsrc-el-file file))))
12353
12354 ;; Parse the old-style quick startup file
12355 (defun gnus-read-old-newsrc-el-file (file)
12356   (let (newsrc killed marked group m)
12357     (prog1
12358         (let ((gnus-killed-assoc nil)
12359               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
12360           (prog1
12361               (condition-case nil
12362                   (load file t t t)
12363                 (error nil))
12364             (setq newsrc gnus-newsrc-assoc
12365                   killed gnus-killed-assoc
12366                   marked gnus-marked-assoc)))
12367       (setq gnus-newsrc-alist nil)
12368       (while newsrc
12369         (setq group (car newsrc))
12370         (let ((info (nth 2 (gnus-gethash (car group) gnus-newsrc-hashtb))))
12371           (if info
12372               (progn
12373                 (setcar (nthcdr 2 info) (cdr (cdr group)))
12374                 (setcar (cdr info)
12375                         (if (nth 1 group) gnus-level-default-subscribed 
12376                           gnus-level-default-unsubscribed))
12377                 (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
12378             (setq gnus-newsrc-alist
12379                   (cons 
12380                    (setq info
12381                          (list (car group)
12382                                (if (nth 1 group) gnus-level-default-subscribed
12383                                  gnus-level-default-unsubscribed) 
12384                                (cdr (cdr group))))
12385                    gnus-newsrc-alist)))
12386           (if (setq m (assoc (car group) marked))
12387             (setcdr (cdr (cdr info)) (cons (list (cons 'tick (cdr m))) nil))))
12388         (setq newsrc (cdr newsrc)))
12389       (setq newsrc killed)
12390       (while newsrc
12391         (setcar newsrc (car (car newsrc)))
12392         (setq newsrc (cdr newsrc)))
12393       (setq gnus-killed-list killed))
12394     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
12395     (gnus-make-hashtable-from-newsrc-alist)))
12396       
12397 (defun gnus-make-newsrc-file (file)
12398   "Make server dependent file name by catenating FILE and server host name."
12399   (let* ((file (expand-file-name file nil))
12400          (real-file (concat file "-" (nth 1 gnus-select-method))))
12401     (if (file-exists-p real-file)
12402         real-file file)))
12403
12404 (defun gnus-uncompress-newsrc-alist ()
12405   ;; Uncompress all lists of marked articles in the newsrc assoc.
12406   (let ((newsrc gnus-newsrc-alist)
12407         marked)
12408     (while newsrc
12409       (if (not (setq marked (nth 3 (car newsrc))))
12410           ()
12411         (while marked
12412           (or (eq 'score (car (car marked)))
12413               (eq 'bookmark (car (car marked)))
12414               (eq 'killed (car (car marked)))
12415               (setcdr (car marked) (gnus-uncompress-range (cdr (car marked)))))
12416           (setq marked (cdr marked))))
12417       (setq newsrc (cdr newsrc)))))
12418
12419 (defun gnus-compress-newsrc-alist ()
12420   ;; Compress all lists of marked articles in the newsrc assoc.
12421   (let ((newsrc gnus-newsrc-alist)
12422         marked)
12423     (while newsrc
12424       (if (not (setq marked (nth 3 (car newsrc))))
12425           ()
12426         (while marked
12427           (or (eq 'score (car (car marked)))
12428               (eq 'bookmark (car (car marked)))
12429               (eq 'killed (car (car marked)))
12430               (setcdr (car marked) 
12431                       (condition-case ()
12432                           (gnus-compress-sequence 
12433                            (sort (cdr (car marked)) '<) t)
12434                         (error (cdr (car marked))))))
12435           (setq marked (cdr marked))))
12436       (setq newsrc (cdr newsrc)))))
12437
12438 (defun gnus-newsrc-to-gnus-format ()
12439   (setq gnus-newsrc-options "")
12440   (setq gnus-newsrc-options-n nil)
12441
12442   (or gnus-active-hashtb
12443       (setq gnus-active-hashtb (make-vector 4095 0)))
12444   (let ((buf (current-buffer))
12445         (already-read (> (length gnus-newsrc-alist) 1))
12446         group subscribed options-symbol newsrc
12447         symbol reads num1)
12448     (goto-char (point-min))
12449     ;; We intern the symbol `options' in the active hashtb so that we
12450     ;; can `eq' against it later.
12451     (setq options-symbol (intern "options" gnus-active-hashtb))
12452   
12453     (while (not (eobp))
12454       ;; We first read the first word on the line by narrowing and
12455       ;; then reading into `gnus-active-hashtb'.  Most groups will
12456       ;; already exist in that hashtb, so this will save some string
12457       ;; space.
12458       (narrow-to-region
12459        (point)
12460        (progn (skip-chars-forward "^ \t!:\n") (point)))
12461       (goto-char (point-min))
12462       (setq symbol 
12463             (and (/= (point-min) (point-max))
12464                  (let ((obarray gnus-active-hashtb)) (read buf))))
12465       (widen)
12466       ;; Now, the symbol we have read is either `options' or a group
12467       ;; name.  If it is an options line, we just add it to a string. 
12468       (cond 
12469        ((eq symbol options-symbol)
12470         (setq gnus-newsrc-options
12471               ;; This concatting is quite inefficient, but since our
12472               ;; thorough studies show that approx 99.37% of all
12473               ;; .newsrc files only contain a single options line, we
12474               ;; don't give a damn, frankly, my dear.
12475               (concat gnus-newsrc-options
12476                       (buffer-substring 
12477                        (gnus-point-at-bol)
12478                        ;; Options may continue on the next line.
12479                        (or (and (re-search-forward "^[^ \t]" nil 'move)
12480                                 (progn (beginning-of-line) (point)))
12481                            (point))))))
12482        (symbol
12483         ;; It was a group name.
12484         (setq subscribed (= (following-char) ?:)
12485               group (symbol-name symbol)
12486               reads nil)
12487         (if (eolp)
12488             ;; If the line ends here, this is clearly a buggy line, so
12489             ;; we put point a the beginning of line and let the cond
12490             ;; below do the error handling.
12491             (beginning-of-line)
12492           ;; We skip to the beginning of the ranges.
12493           (skip-chars-forward "!: \t"))
12494         ;; We are now at the beginning of the list of read articles.
12495         ;; We read them range by range.
12496         (while
12497             (cond 
12498              ((looking-at "[0-9]+")
12499               ;; We narrow and read a number instead of buffer-substring/
12500               ;; string-to-int because it's faster. narrow/widen is
12501               ;; faster than save-restriction/narrow, and save-restriction
12502               ;; produces a garbage object.
12503               (setq num1 (progn
12504                            (narrow-to-region (match-beginning 0) (match-end 0))
12505                            (read buf)))
12506               (widen)
12507               ;; If the next character is a dash, then this is a range.
12508               (if (= (following-char) ?-)
12509                   (progn
12510                     ;; We read the upper bound of the range.
12511                     (forward-char 1)
12512                     (if (not (looking-at "[0-9]+"))
12513                         ;; This is a buggy line, by we pretend that
12514                         ;; it's kinda OK. Perhaps the user should be
12515                         ;; dinged? 
12516                         (setq reads (cons num1 reads))
12517                       (setq reads 
12518                             (cons 
12519                              (cons num1 (progn
12520                                           (narrow-to-region (match-beginning 0) 
12521                                                             (match-end 0))
12522                                           (read buf)))
12523                              reads))
12524                       (widen)))
12525                 ;; It was just a simple number, so we add it to the
12526                 ;; list of ranges.
12527                 (setq reads (cons num1 reads)))
12528               ;; If the next char in ?\n, then we have reached the end
12529               ;; of the line and return nil.
12530               (/= (following-char) ?\n))
12531              ((= (following-char) ?\n)
12532               ;; End of line, so we end.
12533               nil)
12534              (t
12535               ;; Not numbers and not eol, so this might be a buggy
12536               ;; line... 
12537               (or (eobp) ; If it was eob instead of ?\n, we allow it.
12538                   (progn
12539                     ;; The line was buggy.
12540                     (setq group nil)
12541                     (gnus-message 3 "Mangled line: %s" 
12542                                   (buffer-substring (gnus-point-at-bol) 
12543                                                     (gnus-point-at-eol)))
12544                     (ding)
12545                     (sit-for 1)))
12546               nil))
12547           ;; Skip past ", ". Spaces are illegal in these ranges, but
12548           ;; we allow them, because it's a common mistake to put a
12549           ;; space after the comma.
12550           (skip-chars-forward ", "))
12551
12552         ;; We have already read .newsrc.eld, so we gently update the
12553         ;; data in the hash table with the information we have just
12554         ;; read. 
12555         (if (not group)
12556             ()
12557           (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
12558                 level)
12559             (if info
12560                 ;; There is an entry for this file in the alist.
12561                 (progn
12562                   (setcar (nthcdr 2 info) (nreverse reads))
12563                   ;; We update the level very gently.  In fact, we
12564                   ;; only change it if there's been a status change
12565                   ;; from subscribed to unsubscribed, or vice versa.
12566                   (setq level (nth 1 info))
12567                   (cond ((and (<= level gnus-level-subscribed)
12568                               (not subscribed))
12569                          (setq level (if reads
12570                                          gnus-level-default-unsubscribed 
12571                                        (1+ gnus-level-default-unsubscribed))))
12572                         ((and (> level gnus-level-subscribed) subscribed)
12573                          (setq level gnus-level-default-subscribed)))
12574                   (setcar (cdr info) level))
12575               ;; This is a new group.
12576               (setq info (list group 
12577                                (if subscribed
12578                                    gnus-level-default-subscribed 
12579                                  (if reads
12580                                      (1+ gnus-level-subscribed)
12581                                    gnus-level-default-unsubscribed))
12582                                (nreverse reads))))
12583             (setq newsrc (cons info newsrc))))))
12584       (forward-line 1))
12585     
12586     (setq newsrc (nreverse newsrc))
12587
12588     (if (not already-read)
12589         ()
12590       ;; We now have two newsrc lists - `newsrc', which is what we
12591       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
12592       ;; what we've read from .newsrc.eld. We have to merge these
12593       ;; lists. We do this by "attaching" any (foreign) groups in the
12594       ;; gnus-newsrc-alist to the (native) group that precedes them. 
12595       (let ((rc (cdr gnus-newsrc-alist))
12596             (prev gnus-newsrc-alist)
12597             entry mentry)
12598         (while rc
12599           (or (null (nth 4 (car rc))) ; It's a native group.
12600               (assoc (car (car rc)) newsrc) ; It's already in the alist.
12601               (if (setq entry (assoc (car (car prev)) newsrc))
12602                   (setcdr (setq mentry (memq entry newsrc))
12603                           (cons (car rc) (cdr mentry)))
12604                 (setq newsrc (cons (car rc) newsrc))))
12605           (setq prev rc
12606                 rc (cdr rc)))))
12607
12608     (setq gnus-newsrc-alist newsrc)
12609     ;; We make the newsrc hashtb.
12610     (gnus-make-hashtable-from-newsrc-alist)
12611
12612     ;; Finally, if we read some options lines, we parse them.
12613     (or (string= gnus-newsrc-options "")
12614         (gnus-newsrc-parse-options gnus-newsrc-options))))
12615
12616 ;; Parse options lines to find "options -n !all rec.all" and stuff.
12617 ;; The return value will be a list on the form
12618 ;; ((regexp1 . ignore)
12619 ;;  (regexp2 . subscribe)...)
12620 ;; When handling new newsgroups, groups that match a `ignore' regexp
12621 ;; will be ignored, and groups that match a `subscribe' regexp will be
12622 ;; subscribed. A line like
12623 ;; options -n !all rec.all
12624 ;; will lead to a list that looks like
12625 ;; (("^rec\\..+" . subscribe) 
12626 ;;  ("^.+" . ignore))
12627 ;; So all "rec.*" groups will be subscribed, while all the other
12628 ;; groups will be ignored. Note that "options -n !all rec.all" is very
12629 ;; different from "options -n rec.all !all". 
12630 (defun gnus-newsrc-parse-options (options)
12631   (let (out eol)
12632     (save-excursion
12633       (gnus-set-work-buffer)
12634       (insert (regexp-quote options))
12635       ;; First we treat all continuation lines.
12636       (goto-char (point-min))
12637       (while (re-search-forward "\n[ \t]+" nil t)
12638         (replace-match " " t t))
12639       ;; Then we transform all "all"s into ".+"s.
12640       (goto-char (point-min))
12641       (while (re-search-forward "\\ball\\b" nil t)
12642         (replace-match ".+" t t))
12643       (goto-char (point-min))
12644       ;; We remove all other options than the "-n" ones.
12645       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
12646         (replace-match " ")
12647         (forward-char -1))
12648       (goto-char (point-min))
12649
12650       ;; We are only interested in "options -n" lines - we
12651       ;; ignore the other option lines.
12652       (while (re-search-forward "[ \t]-n" nil t)
12653         (setq eol 
12654               (or (save-excursion
12655                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
12656                          (- (point) 2)))
12657                   (gnus-point-at-eol)))
12658         ;; Search for all "words"...
12659         (while (re-search-forward "[^ \t,\n]+" eol t)
12660           (if (= (char-after (match-beginning 0)) ?!)
12661               ;; If the word begins with a bang (!), this is a "not"
12662               ;; spec. We put this spec (minus the bang) and the
12663               ;; symbol `ignore' into the list.
12664               (setq out (cons (cons (concat 
12665                                      "^" (buffer-substring 
12666                                           (1+ (match-beginning 0))
12667                                           (match-end 0)))
12668                                     'ignore) out))
12669             ;; There was no bang, so this is a "yes" spec.
12670             (setq out (cons (cons (concat 
12671                                    "^" (buffer-substring (match-beginning 0)
12672                                                          (match-end 0)))
12673                                   'subscribe) out)))))
12674     
12675       (setq gnus-newsrc-options-n out))))
12676                
12677
12678 (defun gnus-save-newsrc-file ()
12679   "Save .newsrc file."
12680   ;; Note: We cannot save .newsrc file if all newsgroups are removed
12681   ;; from the variable gnus-newsrc-alist.
12682   (and (or gnus-newsrc-alist gnus-killed-list)
12683        gnus-current-startup-file
12684        (let ((make-backup-files t)
12685              (version-control nil)
12686              (require-final-newline t)) ;Don't ask even if requested.
12687          ;; You can stop or change version control of backup file.
12688          ;; Suggested by jason@violet.berkeley.edu.
12689          (run-hooks 'gnus-save-newsrc-hook)
12690          (save-excursion
12691            (if (or (not gnus-dribble-buffer)
12692                    (not (buffer-name gnus-dribble-buffer))
12693                    (zerop (save-excursion
12694                             (set-buffer gnus-dribble-buffer)
12695                             (buffer-size))))
12696                (gnus-message 4 "(No changes need to be saved)")
12697              (if gnus-save-newsrc-file
12698                  (progn
12699                    (gnus-message 5 "Saving %s..." gnus-current-startup-file)
12700                    ;; Make backup file of master newsrc.
12701                    (gnus-gnus-to-newsrc-format)
12702                    (gnus-message 5 "Saving %s...done"
12703                                  gnus-current-startup-file)))
12704              ;; Quickly loadable .newsrc.
12705              (set-buffer (get-buffer-create " *Gnus-newsrc*"))
12706              (gnus-add-current-to-buffer-list)
12707              (buffer-disable-undo (current-buffer))
12708              (erase-buffer)
12709              (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
12710              (gnus-gnus-to-quick-newsrc-format)
12711              (write-region 1 (point-max) 
12712                            (concat gnus-current-startup-file ".eld") 
12713                            nil 'nomesg)
12714              (kill-buffer (current-buffer))
12715              (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)
12716              (gnus-dribble-delete-file))))))
12717
12718 (defun gnus-gnus-to-quick-newsrc-format ()
12719   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
12720   (insert ";; (ding) Gnus startup file.\n")
12721   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
12722   (insert ";; to read .newsrc.\n")
12723   (let ((variables gnus-variable-list)
12724         (inhibit-quit t)
12725         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
12726         variable)
12727     ;; insert lisp expressions.
12728     (gnus-compress-newsrc-alist)
12729     (while variables
12730       (setq variable (car variables))
12731       (and (boundp variable)
12732            (symbol-value variable)
12733            (or gnus-save-killed-list (not (eq variable 'gnus-killed-list)))
12734            (insert "(setq " (symbol-name variable) " '"
12735                    (prin1-to-string (symbol-value variable))
12736                    ")\n"))
12737       (setq variables (cdr variables)))
12738     (gnus-uncompress-newsrc-alist)))
12739
12740
12741 (defun gnus-gnus-to-newsrc-format ()
12742   ;; Generate and save the .newsrc file.
12743   (let ((newsrc (cdr gnus-newsrc-alist))
12744         info ranges range)
12745     (save-excursion
12746       (set-buffer (create-file-buffer gnus-startup-file))
12747       (buffer-disable-undo (current-buffer))
12748       (erase-buffer)
12749       ;; Write options.
12750       (if gnus-newsrc-options (insert gnus-newsrc-options))
12751       ;; Write subscribed and unsubscribed.
12752       (while newsrc
12753         (setq info (car newsrc))
12754         (if (not (nth 4 info))          ;Don't write foreign groups to .newsrc.
12755             (progn
12756               (insert (car info) (if (> (nth 1 info) gnus-level-subscribed)
12757                                      "!" ":"))
12758               (if (setq ranges (nth 2 info))
12759                   (progn
12760                     (insert " ")
12761                     (if (not (listp (cdr ranges)))
12762                         (if (= (car ranges) (cdr ranges))
12763                             (insert (int-to-string (car ranges)))
12764                           (insert (int-to-string (car ranges)) "-" 
12765                                   (int-to-string (cdr ranges))))
12766                       (while ranges
12767                         (setq range (car ranges)
12768                               ranges (cdr ranges))
12769                         (if (or (atom range) (= (car range) (cdr range)))
12770                             (insert (int-to-string 
12771                                      (or (and (atom range) range) 
12772                                          (car range))))
12773                           (insert (int-to-string (car range)) "-"
12774                                   (int-to-string (cdr range))))
12775                         (if ranges (insert ","))))))
12776               (insert "\n")))
12777         (setq newsrc (cdr newsrc)))
12778       (write-region 1 (point-max) gnus-current-startup-file nil 'nomesg)
12779       (kill-buffer (current-buffer)))))
12780
12781 (defun gnus-read-all-descriptions-files ()
12782   (let ((methods (nconc (list gnus-select-method) 
12783                         gnus-secondary-select-methods)))
12784     (while methods
12785       (gnus-read-descriptions-file (car methods))
12786       (setq methods (cdr methods)))
12787     t))
12788
12789 (defun gnus-read-descriptions-file (&optional method)
12790   (let ((method (or method gnus-select-method)))
12791     ;; We create the hashtable whether we manage to read the desc file
12792     ;; to avoid trying to re-read after a failed read.
12793     (or gnus-description-hashtb
12794         (setq gnus-description-hashtb 
12795               (gnus-make-hashtable (length gnus-active-hashtb))))
12796     ;; Mark this method's desc file as read.
12797     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
12798                   gnus-description-hashtb)
12799
12800     (gnus-message 5 "Reading descriptions file via %s..." (car method))
12801     (cond 
12802      ((not (or (gnus-server-opened method)
12803                (gnus-open-server method)))
12804       (gnus-message 1 "Couldn't open server")
12805       nil)
12806      ((not (gnus-request-list-newsgroups method))
12807       (gnus-message 1 "Couldn't read newsgroups descriptions")
12808       nil)
12809      (t
12810       (let (group)
12811         (save-excursion
12812           (save-restriction
12813             (set-buffer nntp-server-buffer)
12814             (goto-char (point-min))
12815             (if (or (search-forward "\n.\n" nil t)
12816                     (goto-char (point-max)))
12817                 (progn
12818                   (beginning-of-line)
12819                   (narrow-to-region (point-min) (point))))
12820             (goto-char (point-min))
12821             (while (not (eobp))
12822               ;; If we get an error, we set group to 0, which is not a
12823               ;; symbol... 
12824               (setq group 
12825                     (condition-case ()
12826                         (let ((obarray gnus-description-hashtb))
12827                           ;; Group is set to a symbol interned in this
12828                           ;; hash table.
12829                           (read nntp-server-buffer))
12830                       (error 0)))
12831               (skip-chars-forward " \t")
12832               ;; ... which leads to this line being effectively ignored.
12833               (and (symbolp group)
12834                    (set group (buffer-substring 
12835                                (point) (progn (end-of-line) (point)))))
12836               (forward-line 1))))
12837         (gnus-message 5 "Reading descriptions file...done")
12838         t)))))
12839
12840 (defun gnus-group-get-description (group)
12841   ;; Get the description of a group by sending XGTITLE to the server.
12842   (and (gnus-request-group-description group)
12843        (save-excursion
12844          (set-buffer nntp-server-buffer)
12845          (goto-char (point-min))
12846          (and (looking-at "[^ \t]+[ \t]+\\(.*\\)")
12847               (buffer-substring (match-beginning 1) (match-end 1))))))
12848
12849 ;;;
12850 ;;; Server
12851 ;;;
12852
12853 (defvar gnus-server-mode-hook nil
12854   "Hook run in `gnus-server-mode' buffers.")
12855
12856 (defconst gnus-server-line-format "     {%(%h:%w%)}\n"
12857   "Format of server lines.
12858 It works along the same lines as a normal formatting string,
12859 with some simple extensions.")
12860
12861 (defvar gnus-server-mode-line-format "(ding) List of servers"
12862   "The format specification for the server mode line.")
12863
12864 (defconst gnus-server-line-format-alist
12865   (list (list ?h 'how ?s)
12866         (list ?n 'name ?s)
12867         (list ?w 'where ?s)
12868         ))
12869
12870 (defconst gnus-server-mode-line-format-alist 
12871   (list (list ?S 'news-server ?s)
12872         (list ?M 'news-method ?s)
12873         (list ?u 'user-defined ?s)))
12874
12875 (defvar gnus-server-line-format-spec nil)
12876 (defvar gnus-server-mode-line-format-spec nil)
12877 (defvar gnus-server-killed-servers nil)
12878
12879 (defvar gnus-server-mode-map nil)
12880 (put 'gnus-server-mode 'mode-class 'special)
12881
12882 (if gnus-server-mode-map
12883     nil
12884   (setq gnus-server-mode-map (make-sparse-keymap))
12885   (suppress-keymap gnus-server-mode-map)
12886   (define-key gnus-server-mode-map " " 'gnus-server-read-server)
12887   (define-key gnus-server-mode-map "\r" 'gnus-server-read-server)
12888   (define-key gnus-server-mode-map gnus-mouse-2 'gnus-server-pick-server)
12889   (define-key gnus-server-mode-map "q" 'gnus-server-exit)
12890   (define-key gnus-server-mode-map "l" 'gnus-server-list-servers)
12891   (define-key gnus-server-mode-map "k" 'gnus-server-kill-server)
12892   (define-key gnus-server-mode-map "y" 'gnus-server-yank-server)
12893   (define-key gnus-server-mode-map "c" 'gnus-server-copy-server)
12894   (define-key gnus-server-mode-map "a" 'gnus-server-add-server)
12895   (define-key gnus-server-mode-map "e" 'gnus-server-edit-server))
12896
12897 (defun gnus-server-mode ()
12898   "Major mode for listing and editing servers.
12899
12900 All normal editing commands are switched off.
12901 \\<gnus-server-mode-map>
12902
12903 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). 
12904
12905 The following commands are available:
12906
12907 \\{gnus-server-mode-map}"
12908   (interactive)
12909   (if gnus-visual (gnus-server-make-menu-bar))
12910   (kill-all-local-variables)
12911   (setq mode-line-modified "-- ")
12912   (make-local-variable 'mode-line-format)
12913   (setq mode-line-format (copy-sequence mode-line-format))
12914   (and (equal (nth 3 mode-line-format) "   ")
12915        (setcar (nthcdr 3 mode-line-format) ""))
12916   (setq major-mode 'gnus-server-mode)
12917   (setq mode-name "Server")
12918 ;  (gnus-group-set-mode-line)
12919   (setq mode-line-process nil)
12920   (use-local-map gnus-server-mode-map)
12921   (buffer-disable-undo (current-buffer))
12922   (setq truncate-lines t)
12923   (setq buffer-read-only t)
12924   (run-hooks 'gnus-server-mode-hook))
12925
12926 (defun gnus-server-insert-server-line (sformat name method)
12927   (let* ((sformat (or sformat gnus-server-line-format-spec))
12928          (how (car method))
12929          (where (nth 1 method))
12930          b)
12931     (beginning-of-line)
12932     (setq b (point))
12933     ;; Insert the text.
12934     (insert (eval sformat))
12935     (add-text-properties b (1+ b) (list 'gnus-server (intern name)))))
12936
12937 (defun gnus-server-setup-buffer ()
12938   (if (get-buffer gnus-server-buffer)
12939       ()
12940     (save-excursion
12941       (set-buffer (get-buffer-create gnus-server-buffer))
12942       (gnus-server-mode)
12943       (and gnus-carpal (gnus-carpal-setup-buffer 'server)))))
12944
12945 (defun gnus-server-prepare ()
12946   (setq gnus-server-mode-line-format-spec 
12947         (gnus-parse-format gnus-server-mode-line-format 
12948                            gnus-server-mode-line-format-alist))
12949   (setq gnus-server-line-format-spec 
12950         (gnus-parse-format gnus-server-line-format 
12951                            gnus-server-line-format-alist))
12952   (let ((alist gnus-server-alist)
12953         (buffer-read-only nil))
12954     (erase-buffer)
12955     (while alist
12956       (gnus-server-insert-server-line nil (car (car alist)) (cdr (car alist)))
12957       (setq alist (cdr alist))))
12958   (goto-char (point-min))
12959   (gnus-server-position-cursor))
12960
12961 (defun gnus-server-server-name ()
12962   (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server)))
12963     (and server (symbol-name server))))
12964
12965 (defalias 'gnus-server-position-cursor 'gnus-goto-colon)
12966
12967 (defconst gnus-server-edit-buffer "*Gnus edit server*")
12968
12969 (defun gnus-server-update-server (server)
12970   (save-excursion
12971     (set-buffer gnus-server-buffer)
12972     (let ((buffer-read-only nil)
12973           (info (cdr (assoc server gnus-server-alist))))
12974       (gnus-dribble-enter 
12975        (concat "(gnus-server-set-info \"" server "\" '"
12976                (prin1-to-string info) ")"))
12977       ;; Buffer may be narrowed.
12978       (save-restriction
12979         (widen)
12980         (if (gnus-server-goto-server server)
12981             (delete-region (progn (beginning-of-line) (point))
12982                            (progn (forward-line 1) (point))))
12983         (let ((entry (assoc server gnus-server-alist)))
12984           (gnus-server-insert-server-line nil (car entry) (cdr entry))
12985           (gnus-server-position-cursor))))))
12986
12987 (defun gnus-server-set-info (server info)
12988   ;; Enter a select method into the virtual server alist.
12989   (gnus-dribble-enter 
12990    (concat "(gnus-server-set-info \"" server "\" '"
12991            (prin1-to-string info) ")"))
12992   (let* ((server (nth 1 info))
12993          (entry (assoc server gnus-server-alist)))
12994     (if entry (setcdr entry info)
12995       (setq gnus-server-alist
12996             (nconc gnus-server-alist (list (cons server info)))))))
12997
12998 (defun gnus-server-to-method (server)
12999   ;; Map virtual server names to select methods.
13000   (or (and (equal server "native") gnus-select-method)
13001       (cdr (assoc server gnus-server-alist))))
13002
13003 (defun gnus-server-extend-method (group method)
13004   ;; This function "extends" a virtual server.  If the server is
13005   ;; "hello", and the select method is ("hello" (my-var "something")) 
13006   ;; in the group "alt.alt", this will result in a new virtual server
13007   ;; called "helly+alt.alt".
13008   (let ((entry
13009          (gnus-copy-sequence 
13010           (if (equal (car method) "native") gnus-select-method
13011               (cdr (assoc (car method) gnus-server-alist))))))
13012     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
13013     (nconc entry (cdr method))))
13014
13015 (defun gnus-server-get-method (group method)
13016   ;; Input either a server name, and extended server name, or a
13017   ;; select method, and return a select method. 
13018   (cond ((stringp method)
13019          (gnus-server-to-method method))
13020         ((stringp (car method))
13021          (gnus-server-extend-method group method))
13022         (t
13023          (gnus-server-add-address method))))
13024
13025 (defun gnus-server-add-address (method)
13026   (let ((method-name (symbol-name (car method))))
13027     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
13028              (not (assq (intern (concat method-name "-address")) method)))
13029         (append method (list (list (intern (concat method-name "-address"))
13030                                    (nth 1 method))))
13031       method)))
13032
13033 (defun gnus-server-equal (s1 s2)
13034   (or (equal s1 s2)
13035       (and (= (length s1) (length s2))
13036            (progn
13037              (while (and s1 (member (car s1) s2))
13038                (setq s1 (cdr s1)))
13039              (null s1)))))
13040
13041 ;;; Interactive server functions.
13042
13043 (defun gnus-server-kill-server (server)
13044   "Kill the server on the current line."
13045   (interactive (list (gnus-server-server-name)))
13046   (or (gnus-server-goto-server server)
13047       (if server (error "No such server: %s" server)
13048         (error "No server on the current line")))
13049   (let ((buffer-read-only nil))
13050     (delete-region (progn (beginning-of-line) (point))
13051                    (progn (forward-line 1) (point))))
13052   (setq gnus-server-killed-servers 
13053         (cons (assoc server gnus-server-alist) gnus-server-killed-servers))
13054   (setq gnus-server-alist (delq (car gnus-server-killed-servers)
13055                                 gnus-server-alist))
13056   (gnus-server-position-cursor))
13057
13058 (defun gnus-server-yank-server ()
13059   "Yank the previously killed server."
13060   (interactive)
13061   (or gnus-server-killed-servers
13062       (error "No killed servers to be yanked"))
13063   (let ((alist gnus-server-alist)
13064         (server (gnus-server-server-name))
13065         (killed (car gnus-server-killed-servers)))
13066     (if (not server) 
13067         (setq gnus-server-alist (nconc gnus-server-alist (list killed)))
13068       (if (string= server (car (car gnus-server-alist)))
13069           (setq gnus-server-alist (cons killed gnus-server-alist))
13070         (while (and (cdr alist)
13071                     (not (string= server (car (car (cdr alist))))))
13072           (setq alist (cdr alist)))
13073         (setcdr alist (cons killed (cdr alist)))))
13074     (gnus-server-update-server (car killed))
13075     (setq gnus-server-killed-servers (cdr gnus-server-killed-servers))
13076     (gnus-server-position-cursor)))
13077
13078 (defun gnus-server-exit ()
13079   "Return to the group buffer."
13080   (interactive)
13081   (kill-buffer (current-buffer))
13082   (switch-to-buffer gnus-group-buffer))
13083
13084 (defun gnus-server-list-servers ()
13085   "List all available servers."
13086   (interactive)
13087   (let ((cur (gnus-server-server-name)))
13088     (gnus-server-prepare)
13089     (if cur (gnus-server-goto-server cur)
13090       (goto-char (point-max))
13091       (forward-line -1))
13092     (gnus-server-position-cursor)))
13093
13094 (defun gnus-server-copy-server (from to)
13095   (interactive
13096    (list
13097     (or (gnus-server-server-name)
13098         (error "No server on the current line"))
13099     (read-string "Copy to: ")))
13100   (or from (error "No server on current line"))
13101   (or (and to (not (string= to ""))) (error "No name to copy to"))
13102   (and (assoc to gnus-server-alist) (error "%s already exists" to))
13103   (or (assoc from gnus-server-alist) 
13104       (error "%s: no such server" from))
13105   (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist))))
13106     (setcar to-entry to)
13107     (setcar (nthcdr 2 to-entry) to)
13108     (setq gnus-server-killed-servers 
13109           (cons to-entry gnus-server-killed-servers))
13110     (gnus-server-yank-server)))
13111
13112 (defun gnus-server-add-server (how where)
13113   (interactive 
13114    (list (intern (completing-read "Server method: "
13115                                   gnus-valid-select-methods nil t))
13116          (read-string "Server name: ")))
13117   (setq gnus-server-killed-servers 
13118         (cons (list where how where) gnus-server-killed-servers))
13119   (gnus-server-yank-server))
13120
13121 (defun gnus-server-goto-server (server)
13122   "Jump to a server line."
13123   (interactive
13124    (list (completing-read "Goto server: " gnus-server-alist nil t)))
13125   (let ((to (text-property-any (point-min) (point-max) 
13126                                'gnus-server (intern server))))
13127     (and to
13128          (progn
13129            (goto-char to) 
13130            (gnus-server-position-cursor)))))
13131
13132 (defun gnus-server-edit-server (server)
13133   "Edit the server on the current line."
13134   (interactive (list (gnus-server-server-name)))
13135   (or server
13136       (error "No server on current line"))
13137   (let ((winconf (current-window-configuration)))
13138     (get-buffer-create gnus-server-edit-buffer)
13139     (gnus-configure-windows 'edit-server)
13140     (gnus-add-current-to-buffer-list)
13141     (emacs-lisp-mode)
13142     (make-local-variable 'gnus-prev-winconf)
13143     (setq gnus-prev-winconf winconf)
13144     (use-local-map (copy-keymap (current-local-map)))
13145     (let ((done-func '(lambda () 
13146                         "Exit editing mode and update the information."
13147                         (interactive)
13148                         (gnus-server-edit-server-done 'group))))
13149       (setcar (cdr (nth 4 done-func)) server)
13150       (local-set-key "\C-c\C-c" done-func))
13151     (erase-buffer)
13152     (insert ";; Type `C-c C-c' after you have edited the server.\n\n")
13153     (insert (pp-to-string (cdr (assoc server gnus-server-alist))))))
13154
13155 (defun gnus-server-edit-server-done (server)
13156   (interactive)
13157   (set-buffer (get-buffer-create gnus-server-edit-buffer))
13158   (goto-char (point-min))
13159   (let ((form (read (current-buffer)))
13160         (winconf gnus-prev-winconf))
13161     (gnus-server-set-info server form)
13162     (kill-buffer (current-buffer))
13163     (and winconf (set-window-configuration winconf))
13164     (set-buffer gnus-server-buffer)
13165     (gnus-server-update-server (gnus-server-server-name))
13166     (gnus-server-position-cursor)))
13167
13168 (defun gnus-server-read-server (server)
13169   "Browse a server."
13170   (interactive (list (gnus-server-server-name)))
13171   (gnus-browse-foreign-server (gnus-server-to-method server) (current-buffer)))
13172
13173 (defun gnus-mouse-pick-server (e)
13174   (interactive "e")
13175   (mouse-set-point e)
13176   (gnus-server-read-server (gnus-server-server-name)))
13177
13178 ;;;
13179 ;;; entry points into gnus-score.el
13180 ;;;
13181
13182 ;;; Finding score files. 
13183
13184 (defvar gnus-global-score-files nil
13185   "*List of global score files and directories.
13186 Set this variable if you want to use people's score files.  One entry
13187 for each score file or each score file directory.  Gnus will decide
13188 by itself what score files are applicable to which group.
13189
13190 Say you want to use the single score file
13191 \"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
13192 score files in the \"/ftp.some-where:/pub/score\" directory.
13193
13194  (setq gnus-global-score-files
13195        '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
13196          \"/ftp.some-where:/pub/score\"))")
13197
13198 (defun gnus-score-score-files (group)
13199   "Return a list of all possible score files."
13200   ;; Search and set any global score files.
13201   (and gnus-global-score-files 
13202        (or gnus-internal-global-score-files
13203            (gnus-score-search-global-directories gnus-global-score-files)))
13204   ;; Fix the kill-file dir variable.
13205   (setq gnus-kill-files-directory 
13206         (file-name-as-directory
13207          (or gnus-kill-files-directory "~/News/")))
13208   ;; If we can't read it, there are no score files.
13209   (if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
13210       (setq gnus-score-file-list nil)
13211     (if (gnus-use-long-file-name 'not-score)
13212         ;; We want long file names.
13213         (if (or (not gnus-score-file-list)
13214                 (not (car gnus-score-file-list))
13215                 (gnus-file-newer-than gnus-kill-files-directory
13216                                       (car gnus-score-file-list)))
13217               (setq gnus-score-file-list 
13218                     (cons (nth 5 (file-attributes gnus-kill-files-directory))
13219                           (nreverse 
13220                            (directory-files 
13221                             gnus-kill-files-directory t 
13222                             (gnus-score-file-regexp))))))
13223       ;; We do not use long file names, so we have to do some
13224       ;; directory traversing.  
13225       (let ((mdir (length (expand-file-name gnus-kill-files-directory)))
13226             (suffixes (list gnus-score-file-suffix gnus-adaptive-file-suffix))
13227             dir files suffix)
13228         (while suffixes
13229           (setq dir (expand-file-name
13230                      (concat gnus-kill-files-directory
13231                              (gnus-replace-chars-in-string group ?. ?/))))
13232           (setq dir (gnus-replace-chars-in-string dir ?: ?/))
13233           (setq suffix (car suffixes)
13234                 suffixes (cdr suffixes))
13235           (if (file-exists-p (concat dir "/" suffix))
13236               (setq files (cons (concat dir "/" suffix) files)))
13237           (while (>= (1+ (length dir)) mdir)
13238             (and (file-exists-p (concat dir "/all/" suffix))
13239                  (setq files (cons (concat dir "/all/" suffix) files)))
13240             (string-match "/[^/]*$" dir)
13241             (setq dir (substring dir 0 (match-beginning 0)))))
13242         (setq gnus-score-file-list 
13243               (cons nil (nreverse files)))))
13244     (cdr gnus-score-file-list)))
13245
13246 (defun gnus-score-file-regexp ()
13247   (concat "\\(" gnus-score-file-suffix 
13248           "\\|" gnus-adaptive-file-suffix "\\)$"))
13249         
13250 (defun gnus-score-find-bnews (group)
13251   "Return a list of score files for GROUP.
13252 The score files are those files in the ~/News directory which matches
13253 GROUP using BNews sys file syntax."
13254   (let* ((sfiles (append (gnus-score-score-files group)
13255                          gnus-internal-global-score-files))
13256          (kill-dir (file-name-as-directory 
13257                     (expand-file-name gnus-kill-files-directory)))
13258          (klen (length kill-dir))
13259          ofiles not-match regexp)
13260     (save-excursion
13261       (set-buffer (get-buffer-create "*gnus score files*"))
13262       (buffer-disable-undo (current-buffer))
13263       ;; Go through all score file names and create regexp with them
13264       ;; as the source.  
13265       (while sfiles
13266         (erase-buffer)
13267         (insert (car sfiles))
13268         (goto-char (point-min))
13269         ;; First remove the suffix itself.
13270         (re-search-forward (concat "." (gnus-score-file-regexp)))
13271         (replace-match "" t t) 
13272         (goto-char (point-min))
13273         (if (looking-at (regexp-quote kill-dir))
13274             ;; If the file name was just "SCORE", `klen' is one character
13275             ;; too much.
13276             (delete-char (min (1- (point-max)) klen))
13277           (goto-char (point-max))
13278           (search-backward "/")
13279           (delete-region (1+ (point)) (point-min)))
13280         ;; If short file names were used, we have to translate slashes.
13281         (goto-char (point-min))
13282         (while (re-search-forward "[/:]" nil t)
13283           (replace-match "." t t))
13284         ;; Translate "all" to ".*".
13285         (while (search-forward "all" nil t)
13286           (replace-match ".*" t t))
13287         (goto-char (point-min))
13288         ;; Deal with "not."s.
13289         (if (looking-at "not.")
13290             (progn
13291               (setq not-match t)
13292               (setq regexp (buffer-substring 5 (point-max))))
13293           (setq regexp (buffer-substring 1 (point-max)))
13294           (setq not-match nil))
13295         ;; Finally - if this resulting regexp matches the group name,
13296         ;; we add this score file to the list of score files
13297         ;; applicable to this group.
13298         (if (or (and not-match
13299                      (not (string-match regexp group)))
13300                 (and (not not-match)
13301                      (string-match regexp group)))
13302             (setq ofiles (cons (car sfiles) ofiles)))
13303         (setq sfiles (cdr sfiles)))
13304       (kill-buffer (current-buffer))
13305       ;; Slight kludge here - the last score file returned should be
13306       ;; the local score file, whether it exists or not. This is so
13307       ;; that any score commands the user enters will go to the right
13308       ;; file, and not end up in some global score file.
13309       (let ((localscore
13310              (expand-file-name
13311               (if (gnus-use-long-file-name 'not-score)
13312                   (concat gnus-kill-files-directory group "." 
13313                           gnus-score-file-suffix)
13314                 (concat gnus-kill-files-directory
13315                         (gnus-replace-chars-in-string group ?. ?/)
13316                         "/" gnus-score-file-suffix)))))
13317         (and (member localscore ofiles)
13318              (delete localscore ofiles))
13319         (setq ofiles (cons localscore ofiles)))
13320       (nreverse ofiles))))
13321
13322 (defun gnus-score-find-single (group)
13323   "Return list containing the score file for GROUP."
13324   (list (gnus-score-file-name group gnus-adaptive-file-suffix)
13325         (gnus-score-file-name group)))
13326
13327 (defun gnus-score-find-hierarchical (group)
13328   "Return list of score files for GROUP.
13329 This includes the score file for the group and all its parents."
13330   (let ((all (copy-sequence '(nil)))
13331         (start 0))
13332     (while (string-match "\\." group (1+ start))
13333       (setq start (match-beginning 0))
13334       (setq all (cons (substring group 0 start) all)))
13335     (setq all (cons group all))
13336     (nconc
13337      (mapcar (lambda (newsgroup)
13338                (gnus-score-file-name newsgroup gnus-adaptive-file-suffix))
13339              (setq all (nreverse all)))
13340      (mapcar 'gnus-score-file-name all))))
13341
13342 (defvar gnus-score-file-alist-cache nil)
13343
13344 (defun gnus-score-find-alist (group)
13345   "Return list of score files for GROUP.
13346 The list is determined from the variable gnus-score-file-alist."
13347   (let ((alist gnus-score-file-multiple-match-alist)
13348         score-files)
13349     ;; if this group has been seen before, return the cached entry
13350     (if (setq score-files (assoc group gnus-score-file-alist-cache))
13351         (cdr score-files)       ; ensures caching of groups with no matches
13352       ;; handle the multiple match alist
13353       (while alist
13354         (and (string-match (car (car alist)) group)
13355              (setq score-files
13356                    (nconc score-files (cdr (car alist)))))
13357         (setq alist (cdr alist)))
13358       (setq alist gnus-score-file-single-match-alist)
13359       ;; handle the single match alist
13360       (catch 'done
13361         (while alist
13362           (and (string-match (car (car alist)) group)
13363                ;; progn used just in case ("regexp") has no files
13364                ;; and score-files is still nil. -sj
13365                ;; this can be construed as a "stop searching here" feature :>
13366                ;; and used to simplify regexps in the single-alist 
13367                (progn
13368                  (setq score-files
13369                        (append score-files (cdr (car alist))))
13370                  (throw 'done nil)))
13371           (setq alist (cdr alist))))
13372       ;; cache the score files
13373       (setq gnus-score-file-alist-cache
13374             (cons (cons group score-files) gnus-score-file-alist-cache))
13375       score-files)))
13376
13377
13378 (defun gnus-possibly-score-headers (&optional trace)
13379   (let ((func gnus-score-find-score-files-function)
13380         score-files)
13381     (and func (not (listp func))
13382          (setq func (list func)))
13383     ;; Go through all the functions for finding score files (or actual
13384     ;; scores) and add them to a list.
13385     (setq score-files (copy-sequence
13386                        (gnus-score-find-alist gnus-newsgroup-name)))
13387     (while func
13388       (and (symbolp (car func))
13389            (fboundp (car func))
13390            (setq score-files 
13391                  (nconc score-files (funcall (car func) gnus-newsgroup-name))))
13392       (setq func (cdr func)))
13393     (if score-files (gnus-score-headers score-files trace))))
13394
13395 (defun gnus-score-file-name (newsgroup &optional suffix)
13396   "Return the name of a score file for NEWSGROUP."
13397   (let ((suffix (or suffix gnus-score-file-suffix)))
13398     (cond  ((or (null newsgroup)
13399                 (string-equal newsgroup ""))
13400             ;; The global score file is placed at top of the directory.
13401             (expand-file-name 
13402              suffix (or gnus-kill-files-directory "~/News")))
13403            ((gnus-use-long-file-name 'not-score)
13404             ;; Append ".SCORE" to newsgroup name.
13405             (expand-file-name (concat newsgroup "." suffix)
13406                               (or gnus-kill-files-directory "~/News")))
13407            (t
13408             ;; Place "SCORE" under the hierarchical directory.
13409             (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
13410                                       "/" suffix)
13411                               (or gnus-kill-files-directory "~/News"))))))
13412
13413 (defun gnus-score-search-global-directories (files)
13414   "Scan all global score directories for score files."
13415   ;; Set the variable `gnus-internal-global-score-files' to all
13416   ;; available global score files.
13417   (interactive (list gnus-global-score-files))
13418   (let (out)
13419     (while files
13420       (if (string-match "/$" (car files))
13421           (setq out (nconc (directory-files 
13422                             (car files) t
13423                             (concat (gnus-score-file-regexp) "$"))))
13424         (setq out (cons (car files) out)))
13425       (setq files (cdr files)))
13426     (setq gnus-internal-global-score-files out)))
13427
13428 ;; Allow redefinition of Gnus functions.
13429
13430 (gnus-ems-redefine)
13431
13432 (provide 'gnus)
13433
13434 ;;; gnus.el ends here