*** empty log message ***
[gnus] / lisp / gnus.el
1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (eval '(run-hooks 'gnus-load-hook))
29
30 (require 'mail-utils)
31 (require 'timezone)
32 (require 'nnheader)
33
34 (eval-when-compile (require 'cl))
35
36 ;; Site dependent variables.  These variables should be defined in
37 ;; paths.el.
38
39 (defvar gnus-default-nntp-server nil
40   "Specify a default NNTP server.
41 This variable should be defined in paths.el, and should never be set
42 by the user.
43 If you want to change servers, you should use `gnus-select-method'.
44 See the documentation to that variable.")
45
46 (defconst gnus-backup-default-subscribed-newsgroups 
47   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
48   "Default default new newsgroups the first time Gnus is run.
49 Should be set in paths.el, and shouldn't be touched by the user.")
50
51 (defvar gnus-local-domain nil
52   "Local domain name without a host name.
53 The DOMAINNAME environment variable is used instead if it is defined.
54 If the `system-name' function returns the full Internet name, there is
55 no need to set this variable.")
56
57 (defvar gnus-local-organization nil
58   "String with a description of what organization (if any) the user belongs to.
59 The ORGANIZATION environment variable is used instead if it is defined.
60 If this variable contains a function, this function will be called
61 with the current newsgroup name as the argument.  The function should
62 return a string.
63
64 In any case, if the string (either in the variable, in the environment
65 variable, or returned by the function) is a file name, the contents of
66 this file will be used as the organization.")
67
68 (defvar gnus-use-generic-from nil
69   "If nil, the full host name will be the system name prepended to the domain name.
70 If this is a string, the full host name will be this string.
71 If this is non-nil, non-string, the domain name will be used as the
72 full host name.")
73
74 (defvar gnus-use-generic-path nil
75   "If nil, use the NNTP server name in the Path header.
76 If stringp, use this; if non-nil, use no host name (user name only).")
77
78
79 ;; Customization variables
80
81 ;; Don't touch this variable.
82 (defvar gnus-nntp-service "nntp"
83   "*NNTP service name (\"nntp\" or 119).
84 This is an obsolete variable, which is scarcely used.  If you use an
85 nntp server for your newsgroup and want to change the port number
86 used to 899, you would say something along these lines:
87
88  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
89
90 (defvar gnus-nntpserver-file "/etc/nntpserver"
91   "*A file with only the name of the nntp server in it.")
92
93 ;; This function is used to check both the environment variable
94 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
95 ;; an nntp server name default.
96 (defun gnus-getenv-nntpserver ()
97   (or (getenv "NNTPSERVER")
98       (and (file-readable-p gnus-nntpserver-file)
99            (save-excursion
100              (set-buffer (get-buffer-create " *gnus nntp*"))
101              (buffer-disable-undo (current-buffer))
102              (insert-file-contents gnus-nntpserver-file)
103              (let ((name (buffer-string)))
104                (prog1
105                    (if (string-match "^[ \t\n]*$" name)
106                        nil
107                      name)
108                  (kill-buffer (current-buffer))))))))
109                  
110 (defvar gnus-select-method 
111   (nconc
112    (list 'nntp (or (condition-case ()
113                        (gnus-getenv-nntpserver)
114                      (error nil))
115                    (if (and gnus-default-nntp-server
116                             (not (string= gnus-default-nntp-server "")))
117                        gnus-default-nntp-server)
118                    (system-name)))
119    (if (or (null gnus-nntp-service)
120            (equal gnus-nntp-service "nntp"))
121        nil 
122      (list gnus-nntp-service)))
123   "*Default method for selecting a newsgroup.
124 This variable should be a list, where the first element is how the
125 news is to be fetched, the second is the address. 
126
127 For instance, if you want to get your news via NNTP from
128 \"flab.flab.edu\", you could say:
129
130 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
131
132 If you want to use your local spool, say:
133
134 (setq gnus-select-method (list 'nnspool (system-name)))
135
136 If you use this variable, you must set `gnus-nntp-server' to nil.
137
138 There is a lot more to know about select methods and virtual servers -
139 see the manual for details.")
140
141 ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
142 (defvar gnus-post-method nil
143   "*Preferred method for posting USENET news.
144 If this variable is nil, Gnus will use the current method to decide
145 which method to use when posting.  If it is non-nil, it will override
146 the current method.  This method will not be used in mail groups and
147 the like, only in \"real\" newsgroups.
148
149 The value must be a valid method as discussed in the documentation of
150 `gnus-select-method'.")
151
152 (defvar gnus-refer-article-method nil
153   "*Preferred method for fetching an article by Message-ID.
154 If you are reading news from the local spool (with nnspool), fetching
155 articles by Message-ID is painfully slow.  By setting this method to an
156 nntp method, you might get acceptable results.
157
158 The value of this variable must be a valid select method as discussed
159 in the documentation of `gnus-select-method'")
160
161 (defvar gnus-secondary-select-methods nil
162   "*A list of secondary methods that will be used for reading news.
163 This is a list where each element is a complete select method (see
164 `gnus-select-method').  
165
166 If, for instance, you want to read your mail with the nnml backend,
167 you could set this variable:
168
169 (setq gnus-secondary-select-methods '((nnml \"\")))")
170
171 (defvar gnus-secondary-servers nil
172   "*List of NNTP servers that the user can choose between interactively.
173 To make Gnus query you for a server, you have to give `gnus' a
174 non-numeric prefix - `C-u M-x gnus', in short.")
175
176 (defvar gnus-nntp-server nil
177   "*The name of the host running the NNTP server.
178 This variable is semi-obsolete.  Use the `gnus-select-method'
179 variable instead.")
180
181 (defvar gnus-startup-file "~/.newsrc"
182   "*Your `.newsrc' file.
183 `.newsrc-SERVER' will be used instead if that exists.")
184
185 (defvar gnus-init-file "~/.gnus"
186   "*Your Gnus elisp startup file.
187 If a file with the .el or .elc suffixes exist, it will be read
188 instead.") 
189
190 (defvar gnus-group-faq-directory
191   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
192     "/ftp@ftp.uu.net:/usenet/news.answers/"
193     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
194     "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
195     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
196     "/ftp@ftp.Germany.EU.net:/pub/newsarchive/news.answers/"
197     "/ftp@ftp.sunet.se:/pub/usenet/"
198     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
199     "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
200     "/ftp@ftp.hk.super.net:/mirror/faqs/")
201   "*Directory where the group FAQs are stored.
202 This will most commonly be on a remote machine, and the file will be
203 fetched by ange-ftp.
204
205 This variable can also be a list of directories.  In that case, the
206 first element in the list will be used by default, and the others will
207 be used as backup sites.
208
209 Note that Gnus uses an aol machine as the default directory.  If this
210 feels fundamentally unclean, just think of it as a way to finally get
211 something of value back from them.
212
213 If the default site is too slow, try one of these:
214
215    North America: ftp.uu.net                     /usenet/news.answers
216                   mirrors.aol.com                /pub/rtfm/usenet
217                   ftp.seas.gwu.edu               /pub/rtfm
218                   rtfm.mit.edu                   /pub/usenet/news.answers
219    Europe:        ftp.uni-paderborn.de           /pub/FAQ
220                   ftp.Germany.EU.net             /pub/newsarchive/news.answers
221                   ftp.sunet.se                   /pub/usenet
222    Asia:          nctuccca.edu.tw                /USENET/FAQ
223                   hwarang.postech.ac.kr          /pub/usenet/news.answers
224                   ftp.hk.super.net               /mirror/faqs")
225
226 (defvar gnus-group-archive-directory
227   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" 
228   "*The address of the (ding) archives.")
229
230 (defvar gnus-group-recent-archive-directory
231   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
232   "*The address of the most recent (ding) articles.")
233
234 (defvar gnus-default-subscribed-newsgroups nil
235   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
236 It should be a list of strings.
237 If it is `t', Gnus will not do anything special the first time it is
238 started; it'll just use the normal newsgroups subscription methods.")
239
240 (defvar gnus-use-cross-reference t
241   "*Non-nil means that cross referenced articles will be marked as read.
242 If nil, ignore cross references.  If t, mark articles as read in
243 subscribed newsgroups.  If neither t nor nil, mark as read in all
244 newsgroups.") 
245
246 (defvar gnus-use-dribble-file t
247   "*Non-nil means that Gnus will use a dribble file to store user updates.
248 If Emacs should crash without saving the .newsrc files, complete
249 information can be restored from the dribble file.")
250
251 (defvar gnus-dribble-directory nil
252   "*The directory where dribble files will be saved.
253 If this variable is nil, the directory where the .newsrc files are
254 saved will be used.")
255
256 (defvar gnus-asynchronous nil
257   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
258
259 (defvar gnus-large-newsgroup 200
260   "*The number of articles which indicates a large newsgroup.
261 If the number of articles in a newsgroup is greater than this value,
262 confirmation is required for selecting the newsgroup.")
263
264 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
265 (defvar gnus-no-groups-message "No news is horrible news"
266   "*Message displayed by Gnus when no groups are available.")
267
268 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
269   "*Non-nil means that the default name of a file to save articles in is the group name.
270 If it's nil, the directory form of the group name is used instead.
271
272 If this variable is a list, and the list contains the element
273 `not-score', long file names will not be used for score files; if it
274 contains the element `not-save', long file names will not be used for
275 saving; and if it contains the element `not-kill', long file names
276 will not be used for kill files.")
277
278 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
279   "*Name of the directory articles will be saved in (default \"~/News\").
280 Initialized from the SAVEDIR environment variable.")
281
282 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
283   "*Name of the directory where kill files will be stored (default \"~/News\").
284 Initialized from the SAVEDIR environment variable.")
285
286 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
287   "*A function to save articles in your favorite format.
288 The function must be interactively callable (in other words, it must
289 be an Emacs command).
290
291 Gnus provides the following functions:
292
293 * gnus-summary-save-in-rmail (Rmail format)
294 * gnus-summary-save-in-mail (Unix mail format)
295 * gnus-summary-save-in-folder (MH folder)
296 * gnus-summary-save-in-file (article format).
297 * gnus-summary-save-in-vm (use VM's folder format).")
298
299 (defvar gnus-prompt-before-saving 'always
300   "*This variable says how much prompting is to be done when saving articles.
301 If it is nil, no prompting will be done, and the articles will be
302 saved to the default files.  If this variable is `always', each and
303 every article that is saved will be preceded by a prompt, even when
304 saving large batches of articles.  If this variable is neither nil not
305 `always', there the user will be prompted once for a file name for
306 each invocation of the saving commands.")
307
308 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
309   "*A function generating a file name to save articles in Rmail format.
310 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
311
312 (defvar gnus-mail-save-name (function gnus-plain-save-name)
313   "*A function generating a file name to save articles in Unix mail format.
314 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
315
316 (defvar gnus-folder-save-name (function gnus-folder-save-name)
317   "*A function generating a file name to save articles in MH folder.
318 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
319
320 (defvar gnus-file-save-name (function gnus-numeric-save-name)
321   "*A function generating a file name to save articles in article format.
322 The function is called with NEWSGROUP, HEADERS, and optional
323 LAST-FILE.")
324
325 (defvar gnus-split-methods nil
326   "*Variable used to suggest where articles are to be saved.
327 The syntax of this variable is the same as `nnmail-split-methods'.  
328
329 For instance, if you would like to save articles related to Gnus in
330 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
331 you could set this variable to something like:
332
333  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
334    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))")
335
336 (defvar gnus-save-score nil
337   "*If non-nil, save group scoring info.")
338
339 (defvar gnus-use-adaptive-scoring nil
340   "*If non-nil, use some adaptive scoring scheme.")
341
342 (defvar gnus-use-cache nil
343   "*If non-nil, Gnus will cache (some) articles locally.")
344
345 (defvar gnus-keep-backlog nil
346   "*If non-nil, Gnus will keep read articles for later re-retrieval.
347 If it is a number N, then Gnus will only keep the last N articles
348 read.  If it is neither nil nor a number, Gnus will keep all read
349 articles.  This is not a good idea.")
350
351 (defvar gnus-use-nocem nil
352   "*If non-nil, Gnus will read NoCeM cancel messages.")
353
354 (defvar gnus-use-demon nil
355   "If non-nil, Gnus might use some demons.")
356
357 (defvar gnus-use-scoring t
358   "*If non-nil, enable scoring.")
359
360 (defvar gnus-fetch-old-headers nil
361   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
362 If an unread article in the group refers to an older, already read (or
363 just marked as read) article, the old article will not normally be
364 displayed in the Summary buffer.  If this variable is non-nil, Gnus
365 will attempt to grab the headers to the old articles, and thereby
366 build complete threads.  If it has the value `some', only enough
367 headers to connect otherwise loose threads will be displayed.
368 This variable can also be a number.  In that case, no more than that
369 number of old headers will be fetched. 
370
371 The server has to support NOV for any of this to work.")
372
373 ;see gnus-cus.el
374 ;(defvar gnus-visual t
375 ;  "*If non-nil, will do various highlighting.
376 ;If nil, no mouse highlights (or any other highlights) will be
377 ;performed.  This might speed up Gnus some when generating large group
378 ;and summary buffers.")
379
380 (defvar gnus-novice-user t
381   "*Non-nil means that you are a usenet novice.
382 If non-nil, verbose messages may be displayed and confirmations may be
383 required.")
384
385 (defvar gnus-expert-user nil
386   "*Non-nil means that you will never be asked for confirmation about anything.
387 And that means *anything*.")
388
389 (defvar gnus-verbose 7
390   "*Integer that says how verbose Gnus should be.
391 The higher the number, the more messages Gnus will flash to say what
392 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
393 display most important messages; and at ten, Gnus will keep on
394 jabbering all the time.")
395
396 (defvar gnus-keep-same-level nil
397   "*Non-nil means that the next newsgroup after the current will be on the same level.
398 When you type, for instance, `n' after reading the last article in the
399 current newsgroup, you will go to the next newsgroup.  If this variable
400 is nil, the next newsgroup will be the next from the group
401 buffer. 
402 If this variable is non-nil, Gnus will either put you in the
403 next newsgroup with the same level, or, if no such newsgroup is
404 available, the next newsgroup with the lowest possible level higher
405 than the current level.
406 If this variable is `best', Gnus will make the next newsgroup the one
407 with the best level.")
408
409 (defvar gnus-summary-make-false-root 'adopt
410   "*nil means that Gnus won't gather loose threads.
411 If the root of a thread has expired or been read in a previous
412 session, the information necessary to build a complete thread has been
413 lost.  Instead of having many small sub-threads from this original thread
414 scattered all over the summary buffer, Gnus can gather them. 
415
416 If non-nil, Gnus will try to gather all loose sub-threads from an
417 original thread into one large thread.
418
419 If this variable is non-nil, it should be one of `none', `adopt',
420 `dummy' or `empty'.
421
422 If this variable is `none', Gnus will not make a false root, but just
423 present the sub-threads after another.
424 If this variable is `dummy', Gnus will create a dummy root that will
425 have all the sub-threads as children.
426 If this variable is `adopt', Gnus will make one of the \"children\"
427 the parent and mark all the step-children as such.
428 If this variable is `empty', the \"children\" are printed with empty
429 subject fields.  (Or rather, they will be printed with a string
430 given by the `gnus-summary-same-subject' variable.)")
431
432 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
433   "*A regexp to match subjects to be excluded from loose thread gathering.
434 As loose thread gathering is done on subjects only, that means that
435 there can be many false gatherings performed.  By rooting out certain
436 common subjects, gathering might become saner.")
437
438 (defvar gnus-summary-gather-subject-limit nil
439   "*Maximum length of subject comparisons when gathering loose threads.
440 Use nil to compare full subjects.  Setting this variable to a low
441 number will help gather threads that have been corrupted by
442 newsreaders chopping off subject lines, but it might also mean that
443 unrelated articles that have subject that happen to begin with the
444 same few characters will be incorrectly gathered.
445
446 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
447 comparing subjects.")
448
449 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
450 (defvar gnus-summary-same-subject ""
451   "*String indicating that the current article has the same subject as the previous.
452 This variable will only be used if the value of
453 `gnus-summary-make-false-root' is `empty'.")
454
455 (defvar gnus-summary-goto-unread t
456   "*If non-nil, marking commands will go to the next unread article.")
457
458 (defvar gnus-group-goto-unread t
459   "*If non-nil, movement commands will go to the next unread and subscribed group.")
460
461 (defvar gnus-check-new-newsgroups t
462   "*Non-nil means that Gnus will add new newsgroups at startup.
463 If this variable is `ask-server', Gnus will ask the server for new
464 groups since the last time it checked.  This means that the killed list
465 is no longer necessary, so you could set `gnus-save-killed-list' to
466 nil. 
467
468 A variant is to have this variable be a list of select methods.  Gnus
469 will then use the `ask-server' method on all these select methods to
470 query for new groups from all those servers.
471
472 Eg.
473   (setq gnus-check-new-newsgroups 
474         '((nntp \"some.server\") (nntp \"other.server\")))
475
476 If this variable is nil, then you have to tell Gnus explicitly to
477 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
478
479 (defvar gnus-check-bogus-newsgroups nil
480   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
481 If this variable is nil, then you have to tell Gnus explicitly to
482 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
483
484 (defvar gnus-read-active-file t
485   "*Non-nil means that Gnus will read the entire active file at startup.
486 If this variable is nil, Gnus will only know about the groups in your
487 `.newsrc' file.
488
489 If this variable is `some', Gnus will try to only read the relevant
490 parts of the active file from the server.  Not all servers support
491 this, and it might be quite slow with other servers, but this should
492 generally be faster than both the t and nil value.
493
494 If you set this variable to nil or `some', you probably still want to
495 be told about new newsgroups that arrive.  To do that, set
496 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
497 properly with all servers.")
498
499 (defvar gnus-level-subscribed 5
500   "*Groups with levels less than or equal to this variable are subscribed.")
501
502 (defvar gnus-level-unsubscribed 7
503   "*Groups with levels less than or equal to this variable are unsubscribed.
504 Groups with levels less than `gnus-level-subscribed', which should be
505 less than this variable, are subscribed.")
506
507 (defvar gnus-level-zombie 8
508   "*Groups with this level are zombie groups.")
509
510 (defvar gnus-level-killed 9
511   "*Groups with this level are killed.")
512
513 (defvar gnus-level-default-subscribed 3
514   "*New subscribed groups will be subscribed at this level.")
515
516 (defvar gnus-level-default-unsubscribed 6
517   "*New unsubscribed groups will be unsubscribed at this level.")
518
519 (defvar gnus-activate-foreign-newsgroups 4
520   "*If nil, Gnus will not check foreign newsgroups at startup.
521 If it is non-nil, it should be a number between one and nine.  Foreign
522 newsgroups that have a level lower or equal to this number will be
523 activated on startup.  For instance, if you want to active all
524 subscribed newsgroups, but not the rest, you'd set this variable to 
525 `gnus-level-subscribed'.
526
527 If you subscribe to lots of newsgroups from different servers, startup
528 might take a while.  By setting this variable to nil, you'll save time,
529 but you won't be told how many unread articles there are in the
530 groups.")
531
532 (defvar gnus-save-newsrc-file t
533   "*Non-nil means that Gnus will save the `.newsrc' file.
534 Gnus always saves its own startup file, which is called
535 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
536 be readily understood by other newsreaders.  If you don't plan on
537 using other newsreaders, set this variable to nil to save some time on
538 exit.")
539
540 (defvar gnus-save-killed-list t
541   "*If non-nil, save the list of killed groups to the startup file.
542 This will save both time (when starting and quitting) and space (both
543 memory and disk), but it will also mean that Gnus has no record of
544 which groups are new and which are old, so the automatic new
545 newsgroups subscription methods become meaningless.  You should always
546 set `gnus-check-new-newsgroups' to `ask-server' or nil if you set this
547 variable to nil.")
548
549 (defvar gnus-interactive-catchup t
550   "*If non-nil, require your confirmation when catching up a group.")
551
552 (defvar gnus-interactive-post t
553   "*If non-nil, group name will be asked for when posting.")
554
555 (defvar gnus-interactive-exit t
556   "*If non-nil, require your confirmation when exiting Gnus.")
557
558 (defvar gnus-kill-killed t
559   "*If non-nil, Gnus will apply kill files to already killed articles.
560 If it is nil, Gnus will never apply kill files to articles that have
561 already been through the scoring process, which might very well save lots
562 of time.")
563
564 (defvar gnus-extract-address-components 'gnus-extract-address-components
565   "*Function for extracting address components from a From header.
566 Two pre-defined function exist: `gnus-extract-address-components',
567 which is the default, quite fast, and too simplistic solution, and
568 `mail-extract-address-components', which works much better, but is
569 slower.")
570
571 (defvar gnus-summary-default-score 0
572   "*Default article score level.
573 If this variable is nil, scoring will be disabled.")
574
575 (defvar gnus-summary-zcore-fuzz 0
576   "*Fuzziness factor for the zcore in the summary buffer.
577 Articles with scores closer than this to `gnus-summary-default-score'
578 will not be marked.")
579
580 (defvar gnus-simplify-subject-fuzzy-regexp nil
581   "*Strings to be removed when doing fuzzy matches.
582 This can either be a egular expression or list of regular expressions
583 that will be removed from subject strings if fuzzy subject
584 simplification is selected.")
585
586 (defvar gnus-permanently-visible-groups nil
587   "*Regexp to match groups that should always be listed in the group buffer.
588 This means that they will still be listed when there are no unread
589 articles in the groups.")
590
591 (defvar gnus-group-default-list-level gnus-level-subscribed
592   "*Default listing level. 
593 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
594
595 (defvar gnus-group-use-permanent-levels nil
596   "*If non-nil, once you set a level, Gnus will use this level.")
597
598 (defvar gnus-show-mime nil
599   "*If non-nil, do mime processing of articles.
600 The articles will simply be fed to the function given by
601 `gnus-show-mime-method'.")
602
603 (defvar gnus-strict-mime t
604   "*If nil, decode MIME header even if there is not Mime-Version field.")
605  
606 (defvar gnus-show-mime-method 'metamail-buffer
607   "*Function to process a MIME message.
608 The function is called from the article buffer.")
609
610 (defvar gnus-decode-encoded-word-method (lambda ())
611   "*Function to decode a MIME encoded-words.
612 The function is called from the article buffer.")
613  
614 (defvar gnus-show-threads t
615   "*If non-nil, display threads in summary mode.")
616
617 (defvar gnus-thread-hide-subtree nil
618   "*If non-nil, hide all threads initially.
619 If threads are hidden, you have to run the command
620 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
621 to expose hidden threads.")
622
623 (defvar gnus-thread-hide-killed t
624   "*If non-nil, hide killed threads automatically.")
625
626 (defvar gnus-thread-ignore-subject nil
627   "*If non-nil, ignore subjects and do all threading based on the Reference header.
628 If nil, which is the default, articles that have different subjects
629 from their parents will start separate threads.")
630
631 (defvar gnus-thread-operation-ignore-subject t
632   "*If non-nil, subjects will be ignored when doing thread commands.
633 This affects commands like `gnus-summary-kill-thread' and
634 `gnus-summary-lower-thread'.  
635
636 If this variable is nil, articles in the same thread with different
637 subjects will not be included in the operation in question.  If this
638 variable is `fuzzy', only articles that have subjects that are fuzzily
639 equal will be included.")
640
641 (defvar gnus-thread-indent-level 4
642   "*Number that says how much each sub-thread should be indented.")
643
644 (defvar gnus-ignored-newsgroups 
645   (purecopy (mapconcat 'identity
646                        '("^to\\."       ; not "real" groups
647                          "^[0-9. \t]+ " ; all digits in name
648                          "[][\"#'()]"   ; bogus characters
649                          )
650                        "\\|"))
651   "*A regexp to match uninteresting newsgroups in the active file.
652 Any lines in the active file matching this regular expression are
653 removed from the newsgroup list before anything else is done to it,
654 thus making them effectively non-existent.")
655
656 (defvar gnus-ignored-headers
657   "^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:"
658   "*All headers that match this regexp will be hidden.
659 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
660
661 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Resent-"
662   "*All headers that do not match this regexp will be hidden.
663 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
664
665 (defvar gnus-sorted-header-list
666   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" 
667     "^Cc:" "^Date:" "^Organization:")
668   "*This variable is a list of regular expressions.
669 If it is non-nil, headers that match the regular expressions will
670 be placed first in the article buffer in the sequence specified by
671 this list.")
672
673 (defvar gnus-show-all-headers nil
674   "*If non-nil, don't hide any headers.")
675
676 (defvar gnus-save-all-headers t
677   "*If non-nil, don't remove any headers before saving.")
678
679 (defvar gnus-saved-headers gnus-visible-headers
680   "*Headers to keep if `gnus-save-all-headers' is nil.
681 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
682 If that variable is nil, however, all headers that match this regexp
683 will be kept while the rest will be deleted before saving.")
684
685 (defvar gnus-inhibit-startup-message nil
686   "*If non-nil, the startup message will not be displayed.")
687
688 (defvar gnus-signature-separator "^-- *$"
689   "Regexp matching signature separator.")
690
691 (defvar gnus-auto-extend-newsgroup t
692   "*If non-nil, extend newsgroup forward and backward when requested.")
693
694 (defvar gnus-auto-select-first t
695   "*If nil, don't select the first unread article when entering a group.
696 If this variable is `best', select the highest-scored unread article
697 in the group.  If neither nil nor `best', select the first unread
698 article.
699
700 If you want to prevent automatic selection of the first unread article
701 in some newsgroups, set the variable to nil in
702 `gnus-select-group-hook'.") 
703
704 (defvar gnus-auto-select-next t
705   "*If non-nil, offer to go to the next group from the end of the previous.
706 If the value is t and the next newsgroup is empty, Gnus will exit
707 summary mode and go back to group mode.  If the value is neither nil
708 nor t, Gnus will select the following unread newsgroup.  In
709 particular, if the value is the symbol `quietly', the next unread
710 newsgroup will be selected without any confirmation, and if it is
711 `almost-quietly', the next group will be selected without any
712 confirmation if you are located on the last article in the group.")
713
714 (defvar gnus-auto-select-same nil
715   "*If non-nil, select the next article with the same subject.")
716
717 (defvar gnus-summary-check-current nil
718   "*If non-nil, consider the current article when moving.
719 The \"unread\" movement commands will stay on the same line if the
720 current article is unread.")
721
722 (defvar gnus-auto-center-summary t
723   "*If non-nil, always center the current summary buffer.")
724
725 (defvar gnus-break-pages t
726   "*If non-nil, do page breaking on articles.
727 The page delimiter is specified by the `gnus-page-delimiter'
728 variable.")
729
730 (defvar gnus-page-delimiter "^\^L"
731   "*Regexp describing what to use as article page delimiters.
732 The default value is \"^\^L\", which is a form linefeed at the
733 beginning of a line.")
734
735 (defvar gnus-use-full-window t
736   "*If non-nil, use the entire Emacs screen.")
737
738 (defvar gnus-window-configuration nil
739   "Obsolete variable.  See `gnus-buffer-configuration'.")
740
741 (defvar gnus-buffer-configuration
742   '((group ([group 1.0 point] 
743             (if gnus-carpal [group-carpal 4])))
744     (summary ([summary 1.0 point]
745               (if gnus-carpal [summary-carpal 4])))
746     (article ([summary 0.25 point] 
747               (if gnus-carpal [summary-carpal 4]) 
748               [article 1.0]))
749     (server ([server 1.0 point]
750              (if gnus-carpal [server-carpal 2])))
751     (browse ([browse 1.0 point]
752              (if gnus-carpal [browse-carpal 2])))
753     (group-mail ([mail 1.0 point]))
754     (summary-mail ([mail 1.0 point]))
755     (summary-reply ([article 0.5]
756                     [mail 1.0 point]))
757     (info ([nil 1.0 point]))
758     (summary-faq ([summary 0.25]
759                   [faq 1.0 point]))
760     (edit-group ([group 0.5]
761                  [edit-group 1.0 point]))
762     (edit-server ([server 0.5]
763                   [edit-server 1.0 point]))
764     (edit-score ([summary 0.25]
765                  [edit-score 1.0 point]))
766     (post ([post 1.0 point]))
767     (reply ([article 0.5]
768             [mail 1.0 point]))
769     (mail-forward ([mail 1.0 point]))
770     (post-forward ([post 1.0 point]))
771     (reply-yank ([mail 1.0 point]))
772     (mail-bounce ([article 0.5]
773                   [mail 1.0 point]))
774     (draft ([draft 1.0 point]))
775     (pipe ([summary 0.25 point] 
776            (if gnus-carpal [summary-carpal 4]) 
777            ["*Shell Command Output*" 1.0]))
778     (followup ([article 0.5]
779                [post 1.0 point]))
780     (followup-yank ([post 1.0 point])))
781   "Window configuration for all possible Gnus buffers.
782 This variable is a list of lists.  Each of these lists has a NAME and
783 a RULE.  The NAMEs are commonsense names like `group', which names a
784 rule used when displaying the group buffer; `summary', which names a
785 rule for what happens when you enter a group and do not display an
786 article buffer; and so on.  See the value of this variable for a
787 complete list of NAMEs.
788
789 Each RULE is a list of vectors.  The first element in this vector is
790 the name of the buffer to be displayed; the second element is the
791 percentage of the screen this buffer is to occupy (a number in the
792 0.0-0.99 range); the optional third element is `point', which should
793 be present to denote which buffer point is to go to after making this
794 buffer configuration.")
795
796 (defvar gnus-window-to-buffer
797   '((group . gnus-group-buffer)
798     (summary . gnus-summary-buffer)
799     (article . gnus-article-buffer)
800     (server . gnus-server-buffer)
801     (browse . "*Gnus Browse Server*")
802     (edit-group . gnus-group-edit-buffer)
803     (edit-server . gnus-server-edit-buffer)
804     (group-carpal . gnus-carpal-group-buffer)
805     (summary-carpal . gnus-carpal-summary-buffer)
806     (server-carpal . gnus-carpal-server-buffer)
807     (browse-carpal . gnus-carpal-browse-buffer)
808     (edit-score . gnus-score-edit-buffer)
809     (mail . gnus-mail-buffer)
810     (post . gnus-post-news-buffer)
811     (faq . gnus-faq-buffer)
812     (draft . gnus-draft-buffer))
813   "Mapping from short symbols to buffer names or buffer variables.")
814
815 (defvar gnus-carpal nil
816   "*If non-nil, display clickable icons.")
817
818 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
819   "*Function called with a group name when new group is detected.
820 A few pre-made functions are supplied: `gnus-subscribe-randomly'
821 inserts new groups at the beginning of the list of groups;
822 `gnus-subscribe-alphabetically' inserts new groups in strict
823 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
824 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
825 for your decision.")
826
827 ;; Suggested by a bug report by Hallvard B Furuseth.
828 ;; <h.b.furuseth@usit.uio.no>. 
829 (defvar gnus-subscribe-options-newsgroup-method
830   (function gnus-subscribe-alphabetically)
831   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
832 If, for instance, you want to subscribe to all newsgroups in the
833 \"no\" and \"alt\" hierarchies, you'd put the following in your
834 .newsrc file:
835
836 options -n no.all alt.all
837
838 Gnus will the subscribe all new newsgroups in these hierarchies with
839 the subscription method in this variable.")
840
841 (defvar gnus-subscribe-hierarchical-interactive nil
842   "*If non-nil, Gnus will offer to subscribe hierarchically.
843 When a new hierarchy appears, Gnus will ask the user:
844
845 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
846
847 If the user pressed `d', Gnus will descend the hierarchy, `y' will
848 subscribe to all newsgroups in the hierarchy and `s' will skip this
849 hierarchy in its entirety.")
850
851 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
852   "*Function used for sorting the group buffer.
853 This function will be called with group info entries as the arguments
854 for the groups to be sorted.  Pre-made functions include
855 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
856 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
857 `gnus-group-sort-by-rank'.  
858
859 This variable can also be a list of sorting functions.  In that case,
860 the most significant sort function should be the last function in the
861 list.")
862
863 ;; Mark variables suggested by Thomas Michanek
864 ;; <Thomas.Michanek@telelogic.se>. 
865 (defvar gnus-unread-mark ? 
866   "*Mark used for unread articles.")
867 (defvar gnus-ticked-mark ?!
868   "*Mark used for ticked articles.")
869 (defvar gnus-dormant-mark ??
870   "*Mark used for dormant articles.")
871 (defvar gnus-del-mark ?r
872   "*Mark used for del'd articles.")
873 (defvar gnus-read-mark ?R
874   "*Mark used for read articles.")
875 (defvar gnus-expirable-mark ?E
876   "*Mark used for expirable articles.")
877 (defvar gnus-killed-mark ?K
878   "*Mark used for killed articles.")
879 (defvar gnus-souped-mark ?F
880   "*Mark used for killed articles.")
881 (defvar gnus-kill-file-mark ?X
882   "*Mark used for articles killed by kill files.")
883 (defvar gnus-low-score-mark ?Y
884   "*Mark used for articles with a low score.")
885 (defvar gnus-catchup-mark ?C
886   "*Mark used for articles that are caught up.")
887 (defvar gnus-replied-mark ?A
888   "*Mark used for articles that have been replied to.")
889 (defvar gnus-process-mark ?# 
890   "*Process mark.")
891 (defvar gnus-ancient-mark ?O
892   "*Mark used for ancient articles.")
893 (defvar gnus-canceled-mark ?G
894   "*Mark used for canceled articles.")
895 (defvar gnus-score-over-mark ?+
896   "*Score mark used for articles with high scores.")
897 (defvar gnus-score-below-mark ?-
898   "*Score mark used for articles with low scores.")
899 (defvar gnus-empty-thread-mark ? 
900   "*There is no thread under the article.")
901 (defvar gnus-not-empty-thread-mark ?=
902   "*There is a thread under the article.")
903
904 (defvar gnus-view-pseudo-asynchronously nil
905   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
906
907 (defvar gnus-view-pseudos nil
908   "*If `automatic', pseudo-articles will be viewed automatically.
909 If `not-confirm', pseudos will be viewed automatically, and the user
910 will not be asked to confirm the command.")
911
912 (defvar gnus-view-pseudos-separately t
913   "*If non-nil, one pseudo-article will be created for each file to be viewed.
914 If nil, all files that use the same viewing command will be given as a
915 list of parameters to that command.")
916
917 (defvar gnus-group-line-format "%M%S%p%5y: %(%g%)\n"
918   "*Format of group lines.
919 It works along the same lines as a normal formatting string,
920 with some simple extensions.
921
922 %M    Only marked articles (character, \"*\" or \" \")
923 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
924 %L    Level of subscribedness (integer)
925 %N    Number of unread articles (integer)
926 %I    Number of dormant articles (integer)
927 %i    Number of ticked and dormant (integer)
928 %T    Number of ticked articles (integer)
929 %R    Number of read articles (integer)
930 %t    Total number of articles (integer)
931 %y    Number of unread, unticked articles (integer)
932 %G    Group name (string)
933 %g    Qualified group name (string)
934 %D    Group description (string)
935 %s    Select method (string)
936 %o    Moderated group (char, \"m\")
937 %p    Process mark (char)
938 %O    Moderated group (string, \"(m)\" or \"\")
939 %n    Select from where (string)
940 %z    A string that look like `<%s:%n>' if a foreign select method is used
941 %u    User defined specifier.  The next character in the format string should
942       be a letter.  Gnus will call the function gnus-user-format-function-X,
943       where X is the letter following %u.  The function will be passed the
944       current header as argument.  The function should return a string, which
945       will be inserted into the buffer just like information from any other
946       group specifier.
947
948 Text between %( and %) will be highlighted with `gnus-mouse-face' when
949 the mouse point move inside the area.  There can only be one such area.
950
951 Note that this format specification is not always respected.  For
952 reasons of efficiency, when listing killed groups, this specification
953 is ignored altogether.  If the spec is changed considerably, your
954 output may end up looking strange when listing both alive and killed
955 groups.
956
957 If you use %o or %O, reading the active file will be slower and quite
958 a bit of extra memory will be used. %D will also worsen performance.
959 Also note that if you change the format specification to include any
960 of these specs, you must probably re-start Gnus to see them go into
961 effect.") 
962
963 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
964   "*The format specification of the lines in the summary buffer.
965
966 It works along the same lines as a normal formatting string,
967 with some simple extensions.
968
969 %N   Article number, left padded with spaces (string)
970 %S   Subject (string)
971 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
972 %n   Name of the poster (string)
973 %a   Extracted name of the poster (string)
974 %A   Extracted address of the poster (string)
975 %F   Contents of the From: header (string)
976 %x   Contents of the Xref: header (string)
977 %D   Date of the article (string)
978 %d   Date of the article (string) in DD-MMM format
979 %M   Message-id of the article (string)
980 %r   References of the article (string)
981 %c   Number of characters in the article (integer)
982 %L   Number of lines in the article (integer)
983 %I   Indentation based on thread level (a string of spaces)
984 %T   A string with two possible values: 80 spaces if the article
985      is on thread level two or larger and 0 spaces on level one
986 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
987 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
988 %[   Opening bracket (character, \"[\" or \"<\")
989 %]   Closing bracket (character, \"]\" or \">\")
990 %>   Spaces of length thread-level (string)
991 %<   Spaces of length (- 20 thread-level) (string)
992 %i   Article score (number)
993 %z   Article zcore (character)
994 %t   Number of articles under the current thread (number).
995 %e   Whether the thread is empty or not (character).
996 %u   User defined specifier.  The next character in the format string should
997      be a letter.  Gnus will call the function gnus-user-format-function-X,
998      where X is the letter following %u.  The function will be passed the
999      current header as argument.  The function should return a string, which
1000      will be inserted into the summary just like information from any other
1001      summary specifier.
1002
1003 Text between %( and %) will be highlighted with `gnus-mouse-face'
1004 when the mouse point is placed inside the area.  There can only be one
1005 such area.
1006
1007 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1008 with care.  For reasons of efficiency, Gnus will compute what column
1009 these characters will end up in, and \"hard-code\" that.  This means that
1010 it is illegal to have these specs after a variable-length spec.  Well,
1011 you might not be arrested, but your summary buffer will look strange,
1012 which is bad enough.
1013
1014 The smart choice is to have these specs as for to the left as
1015 possible. 
1016
1017 This restriction may disappear in later versions of Gnus.")
1018
1019 (defvar gnus-summary-dummy-line-format 
1020   "*  %(:                          :%) %S\n"
1021   "*The format specification for the dummy roots in the summary buffer.
1022 It works along the same lines as a normal formatting string,
1023 with some simple extensions.
1024
1025 %S  The subject")
1026
1027 (defvar gnus-summary-mode-line-format "Gnus  %G/%A %Z"
1028   "*The format specification for the summary mode line.")
1029
1030 (defvar gnus-article-mode-line-format "Gnus  %G/%A %S"
1031   "*The format specification for the article mode line.")
1032
1033 (defvar gnus-group-mode-line-format "Gnus  List of groups   {%M:%S}  "
1034   "*The format specification for the group mode line.")
1035
1036 (defvar gnus-valid-select-methods
1037   '(("nntp" post address prompt-address)
1038     ("nnspool" post)
1039     ("nnvirtual" none virtual prompt-address) 
1040     ("nnmbox" mail respool) 
1041     ("nnml" mail respool)
1042     ("nnmh" mail respool) 
1043     ("nndir" none prompt-address address)
1044     ("nneething" none prompt-address)
1045     ("nndigest" none) 
1046     ("nndoc" none prompt-address) 
1047     ("nnbabyl" mail respool) 
1048     ("nnkiboze" post virtual) 
1049     ("nnsoup" post)
1050     ("nnfolder" mail respool))
1051   "An alist of valid select methods.
1052 The first element of each list lists should be a string with the name
1053 of the select method.  The other elements may be be the category of
1054 this method (ie. `post', `mail', `none' or whatever) or other
1055 properties that this method has (like being respoolable).
1056 If you implement a new select method, all you should have to change is
1057 this variable.  I think.")
1058
1059 (defvar gnus-updated-mode-lines '(group article summary)
1060   "*List of buffers that should update their mode lines.
1061 The list may contain the symbols `group', `article' and `summary'.  If
1062 the corresponding symbol is present, Gnus will keep that mode line
1063 updated with information that may be pertinent. 
1064 If this variable is nil, screen refresh may be quicker.")
1065
1066 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1067 (defvar gnus-mode-non-string-length 25
1068   "*Max length of mode-line non-string contents.
1069 If this is nil, Gnus will take space as is needed, leaving the rest
1070 of the modeline intact.")
1071
1072 ;see gnus-cus.el
1073 ;(defvar gnus-mouse-face 'highlight
1074 ;  "*Face used for mouse highlighting in Gnus.
1075 ;No mouse highlights will be done if `gnus-visual' is nil.")
1076
1077 (defvar gnus-summary-mark-below nil
1078   "*Mark all articles with a score below this variable as read.
1079 This variable is local to each summary buffer and usually set by the
1080 score file.")  
1081
1082 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1083   "*List of functions used for sorting threads in the summary buffer.
1084 By default, threads are sorted by article number.
1085
1086 Each function takes two threads and return non-nil if the first thread
1087 should be sorted before the other.  If you use more than one function,
1088 the primary sort function should be the last.
1089
1090 Ready-mady functions include `gnus-thread-sort-by-number',
1091 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1092 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1093 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1094
1095 (defvar gnus-thread-score-function '+
1096   "*Function used for calculating the total score of a thread.
1097
1098 The function is called with the scores of the article and each
1099 subthread and should then return the score of the thread.
1100
1101 Some functions you can use are `+', `max', or `min'.")
1102
1103 (defvar gnus-auto-subscribed-groups 
1104   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1105   "*All new groups that match this regexp will be subscribed automatically.
1106 Note that this variable only deals with new groups.  It has no effect
1107 whatsoever on old groups.")
1108
1109 (defvar gnus-options-subscribe nil
1110   "*All new groups matching this regexp will be subscribed unconditionally.
1111 Note that this variable deals only with new newsgroups.  This variable
1112 does not affect old newsgroups.")
1113
1114 (defvar gnus-options-not-subscribe nil
1115   "*All new groups matching this regexp will be ignored.
1116 Note that this variable deals only with new newsgroups.  This variable
1117 does not affect old (already subscribed) newsgroups.")
1118
1119 (defvar gnus-auto-expirable-newsgroups nil
1120   "*Groups in which to automatically mark read articles as expirable.
1121 If non-nil, this should be a regexp that should match all groups in
1122 which to perform auto-expiry.  This only makes sense for mail groups.")
1123
1124 (defvar gnus-total-expirable-newsgroups nil
1125   "*Groups in which to perform expiry of all read articles.
1126 Use with extreme caution.  All groups that match this regexp will be
1127 expiring - which means that all read articles will be deleted after
1128 (say) one week.  (This only goes for mail groups and the like, of
1129 course.)")
1130
1131 (defvar gnus-hidden-properties '(invisible t intangible t)
1132   "Property list to use for hiding text.")
1133
1134 (defvar gnus-modtime-botch nil
1135   "*Non-nil means .newsrc should be deleted prior to save.  Its use is
1136 due to the bogus appearance that .newsrc was modified on disc.")
1137
1138 ;; Hooks.
1139
1140 (defvar gnus-group-mode-hook nil
1141   "*A hook for Gnus group mode.")
1142
1143 (defvar gnus-summary-mode-hook nil
1144   "*A hook for Gnus summary mode.
1145 This hook is run before any variables are set in the summary buffer.")
1146
1147 (defvar gnus-article-mode-hook nil
1148   "*A hook for Gnus article mode.")
1149
1150 (defun gnus-summary-prepare-exit-hook nil
1151   "*A hook called when preparing to exit from the summary buffer.
1152 It calls `gnus-summary-expire-articles' by default.")
1153 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1154
1155 (defun gnus-summary-exit-hook nil
1156   "*A hook called on exit from the summary buffer.")
1157
1158 (defvar gnus-open-server-hook nil
1159   "*A hook called just before opening connection to the news server.")
1160
1161 (defvar gnus-load-hook nil
1162   "*A hook run while Gnus is loaded.")
1163
1164 (defvar gnus-startup-hook nil
1165   "*A hook called at startup.
1166 This hook is called after Gnus is connected to the NNTP server.")
1167
1168 (defvar gnus-get-new-news-hook nil
1169   "*A hook run just before Gnus checks for new news.")
1170
1171 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1172   "*A function that is called to generate the group buffer.
1173 The function is called with three arguments: The first is a number;
1174 all group with a level less or equal to that number should be listed,
1175 if the second is non-nil, empty groups should also be displayed.  If
1176 the third is non-nil, it is a number.  No groups with a level lower
1177 than this number should be displayed.
1178
1179 The only current function implemented is `gnus-group-prepare-flat'.")
1180
1181 (defvar gnus-group-prepare-hook nil
1182   "*A hook called after the group buffer has been generated.
1183 If you want to modify the group buffer, you can use this hook.")
1184
1185 (defvar gnus-summary-prepare-hook nil
1186   "*A hook called after the summary buffer has been generated.
1187 If you want to modify the summary buffer, you can use this hook.")
1188
1189 (defvar gnus-summary-generate-hook nil
1190   "*A hook run just before generating the summary buffer.
1191 This hook is commonly used to customize threading variables and the
1192 like.")
1193
1194 (defvar gnus-article-prepare-hook nil
1195   "*A hook called after an article has been prepared in the article buffer.
1196 If you want to run a special decoding program like nkf, use this hook.")
1197
1198 ;(defvar gnus-article-display-hook nil
1199 ;  "*A hook called after the article is displayed in the article buffer.
1200 ;The hook is designed to change the contents of the article
1201 ;buffer.  Typical functions that this hook may contain are
1202 ;`gnus-article-hide-headers' (hide selected headers),
1203 ;`gnus-article-maybe-highlight' (perform fancy article highlighting), 
1204 ;`gnus-article-hide-signature' (hide signature) and
1205 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1206 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1207 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1208 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1209
1210 (defvar gnus-article-x-face-command
1211   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1212   "String or function to be executed to display an X-Face header.
1213 If it is a string, the command will be executed in a sub-shell
1214 asynchronously.  The compressed face will be piped to this command.") 
1215
1216 (defvar gnus-article-x-face-too-ugly nil
1217   "Regexp matching posters whose face shouldn't be shown automatically.")
1218
1219 (defvar gnus-select-group-hook nil
1220   "*A hook called when a newsgroup is selected.
1221
1222 If you'd like to simplify subjects like the
1223 `gnus-summary-next-same-subject' command does, you can use the
1224 following hook:
1225
1226  (setq gnus-select-group-hook
1227       (list
1228         (lambda ()
1229           (mapcar (lambda (header)
1230                      (mail-header-set-subject
1231                       header
1232                       (gnus-simplify-subject
1233                        (mail-header-subject header) 're-only)))
1234                   gnus-newsgroup-headers))))")
1235
1236 (defvar gnus-select-article-hook
1237   '(gnus-summary-show-thread)
1238   "*A hook called when an article is selected.
1239 The default hook shows conversation thread subtrees of the selected
1240 article automatically using `gnus-summary-show-thread'.")
1241
1242 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1243   "*A hook called to apply kill files to a group.
1244 This hook is intended to apply a kill file to the selected newsgroup.
1245 The function `gnus-apply-kill-file' is called by default.
1246
1247 Since a general kill file is too heavy to use only for a few
1248 newsgroups, I recommend you to use a lighter hook function.  For
1249 example, if you'd like to apply a kill file to articles which contains
1250 a string `rmgroup' in subject in newsgroup `control', you can use the
1251 following hook:
1252
1253  (setq gnus-apply-kill-hook
1254       (list
1255         (lambda ()
1256           (cond ((string-match \"control\" gnus-newsgroup-name)
1257                  (gnus-kill \"Subject\" \"rmgroup\")
1258                  (gnus-expunge \"X\"))))))")
1259
1260 (defvar gnus-visual-mark-article-hook 
1261   (list 'gnus-highlight-selected-summary)
1262   "*Hook run after selecting an article in the summary buffer.
1263 It is meant to be used for highlighting the article in some way.  It
1264 is not run if `gnus-visual' is nil.")
1265
1266 (defvar gnus-exit-group-hook nil
1267   "*A hook called when exiting (not quitting) summary mode.")
1268
1269 (defvar gnus-suspend-gnus-hook nil
1270   "*A hook called when suspending (not exiting) Gnus.")
1271
1272 (defvar gnus-exit-gnus-hook nil
1273   "*A hook called when exiting Gnus.")
1274
1275 (defvar gnus-save-newsrc-hook nil
1276   "*A hook called before saving any of the newsrc files.")
1277
1278 (defvar gnus-save-quick-newsrc-hook nil
1279   "*A hook called just before saving the quick newsrc file.
1280 Can be used to turn version control on or off.")
1281
1282 (defvar gnus-save-standard-newsrc-hook nil
1283   "*A hook called just before saving the standard newsrc file.
1284 Can be used to turn version control on or off.")
1285
1286 (defvar gnus-summary-update-hook 
1287   (list 'gnus-summary-highlight-line)
1288   "*A hook called when a summary line is changed.
1289 The hook will not be called if `gnus-visual' is nil.
1290
1291 The default function `gnus-summary-highlight-line' will
1292 highlight the line according to the `gnus-summary-highlight'
1293 variable.")
1294
1295 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1296   "*A hook called when an article is selected for the first time.
1297 The hook is intended to mark an article as read (or unread)
1298 automatically when it is selected.")
1299
1300 ;; Remove any hilit infestation.
1301 (add-hook 'gnus-startup-hook
1302           (lambda ()
1303             (remove-hook 'gnus-summary-prepare-hook
1304                          'hilit-rehighlight-buffer-quietly)
1305             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1306             (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
1307             (remove-hook 'gnus-article-prepare-hook
1308                          'hilit-rehighlight-buffer-quietly)))
1309
1310
1311 \f
1312 ;; Internal variables
1313
1314 ;; Avoid highlighting in kill files.
1315 (defvar gnus-summary-inhibit-highlight nil)
1316 (defvar gnus-newsgroup-selected-overlay nil)
1317
1318 (defvar gnus-inhibit-hiding nil)
1319
1320 (defvar gnus-article-mode-map nil)
1321 (defvar gnus-dribble-buffer nil)
1322 (defvar gnus-headers-retrieved-by nil)
1323 (defvar gnus-article-reply nil)
1324 (defvar gnus-override-method nil)
1325 (defvar gnus-article-check-size nil)
1326
1327 (defvar gnus-nocem-hashtb nil)
1328
1329 (defvar gnus-current-score-file nil)
1330 (defvar gnus-scores-exclude-files nil)
1331
1332 (defvar gnus-opened-servers nil)
1333
1334 (defvar gnus-current-move-group nil)
1335
1336 (defvar gnus-newsgroup-dependencies nil)
1337 (defvar gnus-newsgroup-async nil)
1338 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1339
1340 (defvar gnus-newsgroup-adaptive nil)
1341
1342 (defvar gnus-summary-display-table nil)
1343
1344 (defconst gnus-group-line-format-alist
1345   `((?M gnus-tmp-marked ?c)
1346     (?S gnus-tmp-subscribed ?c)
1347     (?L gnus-tmp-level ?d)
1348     (?N gnus-tmp-number ?s)
1349     (?R gnus-tmp-number-of-read ?s)
1350     (?t gnus-tmp-number-total ?d)
1351     (?y gnus-tmp-number-of-unread ?s)
1352     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1353     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1354     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1355            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1356     (?g gnus-tmp-group ?s)
1357     (?G gnus-tmp-qualified-group ?s)
1358     (?D gnus-tmp-newsgroup-description ?s)
1359     (?o gnus-tmp-moderated ?c)
1360     (?O gnus-tmp-moderated-string ?s)
1361     (?p gnus-tmp-process-marked ?c)
1362     (?s gnus-tmp-news-server ?s)
1363     (?n gnus-tmp-news-method ?s)
1364     (?z gnus-tmp-news-method-string ?s)
1365     (?u gnus-tmp-user-defined ?s)))
1366
1367 (defconst gnus-summary-line-format-alist 
1368   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1369     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1370     (?s gnus-tmp-subject-or-nil ?s)
1371     (?n gnus-tmp-name ?s)
1372     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1373         ?s)
1374     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) 
1375             gnus-tmp-from) ?s)
1376     (?F gnus-tmp-from ?s)
1377     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1378     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1379     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1380     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1381     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1382     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1383     (?L gnus-tmp-lines ?d)
1384     (?I gnus-tmp-indentation ?s)
1385     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1386     (?R gnus-tmp-replied ?c)
1387     (?\[ gnus-tmp-opening-bracket ?c)
1388     (?\] gnus-tmp-closing-bracket ?c)
1389     (?\> (make-string gnus-tmp-level ? ) ?s)
1390     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1391     (?i gnus-tmp-score ?d)
1392     (?z gnus-tmp-score-char ?c)
1393     (?U gnus-tmp-unread ?c)
1394     (?t (gnus-summary-number-of-articles-in-thread 
1395          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1396         ?d)
1397     (?e (gnus-summary-number-of-articles-in-thread 
1398          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1399         ?c)
1400     (?u gnus-tmp-user-defined ?s))
1401   "An alist of format specifications that can appear in summary lines,
1402 and what variables they correspond with, along with the type of the
1403 variable (string, integer, character, etc).")
1404
1405 (defconst gnus-summary-dummy-line-format-alist
1406   (` ((?S gnus-tmp-subject ?s)
1407       (?N gnus-tmp-number ?d)
1408       (?u gnus-tmp-user-defined ?s))))
1409
1410 (defconst gnus-summary-mode-line-format-alist 
1411   (` ((?G gnus-tmp-group-name ?s)
1412       (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1413       (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1414       (?A gnus-tmp-article-number ?d)
1415       (?Z gnus-tmp-unread-and-unselected ?s)
1416       (?V gnus-version ?s)
1417       (?U gnus-tmp-unread ?d)
1418       (?S gnus-tmp-subject ?s)
1419       (?e gnus-tmp-unselected ?d)
1420       (?u gnus-tmp-user-defined ?s)
1421       (?d (length gnus-newsgroup-dormant) ?d)
1422       (?t (length gnus-newsgroup-marked) ?d)
1423       (?r (length gnus-newsgroup-reads) ?d)
1424       (?E gnus-newsgroup-expunged-tally ?d)
1425       (?s (gnus-current-score-file-nondirectory) ?s))))
1426
1427 (defconst gnus-group-mode-line-format-alist 
1428   (` ((?S gnus-tmp-news-server ?s)
1429       (?M gnus-tmp-news-method ?s)
1430       (?u gnus-tmp-user-defined ?s))))
1431
1432 (defvar gnus-have-read-active-file nil)
1433
1434 (defconst gnus-maintainer
1435   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1436   "The mail address of the Gnus maintainers.")
1437
1438 (defconst gnus-version "September Gnus v0.18"
1439   "Version number for this version of Gnus.")
1440
1441 (defvar gnus-info-nodes
1442   '((gnus-group-mode            "(gnus)The Group Buffer")
1443     (gnus-summary-mode          "(gnus)The Summary Buffer")
1444     (gnus-article-mode          "(gnus)The Article Buffer"))
1445   "Assoc list of major modes and related Info nodes.")
1446
1447 (defvar gnus-group-buffer "*Group*")
1448 (defvar gnus-summary-buffer "*Summary*")
1449 (defvar gnus-article-buffer "*Article*")
1450 (defvar gnus-server-buffer "*Server*")
1451
1452 (defvar gnus-work-buffer " *gnus work*")
1453
1454 (defvar gnus-original-article-buffer " *Original Article*")
1455 (defvar gnus-original-article nil)
1456
1457 (defvar gnus-buffer-list nil
1458   "Gnus buffers that should be killed on exit.")
1459
1460 (defvar gnus-server-alist nil
1461   "List of available servers.")
1462
1463 (defvar gnus-slave nil
1464   "Whether this Gnus is a slave or not.")
1465
1466 (defvar gnus-variable-list
1467   '(gnus-newsrc-options gnus-newsrc-options-n
1468     gnus-newsrc-last-checked-date 
1469     gnus-newsrc-alist gnus-server-alist
1470     gnus-killed-list gnus-zombie-list
1471     gnus-topic-topology gnus-topic-alist)
1472   "Gnus variables saved in the quick startup file.")
1473
1474 (defvar gnus-newsrc-options nil
1475   "Options line in the .newsrc file.")
1476
1477 (defvar gnus-newsrc-options-n nil
1478   "List of regexps representing groups to be subscribed/ignored unconditionally.") 
1479
1480 (defvar gnus-newsrc-last-checked-date nil
1481   "Date Gnus last asked server for new newsgroups.")
1482
1483 (defvar gnus-topic-topology nil
1484   "The complete topic hierarchy.")
1485
1486 (defvar gnus-topic-alist nil
1487   "The complete topic-group alist.")
1488
1489 (defvar gnus-newsrc-alist nil
1490   "Assoc list of read articles.
1491 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1492
1493 (defvar gnus-newsrc-hashtb nil
1494   "Hashtable of gnus-newsrc-alist.")
1495
1496 (defvar gnus-killed-list nil
1497   "List of killed newsgroups.")
1498
1499 (defvar gnus-killed-hashtb nil
1500   "Hash table equivalent of gnus-killed-list.")
1501
1502 (defvar gnus-zombie-list nil
1503   "List of almost dead newsgroups.")
1504
1505 (defvar gnus-description-hashtb nil
1506   "Descriptions of newsgroups.")
1507
1508 (defvar gnus-list-of-killed-groups nil
1509   "List of newsgroups that have recently been killed by the user.")
1510
1511 (defvar gnus-active-hashtb nil
1512   "Hashtable of active articles.")
1513
1514 (defvar gnus-moderated-list nil
1515   "List of moderated newsgroups.")
1516
1517 (defvar gnus-group-marked nil)
1518
1519 (defvar gnus-current-startup-file nil
1520   "Startup file for the current host.")
1521
1522 (defvar gnus-last-search-regexp nil
1523   "Default regexp for article search command.")
1524
1525 (defvar gnus-last-shell-command nil
1526   "Default shell command on article.")
1527
1528 (defvar gnus-current-select-method nil
1529   "The current method for selecting a newsgroup.")
1530
1531 (defvar gnus-group-list-mode nil)
1532
1533 (defvar gnus-article-internal-prepare-hook nil)
1534
1535 (defvar gnus-newsgroup-name nil)
1536 (defvar gnus-newsgroup-begin nil)
1537 (defvar gnus-newsgroup-end nil)
1538 (defvar gnus-newsgroup-last-rmail nil)
1539 (defvar gnus-newsgroup-last-mail nil)
1540 (defvar gnus-newsgroup-last-folder nil)
1541 (defvar gnus-newsgroup-last-file nil)
1542 (defvar gnus-newsgroup-auto-expire nil)
1543 (defvar gnus-newsgroup-active nil)
1544
1545 (defvar gnus-newsgroup-data nil)
1546 (defvar gnus-newsgroup-data-reverse nil)
1547 (defvar gnus-newsgroup-limit nil)
1548 (defvar gnus-newsgroup-limits nil)
1549
1550 (defvar gnus-newsgroup-unreads nil
1551   "List of unread articles in the current newsgroup.")
1552
1553 (defvar gnus-newsgroup-unselected nil
1554   "List of unselected unread articles in the current newsgroup.")
1555
1556 (defvar gnus-newsgroup-reads nil
1557   "Alist of read articles and article marks in the current newsgroup.")
1558
1559 (defvar gnus-newsgroup-expunged-tally nil)
1560
1561 (defvar gnus-newsgroup-marked nil
1562   "List of ticked articles in the current newsgroup (a subset of unread art).")
1563
1564 (defvar gnus-newsgroup-killed nil
1565   "List of ranges of articles that have been through the scoring process.")
1566
1567 (defvar gnus-newsgroup-kill-headers nil)
1568
1569 (defvar gnus-newsgroup-replied nil
1570   "List of articles that have been replied to in the current newsgroup.")
1571
1572 (defvar gnus-newsgroup-expirable nil
1573   "List of articles in the current newsgroup that can be expired.")
1574
1575 (defvar gnus-newsgroup-processable nil
1576   "List of articles in the current newsgroup that can be processed.")
1577
1578 (defvar gnus-newsgroup-bookmarks nil
1579   "List of articles in the current newsgroup that have bookmarks.")
1580
1581 (defvar gnus-newsgroup-dormant nil
1582   "List of dormant articles in the current newsgroup.")
1583
1584 (defvar gnus-newsgroup-scored nil
1585   "List of scored articles in the current newsgroup.")
1586
1587 (defvar gnus-newsgroup-headers nil
1588   "List of article headers in the current newsgroup.")
1589
1590 (defvar gnus-newsgroup-threads nil)
1591
1592 (defvar gnus-newsgroup-prepared nil
1593   "Whether the current group has been prepared properly.")
1594
1595 (defvar gnus-newsgroup-ancient nil
1596   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1597
1598 (defvar gnus-current-article nil)
1599 (defvar gnus-article-current nil)
1600 (defvar gnus-current-headers nil)
1601 (defvar gnus-have-all-headers nil)
1602 (defvar gnus-last-article nil)
1603 (defvar gnus-newsgroup-history nil)
1604 (defvar gnus-current-kill-article nil)
1605
1606 ;; Save window configuration.
1607 (defvar gnus-prev-winconf nil)
1608
1609 (defvar gnus-summary-mark-positions nil)
1610 (defvar gnus-group-mark-positions nil)
1611
1612 (defvar gnus-summary-expunge-below nil)
1613 (defvar gnus-reffed-article-number nil)
1614
1615 ;;; Let the byte-compiler know that we know about this variable.
1616 (defvar rmail-default-rmail-file)
1617
1618 (defvar gnus-cache-removeable-articles nil)
1619
1620 (defconst gnus-summary-local-variables 
1621   '(gnus-newsgroup-name 
1622     gnus-newsgroup-begin gnus-newsgroup-end 
1623     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail 
1624     gnus-newsgroup-last-folder gnus-newsgroup-last-file 
1625     gnus-newsgroup-auto-expire gnus-newsgroup-unreads 
1626     gnus-newsgroup-unselected gnus-newsgroup-marked
1627     gnus-newsgroup-reads
1628     gnus-newsgroup-replied gnus-newsgroup-expirable
1629     gnus-newsgroup-processable gnus-newsgroup-killed
1630     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1631     gnus-newsgroup-headers gnus-newsgroup-threads
1632     gnus-newsgroup-prepared
1633     gnus-current-article gnus-current-headers gnus-have-all-headers
1634     gnus-last-article gnus-article-internal-prepare-hook
1635     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1636     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1637     gnus-newsgroup-async
1638     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below 
1639     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1640     gnus-newsgroup-history gnus-newsgroup-ancient
1641     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1642     (gnus-newsgroup-expunged-tally . 0)
1643     gnus-cache-removeable-articles
1644     gnus-newsgroup-data gnus-newsgroup-data-reverse
1645     gnus-newsgroup-limit gnus-newsgroup-limits)
1646   "Variables that are buffer-local to the summary buffers.")
1647
1648 (defconst gnus-bug-message
1649   "Sending a bug report to the Gnus Towers.
1650 ========================================
1651
1652 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1653 be sent to the Gnus Bug Exterminators. 
1654
1655 At the bottom of the buffer you'll see lots of variable settings.
1656 Please do not delete those.  They will tell the Bug People what your
1657 environment is, so that it will be easier to locate the bugs.
1658
1659 If you have found a bug that makes Emacs go \"beep\", set
1660 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') 
1661 and include the backtrace in your bug report.
1662
1663 Please describe the bug in annoying, painstaking detail.
1664
1665 Thank you for your help in stamping out bugs.
1666 ")
1667
1668 ;;; End of variables.
1669
1670 ;; Define some autoload functions Gnus might use.
1671 (eval-and-compile
1672
1673   ;; This little mapcar goes through the list below and marks the
1674   ;; symbols in question as autoloaded functions.
1675   (mapcar 
1676    (lambda (package)
1677      (let ((interactive (nth 1 (memq ':interactive package))))
1678        (mapcar 
1679         (lambda (function)
1680           (let (keymap)
1681             (when (consp function)
1682               (setq keymap (car (memq 'keymap function)))
1683               (setq function (car function)))
1684             (autoload function (car package) nil interactive keymap)))
1685         (if (eq (nth 1 package) ':interactive)
1686             (cdddr package)
1687           (cdr package)))))
1688    '(("metamail" metamail-buffer)
1689      ("info" Info-goto-node)
1690      ("hexl" hexl-hex-string-to-integer)
1691      ("pp" pp pp-to-string pp-eval-expression)
1692      ("mail-extr" mail-extract-address-components)
1693      ("nnmail" nnmail-split-fancy nnmail-article-group)
1694      ("nnvirtual" nnvirtual-catchup-group)
1695      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1696       timezone-make-sortable-date timezone-make-time-string)
1697      ("sendmail" mail-position-on-field mail-setup)
1698      ("rmailout" rmail-output)
1699      ("rnewspost" news-mail-other-window news-reply-yank-original 
1700       news-caesar-buffer-body)
1701      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1702       rmail-show-message)
1703      ("gnus-soup" :interactive t
1704       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article 
1705       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1706      ("nnsoup" nnsoup-pack-replies)
1707      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder 
1708       gnus-Folder-save-name gnus-folder-save-name)
1709      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1710      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1711       gnus-server-make-menu-bar gnus-article-make-menu-bar
1712       gnus-browse-make-menu-bar gnus-highlight-selected-summary
1713       gnus-summary-highlight-line gnus-carpal-setup-buffer
1714       gnus-article-add-button)
1715      ("gnus-vis" :interactive t
1716       gnus-article-push-button gnus-article-press-button 
1717       gnus-article-highlight gnus-article-highlight-some 
1718       gnus-article-hide gnus-article-hide-signature 
1719       gnus-article-highlight-headers gnus-article-highlight-signature 
1720       gnus-article-add-buttons gnus-article-add-buttons-to-head 
1721       gnus-article-next-button)
1722      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1723       gnus-demon-add-disconnection gnus-demon-add-handler
1724       gnus-demon-remove-handler)
1725      ("gnus-demon" :interactive t
1726       gnus-demon-init gnus-demon-cancel)
1727      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
1728      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1729      ("gnus-cite" :interactive t
1730       gnus-article-highlight-citation gnus-article-hide-citation-maybe 
1731       gnus-article-hide-citation)
1732      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal 
1733       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author 
1734       gnus-execute gnus-expunge)
1735      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
1736       gnus-cache-possibly-remove-articles gnus-cache-request-article
1737       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
1738       gnus-cache-enter-remove-article)
1739      ("gnus-cache" :interactive t gnus-jog-cache)
1740      ("gnus-score" :interactive t
1741       gnus-summary-increase-score gnus-summary-lower-score
1742       gnus-score-flush-cache gnus-score-close 
1743       gnus-score-raise-same-subject-and-select 
1744       gnus-score-raise-same-subject gnus-score-default 
1745       gnus-score-raise-thread gnus-score-lower-same-subject-and-select 
1746       gnus-score-lower-same-subject gnus-score-lower-thread 
1747       gnus-possibly-score-headers)
1748      ("gnus-score" 
1749       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
1750       gnus-current-score-file-nondirectory gnus-score-adaptive
1751       gnus-score-find-trace gnus-score-file-name)
1752      ("gnus-edit" :interactive t gnus-score-customize)
1753      ("gnus-topic" :interactive t gnus-topic-mode)
1754      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
1755      ("gnus-uu" :interactive t
1756       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward 
1757       gnus-uu-mark-series gnus-uu-mark-region 
1758       gnus-uu-mark-by-regexp gnus-uu-mark-all 
1759       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu 
1760       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar 
1761       gnus-uu-decode-unshar-and-save gnus-uu-decode-save 
1762       gnus-uu-decode-binhex gnus-uu-decode-uu-view 
1763       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view 
1764       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view 
1765       gnus-uu-decode-binhex-view)
1766      ("gnus-msg" (gnus-summary-send-map keymap)
1767       gnus-mail-yank-original gnus-mail-send-and-exit
1768       gnus-sendmail-setup-mail gnus-article-mail 
1769       gnus-inews-message-id)
1770      ("gnus-msg" :interactive t
1771       gnus-group-post-news gnus-group-mail gnus-summary-post-news
1772       gnus-summary-followup gnus-summary-followup-with-original
1773       gnus-summary-followup-and-reply
1774       gnus-summary-followup-and-reply-with-original
1775       gnus-summary-cancel-article gnus-summary-supersede-article
1776       gnus-post-news gnus-inews-news gnus-cancel-news
1777       gnus-summary-reply gnus-summary-reply-with-original
1778       gnus-summary-mail-forward gnus-summary-mail-other-window
1779       gnus-bug)
1780      ("gnus-vm" gnus-vm-mail-setup)
1781      ("gnus-vm" :interactive t gnus-summary-save-in-vm
1782       gnus-summary-save-article-vm gnus-yank-article))))
1783
1784 \f
1785
1786 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1787 ;; If you want the cursor to go somewhere else, set these two
1788 ;; functions in some startup hook to whatever you want.
1789 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
1790 (defalias 'gnus-group-position-point 'gnus-goto-colon)
1791
1792 ;;; Various macros and substs.
1793
1794 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
1795   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
1796   `(let ((GnusStartBufferWindow (selected-window)))
1797      (unwind-protect
1798          (progn
1799            (pop-to-buffer ,buffer)
1800            ,@forms)
1801        (select-window GnusStartBufferWindow))))
1802
1803 (defmacro gnus-gethash (string hashtable)
1804   "Get hash value of STRING in HASHTABLE."
1805   `(symbol-value (intern-soft ,string ,hashtable)))
1806
1807 (defmacro gnus-sethash (string value hashtable)
1808   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
1809   `(set (intern ,string ,hashtable) ,value))
1810
1811 (defmacro gnus-intern-safe (string hashtable)
1812   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
1813   `(let ((symbol (intern ,string ,hashtable)))
1814      (or (boundp symbol)
1815          (set symbol nil))
1816      symbol))
1817
1818 (defmacro gnus-group-unread (group)
1819   "Get the currently computed number of unread articles in GROUP."
1820   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
1821
1822 (defmacro gnus-active (group)
1823   "Get active info on GROUP."
1824   `(gnus-gethash ,group gnus-active-hashtb))
1825
1826 (defmacro gnus-set-active (group active)
1827   "Set GROUP's active info."
1828   `(gnus-sethash ,group ,active gnus-active-hashtb))
1829
1830 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
1831 ;;   function `substring' might cut on a middle of multi-octet
1832 ;;   character.
1833 (defun gnus-truncate-string (str width)
1834   (substring str 0 width))
1835
1836 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
1837 ;; to limit the length of a string.  This function is necessary since
1838 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
1839 (defsubst gnus-limit-string (str width)
1840   (if (> (length str) width)
1841       (substring str 0 width)
1842     str))
1843
1844 (defsubst gnus-simplify-subject-re (subject)
1845   "Remove \"Re:\" from subject lines."
1846   (if (string-match "^[Rr][Ee]: *" subject)
1847       (substring subject (match-end 0))
1848     subject))
1849
1850 (defsubst gnus-goto-char (point)
1851   (and point (goto-char point)))
1852
1853 (defmacro gnus-buffer-exists-p (buffer)
1854   `(and ,buffer
1855         (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
1856                  ,buffer)))
1857
1858 (defmacro gnus-kill-buffer (buffer)
1859   `(let ((buf ,buffer))
1860      (if (gnus-buffer-exists-p buf)
1861          (kill-buffer buf))))
1862
1863 (defsubst gnus-point-at-bol ()
1864   "Return point at the beginning of the line."
1865   (let ((p (point)))
1866     (beginning-of-line)
1867     (prog1
1868         (point)
1869       (goto-char p))))
1870
1871 (defsubst gnus-point-at-eol ()
1872   "Return point at the end of the line."
1873   (let ((p (point)))
1874     (end-of-line)
1875     (prog1
1876         (point)
1877       (goto-char p))))
1878
1879 ;; Delete the current line (and the next N lines.);
1880 (defmacro gnus-delete-line (&optional n)
1881   `(delete-region (progn (beginning-of-line) (point))
1882                   (progn (forward-line ,(or n 1)) (point))))
1883
1884 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
1885 (defvar gnus-init-inhibit nil)
1886 (defun gnus-read-init-file (&optional inhibit-next)
1887   (if gnus-init-inhibit
1888       (setq gnus-init-inhibit nil)
1889     (setq gnus-init-inhibit inhibit-next)
1890     (and gnus-init-file
1891          (or (and (file-exists-p gnus-init-file) 
1892                   ;; Don't try to load a directory.
1893                   (not (file-directory-p gnus-init-file)))
1894              (file-exists-p (concat gnus-init-file ".el"))
1895              (file-exists-p (concat gnus-init-file ".elc")))
1896          (load gnus-init-file nil t))))
1897
1898 ;; Info access macros.
1899
1900 (defmacro gnus-info-group (info)
1901   `(nth 0 ,info))
1902 (defmacro gnus-info-rank (info)
1903   `(nth 1 ,info))
1904 (defmacro gnus-info-read (info)
1905   `(nth 2 ,info))
1906 (defmacro gnus-info-marks (info)
1907   `(nth 3 ,info))
1908 (defmacro gnus-info-method (info)
1909   `(nth 4 ,info))
1910 (defmacro gnus-info-params (info)
1911   `(nth 5 ,info))
1912
1913 (defmacro gnus-info-level (info)
1914   `(let ((rank (gnus-info-rank ,info)))
1915      (if (consp rank)
1916          (car rank)
1917        rank)))
1918 (defmacro gnus-info-score (info)
1919   `(let ((rank (gnus-info-rank ,info)))
1920      (or (and (consp rank) (cdr rank)) 0)))
1921
1922 (defmacro gnus-info-set-group (info group)
1923   `(setcar ,info ,group))
1924 (defmacro gnus-info-set-rank (info rank)
1925   `(setcar (nthcdr 1 ,info) ,rank))
1926 (defmacro gnus-info-set-read (info read)
1927   `(setcar (nthcdr 2 ,info) ,read))
1928 (defmacro gnus-info-set-marks (info marks)
1929   `(setcar (nthcdr 3 ,info) ,marks))
1930 (defmacro gnus-info-set-method (info method)
1931   `(setcar (nthcdr 4 ,info) ,method))
1932 (defmacro gnus-info-set-params (info params)
1933   `(setcar (nthcdr 5 ,info) ,params))
1934
1935 (defmacro gnus-info-set-level (info level)
1936   `(let ((rank (cdr ,info)))
1937      (if (consp (car rank))
1938          (setcar (car rank) ,level)
1939        (setcar rank ,level))))
1940 (defmacro gnus-info-set-score (info score)
1941   `(let ((rank (cdr ,info)))
1942      (if (consp (car rank))
1943          (setcdr (car rank) ,score)
1944        (setcar rank (cons (car rank) ,score)))))
1945
1946 (defmacro gnus-get-info (group)
1947   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
1948
1949 (defun gnus-byte-code (func)
1950   "Return a form that can be `eval'ed based on FUNC."
1951   (let ((fval (symbol-function func)))
1952     (if (byte-code-function-p fval)
1953         (let ((flist (append fval nil)))
1954           (setcar flist 'byte-code)
1955           flist)
1956       (cons 'progn (cdr (cdr fval))))))
1957
1958 ;;; Load the user startup file.
1959 ;; (eval '(gnus-read-init-file 'inhibit))
1960
1961 ;;; Load the compatability functions. 
1962
1963 (require 'gnus-cus)
1964 (require 'gnus-ems)
1965
1966 \f
1967
1968 ;; Format specs.  The chunks below are the machine-generated forms
1969 ;; that are to be evaled as the result of the default format strings.
1970 ;; We write them in here to get them byte-compiled.  That way the
1971 ;; default actions will be quite fast, while still retaining the full
1972 ;; flexibility of the user-defined format specs. 
1973
1974 ;; First we have lots of dummy defvars to let the compiler know these
1975 ;; are really dynamic variables.
1976
1977 (defvar gnus-tmp-unread)
1978 (defvar gnus-tmp-replied)
1979 (defvar gnus-tmp-score-char)
1980 (defvar gnus-tmp-indentation)
1981 (defvar gnus-tmp-opening-bracket)
1982 (defvar gnus-tmp-lines)
1983 (defvar gnus-tmp-name)
1984 (defvar gnus-tmp-closing-bracket)
1985 (defvar gnus-tmp-subject-or-nil)
1986 (defvar gnus-tmp-subject)
1987 (defvar gnus-tmp-marked)
1988 (defvar gnus-tmp-subscribed)
1989 (defvar gnus-tmp-process-marked)
1990 (defvar gnus-tmp-number-of-unread)
1991 (defvar gnus-tmp-group-name)
1992 (defvar gnus-tmp-group)
1993 (defvar gnus-tmp-article-number)
1994 (defvar gnus-tmp-unread-and-unselected)
1995 (defvar gnus-tmp-news-method)
1996 (defvar gnus-tmp-news-server)
1997 (defvar gnus-tmp-article-number)
1998 (defvar gnus-mouse-face)
1999 (defvar gnus-mouse-face-prop)
2000
2001 (defun gnus-summary-line-format-spec ()
2002   (insert gnus-tmp-unread gnus-tmp-replied 
2003           gnus-tmp-score-char gnus-tmp-indentation)
2004   (put-text-property
2005    (point)
2006    (progn
2007      (insert 
2008       gnus-tmp-opening-bracket 
2009       (format "%4d: %-20s" 
2010               gnus-tmp-lines 
2011               (if (> (length gnus-tmp-name) 20) 
2012                   (substring gnus-tmp-name 0 20) 
2013                 gnus-tmp-name))
2014       gnus-tmp-closing-bracket)
2015      (point))
2016    gnus-mouse-face-prop gnus-mouse-face)
2017   (insert " " gnus-tmp-subject-or-nil "\n"))
2018
2019 (defvar gnus-summary-line-format-spec 
2020   (gnus-byte-code 'gnus-summary-line-format-spec))
2021
2022 (defun gnus-summary-dummy-line-format-spec ()
2023   (insert "*  ")
2024   (put-text-property
2025    (point)
2026    (progn
2027      (insert ":                          :")
2028      (point))
2029    gnus-mouse-face-prop gnus-mouse-face)
2030   (insert " " gnus-tmp-subject "\n"))
2031
2032 (defvar gnus-summary-dummy-line-format-spec 
2033   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2034
2035 (defun gnus-group-line-format-spec ()
2036   (insert gnus-tmp-marked gnus-tmp-subscribed 
2037           gnus-tmp-process-marked
2038           (format "%5s: " gnus-tmp-number-of-unread))
2039   (put-text-property 
2040    (point)
2041    (progn
2042      (insert gnus-tmp-group "\n")
2043      (1- (point)))
2044    gnus-mouse-face-prop gnus-mouse-face))
2045 (defvar gnus-group-line-format-spec 
2046   (gnus-byte-code 'gnus-group-line-format-spec))
2047
2048 (defun gnus-summary-mode-line-format-spec ()
2049   (format "Gnus  %s/%d %s" gnus-tmp-group-name
2050           gnus-tmp-article-number gnus-tmp-unread-and-unselected))
2051 (defvar gnus-summary-mode-line-format-spec
2052   (gnus-byte-code 'gnus-summary-mode-line-format-spec))
2053
2054 (defun gnus-group-mode-line-format-spec ()
2055   (format "Gnus  List of groups   {%s:%s}  "
2056           gnus-tmp-news-method gnus-tmp-news-server))
2057 (defvar gnus-group-mode-line-format-spec 
2058   (gnus-byte-code 'gnus-group-mode-line-format-spec))
2059
2060 (defun gnus-article-mode-line-format-spec ()
2061   (format "Gnus  %s/%d %s" gnus-tmp-group-name
2062           gnus-tmp-article-number gnus-tmp-subject))
2063 (defvar gnus-article-mode-line-format-spec
2064   (gnus-byte-code 'gnus-article-mode-line-format-spec))
2065
2066 (defvar gnus-old-specs 
2067   '((article-mode . "Gnus  %G/%A %S")
2068     (group-mode . "Gnus  List of groups   {%M:%S}  ")
2069     (summary-mode . "Gnus  %G/%A %Z")
2070     (group . "%M%S%p%5y: %(%g%)\n")
2071     (summary-dummy . "*  :                          : %S\n")
2072     (summary . "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n")))
2073
2074 ;;; Phew.  All that gruft is over, fortunately.  
2075
2076 \f
2077 ;;;
2078 ;;; Gnus Utility Functions
2079 ;;;
2080
2081 (defun gnus-extract-address-components (from)
2082   (let (name address)
2083     ;; First find the address - the thing with the @ in it.  This may
2084     ;; not be accurate in mail addresses, but does the trick most of
2085     ;; the time in news messages.
2086     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2087         (setq address (substring from (match-beginning 0) (match-end 0))))
2088     ;; Then we check whether the "name <address>" format is used.
2089     (and address
2090          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2091          ;; Linear white space is not required.
2092          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2093          (and (setq name (substring from 0 (match-beginning 0)))
2094               ;; Strip any quotes from the name.
2095               (string-match "\".*\"" name)
2096               (setq name (substring name 1 (1- (match-end 0))))))
2097     ;; If not, then "address (name)" is used.
2098     (or name
2099         (and (string-match "(.+)" from)
2100              (setq name (substring from (1+ (match-beginning 0)) 
2101                                    (1- (match-end 0)))))
2102         (and (string-match "()" from)
2103              (setq name address))
2104         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2105         ;; XOVER might not support folded From headers.
2106         (and (string-match "(.*" from)
2107              (setq name (substring from (1+ (match-beginning 0)) 
2108                                    (match-end 0)))))
2109     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2110     (list (or name from) (or address from))))
2111
2112 (defun gnus-fetch-field (field)
2113   "Return the value of the header FIELD of current article."
2114   (save-excursion
2115     (save-restriction
2116       (let ((case-fold-search t))
2117         (gnus-narrow-to-headers)
2118         (mail-fetch-field field)))))
2119
2120 (defun gnus-goto-colon ()
2121   (beginning-of-line)
2122   (search-forward ":" (gnus-point-at-eol) t))
2123
2124 (defun gnus-narrow-to-headers ()
2125   "Narrow to the head of an article."
2126   (widen)
2127   (narrow-to-region
2128    (goto-char (point-min))
2129    (if (search-forward "\n\n" nil t)
2130        (1- (point))
2131      (point-max)))
2132   (goto-char (point-min)))
2133
2134 ;;;###autoload
2135 (defun gnus-update-format (var)
2136   "Update the format specification near point."
2137   (interactive
2138    (list
2139     (save-excursion
2140       (eval-defun nil)
2141       ;; Find the end of the current word.
2142       (re-search-forward "[ \t\n]" nil t)
2143       ;; Search backward.
2144       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2145         (match-string 1)))))
2146   (set
2147    (intern (format "%s-spec" var))
2148    (gnus-parse-format (symbol-value (intern var))
2149                       (symbol-value (intern (format "%s-alist" var)))
2150                       (not (string-match "mode" var))))
2151   (pop-to-buffer "*Gnus Format*")
2152   (erase-buffer)
2153   (lisp-interaction-mode)
2154   (insert (pp-to-string (symbol-value (intern (format "%s-spec" var))))))
2155
2156
2157 (defun gnus-update-format-specifications (&optional force)
2158   (gnus-make-thread-indent-array)
2159
2160   (when force
2161     (setq gnus-old-specs nil))
2162
2163   (let ((formats '(summary summary-dummy group 
2164                            summary-mode group-mode article-mode))
2165         old-format new-format)
2166     (while formats
2167       (setq new-format (symbol-value
2168                         (intern (format "gnus-%s-line-format" (car formats)))))
2169       (or (and (setq old-format (cdr (assq (car formats) gnus-old-specs)))
2170                (equal old-format new-format))
2171           (set (intern (format "gnus-%s-line-format-spec" (car formats)))
2172                (if (not (stringp new-format)) new-format
2173                  (gnus-parse-format
2174                   new-format
2175                   (symbol-value 
2176                    (intern (format "gnus-%s-line-format-alist"
2177                                    (if (eq (car formats) 'article-mode)
2178                                        'summary-mode (car formats)))))
2179                   (not (string-match "mode$" (symbol-name (car formats))))))))
2180       (setq gnus-old-specs (cons (cons (car formats) new-format)
2181                                  (delq (assq (car formats) gnus-old-specs)
2182                                        gnus-old-specs)))
2183       (setq formats (cdr formats))))
2184       
2185   (gnus-update-group-mark-positions)
2186   (gnus-update-summary-mark-positions)
2187
2188   (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
2189            (not gnus-description-hashtb)
2190            gnus-read-active-file)
2191       (gnus-read-all-descriptions-files)))
2192
2193 (defun gnus-update-summary-mark-positions ()
2194   (save-excursion
2195     (let ((gnus-replied-mark 129)
2196           (gnus-score-below-mark 130)
2197           (gnus-score-over-mark 130)
2198           (thread nil)
2199           (gnus-visual nil)
2200           pos)
2201       (gnus-set-work-buffer)
2202       (gnus-summary-insert-line 
2203        [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2204       (goto-char (point-min))
2205       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2206                                          (- (point) 2)))))
2207       (goto-char (point-min))
2208       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
2209                                           (- (point) 2))) pos))
2210       (goto-char (point-min))
2211       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
2212                                         (- (point) 2))) pos))
2213       (setq gnus-summary-mark-positions pos))))
2214
2215 (defun gnus-update-group-mark-positions ()
2216   (save-excursion
2217     (let ((gnus-process-mark 128)
2218           (gnus-group-marked '("dummy.group")))
2219       (gnus-set-active "dummy.group" '(0 . 0))
2220       (gnus-set-work-buffer)
2221       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2222       (goto-char (point-min))
2223       (setq gnus-group-mark-positions
2224             (list (cons 'process (and (search-forward "\200" nil t)
2225                                       (- (point) 2))))))))
2226
2227 (defvar gnus-mouse-face-0 'highlight)
2228 (defvar gnus-mouse-face-1 'highlight)
2229 (defvar gnus-mouse-face-2 'highlight)
2230 (defvar gnus-mouse-face-3 'highlight)
2231 (defvar gnus-mouse-face-4 'highlight)
2232
2233 (defun gnus-mouse-face-function (form type)
2234   `(put-text-property
2235     (point) (progn ,@form (point))
2236     gnus-mouse-face-prop 
2237     ,(if (equal type 0)
2238          'gnus-mouse-face
2239        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2240
2241 (defvar gnus-face-0 'bold)
2242 (defvar gnus-face-1 'italic)
2243 (defvar gnus-face-2 'bold-italic)
2244 (defvar gnus-face-3 'bold)
2245 (defvar gnus-face-4 'bold)
2246
2247 (defun gnus-face-face-function (form type)
2248   `(put-text-property
2249     (point) (progn ,@form (point))
2250     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2251
2252 (defun gnus-max-width-function (el max-width)
2253   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2254   (if (symbolp el)
2255       `(if (> (length ,el) ,max-width)
2256            (substring ,el 0 ,max-width)
2257          ,el)
2258     `(let ((val (eval ,el)))
2259        (if (numberp val)
2260            (setq val (int-to-string val)))
2261        (if (> (length val) ,max-width)
2262            (substring val 0 ,max-width))
2263        val)))
2264
2265 (defun gnus-parse-format (format spec-alist &optional insert)
2266   ;; This function parses the FORMAT string with the help of the
2267   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2268   ;; string.  If the FORMAT string contains the specifiers %( and %)
2269   ;; the text between them will have the mouse-face text property.
2270   (if (string-match 
2271        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2272        format)
2273       (gnus-parse-complex-format format spec-alist)
2274     ;; This is a simple format.
2275     (gnus-parse-simple-format format spec-alist insert)))
2276
2277 (defun gnus-parse-complex-format (format spec-alist)
2278   (save-excursion
2279     (gnus-set-work-buffer)
2280     (insert format)
2281     (goto-char (point-min))
2282     (while (re-search-forward "\"" nil t)
2283       (replace-match "\\\"" nil t))
2284     (goto-char (point-min))
2285     (insert "(\"")
2286     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2287       (let ((number (if (match-beginning 1)
2288                         (match-string 1) "0"))
2289             (delim (aref (match-string 2) 0)))
2290         (if (or (= delim ?\() (= delim ?\{))
2291             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2292                                    " " number " \""))
2293           (replace-match "\")\""))))
2294     (goto-char (point-max))
2295     (insert "\")")
2296     (goto-char (point-min))
2297     (let ((form (read (current-buffer))))
2298       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2299
2300 (defun gnus-complex-form-to-spec (form spec-alist)
2301   (delq nil
2302         (mapcar
2303          (lambda (sform)
2304            (if (stringp sform)
2305                (gnus-parse-simple-format sform spec-alist t)
2306              (funcall (intern (format "gnus-%s-face-function"
2307                                       (car sform)))
2308                       (gnus-complex-form-to-spec 
2309                        (cdr (cdr sform)) spec-alist)
2310                       (nth 1 sform))))
2311          form)))
2312     
2313 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2314   ;; This function parses the FORMAT string with the help of the
2315   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2316   ;; string.  
2317   (let ((max-width 0)
2318         spec flist fstring newspec elem beg result dontinsert)
2319     (save-excursion
2320       (gnus-set-work-buffer)
2321       (insert format)
2322       (goto-char (point-min))
2323       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2324                                 nil t)
2325         (setq spec (string-to-char (match-string 2)))
2326         ;; First check if there are any specs that look anything like
2327         ;; "%12,12A", ie. with a "max width specification".  These have
2328         ;; to be treated specially.
2329         (if (setq beg (match-beginning 1))
2330             (setq max-width 
2331                   (string-to-int 
2332                    (buffer-substring (1+ (match-beginning 1)) (match-end 1))))
2333           (setq max-width 0)
2334           (setq beg (match-beginning 2)))
2335         ;; Find the specification from `spec-alist'.
2336         (unless (setq elem (cdr (assq spec spec-alist)))
2337           (setq elem '("*" ?s)))
2338         ;; Treat user defined format specifiers specially.
2339         (when (eq (car elem) 'gnus-tmp-user-defined)
2340           (setq elem
2341                 (list 
2342                  (list (intern (concat "gnus-user-format-function-"
2343                                        (match-string 3)))
2344                        'gnus-tmp-header) ?s))
2345           (delete-region (match-beginning 3) (match-end 3)))
2346         (if (not (zerop max-width))
2347             (let ((el (car elem)))
2348               (cond ((= (car (cdr elem)) ?c) 
2349                      (setq el (list 'char-to-string el)))
2350                     ((= (car (cdr elem)) ?d)
2351                      (numberp el) (setq el (list 'int-to-string el))))
2352               (setq flist (cons (gnus-max-width-function el max-width)
2353                                 flist))
2354               (setq newspec ?s))
2355           (setq flist (cons (car elem) flist))
2356           (setq newspec (car (cdr elem))))
2357         ;; Remove the old specification (and possibly a ",12" string).
2358         (delete-region beg (match-end 2))
2359         ;; Insert the new specification.
2360         (goto-char beg)
2361         (insert newspec))
2362       (setq fstring (buffer-substring 1 (point-max))))
2363     ;; Do some postprocessing to increase efficiency.
2364     (setq 
2365      result
2366      (cond 
2367       ;; Emptyness.
2368       ((string= fstring "")
2369        nil)
2370       ;; Not a format string.
2371       ((not (string-match "%" fstring))
2372        (list fstring))
2373       ;; A format string with just a single string spec.
2374       ((string= fstring "%s")
2375        (list (car flist)))
2376       ;; A single character.
2377       ((string= fstring "%c")
2378        (list (car flist)))
2379       ;; A single number.
2380       ((string= fstring "%d")
2381        (setq dontinsert)
2382        (if insert
2383            (list `(princ ,(car flist)))
2384          (list `(int-to-string ,(car flist)))))
2385       ;; Just lots of chars and strings.
2386       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2387        (nreverse flist))
2388       ;; A single string spec at the beginning of the spec.
2389       ((string-match "\\`%[sc][^%]+\\'" fstring)
2390        (list (car flist) (substring fstring 2)))
2391       ;; A single string spec in the middle of the spec.
2392       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2393        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2394       ;; A single string spec in the end of the spec.
2395       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2396        (list (match-string 1 fstring) (car flist)))
2397       ;; A more complex spec.
2398       (t
2399        (list (cons 'format (cons fstring (nreverse flist)))))))
2400
2401     (if insert
2402         (when result
2403           (if dontinsert
2404               result
2405             (cons 'insert result)))
2406       (or (car result) ""))))
2407
2408 (defun gnus-set-work-buffer ()
2409   (if (get-buffer gnus-work-buffer)
2410       (progn
2411         (set-buffer gnus-work-buffer)
2412         (erase-buffer))
2413     (set-buffer (get-buffer-create gnus-work-buffer))
2414     (kill-all-local-variables)
2415     (buffer-disable-undo (current-buffer))
2416     (gnus-add-current-to-buffer-list)))
2417
2418 ;; Article file names when saving.
2419
2420 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2421   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2422 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2423 Otherwise, it is like ~/News/news/group/num."
2424   (let ((default
2425           (expand-file-name
2426            (concat (if (gnus-use-long-file-name 'not-save)
2427                        (gnus-capitalize-newsgroup newsgroup)
2428                      (gnus-newsgroup-directory-form newsgroup))
2429                    "/" (int-to-string (mail-header-number headers)))
2430            (or gnus-article-save-directory "~/News"))))
2431     (if (and last-file
2432              (string-equal (file-name-directory default)
2433                            (file-name-directory last-file))
2434              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2435         default
2436       (or last-file default))))
2437
2438 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2439   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2440 If variable `gnus-use-long-file-name' is non-nil, it is
2441 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2442   (let ((default
2443           (expand-file-name
2444            (concat (if (gnus-use-long-file-name 'not-save)
2445                        newsgroup
2446                      (gnus-newsgroup-directory-form newsgroup))
2447                    "/" (int-to-string (mail-header-number headers)))
2448            (or gnus-article-save-directory "~/News"))))
2449     (if (and last-file
2450              (string-equal (file-name-directory default)
2451                            (file-name-directory last-file))
2452              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2453         default
2454       (or last-file default))))
2455
2456 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2457   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2458 If variable `gnus-use-long-file-name' is non-nil, it is
2459 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2460   (or last-file
2461       (expand-file-name
2462        (if (gnus-use-long-file-name 'not-save)
2463            (gnus-capitalize-newsgroup newsgroup)
2464          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2465        (or gnus-article-save-directory "~/News"))))
2466
2467 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2468   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2469 If variable `gnus-use-long-file-name' is non-nil, it is
2470 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2471   (or last-file
2472       (expand-file-name
2473        (if (gnus-use-long-file-name 'not-save)
2474            newsgroup
2475          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2476        (or gnus-article-save-directory "~/News"))))
2477
2478 ;; For subscribing new newsgroup
2479
2480 (defun gnus-subscribe-hierarchical-interactive (groups)
2481   (let ((groups (sort groups 'string<))
2482         prefixes prefix start ans group starts)
2483     (while groups
2484       (setq prefixes (list "^"))
2485       (while (and groups prefixes)
2486         (while (not (string-match (car prefixes) (car groups)))
2487           (setq prefixes (cdr prefixes)))
2488         (setq prefix (car prefixes))
2489         (setq start (1- (length prefix)))
2490         (if (and (string-match "[^\\.]\\." (car groups) start)
2491                  (cdr groups)
2492                  (setq prefix 
2493                        (concat "^" (substring (car groups) 0 (match-end 0))))
2494                  (string-match prefix (car (cdr groups))))
2495             (progn
2496               (setq prefixes (cons prefix prefixes))
2497               (message "Descend hierarchy %s? ([y]nsq): " 
2498                        (substring prefix 1 (1- (length prefix))))
2499               (setq ans (read-char))
2500               (cond ((= ans ?n)
2501                      (while (and groups 
2502                                  (string-match prefix 
2503                                                (setq group (car groups))))
2504                        (setq gnus-killed-list 
2505                              (cons group gnus-killed-list))
2506                        (gnus-sethash group group gnus-killed-hashtb)
2507                        (setq groups (cdr groups)))
2508                      (setq starts (cdr starts)))
2509                     ((= ans ?s)
2510                      (while (and groups 
2511                                  (string-match prefix 
2512                                                (setq group (car groups))))
2513                        (gnus-sethash group group gnus-killed-hashtb)
2514                        (gnus-subscribe-alphabetically (car groups))
2515                        (setq groups (cdr groups)))
2516                      (setq starts (cdr starts)))
2517                     ((= ans ?q)
2518                      (while groups
2519                        (setq group (car groups))
2520                        (setq gnus-killed-list (cons group gnus-killed-list))
2521                        (gnus-sethash group group gnus-killed-hashtb)
2522                        (setq groups (cdr groups))))
2523                     (t nil)))
2524           (message "Subscribe %s? ([n]yq)" (car groups))
2525           (setq ans (read-char))
2526           (setq group (car groups))
2527           (cond ((= ans ?y)
2528                  (gnus-subscribe-alphabetically (car groups))
2529                  (gnus-sethash group group gnus-killed-hashtb))
2530                 ((= ans ?q)
2531                  (while groups
2532                    (setq group (car groups))
2533                    (setq gnus-killed-list (cons group gnus-killed-list))
2534                    (gnus-sethash group group gnus-killed-hashtb)
2535                    (setq groups (cdr groups))))
2536                 (t 
2537                  (setq gnus-killed-list (cons group gnus-killed-list))
2538                  (gnus-sethash group group gnus-killed-hashtb)))
2539           (setq groups (cdr groups)))))))
2540
2541 (defun gnus-subscribe-randomly (newsgroup)
2542   "Subscribe new NEWSGROUP by making it the first newsgroup."
2543   (gnus-subscribe-newsgroup newsgroup))
2544
2545 (defun gnus-subscribe-alphabetically (newgroup)
2546   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2547   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2548   (let ((groups (cdr gnus-newsrc-alist))
2549         before)
2550     (while (and (not before) groups)
2551       (if (string< newgroup (car (car groups)))
2552           (setq before (car (car groups)))
2553         (setq groups (cdr groups))))
2554     (gnus-subscribe-newsgroup newgroup before)))
2555
2556 (defun gnus-subscribe-hierarchically (newgroup)
2557   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2558   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2559   (save-excursion
2560     (set-buffer (find-file-noselect gnus-current-startup-file))
2561     (let ((groupkey newgroup)
2562           before)
2563       (while (and (not before) groupkey)
2564         (goto-char (point-min))
2565         (let ((groupkey-re
2566                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2567           (while (and (re-search-forward groupkey-re nil t)
2568                       (progn
2569                         (setq before (match-string 1))
2570                         (string< before newgroup)))))
2571         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2572         (setq groupkey
2573               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2574                   (substring groupkey (match-beginning 1) (match-end 1)))))
2575       (gnus-subscribe-newsgroup newgroup before))))
2576
2577 (defun gnus-subscribe-interactively (newsgroup)
2578   "Subscribe new NEWSGROUP interactively.
2579 It is inserted in hierarchical newsgroup order if subscribed.  If not,
2580 it is killed."
2581   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
2582       (gnus-subscribe-hierarchically newsgroup)
2583     (setq gnus-killed-list (cons newsgroup gnus-killed-list))))
2584
2585 (defun gnus-subscribe-zombies (newsgroup)
2586   "Make new NEWSGROUP a zombie group."
2587   (setq gnus-zombie-list (cons newsgroup gnus-zombie-list)))
2588
2589 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2590   "Subscribe new NEWSGROUP.
2591 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
2592 the first newsgroup."
2593   ;; We subscribe the group by changing its level to `subscribed'.
2594   (gnus-group-change-level 
2595    newsgroup gnus-level-default-subscribed
2596    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2597   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2598
2599 ;; For directories
2600
2601 (defun gnus-newsgroup-directory-form (newsgroup)
2602   "Make hierarchical directory name from NEWSGROUP name."
2603   (let ((newsgroup (gnus-newsgroup-saveable-name newsgroup))
2604         (len (length newsgroup))
2605         idx)
2606     ;; If this is a foreign group, we don't want to translate the
2607     ;; entire name.  
2608     (if (setq idx (string-match ":" newsgroup))
2609         (aset newsgroup idx ?/)
2610       (setq idx 0))
2611     ;; Replace all occurrences of `.' with `/'.
2612     (while (< idx len)
2613       (if (= (aref newsgroup idx) ?.)
2614           (aset newsgroup idx ?/))
2615       (setq idx (1+ idx)))
2616     newsgroup))
2617
2618 (defun gnus-newsgroup-saveable-name (group)
2619   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2620   ;; with dots.
2621   (gnus-replace-chars-in-string group ?/ ?.))
2622
2623 (defun gnus-make-directory (dir)
2624   "Make DIRECTORY recursively."
2625   ;; Why don't we use `(make-directory dir 'parents)'? That's just one
2626   ;; of the many mysteries of the universe.
2627   (let* ((dir (expand-file-name dir default-directory))
2628          dirs err)
2629     (if (string-match "/$" dir)
2630         (setq dir (substring dir 0 (match-beginning 0))))
2631     ;; First go down the path until we find a directory that exists.
2632     (while (not (file-exists-p dir))
2633       (setq dirs (cons dir dirs))
2634       (string-match "/[^/]+$" dir)
2635       (setq dir (substring dir 0 (match-beginning 0))))
2636     ;; Then create all the subdirs.
2637     (while (and dirs (not err))
2638       (condition-case ()
2639           (make-directory (car dirs))
2640         (error (setq err t)))
2641       (setq dirs (cdr dirs)))
2642     ;; We return whether we were successful or not. 
2643     (not dirs)))
2644
2645 (defun gnus-capitalize-newsgroup (newsgroup)
2646   "Capitalize NEWSGROUP name."
2647   (and (not (zerop (length newsgroup)))
2648        (concat (char-to-string (upcase (aref newsgroup 0)))
2649                (substring newsgroup 1))))
2650
2651 ;; Var
2652
2653 (defun gnus-simplify-subject (subject &optional re-only)
2654   "Remove `Re:' and words in parentheses.
2655 If optional argument RE-ONLY is non-nil, strip `Re:' only."
2656   (let ((case-fold-search t))           ;Ignore case.
2657     ;; Remove `Re:' and `Re^N:'.
2658     (if (string-match "^re:[ \t]*" subject)
2659         (setq subject (substring subject (match-end 0))))
2660     ;; Remove words in parentheses from end.
2661     (or re-only
2662         (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2663           (setq subject (substring subject 0 (match-beginning 0)))))
2664     ;; Return subject string.
2665     subject))
2666
2667 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2668 ;; all whitespace.
2669 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2670 (defun gnus-simplify-buffer-fuzzy ()
2671   (goto-char (point-min))
2672   (while (or
2673           (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
2674           (looking-at "^[[].*:[ \t].*[]]$"))
2675     (goto-char (point-min))
2676     (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2677                               nil t)
2678       (replace-match "" t t))
2679     (goto-char (point-min))
2680     (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
2681       (goto-char (match-end 0))
2682       (delete-char -1)
2683       (delete-region 
2684        (progn (goto-char (match-beginning 0)))
2685        (re-search-forward ":"))))
2686   (goto-char (point-min))
2687   (while (re-search-forward "[ \t\n]*([^()]*)[ \t]*$" nil t)
2688     (replace-match "" t t))
2689   (goto-char (point-min))
2690   (while (re-search-forward "[ \t]+" nil t)
2691     (replace-match " " t t))
2692   (goto-char (point-min))
2693   (while (re-search-forward "[ \t]+$" nil t)
2694     (replace-match "" t t))
2695   (goto-char (point-min))
2696   (while (re-search-forward "^[ \t]+" nil t)
2697     (replace-match "" t t))
2698   (goto-char (point-min))
2699   (if gnus-simplify-subject-fuzzy-regexp
2700       (if (listp gnus-simplify-subject-fuzzy-regexp)
2701           (let ((list gnus-simplify-subject-fuzzy-regexp))
2702             (while list
2703               (goto-char (point-min))
2704               (while (re-search-forward (car list) nil t)
2705                 (replace-match "" t t))
2706               (setq list (cdr list))))
2707         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
2708           (replace-match "" t t)))))
2709
2710 (defun gnus-simplify-subject-fuzzy (subject)
2711   "Siplify a subject string fuzzily."
2712   (let ((case-fold-search t))
2713     (save-excursion
2714       (gnus-set-work-buffer)
2715       (insert subject)
2716       (inline (gnus-simplify-buffer-fuzzy))
2717       (buffer-string))))
2718
2719 ;; Add the current buffer to the list of buffers to be killed on exit. 
2720 (defun gnus-add-current-to-buffer-list ()
2721   (or (memq (current-buffer) gnus-buffer-list)
2722       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
2723
2724 (defun gnus-string> (s1 s2)
2725   (not (or (string< s1 s2)
2726            (string= s1 s2))))
2727
2728 ;; Functions accessing headers.
2729 ;; Functions are more convenient than macros in some cases.
2730
2731 (defun gnus-header-number (header)
2732   (mail-header-number header))
2733
2734 (defun gnus-header-subject (header)
2735   (mail-header-subject header))
2736
2737 (defun gnus-header-from (header)
2738   (mail-header-from header))
2739
2740 (defun gnus-header-xref (header)
2741   (mail-header-xref header))
2742
2743 (defun gnus-header-lines (header)
2744   (mail-header-lines header))
2745
2746 (defun gnus-header-date (header)
2747   (mail-header-date header))
2748
2749 (defun gnus-header-id (header)
2750   (mail-header-id header))
2751
2752 (defun gnus-header-message-id (header)
2753   (mail-header-id header))
2754
2755 (defun gnus-header-chars (header)
2756   (mail-header-chars header))
2757
2758 (defun gnus-header-references (header)
2759   (mail-header-references header))
2760
2761 ;;; General various misc type functions.
2762
2763 (defun gnus-clear-system ()
2764   "Clear all variables and buffers."
2765   ;; Clear Gnus variables.
2766   (let ((variables gnus-variable-list))
2767     (while variables
2768       (set (car variables) nil)
2769       (setq variables (cdr variables))))
2770   ;; Clear other internal variables.
2771   (setq gnus-list-of-killed-groups nil
2772         gnus-have-read-active-file nil
2773         gnus-newsrc-alist nil
2774         gnus-newsrc-hashtb nil
2775         gnus-killed-list nil
2776         gnus-zombie-list nil
2777         gnus-killed-hashtb nil
2778         gnus-active-hashtb nil
2779         gnus-moderated-list nil
2780         gnus-description-hashtb nil
2781         gnus-newsgroup-headers nil
2782         gnus-newsgroup-name nil
2783         gnus-server-alist nil
2784         gnus-opened-servers nil
2785         gnus-current-select-method nil)
2786   ;; Reset any score variables.
2787   (and gnus-use-scoring (gnus-score-close))
2788   ;; Kill the startup file.
2789   (and gnus-current-startup-file
2790        (get-file-buffer gnus-current-startup-file)
2791        (kill-buffer (get-file-buffer gnus-current-startup-file)))
2792   ;; Save any cache buffers.
2793   (and gnus-use-cache (gnus-cache-save-buffers))
2794   ;; Clear the dribble buffer.
2795   (gnus-dribble-clear)
2796   ;; Close down NoCeM.
2797   (and gnus-use-nocem (gnus-nocem-close))
2798   ;; Shut down the demons.
2799   (and gnus-use-demon (gnus-demon-cancel))
2800   ;; Kill global KILL file buffer.
2801   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
2802       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
2803   (gnus-kill-buffer nntp-server-buffer)
2804   ;; Kill Gnus buffers.
2805   (while gnus-buffer-list
2806     (gnus-kill-buffer (car gnus-buffer-list))
2807     (setq gnus-buffer-list (cdr gnus-buffer-list))))
2808
2809 (defun gnus-windows-old-to-new (setting)
2810   ;; First we take care of the really, really old Gnus 3 actions.
2811   (if (symbolp setting)
2812       (setq setting 
2813             (cond ((memq setting '(SelectArticle))
2814                    'article)
2815                   ((memq setting '(SelectSubject ExpandSubject))
2816                    'summary)
2817                   ((memq setting '(SelectNewsgroup ExitNewsgroup))
2818                    'group)
2819                   (t setting))))
2820   (if (or (listp setting)
2821           (not (and gnus-window-configuration
2822                     (memq setting '(group summary article)))))
2823       setting
2824     (let* ((setting (if (eq setting 'group) 
2825                         (if (assq 'newsgroup gnus-window-configuration)
2826                             'newsgroup
2827                           'newsgroups) setting))
2828            (elem (car (cdr (assq setting gnus-window-configuration))))
2829            (total (apply '+ elem))
2830            (types '(group summary article))
2831            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
2832            (i 0)
2833            perc
2834            out)
2835       (while (< i 3)
2836         (or (not (numberp (nth i elem)))
2837             (zerop (nth i elem))
2838             (progn
2839               (setq perc  (/ (* 1.0 (nth 0 elem)) total))
2840               (setq out (cons (if (eq pbuf (nth i types))
2841                                   (vector (nth i types) perc 'point)
2842                                 (vector (nth i types) perc))
2843                               out))))
2844         (setq i (1+ i)))
2845       (list (nreverse out)))))
2846            
2847 (defun gnus-add-configuration (conf)
2848   (setq gnus-buffer-configuration 
2849         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
2850                          gnus-buffer-configuration))))
2851
2852 (defun gnus-configure-windows (setting &optional force)
2853   (setq setting (gnus-windows-old-to-new setting))
2854   (let ((r (if (symbolp setting)
2855                (cdr (assq setting gnus-buffer-configuration))
2856              setting))
2857         (in-buf (current-buffer))
2858         rule val w height hor ohor heights sub jump-buffer
2859         rel total to-buf all-visible)
2860     (or r (error "No such setting: %s" setting))
2861
2862     (if (and (not force) (setq all-visible (gnus-all-windows-visible-p r)))
2863         ;; All the windows mentioned are already visible, so we just
2864         ;; put point in the assigned buffer, and do not touch the
2865         ;; winconf. 
2866         (select-window (get-buffer-window all-visible t))
2867          
2868
2869       ;; Either remove all windows or just remove all Gnus windows.
2870       (if gnus-use-full-window
2871           (delete-other-windows)
2872         (gnus-remove-some-windows)
2873         (switch-to-buffer nntp-server-buffer))
2874
2875       (while r
2876         (setq hor (car r)
2877               ohor nil)
2878
2879         ;; We have to do the (possible) horizontal splitting before the
2880         ;; vertical. 
2881         (if (and (listp (car hor)) 
2882                  (eq (car (car hor)) 'horizontal))
2883             (progn
2884               (split-window 
2885                nil
2886                (if (integerp (nth 1 (car hor)))
2887                    (nth 1 (car hor))
2888                  (- (frame-width) (floor (* (frame-width) (nth 1 (car hor))))))
2889                t)
2890               (setq hor (cdr hor))))
2891
2892         ;; Go through the rules and eval the elements that are to be
2893         ;; evaled.  
2894         (while hor
2895           (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor))))
2896               (progn
2897                 ;; Expand short buffer name.
2898                 (setq w (aref val 0))
2899                 (and (setq w (cdr (assq w gnus-window-to-buffer)))
2900                      (progn
2901                        (setq val (apply 'vector (mapcar 'identity val)))
2902                        (aset val 0 w)))
2903                 (setq ohor (cons val ohor))))
2904           (setq hor (cdr hor)))
2905         (setq rule (cons (nreverse ohor) rule))
2906         (setq r (cdr r)))
2907       (setq rule (nreverse rule))
2908
2909       ;; We tally the window sizes.
2910       (setq total (window-height))
2911       (while rule
2912         (setq hor (car rule))
2913         (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal))
2914             (setq hor (cdr hor)))
2915         (setq sub 0)
2916         (while hor
2917           (setq rel (aref (car hor) 1)
2918                 heights (cons
2919                          (cond ((and (floatp rel) (= 1.0 rel))
2920                                 'x)
2921                                ((integerp rel)
2922                                 rel)
2923                                (t
2924                                 (max (floor (* total rel)) 4)))
2925                          heights)
2926                 sub (+ sub (if (numberp (car heights)) (car heights) 0))
2927                 hor (cdr hor)))
2928         (setq heights (nreverse heights)
2929               hor (car rule))
2930
2931         ;; We then go through these heighs and create windows for them.
2932         (while heights
2933           (setq height (car heights)
2934                 heights (cdr heights))
2935           (and (eq height 'x)
2936                (setq height (- total sub)))
2937           (and heights
2938                (split-window nil height))
2939           (setq to-buf (aref (car hor) 0))
2940           (switch-to-buffer 
2941            (cond ((not to-buf)
2942                   in-buf)
2943                  ((symbolp to-buf)
2944                   (symbol-value (aref (car hor) 0)))
2945                  (t
2946                   (aref (car hor) 0))))
2947           (and (> (length (car hor)) 2)
2948                (eq (aref (car hor) 2) 'point)
2949                (setq jump-buffer (current-buffer)))
2950           (other-window 1)
2951           (setq hor (cdr hor)))
2952       
2953         (setq rule (cdr rule)))
2954
2955       ;; Finally, we pop to the buffer that's supposed to have point. 
2956       (or jump-buffer (error "Missing `point' in spec for %s" setting))
2957
2958       (select-window (get-buffer-window jump-buffer t))
2959       (set-buffer jump-buffer))))
2960
2961 (defun gnus-all-windows-visible-p (rule)
2962   (let (invisible hor jump-buffer val buffer)
2963     ;; Go through the rules and eval the elements that are to be
2964     ;; evaled.  
2965     (while (and rule (not invisible))
2966       (setq hor (car rule)
2967             rule (cdr rule))
2968       (while (and hor (not invisible))
2969         (if (setq val (if (vectorp (car hor)) 
2970                           (car hor)
2971                         (if (not (eq (car (car hor)) 'horizontal))
2972                             (eval (car hor)))))
2973             (progn
2974               ;; Expand short buffer name.
2975               (setq buffer (or (cdr (assq (aref val 0) gnus-window-to-buffer))
2976                                (aref val 0)))
2977               (setq buffer (if (symbolp buffer) (symbol-value buffer)
2978                              buffer))
2979               (and (> (length val) 2) (eq 'point (aref val 2))
2980                    (setq jump-buffer buffer))
2981               (setq invisible (not (and buffer (get-buffer-window buffer))))))
2982         (setq hor (cdr hor))))
2983     (and (not invisible) jump-buffer)))
2984
2985 (defun gnus-window-top-edge (&optional window)
2986   (nth 1 (window-edges window)))
2987
2988 (defun gnus-remove-some-windows ()
2989   (let ((buffers gnus-window-to-buffer)
2990         buf bufs lowest-buf lowest)
2991     (save-excursion
2992       ;; Remove windows on all known Gnus buffers.
2993       (while buffers
2994         (setq buf (cdr (car buffers)))
2995         (if (symbolp buf)
2996             (setq buf (and (boundp buf) (symbol-value buf))))
2997         (and buf 
2998              (get-buffer-window buf)
2999              (progn
3000                (setq bufs (cons buf bufs))
3001                (pop-to-buffer buf)
3002                (if (or (not lowest)
3003                        (< (gnus-window-top-edge) lowest))
3004                    (progn
3005                      (setq lowest (gnus-window-top-edge))
3006                      (setq lowest-buf buf)))))
3007         (setq buffers (cdr buffers)))
3008       ;; Remove windows on *all* summary buffers.
3009       (let (wins)
3010         (walk-windows
3011          (lambda (win)
3012            (let ((buf (window-buffer win)))
3013              (if (string-match  "^\\*Summary" (buffer-name buf))
3014                  (progn
3015                    (setq bufs (cons buf bufs))
3016                    (pop-to-buffer buf)
3017                    (if (or (not lowest)
3018                            (< (gnus-window-top-edge) lowest))
3019                        (progn
3020                          (setq lowest-buf buf)
3021                          (setq lowest (gnus-window-top-edge))))))))))
3022       (and lowest-buf 
3023            (progn
3024              (pop-to-buffer lowest-buf)
3025              (switch-to-buffer nntp-server-buffer)))
3026       (while bufs
3027         (and (not (eq (car bufs) lowest-buf))
3028              (delete-windows-on (car bufs)))
3029         (setq bufs (cdr bufs))))))
3030                           
3031 (defun gnus-version ()
3032   "Version numbers of this version of Gnus."
3033   (interactive)
3034   (let ((methods gnus-valid-select-methods)
3035         (mess gnus-version)
3036         meth)
3037     ;; Go through all the legal select methods and add their version
3038     ;; numbers to the total version string.  Only the backends that are
3039     ;; currently in use will have their message numbers taken into
3040     ;; consideration. 
3041     (while methods
3042       (setq meth (intern (concat (car (car methods)) "-version")))
3043       (and (boundp meth)
3044            (stringp (symbol-value meth))
3045            (setq mess (concat mess "; " (symbol-value meth))))
3046       (setq methods (cdr methods)))
3047     (gnus-message 2 mess)))
3048
3049 (defun gnus-info-find-node ()
3050   "Find Info documentation of Gnus."
3051   (interactive)
3052   ;; Enlarge info window if needed.
3053   (let ((mode major-mode))
3054     (gnus-configure-windows 'info)
3055     (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))))
3056
3057 (defun gnus-replace-chars-in-string (string &rest pairs)
3058   "Replace characters in STRING from FROM to TO."
3059   (let ((string (substring string 0))   ;Copy string.
3060         (len (length string))
3061         (idx 0)
3062         sym to)
3063     (or (zerop (% (length pairs) 2)) 
3064         (error "Odd number of translation pairs"))
3065     (setplist 'sym pairs)
3066     ;; Replace all occurrences of FROM with TO.
3067     (while (< idx len)
3068       (if (setq to (get 'sym (aref string idx)))
3069           (aset string idx to))
3070       (setq idx (1+ idx)))
3071     string))
3072
3073 (defun gnus-days-between (date1 date2)
3074   ;; Return the number of days between date1 and date2.
3075   (- (gnus-day-number date1) (gnus-day-number date2)))
3076
3077 (defun gnus-day-number (date)
3078   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3079                      (timezone-parse-date date))))
3080     (timezone-absolute-from-gregorian 
3081      (nth 1 dat) (nth 2 dat) (car dat))))
3082
3083 ;; Returns a floating point number that says how many seconds have
3084 ;; lapsed between Jan 1 12:00:00 1970 and DATE.
3085 (defun gnus-seconds-since-epoch (date)
3086   (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
3087                         (timezone-parse-date date)))
3088          (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
3089                         (timezone-parse-time
3090                          (aref (timezone-parse-date date) 3))))
3091          (edate (mapcar (lambda (ti) (and ti (string-to-int ti)))
3092                         (timezone-parse-date "Jan 1 12:00:00 1970")))
3093          (tday (- (timezone-absolute-from-gregorian 
3094                    (nth 1 tdate) (nth 2 tdate) (nth 0 tdate))
3095                   (timezone-absolute-from-gregorian 
3096                    (nth 1 edate) (nth 2 edate) (nth 0 edate)))))
3097     (+ (nth 2 ttime)
3098        (* (nth 1 ttime) 60)
3099        (* 1.0 (nth 0 ttime) 60 60)
3100        (* 1.0 tday 60 60 24))))
3101
3102 (defun gnus-file-newer-than (file date)
3103   (let ((fdate (nth 5 (file-attributes file))))
3104     (or (> (car fdate) (car date))
3105         (and (= (car fdate) (car date))
3106              (> (nth 1 fdate) (nth 1 date))))))
3107
3108 (defun gnus-group-read-only-p (&optional group)
3109   "Check whether GROUP supports editing or not.
3110 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3111 that that variable is buffer-local to the summary buffers."
3112   (let ((group (or group gnus-newsgroup-name)))
3113     (not (gnus-check-backend-function 'request-replace-article group))))
3114
3115 (defun gnus-group-total-expirable-p (group)
3116   "Check whether GROUP is total-expirable or not."
3117   (let ((params (gnus-info-params (gnus-get-info group))))
3118     (or (memq 'total-expire params) 
3119         (cdr (assq 'total-expire params)) ; (total-expire . t)
3120         (and gnus-total-expirable-newsgroups ; Check var.
3121              (string-match gnus-total-expirable-newsgroups group)))))
3122
3123 (defun gnus-group-auto-expirable-p (group)
3124   "Check whether GROUP is total-expirable or not."
3125   (let ((params (gnus-info-params (gnus-get-info group))))
3126     (or (memq 'auto-expire params) 
3127         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3128         (and gnus-auto-expirable-newsgroups ; Check var.
3129              (string-match gnus-auto-expirable-newsgroups group)))))
3130
3131 (defun gnus-subject-equal (s1 s2)
3132   "Check whether two subjects are equal."
3133   (cond
3134    ((null gnus-summary-gather-subject-limit)
3135     (equal (gnus-simplify-subject-re s1)
3136            (gnus-simplify-subject-re s2)))
3137    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3138     (equal (gnus-simplify-subject-fuzzy s1)
3139            (gnus-simplify-subject-fuzzy s2)))
3140    ((numberp gnus-summary-gather-subject-limit)
3141     (equal (gnus-limit-string s1 gnus-summary-gather-subject-limit)
3142            (gnus-limit-string s2 gnus-summary-gather-subject-limit)))
3143    (t
3144     (equal s1 s2))))
3145
3146 ;; Returns a list of writable groups.
3147 (defun gnus-writable-groups ()
3148   (let ((alist gnus-newsrc-alist)
3149         groups)
3150     (while alist
3151       (or (gnus-group-read-only-p (car (car alist)))
3152           (setq groups (cons (car (car alist)) groups)))
3153       (setq alist (cdr alist)))
3154     (nreverse groups)))
3155
3156 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3157 ;; the echo area.
3158 (defun gnus-y-or-n-p (prompt)
3159   (prog1
3160       (y-or-n-p prompt)
3161     (message "")))
3162
3163 (defun gnus-yes-or-no-p (prompt)
3164   (prog1
3165       (yes-or-no-p prompt)
3166     (message "")))
3167
3168 ;; Check whether to use long file names.
3169 (defun gnus-use-long-file-name (symbol)
3170   ;; The variable has to be set...
3171   (and gnus-use-long-file-name
3172        ;; If it isn't a list, then we return t.
3173        (or (not (listp gnus-use-long-file-name))
3174            ;; If it is a list, and the list contains `symbol', we
3175            ;; return nil.  
3176            (not (memq symbol gnus-use-long-file-name)))))
3177
3178 ;; I suspect there's a better way, but I haven't taken the time to do
3179 ;; it yet. -erik selberg@cs.washington.edu
3180 (defun gnus-dd-mmm (messy-date)
3181   "Return a string like DD-MMM from a big messy string"
3182   (let ((datevec (timezone-parse-date messy-date)))
3183     (format "%2s-%s"
3184             (or (aref datevec 2) "??")
3185             (capitalize
3186              (or (car 
3187                   (nth (1- (string-to-number (aref datevec 1)))
3188                        timezone-months-assoc))
3189                  "???")))))
3190
3191 ;; Make a hash table (default and minimum size is 255).
3192 ;; Optional argument HASHSIZE specifies the table size.
3193 (defun gnus-make-hashtable (&optional hashsize)
3194   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3195
3196 ;; Make a number that is suitable for hashing; bigger than MIN and one
3197 ;; less than 2^x.
3198 (defun gnus-create-hash-size (min)
3199   (let ((i 1))
3200     (while (< i min)
3201       (setq i (* 2 i)))
3202     (1- i)))
3203
3204 ;; Show message if message has a lower level than `gnus-verbose'. 
3205 ;; Guide-line for numbers:
3206 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3207 ;; for things that take a long time, 7 - not very important messages
3208 ;; on stuff, 9 - messages inside loops.
3209 (defun gnus-message (level &rest args)
3210   (if (<= level gnus-verbose)
3211       (apply 'message args)
3212     ;; We have to do this format thingie here even if the result isn't
3213     ;; shown - the return value has to be the same as the return value
3214     ;; from `message'.
3215     (apply 'format args)))
3216
3217 (defun gnus-functionp (form)
3218   "Return non-nil if FORM is funcallable."
3219   (or (and (symbolp form) (fboundp form))
3220       (and (listp form) (eq (car form) 'lambda))))
3221
3222 ;; Generate a unique new group name.
3223 (defun gnus-generate-new-group-name (leaf)
3224   (let ((name leaf)
3225         (num 0))
3226     (while (gnus-gethash name gnus-newsrc-hashtb)
3227       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3228     name))
3229
3230 ;; Find out whether the gnus-visual TYPE is wanted.
3231 (defun gnus-visual-p (&optional type class)
3232   (and gnus-visual                      ; Has to be non-nil, at least.
3233        (if (not type)                   ; We don't care about type.
3234            gnus-visual
3235          (if (listp gnus-visual)        ; It's a list, so we check it.
3236              (or (memq type gnus-visual)
3237                  (memq class gnus-visual))
3238            t))))
3239
3240 (defun gnus-parent-id (references)
3241   "Return the last Message-ID in REFERENCES."
3242   (and references
3243        (string-match "\\(<[^<>]+>\\) *$" references)
3244        (substring references (match-beginning 1) (match-end 1))))
3245
3246 (defun gnus-ephemeral-group-p (group)
3247   "Say whether GROUP is ephemeral or not."
3248   (assoc 'quit-config (gnus-find-method-for-group group)))
3249
3250 (defun gnus-group-quit-config (group)
3251   "Return the quit-config of GROUP."
3252   (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
3253
3254 ;;; List and range functions
3255
3256 (defun gnus-last-element (list)
3257   "Return last element of LIST."
3258   (while (cdr list)
3259     (setq list (cdr list)))
3260   (car list))
3261
3262 (defun gnus-copy-sequence (list)
3263   "Do a complete, total copy of a list."
3264   (if (and (consp list) (not (consp (cdr list))))
3265       (cons (car list) (cdr list))
3266     (mapcar (lambda (elem) (if (consp elem) 
3267                                (if (consp (cdr elem))
3268                                    (gnus-copy-sequence elem)
3269                                  (cons (car elem) (cdr elem)))
3270                              elem))
3271             list)))
3272
3273 (defun gnus-set-difference (list1 list2)
3274   "Return a list of elements of LIST1 that do not appear in LIST2."
3275   (let ((list1 (copy-sequence list1)))
3276     (while list2
3277       (setq list1 (delq (car list2) list1))
3278       (setq list2 (cdr list2)))
3279     list1))
3280
3281 (defun gnus-sorted-complement (list1 list2)
3282   "Return a list of elements of LIST1 that do not appear in LIST2.
3283 Both lists have to be sorted over <."
3284   (let (out)
3285     (if (or (null list1) (null list2))
3286         (or list1 list2)
3287       (while (and list1 list2)
3288         (cond ((= (car list1) (car list2))
3289                (setq list1 (cdr list1)
3290                      list2 (cdr list2)))
3291               ((< (car list1) (car list2))
3292                (setq out (cons (car list1) out))
3293                (setq list1 (cdr list1)))
3294               (t
3295                (setq out (cons (car list2) out))
3296                (setq list2 (cdr list2)))))
3297       (nconc (nreverse out) (or list1 list2)))))
3298
3299 (defun gnus-intersection (list1 list2)      
3300   (let ((result nil))
3301     (while list2
3302       (if (memq (car list2) list1)
3303           (setq result (cons (car list2) result)))
3304       (setq list2 (cdr list2)))
3305     result))
3306
3307 (defun gnus-sorted-intersection (list1 list2)
3308   ;; LIST1 and LIST2 have to be sorted over <.
3309   (let (out)
3310     (while (and list1 list2)
3311       (cond ((= (car list1) (car list2))
3312              (setq out (cons (car list1) out)
3313                    list1 (cdr list1)
3314                    list2 (cdr list2)))
3315             ((< (car list1) (car list2))
3316              (setq list1 (cdr list1)))
3317             (t
3318              (setq list2 (cdr list2)))))
3319     (nreverse out)))
3320
3321 (defun gnus-set-sorted-intersection (list1 list2)
3322   ;; LIST1 and LIST2 have to be sorted over <.
3323   ;; This function modifies LIST1.
3324   (let* ((top (cons nil list1))
3325          (prev top))
3326     (while (and list1 list2)
3327       (cond ((= (car list1) (car list2))
3328              (setq prev list1
3329                    list1 (cdr list1)
3330                    list2 (cdr list2)))
3331             ((< (car list1) (car list2))
3332              (setcdr prev (cdr list1))
3333              (setq list1 (cdr list1)))
3334             (t
3335              (setq list2 (cdr list2)))))
3336     (setcdr prev nil)
3337     (cdr top)))
3338
3339 (defun gnus-compress-sequence (numbers &optional always-list)
3340   "Convert list of numbers to a list of ranges or a single range.
3341 If ALWAYS-LIST is non-nil, this function will always release a list of
3342 ranges."
3343   (let* ((first (car numbers))
3344          (last (car numbers))
3345          result)
3346     (if (null numbers)
3347         nil
3348       (if (not (listp (cdr numbers)))
3349           numbers
3350         (while numbers
3351           (cond ((= last (car numbers)) nil) ;Omit duplicated number
3352                 ((= (1+ last) (car numbers)) ;Still in sequence
3353                  (setq last (car numbers)))
3354                 (t                      ;End of one sequence
3355                  (setq result 
3356                        (cons (if (= first last) first
3357                                (cons first last)) result))
3358                  (setq first (car numbers))
3359                  (setq last  (car numbers))))
3360           (setq numbers (cdr numbers)))
3361         (if (and (not always-list) (null result))
3362             (if (= first last) (list first) (cons first last))
3363           (nreverse (cons (if (= first last) first (cons first last))
3364                           result)))))))
3365
3366 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3367 (defun gnus-uncompress-range (ranges)
3368   "Expand a list of ranges into a list of numbers.
3369 RANGES is either a single range on the form `(num . num)' or a list of
3370 these ranges."
3371   (let (first last result)
3372     (cond 
3373      ((null ranges)
3374       nil)
3375      ((not (listp (cdr ranges)))
3376       (setq first (car ranges))
3377       (setq last (cdr ranges))
3378       (while (<= first last)
3379         (setq result (cons first result))
3380         (setq first (1+ first)))
3381       (nreverse result))
3382      (t
3383       (while ranges
3384         (if (atom (car ranges))
3385             (if (numberp (car ranges))
3386                 (setq result (cons (car ranges) result)))
3387           (setq first (car (car ranges)))
3388           (setq last  (cdr (car ranges)))
3389           (while (<= first last)
3390             (setq result (cons first result))
3391             (setq first (1+ first))))
3392         (setq ranges (cdr ranges)))
3393       (nreverse result)))))
3394
3395 (defun gnus-add-to-range (ranges list)
3396   "Return a list of ranges that has all articles from both RANGES and LIST.
3397 Note: LIST has to be sorted over `<'."
3398   (if (not ranges)
3399       (gnus-compress-sequence list t)
3400     (setq list (copy-sequence list))
3401     (or (listp (cdr ranges))
3402         (setq ranges (list ranges)))
3403     (let ((out ranges)
3404           ilist lowest highest temp)
3405       (while (and ranges list)
3406         (setq ilist list)
3407         (setq lowest (or (and (atom (car ranges)) (car ranges))
3408                          (car (car ranges))))
3409         (while (and list (cdr list) (< (car (cdr list)) lowest))
3410           (setq list (cdr list)))
3411         (if (< (car ilist) lowest)
3412             (progn
3413               (setq temp list)
3414               (setq list (cdr list))
3415               (setcdr temp nil)
3416               (setq out (nconc (gnus-compress-sequence ilist t) out))))
3417         (setq highest (or (and (atom (car ranges)) (car ranges))
3418                           (cdr (car ranges))))
3419         (while (and list (<= (car list) highest))
3420           (setq list (cdr list)))
3421         (setq ranges (cdr ranges)))
3422       (if list
3423           (setq out (nconc (gnus-compress-sequence list t) out)))
3424       (setq out (sort out (lambda (r1 r2) 
3425                             (< (or (and (atom r1) r1) (car r1))
3426                                (or (and (atom r2) r2) (car r2))))))
3427       (setq ranges out)
3428       (while ranges
3429         (if (atom (car ranges))
3430             (if (cdr ranges)
3431                 (if (atom (car (cdr ranges)))
3432                     (if (= (1+ (car ranges)) (car (cdr ranges)))
3433                         (progn
3434                           (setcar ranges (cons (car ranges) 
3435                                                (car (cdr ranges))))
3436                           (setcdr ranges (cdr (cdr ranges)))))
3437                   (if (= (1+ (car ranges)) (car (car (cdr ranges))))
3438                       (progn
3439                         (setcar (car (cdr ranges)) (car ranges))
3440                         (setcar ranges (car (cdr ranges)))
3441                         (setcdr ranges (cdr (cdr ranges)))))))
3442           (if (cdr ranges)
3443               (if (atom (car (cdr ranges)))
3444                   (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
3445                       (progn
3446                         (setcdr (car ranges) (car (cdr ranges)))
3447                         (setcdr ranges (cdr (cdr ranges)))))
3448                 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
3449                     (progn
3450                       (setcdr (car ranges) (cdr (car (cdr ranges))))
3451                       (setcdr ranges (cdr (cdr ranges))))))))
3452         (setq ranges (cdr ranges)))
3453       out)))
3454
3455 (defun gnus-remove-from-range (ranges list)
3456   "Return a list of ranges that has all articles from LIST removed from RANGES.
3457 Note: LIST has to be sorted over `<'."
3458   ;; !!! This function shouldn't look like this, but I've got a headache.
3459   (gnus-compress-sequence 
3460    (gnus-sorted-complement
3461     (gnus-uncompress-range ranges) list)))
3462
3463 (defun gnus-member-of-range (number ranges)
3464   (if (not (listp (cdr ranges)))
3465       (and (>= number (car ranges)) 
3466            (<= number (cdr ranges)))
3467     (let ((not-stop t))
3468       (while (and ranges 
3469                   (if (numberp (car ranges))
3470                       (>= number (car ranges))
3471                     (>= number (car (car ranges))))
3472                   not-stop)
3473         (if (if (numberp (car ranges))
3474                 (= number (car ranges))
3475               (and (>= number (car (car ranges)))
3476                    (<= number (cdr (car ranges)))))
3477             (setq not-stop nil))
3478         (setq ranges (cdr ranges)))
3479       (not not-stop))))
3480
3481 (defun gnus-range-length (range)
3482   "Return the length RANGE would have if uncompressed."
3483   (length (gnus-uncompress-range range)))
3484
3485 (defun gnus-sublist-p (list sublist)
3486   "Test whether all elements in SUBLIST are members of LIST."
3487   (let ((sublistp t))
3488     (while sublist
3489       (unless (memq (pop sublist) list)
3490         (setq sublistp nil
3491               sublist nil)))
3492     sublistp))
3493
3494 \f
3495 ;;;
3496 ;;; Gnus group mode
3497 ;;;
3498
3499 (defvar gnus-group-mode-map nil)
3500 (defvar gnus-group-group-map nil)
3501 (defvar gnus-group-mark-map nil)
3502 (defvar gnus-group-list-map nil)
3503 (defvar gnus-group-sort-map nil)
3504 (defvar gnus-group-soup-map nil)
3505 (defvar gnus-group-sub-map nil)
3506 (defvar gnus-group-sub-map nil)
3507 (defvar gnus-group-help-map nil)
3508 (defvar gnus-group-score-map nil)
3509 (put 'gnus-group-mode 'mode-class 'special)
3510
3511 (if gnus-group-mode-map
3512     nil
3513   (setq gnus-group-mode-map (make-keymap))
3514   (suppress-keymap gnus-group-mode-map)
3515   (define-key gnus-group-mode-map " " 'gnus-group-read-group)
3516   (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
3517   (define-key gnus-group-mode-map "\r" 'gnus-group-select-group)
3518   (define-key gnus-group-mode-map "\M-\r" 'gnus-group-quick-select-group)
3519   (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
3520   (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
3521   (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
3522   (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
3523   (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
3524   (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
3525   (define-key gnus-group-mode-map
3526     "\M-n" 'gnus-group-next-unread-group-same-level)
3527   (define-key gnus-group-mode-map 
3528     "\M-p" 'gnus-group-prev-unread-group-same-level)
3529   (define-key gnus-group-mode-map "," 'gnus-group-best-unread-group)
3530   (define-key gnus-group-mode-map "." 'gnus-group-first-unread-group)
3531   (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
3532   (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
3533   (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current)
3534   (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all)
3535   (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
3536   (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
3537   (define-key gnus-group-mode-map "m" 'gnus-group-mail)
3538   (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
3539   (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group)
3540   (define-key gnus-group-mode-map "R" 'gnus-group-restart)
3541   (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file)
3542   (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server)
3543   (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
3544   (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups)
3545   (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group)
3546   (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups)
3547   (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos)
3548   (define-key gnus-group-mode-map "\C-c\M-\C-a" 'gnus-group-description-apropos)
3549   (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
3550   (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
3551   (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
3552   (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
3553   (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
3554   (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
3555   (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
3556   (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed)
3557   (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles)
3558   (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups)
3559   (define-key gnus-group-mode-map "V" 'gnus-version)
3560   (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc)
3561   (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
3562   (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble)
3563   (define-key gnus-group-mode-map "q" 'gnus-group-exit)
3564   (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
3565   (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
3566   (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
3567   (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method)
3568   (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode)
3569   (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group)
3570   (define-key gnus-group-mode-map "<" 'beginning-of-buffer)
3571   (define-key gnus-group-mode-map ">" 'end-of-buffer)
3572   (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug)
3573   (define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups)
3574   (define-key gnus-group-mode-map "t" 'gnus-topic-mode)
3575
3576   (define-key gnus-group-mode-map "#" 'gnus-group-mark-group)
3577   (define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group)
3578   (define-prefix-command 'gnus-group-mark-map)
3579   (define-key gnus-group-mode-map "M" 'gnus-group-mark-map)
3580   (define-key gnus-group-mark-map "m" 'gnus-group-mark-group)
3581   (define-key gnus-group-mark-map "u" 'gnus-group-unmark-group)
3582   (define-key gnus-group-mark-map "w" 'gnus-group-mark-region)
3583   (define-key gnus-group-mark-map "r" 'gnus-group-mark-regexp)
3584
3585   (define-prefix-command 'gnus-group-group-map)
3586   (define-key gnus-group-mode-map "G" 'gnus-group-group-map)
3587   (define-key gnus-group-group-map "d" 'gnus-group-make-directory-group)
3588   (define-key gnus-group-group-map "h" 'gnus-group-make-help-group)
3589   (define-key gnus-group-group-map "a" 'gnus-group-make-archive-group)
3590   (define-key gnus-group-group-map "k" 'gnus-group-make-kiboze-group)
3591   (define-key gnus-group-group-map "m" 'gnus-group-make-group)
3592   (define-key gnus-group-group-map "E" 'gnus-group-edit-group)
3593   (define-key gnus-group-group-map "e" 'gnus-group-edit-group-method)
3594   (define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters)
3595   (define-key gnus-group-group-map "v" 'gnus-group-add-to-virtual)
3596   (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual)
3597   (define-key gnus-group-group-map "D" 'gnus-group-enter-directory)
3598   (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group)
3599   (define-key gnus-group-group-map "r" 'gnus-group-rename-group)
3600   (define-key gnus-group-group-map "\177" 'gnus-group-delete-group)
3601
3602   (define-prefix-command 'gnus-group-soup-map)
3603   (define-key gnus-group-group-map "s" 'gnus-group-soup-map)
3604   (define-key gnus-group-soup-map "b" 'gnus-group-brew-soup)
3605   (define-key gnus-group-soup-map "w" 'gnus-soup-save-areas)
3606   (define-key gnus-group-soup-map "s" 'gnus-soup-send-replies)
3607   (define-key gnus-group-soup-map "p" 'gnus-soup-pack-packet)
3608   (define-key gnus-group-soup-map "r" 'nnsoup-pack-replies)
3609
3610   (define-prefix-command 'gnus-group-sort-map)
3611   (define-key gnus-group-group-map "S" 'gnus-group-sort-map)
3612   (define-key gnus-group-sort-map "s" 'gnus-group-sort-groups)
3613   (define-key gnus-group-sort-map "a" 'gnus-group-sort-groups-by-alphabet)
3614   (define-key gnus-group-sort-map "u" 'gnus-group-sort-groups-by-unread)
3615   (define-key gnus-group-sort-map "l" 'gnus-group-sort-groups-by-level)
3616   (define-key gnus-group-sort-map "v" 'gnus-group-sort-groups-by-score)
3617   (define-key gnus-group-sort-map "r" 'gnus-group-sort-groups-by-rank)
3618   (define-key gnus-group-sort-map "m" 'gnus-group-sort-groups-by-method)
3619
3620   (define-prefix-command 'gnus-group-help-map)
3621   (define-key gnus-group-mode-map "H" 'gnus-group-help-map)
3622   (define-key gnus-group-help-map "f" 'gnus-group-fetch-faq)
3623
3624   (define-prefix-command 'gnus-group-list-map)
3625   (define-key gnus-group-mode-map "A" 'gnus-group-list-map)
3626   (define-key gnus-group-list-map "k" 'gnus-group-list-killed)
3627   (define-key gnus-group-list-map "z" 'gnus-group-list-zombies)
3628   (define-key gnus-group-list-map "s" 'gnus-group-list-groups)
3629   (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups)
3630   (define-key gnus-group-list-map "A" 'gnus-group-list-active)
3631   (define-key gnus-group-list-map "a" 'gnus-group-apropos)
3632   (define-key gnus-group-list-map "d" 'gnus-group-description-apropos)
3633   (define-key gnus-group-list-map "m" 'gnus-group-list-matching)
3634   (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching)
3635
3636   (define-prefix-command 'gnus-group-score-map)
3637   (define-key gnus-group-mode-map "W" 'gnus-group-score-map)
3638   (define-key gnus-group-score-map "f" 'gnus-score-flush-cache)
3639
3640   (define-prefix-command 'gnus-group-sub-map)
3641   (define-key gnus-group-mode-map "S" 'gnus-group-sub-map)
3642   (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level)
3643   (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group)
3644   (define-key gnus-group-sub-map "s" 'gnus-group-unsubscribe-group)
3645   (define-key gnus-group-sub-map "k" 'gnus-group-kill-group)
3646   (define-key gnus-group-sub-map "y" 'gnus-group-yank-group)
3647   (define-key gnus-group-sub-map "w" 'gnus-group-kill-region)
3648   (define-key gnus-group-sub-map "z" 'gnus-group-kill-all-zombies))
3649
3650 (defun gnus-group-mode ()
3651   "Major mode for reading news.
3652
3653 All normal editing commands are switched off.
3654 \\<gnus-group-mode-map>
3655 The group buffer lists (some of) the groups available.  For instance,
3656 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
3657 lists all zombie groups. 
3658
3659 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe 
3660 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. 
3661
3662 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). 
3663
3664 The following commands are available:
3665
3666 \\{gnus-group-mode-map}"
3667   (interactive)
3668   (when (and menu-bar-mode
3669              (gnus-visual-p 'group-menu 'menu))
3670     (gnus-group-make-menu-bar))
3671   (kill-all-local-variables)
3672   (setq mode-line-modified "-- ")
3673   (make-local-variable 'mode-line-format)
3674   (setq mode-line-format (copy-sequence mode-line-format))
3675   (and (equal (nth 3 mode-line-format) "   ")
3676        (setcar (nthcdr 3 mode-line-format) ""))
3677   (setq major-mode 'gnus-group-mode)
3678   (setq mode-name "Group")
3679   (gnus-group-set-mode-line)
3680   (setq mode-line-process nil)
3681   (use-local-map gnus-group-mode-map)
3682   (buffer-disable-undo (current-buffer))
3683   (setq truncate-lines t)
3684   (setq buffer-read-only t)
3685   (run-hooks 'gnus-group-mode-hook))
3686
3687 (defun gnus-mouse-pick-group (e)
3688   "Enter the group under the mouse pointer."
3689   (interactive "e")
3690   (mouse-set-point e)
3691   (gnus-group-read-group nil))
3692
3693 ;; Look at LEVEL and find out what the level is really supposed to be.
3694 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
3695 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
3696 (defun gnus-group-default-level (&optional level number-or-nil)
3697   (cond  
3698    (gnus-group-use-permanent-levels
3699     (setq gnus-group-default-list-level 
3700           (or level gnus-group-default-list-level))
3701     (or gnus-group-default-list-level gnus-level-subscribed))
3702    (number-or-nil
3703     level)
3704    (t
3705     (or level gnus-group-default-list-level gnus-level-subscribed))))
3706   
3707 ;;;###autoload
3708 (defun gnus-slave-no-server (&optional arg)
3709   "Read network news as a slave, without connecting to local server"
3710   (interactive "P")
3711   (gnus-no-server arg t))
3712
3713 ;;;###autoload
3714 (defun gnus-no-server (&optional arg slave)
3715   "Read network news.
3716 If ARG is a positive number, Gnus will use that as the
3717 startup level.  If ARG is nil, Gnus will be started at level 2. 
3718 If ARG is non-nil and not a positive number, Gnus will
3719 prompt the user for the name of an NNTP server to use.
3720 As opposed to `gnus', this command will not connect to the local server."
3721   (interactive "P")
3722   (make-local-variable 'gnus-group-use-permanent-levels)
3723   (setq gnus-group-use-permanent-levels t)
3724   (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
3725
3726 ;;;###autoload
3727 (defun gnus-slave (&optional arg)
3728   "Read news as a slave."
3729   (interactive "P")
3730   (gnus arg nil 'slave))
3731
3732 ;;;###autoload
3733 (defun gnus (&optional arg dont-connect slave)
3734   "Read network news.
3735 If ARG is non-nil and a positive number, Gnus will use that as the
3736 startup level.  If ARG is non-nil and not a positive number, Gnus will
3737 prompt the user for the name of an NNTP server to use."
3738   (interactive "P")
3739   (if (get-buffer gnus-group-buffer)
3740       (progn
3741         (switch-to-buffer gnus-group-buffer)
3742         (gnus-group-get-new-news))
3743
3744     (gnus-clear-system)
3745
3746     (nnheader-init-server-buffer)
3747
3748     (gnus-read-init-file)
3749
3750     (setq gnus-slave slave)
3751
3752     (gnus-group-setup-buffer)
3753     (let ((buffer-read-only nil))
3754       (erase-buffer)
3755       (if (not gnus-inhibit-startup-message)
3756           (progn
3757             (gnus-group-startup-message)
3758             (sit-for 0))))
3759     
3760     (let ((level (and arg (numberp arg) (> arg 0) arg))
3761           did-connect)
3762       (unwind-protect
3763           (progn
3764             (or dont-connect 
3765                 (setq did-connect
3766                       (gnus-start-news-server (and arg (not level))))))
3767         (if (and (not dont-connect) 
3768                  (not did-connect))
3769             (gnus-group-quit)
3770           (run-hooks 'gnus-startup-hook)
3771           ;; NNTP server is successfully open. 
3772
3773           ;; Find the current startup file name.
3774           (setq gnus-current-startup-file 
3775                 (gnus-make-newsrc-file gnus-startup-file))
3776
3777           ;; Read the dribble file.
3778           (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
3779
3780           (gnus-summary-make-display-table)
3781           (gnus-setup-news nil level)
3782           (gnus-group-list-groups level)
3783           (gnus-configure-windows 'group)
3784           (gnus-group-set-mode-line))))))
3785
3786 (defun gnus-unload ()
3787   "Unload all Gnus features."
3788   (interactive)
3789   (or (boundp 'load-history)
3790       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
3791   (let ((history load-history)
3792         feature)
3793     (while history
3794       (and (string-match "^gnus" (car (car history)))
3795            (setq feature (cdr (assq 'provide (car history))))
3796            (unload-feature feature 'force))
3797       (setq history (cdr history)))))
3798
3799 (defun gnus-compile ()
3800   "Byte-compile the Gnus startup file.
3801 This will also compile the user-defined format specs."
3802   (interactive)
3803   (let ((file (concat (make-temp-name "/tmp/gnuss") ".el")))
3804     (save-excursion
3805       (gnus-message 7 "Compiling user file...")
3806       (nnheader-set-temp-buffer " *compile gnus*")
3807       (and (file-exists-p gnus-init-file)
3808            (insert-file gnus-init-file))
3809       (goto-char (point-max))
3810
3811       (let ((formats '(summary summary-dummy group 
3812                                summary-mode group-mode article-mode))
3813             format fs)
3814         
3815         (while formats
3816           (setq format (symbol-name (car formats))
3817                 formats (cdr formats)
3818                 fs (cons (symbol-value 
3819                           (intern (format "gnus-%s-line-format" format)))
3820                          fs))
3821           (insert "(defun gnus-" format "-line-format-spec ()\n")
3822           (insert 
3823            (prin1-to-string
3824             (symbol-value 
3825              (intern (format "gnus-%s-line-format-spec" format)))))
3826           (insert ")\n")
3827           (insert "(setq gnus-" format 
3828                   "-line-format-spec (list 'gnus-byte-code 'gnus-"
3829                   format "-line-format-spec))\n"))
3830
3831         (insert "(setq gnus-old-specs '" (prin1-to-string fs) ")\n")
3832
3833         (write-region (point-min) (point-max) file nil 'silent)
3834         (byte-compile-file file)
3835         (rename-file
3836          (concat file "c") 
3837          (concat gnus-init-file 
3838                  (if (string-match "\\.el$" gnus-init-file) "c" ".elc"))
3839          t)
3840         (when (file-exists-p file)
3841           (delete-file file))
3842         (kill-buffer (current-buffer)))
3843       (gnus-message 7 "Compiling user file...done"))))
3844
3845 (defun gnus-indent-rigidly (start end arg)
3846   "Indent rigidly using only spaces and no tabs."
3847   (save-excursion
3848     (save-restriction
3849       (narrow-to-region start end)
3850       (indent-rigidly start end arg)
3851       (goto-char (point-min))
3852       (while (search-forward "\t" nil t)
3853         (replace-match "        " t t)))))
3854
3855 (defun gnus-group-startup-message (&optional x y)
3856   "Insert startup message in current buffer."
3857   ;; Insert the message.
3858   (erase-buffer)
3859   (insert
3860    (format "              %s
3861           _    ___ _             _      
3862           _ ___ __ ___  __    _ ___     
3863           __   _     ___    __  ___     
3864               _           ___     _     
3865              _  _ __             _      
3866              ___   __            _      
3867                    __           _       
3868                     _      _   _        
3869                    _      _    _        
3870                       _  _    _         
3871                   __  ___               
3872                  _   _ _     _          
3873                 _   _                   
3874               _    _                    
3875              _    _                     
3876             _                         
3877           __                             
3878
3879
3880            ""))
3881   ;; And then hack it.
3882   (gnus-indent-rigidly (point-min) (point-max) 
3883                        (/ (max (- (window-width) (or x 46)) 0) 2))
3884   (goto-char (point-min))
3885   (forward-line 1)
3886   (let* ((pheight (count-lines (point-min) (point-max)))
3887          (wheight (window-height))
3888          (rest (- wheight pheight)))
3889     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
3890   ;; Fontify some.
3891   (goto-char (point-min))
3892   (and (search-forward "Praxis" nil t)
3893        (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
3894   (goto-char (point-min))
3895   (let* ((mode-string (gnus-group-set-mode-line)))
3896     (setq mode-line-buffer-identification 
3897           (concat gnus-version (substring mode-string 4)))
3898     (set-buffer-modified-p t)))
3899
3900 (defun gnus-group-startup-message-old (&optional x y)
3901   "Insert startup message in current buffer."
3902   ;; Insert the message.
3903   (erase-buffer)
3904   (insert
3905    (format "
3906      %s
3907            A newsreader 
3908       for GNU Emacs
3909
3910         Based on GNUS 
3911              written by 
3912      Masanobu UMEDA
3913
3914        A Praxis Release
3915       larsi@ifi.uio.no
3916
3917            gnus-version))
3918   ;; And then hack it.
3919   ;; 18 is the longest line.
3920   (indent-rigidly (point-min) (point-max) 
3921                   (/ (max (- (window-width) (or x 28)) 0) 2))
3922   (goto-char (point-min))
3923   ;; +4 is fuzzy factor.
3924   (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))
3925
3926   ;; Fontify some.
3927   (goto-char (point-min))
3928   (search-forward "Praxis")
3929   (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
3930   (goto-char (point-min)))
3931
3932 (defun gnus-group-setup-buffer ()
3933   (or (get-buffer gnus-group-buffer)
3934       (progn
3935         (switch-to-buffer gnus-group-buffer)
3936         (gnus-add-current-to-buffer-list)
3937         (gnus-group-mode)
3938         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
3939
3940 (defun gnus-group-list-groups (&optional level unread)
3941   "List newsgroups with level LEVEL or lower that have unread articles.
3942 Default is all subscribed groups.
3943 If argument UNREAD is non-nil, groups with no unread articles are also
3944 listed." 
3945   (interactive (list (if current-prefix-arg
3946                          (prefix-numeric-value current-prefix-arg)
3947                        (or
3948                         (gnus-group-default-level nil t)
3949                         gnus-group-default-list-level
3950                         gnus-level-subscribed))))
3951   (or level
3952       (setq level (car gnus-group-list-mode)
3953             unread (cdr gnus-group-list-mode)))
3954   (setq level (gnus-group-default-level level))
3955   (gnus-group-setup-buffer)             ;May call from out of group buffer
3956   (gnus-update-format-specifications)
3957   (let ((case-fold-search nil)
3958         (group (gnus-group-group-name)))
3959     (funcall gnus-group-prepare-function level unread nil)
3960     (if (zerop (buffer-size))
3961         (gnus-message 5 gnus-no-groups-message)
3962       (goto-char (point-min))
3963       (if (not group)
3964           ;; Go to the first group with unread articles.
3965           (gnus-group-search-forward nil nil nil t)
3966         ;; Find the right group to put point on.  If the current group
3967         ;; has disapeared in the new listing, try to find the next
3968         ;; one.  If no next one can be found, just leave point at the
3969         ;; first newsgroup in the buffer.
3970         (if (not (gnus-goto-char
3971                   (text-property-any
3972                    (point-min) (point-max) 
3973                    'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
3974             (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
3975               (while (and newsrc
3976                           (not (gnus-goto-char 
3977                                 (text-property-any 
3978                                  (point-min) (point-max) 'gnus-group 
3979                                  (gnus-intern-safe 
3980                                   (car (car newsrc)) gnus-active-hashtb)))))
3981                 (setq newsrc (cdr newsrc)))
3982               (or newsrc (progn (goto-char (point-max))
3983                                 (forward-line -1))))))
3984       ;; Adjust cursor point.
3985       (gnus-group-position-point))))
3986
3987 (defun gnus-group-prepare-flat (level &optional all lowest regexp) 
3988   "List all newsgroups with unread articles of level LEVEL or lower.
3989 If ALL is non-nil, list groups that have no unread articles.
3990 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
3991 If REGEXP, only list groups matching REGEXP."
3992   (set-buffer gnus-group-buffer)
3993   (let ((buffer-read-only nil)
3994         (newsrc (cdr gnus-newsrc-alist))
3995         (lowest (or lowest 1))
3996         info clevel unread group params)
3997     (erase-buffer)
3998     (if (< lowest gnus-level-zombie)
3999         ;; List living groups.
4000         (while newsrc
4001           (setq info (car newsrc)
4002                 group (gnus-info-group info)
4003                 params (gnus-info-params info)
4004                 newsrc (cdr newsrc)
4005                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4006           (and unread                   ; This group might be bogus
4007                (or (not regexp)
4008                    (string-match regexp group))
4009                (<= (setq clevel (gnus-info-level info)) level) 
4010                (>= clevel lowest)
4011                (or all                  ; We list all groups?
4012                    (eq unread t)        ; We list unactivated groups
4013                    (> unread 0)         ; We list groups with unread articles
4014                    (cdr (assq 'tick (gnus-info-marks info)))
4015                                         ; And groups with tickeds
4016                    ;; Check for permanent visibility.
4017                    (and gnus-permanently-visible-groups
4018                         (string-match gnus-permanently-visible-groups
4019                                       group))
4020                    (memq 'visible params)
4021                    (cdr (assq 'visible params)))
4022                (gnus-group-insert-group-line 
4023                 group (gnus-info-level info) 
4024                 (gnus-info-marks info) unread (gnus-info-method info)))))
4025       
4026     ;; List dead groups.
4027     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4028          (gnus-group-prepare-flat-list-dead 
4029           (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 
4030           gnus-level-zombie ?Z
4031           regexp))
4032     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4033          (gnus-group-prepare-flat-list-dead 
4034           (setq gnus-killed-list (sort gnus-killed-list 'string<)) 
4035           gnus-level-killed ?K regexp))
4036
4037     (gnus-group-set-mode-line)
4038     (setq gnus-group-list-mode (cons level all))
4039     (run-hooks 'gnus-group-prepare-hook)))
4040
4041 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4042   ;; List zombies and killed lists somehwat faster, which was
4043   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4044   ;; this by ignoring the group format specification altogether.
4045   (let (group beg)
4046     (if regexp
4047         ;; This loop is used when listing groups that match some
4048         ;; regexp. 
4049         (while groups
4050           (setq group (pop groups))
4051           (when (string-match regexp group)
4052             (add-text-properties 
4053              (point) (prog1 (1+ (point))
4054                        (insert " " mark "     *: " group "\n"))
4055              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4056                    'gnus-unread t
4057                    'gnus-level level))))
4058       ;; This loop is used when listing all groups.
4059       (while groups
4060         (add-text-properties 
4061          (point) (prog1 (1+ (point))
4062                    (insert " " mark "     *: " 
4063                            (setq group (pop groups)) "\n"))
4064          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4065                'gnus-unread t
4066                'gnus-level level))))))
4067
4068 (defmacro gnus-group-real-name (group)
4069   "Find the real name of a foreign newsgroup."
4070   `(let ((gname ,group))
4071      (if (string-match ":[^:]+$" gname)
4072          (substring gname (1+ (match-beginning 0)))
4073        gname)))
4074
4075 (defsubst gnus-server-add-address (method)
4076   (let ((method-name (symbol-name (car method))))
4077     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4078              (not (assq (intern (concat method-name "-address")) method)))
4079         (append method (list (list (intern (concat method-name "-address"))
4080                                    (nth 1 method))))
4081       method)))
4082
4083 (defsubst gnus-server-get-method (group method)
4084   ;; Input either a server name, and extended server name, or a
4085   ;; select method, and return a select method. 
4086   (cond ((stringp method)
4087          (gnus-server-to-method method))
4088         ((and (stringp (car method)) group)
4089          (gnus-server-extend-method group method))
4090         (t
4091          (gnus-server-add-address method))))
4092
4093 (defun gnus-server-to-method (server)
4094   "Map virtual server names to select methods."
4095   (or (and (equal server "native") gnus-select-method)
4096       (cdr (assoc server gnus-server-alist))))
4097
4098 (defun gnus-group-prefixed-name (group method)
4099   "Return the whole name from GROUP and METHOD."
4100   (and (stringp method) (setq method (gnus-server-to-method method)))
4101   (concat (format "%s" (car method))
4102           (if (and 
4103                (assoc (format "%s" (car method)) (gnus-methods-using 'address))
4104                (not (string= (nth 1 method) "")))
4105               (concat "+" (nth 1 method)))
4106           ":" group))
4107
4108 (defun gnus-group-real-prefix (group)
4109   "Return the prefix of the current group name."
4110   (if (string-match "^[^:]+:" group)
4111       (substring group 0 (match-end 0))
4112     ""))
4113
4114 (defun gnus-group-method-name (group)
4115   "Return the method used for selecting GROUP."
4116   (let ((prefix (gnus-group-real-prefix group)))
4117     (if (equal prefix "")
4118         gnus-select-method
4119       (if (string-match "^[^\\+]+\\+" prefix)
4120           (list (intern (substring prefix 0 (1- (match-end 0))))
4121                 (substring prefix (match-end 0) (1- (length prefix))))
4122         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
4123
4124 (defsubst gnus-secondary-method-p (method)
4125   "Return whether METHOD is a secondary select method."
4126   (let ((methods gnus-secondary-select-methods)
4127         (gmethod (gnus-server-get-method nil method)))
4128     (while (and methods
4129                 (not (equal (gnus-server-get-method nil (car methods)) 
4130                             gmethod)))
4131       (setq methods (cdr methods)))
4132     methods))
4133
4134 (defun gnus-group-foreign-p (group)
4135   "Say whether a group is foreign or not."
4136   (and (not (gnus-group-native-p group))
4137        (not (gnus-group-secondary-p group))))
4138
4139 (defun gnus-group-native-p (group)
4140   "Say whether the group is native or not."
4141   (not (string-match ":" group)))
4142
4143 (defun gnus-group-secondary-p (group)
4144   "Say whether the group is secondary or not."
4145   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4146
4147 (defun gnus-group-get-parameter (group &optional symbol)
4148   "Returns the group parameters for GROUP.
4149 If SYMBOL, return the value of that symbol in the group parameters."
4150   (let ((params (gnus-info-params (gnus-get-info group))))
4151     (if symbol
4152         (gnus-group-parameter-value params symbol)
4153       params)))
4154
4155 (defun gnus-group-parameter-value (params symbol)
4156   "Return the value of SYMBOL in group PARAMS."
4157   (or (car (memq symbol params))        ; It's either a simple symbol
4158       (cdr (assq symbol params))))      ; or a cons.
4159
4160 (defun gnus-group-add-parameter (group param)
4161   "Add parameter PARAM to GROUP."
4162   (let ((info (gnus-get-info group)))
4163     (if (not info)
4164         () ; This is a dead group.  We just ignore it.
4165       ;; Cons the new param to the old one and update.
4166       (gnus-group-set-info (cons param (gnus-info-params info)) 
4167                            group 'params))))
4168
4169 (defun gnus-group-add-score (group &optional score)
4170   "Add SCORE to the GROUP score.  
4171 If SCORE is nil, add 1 to the score of GROUP."
4172   (let ((info (gnus-get-info group)))
4173     (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
4174
4175 (defun gnus-summary-bubble-group ()
4176   "Increase the score of the current group.
4177 This is a handy function to add to `gnus-summary-exit-hook' to
4178 increase the score of each group you read."
4179   (gnus-group-add-score gnus-newsgroup-name))
4180
4181 (defun gnus-group-set-info (info &optional method-only-group part)
4182   (let* ((entry (gnus-gethash
4183                  (or method-only-group (gnus-info-group info))
4184                  gnus-newsrc-hashtb))
4185          (part-info info)
4186          (info (if method-only-group (nth 2 entry) info)))
4187     (when method-only-group
4188       (unless entry
4189         (error "Trying to change non-existent group %s" method-only-group))
4190       ;; We have recevied parts of the actual group info - either the
4191       ;; select method or the group parameters.  We first check
4192       ;; whether we have to extend the info, and if so, do that.
4193       (let ((len (length info))
4194             (total (if (eq part 'method) 5 6)))
4195         (when (< len total)
4196           (setcdr (nthcdr (1- len) info)
4197                   (make-list (- total len) nil)))
4198         ;; Then we enter the new info.
4199         (setcar (nthcdr (1- total) info) part-info)))
4200     (unless entry
4201       ;; This is a new group, so we just create it.
4202       (save-excursion
4203         (set-buffer gnus-group-buffer)
4204         (if (gnus-info-method info)
4205             ;; It's a foreign group...
4206             (gnus-group-make-group 
4207              (gnus-group-real-name (gnus-info-group info))
4208              (prin1-to-string (car (gnus-info-method info)))
4209              (nth 1 (gnus-info-method info)))
4210           ;; It's a native group.
4211           (gnus-group-make-group (gnus-info-group info)))
4212         (gnus-message 6 "Note: New group created")
4213         (setq entry 
4214               (gnus-gethash (gnus-group-prefixed-name 
4215                              (gnus-group-real-name (gnus-info-group info))
4216                              (or (gnus-info-method info) gnus-select-method))
4217                             gnus-newsrc-hashtb))))
4218     ;; Whether it was a new group or not, we now have the entry, so we
4219     ;; can do the update.
4220     (if entry
4221         (progn
4222           (setcar (nthcdr 2 entry) info)
4223           (when (and (not (eq (car entry) t)) 
4224                      (gnus-active (gnus-info-group info)))
4225             (let ((marked (gnus-info-marks info)))
4226               (setcar entry (length (gnus-list-of-unread-articles 
4227                                      (car info)))))))
4228       (error "No such group: %s" (gnus-info-group info)))))
4229
4230 (defun gnus-group-set-method-info (group select-method)
4231   (gnus-group-set-info select-method group 'method))
4232
4233 (defun gnus-group-set-params-info (group params)
4234   (gnus-group-set-info params group 'params))
4235
4236 (defun gnus-group-update-group-line ()
4237   "Update the current line in the group buffer."
4238   (let* ((buffer-read-only nil)
4239          (group (gnus-group-group-name))
4240          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4241     (and entry 
4242          (not (gnus-ephemeral-group-p group))
4243          (gnus-dribble-enter 
4244           (concat "(gnus-group-set-info '" 
4245                   (prin1-to-string (nth 2 entry)) ")")))
4246     (gnus-delete-line)
4247     (gnus-group-insert-group-line-info group)
4248     (forward-line -1)
4249     (gnus-group-position-point)))
4250
4251 (defun gnus-group-insert-group-line-info (group)
4252   "Insert GROUP on the current line."
4253   (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) 
4254         active info)
4255     (if entry
4256         (progn
4257           ;; (Un)subscribed group.
4258           (setq info (nth 2 entry))
4259           (gnus-group-insert-group-line 
4260            group (gnus-info-level info) (gnus-info-marks info)
4261            (or (car entry) t) (gnus-info-method info)))
4262       ;; This group is dead.
4263       (gnus-group-insert-group-line 
4264        group 
4265        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4266        nil 
4267        (if (setq active (gnus-active group))
4268            (- (1+ (cdr active)) (car active)) 0) 
4269        nil))))
4270
4271 ;; Dummy function redefined when running under XEmacs.
4272 (defalias 'gnus-group-remove-excess-properties 'ignore)
4273
4274 (defun gnus-group-insert-group-line 
4275   (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
4276                   gnus-tmp-method)
4277   "Insert a group line in the group buffer."
4278   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4279          (gnus-tmp-number-total 
4280           (if gnus-tmp-active 
4281               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4282             0))
4283          (gnus-tmp-number-of-unread 
4284           (if (numberp number) (int-to-string (max 0 number))
4285             "*"))
4286          (gnus-tmp-number-of-read
4287           (if (numberp number)
4288               (max 0 (- gnus-tmp-number-total number))
4289             "*"))
4290          (gnus-tmp-subscribed
4291           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4292                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4293                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4294                 (t ?K)))
4295          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4296          (gnus-tmp-newsgroup-description 
4297           (if gnus-description-hashtb
4298               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4299             ""))
4300          (gnus-tmp-moderated
4301           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4302          (gnus-tmp-moderated-string 
4303           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4304          (gnus-tmp-method
4305           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4306          (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) ""))
4307          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4308          (gnus-tmp-news-method-string 
4309           (if gnus-tmp-method
4310               (format "(%s:%s)" (car gnus-tmp-method)
4311                       (car (cdr gnus-tmp-method))) ""))
4312          (gnus-tmp-marked 
4313           (if (and (numberp number) 
4314                    (zerop number)
4315                    (cdr (assq 'tick gnus-tmp-marked)))
4316               ?* ? ))
4317          (gnus-tmp-number
4318           (cond ((eq number t) "*" )
4319                 ((numberp number) (int-to-string number))
4320                 (t number)))
4321          (gnus-tmp-process-marked
4322           (if (member gnus-tmp-group gnus-group-marked)
4323               gnus-process-mark ? ))
4324          (buffer-read-only nil)
4325          header)                        ; passed as parameter to user-funcs.
4326     (beginning-of-line)
4327     (add-text-properties
4328      (point)
4329      (prog1 (1+ (point))
4330        ;; Insert the text.
4331        (eval gnus-group-line-format-spec))
4332      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4333        gnus-unread ,(if (numberp number)
4334                         (string-to-int gnus-tmp-number-of-unread)
4335                       t)
4336        gnus-marked ,gnus-tmp-marked
4337        gnus-level ,gnus-tmp-level))
4338     ;; Allow XEmacs to remove front-sticky text properties.
4339     (gnus-group-remove-excess-properties)))
4340
4341 (defun gnus-group-update-group (group &optional visible-only)
4342   "Update all lines where GROUP appear.
4343 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4344 already." 
4345   (save-excursion
4346     (set-buffer gnus-group-buffer)
4347     ;; The buffer may be narrowed.
4348     (save-restriction
4349       (widen)
4350       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4351             (loc (point-min))
4352             found buffer-read-only visible)
4353         ;; Enter the current status into the dribble buffer.
4354         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4355           (if (and entry (not (gnus-ephemeral-group-p group)))
4356               (gnus-dribble-enter 
4357                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4358                        ")"))))
4359         ;; Find all group instances.  If topics are in use, each group
4360         ;; may be listed in more than once.
4361         (while (setq loc (text-property-any 
4362                           loc (point-max) 'gnus-group ident))
4363           (setq found t)
4364           (goto-char loc)
4365           (gnus-delete-line)
4366           (gnus-group-insert-group-line-info group)
4367           (setq loc (1+ loc)))
4368         (if (or found visible-only)
4369             ()
4370           ;; No such line in the buffer, find out where it's supposed to
4371           ;; go, and insert it there (or at the end of the buffer).
4372           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
4373           (let ((entry (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
4374             (while (and entry (car entry)
4375                         (not
4376                          (gnus-goto-char
4377                           (text-property-any
4378                            (point-min) (point-max) 
4379                            'gnus-group (gnus-intern-safe 
4380                                         (car (car entry)) 
4381                                         gnus-active-hashtb)))))
4382               (setq entry (cdr entry)))
4383             (or entry (goto-char (point-max))))
4384           ;; Finally insert the line.
4385           (gnus-group-insert-group-line-info group))
4386         (gnus-group-set-mode-line)))))
4387
4388 (defun gnus-group-set-mode-line ()
4389   (when (memq 'group gnus-updated-mode-lines)
4390     (let* ((gformat (or gnus-group-mode-line-format-spec
4391                         (setq gnus-group-mode-line-format-spec
4392                               (gnus-parse-format 
4393                                gnus-group-mode-line-format 
4394                                gnus-group-mode-line-format-alist))))
4395            (gnus-tmp-news-server (car (cdr gnus-select-method)))
4396            (gnus-tmp-news-method (car gnus-select-method))
4397            (max-len 60)
4398            header                       ;Dummy binding for user-defined formats
4399            ;; Get the resulting string.
4400            (mode-string (eval gformat)))
4401       ;; If the line is too long, we chop it off.
4402       (when (> (length mode-string) max-len) 
4403         (setq mode-string (substring mode-string 0 (- max-len 4))))
4404       (prog1
4405           (setq mode-line-buffer-identification mode-string)
4406         (set-buffer-modified-p t)))))
4407
4408 (defun gnus-group-group-name ()
4409   "Get the name of the newsgroup on the current line."
4410   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4411     (and group (symbol-name group))))
4412
4413 (defun gnus-group-group-level ()
4414   "Get the level of the newsgroup on the current line."
4415   (get-text-property (gnus-point-at-bol) 'gnus-level))
4416
4417 (defun gnus-group-group-unread ()
4418   "Get the number of unread articles of the newsgroup on the current line."
4419   (get-text-property (gnus-point-at-bol) 'gnus-unread))
4420
4421 (defun gnus-group-search-forward (&optional backward all level first-too)
4422   "Find the next newsgroup with unread articles.
4423 If BACKWARD is non-nil, find the previous newsgroup instead.
4424 If ALL is non-nil, just find any newsgroup.
4425 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4426 group exists.
4427 If FIRST-TOO, the current line is also eligible as a target."
4428   (let ((way (if backward -1 1))
4429         (low gnus-level-killed)
4430         (beg (point))
4431         pos found lev)
4432     (if (and backward (progn (beginning-of-line)) (bobp))
4433         nil
4434       (or first-too (forward-line way))
4435       (while (and 
4436               (not (eobp))
4437               (not (setq 
4438                     found 
4439                     (and (or all
4440                              (and
4441                               (let ((unread 
4442                                      (get-text-property (point) 'gnus-unread)))
4443                                 (and (numberp unread) (> unread 0)))
4444                               (setq lev (get-text-property (point)
4445                                                            'gnus-level))
4446                               (<= lev gnus-level-subscribed)))
4447                          (or (not level)
4448                              (and (setq lev (get-text-property (point)
4449                                                                'gnus-level))
4450                                   (or (= lev level)
4451                                       (and (< lev low)
4452                                            (< level lev)
4453                                            (progn
4454                                              (setq low lev)
4455                                              (setq pos (point))
4456                                              nil))))))))
4457               (zerop (forward-line way)))))
4458     (if found 
4459         (progn (gnus-group-position-point) t)
4460       (goto-char (or pos beg))
4461       (and pos t))))
4462
4463 ;;; Gnus group mode commands
4464
4465 ;; Group marking.
4466
4467 (defun gnus-group-mark-group (n &optional unmark no-advance)
4468   "Mark the current group."
4469   (interactive "p")
4470   (let ((buffer-read-only nil)
4471         group)
4472     (while 
4473         (and (> n 0) 
4474              (setq group (gnus-group-group-name))
4475              (progn
4476                (beginning-of-line)
4477                (forward-char 
4478                 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
4479                (delete-char 1)
4480                (if unmark
4481                    (progn
4482                      (insert " ")
4483                      (setq gnus-group-marked (delete group gnus-group-marked)))
4484                  (insert "#")
4485                  (setq gnus-group-marked
4486                        (cons group (delete group gnus-group-marked))))
4487                t)
4488              (or no-advance (zerop (gnus-group-next-group 1))))
4489       (setq n (1- n)))
4490     (gnus-summary-position-point)
4491     n))
4492
4493 (defun gnus-group-unmark-group (n)
4494   "Remove the mark from the current group."
4495   (interactive "p")
4496   (gnus-group-mark-group n 'unmark))
4497
4498 (defun gnus-group-mark-region (unmark beg end)
4499   "Mark all groups between point and mark.
4500 If UNMARK, remove the mark instead."
4501   (interactive "P\nr")
4502   (let ((num (count-lines beg end)))
4503     (save-excursion
4504       (goto-char beg)
4505       (- num (gnus-group-mark-group num unmark)))))
4506
4507 (defun gnus-group-mark-regexp (regexp)
4508   "Mark all groups that match some regexp."
4509   (interactive "sMark (regexp): ")
4510   (let ((alist (cdr gnus-newsrc-alist))
4511         group)
4512     (while alist
4513       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
4514         (gnus-group-set-mark group)))))
4515
4516 (defun gnus-group-remove-mark (group)
4517   (if (gnus-group-goto-group group)
4518       (save-excursion
4519         (gnus-group-mark-group 1 'unmark t))
4520     (setq gnus-group-marked
4521           (cons group (delete group gnus-group-marked)))))
4522                 
4523 (defun gnus-group-set-mark (group)
4524   (if (gnus-group-goto-group group)
4525       (save-excursion
4526         (gnus-group-mark-group 1 nil t))
4527     (setq gnus-group-marked
4528           (cons group (delete group gnus-group-marked)))))
4529                 
4530 ;; Return a list of groups to work on.  Take into consideration N (the
4531 ;; prefix) and the list of marked groups.
4532 (defun gnus-group-process-prefix (n)
4533   (cond
4534    (n
4535     (setq n (prefix-numeric-value n))
4536     ;; There is a prefix, so we return a list of the N next
4537     ;; groups. 
4538     (let ((way (if (< n 0) -1 1))
4539           (n (abs n))
4540           group groups)
4541       (save-excursion
4542         (while (and (> n 0)
4543                     (setq group (gnus-group-group-name)))
4544           (setq groups (cons group groups))
4545           (setq n (1- n))
4546           (gnus-group-next-group way)))
4547       (nreverse groups)))
4548    ((and (boundp 'transient-mark-mode)
4549          transient-mark-mode
4550          mark-active)
4551     ;; Work on the region between point and mark.
4552     (let ((max (max (point) (mark)))
4553           groups)
4554       (save-excursion
4555         (goto-char (min (point) (mark)))
4556         (while 
4557             (and 
4558              (push (gnus-group-group-name) groups)
4559              (zerop (gnus-group-next-group 1))
4560              (< (point) max)))
4561         (nreverse groups))))
4562    (gnus-group-marked
4563     ;; No prefix, but a list of marked articles.
4564     (reverse gnus-group-marked))
4565    (t
4566     ;; Neither marked articles or a prefix, so we return the
4567     ;; current group.
4568     (let ((group (gnus-group-group-name)))
4569       (and group (list group))))))
4570
4571 ;; Selecting groups.
4572
4573 (defun gnus-group-read-group (&optional all no-article group)
4574   "Read news in this newsgroup.
4575 If the prefix argument ALL is non-nil, already read articles become
4576 readable.  IF ALL is a number, fetch this number of articles.  If the
4577 optional argument NO-ARTICLE is non-nil, no article will be
4578 auto-selected upon group entry.  If GROUP is non-nil, fetch that
4579 group."
4580   (interactive "P")
4581   (let ((group (or group (gnus-group-group-name)))
4582         number active marked entry)
4583     (or group (error "No group on current line"))
4584     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
4585                                             group gnus-newsrc-hashtb)))))
4586     ;; This group might be a dead group.  In that case we have to get
4587     ;; the number of unread articles from `gnus-active-hashtb'.
4588     (setq number
4589           (cond ((numberp all) all)
4590                 (entry (car entry))
4591                 ((setq active (gnus-active group))
4592                  (- (1+ (cdr active)) (car active)))))
4593     (gnus-summary-read-group 
4594      group (or all (and (numberp number) 
4595                         (zerop (+ number (length (cdr (assq 'tick marked)))
4596                                   (length (cdr (assq 'dormant marked)))))))
4597      no-article)))
4598
4599 (defun gnus-group-select-group (&optional all)
4600   "Select this newsgroup.
4601 No article is selected automatically.
4602 If ALL is non-nil, already read articles become readable.
4603 If ALL is a number, fetch this number of articles."
4604   (interactive "P")
4605   (gnus-group-read-group all t))
4606
4607 (defun gnus-group-quick-select-group (&optional all)
4608   "Select the current group \"quickly\". 
4609 This means that no highlighting or scoring will be performed."
4610   (interactive "P")
4611   (let (gnus-visual
4612         gnus-score-find-score-files-function
4613         gnus-apply-kill-hook
4614         gnus-summary-expunge-below)
4615     (gnus-group-read-group all t)))
4616
4617 ;;;###autoload
4618 (defun gnus-fetch-group (group)
4619   "Start Gnus if necessary and enter GROUP.
4620 Returns whether the fetching was successful or not."
4621   (interactive "sGroup name: ")
4622   (or (get-buffer gnus-group-buffer)
4623       (gnus))
4624   (gnus-group-select-group))
4625
4626 ;; Enter a group that is not in the group buffer.  Non-nil is returned
4627 ;; if selection was successful.
4628 (defun gnus-group-read-ephemeral-group 
4629   (group method &optional activate quit-config)
4630   (let ((group (if (gnus-group-foreign-p group) group
4631                  (gnus-group-prefixed-name group method))))
4632     (gnus-sethash 
4633      group
4634      (list t nil (list group gnus-level-default-subscribed nil nil 
4635                        (append method
4636                                (list
4637                                 (list 'quit-config 
4638                                       (if quit-config quit-config
4639                                         (cons (current-buffer) 'summary)))))))
4640      gnus-newsrc-hashtb)
4641     (set-buffer gnus-group-buffer)
4642     (or (gnus-check-server method)
4643         (error "Unable to contact server: %s" (gnus-status-message method)))
4644     (if activate (or (gnus-request-group group)
4645                      (error "Couldn't request group")))
4646     (condition-case ()
4647         (gnus-group-read-group t t group)
4648       (error nil)
4649       (quit nil))
4650     (not (equal major-mode 'gnus-group-mode))))
4651   
4652 (defun gnus-group-jump-to-group (group)
4653   "Jump to newsgroup GROUP."
4654   (interactive 
4655    (list (completing-read 
4656           "Group: " gnus-active-hashtb nil 
4657           (memq gnus-select-method gnus-have-read-active-file))))
4658
4659   (if (equal group "")
4660       (error "Empty group name"))
4661
4662   (let ((b (text-property-any 
4663             (point-min) (point-max) 
4664             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4665     (if b
4666         ;; Either go to the line in the group buffer...
4667         (goto-char b)
4668       ;; ... or insert the line.
4669       (or
4670        (gnus-active group)
4671        (gnus-activate-group group)
4672        (error "%s error: %s" group (gnus-status-message group)))
4673
4674       (gnus-group-update-group group)
4675       (goto-char (text-property-any 
4676                   (point-min) (point-max)
4677                   'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
4678   ;; Adjust cursor point.
4679   (gnus-group-position-point))
4680
4681 (defun gnus-group-goto-group (group)
4682   "Goto to newsgroup GROUP."
4683   (when group
4684     (let ((b (text-property-any (point-min) (point-max) 
4685                                 'gnus-group (gnus-intern-safe
4686                                              group gnus-active-hashtb))))
4687       (and b (goto-char b)))))
4688
4689 (defun gnus-group-next-group (n)
4690   "Go to next N'th newsgroup.
4691 If N is negative, search backward instead.
4692 Returns the difference between N and the number of skips actually
4693 done."
4694   (interactive "p")
4695   (gnus-group-next-unread-group n t))
4696
4697 (defun gnus-group-next-unread-group (n &optional all level)
4698   "Go to next N'th unread newsgroup.
4699 If N is negative, search backward instead.
4700 If ALL is non-nil, choose any newsgroup, unread or not.
4701 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
4702 such group can be found, the next group with a level higher than
4703 LEVEL.
4704 Returns the difference between N and the number of skips actually
4705 made."
4706   (interactive "p")
4707   (let ((backward (< n 0))
4708         (n (abs n)))
4709     (while (and (> n 0)
4710                 (gnus-group-search-forward 
4711                  backward (or (not gnus-group-goto-unread) all) level))
4712       (setq n (1- n)))
4713     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
4714                                (if level " on this level or higher" "")))
4715     n))
4716
4717 (defun gnus-group-prev-group (n)
4718   "Go to previous N'th newsgroup.
4719 Returns the difference between N and the number of skips actually
4720 done."
4721   (interactive "p")
4722   (gnus-group-next-unread-group (- n) t))
4723
4724 (defun gnus-group-prev-unread-group (n)
4725   "Go to previous N'th unread newsgroup.
4726 Returns the difference between N and the number of skips actually
4727 done."  
4728   (interactive "p")
4729   (gnus-group-next-unread-group (- n)))
4730
4731 (defun gnus-group-next-unread-group-same-level (n)
4732   "Go to next N'th unread newsgroup on the same level.
4733 If N is negative, search backward instead.
4734 Returns the difference between N and the number of skips actually
4735 done."
4736   (interactive "p")
4737   (gnus-group-next-unread-group n t (gnus-group-group-level))
4738   (gnus-group-position-point))
4739
4740 (defun gnus-group-prev-unread-group-same-level (n)
4741   "Go to next N'th unread newsgroup on the same level.
4742 Returns the difference between N and the number of skips actually
4743 done."
4744   (interactive "p")
4745   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
4746   (gnus-group-position-point))
4747
4748 (defun gnus-group-best-unread-group (&optional exclude-group)
4749   "Go to the group with the highest level.
4750 If EXCLUDE-GROUP, do not go to that group."
4751   (interactive)
4752   (goto-char (point-min))
4753   (let ((best 100000)
4754         unread best-point)
4755     (while (setq unread (get-text-property (point) 'gnus-unread))
4756       (if (and (numberp unread) (> unread 0))
4757           (progn
4758             (if (and (< (get-text-property (point) 'gnus-level) best)
4759                      (or (not exclude-group)
4760                          (not (equal exclude-group (gnus-group-group-name)))))
4761                 (progn 
4762                   (setq best (get-text-property (point) 'gnus-level))
4763                   (setq best-point (point))))))
4764       (forward-line 1))
4765     (if best-point (goto-char best-point))
4766     (gnus-summary-position-point)
4767     (and best-point (gnus-group-group-name))))
4768
4769 (defun gnus-group-first-unread-group ()
4770   "Go to the first group with unread articles."
4771   (interactive)
4772   (prog1
4773       (let ((opoint (point))
4774             unread)
4775         (goto-char (point-min))
4776         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
4777                 (and (numberp unread)   ; Not a topic.
4778                      (not (zerop unread))) ; Has unread articles.
4779                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
4780             (point)                     ; Success.
4781           (goto-char opoint)
4782           nil))                         ; Not success.
4783     (gnus-group-position-point)))
4784
4785 (defun gnus-group-enter-server-mode ()
4786   "Jump to the server buffer."
4787   (interactive)
4788   (gnus-enter-server-buffer))
4789
4790 (defun gnus-group-make-group (name &optional method address)
4791   "Add a new newsgroup.
4792 The user will be prompted for a NAME, for a select METHOD, and an
4793 ADDRESS."
4794   (interactive
4795    (cons 
4796     (read-string "Group name: ")
4797     (let ((method
4798            (completing-read 
4799             "Method: " (append gnus-valid-select-methods gnus-server-alist)
4800             nil t)))
4801       (if (assoc method gnus-valid-select-methods)
4802           (list method
4803                 (if (memq 'prompt-address
4804                           (assoc method gnus-valid-select-methods))
4805                     (read-string "Address: ")
4806                   ""))
4807         (list method nil)))))
4808   
4809   (save-excursion
4810     (set-buffer gnus-group-buffer)
4811     (let* ((meth (and method (if address (list (intern method) address) 
4812                                method)))
4813            (nname (if method (gnus-group-prefixed-name name meth) name))
4814            info)
4815       (and (gnus-gethash nname gnus-newsrc-hashtb)
4816            (error "Group %s already exists" nname))
4817       (gnus-group-change-level 
4818        (setq info (list t nname gnus-level-default-subscribed nil nil meth))
4819        gnus-level-default-subscribed gnus-level-killed 
4820        (and (gnus-group-group-name)
4821             (gnus-gethash (gnus-group-group-name)
4822                           gnus-newsrc-hashtb))
4823        t)
4824       (gnus-set-active nname (cons 1 0))
4825       (or (gnus-ephemeral-group-p name)
4826           (gnus-dribble-enter 
4827            (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
4828       (gnus-group-insert-group-line-info nname)
4829
4830       (if (assoc method gnus-valid-select-methods)
4831           (require (intern method)))
4832       (and (gnus-check-backend-function 'request-create-group nname)
4833            (gnus-request-create-group nname))
4834       t)))
4835
4836 (defun gnus-group-delete-group (group &optional force)
4837   "Delete the current group.
4838 If FORCE (the prefix) is non-nil, all the articles in the group will
4839 be deleted.  This is \"deleted\" as in \"removed forever from the face
4840 of the Earth\".  There is no undo."
4841   (interactive 
4842    (list (gnus-group-group-name)
4843          current-prefix-arg))
4844   (or group (error "No group to rename"))
4845   (or (gnus-check-backend-function 'request-delete-group group)
4846       (error "This backend does not support group deletion"))
4847   (prog1
4848       (if (not (gnus-yes-or-no-p
4849                 (format
4850                  "Do you really want to delete %s%s? " 
4851                  group (if force " and all its contents" ""))))
4852           () ; Whew!
4853         (gnus-message 6 "Deleting group %s..." group)
4854         (if (not (gnus-request-delete-group group force))
4855             (progn
4856               (gnus-message 3 "Couldn't delete group %s" group)
4857               (ding))
4858           (gnus-message 6 "Deleting group %s...done" group)
4859           (gnus-group-goto-group group)
4860           (gnus-group-kill-group 1 t)
4861           t))
4862     (gnus-group-position-point)))
4863
4864 (defun gnus-group-rename-group (group new-name)
4865   (interactive
4866    (list
4867     (gnus-group-group-name)
4868     (progn
4869       (or (gnus-check-backend-function 
4870            'request-rename-group (gnus-group-group-name))
4871           (error "This backend does not support renaming groups"))
4872       (read-string "New group name: "))))
4873
4874   (or (gnus-check-backend-function 'request-rename-group group)
4875       (error "This backend does not support renaming groups"))
4876
4877   (or group (error "No group to rename"))
4878   (and (string-match "^[ \t]*$" new-name) 
4879        (error "Not a valid group name"))
4880
4881   ;; We find the proper prefixed name.
4882   (setq new-name
4883         (gnus-group-prefixed-name 
4884          (gnus-group-real-name new-name)
4885          (gnus-info-method (gnus-get-info group))))
4886
4887   (gnus-message 6 "Renaming group %s to %s..." group new-name)
4888   (prog1
4889       (if (not (gnus-request-rename-group group new-name))
4890           (progn
4891             (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
4892             (ding))
4893         ;; We rename the group internally by killing it...
4894         (gnus-group-goto-group group)
4895         (gnus-group-kill-group)
4896         ;; ... changing its name ...
4897         (setcar (cdr (car gnus-list-of-killed-groups))
4898                 new-name)
4899         ;; ... and then yanking it.  Magic!
4900         (gnus-group-yank-group) 
4901         (gnus-set-active new-name (gnus-active group))
4902         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
4903         new-name)
4904     (gnus-group-position-point)))
4905
4906
4907 (defun gnus-group-edit-group (group &optional part)
4908   "Edit the group on the current line."
4909   (interactive (list (gnus-group-group-name)))
4910   (let ((done-func '(lambda () 
4911                       "Exit editing mode and update the information."
4912                       (interactive)
4913                       (gnus-group-edit-group-done 'part 'group)))
4914         (part (or part 'info))
4915         (winconf (current-window-configuration))
4916         info)
4917     (or group (error "No group on current line"))
4918     (or (setq info (gnus-get-info group))
4919         (error "Killed group; can't be edited"))
4920     (set-buffer (get-buffer-create gnus-group-edit-buffer))
4921     (gnus-configure-windows 'edit-group)
4922     (gnus-add-current-to-buffer-list)
4923     (emacs-lisp-mode)
4924     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
4925     (use-local-map (copy-keymap emacs-lisp-mode-map))
4926     (local-set-key "\C-c\C-c" done-func)
4927     (make-local-variable 'gnus-prev-winconf)
4928     (setq gnus-prev-winconf winconf)
4929     ;; We modify the func to let it know what part it is editing.
4930     (setcar (cdr (nth 4 done-func)) (list 'quote part))
4931     (setcar (cdr (cdr (nth 4 done-func))) group)
4932     (erase-buffer)
4933     (insert
4934      (cond 
4935       ((eq part 'method)
4936        ";; Type `C-c C-c' after editing the select method.\n\n")
4937       ((eq part 'params)
4938        ";; Type `C-c C-c' after editing the group parameters.\n\n")
4939       ((eq part 'info)
4940        ";; Type `C-c C-c' after editing the group info.\n\n")))
4941     (insert 
4942      (pp-to-string
4943       (cond ((eq part 'method)
4944              (or (gnus-info-method info) "native"))
4945             ((eq part 'params)
4946              (gnus-info-params info))
4947             (t info)))
4948      "\n")))
4949
4950 (defun gnus-group-edit-group-method (group)
4951   "Edit the select method of GROUP."
4952   (interactive (list (gnus-group-group-name)))
4953   (gnus-group-edit-group group 'method))
4954
4955 (defun gnus-group-edit-group-parameters (group)
4956   "Edit the group parameters of GROUP."
4957   (interactive (list (gnus-group-group-name)))
4958   (gnus-group-edit-group group 'params))
4959
4960 (defun gnus-group-edit-group-done (part group)
4961   "Get info from buffer, update variables and jump to the group buffer."
4962   (set-buffer (get-buffer-create gnus-group-edit-buffer))
4963   (goto-char (point-min))
4964   (let ((form (read (current-buffer)))
4965         (winconf gnus-prev-winconf))
4966     (if (eq part 'info) 
4967         (gnus-group-set-info form)
4968       (gnus-group-set-info form group part))
4969     (kill-buffer (current-buffer))
4970     (and winconf (set-window-configuration winconf))
4971     (set-buffer gnus-group-buffer)
4972     (gnus-group-update-group (gnus-group-group-name))
4973     (gnus-group-position-point)))
4974
4975 (defun gnus-group-make-help-group ()
4976   "Create the Gnus documentation group."
4977   (interactive)
4978   (let ((path (cons (concat installation-directory "etc/") load-path))
4979         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
4980         file)
4981     (and (gnus-gethash name gnus-newsrc-hashtb)
4982          (error "Documentation group already exists"))
4983     (while (and path
4984                 (not (file-exists-p 
4985                       (setq file (concat (file-name-as-directory (car path))
4986                                          "gnus-tut.txt")))))
4987       (setq path (cdr path)))
4988     (if (not path)
4989         (message "Couldn't find doc group")
4990       (gnus-group-make-group 
4991        (gnus-group-real-name name)
4992        (list 'nndoc name
4993              (list 'nndoc-address file)
4994              (list 'nndoc-article-type 'mbox)))))
4995   (gnus-group-position-point))
4996
4997 (defun gnus-group-make-doc-group (file type)
4998   "Create a group that uses a single file as the source."
4999   (interactive 
5000    (list (read-file-name "File name: ") 
5001          (and current-prefix-arg 'ask)))
5002   (when (eq type 'ask)
5003     (let ((err "")
5004           char found)
5005       (while (not found)
5006         (message 
5007          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5008          err)
5009         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5010                           ((= char ?b) 'babyl)
5011                           ((= char ?d) 'digest)
5012                           ((= char ?f) 'forward)
5013                           ((= char ?a) 'mmfd)
5014                           (t (setq err (format "%c unknown. " char))
5015                              nil))))
5016       (setq type found)))
5017   (let* ((file (expand-file-name file))
5018          (name (gnus-generate-new-group-name
5019                 (gnus-group-prefixed-name
5020                  (file-name-nondirectory file) '(nndoc "")))))
5021     (gnus-group-make-group 
5022      (gnus-group-real-name name)
5023      (list 'nndoc name
5024            (list 'nndoc-address file)
5025            (list 'nndoc-article-type (or type 'guess))))
5026     (forward-line -1)
5027     (gnus-group-position-point)))
5028
5029 (defun gnus-group-make-archive-group (&optional all)
5030   "Create the (ding) Gnus archive group of the most recent articles.
5031 Given a prefix, create a full group."
5032   (interactive "P")
5033   (let ((group (gnus-group-prefixed-name 
5034                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5035     (and (gnus-gethash group gnus-newsrc-hashtb)
5036          (error "Archive group already exists"))
5037     (gnus-group-make-group
5038      (gnus-group-real-name group)
5039      (list 'nndir (if all "hpc" "edu")
5040            (list 'nndir-directory  
5041                  (if all gnus-group-archive-directory 
5042                    gnus-group-recent-archive-directory)))))
5043   (forward-line -1)
5044   (gnus-group-position-point))
5045
5046 (defun gnus-group-make-directory-group (dir)
5047   "Create an nndir group.
5048 The user will be prompted for a directory.  The contents of this
5049 directory will be used as a newsgroup.  The directory should contain
5050 mail messages or news articles in files that have numeric names."
5051   (interactive
5052    (list (read-file-name "Create group from directory: ")))
5053   (or (file-exists-p dir) (error "No such directory"))
5054   (or (file-directory-p dir) (error "Not a directory"))
5055   (let ((ext "")
5056         (i 0)
5057         group)
5058     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5059       (setq group
5060             (gnus-group-prefixed-name 
5061              (concat (file-name-as-directory (directory-file-name dir))
5062                      ext)
5063              '(nndir "")))
5064       (setq ext (format "<%d>" (setq i (1+ i)))))
5065     (gnus-group-make-group 
5066      (gnus-group-real-name group)
5067      (list 'nndir group (list 'nndir-directory dir))))
5068   (forward-line -1)
5069   (gnus-group-position-point))
5070
5071 (defun gnus-group-make-kiboze-group (group address scores)
5072   "Create an nnkiboze group.
5073 The user will be prompted for a name, a regexp to match groups, and
5074 score file entries for articles to include in the group."
5075   (interactive
5076    (list
5077     (read-string "nnkiboze group name: ")
5078     (read-string "Source groups (regexp): ")
5079     (let ((headers (mapcar (lambda (group) (list group))
5080                            '("subject" "from" "number" "date" "message-id"
5081                              "references" "chars" "lines" "xref"
5082                              "followup" "all" "body" "head")))
5083           scores header regexp regexps)
5084       (while (not (equal "" (setq header (completing-read 
5085                                           "Match on header: " headers nil t))))
5086         (setq regexps nil)
5087         (while (not (equal "" (setq regexp (read-string 
5088                                             (format "Match on %s (string): "
5089                                                     header)))))
5090           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5091         (setq scores (cons (cons header regexps) scores)))
5092       scores)))
5093   (gnus-group-make-group group "nnkiboze" address)
5094   (save-excursion
5095     (gnus-set-work-buffer)
5096     (let (emacs-lisp-mode-hook)
5097       (pp scores (current-buffer)))
5098     (write-region (point-min) (point-max) 
5099                   (gnus-score-file-name (concat "nnkiboze:" group))))
5100   (forward-line -1)
5101   (gnus-group-position-point))
5102
5103 (defun gnus-group-add-to-virtual (n vgroup)
5104   "Add the current group to a virtual group."
5105   (interactive
5106    (list current-prefix-arg
5107          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5108                           "nnvirtual:")))
5109   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5110       (error "%s is not an nnvirtual group" vgroup))
5111   (let* ((groups (gnus-group-process-prefix n))
5112          (method (gnus-info-method (gnus-get-info vgroup))))
5113     (setcar (cdr method)
5114             (concat 
5115              (nth 1 method) "\\|"
5116              (mapconcat 
5117               (lambda (s) 
5118                 (gnus-group-remove-mark s)
5119                 (concat "\\(^" (regexp-quote s) "$\\)"))
5120               groups "\\|"))))
5121   (gnus-group-position-point))
5122
5123 (defun gnus-group-make-empty-virtual (group)
5124   "Create a new, fresh, empty virtual group."
5125   (interactive "sCreate new, empty virtual group: ")
5126   (let* ((method (list 'nnvirtual "^$"))
5127          (pgroup (gnus-group-prefixed-name group method)))
5128     ;; Check whether it exists already.
5129     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
5130          (error "Group %s already exists." pgroup))
5131     ;; Subscribe the new group after the group on the current line.
5132     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
5133     (gnus-group-update-group pgroup)
5134     (forward-line -1)
5135     (gnus-group-position-point)))
5136
5137 (defun gnus-group-enter-directory (dir)
5138   "Enter an ephemeral nneething group."
5139   (interactive "DDirectory to read: ")
5140   (let* ((method (list 'nneething dir))
5141          (leaf (gnus-group-prefixed-name
5142                 (file-name-nondirectory (directory-file-name dir))
5143                 method))
5144          (name (gnus-generate-new-group-name leaf)))
5145     (let ((nneething-read-only t))
5146       (or (gnus-group-read-ephemeral-group 
5147            name method t
5148            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
5149                                       'summary 'group)))
5150           (error "Couldn't enter %s" dir)))))
5151
5152 ;; Group sorting commands
5153 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
5154
5155 (defun gnus-group-sort-groups (func &optional reverse)
5156   "Sort the group buffer according to FUNC.
5157 If REVERSE, reverse the sorting order."
5158   (interactive (list gnus-group-sort-function
5159                      current-prefix-arg))
5160   (unless (listp func)
5161     (setq func (list func)))
5162   ;; We peel off the dummy group from the alist.
5163   (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
5164     (pop gnus-newsrc-alist))
5165   ;; Do the sorting.
5166   (while func
5167     (setq gnus-newsrc-alist 
5168           (sort gnus-newsrc-alist (pop func))))
5169   (when reverse
5170     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
5171   ;; Regenerate the hash table.
5172   (gnus-make-hashtable-from-newsrc-alist)
5173   (gnus-group-list-groups))
5174
5175 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
5176   "Sort the group buffer alphabetically by group name.
5177 If REVERSE, sort in reverse order."
5178   (interactive "P")
5179   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
5180
5181 (defun gnus-group-sort-groups-by-unread (&optional reverse)
5182   "Sort the group buffer by number of unread articles.
5183 If REVERSE, sort in reverse order."
5184   (interactive "P")
5185   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
5186
5187 (defun gnus-group-sort-groups-by-level (&optional reverse)
5188   "Sort the group buffer by group level.
5189 If REVERSE, sort in reverse order."
5190   (interactive "P")
5191   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
5192
5193 (defun gnus-group-sort-groups-by-score (&optional reverse)
5194   "Sort the group buffer by group score.
5195 If REVERSE, sort in reverse order."
5196   (interactive "P")
5197   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
5198
5199 (defun gnus-group-sort-groups-by-rank (&optional reverse)
5200   "Sort the group buffer by group rank.
5201 If REVERSE, sort in reverse order."
5202   (interactive "P")
5203   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
5204
5205 (defun gnus-group-sort-groups-by-method (&optional reverse)
5206   "Sort the group buffer alphabetically by backend name.
5207 If REVERSE, sort in reverse order."
5208   (interactive "P")
5209   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
5210
5211 (defun gnus-group-sort-by-alphabet (info1 info2)
5212   "Sort alphabetically."
5213   (string< (gnus-info-group info1) (gnus-info-group info2)))
5214
5215 (defun gnus-group-sort-by-unread (info1 info2)
5216   "Sort by number of unread articles."
5217   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
5218         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
5219     (< (or (and (numberp n1) n1) 0)
5220        (or (and (numberp n2) n2) 0))))
5221
5222 (defun gnus-group-sort-by-level (info1 info2)
5223   "Sort by level."
5224   (< (gnus-info-level info1) (gnus-info-level info2)))
5225
5226 (defun gnus-group-sort-by-method (info1 info2)
5227   "Sort alphabetically by backend name."
5228   (string< (symbol-name (car (gnus-find-method-for-group
5229                               (gnus-info-group info1) info1)))
5230            (symbol-name (car (gnus-find-method-for-group 
5231                               (gnus-info-group info2) info2)))))
5232
5233 (defun gnus-group-sort-by-score (info1 info2)
5234   "Sort by group score."
5235   (< (gnus-info-score info1) (gnus-info-score info2)))
5236
5237 (defun gnus-group-sort-by-rank (info1 info2)
5238   "Sort by level and score."
5239   (let ((level1 (gnus-info-level info1))
5240         (level2 (gnus-info-level info2)))
5241     (or (< level1 level2)
5242         (and (= level1 level2)
5243              (< (gnus-info-score info1) (gnus-info-score info2))))))
5244
5245 ;; Group catching up.
5246
5247 (defun gnus-group-catchup-current (&optional n all)
5248   "Mark all articles not marked as unread in current newsgroup as read.
5249 If prefix argument N is numeric, the ARG next newsgroups will be
5250 caught up.  If ALL is non-nil, marked articles will also be marked as
5251 read.  Cross references (Xref: header) of articles are ignored.
5252 The difference between N and actual number of newsgroups that were
5253 caught up is returned."
5254   (interactive "P")
5255   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
5256                gnus-expert-user
5257                (gnus-y-or-n-p
5258                 (if all
5259                     "Do you really want to mark all articles as read? "
5260                   "Mark all unread articles as read? "))))
5261       n
5262     (let ((groups (gnus-group-process-prefix n))
5263           (ret 0))
5264       (while groups
5265         ;; Virtual groups have to be given special treatment. 
5266         (let ((method (gnus-find-method-for-group (car groups))))
5267           (if (eq 'nnvirtual (car method))
5268               (nnvirtual-catchup-group
5269                (gnus-group-real-name (car groups)) (nth 1 method) all)))
5270         (gnus-group-remove-mark (car groups))
5271         (if (prog1
5272                 (gnus-group-goto-group (car groups))
5273               (gnus-group-catchup (car groups) all))
5274             (gnus-group-update-group-line)
5275           (setq ret (1+ ret)))
5276         (setq groups (cdr groups)))
5277       (gnus-group-next-unread-group 1)
5278       ret)))
5279
5280 (defun gnus-group-catchup-current-all (&optional n)
5281   "Mark all articles in current newsgroup as read.
5282 Cross references (Xref: header) of articles are ignored."
5283   (interactive "P")
5284   (gnus-group-catchup-current n 'all))
5285
5286 (defun gnus-group-catchup (group &optional all)
5287   "Mark all articles in GROUP as read.
5288 If ALL is non-nil, all articles are marked as read.
5289 The return value is the number of articles that were marked as read,
5290 or nil if no action could be taken."
5291   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
5292          (num (car entry))
5293          (marked (nth 3 (nth 2 entry))))
5294     (if (not (numberp (car entry)))
5295         (gnus-message 1 "Can't catch up; non-active group")
5296       ;; Do the updating only if the newsgroup isn't killed.
5297       (when entry
5298         (gnus-update-read-articles group nil)
5299         ;; Also nix out the lists of marks and dormants. 
5300         (when all 
5301           (gnus-add-marked-articles group 'tick nil nil 'force)
5302           (gnus-add-marked-articles group 'dormant nil nil 'force))
5303         num))))
5304
5305 (defun gnus-group-expire-articles (&optional n)
5306   "Expire all expirable articles in the current newsgroup."
5307   (interactive "P")
5308   (let ((groups (gnus-group-process-prefix n))
5309         group)
5310     (unless groups
5311       (error "No groups to expire"))
5312     (while groups
5313       (setq group (pop groups))
5314       (gnus-group-remove-mark group)
5315       (when (gnus-check-backend-function 'request-expire-articles group)
5316         (let* ((info (gnus-get-info group))
5317                (expirable (if (gnus-group-total-expirable-p group)
5318                               (cons nil (gnus-list-of-read-articles group))
5319                             (assq 'expire (gnus-info-marks info)))))
5320           (when expirable 
5321             (setcdr expirable
5322                     (gnus-compress-sequence
5323                      (gnus-request-expire-articles 
5324                       (gnus-uncompress-sequence (cdr expirable)) group)))))))))
5325
5326 (defun gnus-group-expire-all-groups ()
5327   "Expire all expirable articles in all newsgroups."
5328   (interactive)
5329   (save-excursion
5330     (gnus-message 5 "Expiring...")
5331     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
5332                                      (cdr gnus-newsrc-alist))))
5333       (gnus-group-expire-articles nil)))
5334   (gnus-group-position-point)
5335   (gnus-message 5 "Expiring...done"))
5336
5337 (defun gnus-group-set-current-level (n level)
5338   "Set the level of the next N groups to LEVEL."
5339   (interactive 
5340    (list
5341     current-prefix-arg
5342     (string-to-int
5343      (let ((s (read-string 
5344                (format "Level (default %s): " (gnus-group-group-level)))))
5345        (if (string-match "^\\s-*$" s)
5346            (int-to-string (gnus-group-group-level))
5347          s)))))
5348   (or (and (>= level 1) (<= level gnus-level-killed))
5349       (error "Illegal level: %d" level))
5350   (let ((groups (gnus-group-process-prefix n))
5351         group)
5352     (while groups
5353       (setq group (car groups)
5354             groups (cdr groups))
5355       (gnus-group-remove-mark group)
5356       (gnus-message 6 "Changed level of %s from %d to %d" 
5357                     group (gnus-group-group-level) level)
5358       (gnus-group-change-level group level
5359                                (gnus-group-group-level))
5360       (gnus-group-update-group-line)))
5361   (gnus-group-position-point))
5362
5363 (defun gnus-group-unsubscribe-current-group (&optional n)
5364   "Toggle subscription of the current group.
5365 If given numerical prefix, toggle the N next groups."
5366   (interactive "P")
5367   (let ((groups (gnus-group-process-prefix n))
5368         group)
5369     (while groups
5370       (setq group (car groups)
5371             groups (cdr groups))
5372       (gnus-group-remove-mark group)
5373       (gnus-group-unsubscribe-group
5374        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
5375                  gnus-level-default-unsubscribed
5376                gnus-level-default-subscribed))
5377       (gnus-group-update-group-line))
5378     (gnus-group-next-group 1)))
5379
5380 (defun gnus-group-unsubscribe-group (group &optional level)
5381   "Toggle subscribe from/to unsubscribe GROUP.
5382 New newsgroup is added to .newsrc automatically."
5383   (interactive
5384    (list (completing-read
5385           "Group: " gnus-active-hashtb nil 
5386           (memq gnus-select-method gnus-have-read-active-file))))
5387   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
5388     (cond
5389      ((string-match "^[ \t]$" group)
5390       (error "Empty group name"))
5391      (newsrc
5392       ;; Toggle subscription flag.
5393       (gnus-group-change-level 
5394        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) 
5395                                       gnus-level-subscribed) 
5396                                   (1+ gnus-level-subscribed)
5397                                 gnus-level-default-subscribed)))
5398       (gnus-group-update-group group))
5399      ((and (stringp group)
5400            (or (not (memq gnus-select-method gnus-have-read-active-file))
5401                (gnus-active group)))
5402       ;; Add new newsgroup.
5403       (gnus-group-change-level 
5404        group 
5405        (if level level gnus-level-default-subscribed) 
5406        (or (and (member group gnus-zombie-list) 
5407                 gnus-level-zombie) 
5408            gnus-level-killed)
5409        (and (gnus-group-group-name)
5410             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
5411       (gnus-group-update-group group))
5412      (t (error "No such newsgroup: %s" group)))
5413     (gnus-group-position-point)))
5414
5415 (defun gnus-group-transpose-groups (n)
5416   "Move the current newsgroup up N places.
5417 If given a negative prefix, move down instead.  The difference between
5418 N and the number of steps taken is returned." 
5419   (interactive "p")
5420   (or (gnus-group-group-name)
5421       (error "No group on current line"))
5422   (gnus-group-kill-group 1)
5423   (prog1
5424       (forward-line (- n))
5425     (gnus-group-yank-group)
5426     (gnus-group-position-point)))
5427
5428 (defun gnus-group-kill-all-zombies ()
5429   "Kill all zombie newsgroups."
5430   (interactive)
5431   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
5432   (setq gnus-zombie-list nil)
5433   (gnus-group-list-groups))
5434
5435 (defun gnus-group-kill-region (begin end)
5436   "Kill newsgroups in current region (excluding current point).
5437 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
5438   (interactive "r")
5439   (let ((lines
5440          ;; Count lines.
5441          (save-excursion
5442            (count-lines
5443             (progn
5444               (goto-char begin)
5445               (beginning-of-line)
5446               (point))
5447             (progn
5448               (goto-char end)
5449               (beginning-of-line)
5450               (point))))))
5451     (goto-char begin)
5452     (beginning-of-line)                 ;Important when LINES < 1
5453     (gnus-group-kill-group lines)))
5454
5455 (defun gnus-group-kill-group (&optional n discard)
5456   "Kill the next N groups.
5457 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
5458 However, only groups that were alive can be yanked; already killed 
5459 groups or zombie groups can't be yanked.
5460 The return value is the name of the (last) group that was killed."
5461   (interactive "P")
5462   (let ((buffer-read-only nil)
5463         (groups (gnus-group-process-prefix n))
5464         group entry level)
5465     (if (or t (< (length groups) 10))
5466         ;; This is faster when there are few groups.
5467         (while groups
5468           (setq group (car groups)
5469                 groups (cdr groups))
5470           (gnus-group-remove-mark group)
5471           (setq level (gnus-group-group-level))
5472           (gnus-delete-line)
5473           (if (and (not discard)
5474                    (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
5475               (setq gnus-list-of-killed-groups 
5476                     (cons (cons (car entry) (nth 2 entry)) 
5477                           gnus-list-of-killed-groups)))
5478           (gnus-group-change-level 
5479            (if entry entry group) gnus-level-killed (if entry nil level)))
5480       ;; If there are lots and lots of groups to be killed, we use
5481       ;; this thing instead.
5482       ;; !!! Not written.
5483       )
5484       
5485     (gnus-group-position-point)
5486     group))
5487
5488 (defun gnus-group-yank-group (&optional arg)
5489   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
5490 inserting it before the current newsgroup.  The numeric ARG specifies
5491 how many newsgroups are to be yanked.  The name of the (last)
5492 newsgroup yanked is returned."
5493   (interactive "p")
5494   (if (not arg) (setq arg 1))
5495   (let (info group prev)
5496     (while (>= (setq arg (1- arg)) 0)
5497       (if (not (setq info (car gnus-list-of-killed-groups)))
5498           (error "No more newsgroups to yank"))
5499       (setq group (nth 1 info))
5500       ;; Find which newsgroup to insert this one before - search
5501       ;; backward until something suitable is found.  If there are no
5502       ;; other newsgroups in this buffer, just make this newsgroup the
5503       ;; first newsgroup.
5504       (setq prev (gnus-group-group-name))
5505       (gnus-group-change-level 
5506        info (nth 2 info) gnus-level-killed 
5507        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
5508        t)
5509       (gnus-group-insert-group-line-info group)
5510       (setq gnus-list-of-killed-groups 
5511             (cdr gnus-list-of-killed-groups)))
5512     (forward-line -1)
5513     (gnus-group-position-point)
5514     group))
5515       
5516 (defun gnus-group-list-all-groups (&optional arg)
5517   "List all newsgroups with level ARG or lower.
5518 Default is gnus-level-unsubscribed, which lists all subscribed and most
5519 unsubscribed groups."
5520   (interactive "P")
5521   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
5522
5523 ;; Redefine this to list ALL killed groups if prefix arg used.
5524 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
5525 (defun gnus-group-list-killed (&optional arg)
5526   "List all killed newsgroups in the group buffer.
5527 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
5528 entail asking the server for the groups."
5529   (interactive "P")
5530   ;; Find all possible killed newsgroups if arg.
5531   (when arg
5532     ;; First make sure active file has been read.
5533     (unless gnus-have-read-active-file
5534       (let ((gnus-read-active-file t))
5535         (gnus-read-active-file)))
5536     (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
5537     ;; Go through all newsgroups that are known to Gnus - enlarge kill list
5538     (mapatoms
5539      (lambda (sym)
5540        (let ((groups 0)
5541              (group (symbol-name sym)))
5542          (if (or (null group)
5543                  (gnus-gethash group gnus-killed-hashtb)
5544                  (gnus-gethash group gnus-newsrc-hashtb))
5545              ()
5546            (let ((do-sub (gnus-matches-options-n group)))
5547              (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
5548                  ()
5549                (setq groups (1+ groups))
5550                (setq gnus-killed-list 
5551                      (cons group gnus-killed-list))
5552                (gnus-sethash group group gnus-killed-hashtb))))))
5553      gnus-active-hashtb))
5554   (if (not gnus-killed-list)
5555       (gnus-message 6 "No killed groups")
5556     (let (gnus-group-list-mode)
5557       (funcall gnus-group-prepare-function 
5558                gnus-level-killed t gnus-level-killed))
5559     (goto-char (point-min)))
5560   (gnus-group-position-point))
5561
5562 (defun gnus-group-list-zombies ()
5563   "List all zombie newsgroups in the group buffer."
5564   (interactive)
5565   (if (not gnus-zombie-list)
5566       (gnus-message 6 "No zombie groups")
5567     (let (gnus-group-list-mode)
5568       (funcall gnus-group-prepare-function
5569                gnus-level-zombie t gnus-level-zombie))
5570     (goto-char (point-min)))
5571   (gnus-group-position-point))
5572
5573 (defun gnus-group-list-active ()
5574   "List all groups that are available from the server(s)."
5575   (interactive)
5576   ;; First we make sure that we have really read the active file. 
5577   (unless gnus-have-read-active-file
5578     (let ((gnus-read-active-file t))
5579       (gnus-read-active-file)))
5580   ;; Find all groups and sort them.
5581   (let ((groups 
5582          (sort 
5583           (let (list)
5584             (mapatoms
5585              (lambda (sym)
5586                (and (symbol-value sym)
5587                     (setq list (cons (symbol-name sym) list))))
5588              gnus-active-hashtb)
5589             list)
5590           'string<))
5591         (buffer-read-only nil))
5592     (erase-buffer)
5593     (while groups
5594       (gnus-group-insert-group-line-info (car groups))
5595       (setq groups (cdr groups)))
5596     (goto-char (point-min))))
5597
5598 (defun gnus-group-get-new-news (&optional arg)
5599   "Get newly arrived articles.
5600 If ARG is a number, it specifies which levels you are interested in
5601 re-scanning.  If ARG is non-nil and not a number, this will force
5602 \"hard\" re-reading of the active files from all servers."
5603   (interactive "P")
5604   (run-hooks 'gnus-get-new-news-hook)
5605   ;; We might read in new NoCeM messages here.
5606   (and gnus-use-nocem (gnus-nocem-scan-groups))
5607   ;; If ARG is not a number, then we read the active file.
5608   (and arg
5609        (not (numberp arg))
5610        (progn
5611          (let ((gnus-read-active-file t))
5612            (gnus-read-active-file))
5613          (setq arg nil)))
5614
5615   (setq arg (gnus-group-default-level arg t))
5616   (if (and gnus-read-active-file (not arg))
5617       (progn
5618         (gnus-read-active-file)
5619         (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed))))
5620     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
5621       (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed)))))
5622   (gnus-group-list-groups))
5623
5624 (defun gnus-group-get-new-news-this-group (&optional n)
5625   "Check for newly arrived news in the current group (and the N-1 next groups).
5626 The difference between N and the number of newsgroup checked is returned.
5627 If N is negative, this group and the N-1 previous groups will be checked."
5628   (interactive "P")
5629   (let* ((groups (gnus-group-process-prefix n))
5630          (ret (if (numberp n) (- n (length groups)) 0))
5631          group)
5632     (while groups
5633       (setq group (car groups)
5634             groups (cdr groups))
5635       (gnus-group-remove-mark group)
5636       (or (gnus-get-new-news-in-group group)
5637           (progn 
5638             (ding) 
5639             (message "%s error: %s" group (gnus-status-message group))
5640             (sit-for 2))))
5641     (gnus-group-next-unread-group 1 t)
5642     (gnus-summary-position-point)
5643     ret))
5644
5645 (defun gnus-get-new-news-in-group (group)
5646   (when (and group (gnus-activate-group group 'scan))
5647     (gnus-get-unread-articles-in-group 
5648      (gnus-get-info group) (gnus-active group))
5649     (when (gnus-group-goto-group group)
5650       (gnus-group-update-group-line))
5651     t))
5652
5653 (defun gnus-group-fetch-faq (group &optional faq-dir)
5654   "Fetch the FAQ for the current group."
5655   (interactive 
5656    (list
5657     (gnus-group-real-name (gnus-group-group-name))
5658     (cond (current-prefix-arg
5659            (completing-read 
5660             "Faq dir: " (and (listp gnus-group-faq-directory) 
5661                              gnus-group-faq-directory))))))
5662   (or faq-dir
5663       (setq faq-dir (if (listp gnus-group-faq-directory)
5664                         (car gnus-group-faq-directory)
5665                       gnus-group-faq-directory)))
5666   (or group (error "No group name given"))
5667   (let ((file (concat (file-name-as-directory faq-dir)
5668                       (gnus-group-real-name group))))
5669     (if (not (file-exists-p file))
5670         (error "No such file: %s" file)
5671       (find-file file))))
5672   
5673 (defun gnus-group-describe-group (force &optional group)
5674   "Display a description of the current newsgroup."
5675   (interactive (list current-prefix-arg (gnus-group-group-name)))
5676   (and force (setq gnus-description-hashtb nil))
5677   (let ((method (gnus-find-method-for-group group))
5678         desc)
5679     (or group (error "No group name given"))
5680     (and (or (and gnus-description-hashtb
5681                   ;; We check whether this group's method has been
5682                   ;; queried for a description file.  
5683                   (gnus-gethash 
5684                    (gnus-group-prefixed-name "" method) 
5685                    gnus-description-hashtb))
5686              (setq desc (gnus-group-get-description group))
5687              (gnus-read-descriptions-file method))
5688          (message
5689           (or desc (gnus-gethash group gnus-description-hashtb)
5690               "No description available")))))
5691
5692 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
5693 (defun gnus-group-describe-all-groups (&optional force)
5694   "Pop up a buffer with descriptions of all newsgroups."
5695   (interactive "P")
5696   (and force (setq gnus-description-hashtb nil))
5697   (if (not (or gnus-description-hashtb
5698                (gnus-read-all-descriptions-files)))
5699       (error "Couldn't request descriptions file"))
5700   (let ((buffer-read-only nil)
5701         b)
5702     (erase-buffer)
5703     (mapatoms
5704      (lambda (group)
5705        (setq b (point))
5706        (insert (format "      *: %-20s %s\n" (symbol-name group)
5707                        (symbol-value group)))
5708        (add-text-properties 
5709         b (1+ b) (list 'gnus-group group
5710                        'gnus-unread t 'gnus-marked nil
5711                        'gnus-level (1+ gnus-level-subscribed))))
5712      gnus-description-hashtb)
5713     (goto-char (point-min))
5714     (gnus-group-position-point)))
5715
5716 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
5717 (defun gnus-group-apropos (regexp &optional search-description)
5718   "List all newsgroups that have names that match a regexp."
5719   (interactive "sGnus apropos (regexp): ")
5720   (let ((prev "")
5721         (obuf (current-buffer))
5722         groups des)
5723     ;; Go through all newsgroups that are known to Gnus.
5724     (mapatoms 
5725      (lambda (group)
5726        (and (symbol-name group)
5727             (string-match regexp (symbol-name group))
5728             (setq groups (cons (symbol-name group) groups))))
5729      gnus-active-hashtb)
5730     ;; Go through all descriptions that are known to Gnus. 
5731     (if search-description
5732         (mapatoms 
5733          (lambda (group)
5734            (and (string-match regexp (symbol-value group))
5735                 (gnus-active (symbol-name group))
5736                 (setq groups (cons (symbol-name group) groups))))
5737          gnus-description-hashtb))
5738     (if (not groups)
5739         (gnus-message 3 "No groups matched \"%s\"." regexp)
5740       ;; Print out all the groups.
5741       (save-excursion
5742         (pop-to-buffer "*Gnus Help*")
5743         (buffer-disable-undo (current-buffer))
5744         (erase-buffer)
5745         (setq groups (sort groups 'string<))
5746         (while groups
5747           ;; Groups may be entered twice into the list of groups.
5748           (if (not (string= (car groups) prev))
5749               (progn
5750                 (insert (setq prev (car groups)) "\n")
5751                 (if (and gnus-description-hashtb
5752                          (setq des (gnus-gethash (car groups) 
5753                                                  gnus-description-hashtb)))
5754                     (insert "  " des "\n"))))
5755           (setq groups (cdr groups)))
5756         (goto-char (point-min))))
5757     (pop-to-buffer obuf)))
5758
5759 (defun gnus-group-description-apropos (regexp)
5760   "List all newsgroups that have names or descriptions that match a regexp."
5761   (interactive "sGnus description apropos (regexp): ")
5762   (if (not (or gnus-description-hashtb
5763                (gnus-read-all-descriptions-files)))
5764       (error "Couldn't request descriptions file"))
5765   (gnus-group-apropos regexp t))
5766
5767 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
5768 (defun gnus-group-list-matching (level regexp &optional all lowest) 
5769   "List all groups with unread articles that match REGEXP.
5770 If the prefix LEVEL is non-nil, it should be a number that says which
5771 level to cut off listing groups. 
5772 If ALL, also list groups with no unread articles.
5773 If LOWEST, don't list groups with level lower than LOWEST."
5774   (interactive "P\nsList newsgroups matching: ")
5775   (gnus-group-prepare-flat (or level gnus-level-subscribed)
5776                            all (or lowest 1) regexp)
5777   (goto-char (point-min))
5778   (gnus-group-position-point))
5779
5780 (defun gnus-group-list-all-matching (level regexp &optional lowest) 
5781   "List all groups that match REGEXP.
5782 If the prefix LEVEL is non-nil, it should be a number that says which
5783 level to cut off listing groups. 
5784 If LOWEST, don't list groups with level lower than LOWEST."
5785   (interactive "P\nsList newsgroups matching: ")
5786   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
5787
5788 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
5789 (defun gnus-group-save-newsrc (&optional force)
5790   "Save the Gnus startup files.
5791 If FORCE, force saving whether it is necessary or not."
5792   (interactive "P")
5793   (gnus-save-newsrc-file force))
5794
5795 (defun gnus-group-restart (&optional arg)
5796   "Force Gnus to read the .newsrc file."
5797   (interactive "P")
5798   (gnus-save-newsrc-file)
5799   (gnus-setup-news 'force)
5800   (gnus-group-list-groups arg))
5801
5802 (defun gnus-group-read-init-file ()
5803   "Read the Gnus elisp init file."
5804   (interactive)
5805   (gnus-read-init-file))
5806
5807 (defun gnus-group-check-bogus-groups (&optional silent)
5808   "Check bogus newsgroups.
5809 If given a prefix, don't ask for confirmation before removing a bogus
5810 group."
5811   (interactive "P")
5812   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
5813   (gnus-group-list-groups))
5814
5815 (defun gnus-group-edit-global-kill (&optional article group)
5816   "Edit the global kill file.
5817 If GROUP, edit that local kill file instead."
5818   (interactive "P")
5819   (setq gnus-current-kill-article article)
5820   (gnus-kill-file-edit-file group)
5821   (gnus-message 
5822    6
5823    (substitute-command-keys
5824     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
5825             (if group "local" "global")))))
5826
5827 (defun gnus-group-edit-local-kill (article group)
5828   "Edit a local kill file."
5829   (interactive (list nil (gnus-group-group-name)))
5830   (gnus-group-edit-global-kill article group))
5831
5832 (defun gnus-group-force-update ()
5833   "Update `.newsrc' file."
5834   (interactive)
5835   (gnus-save-newsrc-file))
5836
5837 (defun gnus-group-suspend ()
5838   "Suspend the current Gnus session.
5839 In fact, cleanup buffers except for group mode buffer.
5840 The hook gnus-suspend-gnus-hook is called before actually suspending."
5841   (interactive)
5842   (run-hooks 'gnus-suspend-gnus-hook)
5843   ;; Kill Gnus buffers except for group mode buffer.
5844   (let ((group-buf (get-buffer gnus-group-buffer)))
5845     ;; Do this on a separate list in case the user does a ^G before we finish
5846     (let ((gnus-buffer-list
5847            (delq group-buf (delq gnus-dribble-buffer
5848                                  (append gnus-buffer-list nil)))))
5849       (while gnus-buffer-list
5850         (gnus-kill-buffer (car gnus-buffer-list))
5851         (setq gnus-buffer-list (cdr gnus-buffer-list))))
5852     (if group-buf
5853         (progn
5854           (setq gnus-buffer-list (list group-buf))
5855           (bury-buffer group-buf)
5856           (delete-windows-on group-buf t)))))
5857
5858 (defun gnus-group-clear-dribble ()
5859   "Clear all information from the dribble buffer."
5860   (interactive)
5861   (gnus-dribble-clear))
5862
5863 (defun gnus-group-exit ()
5864   "Quit reading news after updating .newsrc.eld and .newsrc.
5865 The hook `gnus-exit-gnus-hook' is called before actually exiting."
5866   (interactive)
5867   (if (or noninteractive                ;For gnus-batch-kill
5868           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
5869           (not gnus-interactive-exit)   ;Without confirmation
5870           gnus-expert-user
5871           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
5872       (progn
5873         (run-hooks 'gnus-exit-gnus-hook)
5874         ;; Offer to save data from non-quitted summary buffers.
5875         (gnus-offer-save-summaries)
5876         ;; Save the newsrc file(s).
5877         (gnus-save-newsrc-file)
5878         ;; Kill-em-all.
5879         (gnus-close-backends)
5880         ;; Reset everything.
5881         (gnus-clear-system))))
5882
5883 (defun gnus-close-backends ()
5884   ;; Send a close request to all backends that support such a request. 
5885   (let ((methods gnus-valid-select-methods)
5886         func)
5887     (while methods
5888       (if (fboundp (setq func (intern (concat (car (car methods))
5889                                               "-request-close"))))
5890           (funcall func))
5891       (setq methods (cdr methods)))))
5892
5893 (defun gnus-group-quit ()
5894   "Quit reading news without updating .newsrc.eld or .newsrc.
5895 The hook `gnus-exit-gnus-hook' is called before actually exiting."
5896   (interactive)
5897   (when (or noninteractive              ;For gnus-batch-kill
5898             (zerop (buffer-size))
5899             (not (gnus-server-opened gnus-select-method))
5900             gnus-expert-user
5901             (not gnus-current-startup-file)
5902             (gnus-yes-or-no-p
5903              (format "Quit reading news without saving %s? "
5904                      (file-name-nondirectory gnus-current-startup-file))))
5905     (run-hooks 'gnus-exit-gnus-hook)
5906     (if gnus-use-full-window
5907         (delete-other-windows)
5908       (gnus-remove-some-windows))
5909     (gnus-dribble-save)
5910     (gnus-close-backends)
5911     (gnus-clear-system)))
5912
5913 (defun gnus-offer-save-summaries ()
5914   "Offer to save all active summary buffers."
5915   (save-excursion
5916     (let ((buflist (buffer-list)) 
5917           buffers bufname)
5918       ;; Go through all buffers and find all summaries.
5919       (while buflist
5920         (and (setq bufname (buffer-name (car buflist)))
5921              (string-match "Summary" bufname)
5922              (save-excursion
5923                (set-buffer bufname)
5924                ;; We check that this is, indeed, a summary buffer.
5925                (and (eq major-mode 'gnus-summary-mode)
5926                     ;; Also make sure this isn't bogus.
5927                     gnus-newsgroup-prepared))
5928              (push bufname buffers))
5929         (setq buflist (cdr buflist)))
5930       ;; Go through all these summary buffers and offer to save them.
5931       (when buffers
5932         (map-y-or-n-p 
5933          "Update summary buffer %s? "
5934          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
5935          buffers)))))
5936
5937 (defun gnus-group-describe-briefly ()
5938   "Give a one line description of the group mode commands."
5939   (interactive)
5940   (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select  \\[gnus-group-next-unread-group]:Forward  \\[gnus-group-prev-unread-group]:Backward  \\[gnus-group-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-group-describe-briefly]:This help")))
5941
5942 (defun gnus-group-browse-foreign-server (method)
5943   "Browse a foreign news server.
5944 If called interactively, this function will ask for a select method
5945  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). 
5946 If not, METHOD should be a list where the first element is the method
5947 and the second element is the address."
5948   (interactive
5949    (list (let ((how (completing-read 
5950                      "Which backend: "
5951                      (append gnus-valid-select-methods gnus-server-alist)
5952                      nil t "nntp")))
5953            ;; We either got a backend name or a virtual server name.
5954            ;; If the first, we also need an address.
5955            (if (assoc how gnus-valid-select-methods)
5956                (list (intern how)
5957                      ;; Suggested by mapjph@bath.ac.uk.
5958                      (completing-read 
5959                       "Address: " 
5960                       (mapcar (lambda (server) (list server))
5961                               gnus-secondary-servers)))
5962              ;; We got a server name, so we find the method.
5963              (gnus-server-to-method how)))))
5964   (gnus-browse-foreign-server method))
5965
5966 \f
5967 ;;;
5968 ;;; Browse Server Mode
5969 ;;;
5970
5971 (defvar gnus-browse-mode-hook nil)
5972 (defvar gnus-browse-mode-map nil)
5973 (put 'gnus-browse-mode 'mode-class 'special)
5974
5975 (if gnus-browse-mode-map
5976     nil
5977   (setq gnus-browse-mode-map (make-keymap))
5978   (suppress-keymap gnus-browse-mode-map)
5979   (define-key gnus-browse-mode-map " " 'gnus-browse-read-group)
5980   (define-key gnus-browse-mode-map "=" 'gnus-browse-select-group)
5981   (define-key gnus-browse-mode-map "n" 'gnus-browse-next-group)
5982   (define-key gnus-browse-mode-map "p" 'gnus-browse-prev-group)
5983   (define-key gnus-browse-mode-map "\177" 'gnus-browse-prev-group)
5984   (define-key gnus-browse-mode-map "N" 'gnus-browse-next-group)
5985   (define-key gnus-browse-mode-map "P" 'gnus-browse-prev-group)
5986   (define-key gnus-browse-mode-map "\M-n" 'gnus-browse-next-group)
5987   (define-key gnus-browse-mode-map "\M-p" 'gnus-browse-prev-group)
5988   (define-key gnus-browse-mode-map "\r" 'gnus-browse-select-group)
5989   (define-key gnus-browse-mode-map "u" 'gnus-browse-unsubscribe-current-group)
5990   (define-key gnus-browse-mode-map "l" 'gnus-browse-exit)
5991   (define-key gnus-browse-mode-map "L" 'gnus-browse-exit)
5992   (define-key gnus-browse-mode-map "q" 'gnus-browse-exit)
5993   (define-key gnus-browse-mode-map "Q" 'gnus-browse-exit)
5994   (define-key gnus-browse-mode-map "\C-c\C-c" 'gnus-browse-exit)
5995   (define-key gnus-browse-mode-map "?" 'gnus-browse-describe-briefly)
5996   (define-key gnus-browse-mode-map "\C-c\C-i" 'gnus-info-find-node)
5997   )
5998
5999 (defvar gnus-browse-current-method nil)
6000 (defvar gnus-browse-return-buffer nil)
6001
6002 (defvar gnus-browse-buffer "*Gnus Browse Server*")
6003
6004 (defun gnus-browse-foreign-server (method &optional return-buffer)
6005   "Browse the server METHOD."
6006   (setq gnus-browse-current-method method)
6007   (setq gnus-browse-return-buffer return-buffer)
6008   (let ((gnus-select-method method)
6009         groups group)
6010     (gnus-message 5 "Connecting to %s..." (nth 1 method))
6011     (cond 
6012      ((not (gnus-check-server method))
6013       (gnus-message 
6014        1 "Unable to contact server: %s" (gnus-status-message method))
6015       nil)
6016      ((not (gnus-request-list method))
6017       (gnus-message 
6018        1 "Couldn't request list: %s" (gnus-status-message method))
6019       nil)
6020      (t
6021       (get-buffer-create gnus-browse-buffer)
6022       (gnus-add-current-to-buffer-list)
6023       (and gnus-carpal (gnus-carpal-setup-buffer 'browse))
6024       (gnus-configure-windows 'browse)
6025       (buffer-disable-undo (current-buffer))
6026       (let ((buffer-read-only nil))
6027         (erase-buffer))
6028       (gnus-browse-mode)
6029       (setq mode-line-buffer-identification
6030             (format
6031              "Gnus  Browse Server {%s:%s}" (car method) (car (cdr method))))
6032       (save-excursion
6033         (set-buffer nntp-server-buffer)
6034         (let ((cur (current-buffer)))
6035           (goto-char (point-min))
6036           (or (string= gnus-ignored-newsgroups "")
6037               (delete-matching-lines gnus-ignored-newsgroups))
6038           (while (re-search-forward 
6039                   "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
6040             (goto-char (match-end 1))
6041             (setq groups (cons (cons (match-string 1)
6042                                      (max 0 (- (1+ (read cur)) (read cur))))
6043                                groups)))))
6044       (setq groups (sort groups 
6045                          (lambda (l1 l2)
6046                            (string< (car l1) (car l2)))))
6047       (let ((buffer-read-only nil))
6048         (while groups
6049           (setq group (car groups))
6050           (insert 
6051            (format "K%7d: %s\n" (cdr group) (car group)))
6052           (setq groups (cdr groups))))
6053       (switch-to-buffer (current-buffer))
6054       (goto-char (point-min))
6055       (gnus-group-position-point)
6056       t))))
6057
6058 (defun gnus-browse-mode ()
6059   "Major mode for browsing a foreign server.
6060
6061 All normal editing commands are switched off.
6062
6063 \\<gnus-browse-mode-map>
6064 The only things you can do in this buffer is
6065
6066 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
6067 The group will be inserted into the group buffer upon exit from this
6068 buffer.  
6069
6070 2) `\\[gnus-browse-read-group]' to read a group ephemerally.
6071
6072 3) `\\[gnus-browse-exit]' to return to the group buffer."
6073   (interactive)
6074   (kill-all-local-variables)
6075   (when (and menu-bar-mode
6076              (gnus-visual-p 'browse-menu 'menu))
6077     (gnus-browse-make-menu-bar))
6078   (setq mode-line-modified "-- ")
6079   (make-local-variable 'mode-line-format)
6080   (setq mode-line-format (copy-sequence mode-line-format))
6081   (and (equal (nth 3 mode-line-format) "   ")
6082        (setcar (nthcdr 3 mode-line-format) ""))
6083   (setq major-mode 'gnus-browse-mode)
6084   (setq mode-name "Browse Server")
6085   (setq mode-line-process nil)
6086   (use-local-map gnus-browse-mode-map)
6087   (buffer-disable-undo (current-buffer))
6088   (setq truncate-lines t)
6089   (setq buffer-read-only t)
6090   (run-hooks 'gnus-browse-mode-hook))
6091
6092 (defun gnus-browse-read-group (&optional no-article)
6093   "Enter the group at the current line."
6094   (interactive)
6095   (let ((group (gnus-browse-group-name)))
6096     (or (gnus-group-read-ephemeral-group 
6097          group gnus-browse-current-method nil
6098          (cons (current-buffer) 'browse))
6099         (error "Couldn't enter %s" group))))
6100
6101 (defun gnus-browse-select-group ()
6102   "Select the current group."
6103   (interactive)
6104   (gnus-browse-read-group 'no))
6105
6106 (defun gnus-browse-next-group (n)
6107   "Go to the next group."
6108   (interactive "p")
6109   (prog1
6110       (forward-line n)
6111     (gnus-group-position-point)))
6112
6113 (defun gnus-browse-prev-group (n)
6114   "Go to the next group."
6115   (interactive "p")
6116   (gnus-browse-next-group (- n)))
6117
6118 (defun gnus-browse-unsubscribe-current-group (arg)
6119   "(Un)subscribe to the next ARG groups."
6120   (interactive "p")
6121   (and (eobp)
6122        (error "No group at current line."))
6123   (let ((ward (if (< arg 0) -1 1))
6124         (arg (abs arg)))
6125     (while (and (> arg 0)
6126                 (not (eobp))
6127                 (gnus-browse-unsubscribe-group)
6128                 (zerop (gnus-browse-next-group ward)))
6129       (setq arg (1- arg)))
6130     (gnus-group-position-point)
6131     (if (/= 0 arg) (gnus-message 7 "No more newsgroups"))
6132     arg))
6133
6134 (defun gnus-browse-group-name ()
6135   (save-excursion
6136     (beginning-of-line)
6137     (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
6138       (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method))))
6139   
6140 (defun gnus-browse-unsubscribe-group ()
6141   "Toggle subscription of the current group in the browse buffer."
6142   (let ((sub nil)
6143         (buffer-read-only nil)
6144         group)
6145     (save-excursion
6146       (beginning-of-line)
6147       ;; If this group it killed, then we want to subscribe it.
6148       (if (= (following-char) ?K) (setq sub t))
6149       (setq group (gnus-browse-group-name))
6150       (delete-char 1)
6151       (if sub
6152           (progn
6153             (gnus-group-change-level 
6154              (list t group gnus-level-default-subscribed
6155                    nil nil gnus-browse-current-method) 
6156              gnus-level-default-subscribed gnus-level-killed
6157              (and (car (nth 1 gnus-newsrc-alist))
6158                   (gnus-gethash (car (nth 1 gnus-newsrc-alist))
6159                                 gnus-newsrc-hashtb))
6160              t)
6161             (insert ? ))
6162         (gnus-group-change-level 
6163          group gnus-level-killed gnus-level-default-subscribed)
6164         (insert ?K)))
6165     t))
6166
6167 (defun gnus-browse-exit ()
6168   "Quit browsing and return to the group buffer."
6169   (interactive)
6170   (if (eq major-mode 'gnus-browse-mode)
6171       (kill-buffer (current-buffer)))
6172   (if gnus-browse-return-buffer
6173       (gnus-configure-windows 'server 'force)
6174     (gnus-configure-windows 'group 'force)
6175     (gnus-group-list-groups nil)))
6176
6177 (defun gnus-browse-describe-briefly ()
6178   "Give a one line description of the group mode commands."
6179   (interactive)
6180   (gnus-message 6
6181                 (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")))
6182       
6183 \f
6184 ;;;
6185 ;;; Gnus summary mode
6186 ;;;
6187
6188 (defvar gnus-summary-mode-map nil)
6189 (defvar gnus-summary-mark-map nil)
6190 (defvar gnus-summary-mscore-map nil)
6191 (defvar gnus-summary-article-map nil)
6192 (defvar gnus-summary-thread-map nil)
6193 (defvar gnus-summary-goto-map nil)
6194 (defvar gnus-summary-exit-map nil)
6195 (defvar gnus-summary-interest-map nil)
6196 (defvar gnus-summary-sort-map nil)
6197 (defvar gnus-summary-backend-map nil)
6198 (defvar gnus-summary-save-map nil)
6199 (defvar gnus-summary-wash-map nil)
6200 (defvar gnus-summary-wash-hide-map nil)
6201 (defvar gnus-summary-wash-highlight-map nil)
6202 (defvar gnus-summary-wash-time-map nil)
6203 (defvar gnus-summary-help-map nil)
6204 (defvar gnus-summary-limit-map nil)
6205
6206 (put 'gnus-summary-mode 'mode-class 'special)
6207
6208 (if gnus-summary-mode-map
6209     nil
6210   (setq gnus-summary-mode-map (make-keymap))
6211   (suppress-keymap gnus-summary-mode-map)
6212
6213   ;; Non-orthogonal keys
6214
6215   (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
6216   (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
6217   (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
6218   (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
6219   (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
6220   (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
6221   (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
6222   (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject)
6223   (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject)
6224   (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject)
6225   (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject)
6226   (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
6227   (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article)
6228   (define-key gnus-summary-mode-map 
6229     "\M-s" 'gnus-summary-search-article-forward)
6230   (define-key gnus-summary-mode-map 
6231     "\M-r" 'gnus-summary-search-article-backward)
6232   (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
6233   (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
6234   (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-article)
6235   (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
6236   (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article)
6237   (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward)
6238   (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward)
6239   (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward)
6240   (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
6241   (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
6242   (define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable)
6243   (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward)
6244   (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward)
6245   (define-key gnus-summary-mode-map 
6246     "k" 'gnus-summary-kill-same-subject-and-select)
6247   (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
6248   (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread)
6249   (define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread)
6250   (define-key gnus-summary-mode-map "e" 'gnus-summary-edit-article)
6251   (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable)
6252   (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable)
6253   (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads)
6254   (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread)
6255   (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread)
6256   (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread)
6257   (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread)
6258   (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread)
6259   (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread)
6260   (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
6261   (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
6262   (define-key gnus-summary-mode-map "\C-w" 'gnus-summary-mark-region-as-read)
6263   (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
6264   (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant)
6265   (define-key gnus-summary-mode-map 
6266     "\C-c\M-\C-s" 'gnus-summary-limit-include-expunged)
6267   (define-key gnus-summary-mode-map 
6268     "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
6269   (define-key gnus-summary-mode-map 
6270     "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
6271   (define-key gnus-summary-mode-map 
6272     "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
6273   (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
6274   (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score)
6275   (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
6276   (define-key gnus-summary-mode-map 
6277     "\C-x\C-s" 'gnus-summary-reselect-current-group)
6278   (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group)
6279   (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
6280   (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
6281   (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime)
6282   (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
6283   (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
6284   (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
6285   (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
6286   (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
6287   (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
6288   (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
6289   (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail)
6290   (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
6291   (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill)
6292   (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill)
6293   (define-key gnus-summary-mode-map "V" 'gnus-version)
6294   (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group)
6295   (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
6296   (define-key gnus-summary-mode-map "Q" 'gnus-summary-exit-no-update)
6297   (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
6298   (define-key gnus-summary-mode-map gnus-mouse-2 'gnus-mouse-pick-article)
6299   (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
6300   (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
6301   (define-key gnus-summary-mode-map "x" 'gnus-summary-limit-to-unread)
6302   (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
6303   (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
6304   (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
6305 ;  (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
6306   (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
6307   (define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu-view)
6308   (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-enter-digest-group)
6309   (define-key gnus-summary-mode-map "v" 'gnus-summary-verbose-headers)
6310   (define-key gnus-summary-mode-map "\C-c\C-b" 'gnus-bug)
6311
6312
6313   ;; Sort of orthogonal keymap
6314   (define-prefix-command 'gnus-summary-mark-map)
6315   (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map)
6316   (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward)
6317   (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward)
6318   (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward)
6319   (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward)
6320   (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward)
6321   (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward)
6322   (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable)
6323   (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable)
6324   (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant)
6325   (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark)
6326   (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark)
6327   (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable)
6328   (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable)
6329   (define-key gnus-summary-mark-map "S" 'gnus-summary-limit-include-expunged)
6330   (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup)
6331   (define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here)
6332   (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all)
6333   (define-key gnus-summary-mark-map 
6334     "k" 'gnus-summary-kill-same-subject-and-select)
6335   (define-key gnus-summary-mark-map "K" 'gnus-summary-kill-same-subject)
6336
6337   (define-prefix-command 'gnus-summary-mscore-map)
6338   (define-key gnus-summary-mark-map "V" 'gnus-summary-mscore-map)
6339   (define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above)
6340   (define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above)
6341   (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above)
6342   (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below)
6343
6344   (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map)
6345   
6346   (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
6347
6348   (define-prefix-command 'gnus-summary-limit-map)
6349   (define-key gnus-summary-mode-map "/" 'gnus-summary-limit-map)
6350   (define-key gnus-summary-limit-map "/" 'gnus-summary-limit-to-subject)
6351   (define-key gnus-summary-limit-map "n" 'gnus-summary-limit-to-articles)
6352   (define-key gnus-summary-limit-map "w" 'gnus-summary-pop-limit)
6353   (define-key gnus-summary-limit-map "s" 'gnus-summary-limit-to-subject)
6354   (define-key gnus-summary-limit-map "u" 'gnus-summary-limit-to-unread)
6355   (define-key gnus-summary-limit-map "m" 'gnus-summary-limit-to-marks)
6356   (define-key gnus-summary-limit-map "v" 'gnus-summary-limit-to-score)
6357   (define-key gnus-summary-limit-map "D" 'gnus-summary-limit-include-dormant)
6358   (define-key gnus-summary-limit-map "d" 'gnus-summary-limit-exclude-dormant)
6359   (define-key gnus-summary-mark-map "E" 'gnus-summary-limit-include-expunged)
6360   (define-key gnus-summary-limit-map "c" 
6361     'gnus-summary-limit-exclude-childless-dormant)
6362
6363   (define-prefix-command 'gnus-summary-goto-map)
6364   (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map)
6365   (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article)
6366   (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article)
6367   (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article)
6368   (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article)
6369   (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject)
6370   (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject)
6371   (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject)
6372   (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject)
6373   (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article)
6374   (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article)
6375   (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject)
6376   (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article)
6377   (define-key gnus-summary-goto-map "p" 'gnus-summary-pop-article)
6378
6379
6380   (define-prefix-command 'gnus-summary-thread-map)
6381   (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map)
6382   (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread)
6383   (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread)
6384   (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread)
6385   (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads)
6386   (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread)
6387   (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads)
6388   (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread)
6389   (define-key gnus-summary-thread-map "H" 'gnus-summary-hide-all-threads)
6390   (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread)
6391   (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread)
6392   (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread)
6393   (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread)
6394   (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread)
6395   (define-key gnus-summary-thread-map "\M-#" 'gnus-uu-unmark-thread)
6396
6397   
6398   (define-prefix-command 'gnus-summary-exit-map)
6399   (define-key gnus-summary-mode-map "Z" 'gnus-summary-exit-map)
6400   (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit)
6401   (define-key gnus-summary-exit-map "C" 'gnus-summary-catchup-all-and-exit)
6402   (define-key gnus-summary-exit-map "E" 'gnus-summary-exit-no-update)
6403   (define-key gnus-summary-exit-map "Q" 'gnus-summary-exit)
6404   (define-key gnus-summary-exit-map "Z" 'gnus-summary-exit)
6405   (define-key gnus-summary-exit-map 
6406     "n" 'gnus-summary-catchup-and-goto-next-group)
6407   (define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group)
6408   (define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group)
6409   (define-key gnus-summary-exit-map "N" 'gnus-summary-next-group)
6410   (define-key gnus-summary-exit-map "P" 'gnus-summary-prev-group)
6411
6412
6413   (define-prefix-command 'gnus-summary-article-map)
6414   (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map)
6415   (define-key gnus-summary-article-map " " 'gnus-summary-next-page)
6416   (define-key gnus-summary-article-map "n" 'gnus-summary-next-page)
6417   (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page)
6418   (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page)
6419   (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up)
6420   (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article)
6421   (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article)
6422   (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article)
6423   (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article)
6424   (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article)
6425   (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article)
6426   (define-key gnus-summary-article-map "R" 'gnus-summary-refer-references)
6427   (define-key gnus-summary-article-map "g" 'gnus-summary-show-article)
6428   (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article)
6429
6430
6431
6432   (define-prefix-command 'gnus-summary-wash-map)
6433   (define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map)
6434
6435   (define-prefix-command 'gnus-summary-wash-hide-map)
6436   (define-key gnus-summary-wash-map "W" 'gnus-summary-wash-hide-map)
6437   (define-key gnus-summary-wash-hide-map "a" 'gnus-article-hide)
6438   (define-key gnus-summary-wash-hide-map "h" 'gnus-article-hide-headers)
6439   (define-key gnus-summary-wash-hide-map "s" 'gnus-article-hide-signature)
6440   (define-key gnus-summary-wash-hide-map "c" 'gnus-article-hide-citation)
6441   (define-key gnus-summary-wash-hide-map "p" 'gnus-article-hide-pgp)
6442   (define-key gnus-summary-wash-hide-map 
6443     "\C-c" 'gnus-article-hide-citation-maybe)
6444
6445   (define-prefix-command 'gnus-summary-wash-highlight-map)
6446   (define-key gnus-summary-wash-map "H" 'gnus-summary-wash-highlight-map)
6447   (define-key gnus-summary-wash-highlight-map "a" 'gnus-article-highlight)
6448   (define-key gnus-summary-wash-highlight-map 
6449     "h" 'gnus-article-highlight-headers)
6450   (define-key gnus-summary-wash-highlight-map
6451     "c" 'gnus-article-highlight-citation)
6452   (define-key gnus-summary-wash-highlight-map
6453     "s" 'gnus-article-highlight-signature)
6454
6455   (define-prefix-command 'gnus-summary-wash-time-map)
6456   (define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map)
6457   (define-key gnus-summary-wash-time-map "z" 'gnus-article-date-ut)
6458   (define-key gnus-summary-wash-time-map "u" 'gnus-article-date-ut)
6459   (define-key gnus-summary-wash-time-map "l" 'gnus-article-date-local)
6460   (define-key gnus-summary-wash-time-map "e" 'gnus-article-date-lapsed)
6461   (define-key gnus-summary-wash-time-map "o" 'gnus-article-date-original)
6462
6463   (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons)
6464   (define-key gnus-summary-wash-map "B" 'gnus-article-add-buttons-to-head)
6465   (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike)
6466   (define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap)
6467   (define-key gnus-summary-wash-map "c" 'gnus-article-remove-cr)
6468   (define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable)
6469   (define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face)
6470   (define-key gnus-summary-wash-map "l" 'gnus-summary-stop-page-breaking)
6471   (define-key gnus-summary-wash-map "r" 'gnus-summary-caesar-message)
6472   (define-key gnus-summary-wash-map "t" 'gnus-summary-toggle-header)
6473   (define-key gnus-summary-wash-map "m" 'gnus-summary-toggle-mime)
6474
6475
6476   (define-prefix-command 'gnus-summary-help-map)
6477   (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map)
6478   (define-key gnus-summary-help-map "v" 'gnus-version)
6479   (define-key gnus-summary-help-map "f" 'gnus-summary-fetch-faq)
6480   (define-key gnus-summary-help-map "d" 'gnus-summary-describe-group)
6481   (define-key gnus-summary-help-map "h" 'gnus-summary-describe-briefly)
6482   (define-key gnus-summary-help-map "i" 'gnus-info-find-node)
6483
6484
6485   (define-prefix-command 'gnus-summary-backend-map)
6486   (define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map)
6487   (define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles)
6488   (define-key gnus-summary-backend-map "\M-\C-e" 
6489     'gnus-summary-expire-articles-now)
6490   (define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article)
6491   (define-key gnus-summary-backend-map "m" 'gnus-summary-move-article)
6492   (define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article)
6493   (define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article)
6494   (define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article)
6495   (define-key gnus-summary-backend-map "q" 'gnus-summary-respool-query)
6496   (define-key gnus-summary-backend-map "i" 'gnus-summary-import-article)
6497
6498
6499   (define-prefix-command 'gnus-summary-save-map)
6500   (define-key gnus-summary-mode-map "O" 'gnus-summary-save-map)
6501   (define-key gnus-summary-save-map "o" 'gnus-summary-save-article)
6502   (define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail)
6503   (define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail)
6504   (define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file)
6505   (define-key gnus-summary-save-map "b" 'gnus-summary-save-article-body-file)
6506   (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder)
6507   (define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm)
6508   (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output)
6509   (define-key gnus-summary-save-map "s" 'gnus-soup-add-article)
6510
6511   (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map)
6512
6513   (define-key gnus-summary-mode-map "\M-&" 'gnus-summary-universal-argument)
6514   (define-key gnus-summary-article-map "D" 'gnus-summary-enter-digest-group)
6515
6516   (define-key gnus-summary-mode-map "V" 'gnus-summary-score-map)
6517
6518   (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-score)
6519   (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-score)
6520   )
6521
6522
6523 \f
6524
6525 (defun gnus-summary-mode (&optional group)
6526   "Major mode for reading articles.
6527
6528 All normal editing commands are switched off.
6529 \\<gnus-summary-mode-map>
6530 Each line in this buffer represents one article.  To read an
6531 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
6532 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', 
6533 respectively.
6534
6535 You can also post articles and send mail from this buffer.  To 
6536 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author 
6537 of an article, type `\\[gnus-summary-reply]'.
6538
6539 There are approx. one gazillion commands you can execute in this 
6540 buffer; read the info pages for more information (`\\[gnus-info-find-node]'). 
6541
6542 The following commands are available:
6543
6544 \\{gnus-summary-mode-map}"
6545   (interactive)
6546   (when (and menu-bar-mode
6547              (gnus-visual-p 'summary-menu 'menu))
6548     (gnus-summary-make-menu-bar))
6549   (kill-all-local-variables)
6550   (let ((locals gnus-summary-local-variables))
6551     (while locals
6552       (if (consp (car locals))
6553           (progn
6554             (make-local-variable (car (car locals)))
6555             (set (car (car locals)) (eval (cdr (car locals)))))
6556         (make-local-variable (car locals))
6557         (set (car locals) nil))
6558       (setq locals (cdr locals))))
6559   (gnus-make-thread-indent-array)
6560   (setq mode-line-modified "-- ")
6561   (make-local-variable 'mode-line-format)
6562   (setq mode-line-format (copy-sequence mode-line-format))
6563   (and (equal (nth 3 mode-line-format) "   ")
6564        (setcar (nthcdr 3 mode-line-format) ""))
6565   (setq major-mode 'gnus-summary-mode)
6566   (setq mode-name "Summary")
6567   (make-local-variable 'minor-mode-alist)
6568   (use-local-map gnus-summary-mode-map)
6569   (buffer-disable-undo (current-buffer))
6570   (setq buffer-read-only t)             ;Disable modification
6571   (setq truncate-lines t)
6572   (setq selective-display t)
6573   (setq selective-display-ellipses t)   ;Display `...'
6574   (setq buffer-display-table gnus-summary-display-table)
6575   (setq gnus-newsgroup-name group)
6576   (run-hooks 'gnus-summary-mode-hook))
6577
6578 (defun gnus-summary-make-display-table ()
6579   ;; Change the display table.  Odd characters have a tendency to mess
6580   ;; up nicely formatted displays - we make all possible glyphs
6581   ;; display only a single character.
6582
6583   ;; We start from the standard display table, if any.
6584   (setq gnus-summary-display-table 
6585         (or (copy-sequence standard-display-table)
6586             (make-display-table)))
6587   ;; Nix out all the control chars...
6588   (let ((i 32))
6589     (while (>= (setq i (1- i)) 0)
6590       (aset gnus-summary-display-table i [??])))
6591   ;; ... but not newline and cr, of course. (cr is necessary for the
6592   ;; selective display).  
6593   (aset gnus-summary-display-table ?\n nil)
6594   (aset gnus-summary-display-table ?\r nil)
6595   ;; We nix out any glyphs over 126 that are not set already.  
6596   (let ((i 256))
6597     (while (>= (setq i (1- i)) 127)
6598       ;; Only modify if the entry is nil.
6599       (or (aref gnus-summary-display-table i) 
6600           (aset gnus-summary-display-table i [??])))))
6601
6602 (defun gnus-summary-clear-local-variables ()
6603   (let ((locals gnus-summary-local-variables))
6604     (while locals
6605       (if (consp (car locals))
6606           (and (vectorp (car (car locals)))
6607                (set (car (car locals)) nil))
6608         (and (vectorp (car locals))
6609              (set (car locals) nil)))
6610       (setq locals (cdr locals)))))
6611
6612 ;; Summary data functions.
6613
6614 (defmacro gnus-data-number (data)
6615   `(car ,data))
6616
6617 (defmacro gnus-data-mark (data)
6618   `(nth 1 ,data))
6619
6620 (defmacro gnus-data-set-mark (data mark)
6621   `(setcar (nthcdr 1 ,data) ,mark))
6622
6623 (defmacro gnus-data-pos (data)
6624   `(nth 2 ,data))
6625
6626 (defmacro gnus-data-set-pos (data pos)
6627   `(setcar (nthcdr 2 ,data) ,pos))
6628
6629 (defmacro gnus-data-header (data)
6630   `(nth 3 ,data))
6631
6632 (defmacro gnus-data-level (data)
6633   `(nth 4 ,data))
6634
6635 (defmacro gnus-data-unread-p (data)
6636   `(= (nth 1 ,data) gnus-unread-mark))
6637
6638 (defmacro gnus-data-pseudo-p (data)
6639   `(consp (nth 3 ,data)))
6640
6641 (defmacro gnus-data-find (number)
6642   `(assq ,number gnus-newsgroup-data))
6643
6644 (defmacro gnus-data-find-list (number &optional data)
6645   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
6646      (memq (assq ,number bdata)
6647            bdata)))
6648
6649 (defmacro gnus-data-make (number mark pos header level)
6650   `(list ,number ,mark ,pos ,header ,level))
6651
6652 (defun gnus-data-enter (after-article number mark pos header level offset)
6653   (let ((data (gnus-data-find-list after-article)))
6654     (or data (error "No such article: %d" after-article))
6655     (setcdr data (cons (gnus-data-make number mark pos header level)
6656                        (cdr data)))
6657     (setq gnus-newsgroup-data-reverse nil)
6658     (gnus-data-update-list (cdr (cdr data)) offset)))
6659
6660 (defun gnus-data-enter-list (after-article list &optional offset)
6661   (when list
6662     (let ((data (and after-article (gnus-data-find-list after-article)))
6663           (ilist list))
6664       (or data (not after-article) (error "No such article: %d" after-article))
6665       ;; Find the last element in the list to be spliced into the main
6666       ;; list.  
6667       (while (cdr list)
6668         (setq list (cdr list)))
6669       (if (not data)
6670           (progn
6671             (setcdr list gnus-newsgroup-data)
6672             (setq gnus-newsgroup-data ilist)
6673             (and offset (gnus-data-update-list (cdr list) offset)))
6674         (setcdr list (cdr data))
6675         (setcdr data ilist)
6676         (and offset (gnus-data-update-list (cdr data) offset)))
6677       (setq gnus-newsgroup-data-reverse nil))))
6678
6679 (defun gnus-data-remove (article &optional offset)
6680   (let ((data gnus-newsgroup-data))
6681     (if (= (gnus-data-number (car data)) article)
6682         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
6683               gnus-newsgroup-data-reverse nil)
6684       (while (cdr data)
6685         (and (= (gnus-data-number (car (cdr data))) article)
6686              (progn
6687                (setcdr data (cdr (cdr data)))
6688                (and offset (gnus-data-update-list (cdr data) offset))
6689                (setq data nil
6690                      gnus-newsgroup-data-reverse nil)))
6691         (setq data (cdr data))))))
6692
6693 (defmacro gnus-data-list (backward)
6694   `(if ,backward
6695        (or gnus-newsgroup-data-reverse
6696            (setq gnus-newsgroup-data-reverse
6697                  (reverse gnus-newsgroup-data)))
6698      gnus-newsgroup-data))
6699
6700 (defun gnus-data-update-list (data offset)
6701   "Add OFFSET to the POS of all data entries in DATA."
6702   (while data
6703     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
6704     (setq data (cdr data))))
6705
6706 (defun gnus-data-compute-positions ()
6707   "Compute the positions of all articles."
6708   (let ((data gnus-newsgroup-data)
6709         pos)
6710     (while data
6711       (when (setq pos (text-property-any 
6712                        (point-min) (point-max)
6713                        'gnus-number (gnus-data-number (car data))))
6714         (gnus-data-set-pos (car data) (+ pos 3)))
6715       (setq data (cdr data)))))
6716
6717 (defun gnus-summary-article-pseudo-p (article)
6718   "Say whether this article is a pseudo article or not."
6719   (not (vectorp (gnus-data-header (gnus-data-find article)))))
6720
6721 (defun gnus-article-parent-p (number)
6722   "Say whether this article is a parent or not."
6723   (let* ((data (gnus-data-find-list number)))
6724     (and (cdr data)                     ; There has to be an article after...
6725          (< (gnus-data-level (car data)) ; And it has to have a higher level.
6726             (gnus-data-level (nth 1 data))))))
6727     
6728 (defmacro gnus-summary-skip-intangible ()
6729   "If the current article is intangible, then jump to a different article."
6730   '(let ((to (get-text-property (point) 'gnus-intangible)))
6731     (when to
6732       (gnus-summary-goto-subject to))))
6733
6734 (defmacro gnus-summary-article-intangible-p ()
6735   "Say whether this article is intangible or not."
6736   '(get-text-property (point) 'gnus-intangible))
6737
6738 ;; Some summary mode macros.
6739
6740 (defmacro gnus-summary-article-number ()
6741   "The article number of the article on the current line.
6742 If there isn's an article number here, then we return the current
6743 article number."
6744   '(progn
6745      (gnus-summary-skip-intangible)
6746      (or (get-text-property (point) 'gnus-number) 
6747          (progn
6748            (forward-line -1)
6749            gnus-newsgroup-end))))
6750
6751 (defmacro gnus-summary-article-header (&optional number)
6752   `(gnus-data-header (gnus-data-find
6753                       ,(or number '(gnus-summary-article-number)))))
6754
6755 (defmacro gnus-summary-thread-level (&optional number)
6756   `(gnus-data-level (gnus-data-find
6757                      ,(or number '(gnus-summary-article-number)))))
6758
6759 (defmacro gnus-summary-article-mark (&optional number)
6760   `(gnus-data-mark (gnus-data-find
6761                     ,(or number '(gnus-summary-article-number)))))
6762
6763 (defmacro gnus-summary-article-pos (&optional number)
6764   `(gnus-data-pos (gnus-data-find
6765                    ,(or number '(gnus-summary-article-number)))))
6766
6767 (defmacro gnus-summary-article-subject (&optional number)
6768   "Return current subject string or nil if nothing."
6769   `(let ((headers 
6770           ,(if number
6771                `(gnus-data-header (assq ,number gnus-newsgroup-data))
6772              '(gnus-data-header (assq (gnus-summary-article-number)
6773                                       gnus-newsgroup-data)))))
6774      (and headers
6775           (vectorp headers)
6776           (mail-header-subject headers))))
6777
6778 (defmacro gnus-summary-article-score (&optional number)
6779   "Return current article score."
6780   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
6781                   gnus-newsgroup-scored))
6782        gnus-summary-default-score 0))
6783
6784 (defun gnus-summary-article-children (&optional number)
6785   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
6786          (level (gnus-data-level (car data)))
6787          l children)
6788     (while (and (setq data (cdr data))
6789                 (> (setq l (gnus-data-level (car data))) level))
6790       (and (= (1+ level) l)
6791            (setq children (cons (gnus-data-number (car data))
6792                                 children))))
6793     (nreverse children)))
6794
6795 (defun gnus-summary-article-parent (&optional number)
6796   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
6797                                     (gnus-data-list t)))
6798          (level (gnus-data-level (car data)))
6799          l)
6800     (if (zerop level)
6801         () ; This is a root.
6802       ;; We search until we find an article with a level less than
6803       ;; this one.  That function has to be the parent.
6804       (while (and (setq data (cdr data))
6805                   (not (< (gnus-data-level (car data)) level))))
6806       (and data (gnus-data-number (car data))))))
6807
6808
6809 ;; Various summary mode internalish functions.
6810
6811 (defun gnus-mouse-pick-article (e)
6812   (interactive "e")
6813   (mouse-set-point e)
6814   (gnus-summary-next-page nil t))
6815
6816 (defun gnus-summary-setup-buffer (group)
6817   "Initialize summary buffer."
6818   (let ((buffer (concat "*Summary " group "*")))
6819     (if (get-buffer buffer)
6820         (progn
6821           (set-buffer buffer)
6822           (not gnus-newsgroup-prepared))
6823       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
6824       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
6825       (gnus-add-current-to-buffer-list)
6826       (gnus-summary-mode group)
6827       (and gnus-carpal (gnus-carpal-setup-buffer 'summary))
6828       (setq gnus-newsgroup-name group)
6829       t)))
6830
6831 (defun gnus-set-global-variables ()
6832   ;; Set the global equivalents of the summary buffer-local variables
6833   ;; to the latest values they had.  These reflect the summary buffer
6834   ;; that was in action when the last article was fetched.
6835   (if (eq major-mode 'gnus-summary-mode) 
6836       (progn
6837         (setq gnus-summary-buffer (current-buffer))
6838         (let ((name gnus-newsgroup-name)
6839               (marked gnus-newsgroup-marked)
6840               (unread gnus-newsgroup-unreads)
6841               (headers gnus-current-headers)
6842               (data gnus-newsgroup-data)
6843               (score-file gnus-current-score-file))
6844           (save-excursion
6845             (set-buffer gnus-group-buffer)
6846             (setq gnus-newsgroup-name name)
6847             (setq gnus-newsgroup-marked marked)
6848             (setq gnus-newsgroup-unreads unread)
6849             (setq gnus-current-headers headers)
6850             (setq gnus-newsgroup-data data)
6851             (setq gnus-current-score-file score-file))))))
6852
6853 (defun gnus-summary-last-article-p (&optional article)
6854   "Return whether ARTICLE is the last article in the buffer."
6855   (if (not (setq article (or article (gnus-summary-article-number))))
6856       t ; All non-existant numbers are the last article. :-)
6857     (cdr (gnus-data-find-list article))))
6858     
6859 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
6860   "Insert a dummy root in the summary buffer."
6861   (beginning-of-line)
6862   (add-text-properties
6863    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
6864    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
6865
6866 (defvar gnus-thread-indent-array nil)
6867 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
6868 (defun gnus-make-thread-indent-array ()
6869   (let ((n 200))
6870     (if (and gnus-thread-indent-array
6871              (= gnus-thread-indent-level gnus-thread-indent-array-level))
6872         nil
6873       (setq gnus-thread-indent-array (make-vector 201 "")
6874             gnus-thread-indent-array-level gnus-thread-indent-level)
6875       (while (>= n 0)
6876         (aset gnus-thread-indent-array n
6877               (make-string (* n gnus-thread-indent-level) ? ))
6878         (setq n (1- n))))))
6879
6880 (defun gnus-summary-insert-line 
6881   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread 
6882                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
6883                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
6884   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
6885          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
6886          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
6887          (gnus-tmp-score-char
6888           (if (or (null gnus-summary-default-score)
6889                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
6890                       gnus-summary-zcore-fuzz)) ? 
6891             (if (< gnus-tmp-score gnus-summary-default-score)
6892                 gnus-score-below-mark gnus-score-over-mark)))
6893          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
6894                                  (gnus-tmp-replied gnus-replied-mark)
6895                                  (t gnus-unread-mark)))
6896          (gnus-tmp-from (mail-header-from gnus-tmp-header))
6897          (gnus-tmp-name 
6898           (cond 
6899            ((string-match "(.+)" gnus-tmp-from)
6900             (substring gnus-tmp-from 
6901                        (1+ (match-beginning 0)) (1- (match-end 0))))
6902            ((string-match "<[^>]+> *$" gnus-tmp-from)
6903             (let ((beg (match-beginning 0)))
6904               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
6905                        (substring gnus-tmp-from (1+ (match-beginning 0))
6906                                   (1- (match-end 0))))
6907                   (substring gnus-tmp-from 0 beg))))
6908            (t gnus-tmp-from)))
6909          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
6910          (gnus-tmp-number (mail-header-number gnus-tmp-header))
6911          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
6912          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
6913          (buffer-read-only nil))
6914     (when (string= gnus-tmp-name "")
6915       (setq gnus-tmp-name gnus-tmp-from))
6916     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
6917     (put-text-property
6918      (point)
6919      (progn (eval gnus-summary-line-format-spec) (point))
6920      'gnus-number gnus-tmp-number)
6921     (when (gnus-visual-p 'summary-highlight 'highlight)
6922       (forward-line -1)
6923       (run-hooks 'gnus-summary-update-hook)
6924       (forward-line 1))))
6925
6926 (defun gnus-summary-update-line (&optional dont-update)
6927   ;; Update summary line after change.
6928   (when (and gnus-summary-default-score
6929              (not gnus-summary-inhibit-highlight))
6930     (let ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
6931           (article (gnus-summary-article-number)))
6932       (unless dont-update
6933         (if (and gnus-summary-mark-below
6934                  (< (gnus-summary-article-score)
6935                     gnus-summary-mark-below))
6936             ;; This article has a low score, so we mark it as read.
6937             (when (memq article gnus-newsgroup-unreads)
6938               (gnus-summary-mark-article-as-read gnus-low-score-mark))
6939           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
6940             ;; This article was previously marked as read on account
6941             ;; of a low score, but now it has risen, so we mark it as
6942             ;; unread. 
6943             (gnus-summary-mark-article-as-unread gnus-unread-mark))))
6944       ;; Do visual highlighting.
6945       (when (gnus-visual-p 'summary-highlight 'highlight)
6946         (run-hooks 'gnus-summary-update-hook)))))
6947
6948 (defvar gnus-tmp-new-adopts)
6949
6950 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
6951   ;; Sum up all elements (and sub-elements) in a list.
6952   (let* ((number
6953           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
6954           (cond ((and (consp thread) (cdr thread))
6955                  (apply
6956                   '+ 1 (mapcar
6957                         'gnus-summary-number-of-articles-in-thread 
6958                         (cdr thread))))
6959                 ((null thread)
6960                  1)
6961                 ((and level (zerop level) gnus-tmp-new-adopts)
6962                  (apply '+ 1 (mapcar 
6963                               'gnus-summary-number-of-articles-in-thread 
6964                               gnus-tmp-new-adopts)))
6965                 ((memq (mail-header-number (car thread))
6966                        gnus-newsgroup-limit)
6967                  1) 
6968                 (t 0))))
6969     (if char 
6970         (if (> number 1) gnus-not-empty-thread-mark
6971           gnus-empty-thread-mark)
6972       number)))
6973
6974 (defun gnus-summary-set-local-parameters (group)
6975  "Go through the local params of GROUP and set all variable specs in that list."
6976   (let ((params (gnus-info-params (gnus-get-info group)))
6977         elem)
6978     (while params
6979       (setq elem (car params)
6980             params (cdr params))
6981       (and (consp elem)                 ; Has to be a cons.
6982            (consp (cdr elem))           ; The cdr has to be a list.
6983            (symbolp (car elem))         ; Has to be a symbol in there.
6984            (progn                       ; So we set it.
6985              (make-local-variable (car elem))
6986              (set (car elem) (eval (nth 1 elem))))))))
6987
6988 (defun gnus-summary-read-group 
6989   (group &optional show-all no-article kill-buffer no-display)
6990   "Start reading news in newsgroup GROUP.
6991 If SHOW-ALL is non-nil, already read articles are also listed.
6992 If NO-ARTICLE is non-nil, no article is selected initially.
6993 If NO-DISPLAY, don't generate a summary buffer."
6994   (gnus-message 5 "Retrieving newsgroup: %s..." group)
6995   (let* ((new-group (gnus-summary-setup-buffer group))
6996          (quit-config (gnus-group-quit-config group))
6997          (did-select (and new-group (gnus-select-newsgroup group show-all))))
6998     (cond 
6999      ;; This summary buffer exists already, so we just select it. 
7000      ((not new-group)
7001       (gnus-set-global-variables)
7002       (gnus-kill-buffer kill-buffer)
7003       (gnus-configure-windows 'summary 'force)
7004       (gnus-set-mode-line 'summary)
7005       (gnus-summary-position-point)
7006       (message "")
7007       t)
7008      ;; We couldn't select this group.
7009      ((null did-select) 
7010       (when (and (eq major-mode 'gnus-summary-mode)
7011                  (not (equal (current-buffer) kill-buffer)))
7012         (kill-buffer (current-buffer))
7013         (if (not quit-config)
7014             (progn
7015               (set-buffer gnus-group-buffer)
7016               (gnus-group-jump-to-group group)
7017               (gnus-group-next-unread-group 1))
7018           (if (not (buffer-name (car quit-config)))
7019               (gnus-configure-windows 'group 'force)
7020             (set-buffer (car quit-config))
7021             (and (eq major-mode 'gnus-summary-mode)
7022                  (gnus-set-global-variables))
7023             (gnus-configure-windows (cdr quit-config)))))
7024       (message "Can't select group")
7025       nil)
7026      ;; The user did a `C-g' while prompting for number of articles,
7027      ;; so we exit this group.
7028      ((eq did-select 'quit)
7029       (and (eq major-mode 'gnus-summary-mode)
7030            (not (equal (current-buffer) kill-buffer))
7031            (kill-buffer (current-buffer)))
7032       (gnus-kill-buffer kill-buffer)
7033       (if (not quit-config)
7034           (progn
7035             (set-buffer gnus-group-buffer)
7036             (gnus-group-jump-to-group group)
7037             (gnus-group-next-unread-group 1)
7038             (gnus-configure-windows 'group 'force))
7039         (if (not (buffer-name (car quit-config)))
7040             (gnus-configure-windows 'group 'force)
7041           (set-buffer (car quit-config))
7042           (and (eq major-mode 'gnus-summary-mode)
7043                (gnus-set-global-variables))
7044           (gnus-configure-windows (cdr quit-config))))
7045       ;; Finallt signal the quit.
7046       (signal 'quit nil))
7047      ;; The group was successfully selected.
7048      (t
7049       (gnus-set-global-variables)
7050       ;; Save the active value in effect when the group was entered.
7051       (setq gnus-newsgroup-active 
7052             (gnus-copy-sequence
7053              (gnus-active gnus-newsgroup-name)))
7054       ;; You can change the summary buffer in some way with this hook.
7055       (run-hooks 'gnus-select-group-hook)
7056       ;; Set any local variables in the group parameters.
7057       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7058       ;; Do score processing.
7059       (when gnus-use-scoring
7060         (gnus-possibly-score-headers))
7061       (gnus-update-format-specifications)
7062       ;; Find the initial limit.
7063       (gnus-summary-initial-limit)
7064       ;; Generate the summary buffer.
7065       (unless no-display
7066         (gnus-summary-prepare))
7067       ;; If the summary buffer is empty, but there are some low-scored
7068       ;; articles or some excluded dormants, we include these in the
7069       ;; buffer. 
7070       (when (zerop (buffer-size))
7071         (cond (gnus-newsgroup-dormant
7072                (gnus-summary-limit-include-dormant))
7073               ((and gnus-newsgroup-scored show-all)
7074                (gnus-summary-limit-include-expunged))))
7075       ;; Function `gnus-apply-kill-file' must be called in this hook.
7076       (run-hooks 'gnus-apply-kill-hook)
7077       (if (zerop (buffer-size))
7078           (progn
7079             ;; This newsgroup is empty.
7080             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7081             (gnus-message 6 "No unread news")
7082             (gnus-kill-buffer kill-buffer)
7083             ;; Return nil from this function.
7084             nil)
7085         ;; Hide conversation thread subtrees.  We cannot do this in
7086         ;; gnus-summary-prepare-hook since kill processing may not
7087         ;; work with hidden articles.
7088         (and gnus-show-threads
7089              gnus-thread-hide-subtree
7090              (gnus-summary-hide-all-threads))
7091         ;; Show first unread article if requested.
7092         (if (and (not no-article)
7093                  gnus-newsgroup-unreads
7094                  gnus-auto-select-first)
7095             (progn
7096               (if (eq gnus-auto-select-first 'best)
7097                   (gnus-summary-best-unread-article)
7098                 (gnus-summary-first-unread-article)))
7099           ;; Don't select any articles, just move point to the first
7100           ;; article in the group.
7101           (goto-char (point-min))
7102           (gnus-summary-position-point)
7103           (gnus-set-mode-line 'summary)
7104           (gnus-configure-windows 'summary 'force))
7105         ;; If we are in async mode, we send some info to the backend.
7106         (when gnus-newsgroup-async
7107           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7108         (gnus-kill-buffer kill-buffer)
7109         (when (get-buffer-window gnus-group-buffer)
7110           ;; Gotta use windows, because recenter does wierd stuff if
7111           ;; the current buffer ain't the displayed window.
7112           (let ((owin (selected-window))) 
7113             (select-window (get-buffer-window gnus-group-buffer))
7114             (when (gnus-group-goto-group group)
7115               (recenter))
7116             (select-window owin))))
7117       ;; Mark this buffer as "prepared".
7118       (setq gnus-newsgroup-prepared t)
7119       t))))
7120
7121 (defun gnus-summary-prepare ()
7122   "Generate the summary buffer."
7123   (let ((buffer-read-only nil))
7124     (erase-buffer)
7125     (setq gnus-newsgroup-data nil
7126           gnus-newsgroup-data-reverse nil)
7127     (run-hooks 'gnus-summary-generate-hook)
7128     ;; Generate the buffer, either with threads or without.
7129     (gnus-summary-prepare-threads 
7130      (if gnus-show-threads
7131          (gnus-gather-threads (gnus-sort-threads (gnus-make-threads)))
7132        gnus-newsgroup-headers))
7133     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7134     ;; Call hooks for modifying summary buffer.
7135     (goto-char (point-min))
7136     (run-hooks 'gnus-summary-prepare-hook)))
7137
7138 (defun gnus-gather-threads (threads)
7139   "Gather threads that have lost their roots."
7140   (if (not gnus-summary-make-false-root)
7141       threads 
7142     (let ((hashtb (gnus-make-hashtable 1023))
7143           (prev threads)
7144           (result threads)
7145           subject hthread whole-subject)
7146       (while threads
7147         (setq whole-subject 
7148               (setq subject (mail-header-subject (car (car threads)))))
7149         (if (and gnus-summary-gather-exclude-subject
7150                  (string-match gnus-summary-gather-exclude-subject
7151                                subject))
7152             () ; We don't want to do anything with this.
7153           (if gnus-summary-gather-subject-limit
7154               (or (and (numberp gnus-summary-gather-subject-limit)
7155                        (> (length subject) gnus-summary-gather-subject-limit)
7156                        (setq subject
7157                              (substring subject 0 
7158                                         gnus-summary-gather-subject-limit)))
7159                   (and (eq 'fuzzy gnus-summary-gather-subject-limit)
7160                        (setq subject (gnus-simplify-subject-fuzzy subject))))
7161             (setq subject (gnus-simplify-subject-re subject)))
7162           (if (setq hthread 
7163                     (gnus-gethash subject hashtb))
7164               (progn
7165                 (or (stringp (car (car hthread)))
7166                     (setcar hthread (list whole-subject (car hthread))))
7167                 (setcdr (car hthread) (nconc (cdr (car hthread)) 
7168                                              (list (car threads))))
7169                 (setcdr prev (cdr threads))
7170                 (setq threads prev))
7171             (gnus-sethash subject threads hashtb)))
7172         (setq prev threads)
7173         (setq threads (cdr threads)))
7174       result)))
7175
7176 (defun gnus-make-threads ()
7177   "Go through the dependency hashtb and find the roots.  Return all threads."
7178   ;; Then we find all the roots and return all the threads.
7179   (let (threads)
7180     (mapatoms
7181      (lambda (refs)
7182        (or (car (symbol-value refs))
7183            (setq threads (append (cdr (symbol-value refs)) threads))))
7184      gnus-newsgroup-dependencies)
7185     threads))
7186   
7187 (defun gnus-build-old-threads ()
7188   ;; Look at all the articles that refer back to old articles, and
7189   ;; fetch the headers for the articles that aren't there.  This will
7190   ;; build complete threads - if the roots haven't been expired by the
7191   ;; server, that is.
7192   (let (id heads)
7193     (mapatoms
7194      (lambda (refs)
7195        (when (car (symbol-value refs))
7196          (setq heads (cdr (symbol-value refs)))
7197          (while heads
7198            (if (memq (mail-header-number (car (car heads)))
7199                      gnus-newsgroup-dormant)
7200                (setq heads (cdr heads))
7201              (setq id (symbol-name refs))
7202              (while (and (setq id (gnus-build-get-header id))
7203                          (not (car (gnus-gethash 
7204                                     id gnus-newsgroup-dependencies)))))
7205              (setq heads nil)))))
7206      gnus-newsgroup-dependencies)))
7207
7208 (defun gnus-build-get-header (id)
7209   ;; Look through the buffer of NOV lines and find the header to
7210   ;; ID.  Enter this line into the dependencies hash table, and return
7211   ;; the id of the parent article (if any).
7212   (let ((deps gnus-newsgroup-dependencies)
7213         found header)
7214     (prog1
7215         (save-excursion
7216           (set-buffer nntp-server-buffer)
7217           (goto-char (point-min))
7218           (while (and (not found) (search-forward id nil t))
7219             (beginning-of-line)
7220             (setq found (looking-at 
7221                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
7222                                  (regexp-quote id))))
7223             (or found (beginning-of-line 2)))
7224           (when found
7225             (let (ref)
7226               (beginning-of-line)
7227               (and
7228                (setq header (gnus-nov-parse-line 
7229                              (read (current-buffer)) deps))
7230                (gnus-parent-id (mail-header-references header))))))
7231       (when header
7232         (let ((number (mail-header-number header)))
7233           (push number gnus-newsgroup-limit)
7234           (push header gnus-newsgroup-headers)
7235           (push number gnus-newsgroup-ancient))))))
7236
7237 (defun gnus-rebuild-thread (id)
7238   "Rebuild the thread containing ID."
7239   (let ((dep gnus-newsgroup-dependencies)
7240         (buffer-read-only nil)
7241         current headers refs thread art data)
7242     (if (not gnus-show-threads)
7243         (setq thread (list (car (gnus-gethash (downcase id) dep))))
7244       ;; Get the thread this article is part of.
7245       (setq thread (gnus-remove-thread id)))
7246     (setq current (save-excursion
7247                     (and (zerop (forward-line -1))
7248                          (gnus-summary-article-number))))
7249     ;; If this is a gathered thread, we have to go some re-gathering.
7250     (when (stringp (car thread))
7251       (let ((subject (car thread))
7252             roots thr)
7253         (setq thread (cdr thread))
7254         (while thread
7255           (unless (memq (setq thr (gnus-id-to-thread 
7256                                       (gnus-root-id
7257                                        (mail-header-id (car (car thread))))))
7258                         roots)
7259             (push thr roots))
7260           (setq thread (cdr thread)))
7261         ;; We now have all (unique) roots.
7262         (if (= (length roots) 1)
7263             ;; All the loose roots are now one solid root.
7264             (setq thread (car roots))
7265           (setq thread (cons subject (gnus-sort-threads roots))))))
7266     (let ((beg (point)) 
7267           threads)
7268       ;; We then insert this thread into the summary buffer.
7269       (let (gnus-newsgroup-data gnus-newsgroup-threads)
7270         (gnus-summary-prepare-threads (list thread))
7271         (setq data (nreverse gnus-newsgroup-data))
7272         (setq threads gnus-newsgroup-threads))
7273       ;; We splice the new data into the data structure.
7274       (gnus-data-enter-list current data)
7275       (gnus-data-compute-positions)
7276       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
7277
7278 (defun gnus-id-to-thread (id)
7279   "Return the (sub-)thread where ID appears."
7280   (gnus-gethash (downcase id) gnus-newsgroup-dependencies))
7281
7282 (defun gnus-root-id (id)
7283   "Return the id of the root of the thread where ID appears."
7284   (let (last-id prev)
7285     (while (and id (setq prev (car (gnus-gethash 
7286                                     (downcase id)
7287                                     gnus-newsgroup-dependencies))))
7288       (setq last-id id
7289             id (gnus-parent-id (mail-header-references prev))))
7290     last-id))
7291
7292 (defun gnus-remove-thread (id)
7293   "Remove the thread that has ID in it."
7294   (let ((dep gnus-newsgroup-dependencies)
7295         headers thread prev last-id)
7296     ;; First go up in this thread until we find the root.
7297     (setq last-id (gnus-root-id id))
7298     (setq headers (list (car (gnus-id-to-thread last-id))
7299                         (car (car (cdr (gnus-id-to-thread last-id))))))
7300     ;; We have now found the real root of this thread.  It might have
7301     ;; been gathered into some loose thread, so we have to search
7302     ;; through the threads to find the thread we wanted.
7303     (let ((threads gnus-newsgroup-threads)
7304           sub)
7305       (while threads
7306         (setq sub (car threads))
7307         (if (stringp (car sub))
7308             ;; This is a gathered threads, so we look at the roots
7309             ;; below it to find whether this article in in this
7310             ;; gathered root.
7311             (progn
7312               (setq sub (cdr sub))
7313               (while sub
7314                 (when (member (car (car sub)) headers)
7315                   (setq thread (car threads)
7316                         threads nil
7317                         sub nil))
7318                 (setq sub (cdr sub))))
7319           ;; It's an ordinary thread, so we check it.
7320           (when (eq (car sub) (car headers))
7321             (setq thread sub
7322                   threads nil)))
7323         (setq threads (cdr threads)))
7324       ;; If this article is in no thread, then it's a root. 
7325       (if thread 
7326           (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))
7327         (setq thread (gnus-gethash (downcase last-id) dep)))
7328       (when thread
7329         (prog1 
7330             thread ; We return this thread.
7331           (if (stringp (car thread))
7332               (progn
7333                 ;; If we use dummy roots, then we have to remove the
7334                 ;; dummy root as well.
7335                 (when (eq gnus-summary-make-false-root 'dummy)
7336                   ;; Uhm.
7337                   )
7338                 (setq thread (cdr thread))
7339                 (while thread
7340                   (gnus-remove-thread-1 (car thread))
7341                   (setq thread (cdr thread))))
7342             (gnus-remove-thread-1 thread)))))))
7343
7344 (defun gnus-remove-thread-1 (thread)
7345   "Remove the thread THREAD recursively."
7346   (let ((number (mail-header-number (car thread)))
7347         pos)
7348     (when (setq pos (text-property-any 
7349                      (point-min) (point-max) 'gnus-number number))
7350       (goto-char pos)
7351       (gnus-delete-line)
7352       (gnus-data-remove number))
7353     (setq thread (cdr thread))
7354     (while thread
7355       (gnus-remove-thread-1 (car thread))
7356       (setq thread (cdr thread)))))
7357
7358 (defun gnus-sort-threads (threads)
7359   "Sort THREADS as specified in `gnus-thread-sort-functions'."
7360   (let ((funs gnus-thread-sort-functions))
7361     (when funs
7362       (while funs
7363         (gnus-message 7 "Sorting with %S..." (car funs))
7364         (setq threads (sort threads (pop funs))))
7365       (gnus-message 7 "Sorting...done")))
7366   threads)
7367
7368 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
7369 (defmacro gnus-thread-header (thread)
7370   ;; Return header of first article in THREAD.
7371   ;; Note that THREAD must never, evr be anything else than a variable -
7372   ;; using some other form will lead to serious barfage.
7373   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
7374   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
7375   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; 
7376         (vector thread) 2))
7377
7378 (defun gnus-thread-sort-by-number (h1 h2)
7379   "Sort threads by root article number."
7380   (< (mail-header-number (gnus-thread-header h1))
7381      (mail-header-number (gnus-thread-header h2))))
7382
7383 (defun gnus-thread-sort-by-author (h1 h2)
7384   "Sort threads by root author."
7385   (string-lessp
7386    (let ((extract (funcall 
7387                    gnus-extract-address-components
7388                    (mail-header-from (gnus-thread-header h1)))))
7389      (or (car extract) (cdr extract)))
7390    (let ((extract (funcall
7391                    gnus-extract-address-components 
7392                    (mail-header-from (gnus-thread-header h2)))))
7393      (or (car extract) (cdr extract)))))
7394
7395 (defun gnus-thread-sort-by-subject (h1 h2)
7396   "Sort threads by root subject."
7397   (string-lessp
7398    (downcase (gnus-simplify-subject-re
7399               (mail-header-subject (gnus-thread-header h1))))
7400    (downcase (gnus-simplify-subject-re 
7401               (mail-header-subject (gnus-thread-header h2))))))
7402
7403 (defun gnus-thread-sort-by-date (h1 h2)
7404   "Sort threads by root article date."
7405   (string-lessp
7406    (gnus-sortable-date (mail-header-date (gnus-thread-header h1)))
7407    (gnus-sortable-date (mail-header-date (gnus-thread-header h2)))))
7408
7409 (defun gnus-thread-sort-by-score (h1 h2)
7410   "Sort threads by root article score.
7411 Unscored articles will be counted as having a score of zero."
7412   (> (or (cdr (assq (mail-header-number (gnus-thread-header h1))
7413                     gnus-newsgroup-scored))
7414          gnus-summary-default-score 0)
7415      (or (cdr (assq (mail-header-number (gnus-thread-header h2))
7416                     gnus-newsgroup-scored))
7417          gnus-summary-default-score 0)))
7418
7419 (defun gnus-thread-sort-by-total-score (h1 h2)
7420   "Sort threads by the sum of all scores in the thread.
7421 Unscored articles will be counted as having a score of zero."
7422   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
7423
7424 (defun gnus-thread-total-score (thread)
7425   ;;  This function find the total score of THREAD.
7426   (if (consp thread)
7427       (if (stringp (car thread))
7428           (apply gnus-thread-score-function 0
7429                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
7430         (gnus-thread-total-score-1 thread))
7431     (gnus-thread-total-score-1 (list thread))))
7432
7433 (defun gnus-thread-total-score-1 (root)
7434   ;; This function find the total score of the thread below ROOT.
7435   (setq root (car root))
7436   (apply gnus-thread-score-function
7437          (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
7438              gnus-summary-default-score 0)
7439          (mapcar 'gnus-thread-total-score
7440                  (cdr (gnus-gethash (downcase (mail-header-id root))
7441                                     gnus-newsgroup-dependencies)))))
7442
7443 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
7444 (defvar gnus-tmp-prev-subject nil)
7445 (defvar gnus-tmp-false-parent nil)
7446 (defvar gnus-tmp-root-expunged nil)
7447 (defvar gnus-tmp-dummy-line nil)
7448
7449 (defun gnus-summary-prepare-threads (threads)
7450   "Prepare summary buffer from THREADS and indentation LEVEL.  
7451 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'  
7452 or a straight list of headers."
7453   (message "Generating summary...")
7454
7455   (setq gnus-newsgroup-threads threads)
7456   (beginning-of-line)
7457
7458   (let ((gnus-tmp-level 0)
7459         (default-score (or gnus-summary-default-score 0))
7460         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
7461         thread number subject stack state gnus-tmp-gathered beg-match
7462         new-roots gnus-tmp-new-adopts thread-end
7463         gnus-tmp-header gnus-tmp-unread
7464         gnus-tmp-replied gnus-tmp-subject-or-nil
7465         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
7466         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
7467         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
7468
7469     (setq gnus-tmp-prev-subject nil)
7470
7471     (if (vectorp (car threads))
7472         ;; If this is a straight (sic) list of headers, then a
7473         ;; threaded summary display isn't required, so we just create
7474         ;; an unthreaded one.
7475         (gnus-summary-prepare-unthreaded threads)
7476
7477       ;; Do the threaded display.
7478
7479       (while (or threads stack gnus-tmp-new-adopts new-roots)
7480
7481         (if (and (= gnus-tmp-level 0)
7482                  (not (setq gnus-tmp-dummy-line nil))
7483                  (or (not stack)
7484                      (= (car (car stack)) 0))
7485                  (not gnus-tmp-false-parent)
7486                  (or gnus-tmp-new-adopts new-roots))
7487             (if gnus-tmp-new-adopts
7488                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
7489                       thread (list (car gnus-tmp-new-adopts))
7490                       gnus-tmp-header (car (car thread))
7491                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
7492               (if new-roots
7493                   (setq thread (list (car new-roots))
7494                         gnus-tmp-header (car (car thread))
7495                         new-roots (cdr new-roots))))
7496
7497           (if threads
7498               ;; If there are some threads, we do them before the
7499               ;; threads on the stack.
7500               (setq thread threads
7501                     gnus-tmp-header (car (car thread)))
7502             ;; There were no current threads, so we pop something off
7503             ;; the stack. 
7504             (setq state (car stack)
7505                   gnus-tmp-level (car state)
7506                   thread (cdr state)
7507                   stack (cdr stack)
7508                   gnus-tmp-header (car (car thread)))))
7509
7510         (setq gnus-tmp-false-parent nil)
7511         (setq gnus-tmp-root-expunged nil)
7512         (setq thread-end nil)
7513
7514         (if (stringp gnus-tmp-header)
7515             ;; The header is a dummy root.
7516             (cond 
7517              ((eq gnus-summary-make-false-root 'adopt)
7518               ;; We let the first article adopt the rest.
7519               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
7520                                                (cdr (cdr (car thread)))))
7521               (setq gnus-tmp-gathered 
7522                     (nconc (mapcar
7523                             (lambda (h) (mail-header-number (car h)))
7524                             (cdr (cdr (car thread))))
7525                            gnus-tmp-gathered))
7526               (setq thread (cons (list (car (car thread))
7527                                        (car (cdr (car thread))))
7528                                  (cdr thread)))
7529               (setq gnus-tmp-level -1
7530                     gnus-tmp-false-parent t))
7531              ((eq gnus-summary-make-false-root 'empty)
7532               ;; We print adopted articles with empty subject fields.
7533               (setq gnus-tmp-gathered 
7534                     (nconc (mapcar
7535                             (lambda (h) (mail-header-number (car h)))
7536                             (cdr (cdr (car thread))))
7537                            gnus-tmp-gathered))
7538               (setq gnus-tmp-level -1))
7539              ((eq gnus-summary-make-false-root 'dummy)
7540               ;; We remember that we probably want to output a dummy
7541               ;; root.   
7542               (setq gnus-tmp-dummy-line gnus-tmp-header)
7543               (setq gnus-tmp-prev-subject gnus-tmp-header))
7544              (t
7545               ;; We do not make a root for the gathered
7546               ;; sub-threads at all.  
7547               (setq gnus-tmp-level -1)))
7548       
7549           (setq number (mail-header-number gnus-tmp-header)
7550                 subject (mail-header-subject gnus-tmp-header))
7551
7552           (cond 
7553            ;; If the thread has changed subject, we might want to make 
7554            ;; this subthread into a root.
7555            ((and (null gnus-thread-ignore-subject)
7556                  (not (zerop gnus-tmp-level))
7557                  gnus-tmp-prev-subject
7558                  (not (inline
7559                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
7560             (setq new-roots (nconc new-roots (list (car thread)))
7561                   thread-end t
7562                   gnus-tmp-header nil))
7563            ;; If the article lies outside the current limit,
7564            ;; then we do not display it.
7565            ((not (memq number gnus-newsgroup-limit))
7566             (setq gnus-tmp-gathered 
7567                   (nconc (mapcar
7568                           (lambda (h) (mail-header-number (car h)))
7569                           (cdr (car thread)))
7570                          gnus-tmp-gathered))
7571             (setq gnus-tmp-new-adopts (if (cdr (car thread))
7572                                           (append gnus-tmp-new-adopts 
7573                                                   (cdr (car thread)))
7574                                         gnus-tmp-new-adopts)
7575                   thread-end t
7576                   gnus-tmp-header nil)
7577             (when (zerop gnus-tmp-level)
7578               (setq gnus-tmp-root-expunged t)))
7579            ;; Perhaps this article is to be marked as read?
7580            ((and gnus-summary-mark-below
7581                  (< (or (cdr (assq number gnus-newsgroup-scored))
7582                         default-score)
7583                     gnus-summary-mark-below))
7584             (setq gnus-newsgroup-unreads 
7585                   (delq number gnus-newsgroup-unreads)
7586                   gnus-newsgroup-reads
7587                   (cons (cons number gnus-low-score-mark)
7588                         gnus-newsgroup-reads))))
7589           
7590           (when gnus-tmp-header
7591             ;; We may have an old dummy line to output before this
7592             ;; article.  
7593             (when gnus-tmp-dummy-line
7594               (gnus-summary-insert-dummy-line 
7595                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
7596               (setq gnus-tmp-dummy-line nil))
7597
7598             ;; Compute the mark.
7599             (setq 
7600              gnus-tmp-unread
7601              (cond 
7602               ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
7603               ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
7604               ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
7605               ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
7606               (t (or (cdr (assq number gnus-newsgroup-reads))
7607                      gnus-ancient-mark))))
7608
7609             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
7610                                   gnus-tmp-header gnus-tmp-level)
7611                   gnus-newsgroup-data)
7612
7613             ;; Actually insert the line.
7614             (setq 
7615              gnus-tmp-subject-or-nil
7616              (cond
7617               ((and gnus-thread-ignore-subject
7618                     gnus-tmp-prev-subject
7619                     (not (inline (gnus-subject-equal 
7620                                   gnus-tmp-prev-subject subject))))
7621                subject)
7622               ((zerop gnus-tmp-level)
7623                (if (and (eq gnus-summary-make-false-root 'empty)
7624                         (memq number gnus-tmp-gathered)
7625                         gnus-tmp-prev-subject
7626                         (inline (gnus-subject-equal
7627                                  gnus-tmp-prev-subject subject)))
7628                    gnus-summary-same-subject
7629                  subject))
7630               (t gnus-summary-same-subject)))
7631             (if (and (eq gnus-summary-make-false-root 'adopt)
7632                      (= gnus-tmp-level 1)
7633                      (memq number gnus-tmp-gathered))
7634                 (setq gnus-tmp-opening-bracket ?\<
7635                       gnus-tmp-closing-bracket ?\>)
7636               (setq gnus-tmp-opening-bracket ?\[
7637                     gnus-tmp-closing-bracket ?\]))
7638             (setq 
7639              gnus-tmp-indentation 
7640              (aref gnus-thread-indent-array gnus-tmp-level)
7641              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
7642              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
7643                                 gnus-summary-default-score 0)
7644              gnus-tmp-score-char
7645              (if (or (null gnus-summary-default-score)
7646                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7647                          gnus-summary-zcore-fuzz)) ? 
7648                (if (< gnus-tmp-score gnus-summary-default-score)
7649                    gnus-score-below-mark gnus-score-over-mark))
7650              gnus-tmp-replied
7651              (cond ((memq number gnus-newsgroup-processable)
7652                     gnus-process-mark)
7653                    ((memq number gnus-newsgroup-replied)
7654                     gnus-replied-mark)
7655                    (t gnus-unread-mark))
7656              gnus-tmp-from (mail-header-from gnus-tmp-header)
7657              gnus-tmp-name 
7658              (cond 
7659               ((string-match "(.+)" gnus-tmp-from)
7660                (substring gnus-tmp-from 
7661                           (1+ (match-beginning 0)) (1- (match-end 0))))
7662               ((string-match "<[^>]+> *$" gnus-tmp-from)
7663                (setq beg-match (match-beginning 0))
7664                (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7665                         (substring gnus-tmp-from (1+ (match-beginning 0))
7666                                    (1- (match-end 0))))
7667                    (substring gnus-tmp-from 0 beg-match)))
7668               (t gnus-tmp-from)))
7669             (when (string= gnus-tmp-name "")
7670               (setq gnus-tmp-name gnus-tmp-from))
7671             (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7672             (put-text-property
7673              (point)
7674              (progn (eval gnus-summary-line-format-spec) (point))
7675              'gnus-number number)
7676             (when gnus-visual-p
7677               (forward-line -1)
7678               (run-hooks 'gnus-summary-update-hook)
7679               (forward-line 1))
7680
7681             (setq gnus-tmp-prev-subject subject)))
7682
7683         (when (nth 1 thread) 
7684           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
7685         (incf gnus-tmp-level)
7686         (setq threads (if thread-end nil (cdr (car thread))))
7687         (unless threads
7688           (setq gnus-tmp-level 0)))))
7689   (message "Generating summary...done"))
7690
7691 (defun gnus-summary-prepare-unthreaded (headers)
7692   "Generate an unthreaded summary buffer based on HEADERS."
7693   (let (header number mark)
7694
7695     (while headers
7696       (setq header (car headers)
7697             headers (cdr headers)
7698             number (mail-header-number header))
7699
7700       ;; We may have to root out some bad articles...
7701       (when (memq number gnus-newsgroup-limit)
7702         (when (and gnus-summary-mark-below
7703                    (< (or (cdr (assq number gnus-newsgroup-scored))
7704                           gnus-summary-default-score 0)
7705                       gnus-summary-mark-below))
7706           (setq gnus-newsgroup-unreads 
7707                 (delq number gnus-newsgroup-unreads)
7708                 gnus-newsgroup-reads
7709                 (cons (cons number gnus-low-score-mark)
7710                       gnus-newsgroup-reads)))
7711           
7712         (setq mark
7713               (cond 
7714                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
7715                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
7716                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
7717                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
7718                (t (or (cdr (assq number gnus-newsgroup-reads))
7719                       gnus-ancient-mark))))
7720         (setq gnus-newsgroup-data 
7721               (cons (gnus-data-make number mark (1+ (point)) header 0)
7722                     gnus-newsgroup-data))
7723         (gnus-summary-insert-line
7724          header 0 nil mark (memq number gnus-newsgroup-replied)
7725          (memq number gnus-newsgroup-expirable)
7726          (mail-header-subject header) nil
7727          (cdr (assq number gnus-newsgroup-scored))
7728          (memq number gnus-newsgroup-processable))))))
7729
7730 (defun gnus-select-newsgroup (group &optional read-all)
7731   "Select newsgroup GROUP.
7732 If READ-ALL is non-nil, all articles in the group are selected."
7733   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
7734          (info (nth 2 entry))
7735          articles)
7736
7737     (or (gnus-check-server
7738          (setq gnus-current-select-method (gnus-find-method-for-group group)))
7739         (error "Couldn't open server"))
7740     
7741     (or (and entry (not (eq (car entry) t))) ; Either it's active...
7742         (gnus-activate-group group) ; Or we can activate it...
7743         (progn ; Or we bug out.
7744           (kill-buffer (current-buffer))
7745           (error "Couldn't request group %s: %s" 
7746                  group (gnus-status-message group))))
7747
7748     (setq gnus-newsgroup-name group)
7749     (setq gnus-newsgroup-unselected nil)
7750     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
7751
7752     (and gnus-asynchronous
7753          (gnus-check-backend-function 
7754           'request-asynchronous gnus-newsgroup-name)
7755          (setq gnus-newsgroup-async
7756                (gnus-request-asynchronous gnus-newsgroup-name)))
7757
7758     ;; Adjust and set lists of article marks.
7759     (when info
7760       (gnus-adjust-marked-articles info))
7761
7762     (setq gnus-newsgroup-unreads 
7763           (gnus-set-difference
7764            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
7765            gnus-newsgroup-dormant))
7766
7767     (setq gnus-newsgroup-processable nil)
7768     
7769     (setq articles (gnus-articles-to-read group read-all))
7770     
7771     (cond 
7772      ((null articles) 
7773       (gnus-message 3 "Couldn't select newsgroup")
7774       'quit)
7775      ((eq articles 0) nil)
7776      (t
7777       ;; Init the dependencies hash table.
7778       (setq gnus-newsgroup-dependencies 
7779             (gnus-make-hashtable (length articles)))
7780       ;; Retrieve the headers and read them in.
7781       (gnus-message 5 "Fetching headers...")
7782       (setq gnus-newsgroup-headers 
7783             (if (eq 'nov 
7784                     (setq gnus-headers-retrieved-by
7785                           (gnus-retrieve-headers 
7786                            articles gnus-newsgroup-name
7787                            ;; We might want to fetch old headers, but
7788                            ;; not if there is only 1 article.
7789                            (and gnus-fetch-old-headers
7790                                 (or (and 
7791                                      (not (eq gnus-fetch-old-headers 'some))
7792                                      (not (numberp gnus-fetch-old-headers)))
7793                                     (> (length articles) 1))))))
7794                 (gnus-get-newsgroup-headers-xover articles)
7795               (gnus-get-newsgroup-headers)))
7796       (gnus-message 5 "Fetching headers...done")      
7797       ;; Set the initial limit.
7798       (setq gnus-newsgroup-limit (copy-sequence articles))
7799       ;; Remove canceled articles from the list of unread articles.
7800       (setq gnus-newsgroup-unreads
7801             (gnus-set-sorted-intersection 
7802              gnus-newsgroup-unreads
7803              (mapcar (lambda (headers) (mail-header-number headers))
7804                      gnus-newsgroup-headers)))
7805       ;; We might want to build some more threads first.
7806       (and gnus-fetch-old-headers
7807            (eq gnus-headers-retrieved-by 'nov)
7808            (gnus-build-old-threads))
7809       ;; Check whether auto-expire is to be done in this group.
7810       (setq gnus-newsgroup-auto-expire
7811             (gnus-group-auto-expirable-p group))
7812       ;; First and last article in this newsgroup.
7813       (and gnus-newsgroup-headers
7814            (setq gnus-newsgroup-begin 
7815                  (mail-header-number (car gnus-newsgroup-headers)))
7816            (setq gnus-newsgroup-end
7817                  (mail-header-number
7818                   (gnus-last-element gnus-newsgroup-headers))))
7819       (setq gnus-reffed-article-number -1)
7820       ;; GROUP is successfully selected.
7821       (or gnus-newsgroup-headers t)))))
7822
7823 (defun gnus-articles-to-read (group read-all)
7824   ;; Find out what articles the user wants to read.
7825   (let* ((articles
7826           ;; Select all articles if `read-all' is non-nil, or if there
7827           ;; are no unread articles.
7828           (if (or read-all
7829                   (and (zerop (length gnus-newsgroup-marked))
7830                        (zerop (length gnus-newsgroup-unreads))))
7831               (gnus-uncompress-range (gnus-active group))
7832             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked 
7833                           (copy-sequence gnus-newsgroup-unreads))
7834                   '<)))
7835          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
7836          (scored (length scored-list))
7837          (number (length articles))
7838          (marked (+ (length gnus-newsgroup-marked)
7839                     (length gnus-newsgroup-dormant)))
7840          (select
7841           (cond 
7842            ((numberp read-all)
7843             read-all)
7844            (t
7845             (condition-case ()
7846                 (cond 
7847                  ((and (or (<= scored marked) (= scored number))
7848                        (numberp gnus-large-newsgroup)
7849                        (> number gnus-large-newsgroup))
7850                   (let ((input
7851                          (read-string
7852                           (format
7853                            "How many articles from %s (default %d): "
7854                            gnus-newsgroup-name number))))
7855                     (if (string-match "^[ \t]*$" input) number input)))
7856                  ((and (> scored marked) (< scored number))
7857                   (let ((input
7858                          (read-string
7859                           (format "%s %s (%d scored, %d total): "
7860                                   "How many articles from"
7861                                   group scored number))))
7862                     (if (string-match "^[ \t]*$" input)
7863                         number input)))
7864                  (t number))
7865               (quit nil))))))
7866     (setq select (if (stringp select) (string-to-number select) select))
7867     (if (or (null select) (zerop select))
7868         select
7869       (if (and (not (zerop scored)) (<= (abs select) scored))
7870           (progn
7871             (setq articles (sort scored-list '<))
7872             (setq number (length articles)))
7873         (setq articles (copy-sequence articles)))
7874
7875       (if (< (abs select) number)
7876           (if (< select 0) 
7877               ;; Select the N oldest articles.
7878               (setcdr (nthcdr (1- (abs select)) articles) nil)
7879             ;; Select the N most recent articles.
7880             (setq articles (nthcdr (- number select) articles))))
7881       (setq gnus-newsgroup-unselected
7882             (gnus-sorted-intersection
7883              gnus-newsgroup-unreads
7884              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
7885       articles)))
7886
7887 (defun gnus-killed-articles (killed articles)
7888   (let (out)
7889     (while articles
7890       (if (inline (gnus-member-of-range (car articles) killed))
7891           (setq out (cons (car articles) out)))
7892       (setq articles (cdr articles)))
7893     out))
7894
7895 (defun gnus-adjust-marked-articles (info)
7896   "Set all article lists and remove all marks that are no longer legal."
7897   (let* ((marked-lists (gnus-info-marks info))
7898          (active (gnus-active (gnus-info-group info)))
7899          (min (car active))
7900          (max (cdr active))
7901          (types '((marked . tick) (replied . reply) 
7902                   (expirable . expire) (killed . killed)
7903                   (bookmarks . bookmark) (dormant . dormant)
7904                   (scored . score)))
7905          (uncompressed '(score bookmark))
7906          marks var articles article mark)
7907
7908     (while marked-lists
7909       (setq marks (pop marked-lists))
7910       (set (setq var (intern (format "gnus-newsgroup-%s" 
7911                                      (car (rassq (setq mark (car marks)) 
7912                                                  types)))))
7913            (if (memq (car marks) uncompressed) (cdr marks)
7914              (gnus-uncompress-range (cdr marks))))
7915
7916       (setq articles (symbol-value var))
7917
7918       ;; All articles have to be subsets of the active articles.  
7919       (cond 
7920        ;; Adjust "simple" lists.
7921        ((memq mark '(tick dormant expirable reply killed))
7922         (while articles
7923           (when (or (< (setq article (pop articles)) min) (> article max))
7924             (set var (delq article (symbol-value var))))))
7925        ;; Adjust assocs.
7926        ((memq mark '(score bookmark))
7927         (while articles 
7928           (when (or (< (car (setq article (pop articles))) min) 
7929                     (> (car article) max))
7930             (set var (delq article (symbol-value var))))))))))
7931
7932 (defun gnus-update-marks ()
7933   "Enter the various lists of marked articles into the newsgroup info list."
7934   (let ((types '((marked . tick) (replied . reply) 
7935                  (expirable . expire) (killed . killed)
7936                  (bookmarks . bookmark) (dormant . dormant)
7937                  (scored . score)))
7938         (info (gnus-get-info gnus-newsgroup-name))
7939         (uncompressed '(score bookmark))
7940         var type list newmarked)
7941     ;; Add all marks lists that are non-nil to the list of marks lists. 
7942     (while types
7943       (setq type (pop types))
7944       (when (setq list (symbol-value (intern (format "gnus-newsgroup-%s" 
7945                                                      (car type)))))
7946         (push (cons (cdr type) 
7947                     (if (memq (cdr type) uncompressed) list
7948                       (gnus-compress-sequence list t)))
7949               newmarked)))
7950
7951     ;; Enter these new marks into the info of the group.
7952     (if (nthcdr 3 info)
7953         (progn
7954           (setcar (nthcdr 3 info) newmarked)
7955           ;; Cut off the end of the info if there's nothing else there. 
7956           (or newmarked (nthcdr 4 info)
7957               (setcdr (nthcdr 2 info) nil)))
7958       ;; Add the marks lists to the end of the info.
7959       (when newmarked
7960         (setcdr (nthcdr 2 info) (list newmarked))))))
7961
7962
7963 (defun gnus-add-marked-articles (group type articles &optional info force)
7964   ;; Add ARTICLES of TYPE to the info of GROUP.
7965   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
7966   ;; add, but replace marked articles of TYPE with ARTICLES.
7967   (let ((info (or info (gnus-get-info group)))
7968         (uncompressed '(score bookmark))
7969         marked m)
7970     (or (not info)
7971         (and (not (setq marked (nthcdr 3 info)))
7972              (setcdr (nthcdr 2 info)
7973                      (list (list (cons type (gnus-compress-sequence
7974                                              articles t))))))
7975         (and (not (setq m (assq type (car marked))))
7976              (setcar marked 
7977                      (cons (cons type (gnus-compress-sequence articles t) )
7978                            (car marked))))
7979         (if force
7980             (setcdr m (gnus-compress-sequence articles t))
7981           (setcdr m (gnus-compress-sequence
7982                      (sort (nconc (gnus-uncompress-range m) 
7983                                   (copy-sequence articles)) '<) t))))))
7984          
7985 (defun gnus-set-mode-line (where)
7986   "This function sets the mode line of the article or summary buffers.
7987 If WHERE is `summary', the summary mode line format will be used."
7988   ;; Is this mode line one we keep updated?
7989   (when (memq where gnus-updated-mode-lines)
7990     (let (mode-string)
7991       (save-excursion
7992         ;; We evaluate this in the summary buffer since these
7993         ;; variables are buffer-local to that buffer.
7994         (set-buffer gnus-summary-buffer)
7995         ;; We bind all these variables that are used in the `eval' form
7996         ;; below. 
7997         (let* ((mformat (if (eq where 'article) 
7998                             gnus-article-mode-line-format-spec
7999                           gnus-summary-mode-line-format-spec))
8000                (gnus-tmp-group-name gnus-newsgroup-name)
8001                (gnus-tmp-article-number (or gnus-current-article 0))
8002                (gnus-tmp-unread gnus-newsgroup-unreads)
8003                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
8004                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
8005                (gnus-tmp-unread-and-unselected
8006                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
8007                             (zerop gnus-tmp-unselected)) "")
8008                       ((zerop gnus-tmp-unselected) 
8009                        (format "{%d more}" gnus-tmp-unread-and-unticked))
8010                       (t (format "{%d(+%d) more}"
8011                                  gnus-tmp-unread-and-unticked
8012                                  gnus-tmp-unselected))))
8013                (gnus-tmp-subject
8014                 (if gnus-current-headers
8015                     (mail-header-subject gnus-current-headers) ""))
8016                max-len 
8017                header);; passed as argument to any user-format-funcs
8018           (setq mode-string (eval mformat))
8019           (setq max-len (max 4 (if gnus-mode-non-string-length
8020                                    (- (frame-width) 
8021                                       gnus-mode-non-string-length)
8022                                  (length mode-string))))
8023           ;; We might have to chop a bit of the string off...
8024           (when (> (length mode-string) max-len)
8025             (setq mode-string 
8026                   (concat (gnus-truncate-string mode-string (- max-len 3))
8027                           "...")))
8028           ;; Pad the mode string a bit.
8029           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
8030       ;; Update the mode line.
8031       (setq mode-line-buffer-identification mode-string)
8032       (set-buffer-modified-p t))))
8033
8034 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
8035   "Go through the HEADERS list and add all Xrefs to a hash table.
8036 The resulting hash table is returned, or nil if no Xrefs were found."
8037   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
8038          (prefix (gnus-group-real-prefix from-newsgroup))
8039          (xref-hashtb (make-vector 63 0))
8040          start group entry number xrefs header)
8041     (while headers
8042       (setq header (pop headers))
8043       (when (and (setq xrefs (mail-header-xref header))
8044                  (not (memq (setq number (mail-header-number header))
8045                             unreads)))
8046         (setq start 0)
8047         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
8048           (setq start (match-end 0))
8049           (setq group (concat prefix (substring xrefs (match-beginning 1) 
8050                                                 (match-end 1))))
8051           (setq number 
8052                 (string-to-int (substring xrefs (match-beginning 2) 
8053                                           (match-end 2))))
8054           (if (setq entry (gnus-gethash group xref-hashtb))
8055               (setcdr entry (cons number (cdr entry)))
8056             (gnus-sethash group (cons number nil) xref-hashtb)))))
8057     (and start xref-hashtb)))
8058
8059 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
8060   "Look through all the headers and mark the Xrefs as read."
8061   (let ((virtual (memq 'virtual 
8062                        (assoc (symbol-name (car (gnus-find-method-for-group 
8063                                                  from-newsgroup)))
8064                               gnus-valid-select-methods)))
8065         name entry info xref-hashtb idlist method
8066         nth4)
8067     (save-excursion
8068       (set-buffer gnus-group-buffer)
8069       (when (setq xref-hashtb 
8070                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
8071         (mapatoms 
8072          (lambda (group)
8073            (unless (string= from-newsgroup (setq name (symbol-name group)))
8074              (setq idlist (symbol-value group))
8075              ;; Dead groups are not updated.
8076              (and (prog1 
8077                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
8078                             info (nth 2 entry))
8079                     (if (stringp (setq nth4 (gnus-info-method info)))
8080                         (setq nth4 (gnus-server-to-method nth4))))
8081                   ;; Only do the xrefs if the group has the same
8082                   ;; select method as the group we have just read.
8083                   (or (gnus-methods-equal-p 
8084                        nth4 (gnus-find-method-for-group from-newsgroup))
8085                       virtual
8086                       (equal nth4 (setq method (gnus-find-method-for-group 
8087                                                 from-newsgroup)))
8088                       (and (equal (car nth4) (car method))
8089                            (equal (nth 1 nth4) (nth 1 method))))
8090                   gnus-use-cross-reference
8091                   (or (not (eq gnus-use-cross-reference t))
8092                       virtual
8093                       ;; Only do cross-references on subscribed
8094                       ;; groups, if that is what is wanted.  
8095                       (<= (gnus-info-level info) gnus-level-subscribed))
8096                   (gnus-group-make-articles-read name idlist))))
8097          xref-hashtb)))))
8098
8099 (defun gnus-group-make-articles-read (group articles)
8100   (let* ((num 0)
8101          (entry (gnus-gethash group gnus-newsrc-hashtb))
8102          (info (nth 2 entry))
8103          (active (gnus-active group))
8104          range)
8105     ;; First peel off all illegal article numbers.
8106     (if active
8107         (let ((ids articles)
8108               id first)
8109           (while ids
8110             (setq id (car ids))
8111             (if (and first (> id (cdr active)))
8112                 (progn
8113                   ;; We'll end up in this situation in one particular
8114                   ;; obscure situation.  If you re-scan a group and get
8115                   ;; a new article that is cross-posted to a different
8116                   ;; group that has not been re-scanned, you might get
8117                   ;; crossposted article that has a higher number than
8118                   ;; Gnus believes possible.  So we re-activate this
8119                   ;; group as well.  This might mean doing the
8120                   ;; crossposting thingie will *increase* the number
8121                   ;; of articles in some groups.  Tsk, tsk.
8122                   (setq active (or (gnus-activate-group group) active))))
8123             (if (or (> id (cdr active))
8124                     (< id (car active)))
8125                 (setq articles (delq id articles)))
8126             (setq ids (cdr ids)))))
8127     ;; If the read list is nil, we init it.
8128     (and active
8129          (null (gnus-info-read info))
8130          (> (car active) 1)
8131          (gnus-info-set-read info (cons 1 (1- (car active)))))
8132     ;; Then we add the read articles to the range.
8133     (gnus-info-set-read
8134      info
8135      (setq range
8136            (gnus-add-to-range 
8137             (gnus-info-read info) (setq articles (sort articles '<)))))
8138     ;; Then we have to re-compute how many unread
8139     ;; articles there are in this group.
8140     (if active
8141         (progn
8142           (cond 
8143            ((not range)
8144             (setq num (- (1+ (cdr active)) (car active))))
8145            ((not (listp (cdr range)))
8146             (setq num (- (cdr active) (- (1+ (cdr range)) 
8147                                          (car range)))))
8148            (t
8149             (while range
8150               (if (numberp (car range))
8151                   (setq num (1+ num))
8152                 (setq num (+ num (- (1+ (cdr (car range)))
8153                                     (car (car range))))))
8154               (setq range (cdr range)))
8155             (setq num (- (cdr active) num))))
8156           ;; Update the number of unread articles.
8157           (setcar entry num)
8158           ;; Update the group buffer.
8159           (gnus-group-update-group group t)))))
8160
8161 (defun gnus-methods-equal-p (m1 m2)
8162   (let ((m1 (or m1 gnus-select-method))
8163         (m2 (or m2 gnus-select-method)))
8164     (or (equal m1 m2)
8165         (and (eq (car m1) (car m2))
8166              (or (not (memq 'address (assoc (symbol-name (car m1))
8167                                             gnus-valid-select-methods)))
8168                  (equal (nth 1 m1) (nth 1 m2)))))))
8169
8170 (defsubst gnus-header-value ()
8171   (buffer-substring (match-end 0) (gnus-point-at-eol)))
8172
8173 (defvar gnus-newsgroup-none-id 0)
8174
8175 (defun gnus-get-newsgroup-headers (&optional dependencies)
8176   (let ((cur nntp-server-buffer)
8177         (dependencies 
8178          (or dependencies
8179              (save-excursion (set-buffer gnus-summary-buffer)
8180                              gnus-newsgroup-dependencies)))
8181         headers id id-dep ref-dep end ref)
8182     (save-excursion
8183       (set-buffer nntp-server-buffer)
8184       (let ((case-fold-search t)
8185             in-reply-to header number p lines)
8186         (goto-char (point-min))
8187         ;; Search to the beginning of the next header.  Error messages
8188         ;; do not begin with 2 or 3.
8189         (while (re-search-forward "^[23][0-9]+ " nil t)
8190           (setq id nil
8191                 ref nil)
8192           ;; This implementation of this function, with nine
8193           ;; search-forwards instead of the one re-search-forward and
8194           ;; a case (which basically was the old function) is actually
8195           ;; about twice as fast, even though it looks messier.  You
8196           ;; can't have everything, I guess.  Speed and elegance
8197           ;; doesn't always go hand in hand.
8198           (setq 
8199            header
8200            (vector
8201             ;; Number.
8202             (prog1
8203                 (read cur)
8204               (end-of-line)
8205               (setq p (point))
8206               (narrow-to-region (point) 
8207                                 (or (and (search-forward "\n.\n" nil t)
8208                                          (- (point) 2))
8209                                     (point))))
8210             ;; Subject.
8211             (progn
8212               (goto-char p)
8213               (if (search-forward "\nsubject: " nil t)
8214                   (gnus-header-value) "(none)"))
8215             ;; From.
8216             (progn
8217               (goto-char p)
8218               (if (search-forward "\nfrom: " nil t)
8219                   (gnus-header-value) "(nobody)"))
8220             ;; Date.
8221             (progn
8222               (goto-char p)
8223               (if (search-forward "\ndate: " nil t)
8224                   (gnus-header-value) ""))
8225             ;; Message-ID.
8226             (progn
8227               (goto-char p)
8228               (if (search-forward "\nmessage-id: " nil t)
8229                   (setq id (gnus-header-value))
8230                 ;; If there was no message-id, we just fake one to make
8231                 ;; subsequent routines simpler.
8232                 (setq id (concat "none+" 
8233                                  (int-to-string 
8234                                   (setq gnus-newsgroup-none-id 
8235                                         (1+ gnus-newsgroup-none-id)))))))
8236             ;; References.
8237             (progn
8238               (goto-char p)
8239               (if (search-forward "\nreferences: " nil t)
8240                   (prog1
8241                       (gnus-header-value)
8242                     (setq end (match-end 0))
8243                     (save-excursion
8244                       (setq ref 
8245                             (downcase
8246                              (buffer-substring
8247                               (progn 
8248                                 (end-of-line)
8249                                 (search-backward ">" end t)
8250                                 (1+ (point)))
8251                               (progn
8252                                 (search-backward "<" end t)
8253                                 (point)))))))
8254                 ;; Get the references from the in-reply-to header if there
8255                 ;; were no references and the in-reply-to header looks
8256                 ;; promising. 
8257                 (if (and (search-forward "\nin-reply-to: " nil t)
8258                          (setq in-reply-to (gnus-header-value))
8259                          (string-match "<[^>]+>" in-reply-to))
8260                     (prog1
8261                         (setq ref (substring in-reply-to (match-beginning 0)
8262                                              (match-end 0)))
8263                       (setq ref (downcase ref))))
8264                 (setq ref "")))
8265             ;; Chars.
8266             0
8267             ;; Lines.
8268             (progn
8269               (goto-char p)
8270               (if (search-forward "\nlines: " nil t)
8271                   (if (numberp (setq lines (read cur)))
8272                       lines 0)
8273                 0))
8274             ;; Xref.
8275             (progn
8276               (goto-char p)
8277               (and (search-forward "\nxref: " nil t)
8278                    (gnus-header-value)))))
8279           (if (and gnus-nocem-hashtb
8280                    (gnus-gethash id gnus-nocem-hashtb))
8281               ;; Banned article.
8282               (setq header nil)
8283             ;; We do the threading while we read the headers.  The
8284             ;; message-id and the last reference are both entered into
8285             ;; the same hash table.  Some tippy-toeing around has to be
8286             ;; done in case an article has arrived before the article
8287             ;; which it refers to.
8288             (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8289                 (if (car (symbol-value id-dep))
8290                     ;; An article with this Message-ID has already
8291                     ;; been seen, so we ignore this one, except we add
8292                     ;; any additional Xrefs (in case the two articles
8293                     ;; came from different servers).
8294                     (progn
8295                       (mail-header-set-xref 
8296                        (car (symbol-value id-dep))
8297                        (concat (or (mail-header-xref 
8298                                     (car (symbol-value id-dep))) "")
8299                                (or (mail-header-xref header) "")))
8300                       (setq header nil))
8301                   (setcar (symbol-value id-dep) header))
8302               (set id-dep (list header))))
8303           (if header
8304               (progn
8305                 (if (boundp (setq ref-dep (intern ref dependencies)))
8306                     (setcdr (symbol-value ref-dep) 
8307                             (nconc (cdr (symbol-value ref-dep))
8308                                    (list (symbol-value id-dep))))
8309                   (set ref-dep (list nil (symbol-value id-dep))))
8310                 (setq headers (cons header headers))))
8311           (goto-char (point-max))
8312           (widen))
8313         (nreverse headers)))))
8314
8315 ;; The following macros and functions were written by Felix Lee
8316 ;; <flee@cse.psu.edu>. 
8317
8318 (defmacro gnus-nov-read-integer ()
8319   '(prog1
8320        (if (= (following-char) ?\t)
8321            0
8322          (let ((num (condition-case nil (read buffer) (error nil))))
8323            (if (numberp num) num 0)))
8324      (or (eobp) (forward-char 1))))
8325
8326 (defmacro gnus-nov-skip-field ()
8327   '(search-forward "\t" eol 'move))
8328
8329 (defmacro gnus-nov-field ()
8330   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
8331
8332 ;; Goes through the xover lines and returns a list of vectors
8333 (defun gnus-get-newsgroup-headers-xover (sequence)
8334   "Parse the news overview data in the server buffer, and return a
8335 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
8336   ;; Get the Xref when the users reads the articles since most/some
8337   ;; NNTP servers do not include Xrefs when using XOVER.
8338   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
8339   (let ((cur nntp-server-buffer)
8340         (dependencies gnus-newsgroup-dependencies)
8341         number headers header)
8342     (save-excursion
8343       (set-buffer nntp-server-buffer)
8344       (goto-char (point-min))
8345       (while (and sequence (not (eobp)))
8346         (setq number (read cur))
8347         (while (and sequence (< (car sequence) number))
8348           (setq sequence (cdr sequence)))
8349         (and sequence 
8350              (eq number (car sequence))
8351              (progn
8352                (setq sequence (cdr sequence))
8353                (if (setq header 
8354                          (inline (gnus-nov-parse-line number dependencies)))
8355                    (setq headers (cons header headers)))))
8356         (forward-line 1))
8357       (setq headers (nreverse headers)))
8358     headers))
8359
8360 ;; This function has to be called with point after the article number
8361 ;; on the beginning of the line.
8362 (defun gnus-nov-parse-line (number dependencies)
8363   (let ((none 0)
8364         (eol (gnus-point-at-eol)) 
8365         (buffer (current-buffer))
8366         header ref id id-dep ref-dep)
8367
8368     ;; overview: [num subject from date id refs chars lines misc]
8369     (narrow-to-region (point) eol)
8370     (or (eobp) (forward-char))
8371
8372     (condition-case nil
8373         (setq header
8374               (vector 
8375                number                   ; number
8376                (gnus-nov-field)         ; subject
8377                (gnus-nov-field)         ; from
8378                (gnus-nov-field)         ; date
8379                (setq id (or (gnus-nov-field)
8380                             (concat "none+"
8381                                     (int-to-string 
8382                                      (setq none (1+ none)))))) ; id
8383                (progn
8384                  (save-excursion
8385                    (let ((beg (point)))
8386                      (search-forward "\t" eol)
8387                      (if (search-backward ">" beg t)
8388                          (setq ref 
8389                                (downcase 
8390                                 (buffer-substring 
8391                                  (1+ (point))
8392                                  (progn
8393                                    (search-backward "<" beg t)
8394                                    (point)))))
8395                        (setq ref nil))))
8396                  (gnus-nov-field))      ; refs
8397                (gnus-nov-read-integer)  ; chars
8398                (gnus-nov-read-integer)  ; lines
8399                (if (= (following-char) ?\n)
8400                    nil
8401                  (gnus-nov-field))      ; misc
8402                ))
8403       (error (progn 
8404                (ding)
8405                (message "Strange nov line.")
8406                (setq header nil)
8407                (goto-char eol))))
8408
8409     (widen)
8410
8411     ;; We build the thread tree.
8412     (and header
8413          (if (and gnus-nocem-hashtb
8414                   (gnus-gethash id gnus-nocem-hashtb))
8415              ;; Banned article.
8416              (setq header nil)
8417            (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8418                (if (car (symbol-value id-dep))
8419                    ;; An article with this Message-ID has already been seen,
8420                    ;; so we ignore this one, except we add any additional
8421                    ;; Xrefs (in case the two articles came from different
8422                    ;; servers.
8423                    (progn
8424                      (mail-header-set-xref 
8425                       (car (symbol-value id-dep))
8426                       (concat (or (mail-header-xref 
8427                                    (car (symbol-value id-dep))) "")
8428                               (or (mail-header-xref header) "")))
8429                      (setq header nil))
8430                  (setcar (symbol-value id-dep) header))
8431              (set id-dep (list header)))))
8432     (if header
8433         (progn
8434           (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
8435               (setcdr (symbol-value ref-dep) 
8436                       (nconc (cdr (symbol-value ref-dep))
8437                              (list (symbol-value id-dep))))
8438             (set ref-dep (list nil (symbol-value id-dep))))))
8439     header))
8440
8441 (defun gnus-article-get-xrefs ()
8442   "Fill in the Xref value in `gnus-current-headers', if necessary.
8443 This is meant to be called in `gnus-article-internal-prepare-hook'."
8444   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
8445                                  gnus-current-headers)))
8446     (or (not gnus-use-cross-reference)
8447         (not headers)
8448         (and (mail-header-xref headers)
8449              (not (string= (mail-header-xref headers) "")))
8450         (let ((case-fold-search t)
8451               xref)
8452           (save-restriction
8453             (gnus-narrow-to-headers)
8454             (goto-char (point-min))
8455             (if (or (and (eq (downcase (following-char)) ?x)
8456                          (looking-at "Xref:"))
8457                     (search-forward "\nXref:" nil t))
8458                 (progn
8459                   (goto-char (1+ (match-end 0)))
8460                   (setq xref (buffer-substring (point) 
8461                                                (progn (end-of-line) (point))))
8462                   (mail-header-set-xref headers xref))))))))
8463
8464 (defun gnus-summary-insert-subject (id)
8465   "Find article ID and insert the summary line for that article."
8466   (let ((header (gnus-read-header id))
8467         number)
8468     (when header
8469       ;; Rebuild the thread that this article is part of and go to the
8470       ;; article we have fetched.
8471       (gnus-rebuild-thread (mail-header-id header))
8472       (gnus-summary-goto-subject (setq number (mail-header-number header)))
8473       (when (> number 0)
8474         ;; We have to update the boundaries, possibly.
8475         (and (> number gnus-newsgroup-end)
8476              (setq gnus-newsgroup-end number))
8477         (and (< number gnus-newsgroup-begin)
8478              (setq gnus-newsgroup-begin number))
8479         (setq gnus-newsgroup-unselected
8480               (delq number gnus-newsgroup-unselected)))
8481       ;; Report back a success.
8482       number)))
8483
8484 (defun gnus-summary-work-articles (n)
8485   "Return a list of articles to be worked upon.  The prefix argument,
8486 the list of process marked articles, and the current article will be
8487 taken into consideration."
8488   (cond
8489    ((and n (numberp n))
8490     ;; A numerical prefix has been given.
8491     (let ((backward (< n 0))
8492           (n (abs n))
8493           articles article)
8494       (save-excursion
8495         (while 
8496             (and (> n 0)
8497                  (push (setq article (gnus-summary-article-number))
8498                        articles)
8499                  (if backward
8500                      (gnus-summary-find-prev nil article)
8501                    (gnus-summary-find-next nil article)))
8502           (decf n)))
8503       (nreverse articles)))
8504    ((and (boundp 'transient-mark-mode)
8505          transient-mark-mode
8506          mark-active)
8507     ;; Work on the region between point and mark.
8508     (let ((max (max (point) (mark)))
8509           articles article)
8510       (save-excursion
8511         (goto-char (min (point) (mark)))
8512         (while 
8513             (and 
8514              (push (setq article (gnus-summary-article-number)) articles)
8515              (gnus-summary-find-next nil article)
8516              (< (point) max)))
8517         (nreverse articles))))
8518    (gnus-newsgroup-processable
8519     ;; There are process-marked articles present.
8520     (reverse gnus-newsgroup-processable))
8521    (t
8522     ;; Just return the current article.
8523     (list (gnus-summary-article-number)))))
8524
8525 (defun gnus-summary-search-group (&optional backward use-level)
8526   "Search for next unread newsgroup.
8527 If optional argument BACKWARD is non-nil, search backward instead."
8528   (save-excursion
8529     (set-buffer gnus-group-buffer)
8530     (if (gnus-group-search-forward 
8531          backward nil (if use-level (gnus-group-group-level) nil))
8532         (gnus-group-group-name))))
8533
8534 (defun gnus-summary-best-group (&optional exclude-group)
8535   "Find the name of the best unread group.
8536 If EXCLUDE-GROUP, do not go to this group."
8537   (save-excursion
8538     (set-buffer gnus-group-buffer)
8539     (save-excursion
8540       (gnus-group-best-unread-group exclude-group))))
8541
8542 (defun gnus-summary-find-next (&optional unread article backward)
8543   (if backward (gnus-summary-find-prev)
8544     (let* ((article (or article (gnus-summary-article-number)))
8545            (arts (gnus-data-find-list article))
8546            result)
8547       (when (or (not gnus-summary-check-current)
8548                 (not unread)
8549                 (not (gnus-data-unread-p (car arts))))
8550         (setq arts (cdr arts)))
8551       (when (setq result
8552                 (if unread
8553                     (progn
8554                       (while arts
8555                         (when (gnus-data-unread-p (car arts))
8556                           (setq result (car arts)
8557                                 arts nil))
8558                         (setq arts (cdr arts)))
8559                       result)
8560                   (car arts)))
8561         (goto-char (gnus-data-pos result))
8562         (gnus-data-number result)))))
8563
8564 (defun gnus-summary-find-prev (&optional unread article)
8565   (let* ((article (or article (gnus-summary-article-number)))
8566          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
8567          result)
8568     (when (or (not gnus-summary-check-current)
8569               (not unread)
8570               (not (gnus-data-unread-p (car arts))))
8571       (setq arts (cdr arts)))
8572     (if (setq result
8573               (if unread
8574                   (progn
8575                     (while arts
8576                       (and (gnus-data-unread-p (car arts))
8577                            (setq result (car arts)
8578                                  arts nil))
8579                       (setq arts (cdr arts)))
8580                     result)
8581                 (car arts)))
8582         (progn
8583           (goto-char (gnus-data-pos result))
8584           (gnus-data-number result)))))
8585
8586 (defun gnus-summary-find-subject (subject &optional unread backward article)
8587   (let* ((article (or article (gnus-summary-article-number)))
8588          (articles (gnus-data-list backward))
8589          (arts (gnus-data-find-list article articles))
8590          result)
8591     (when (or (not gnus-summary-check-current)
8592               (not unread)
8593               (not (gnus-data-unread-p (car arts))))
8594       (setq arts (cdr arts)))
8595     (while arts
8596       (and (or (not unread)
8597                (gnus-data-unread-p (car arts)))
8598            (vectorp (gnus-data-header (car arts)))
8599            (gnus-subject-equal 
8600             subject (mail-header-subject (gnus-data-header (car arts))))
8601            (setq result (car arts)
8602                  arts nil))
8603       (setq arts (cdr arts)))
8604     (and result
8605          (goto-char (gnus-data-pos result))
8606          (gnus-data-number result))))
8607
8608 (defun gnus-summary-search-forward (&optional unread subject backward)
8609   (cond (subject
8610          (gnus-summary-find-subject subject unread backward))
8611         (backward
8612          (gnus-summary-find-prev unread))
8613         (t
8614          (gnus-summary-find-next unread))))
8615
8616 (defun gnus-summary-recenter ()
8617   "Center point in the summary window.
8618 If `gnus-auto-center-summary' is nil, or the article buffer isn't
8619 displayed, no centering will be performed." 
8620   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
8621   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
8622   (let* ((top (cond ((< (window-height) 4) 0)
8623                     ((< (window-height) 7) 1)
8624                     (t 2)))
8625          (height (1- (window-height)))
8626          (bottom (save-excursion (goto-char (point-max))
8627                                  (forward-line (- height))
8628                                  (point)))
8629          (window (get-buffer-window (current-buffer))))
8630     (and 
8631      ;; The user has to want it,
8632      gnus-auto-center-summary 
8633      ;; the article buffer must be displayed,
8634      (get-buffer-window gnus-article-buffer)
8635      ;; Set the window start to either `bottom', which is the biggest
8636      ;; possible valid number, or the second line from the top,
8637      ;; whichever is the least.
8638      (set-window-start
8639       window (min bottom (save-excursion (forward-line (- top)) (point)))))))
8640
8641 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
8642 (defun gnus-short-group-name (group &optional levels)
8643   "Collapse GROUP name LEVELS."
8644   (let* ((name "") (foreign "") (depth -1) (skip 1)
8645          (levels (or levels
8646                      (progn
8647                        (while (string-match "\\." group skip)
8648                          (setq skip (match-end 0)
8649                                depth (+ depth 1)))
8650                        depth))))
8651     (if (string-match ":" group)
8652         (setq foreign (substring group 0 (match-end 0))
8653               group (substring group (match-end 0))))
8654     (while group
8655       (if (and (string-match "\\." group) (> levels 0))
8656           (setq name (concat name (substring group 0 1))
8657                 group (substring group (match-end 0))
8658                 levels (- levels 1)
8659                 name (concat name "."))
8660         (setq name (concat foreign name group)
8661               group nil)))
8662     name))
8663
8664 (defun gnus-summary-jump-to-group (newsgroup)
8665   "Move point to NEWSGROUP in group mode buffer."
8666   ;; Keep update point of group mode buffer if visible.
8667   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
8668       (save-window-excursion
8669         ;; Take care of tree window mode.
8670         (if (get-buffer-window gnus-group-buffer)
8671             (pop-to-buffer gnus-group-buffer))
8672         (gnus-group-jump-to-group newsgroup))
8673     (save-excursion
8674       ;; Take care of tree window mode.
8675       (if (get-buffer-window gnus-group-buffer)
8676           (pop-to-buffer gnus-group-buffer)
8677         (set-buffer gnus-group-buffer))
8678       (gnus-group-jump-to-group newsgroup))))
8679
8680 ;; This function returns a list of article numbers based on the
8681 ;; difference between the ranges of read articles in this group and
8682 ;; the range of active articles.
8683 (defun gnus-list-of-unread-articles (group)
8684   (let* ((read (gnus-info-read (gnus-get-info group)))
8685          (active (gnus-active group))
8686          (last (cdr active))
8687          first nlast unread)
8688     ;; If none are read, then all are unread. 
8689     (if (not read)
8690         (setq first (car active))
8691       ;; If the range of read articles is a single range, then the
8692       ;; first unread article is the article after the last read
8693       ;; article.  Sounds logical, doesn't it?
8694       (if (not (listp (cdr read)))
8695           (setq first (1+ (cdr read)))
8696         ;; `read' is a list of ranges.
8697         (if (/= (setq nlast (or (and (numberp (car read)) (car read)) 
8698                                 (car (car read)))) 1)
8699             (setq first 1))
8700         (while read
8701           (if first 
8702               (while (< first nlast)
8703                 (setq unread (cons first unread))
8704                 (setq first (1+ first))))
8705           (setq first (1+ (if (atom (car read)) (car read) (cdr (car read)))))
8706           (setq nlast (if (atom (car (cdr read))) 
8707                           (car (cdr read))
8708                         (car (car (cdr read)))))
8709           (setq read (cdr read)))))
8710     ;; And add the last unread articles.
8711     (while (<= first last)
8712       (setq unread (cons first unread))
8713       (setq first (1+ first)))
8714     ;; Return the list of unread articles.
8715     (nreverse unread)))
8716
8717 (defun gnus-list-of-read-articles (group)
8718   "Return a list of unread, unticked and non-dormant articles."
8719   (let* ((info (gnus-get-info group))
8720          (marked (gnus-info-marks info))
8721          (active (gnus-active group)))
8722     (and info active
8723          (gnus-set-difference
8724           (gnus-sorted-complement 
8725            (gnus-uncompress-range active) 
8726            (gnus-list-of-unread-articles group))
8727           (append 
8728            (gnus-uncompress-range (cdr (assq 'dormant marked)))
8729            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
8730
8731 ;; Various summary commands
8732
8733 (defun gnus-summary-universal-argument ()
8734   "Perform any operation on all articles marked with the process mark."
8735   (interactive)
8736   (gnus-set-global-variables)
8737   (let ((articles (reverse gnus-newsgroup-processable))
8738         func)
8739     (or articles (error "No articles marked"))
8740     (or (setq func (key-binding (read-key-sequence "C-c C-u")))
8741         (error "Undefined key"))
8742     (while articles
8743       (gnus-summary-goto-subject (car articles))
8744       (command-execute func)
8745       (gnus-summary-remove-process-mark (car articles))
8746       (setq articles (cdr articles)))))
8747
8748 (defun gnus-summary-toggle-truncation (&optional arg)
8749   "Toggle truncation of summary lines.
8750 With arg, turn line truncation on iff arg is positive."
8751   (interactive "P")
8752   (setq truncate-lines
8753         (if (null arg) (not truncate-lines)
8754           (> (prefix-numeric-value arg) 0)))
8755   (redraw-display))
8756
8757 (defun gnus-summary-reselect-current-group (&optional all)
8758   "Once exit and then reselect the current newsgroup.
8759 The prefix argument ALL means to select all articles."
8760   (interactive "P")
8761   (gnus-set-global-variables)
8762   (let ((current-subject (gnus-summary-article-number))
8763         (group gnus-newsgroup-name))
8764     (setq gnus-newsgroup-begin nil)
8765     (gnus-summary-exit t)
8766     ;; We have to adjust the point of group mode buffer because the
8767     ;; current point was moved to the next unread newsgroup by
8768     ;; exiting.
8769     (gnus-summary-jump-to-group group)
8770     (gnus-group-read-group all t)
8771     (gnus-summary-goto-subject current-subject)))
8772
8773 (defun gnus-summary-rescan-group (&optional all)
8774   "Exit the newsgroup, ask for new articles, and select the newsgroup."
8775   (interactive "P")
8776   (gnus-set-global-variables)
8777   ;; Fix by Ilja Weis <kult@uni-paderborn.de>.
8778   (let ((group gnus-newsgroup-name))
8779     (gnus-summary-exit)
8780     (gnus-summary-jump-to-group group)
8781     (save-excursion
8782       (set-buffer gnus-group-buffer)
8783       (gnus-group-get-new-news-this-group 1))
8784     (gnus-summary-jump-to-group group)
8785     (gnus-group-read-group all)))
8786
8787 (defun gnus-summary-update-info ()
8788   (let* ((group gnus-newsgroup-name))
8789     (when gnus-newsgroup-kill-headers
8790       (setq gnus-newsgroup-killed
8791             (gnus-compress-sequence
8792              (nconc
8793               (gnus-set-sorted-intersection
8794                (gnus-uncompress-range gnus-newsgroup-killed)
8795                (setq gnus-newsgroup-unselected
8796                      (sort gnus-newsgroup-unselected '<)))
8797               (setq gnus-newsgroup-unreads
8798                     (sort gnus-newsgroup-unreads '<))) t)))
8799     (unless (listp (cdr gnus-newsgroup-killed))
8800       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
8801     (let ((headers gnus-newsgroup-headers))
8802       (gnus-close-group group)
8803       (run-hooks 'gnus-exit-group-hook)
8804       (unless gnus-save-score
8805         (setq gnus-newsgroup-scored nil))
8806       ;; Set the new ranges of read articles.
8807       (gnus-update-read-articles
8808        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
8809       ;; Set the current article marks.
8810       (gnus-update-marks)
8811       ;; Do the cross-ref thing.
8812       (when gnus-use-cross-reference
8813         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
8814       ;; Do adaptive scoring, and possibly save score files.
8815       (when gnus-newsgroup-adaptive
8816         (gnus-score-adaptive))
8817       (when gnus-use-scoring 
8818         (gnus-score-save))
8819       ;; Do not switch windows but change the buffer to work.
8820       (set-buffer gnus-group-buffer)
8821       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
8822           (gnus-group-update-group group)))))
8823   
8824 (defun gnus-summary-exit (&optional temporary)
8825   "Exit reading current newsgroup, and then return to group selection mode.
8826 gnus-exit-group-hook is called with no arguments if that value is non-nil."
8827   (interactive)
8828   (gnus-set-global-variables)
8829   (gnus-kill-save-kill-buffer)
8830   (let* ((group gnus-newsgroup-name)
8831          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
8832          (mode major-mode)
8833          (buf (current-buffer)))
8834     (run-hooks 'gnus-summary-prepare-exit-hook)
8835     ;; Make all changes in this group permanent.
8836     (gnus-summary-update-info)          
8837     (set-buffer buf)
8838     (and gnus-use-cache (gnus-cache-possibly-remove-articles))
8839     ;; Make sure where I was, and go to next newsgroup.
8840     (set-buffer gnus-group-buffer)
8841     (or quit-config
8842         (progn
8843           (gnus-group-jump-to-group group)
8844           (gnus-group-next-unread-group 1)))
8845     (if temporary
8846         nil                             ;Nothing to do.
8847       ;; We set all buffer-local variables to nil.  It is unclear why
8848       ;; this is needed, but if we don't, buffer-local variables are
8849       ;; not garbage-collected, it seems.  This would the lead to en
8850       ;; ever-growing Emacs.
8851       (set-buffer buf)
8852       (gnus-summary-clear-local-variables)
8853       ;; We clear the global counterparts of the buffer-local
8854       ;; variables as well, just to be on the safe side.
8855       (gnus-configure-windows 'group 'force)
8856       (gnus-summary-clear-local-variables)
8857       ;; Return to group mode buffer. 
8858       (if (eq mode 'gnus-summary-mode)
8859           (gnus-kill-buffer buf))
8860       (if (get-buffer gnus-article-buffer)
8861           (bury-buffer gnus-article-buffer))
8862       (setq gnus-current-select-method gnus-select-method)
8863       (pop-to-buffer gnus-group-buffer)
8864       (if (not quit-config)
8865           (progn
8866             (gnus-group-jump-to-group group)
8867             (gnus-group-next-unread-group 1))
8868         (if (not (buffer-name (car quit-config)))
8869             (gnus-configure-windows 'group 'force)
8870           (set-buffer (car quit-config))
8871           (and (eq major-mode 'gnus-summary-mode)
8872                (gnus-set-global-variables))
8873           (gnus-configure-windows (cdr quit-config))))
8874       (run-hooks 'gnus-summary-exit-hook))))
8875
8876 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
8877 (defun gnus-summary-exit-no-update (&optional no-questions)
8878   "Quit reading current newsgroup without updating read article info."
8879   (interactive)
8880   (gnus-set-global-variables)
8881   (let* ((group gnus-newsgroup-name)
8882          (quit-config (gnus-group-quit-config group)))
8883     (if (or no-questions
8884             gnus-expert-user
8885             (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
8886         (progn
8887           (gnus-close-group group)
8888           (gnus-summary-clear-local-variables)
8889           (set-buffer gnus-group-buffer)
8890           (gnus-summary-clear-local-variables)
8891           ;; Return to group selection mode.
8892           (gnus-configure-windows 'group 'force)
8893           (if (get-buffer gnus-summary-buffer)
8894               (kill-buffer gnus-summary-buffer))
8895           (if (get-buffer gnus-article-buffer)
8896               (bury-buffer gnus-article-buffer))
8897           (if (equal (gnus-group-group-name) group)
8898               (gnus-group-next-unread-group 1))
8899           (if quit-config
8900               (progn
8901                 (if (not (buffer-name (car quit-config)))
8902                     (gnus-configure-windows 'group 'force)
8903                   (set-buffer (car quit-config))
8904                   (and (eq major-mode 'gnus-summary-mode)
8905                        (gnus-set-global-variables))
8906                   (gnus-configure-windows (cdr quit-config)))))))))
8907
8908 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
8909 (defun gnus-summary-fetch-faq (&optional faq-dir)
8910   "Fetch the FAQ for the current group.
8911 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
8912 in."
8913   (interactive 
8914    (list
8915     (if current-prefix-arg
8916         (completing-read 
8917          "Faq dir: " (and (listp gnus-group-faq-directory)
8918                           gnus-group-faq-directory)))))
8919   (let (gnus-faq-buffer)
8920     (and (setq gnus-faq-buffer 
8921                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
8922          (gnus-configure-windows 'summary-faq))))
8923
8924 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
8925 (defun gnus-summary-describe-group (&optional force)
8926   "Describe the current newsgroup."
8927   (interactive "P")
8928   (gnus-group-describe-group force gnus-newsgroup-name))
8929
8930 (defun gnus-summary-describe-briefly ()
8931   "Describe summary mode commands briefly."
8932   (interactive)
8933   (gnus-message 6
8934                 (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")))
8935
8936 ;; Walking around group mode buffer from summary mode.
8937
8938 (defun gnus-summary-next-group (&optional no-article target-group backward)
8939   "Exit current newsgroup and then select next unread newsgroup.
8940 If prefix argument NO-ARTICLE is non-nil, no article is selected
8941 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
8942 previous group instead."
8943   (interactive "P")
8944   (gnus-set-global-variables)
8945   (let ((current-group gnus-newsgroup-name)
8946         (current-buffer (current-buffer))
8947         entered)
8948     ;; First we semi-exit this group to update Xrefs and all variables.
8949     ;; We can't do a real exit, because the window conf must remain
8950     ;; the same in case the user is prompted for info, and we don't
8951     ;; want the window conf to change before that...
8952     (gnus-summary-exit t)
8953     (while (not entered)
8954       ;; Then we find what group we are supposed to enter.
8955       (set-buffer gnus-group-buffer)
8956       (gnus-group-jump-to-group current-group)
8957       (setq target-group 
8958             (or target-group        
8959                 (if (eq gnus-keep-same-level 'best) 
8960                     (gnus-summary-best-group gnus-newsgroup-name)
8961                   (gnus-summary-search-group backward gnus-keep-same-level))))
8962       (if (not target-group)
8963           ;; There are no further groups, so we return to the group
8964           ;; buffer.
8965           (progn
8966             (gnus-message 5 "Returning to the group buffer")
8967             (setq entered t)
8968             (set-buffer current-buffer)
8969             (gnus-summary-exit))
8970         ;; We try to enter the target group.
8971         (gnus-group-jump-to-group target-group)
8972         (let ((unreads (gnus-group-group-unread)))
8973           (if (and (or (eq t unreads)
8974                        (and unreads (not (zerop unreads))))
8975                    (gnus-summary-read-group
8976                     target-group nil no-article current-buffer))
8977               (setq entered t)
8978             (setq current-group target-group
8979                   target-group nil)))))))
8980
8981 (defun gnus-summary-prev-group (&optional no-article)
8982   "Exit current newsgroup and then select previous unread newsgroup.
8983 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
8984   (interactive "P")
8985   (gnus-summary-next-group no-article nil t))
8986
8987 ;; Walking around summary lines.
8988
8989 (defun gnus-summary-first-subject (&optional unread)
8990   "Go to the first unread subject.
8991 If UNREAD is non-nil, go to the first unread article.
8992 Returns the article selected or nil if there are no unread articles."
8993   (interactive "P")
8994   (prog1
8995       (cond 
8996        ;; Empty summary.
8997        ((null gnus-newsgroup-data)
8998         (gnus-message 3 "No articles in the group")
8999         nil)
9000        ;; Pick the first article.
9001        ((not unread)
9002         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
9003         (gnus-data-number (car gnus-newsgroup-data)))
9004        ;; No unread articles.
9005        ((null gnus-newsgroup-unreads)
9006         (gnus-message 3 "No more unread articles")
9007         nil)
9008        ;; Find the first unread article.
9009        (t
9010         (let ((data gnus-newsgroup-data))
9011           (while (and data
9012                       (not (gnus-data-unread-p (car data))))
9013             (setq data (cdr data)))
9014           (if data
9015               (progn
9016                 (goto-char (gnus-data-pos (car data)))
9017                 (gnus-data-number (car data)))))))
9018     (gnus-summary-position-point)))
9019
9020 (defun gnus-summary-next-subject (n &optional unread dont-display)
9021   "Go to next N'th summary line.
9022 If N is negative, go to the previous N'th subject line.
9023 If UNREAD is non-nil, only unread articles are selected.
9024 The difference between N and the actual number of steps taken is
9025 returned."
9026   (interactive "p")
9027   (let ((backward (< n 0))
9028         (n (abs n)))
9029     (while (and (> n 0)
9030                 (if backward
9031                     (gnus-summary-find-prev unread)
9032                   (gnus-summary-find-next unread)))
9033       (setq n (1- n)))
9034     (if (/= 0 n) (gnus-message 7 "No more%s articles"
9035                                (if unread " unread" "")))
9036     (or dont-display
9037         (progn
9038           (gnus-summary-recenter)
9039           (gnus-summary-position-point)))
9040     n))
9041
9042 (defun gnus-summary-next-unread-subject (n)
9043   "Go to next N'th unread summary line."
9044   (interactive "p")
9045   (gnus-summary-next-subject n t))
9046
9047 (defun gnus-summary-prev-subject (n &optional unread)
9048   "Go to previous N'th summary line.
9049 If optional argument UNREAD is non-nil, only unread article is selected."
9050   (interactive "p")
9051   (gnus-summary-next-subject (- n) unread))
9052
9053 (defun gnus-summary-prev-unread-subject (n)
9054   "Go to previous N'th unread summary line."
9055   (interactive "p")
9056   (gnus-summary-next-subject (- n) t))
9057
9058 (defun gnus-summary-goto-subject (article &optional force silent)
9059   "Go the subject line of ARTICLE.
9060 If FORCE, also allow jumping to articles not currently shown."
9061   (let ((b (point))
9062         (data (gnus-data-find article)))
9063     ;; We read in the article if we have to.
9064     (and (not data) 
9065          force
9066          (gnus-summary-insert-subject article)
9067          (setq data (gnus-data-find article)))
9068     (goto-char b)
9069     (if (and (not silent) (not data))
9070         (progn
9071           (message "Can't find article %d" article)
9072           nil)
9073       (goto-char (gnus-data-pos data))
9074       article)))
9075
9076 ;; Walking around summary lines with displaying articles.
9077
9078 (defun gnus-summary-expand-window (&optional arg)
9079   "Make the summary buffer take up the entire Emacs frame.
9080 Given a prefix, will force an `article' buffer configuration."
9081   (interactive "P")
9082   (gnus-set-global-variables)
9083   (if arg
9084       (gnus-configure-windows 'article 'force)
9085     (gnus-configure-windows 'summary 'force)))
9086
9087 (defun gnus-summary-display-article (article &optional all-header)
9088   "Display ARTICLE in article buffer."
9089   (gnus-set-global-variables)
9090   (if (null article)
9091       nil
9092     (prog1
9093         (gnus-article-prepare article all-header)
9094       (gnus-summary-show-thread)
9095       (run-hooks 'gnus-select-article-hook)
9096       (gnus-summary-recenter)
9097       (gnus-summary-goto-subject article)
9098       ;; Successfully display article.
9099       (gnus-summary-update-line)
9100       (gnus-article-set-window-start 
9101        (cdr (assq article gnus-newsgroup-bookmarks)))
9102       t)))
9103
9104 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
9105   "Select the current article.
9106 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
9107 non-nil, the article will be re-fetched even if it already present in
9108 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
9109 be displayed."
9110   (let ((article (or article (gnus-summary-article-number)))
9111         (all-headers (not (not all-headers))) ;Must be T or NIL.
9112         did) 
9113     (and (not pseudo) 
9114          (gnus-summary-article-pseudo-p article)
9115          (error "This is a pseudo-article."))
9116     (prog1
9117         (save-excursion
9118           (set-buffer gnus-summary-buffer)
9119           (if (or (null gnus-current-article)
9120                   (null gnus-article-current)
9121                   (null (get-buffer gnus-article-buffer))
9122                   (not (eq article (cdr gnus-article-current)))
9123                   (not (equal (car gnus-article-current) gnus-newsgroup-name))
9124                   force)
9125               ;; The requested article is different from the current article.
9126               (progn
9127                 (gnus-summary-display-article article all-headers)
9128                 (setq did article))
9129             (if (or all-headers gnus-show-all-headers) 
9130                 (gnus-article-show-all-headers))
9131             nil))
9132       (if did 
9133           (gnus-article-set-window-start 
9134            (cdr (assq article gnus-newsgroup-bookmarks)))))))
9135
9136 (defun gnus-summary-set-current-mark (&optional current-mark)
9137   "Obsolete function."
9138   nil)
9139
9140 (defun gnus-summary-next-article (&optional unread subject backward)
9141   "Select the next article.
9142 If UNREAD, only unread articles are selected.
9143 If SUBJECT, only articles with SUBJECT are selected.
9144 If BACKWARD, the previous article is selected instead of the next."
9145   (interactive "P")
9146   (gnus-set-global-variables)
9147   (let (header)
9148     (cond
9149      ;; Is there such an article?
9150      ((and (gnus-summary-search-forward unread subject backward)
9151            (or (gnus-summary-display-article (gnus-summary-article-number))
9152                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9153       (gnus-summary-position-point))
9154      ;; If not, we try the first unread, if that is wanted.
9155      ((and subject
9156            gnus-auto-select-same
9157            (or (gnus-summary-first-unread-article)
9158                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9159       (gnus-summary-position-point)
9160       (gnus-message 6 "Wrapped"))
9161      ;; Try to get next/previous article not displayed in this group.
9162      ((and gnus-auto-extend-newsgroup
9163            (not unread) (not subject))
9164       (gnus-summary-goto-article 
9165        (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
9166        nil t))
9167      ;; Go to next/previous group.
9168      (t
9169       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9170           (gnus-summary-jump-to-group gnus-newsgroup-name))
9171       (let ((cmd last-command-char)
9172             (group 
9173              (if (eq gnus-keep-same-level 'best) 
9174                  (gnus-summary-best-group gnus-newsgroup-name)
9175                (gnus-summary-search-group backward gnus-keep-same-level))))
9176         ;; For some reason, the group window gets selected.  We change
9177         ;; it back.  
9178         (select-window (get-buffer-window (current-buffer)))
9179         ;; Keep just the event type of CMD.
9180                                         ;(and (listp cmd) (setq cmd (car cmd)))
9181         ;; Select next unread newsgroup automagically.
9182         (cond 
9183          ((not gnus-auto-select-next)
9184           (gnus-message 7 "No more%s articles" (if unread " unread" "")))
9185          ((or (eq gnus-auto-select-next 'quietly)
9186               (and (eq gnus-auto-select-next 'almost-quietly)
9187                    (gnus-summary-last-article-p)))
9188           ;; Select quietly.
9189           (if (gnus-ephemeral-group-p gnus-newsgroup-name)
9190               (gnus-summary-exit)
9191             (gnus-message 7 "No more%s articles (%s)..."
9192                           (if unread " unread" "") 
9193                           (if group (concat "selecting " group)
9194                             "exiting"))
9195             (gnus-summary-next-group nil group backward)))
9196          (t
9197           (let ((keystrokes '(?\C-n ?\C-p))
9198                 key)
9199             (while (or (null key) (memq key keystrokes))
9200               (gnus-message 
9201                7 "No more%s articles%s" (if unread " unread" "")
9202                (if (and group 
9203                         (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
9204                    (format " (Type %s for %s [%s])"
9205                            (single-key-description cmd) group
9206                            (car (gnus-gethash group gnus-newsrc-hashtb)))
9207                  (format " (Type %s to exit %s)"
9208                          (single-key-description cmd)
9209                          gnus-newsgroup-name)))
9210               ;; Confirm auto selection.
9211               (let* ((event (read-char-exclusive)))
9212                 (setq key (if (listp event) (car event) event))
9213                 (if (memq key keystrokes)
9214                     (let ((obuf (current-buffer)))
9215                       (switch-to-buffer gnus-group-buffer)
9216                       (and group
9217                            (gnus-group-jump-to-group group))
9218                       (condition-case ()
9219                           (cond ((= key ?\C-n)
9220                                  (gnus-group-next-unread-group 1))
9221                                 ((= key ?\C-p)
9222                                  (gnus-group-prev-unread-group 1)))
9223                         (error (ding) nil))
9224                       (setq group (gnus-group-group-name))
9225                       (switch-to-buffer obuf)))))
9226             (if (equal key cmd)
9227                 (if (or (not group)
9228                         (gnus-ephemeral-group-p gnus-newsgroup-name))
9229                     (gnus-summary-exit)
9230                   (gnus-summary-next-group nil group backward))
9231               (execute-kbd-macro (char-to-string key)))))))))))
9232
9233 (defun gnus-summary-next-unread-article ()
9234   "Select unread article after current one."
9235   (interactive)
9236   (gnus-summary-next-article t (and gnus-auto-select-same
9237                                     (gnus-summary-article-subject))))
9238
9239 (defun gnus-summary-prev-article (&optional unread subject)
9240   "Select the article after the current one.
9241 If UNREAD is non-nil, only unread articles are selected."
9242   (interactive "P")
9243   (gnus-summary-next-article unread subject t))
9244
9245 (defun gnus-summary-prev-unread-article ()
9246   "Select unred article before current one."
9247   (interactive)
9248   (gnus-summary-prev-article t (and gnus-auto-select-same
9249                                     (gnus-summary-article-subject))))
9250
9251 (defun gnus-summary-next-page (&optional lines circular)
9252   "Show next page of selected article.
9253 If end of article, select next article.
9254 Argument LINES specifies lines to be scrolled up.
9255 If CIRCULAR is non-nil, go to the start of the article instead of 
9256 instead of selecting the next article when reaching the end of the
9257 current article." 
9258   (interactive "P")
9259   (setq gnus-summary-buffer (current-buffer))
9260   (gnus-set-global-variables)
9261   (let ((article (gnus-summary-article-number))
9262         (endp nil))
9263     (gnus-configure-windows 'article)
9264     (if (or (null gnus-current-article)
9265             (null gnus-article-current)
9266             (/= article (cdr gnus-article-current))
9267             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9268         ;; Selected subject is different from current article's.
9269         (gnus-summary-display-article article)
9270       (gnus-eval-in-buffer-window
9271        gnus-article-buffer
9272        (setq endp (gnus-article-next-page lines)))
9273       (if endp
9274           (cond (circular
9275                  (gnus-summary-beginning-of-article))
9276                 (lines
9277                  (gnus-message 3 "End of message"))
9278                 ((null lines)
9279                  (gnus-summary-next-unread-article)))))
9280     (gnus-summary-recenter)
9281     (gnus-summary-position-point)))
9282
9283 (defun gnus-summary-prev-page (&optional lines)
9284   "Show previous page of selected article.
9285 Argument LINES specifies lines to be scrolled down."
9286   (interactive "P")
9287   (gnus-set-global-variables)
9288   (let ((article (gnus-summary-article-number)))
9289     (gnus-configure-windows 'article)
9290     (if (or (null gnus-current-article)
9291             (null gnus-article-current)
9292             (/= article (cdr gnus-article-current))
9293             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9294         ;; Selected subject is different from current article's.
9295         (gnus-summary-display-article article)
9296       (gnus-summary-recenter)
9297       (gnus-eval-in-buffer-window gnus-article-buffer
9298                                   (gnus-article-prev-page lines))))
9299   (gnus-summary-position-point))
9300
9301 (defun gnus-summary-scroll-up (lines)
9302   "Scroll up (or down) one line current article.
9303 Argument LINES specifies lines to be scrolled up (or down if negative)."
9304   (interactive "p")
9305   (gnus-set-global-variables)
9306   (gnus-configure-windows 'article)
9307   (or (gnus-summary-select-article nil nil 'pseudo)
9308       (gnus-eval-in-buffer-window 
9309        gnus-article-buffer
9310        (cond ((> lines 0)
9311               (if (gnus-article-next-page lines)
9312                   (gnus-message 3 "End of message")))
9313              ((< lines 0)
9314               (gnus-article-prev-page (- lines))))))
9315   (gnus-summary-recenter)
9316   (gnus-summary-position-point))
9317
9318 (defun gnus-summary-next-same-subject ()
9319   "Select next article which has the same subject as current one."
9320   (interactive)
9321   (gnus-set-global-variables)
9322   (gnus-summary-next-article nil (gnus-summary-article-subject)))
9323
9324 (defun gnus-summary-prev-same-subject ()
9325   "Select previous article which has the same subject as current one."
9326   (interactive)
9327   (gnus-set-global-variables)
9328   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
9329
9330 (defun gnus-summary-next-unread-same-subject ()
9331   "Select next unread article which has the same subject as current one."
9332   (interactive)
9333   (gnus-set-global-variables)
9334   (gnus-summary-next-article t (gnus-summary-article-subject)))
9335
9336 (defun gnus-summary-prev-unread-same-subject ()
9337   "Select previous unread article which has the same subject as current one."
9338   (interactive)
9339   (gnus-set-global-variables)
9340   (gnus-summary-prev-article t (gnus-summary-article-subject)))
9341
9342 (defun gnus-summary-first-unread-article ()
9343   "Select the first unread article. 
9344 Return nil if there are no unread articles."
9345   (interactive)
9346   (gnus-set-global-variables)
9347   (prog1
9348       (if (gnus-summary-first-subject t)
9349           (progn
9350             (gnus-summary-show-thread)
9351             (gnus-summary-first-subject t)
9352             (gnus-summary-display-article (gnus-summary-article-number))))
9353     (gnus-summary-position-point)))
9354
9355 (defun gnus-summary-best-unread-article ()
9356   "Select the unread article with the highest score."
9357   (interactive)
9358   (gnus-set-global-variables)
9359   (let ((best -1000000)
9360         (data gnus-newsgroup-data)
9361         article score)
9362     (while data
9363       (and (gnus-data-unread-p (car data))
9364            (> (setq score 
9365                     (gnus-summary-article-score (gnus-data-number (car data))))
9366               best)
9367            (setq best score
9368                  article (gnus-data-number (car data))))
9369       (setq data (cdr data)))
9370     (if article
9371         (gnus-summary-goto-article article)
9372       (error "No unread articles"))
9373     (gnus-summary-position-point)))
9374
9375 (defun gnus-summary-goto-article (article &optional all-headers force)
9376   "Fetch ARTICLE and display it if it exists.
9377 If ALL-HEADERS is non-nil, no header lines are hidden."
9378   (interactive
9379    (list
9380     (string-to-int
9381      (completing-read 
9382       "Article number: "
9383       (mapcar (lambda (number) (list (int-to-string number)))
9384               gnus-newsgroup-limit)))
9385     current-prefix-arg
9386     t))
9387   (prog1
9388       (if (gnus-summary-goto-subject article force)
9389           (gnus-summary-display-article article all-headers)
9390         (message "Couldn't go to article %s" article) nil)
9391     (gnus-summary-position-point)))
9392
9393 (defun gnus-summary-goto-last-article ()
9394   "Go to the previously read article."
9395   (interactive)
9396   (prog1
9397       (and gnus-last-article
9398            (gnus-summary-goto-article gnus-last-article))
9399     (gnus-summary-position-point)))
9400
9401 (defun gnus-summary-pop-article (number)
9402   "Pop one article off the history and go to the previous.
9403 NUMBER articles will be popped off."
9404   (interactive "p")
9405   (let (to)
9406     (setq gnus-newsgroup-history
9407           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
9408     (if to
9409         (gnus-summary-goto-article (car to))
9410       (error "Article history empty")))
9411   (gnus-summary-position-point))
9412
9413 ;; Summary commands and functions for limiting the summary buffer.
9414
9415 (defun gnus-summary-limit-to-articles (n)
9416   "Limit the summary buffer to the next N articles.
9417 If not given a prefix, use the process marked articles instead."
9418   (interactive "P")
9419   (gnus-set-global-variables)
9420   (prog1
9421       (let ((articles (gnus-summary-work-articles n)))
9422         (gnus-summary-limit articles))
9423     (gnus-summary-position-point)))
9424
9425 (defun gnus-summary-pop-limit (&optional total)
9426   "Restore the previous limit.
9427 If given a prefix, remove all limits."
9428   (interactive "P")
9429   (gnus-set-global-variables)
9430   (prog2
9431       (if total (setq gnus-newsgroup-limits 
9432                       (list (mapcar (lambda (h) (mail-header-number h))
9433                                     gnus-newsgroup-headers))))
9434       (gnus-summary-limit nil 'pop)
9435     (gnus-summary-position-point)))
9436
9437 (defun gnus-summary-limit-to-subject (subject)
9438   "Limit the summary buffer to articles that have subjects that match a regexp."
9439   (interactive "sRegexp: ")
9440   (when (not (equal "" subject))
9441     (prog1
9442         (let ((articles (gnus-summary-find-matching "subject" subject 'all)))
9443           (or articles (error "Found no matches for \"%s\"" subject))
9444           (gnus-summary-limit articles))
9445       (gnus-summary-position-point))))
9446
9447 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
9448 (make-obsolete 
9449  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
9450
9451 (defun gnus-summary-limit-to-unread (&optional all)
9452   "Limit the summary buffer to articles that are not marked as read.
9453 If ALL is non-nil, limit strictly to unread articles."
9454   (interactive "P")
9455   (if all
9456       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
9457     (gnus-summary-limit-to-marks
9458      ;; Concat all the marks that say that an article is read and have
9459      ;; those removed.  
9460      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
9461            gnus-killed-mark gnus-kill-file-mark
9462            gnus-low-score-mark gnus-expirable-mark
9463            gnus-canceled-mark gnus-catchup-mark)
9464      'reverse)))
9465
9466 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
9467 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
9468
9469 (defun gnus-summary-limit-to-marks (marks &optional reverse)
9470   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
9471 If REVERSE, limit the summary buffer to articles that are not marked
9472 with MARKS.  MARKS can either be a string of marks or a list of marks. 
9473 Returns how many articles were removed."
9474   (interactive "sMarks: ")
9475   (gnus-set-global-variables)
9476   (prog1
9477       (let ((data gnus-newsgroup-data)
9478             (marks (if (listp marks) marks
9479                      (append marks nil))) ; Transform to list.
9480             articles)
9481         (while data
9482           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
9483                  (memq (gnus-data-mark (car data)) marks))
9484                (setq articles (cons (gnus-data-number (car data)) articles)))
9485           (setq data (cdr data)))
9486         (gnus-summary-limit articles))
9487     (gnus-summary-position-point)))
9488
9489 (defun gnus-summary-limit-to-score (&optional score)
9490   "Limit to articles with score at or above SCORE."
9491   (interactive "P")
9492   (gnus-set-global-variables)
9493   (setq score (if score
9494                   (prefix-numeric-value score)
9495                 (or gnus-summary-default-score 0)))
9496   (let ((data gnus-newsgroup-data)
9497         articles)
9498     (while data
9499       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
9500                 score)
9501         (push (gnus-data-number (car data)) articles))
9502       (setq data (cdr data)))
9503     (prog1
9504         (gnus-summary-limit articles)
9505       (gnus-summary-position-point))))
9506
9507 (defun gnus-summary-limit-include-dormant ()
9508   "Display all the hidden articles that are marked as dormant."
9509   (interactive)
9510   (gnus-set-global-variables)
9511   (or gnus-newsgroup-dormant 
9512       (error "There are no dormant articles in this group"))
9513   (prog1
9514       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
9515     (gnus-summary-position-point)))
9516
9517 (defun gnus-summary-limit-exclude-dormant ()
9518   "Hide all dormant articles."
9519   (interactive)
9520   (gnus-set-global-variables)
9521   (prog1
9522       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
9523     (gnus-summary-position-point)))
9524
9525 (defun gnus-summary-limit-exclude-childless-dormant ()
9526   "Hide all dormant articles that have no children."
9527   (interactive)
9528   (gnus-set-global-variables)
9529   (let ((data gnus-newsgroup-data)
9530         articles)
9531     ;; Find all articles that are either not dormant or have
9532     ;; children. 
9533     (while data
9534       (and (or (not (= (gnus-data-mark (car data)) gnus-dormant-mark))
9535                (gnus-article-parent-p (gnus-data-number (car data))))
9536            (setq articles (cons (gnus-data-number (car data))
9537                                 articles)))
9538       (setq data (cdr data)))
9539     ;; Do the limiting.
9540     (prog1
9541         (gnus-summary-limit articles)
9542       (gnus-summary-position-point))))
9543  
9544 (defun gnus-summary-limit (articles &optional pop)
9545   (if pop
9546       ;; We pop the previous limit off the stack and use that.
9547       (setq articles (car gnus-newsgroup-limits)
9548             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
9549     ;; We use the new limit, so we push the old limit on the stack. 
9550     (setq gnus-newsgroup-limits 
9551           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
9552   ;; Set the limit.
9553   (setq gnus-newsgroup-limit articles)
9554   (let ((total (length gnus-newsgroup-data))
9555         (data (gnus-data-find-list (gnus-summary-article-number)))
9556         found)
9557     ;; This will do all the work of generating the new summary buffer
9558     ;; according to the new limit.
9559     (gnus-summary-prepare)
9560     ;; Try to return to the article you were at, or on in the
9561     ;; neighborhood.  
9562     (if data
9563         ;; We try to find some article after the current one.
9564         (while data
9565           (and (gnus-summary-goto-subject (gnus-data-number (car data)))
9566                (setq data nil
9567                      found t))
9568           (setq data (cdr data))))
9569     (or found
9570         ;; If there is no data, that means that we were after the last
9571         ;; article.  The same goes when we can't find any articles
9572         ;; after the current one.
9573         (progn
9574           (goto-char (point-max))
9575           (gnus-summary-find-prev)))
9576     ;; We return how many articles were removed from the summary
9577     ;; buffer as a result of the new limit.
9578     (- total (length gnus-newsgroup-data))))
9579
9580 (defun gnus-summary-initial-limit ()
9581   "Figure out what the initial limit is supposed to be on group entry.
9582 This entails weeding out unwanted dormants, low-scored articles,
9583 fetch-old-headers verbiage, and so on."
9584   ;; Most groups have nothing to remove.
9585   (if (and (null gnus-newsgroup-dormant)
9586            (not (eq gnus-fetch-old-headers 'some))
9587            (null gnus-summary-expunge-below))
9588       () ; Do nothing.
9589     (setq gnus-newsgroup-limits 
9590           (cons gnus-newsgroup-limit gnus-newsgroup-limits))
9591     (setq gnus-newsgroup-limit nil)
9592     (mapatoms
9593      (lambda (node)
9594        (if (null (car (symbol-value node)))
9595            (let ((nodes (cdr (symbol-value node))))
9596              (while nodes
9597                (gnus-summary-limit-children (car nodes))
9598                (setq nodes (cdr nodes))))))
9599      gnus-newsgroup-dependencies)
9600     (when (not gnus-newsgroup-limit)
9601       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
9602     gnus-newsgroup-limit))
9603
9604 (defun gnus-summary-limit-children (thread)
9605   "Return 1 if this subthread is visible and 0 if it is not."
9606   ;; First we get the number of visible children to this thread.  This
9607   ;; is done by recursing down the thread using this function, so this
9608   ;; will really go down to a leaf article first, before slowly
9609   ;; working its way up towards the root.
9610   (let ((children 
9611          (if (cdr thread)
9612              (apply '+ (mapcar (lambda (th)
9613                                  (gnus-summary-limit-children th))
9614                                (cdr thread)))
9615            0))
9616         (number (mail-header-number (car thread)))
9617         score)
9618     (if (or 
9619          ;; If this article is dormant and has absolutely no visible
9620          ;; children, then this article isn't visible.
9621          (and (memq number gnus-newsgroup-dormant)
9622               (= children 0))
9623          ;; If this is a "fetch-old-headered" and there is only one
9624          ;; visible child (or less), then we don't want this article. 
9625          (and (eq gnus-fetch-old-headers 'some)
9626               (memq number gnus-newsgroup-ancient)
9627               (<= children 1))
9628          ;; If we use expunging, and this article is really
9629          ;; low-scored, then we don't want this article.
9630          (when (and gnus-summary-expunge-below
9631                     (< (setq score 
9632                              (or (cdr (assq number gnus-newsgroup-scored)) 
9633                                  gnus-summary-default-score))
9634                        gnus-summary-expunge-below))
9635            ;; We increase the expunge-tally here, but that has
9636            ;; nothing to do with the limits, really.
9637            (incf gnus-newsgroup-expunged-tally)
9638            ;; We also mark as read here, if that's wanted.
9639            (when (and gnus-summary-mark-below
9640                       (< score gnus-summary-mark-below))
9641              (setq gnus-newsgroup-unreads 
9642                    (delq number gnus-newsgroup-unreads))
9643              (push (cons number gnus-low-score-mark) gnus-newsgroup-reads))
9644            t))
9645         ;; Nope, invisible article.
9646         0
9647       ;; Ok, this article is to be visible, so we add it to the limit
9648       ;; and return 1.
9649       (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
9650       1)))
9651
9652 ;; Summary article oriented commands
9653
9654 (defun gnus-summary-refer-parent-article (n)
9655   "Refer parent article N times.
9656 The difference between N and the number of articles fetched is returned."
9657   (interactive "p")
9658   (gnus-set-global-variables)
9659   (while 
9660       (and 
9661        (> n 0)
9662        (let* ((header (gnus-summary-article-header))
9663               (ref 
9664                ;; If we try to find the parent of the currently
9665                ;; displayed article, then we take a look at the actual
9666                ;; References header, since this is slightly more
9667                ;; reliable than the References field we got from the
9668                ;; server. 
9669                (if (and (eq (mail-header-number header) 
9670                             (cdr gnus-article-current))
9671                         (equal gnus-newsgroup-name 
9672                                (car gnus-article-current)))
9673                    (save-excursion
9674                      (set-buffer gnus-original-article-buffer)
9675                      (gnus-narrow-to-headers)
9676                      (prog1
9677                          (mail-fetch-field "references")
9678                        (widen)))
9679                  ;; It's not the current article, so we take a bet on
9680                  ;; the value we got from the server. 
9681                  (mail-header-references header))))
9682          (if ref
9683              (or (gnus-summary-refer-article (gnus-parent-id ref))
9684                  (gnus-message 1 "Couldn't find parent"))
9685            (gnus-message 1 "No references in article %d"
9686                          (gnus-summary-article-number))
9687            nil)))
9688     (setq n (1- n)))
9689   (gnus-summary-position-point)
9690   n)
9691
9692 (defun gnus-summary-refer-references ()
9693   "Fetch all articles mentioned in the References header.
9694 Return how many articles were fetched."
9695   (interactive)
9696   (gnus-set-global-variables)
9697   (let ((ref (mail-header-references (gnus-summary-article-header)))
9698         (current (gnus-summary-article-number))
9699         (n 0))
9700     ;; For each Message-ID in the References header...
9701     (while (string-match "<[^>]*>" ref)
9702       (incf n)
9703       ;; ... fetch that article.
9704       (gnus-summary-refer-article 
9705        (prog1 (match-string 0 ref)
9706          (setq ref (substring ref (match-end 0))))))
9707     (gnus-summary-goto-subject current)
9708     (gnus-summary-position-point)
9709     n))
9710     
9711 (defun gnus-summary-refer-article (message-id)
9712   "Fetch an article specified by MESSAGE-ID."
9713   (interactive "sMessage-ID: ")
9714   (when (and (stringp message-id)
9715              (not (zerop (length message-id))))
9716     ;; Construct the correct Message-ID if necessary.
9717     ;; Suggested by tale@pawl.rpi.edu.
9718     (unless (string-match "^<" message-id)
9719       (setq message-id (concat "<" message-id)))
9720     (unless (string-match ">$" message-id)
9721       (setq message-id (concat message-id ">")))
9722     (let ((header (car (gnus-gethash (downcase message-id)
9723                                      gnus-newsgroup-dependencies))))
9724       (if header
9725           ;; The article is present in the buffer, to we just go to it.
9726           (gnus-summary-goto-article (mail-header-number header) nil t)
9727         ;; We fetch the article
9728         (let ((gnus-override-method gnus-refer-article-method)
9729               number)
9730           ;; Start the special refer-article method, if necessary.
9731           (when gnus-refer-article-method
9732             (gnus-check-server gnus-refer-article-method))
9733           ;; Fetch the header, and display the article.
9734           (when (setq number (gnus-summary-insert-subject message-id))
9735             (gnus-summary-select-article nil nil nil number)))))))
9736
9737 (defun gnus-summary-enter-digest-group (&optional force)
9738   "Enter a digest group based on the current article."
9739   (interactive "P")
9740   (gnus-set-global-variables)
9741   (gnus-summary-select-article)
9742   ;; We do not want a narrowed article.
9743   (gnus-summary-stop-page-breaking)
9744   (let ((name (format "%s-%d" 
9745                       (gnus-group-prefixed-name 
9746                        gnus-newsgroup-name (list 'nndoc "")) 
9747                       gnus-current-article))
9748         (ogroup gnus-newsgroup-name)
9749         (buf (current-buffer)))
9750     (if (gnus-group-read-ephemeral-group 
9751          name `(nndoc ,name (nndoc-address ,(get-buffer gnus-article-buffer))
9752                       (nndoc-article-type ,(if force 'digest 'guess))) t)
9753         ;; Make all postings to this group go to the parent group.
9754         (setcdr (nthcdr 4 (gnus-get-info name))
9755                 (list (list (cons 'to-group ogroup))))
9756       ;; Couldn't select this doc group.
9757       (switch-to-buffer buf)
9758       (gnus-set-global-variables)
9759       (gnus-configure-windows 'summary)
9760       (gnus-message 3 "Article not a digest?"))))
9761
9762 (defun gnus-summary-isearch-article (&optional regexp-p)
9763   "Do incremental search forward on the current article.
9764 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
9765   (interactive "P")
9766   (gnus-set-global-variables)
9767   (gnus-summary-select-article)
9768   (gnus-eval-in-buffer-window 
9769    gnus-article-buffer
9770    (goto-char (point-min))
9771    (isearch-forward regexp-p)))
9772
9773 (defun gnus-summary-search-article-forward (regexp &optional backward)
9774   "Search for an article containing REGEXP forward.
9775 If BACKWARD, search backward instead."
9776   (interactive
9777    (list (read-string
9778           (format "Search article %s (regexp%s): "
9779                   (if current-prefix-arg "backward" "forward")
9780                   (if gnus-last-search-regexp
9781                       (concat ", default " gnus-last-search-regexp)
9782                     "")))
9783          current-prefix-arg))
9784   (gnus-set-global-variables)
9785   (if (string-equal regexp "")
9786       (setq regexp (or gnus-last-search-regexp ""))
9787     (setq gnus-last-search-regexp regexp))
9788   (if (gnus-summary-search-article regexp backward)
9789       (gnus-article-set-window-start 
9790        (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
9791     (error "Search failed: \"%s\"" regexp)))
9792
9793 (defun gnus-summary-search-article-backward (regexp)
9794   "Search for an article containing REGEXP backward."
9795   (interactive
9796    (list (read-string
9797           (format "Search article backward (regexp%s): "
9798                   (if gnus-last-search-regexp
9799                       (concat ", default " gnus-last-search-regexp)
9800                     "")))))
9801   (gnus-summary-search-article-forward regexp 'backward))
9802
9803 (defun gnus-summary-search-article (regexp &optional backward)
9804   "Search for an article containing REGEXP.
9805 Optional argument BACKWARD means do search for backward.
9806 gnus-select-article-hook is not called during the search."
9807   (let ((gnus-select-article-hook nil)  ;Disable hook.
9808         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
9809         (re-search
9810          (if backward
9811              (function re-search-backward) (function re-search-forward)))
9812         (found nil)
9813         (last nil))
9814     ;; Hidden thread subtrees must be searched for ,too.
9815     (gnus-summary-show-all-threads)
9816     ;; First of all, search current article.
9817     ;; We don't want to read article again from NNTP server nor reset
9818     ;; current point.
9819     (gnus-summary-select-article)
9820     (gnus-message 9 "Searching article: %d..." gnus-current-article)
9821     (setq last gnus-current-article)
9822     (gnus-eval-in-buffer-window
9823      gnus-article-buffer
9824      (save-restriction
9825        (widen)
9826        ;; Begin search from current point.
9827        (setq found (funcall re-search regexp nil t))))
9828     ;; Then search next articles.
9829     (while (and (not found)
9830                 (gnus-summary-display-article 
9831                  (if backward (gnus-summary-find-prev)
9832                    (gnus-summary-find-next))))
9833       (gnus-message 9 "Searching article: %d..." gnus-current-article)
9834       (gnus-eval-in-buffer-window
9835        gnus-article-buffer
9836        (save-restriction
9837          (widen)
9838          (goto-char (if backward (point-max) (point-min)))
9839          (setq found (funcall re-search regexp nil t)))))
9840     (message "")
9841     ;; Adjust article pointer.
9842     (or (eq last gnus-current-article)
9843         (setq gnus-last-article last))
9844     ;; Return T if found such article.
9845     found))
9846
9847 (defun gnus-summary-find-matching (header regexp &optional backward unread
9848                                           not-case-fold)
9849   "Return a list of all articles that match REGEXP on HEADER.
9850 The search stars on the current article and goes forwards unless
9851 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
9852 If UNREAD is non-nil, only unread articles will
9853 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
9854 in the comparisons."
9855   (let ((data (if (eq backward 'all) gnus-newsgroup-data
9856                 (gnus-data-find-list 
9857                  (gnus-summary-article-number) (gnus-data-list backward))))
9858         (func (intern (concat "gnus-header-" header)))
9859         (case-fold-search (not not-case-fold))
9860         articles d)
9861     (or (fboundp func) (error "%s is not a valid header" header))
9862     (while data
9863       (setq d (car data))
9864       (and (or (not unread)             ; We want all articles...
9865                (gnus-data-unread-p d))  ; Or just unreads.
9866            (vectorp (gnus-data-header d)) ; It's not a pseudo.
9867            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
9868            (setq articles (cons (gnus-data-number d) articles))) ; Success!
9869       (setq data (cdr data)))
9870     (nreverse articles)))
9871     
9872 (defun gnus-summary-execute-command (header regexp command &optional backward)
9873   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
9874 If HEADER is an empty string (or nil), the match is done on the entire
9875 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
9876   (interactive
9877    (list (let ((completion-ignore-case t))
9878            (completing-read 
9879             "Header name: "
9880             (mapcar (lambda (string) (list string))
9881                     '("Number" "Subject" "From" "Lines" "Date"
9882                       "Message-ID" "Xref" "References"))
9883             nil 'require-match))
9884          (read-string "Regexp: ")
9885          (read-key-sequence "Command: ")
9886          current-prefix-arg))
9887   (gnus-set-global-variables)
9888   ;; Hidden thread subtrees must be searched as well.
9889   (gnus-summary-show-all-threads)
9890   ;; We don't want to change current point nor window configuration.
9891   (save-excursion
9892     (save-window-excursion
9893       (gnus-message 6 "Executing %s..." (key-description command))
9894       ;; We'd like to execute COMMAND interactively so as to give arguments.
9895       (gnus-execute header regexp
9896                     `(lambda () (call-interactively ',(key-binding command)))
9897                     backward)
9898       (gnus-message 6 "Executing %s...done" (key-description command)))))
9899
9900 (defun gnus-summary-beginning-of-article ()
9901   "Scroll the article back to the beginning."
9902   (interactive)
9903   (gnus-set-global-variables)
9904   (gnus-summary-select-article)
9905   (gnus-configure-windows 'article)
9906   (gnus-eval-in-buffer-window
9907    gnus-article-buffer
9908    (widen)
9909    (goto-char (point-min))
9910    (and gnus-break-pages (gnus-narrow-to-page))))
9911
9912 (defun gnus-summary-end-of-article ()
9913   "Scroll to the end of the article."
9914   (interactive)
9915   (gnus-set-global-variables)
9916   (gnus-summary-select-article)
9917   (gnus-configure-windows 'article)
9918   (gnus-eval-in-buffer-window 
9919    gnus-article-buffer
9920    (widen)
9921    (goto-char (point-max))
9922    (recenter -3)
9923    (and gnus-break-pages (gnus-narrow-to-page))))
9924
9925 (defun gnus-summary-show-article (&optional arg)
9926   "Force re-fetching of the current article.
9927 If ARG (the prefix) is non-nil, show the raw article without any
9928 article massaging functions being run."
9929   (interactive "P")
9930   (gnus-set-global-variables)
9931   (if (not arg)
9932       ;; Select the article the normal way.
9933       (gnus-summary-select-article nil 'force)
9934     ;; Bind the article treatment functions to nil.
9935     (let ((gnus-have-all-headers t)
9936           gnus-article-display-hook
9937           gnus-article-prepare-hook
9938           gnus-visual)
9939       (gnus-summary-select-article nil 'force)))
9940   (gnus-configure-windows 'article)
9941   (gnus-summary-position-point))
9942
9943 (defun gnus-summary-verbose-headers (&optional arg)
9944   "Toggle permanent full header display.
9945 If ARG is a positive number, turn header display on.
9946 If ARG is a negative number, turn header display off."
9947   (interactive "P")
9948   (gnus-set-global-variables)
9949   (gnus-summary-toggle-header arg)
9950   (setq gnus-show-all-headers
9951         (cond ((or (not (numberp arg))
9952                    (zerop arg))
9953                (not gnus-show-all-headers))
9954               ((natnump arg)
9955                t))))
9956
9957 (defun gnus-summary-toggle-header (&optional arg)
9958   "Show the headers if they are hidden, or hide them if they are shown.
9959 If ARG is a positive number, show the entire header.
9960 If ARG is a negative number, hide the unwanted header lines."
9961   (interactive "P")
9962   (gnus-set-global-variables)
9963   (save-excursion
9964     (set-buffer gnus-article-buffer)
9965     (let* ((buffer-read-only nil)
9966            (inhibit-point-motion-hooks t) 
9967            (hidden (text-property-any 
9968                     (goto-char (point-min)) (search-forward "\n\n")
9969                     'invisible t))
9970            e)
9971       (goto-char (point-min))
9972       (when (search-forward "\n\n" nil t)
9973         (delete-region (point-min) (1- (point))))
9974       (goto-char (point-min))
9975       (save-excursion 
9976         (set-buffer gnus-original-article-buffer)
9977         (goto-char (point-min))
9978         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
9979       (insert-buffer-substring gnus-original-article-buffer 1 e)
9980       (let ((hook (delq 'gnus-article-hide-headers-if-wanted
9981                         (delq 'gnus-article-hide-headers
9982                               (copy-sequence gnus-article-display-hook))))
9983             (gnus-inhibit-hiding t))
9984         (run-hooks 'hook))
9985       (if (or (not hidden) (and (numberp arg) (< arg 0)))
9986           (gnus-article-hide-headers)))))
9987
9988 (defun gnus-summary-show-all-headers ()
9989   "Make all header lines visible."
9990   (interactive)
9991   (gnus-set-global-variables)
9992   (gnus-article-show-all-headers))
9993
9994 (defun gnus-summary-toggle-mime (&optional arg)
9995   "Toggle MIME processing.
9996 If ARG is a positive number, turn MIME processing on."
9997   (interactive "P")
9998   (gnus-set-global-variables)
9999   (setq gnus-show-mime
10000         (if (null arg) (not gnus-show-mime)
10001           (> (prefix-numeric-value arg) 0)))
10002   (gnus-summary-select-article t 'force))
10003
10004 (defun gnus-summary-caesar-message (&optional arg)
10005   "Caesar rotate the current article by 13.
10006 The numerical prefix specifies how manu places to rotate each letter
10007 forward."
10008   (interactive "P")
10009   (gnus-set-global-variables)
10010   (gnus-summary-select-article)
10011   (let ((mail-header-separator ""))
10012     (gnus-eval-in-buffer-window 
10013      gnus-article-buffer
10014      (save-restriction
10015        (widen)
10016        (let ((start (window-start)))
10017          (news-caesar-buffer-body arg)
10018          (set-window-start (get-buffer-window (current-buffer)) start))))))
10019
10020 (defun gnus-summary-stop-page-breaking ()
10021   "Stop page breaking in the current article."
10022   (interactive)
10023   (gnus-set-global-variables)
10024   (gnus-summary-select-article)
10025   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
10026
10027 ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
10028
10029 (defun gnus-summary-move-article (&optional n to-newsgroup select-method)
10030   "Move the current article to a different newsgroup.
10031 If N is a positive number, move the N next articles.
10032 If N is a negative number, move the N previous articles.
10033 If N is nil and any articles have been marked with the process mark,
10034 move those articles instead.
10035 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
10036 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10037 re-spool using this method.
10038 For this function to work, both the current newsgroup and the
10039 newsgroup that you want to move to have to support the `request-move'
10040 and `request-accept' functions. (Ie. mail newsgroups at present.)"
10041   (interactive "P")
10042   (gnus-set-global-variables)
10043   (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)
10044       (error "The current newsgroup does not support article moving"))
10045   (let ((articles (gnus-summary-work-articles n))
10046         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
10047         art-group to-method sel-met)
10048     (if (and (not to-newsgroup) (not select-method))
10049         (setq to-newsgroup
10050               (completing-read 
10051                (format "Where do you want to move %s? %s"
10052                        (if (> (length articles) 1)
10053                            (format "these %d articles" (length articles))
10054                          "this article")
10055                        (if gnus-current-move-group
10056                            (format "(default %s) " gnus-current-move-group)
10057                          ""))
10058                gnus-active-hashtb nil nil prefix)))
10059     (if to-newsgroup
10060         (progn
10061           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
10062               (setq to-newsgroup (or gnus-current-move-group "")))
10063           (or (gnus-active to-newsgroup)
10064               (gnus-activate-group to-newsgroup)
10065               (error "No such group: %s" to-newsgroup))
10066           (setq gnus-current-move-group to-newsgroup)))
10067     (setq to-method (if select-method (list select-method "")
10068                       (gnus-find-method-for-group to-newsgroup)))
10069     (or (gnus-check-backend-function 'request-accept-article (car to-method))
10070         (error "%s does not support article copying" (car to-method)))
10071     (or (gnus-check-server to-method)
10072         (error "Can't open server %s" (car to-method)))
10073     (gnus-message 6 "Moving to %s: %s..." 
10074                   (or select-method to-newsgroup) articles)
10075     (while articles
10076       (if (setq art-group
10077                 (gnus-request-move-article 
10078                  (car articles)         ; Article to move
10079                  gnus-newsgroup-name    ; From newsgrouo
10080                  (nth 1 (gnus-find-method-for-group 
10081                          gnus-newsgroup-name)) ; Server
10082                  (list 'gnus-request-accept-article 
10083                        (if select-method
10084                            (list 'quote select-method)
10085                          to-newsgroup)
10086                        (not (cdr articles))) ; Accept form
10087                  (not (cdr articles)))) ; Only save nov last time
10088           (let* ((buffer-read-only nil)
10089                  (entry 
10090                   (or
10091                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
10092                    (gnus-gethash 
10093                     (gnus-group-prefixed-name 
10094                      (car art-group) 
10095                      (if select-method (list select-method "")
10096                        (gnus-find-method-for-group to-newsgroup)))
10097                     gnus-newsrc-hashtb)))
10098                  (info (nth 2 entry))
10099                  (article (car articles)))
10100             ;; Update the group that has been moved to.
10101             (if (not info)
10102                 ()                      ; This group does not exist yet.
10103               (unless (memq article gnus-newsgroup-unreads)
10104                 (gnus-info-set-read 
10105                  info (gnus-add-to-range (gnus-info-read info) 
10106                                          (list (cdr art-group)))))
10107
10108               ;; Copy any marks over to the new group.
10109               (let ((marks '((tick . gnus-newsgroup-marked)
10110                              (dormant . gnus-newsgroup-dormant)
10111                              (expire . gnus-newsgroup-expirable)
10112                              (bookmark . gnus-newsgroup-bookmarks)
10113                              (reply . gnus-newsgroup-replied)))
10114                     (to-article (cdr art-group)))
10115
10116                 ;; See whether the article is to be put in the cache.
10117                 (when gnus-use-cache
10118                   (gnus-cache-possibly-enter-article 
10119                    (gnus-info-group info) to-article
10120                    (let ((header (copy-sequence
10121                                   (gnus-summary-article-header article))))
10122                      (mail-header-set-number header to-article)
10123                      header)
10124                    (memq article gnus-newsgroup-marked)
10125                    (memq article gnus-newsgroup-dormant)
10126                    (memq article gnus-newsgroup-unreads)))
10127
10128                 (while marks
10129                   (if (memq article (symbol-value (cdr (car marks))))
10130                       (gnus-add-marked-articles 
10131                        (gnus-info-group info) (car (car marks))
10132                        (list to-article) info))
10133                   (setq marks (cdr marks)))))
10134             (gnus-summary-goto-subject article)
10135             (gnus-summary-mark-article article gnus-canceled-mark))
10136         (gnus-message 1 "Couldn't move article %s" (car articles)))
10137       (gnus-summary-remove-process-mark (car articles))
10138       (setq articles (cdr articles)))
10139     (gnus-set-mode-line 'summary)))
10140
10141 (defun gnus-summary-respool-article (&optional n respool-method)
10142   "Respool the current article.
10143 The article will be squeezed through the mail spooling process again,
10144 which means that it will be put in some mail newsgroup or other
10145 depending on `nnmail-split-methods'.
10146 If N is a positive number, respool the N next articles.
10147 If N is a negative number, respool the N previous articles.
10148 If N is nil and any articles have been marked with the process mark,
10149 respool those articles instead.
10150
10151 Respooling can be done both from mail groups and \"real\" newsgroups.
10152 In the former case, the articles in question will be moved from the
10153 current group into whatever groups they are destined to.  In the
10154 latter case, they will be copied into the relevant groups."
10155   (interactive "P")
10156   (gnus-set-global-variables)
10157   (let ((respool-methods (gnus-methods-using 'respool))
10158         (methname 
10159          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
10160     (or respool-method
10161         (setq respool-method
10162               (completing-read
10163                "What method do you want to use when respooling? "
10164                respool-methods nil t methname)))
10165     (or (string= respool-method "")
10166         (if (assoc (symbol-name
10167                     (car (gnus-find-method-for-group gnus-newsgroup-name)))
10168                    respool-methods)
10169             (gnus-summary-move-article n nil (intern respool-method))
10170           (gnus-summary-copy-article n nil (intern respool-method))))))
10171
10172 ;; Suggested by gregj@unidata.com (Gregory J. Grubbs).
10173 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
10174   "Move the current article to a different newsgroup.
10175 If N is a positive number, move the N next articles.
10176 If N is a negative number, move the N previous articles.
10177 If N is nil and any articles have been marked with the process mark,
10178 move those articles instead.
10179 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
10180 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10181 re-spool using this method.
10182 For this function to work, the newsgroup that you want to move to have
10183 to support the `request-move' and `request-accept'
10184 functions. (Ie. mail newsgroups at present.)"
10185   (interactive "P")
10186   (gnus-set-global-variables)
10187   (let ((articles (gnus-summary-work-articles n))
10188         (copy-buf (get-buffer-create "*copy work*"))
10189         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
10190         art-group to-method)
10191     (buffer-disable-undo copy-buf)
10192     (if (and (not to-newsgroup) (not select-method))
10193         (setq to-newsgroup
10194               (completing-read 
10195                (format "Where do you want to copy %s? %s"
10196                        (if (> (length articles) 1)
10197                            (format "these %d articles" (length articles))
10198                          "this article")
10199                        (if gnus-current-move-group
10200                            (format "(default %s) " gnus-current-move-group)
10201                          ""))
10202                gnus-active-hashtb nil nil prefix)))
10203     (if to-newsgroup
10204         (progn
10205           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
10206               (setq to-newsgroup (or gnus-current-move-group "")))
10207           (or (gnus-active to-newsgroup)
10208               (gnus-activate-group to-newsgroup)
10209               (error "No such group: %s" to-newsgroup))
10210           (setq gnus-current-move-group to-newsgroup)))
10211     (setq to-method (if select-method (list select-method "")
10212                       (gnus-find-method-for-group to-newsgroup)))
10213     (or (gnus-check-backend-function 'request-accept-article (car to-method))
10214         (error "%s does not support article copying" (car to-method)))
10215     (or (gnus-check-server to-method)
10216         (error "Can't open server %s" (car to-method)))
10217     (while articles
10218       (gnus-message 6 "Copying to %s: %s..." 
10219                     (or select-method to-newsgroup) articles)
10220       (if (setq art-group
10221                 (save-excursion
10222                   (set-buffer copy-buf)
10223                   (gnus-request-article-this-buffer
10224                    (car articles) gnus-newsgroup-name)
10225                   (gnus-request-accept-article
10226                    (if select-method select-method to-newsgroup)
10227                    (not (cdr articles)))))
10228           (let* ((entry 
10229                   (or
10230                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
10231                    (gnus-gethash 
10232                     (gnus-group-prefixed-name 
10233                      (car art-group) 
10234                      (if select-method (list select-method "")
10235                        (gnus-find-method-for-group to-newsgroup)))
10236                     gnus-newsrc-hashtb)))
10237                  (info (nth 2 entry))
10238                  (article (car articles)))
10239             ;; We copy the info over to the new group.
10240             (if (not info)
10241                 ()                      ; This group does not exist (yet).
10242               (if (not (memq article gnus-newsgroup-unreads))
10243                   (gnus-info-set-read 
10244                    info (gnus-add-to-range (gnus-info-read info) 
10245                                            (list (cdr art-group)))))
10246
10247               ;; Copy any marks over to the new group.
10248               (let ((marks '((tick . gnus-newsgroup-marked)
10249                              (dormant . gnus-newsgroup-dormant)
10250                              (expire . gnus-newsgroup-expirable)
10251                              (bookmark . gnus-newsgroup-bookmarks)
10252                              (reply . gnus-newsgroup-replied)))
10253                     (to-article (cdr art-group)))
10254
10255               ;; See whether the article is to be put in the cache.
10256               (when gnus-use-cache
10257                 (gnus-cache-possibly-enter-article 
10258                  (gnus-info-group info) to-article 
10259                  (let ((header (copy-sequence
10260                                 (gnus-summary-article-header article))))
10261                    (mail-header-set-number header to-article)
10262                    header)
10263                  (memq article gnus-newsgroup-marked)
10264                  (memq article gnus-newsgroup-dormant)
10265                  (memq article gnus-newsgroup-unreads)))
10266
10267               (while marks
10268                 (if (memq article (symbol-value (cdr (car marks))))
10269                     (gnus-add-marked-articles 
10270                      (gnus-info-group info) (car (car marks)) 
10271                      (list to-article) info))
10272                 (setq marks (cdr marks))))))
10273         (gnus-message 1 "Couldn't copy article %s" (car articles)))
10274       (gnus-summary-remove-process-mark (car articles))
10275       (setq articles (cdr articles)))
10276     (kill-buffer copy-buf)))
10277
10278 (defun gnus-summary-import-article (file)
10279   "Import a random file into a mail newsgroup."
10280   (interactive "fImport file: ")
10281   (gnus-set-global-variables)
10282   (let ((group gnus-newsgroup-name)
10283         atts lines)
10284     (or (gnus-check-backend-function 'request-accept-article group)
10285         (error "%s does not support article importing" group))
10286     (or (file-readable-p file)
10287         (not (file-regular-p file))
10288         (error "Can't read %s" file))
10289     (save-excursion
10290       (set-buffer (get-buffer-create " *import file*"))
10291       (buffer-disable-undo (current-buffer))
10292       (erase-buffer)
10293       (insert-file-contents file)
10294       (goto-char (point-min))
10295       (if (nnheader-article-p)
10296           ()
10297         (setq atts (file-attributes file)
10298               lines (count-lines (point-min) (point-max)))
10299         (insert "From: " (read-string "From: ") "\n"
10300                 "Subject: " (read-string "Subject: ") "\n"
10301                 "Date: " (current-time-string (nth 5 atts)) "\n"
10302                 "Message-ID: " (gnus-inews-message-id) "\n"
10303                 "Lines: " (int-to-string lines) "\n"
10304                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
10305       (gnus-request-accept-article group t)
10306       (kill-buffer (current-buffer)))))
10307
10308 (defun gnus-summary-expire-articles ()
10309   "Expire all articles that are marked as expirable in the current group."
10310   (interactive)
10311   (gnus-set-global-variables)
10312   (when (gnus-check-backend-function 
10313          'request-expire-articles gnus-newsgroup-name)
10314     ;; This backend supports expiry.
10315     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
10316            (expirable (if total
10317                           (gnus-list-of-read-articles gnus-newsgroup-name)
10318                         (setq gnus-newsgroup-expirable
10319                               (sort gnus-newsgroup-expirable '<))))
10320            es)
10321       (when expirable
10322         ;; There are expirable articles in this group, so we run them
10323         ;; through the expiry process.
10324         (gnus-message 6 "Expiring articles...")
10325         ;; The list of articles that weren't expired is returned.
10326         (setq es (gnus-request-expire-articles expirable gnus-newsgroup-name))
10327         (or total (setq gnus-newsgroup-expirable es))
10328         ;; We go through the old list of expirable, and mark all
10329         ;; really expired articles as non-existant.
10330         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
10331           (let ((gnus-use-cache nil))
10332             (while expirable
10333               (unless (memq (car expirable) es)
10334                 (when (gnus-data-find (car expirable))
10335                   (gnus-summary-mark-article
10336                    (car expirable) gnus-canceled-mark)))
10337               (setq expirable (cdr expirable)))))
10338         (gnus-message 6 "Expiring articles...done")))))
10339
10340 (defun gnus-summary-expire-articles-now ()
10341   "Expunge all expirable articles in the current group.
10342 This means that *all* articles that are marked as expirable will be
10343 deleted forever, right now."
10344   (interactive)
10345   (gnus-set-global-variables)
10346   (or gnus-expert-user
10347       (gnus-y-or-n-p
10348        "Are you really, really, really sure you want to expunge? ")
10349       (error "Phew!"))
10350   (let ((nnmail-expiry-wait -1)
10351         (nnmail-expiry-wait-function nil))
10352     (gnus-summary-expire-articles)))
10353
10354 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
10355 (defun gnus-summary-delete-article (&optional n)
10356   "Delete the N next (mail) articles.
10357 This command actually deletes articles.  This is not a marking
10358 command.  The article will disappear forever from your life, never to
10359 return. 
10360 If N is negative, delete backwards.
10361 If N is nil and articles have been marked with the process mark,
10362 delete these instead."
10363   (interactive "P")
10364   (gnus-set-global-variables)
10365   (or (gnus-check-backend-function 'request-expire-articles 
10366                                    gnus-newsgroup-name)
10367       (error "The current newsgroup does not support article deletion."))
10368   ;; Compute the list of articles to delete.
10369   (let ((articles (gnus-summary-work-articles n))
10370         not-deleted)
10371     (if (and gnus-novice-user
10372              (not (gnus-y-or-n-p 
10373                    (format "Do you really want to delete %s forever? "
10374                            (if (> (length articles) 1) "these articles"
10375                              "this article")))))
10376         ()
10377       ;; Delete the articles.
10378       (setq not-deleted (gnus-request-expire-articles 
10379                          articles gnus-newsgroup-name 'force))
10380       (while articles
10381         (gnus-summary-remove-process-mark (car articles))       
10382         ;; The backend might not have been able to delete the article
10383         ;; after all.  
10384         (or (memq (car articles) not-deleted)
10385             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
10386         (setq articles (cdr articles))))
10387     (gnus-summary-position-point)
10388     (gnus-set-mode-line 'summary)
10389     not-deleted))
10390
10391 (defun gnus-summary-edit-article (&optional force)
10392   "Enter into a buffer and edit the current article.
10393 This will have permanent effect only in mail groups.
10394 If FORCE is non-nil, allow editing of articles even in read-only
10395 groups."
10396   (interactive "P")
10397   (gnus-set-global-variables)
10398   (when (and (not force)
10399              (gnus-group-read-only-p))
10400     (error "The current newsgroup does not support article editing."))
10401   (gnus-summary-select-article t nil t)
10402   (gnus-configure-windows 'article)
10403   (select-window (get-buffer-window gnus-article-buffer))
10404   (gnus-message 6 "C-c C-c to end edits")
10405   (setq buffer-read-only nil)
10406   (text-mode)
10407   (use-local-map (copy-keymap (current-local-map)))
10408   (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
10409   (buffer-enable-undo)
10410   (widen)
10411   (goto-char (point-min))
10412   (search-forward "\n\n" nil t))
10413
10414 (defun gnus-summary-edit-article-done ()
10415   "Make edits to the current article permanent."
10416   (interactive)
10417   (if (gnus-group-read-only-p)
10418       (progn
10419         (gnus-summary-edit-article-postpone)
10420         (message "The current newsgroup does not support article editing.")
10421         (ding))
10422     (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
10423       (erase-buffer)
10424       (insert buf)
10425       (if (not (gnus-request-replace-article 
10426                 (cdr gnus-article-current) (car gnus-article-current) 
10427                 (current-buffer)))
10428           (error "Couldn't replace article.")
10429         (gnus-article-mode)
10430         (use-local-map gnus-article-mode-map)
10431         (setq buffer-read-only t)
10432         (buffer-disable-undo (current-buffer))
10433         (gnus-configure-windows 'summary))
10434       (and (gnus-visual-p 'summary-highlight 'highlight)
10435            (run-hooks 'gnus-visual-mark-article-hook)))))
10436
10437 (defun gnus-summary-edit-article-postpone ()
10438   "Postpone changes to the current article."
10439   (interactive)
10440   (gnus-article-mode)
10441   (use-local-map gnus-article-mode-map)
10442   (setq buffer-read-only t)
10443   (buffer-disable-undo (current-buffer))
10444   (gnus-configure-windows 'summary)
10445   (and (gnus-visual-p 'summary-highlight 'highlight)
10446        (run-hooks 'gnus-visual-mark-article-hook)))
10447
10448 (defun gnus-summary-respool-query ()
10449   "Query where the respool algorithm would put this article."
10450   (interactive)
10451   (gnus-set-global-variables)
10452   (gnus-summary-select-article)
10453   (save-excursion
10454     (set-buffer gnus-article-buffer)
10455     (save-restriction
10456       (goto-char (point-min))
10457       (search-forward "\n\n")
10458       (narrow-to-region (point-min) (point))
10459       (pp-eval-expression
10460        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
10461
10462 ;; Summary score commands.
10463
10464 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
10465
10466 (defun gnus-summary-raise-score (n)
10467   "Raise the score of the current article by N."
10468   (interactive "p")
10469   (gnus-set-global-variables)
10470   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
10471
10472 (defun gnus-summary-set-score (n)
10473   "Set the score of the current article to N."
10474   (interactive "p")
10475   (gnus-set-global-variables)
10476   (save-excursion
10477     (gnus-summary-show-thread)
10478     (let ((buffer-read-only nil))
10479       ;; Set score.
10480       (gnus-summary-update-mark
10481        (if (= n (or gnus-summary-default-score 0)) ? 
10482          (if (< n (or gnus-summary-default-score 0)) 
10483              gnus-score-below-mark gnus-score-over-mark)) 'score))
10484     (let* ((article (gnus-summary-article-number))
10485            (score (assq article gnus-newsgroup-scored)))
10486       (if score (setcdr score n)
10487         (setq gnus-newsgroup-scored 
10488               (cons (cons article n) gnus-newsgroup-scored))))
10489     (gnus-summary-update-line)))
10490
10491 (defun gnus-summary-current-score ()
10492   "Return the score of the current article."
10493   (interactive)
10494   (gnus-set-global-variables)
10495   (message "%s" (gnus-summary-article-score)))
10496
10497 ;; Summary marking commands.
10498
10499 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
10500   "Mark articles which has the same subject as read, and then select the next.
10501 If UNMARK is positive, remove any kind of mark.
10502 If UNMARK is negative, tick articles."
10503   (interactive "P")
10504   (gnus-set-global-variables)
10505   (if unmark
10506       (setq unmark (prefix-numeric-value unmark)))
10507   (let ((count
10508          (gnus-summary-mark-same-subject
10509           (gnus-summary-article-subject) unmark)))
10510     ;; Select next unread article.  If auto-select-same mode, should
10511     ;; select the first unread article.
10512     (gnus-summary-next-article t (and gnus-auto-select-same
10513                                       (gnus-summary-article-subject)))
10514     (gnus-message 7 "%d article%s marked as %s"
10515                   count (if (= count 1) " is" "s are")
10516                   (if unmark "unread" "read"))))
10517
10518 (defun gnus-summary-kill-same-subject (&optional unmark)
10519   "Mark articles which has the same subject as read. 
10520 If UNMARK is positive, remove any kind of mark.
10521 If UNMARK is negative, tick articles."
10522   (interactive "P")
10523   (gnus-set-global-variables)
10524   (if unmark
10525       (setq unmark (prefix-numeric-value unmark)))
10526   (let ((count
10527          (gnus-summary-mark-same-subject
10528           (gnus-summary-article-subject) unmark)))
10529     ;; If marked as read, go to next unread subject.
10530     (if (null unmark)
10531         ;; Go to next unread subject.
10532         (gnus-summary-next-subject 1 t))
10533     (gnus-message 7 "%d articles are marked as %s"
10534                   count (if unmark "unread" "read"))))
10535
10536 (defun gnus-summary-mark-same-subject (subject &optional unmark)
10537   "Mark articles with same SUBJECT as read, and return marked number.
10538 If optional argument UNMARK is positive, remove any kinds of marks.
10539 If optional argument UNMARK is negative, mark articles as unread instead."
10540   (let ((count 1))
10541     (save-excursion
10542       (cond 
10543        ((null unmark)                   ; Mark as read.
10544         (while (and 
10545                 (progn
10546                   (gnus-summary-mark-article-as-read gnus-killed-mark)
10547                   (gnus-summary-show-thread) t)
10548                 (gnus-summary-find-subject subject))
10549           (setq count (1+ count))))
10550        ((> unmark 0)                    ; Tick.
10551         (while (and
10552                 (progn
10553                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
10554                   (gnus-summary-show-thread) t)
10555                 (gnus-summary-find-subject subject))
10556           (setq count (1+ count))))
10557        (t                               ; Mark as unread.
10558         (while (and
10559                 (progn
10560                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
10561                   (gnus-summary-show-thread) t)
10562                 (gnus-summary-find-subject subject))
10563           (setq count (1+ count)))))
10564       (gnus-set-mode-line 'summary)
10565       ;; Return the number of marked articles.
10566       count)))
10567
10568 (defun gnus-summary-mark-as-processable (n &optional unmark)
10569   "Set the process mark on the next N articles.
10570 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
10571 the process mark instead.  The difference between N and the actual
10572 number of articles marked is returned."
10573   (interactive "p")
10574   (gnus-set-global-variables)
10575   (let ((backward (< n 0))
10576         (n (abs n)))
10577     (while (and 
10578             (> n 0)
10579             (if unmark
10580                 (gnus-summary-remove-process-mark
10581                  (gnus-summary-article-number))
10582               (gnus-summary-set-process-mark (gnus-summary-article-number)))
10583             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
10584       (setq n (1- n)))
10585     (if (/= 0 n) (gnus-message 7 "No more articles"))
10586     (gnus-summary-recenter)
10587     (gnus-summary-position-point)
10588     n))
10589
10590 (defun gnus-summary-unmark-as-processable (n)
10591   "Remove the process mark from the next N articles.
10592 If N is negative, mark backward instead.  The difference between N and
10593 the actual number of articles marked is returned."
10594   (interactive "p")
10595   (gnus-set-global-variables)
10596   (gnus-summary-mark-as-processable n t))
10597
10598 (defun gnus-summary-unmark-all-processable ()
10599   "Remove the process mark from all articles."
10600   (interactive)
10601   (gnus-set-global-variables)
10602   (save-excursion
10603     (while gnus-newsgroup-processable
10604       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
10605   (gnus-summary-position-point))
10606
10607 (defun gnus-summary-mark-as-expirable (n)
10608   "Mark N articles forward as expirable.
10609 If N is negative, mark backward instead.  The difference between N and
10610 the actual number of articles marked is returned."
10611   (interactive "p")
10612   (gnus-set-global-variables)
10613   (gnus-summary-mark-forward n gnus-expirable-mark))
10614
10615 (defun gnus-summary-mark-article-as-replied (article)
10616   "Mark ARTICLE replied and update the summary line."
10617   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
10618   (let ((buffer-read-only nil))
10619     (if (gnus-summary-goto-subject article)
10620         (progn
10621           (gnus-summary-update-mark gnus-replied-mark 'replied)
10622           t))))
10623
10624 (defun gnus-summary-set-bookmark (article)
10625   "Set a bookmark in current article."
10626   (interactive (list (gnus-summary-article-number)))
10627   (gnus-set-global-variables)
10628   (if (or (not (get-buffer gnus-article-buffer))
10629           (not gnus-current-article)
10630           (not gnus-article-current)
10631           (not (equal gnus-newsgroup-name (car gnus-article-current))))
10632       (error "No current article selected"))
10633   ;; Remove old bookmark, if one exists.
10634   (let ((old (assq article gnus-newsgroup-bookmarks)))
10635     (if old (setq gnus-newsgroup-bookmarks 
10636                   (delq old gnus-newsgroup-bookmarks))))
10637   ;; Set the new bookmark, which is on the form 
10638   ;; (article-number . line-number-in-body).
10639   (setq gnus-newsgroup-bookmarks 
10640         (cons 
10641          (cons article 
10642                (save-excursion
10643                  (set-buffer gnus-article-buffer)
10644                  (count-lines
10645                   (min (point)
10646                        (save-excursion
10647                          (goto-char (point-min))
10648                          (search-forward "\n\n" nil t)
10649                          (point)))
10650                   (point))))
10651          gnus-newsgroup-bookmarks))
10652   (gnus-message 6 "A bookmark has been added to the current article."))
10653
10654 (defun gnus-summary-remove-bookmark (article)
10655   "Remove the bookmark from the current article."
10656   (interactive (list (gnus-summary-article-number)))
10657   (gnus-set-global-variables)
10658   ;; Remove old bookmark, if one exists.
10659   (let ((old (assq article gnus-newsgroup-bookmarks)))
10660     (if old 
10661         (progn
10662           (setq gnus-newsgroup-bookmarks 
10663                 (delq old gnus-newsgroup-bookmarks))
10664           (gnus-message 6 "Removed bookmark."))
10665       (gnus-message 6 "No bookmark in current article."))))
10666
10667 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
10668 (defun gnus-summary-mark-as-dormant (n)
10669   "Mark N articles forward as dormant.
10670 If N is negative, mark backward instead.  The difference between N and
10671 the actual number of articles marked is returned."
10672   (interactive "p")
10673   (gnus-set-global-variables)
10674   (gnus-summary-mark-forward n gnus-dormant-mark))
10675
10676 (defun gnus-summary-set-process-mark (article)
10677   "Set the process mark on ARTICLE and update the summary line."
10678   (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable))
10679   (let ((buffer-read-only nil))
10680     (if (gnus-summary-goto-subject article)
10681         (progn
10682           (gnus-summary-show-thread)
10683           (gnus-summary-update-mark gnus-process-mark 'replied)
10684           t))))
10685
10686 (defun gnus-summary-remove-process-mark (article)
10687   "Remove the process mark from ARTICLE and update the summary line."
10688   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
10689   (let ((buffer-read-only nil))
10690     (if (gnus-summary-goto-subject article)
10691         (progn
10692           (gnus-summary-show-thread)
10693           (gnus-summary-update-mark ?  'replied)
10694           (if (memq article gnus-newsgroup-replied) 
10695               (gnus-summary-update-mark gnus-replied-mark 'replied))
10696           t))))
10697
10698 (defun gnus-summary-mark-forward (n &optional mark no-expire)
10699   "Mark N articles as read forwards.
10700 If N is negative, mark backwards instead.
10701 Mark with MARK.  If MARK is ? , ?! or ??, articles will be
10702 marked as unread. 
10703 The difference between N and the actual number of articles marked is
10704 returned."
10705   (interactive "p")
10706   (gnus-set-global-variables)
10707   (let ((backward (< n 0))
10708         (gnus-summary-goto-unread
10709          (and gnus-summary-goto-unread
10710               (not (memq mark (list gnus-unread-mark
10711                                     gnus-ticked-mark gnus-dormant-mark)))))
10712         (n (abs n))
10713         (mark (or mark gnus-del-mark)))
10714     (while (and (> n 0)
10715                 (gnus-summary-mark-article nil mark no-expire)
10716                 (zerop (gnus-summary-next-subject 
10717                         (if backward -1 1) gnus-summary-goto-unread t)))
10718       (setq n (1- n)))
10719     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
10720     (gnus-summary-recenter)
10721     (gnus-summary-position-point)
10722     (gnus-set-mode-line 'summary)
10723     n))
10724
10725 (defun gnus-summary-mark-article-as-read (mark)
10726   "Mark the current article quickly as read with MARK."
10727   (let ((article (gnus-summary-article-number)))
10728     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10729     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10730     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10731     (setq gnus-newsgroup-reads
10732           (cons (cons article mark) gnus-newsgroup-reads))
10733     ;; Possibly remove from cache, if that is used. 
10734     (and gnus-use-cache (gnus-cache-enter-remove-article article))
10735     (and gnus-newsgroup-auto-expire 
10736          (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
10737              (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
10738              (= mark gnus-read-mark) (= mark gnus-souped-mark))
10739          (progn
10740            (setq mark gnus-expirable-mark)
10741            (setq gnus-newsgroup-expirable 
10742                  (cons article gnus-newsgroup-expirable))))
10743     ;; Fix the mark.
10744     (gnus-summary-update-mark mark 'unread)
10745     t))
10746
10747 (defun gnus-summary-mark-article-as-unread (mark)
10748   "Mark the current article quickly as unread with MARK."
10749   (let ((article (gnus-summary-article-number)))
10750     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10751     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10752     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
10753     (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
10754     (cond ((= mark gnus-ticked-mark)
10755            (push article gnus-newsgroup-marked))
10756           ((= mark gnus-dormant-mark)
10757            (push article gnus-newsgroup-dormant))
10758           (t     
10759            (push article gnus-newsgroup-unreads)))
10760     (setq gnus-newsgroup-reads
10761           (delq (assq article gnus-newsgroup-reads)
10762                 gnus-newsgroup-reads))
10763
10764     ;; See whether the article is to be put in the cache.
10765     (and gnus-use-cache
10766          (vectorp (gnus-summary-article-header article))
10767          (save-excursion
10768            (gnus-cache-possibly-enter-article 
10769             gnus-newsgroup-name article 
10770             (gnus-summary-article-header article)
10771             (= mark gnus-ticked-mark)
10772             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
10773
10774     ;; Fix the mark.
10775     (gnus-summary-update-mark mark 'unread)
10776     t))
10777
10778 (defun gnus-summary-mark-article (&optional article mark no-expire)
10779   "Mark ARTICLE with MARK.  MARK can be any character.
10780 Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??'
10781 (dormant) and `?E' (expirable).
10782 If MARK is nil, then the default character `?D' is used.
10783 If ARTICLE is nil, then the article on the current line will be
10784 marked." 
10785   ;; The mark might be a string.
10786   (and (stringp mark)
10787        (setq mark (aref mark 0)))
10788   ;; If no mark is given, then we check auto-expiring.
10789   (and (not no-expire)
10790        gnus-newsgroup-auto-expire 
10791        (or (not mark)
10792            (and (numberp mark) 
10793                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
10794                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
10795                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
10796        (setq mark gnus-expirable-mark))
10797   (let* ((mark (or mark gnus-del-mark))
10798          (article (or article (gnus-summary-article-number))))
10799     (or article (error "No article on current line"))
10800     (if (or (= mark gnus-unread-mark) 
10801             (= mark gnus-ticked-mark) 
10802             (= mark gnus-dormant-mark))
10803         (gnus-mark-article-as-unread article mark)
10804       (gnus-mark-article-as-read article mark))
10805
10806     ;; See whether the article is to be put in the cache.
10807     (and gnus-use-cache
10808          (not (= mark gnus-canceled-mark))
10809          (vectorp (gnus-summary-article-header article))
10810          (save-excursion
10811            (gnus-cache-possibly-enter-article 
10812             gnus-newsgroup-name article 
10813             (gnus-summary-article-header article)
10814             (= mark gnus-ticked-mark)
10815             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
10816
10817     (if (gnus-summary-goto-subject article nil t)
10818         (let ((buffer-read-only nil))
10819           (gnus-summary-show-thread)
10820           ;; Fix the mark.
10821           (gnus-summary-update-mark mark 'unread)
10822           t))))
10823
10824 (defun gnus-summary-update-mark (mark type)
10825   (beginning-of-line)
10826   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
10827         (buffer-read-only nil))
10828     (when forward
10829       ;; Go to the right position on the line.
10830       (forward-char forward)
10831       ;; Replace the old mark with the new mark.
10832       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
10833       ;; Optionally update the marks by some user rule.
10834       (when (eq type 'unread)
10835         (gnus-data-set-mark 
10836          (gnus-data-find (gnus-summary-article-number)) mark)
10837         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
10838   
10839 (defun gnus-mark-article-as-read (article &optional mark)
10840   "Enter ARTICLE in the pertinent lists and remove it from others."
10841   ;; Make the article expirable.
10842   (let ((mark (or mark gnus-del-mark)))
10843     (if (= mark gnus-expirable-mark)
10844         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
10845       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
10846     ;; Remove from unread and marked lists.
10847     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10848     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10849     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10850     (push (cons article mark) gnus-newsgroup-reads)
10851     ;; Possibly remove from cache, if that is used. 
10852     (when gnus-use-cache 
10853       (gnus-cache-enter-remove-article article))))
10854
10855 (defun gnus-mark-article-as-unread (article &optional mark)
10856   "Enter ARTICLE in the pertinent lists and remove it from others."
10857   (let ((mark (or mark gnus-ticked-mark)))
10858     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10859     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10860     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
10861     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10862     (cond ((= mark gnus-ticked-mark)
10863            (push article gnus-newsgroup-marked))
10864           ((= mark gnus-dormant-mark)
10865            (push article gnus-newsgroup-dormant))
10866           (t     
10867            (push article gnus-newsgroup-unreads)))
10868     (setq gnus-newsgroup-reads
10869           (delq (assq article gnus-newsgroup-reads)
10870                 gnus-newsgroup-reads))))
10871
10872 (defalias 'gnus-summary-mark-as-unread-forward 
10873   'gnus-summary-tick-article-forward)
10874 (make-obsolete 'gnus-summary-mark-as-unread-forward 
10875                'gnus-summary-tick-article-forward)
10876 (defun gnus-summary-tick-article-forward (n)
10877   "Tick N articles forwards.
10878 If N is negative, tick backwards instead.
10879 The difference between N and the number of articles ticked is returned."
10880   (interactive "p")
10881   (gnus-summary-mark-forward n gnus-ticked-mark))
10882
10883 (defalias 'gnus-summary-mark-as-unread-backward 
10884   'gnus-summary-tick-article-backward)
10885 (make-obsolete 'gnus-summary-mark-as-unread-backward 
10886                'gnus-summary-tick-article-backward)
10887 (defun gnus-summary-tick-article-backward (n)
10888   "Tick N articles backwards.
10889 The difference between N and the number of articles ticked is returned."
10890   (interactive "p")
10891   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
10892
10893 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
10894 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
10895 (defun gnus-summary-tick-article (&optional article clear-mark)
10896   "Mark current article as unread.
10897 Optional 1st argument ARTICLE specifies article number to be marked as unread.
10898 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
10899   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
10900                                        gnus-ticked-mark)))
10901
10902 (defun gnus-summary-mark-as-read-forward (n)
10903   "Mark N articles as read forwards.
10904 If N is negative, mark backwards instead.
10905 The difference between N and the actual number of articles marked is
10906 returned."
10907   (interactive "p")
10908   (gnus-summary-mark-forward n gnus-del-mark t))
10909
10910 (defun gnus-summary-mark-as-read-backward (n)
10911   "Mark the N articles as read backwards.
10912 The difference between N and the actual number of articles marked is
10913 returned."
10914   (interactive "p")
10915   (gnus-summary-mark-forward (- n) gnus-del-mark t))
10916
10917 (defun gnus-summary-mark-as-read (&optional article mark)
10918   "Mark current article as read.
10919 ARTICLE specifies the article to be marked as read.
10920 MARK specifies a string to be inserted at the beginning of the line."
10921   (gnus-summary-mark-article article mark))
10922
10923 (defun gnus-summary-clear-mark-forward (n)
10924   "Clear marks from N articles forward.
10925 If N is negative, clear backward instead.
10926 The difference between N and the number of marks cleared is returned."
10927   (interactive "p")
10928   (gnus-summary-mark-forward n gnus-unread-mark))
10929
10930 (defun gnus-summary-clear-mark-backward (n)
10931   "Clear marks from N articles backward.
10932 The difference between N and the number of marks cleared is returned."
10933   (interactive "p")
10934   (gnus-summary-mark-forward (- n) gnus-unread-mark))
10935
10936 (defun gnus-summary-mark-unread-as-read ()
10937   "Intended to be used by `gnus-summary-mark-article-hook'."
10938   (when (memq gnus-current-article gnus-newsgroup-unreads)
10939     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
10940
10941 (defun gnus-summary-mark-region-as-read (point mark all)
10942   "Mark all unread articles between point and mark as read.
10943 If given a prefix, mark all articles between point and mark as read,
10944 even ticked and dormant ones."
10945   (interactive "r\nP")
10946   (save-excursion
10947     (let (article)
10948       (goto-char point)
10949       (beginning-of-line)
10950       (while (and 
10951               (< (point) mark)
10952               (progn
10953                 (when (or all 
10954                           (memq (setq article (gnus-summary-article-number))
10955                                 gnus-newsgroup-unreads))
10956                   (gnus-summary-mark-article article gnus-del-mark))
10957                 t)
10958               (gnus-summary-find-next))))))
10959
10960 (defun gnus-summary-mark-below (score mark)
10961   "Mark articles with score less than SCORE with MARK."
10962   (interactive "P\ncMark: ")
10963   (gnus-set-global-variables)
10964   (setq score (if score
10965                   (prefix-numeric-value score)
10966                 (or gnus-summary-default-score 0)))
10967   (save-excursion
10968     (set-buffer gnus-summary-buffer)
10969     (goto-char (point-min))
10970     (while (not (eobp))
10971       (and (< (gnus-summary-article-score) score)
10972            (gnus-summary-mark-article nil mark))
10973       (gnus-summary-find-next))))
10974
10975 (defun gnus-summary-kill-below (&optional score)
10976   "Mark articles with score below SCORE as read."
10977   (interactive "P")
10978   (gnus-set-global-variables)
10979   (gnus-summary-mark-below score gnus-killed-mark))
10980
10981 (defun gnus-summary-clear-above (&optional score)
10982   "Clear all marks from articles with score above SCORE."
10983   (interactive "P")
10984   (gnus-set-global-variables)
10985   (gnus-summary-mark-above score gnus-unread-mark))
10986
10987 (defun gnus-summary-tick-above (&optional score)
10988   "Tick all articles with score above SCORE."
10989   (interactive "P")
10990   (gnus-set-global-variables)
10991   (gnus-summary-mark-above score gnus-ticked-mark))
10992
10993 (defun gnus-summary-mark-above (score mark)
10994   "Mark articles with score over SCORE with MARK."
10995   (interactive "P\ncMark: ")
10996   (gnus-set-global-variables)
10997   (setq score (if score
10998                   (prefix-numeric-value score)
10999                 (or gnus-summary-default-score 0)))
11000   (save-excursion
11001     (set-buffer gnus-summary-buffer)
11002     (goto-char (point-min))
11003     (while (and (progn
11004                   (if (> (gnus-summary-article-score) score)
11005                       (gnus-summary-mark-article nil mark))
11006                   t)
11007                 (gnus-summary-find-next)))))
11008
11009 ;; Suggested by Daniel Quinlan <quinlan@best.com>.  
11010 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
11011 (defun gnus-summary-limit-include-expunged ()
11012   "Display all the hidden articles that were expunged for low scores."
11013   (interactive)
11014   (gnus-set-global-variables)
11015   (let ((buffer-read-only nil))
11016     (let ((scored gnus-newsgroup-scored)
11017           headers h)
11018       (while scored
11019         (or (gnus-summary-goto-subject (car (car scored)))
11020             (and (setq h (gnus-summary-article-header (car (car scored))))
11021                  (< (cdr (car scored)) gnus-summary-expunge-below)
11022                  (setq headers (cons h headers))))
11023         (setq scored (cdr scored)))
11024       (or headers (error "No expunged articles hidden."))
11025       (goto-char (point-min))
11026       (gnus-summary-prepare-unthreaded (nreverse headers)))
11027     (goto-char (point-min))
11028     (gnus-summary-position-point)))
11029
11030 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
11031   "Mark all articles not marked as unread in this newsgroup as read.
11032 If prefix argument ALL is non-nil, all articles are marked as read.
11033 If QUIETLY is non-nil, no questions will be asked.
11034 If TO-HERE is non-nil, it should be a point in the buffer.  All
11035 articles before this point will be marked as read.
11036 The number of articles marked as read is returned."
11037   (interactive "P")
11038   (gnus-set-global-variables)
11039   (prog1
11040       (if (or quietly
11041               (not gnus-interactive-catchup) ;Without confirmation?
11042               gnus-expert-user
11043               (gnus-y-or-n-p
11044                (if all
11045                    "Mark absolutely all articles as read? "
11046                  "Mark all unread articles as read? ")))
11047           (if (and not-mark 
11048                    (not gnus-newsgroup-adaptive)
11049                    (not gnus-newsgroup-auto-expire))
11050               (progn
11051                 (when all
11052                   (setq gnus-newsgroup-marked nil
11053                         gnus-newsgroup-dormant nil))
11054                 (setq gnus-newsgroup-unreads nil))
11055             ;; We actually mark all articles as canceled, which we
11056             ;; have to do when using auto-expiry or adaptive scoring. 
11057             (gnus-summary-show-all-threads)
11058             (if (gnus-summary-first-subject (not all))
11059                 (while (and 
11060                         (if to-here (< (point) to-here) t)
11061                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
11062                         (gnus-summary-find-next (not all)))))
11063             (unless to-here
11064               (setq gnus-newsgroup-unreads nil))
11065             (gnus-set-mode-line 'summary)))
11066     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
11067       (if (and (not to-here) (eq 'nnvirtual (car method)))
11068           (nnvirtual-catchup-group
11069            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
11070     (gnus-summary-position-point)))
11071
11072 (defun gnus-summary-catchup-to-here (&optional all)
11073   "Mark all unticked articles before the current one as read.
11074 If ALL is non-nil, also mark ticked and dormant articles as read."
11075   (interactive "P")
11076   (gnus-set-global-variables)
11077   (save-excursion
11078     (let ((beg (point)))
11079       ;; We check that there are unread articles.
11080       (when (or all (gnus-summary-find-prev))
11081         (gnus-summary-catchup all t beg))))
11082   (gnus-summary-position-point))
11083
11084 (defun gnus-summary-catchup-all (&optional quietly)
11085   "Mark all articles in this newsgroup as read."
11086   (interactive "P")
11087   (gnus-set-global-variables)
11088   (gnus-summary-catchup t quietly))
11089
11090 (defun gnus-summary-catchup-and-exit (&optional all quietly)
11091   "Mark all articles not marked as unread in this newsgroup as read, then exit.
11092 If prefix argument ALL is non-nil, all articles are marked as read."
11093   (interactive "P")
11094   (gnus-set-global-variables)
11095   (gnus-summary-catchup all quietly nil 'fast)
11096   ;; Select next newsgroup or exit.
11097   (if (eq gnus-auto-select-next 'quietly)
11098       (gnus-summary-next-group nil)
11099     (gnus-summary-exit)))
11100
11101 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
11102   "Mark all articles in this newsgroup as read, and then exit."
11103   (interactive "P")
11104   (gnus-set-global-variables)
11105   (gnus-summary-catchup-and-exit t quietly))
11106
11107 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
11108 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
11109   "Mark all articles in this group as read and select the next group.
11110 If given a prefix, mark all articles, unread as well as ticked, as
11111 read." 
11112   (interactive "P")
11113   (gnus-set-global-variables)
11114   (gnus-summary-catchup all)
11115   (gnus-summary-next-group))
11116
11117 ;; Thread-based commands.
11118
11119 (defun gnus-summary-articles-in-thread (&optional article)
11120   "Return a list of all articles in the current thread.
11121 If ARTICLE is non-nil, return all articles in the thread that starts
11122 with that article."
11123   (let* ((article (or article (gnus-summary-article-number)))
11124          (data (gnus-data-find-list article))
11125          (top-level (gnus-data-level (car data)))
11126          (top-subject 
11127           (cond ((null gnus-thread-operation-ignore-subject)
11128                  (gnus-simplify-subject-re
11129                   (mail-header-subject (gnus-data-header (car data)))))
11130                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
11131                  (gnus-simplify-subject-fuzzy
11132                   (mail-header-subject (gnus-data-header (car data)))))
11133                 (t nil)))
11134          articles)
11135     (if (not data)
11136         ()                              ; This article doesn't exist.
11137       (while data
11138         (and (or (not top-subject)
11139                  (string= top-subject
11140                           (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
11141                               (gnus-simplify-subject-fuzzy
11142                                (mail-header-subject 
11143                                 (gnus-data-header (car data))))
11144                             (gnus-simplify-subject-re
11145                              (mail-header-subject 
11146                               (gnus-data-header (car data)))))))
11147              (setq articles (cons (gnus-data-number (car data)) articles)))
11148         (if (and (setq data (cdr data))
11149                  (> (gnus-data-level (car data)) top-level))
11150             ()
11151           (setq data nil)))
11152       ;; Return the list of articles.
11153       (nreverse articles))))
11154
11155 (defun gnus-summary-toggle-threads (&optional arg)
11156   "Toggle showing conversation threads.
11157 If ARG is positive number, turn showing conversation threads on."
11158   (interactive "P")
11159   (gnus-set-global-variables)
11160   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
11161     (setq gnus-show-threads
11162           (if (null arg) (not gnus-show-threads)
11163             (> (prefix-numeric-value arg) 0)))
11164     (gnus-summary-prepare)
11165     (gnus-summary-goto-subject current)
11166     (gnus-summary-position-point)))
11167
11168 (defun gnus-summary-show-all-threads ()
11169   "Show all threads."
11170   (interactive)
11171   (gnus-set-global-variables)
11172   (save-excursion
11173     (let ((buffer-read-only nil))
11174       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
11175   (gnus-summary-position-point))
11176
11177 (defun gnus-summary-show-thread ()
11178   "Show thread subtrees.
11179 Returns nil if no thread was there to be shown."
11180   (interactive)
11181   (gnus-set-global-variables)
11182   (let ((buffer-read-only nil)
11183         (orig (point))
11184         ;; first goto end then to beg, to have point at beg after let
11185         (end (progn (end-of-line) (point)))
11186         (beg (progn (beginning-of-line) (point))))
11187     (prog1
11188         ;; Any hidden lines here?
11189         (search-forward "\r" end t)
11190       (subst-char-in-region beg end ?\^M ?\n t)
11191       (goto-char orig)
11192       (gnus-summary-position-point))))
11193
11194 (defun gnus-summary-hide-all-threads ()
11195   "Hide all thread subtrees."
11196   (interactive)
11197   (gnus-set-global-variables)
11198   (save-excursion
11199     (goto-char (point-min))
11200     (gnus-summary-hide-thread)
11201     (while (zerop (gnus-summary-next-thread 1 t))
11202       (gnus-summary-hide-thread)))
11203   (gnus-summary-position-point))
11204
11205 (defun gnus-summary-hide-thread ()
11206   "Hide thread subtrees.
11207 Returns nil if no threads were there to be hidden."
11208   (interactive)
11209   (gnus-set-global-variables)
11210   (let ((buffer-read-only nil)
11211         (start (point))
11212         (article (gnus-summary-article-number))
11213         end)
11214     ;; Go forward until either the buffer ends or the subthread
11215     ;; ends. 
11216     (when (and (not (eobp))
11217                (or (and (zerop (gnus-summary-next-thread 1 t))
11218                         (gnus-summary-find-prev))
11219                    (goto-char (gnus-data-pos (car (gnus-data-list 'rev))))))
11220       (setq end (point))
11221       (prog1
11222           (if (and (> (point) start)
11223                    (search-backward "\n" start t))
11224               (progn
11225                 (subst-char-in-region start end ?\n ?\^M)
11226                 (gnus-summary-goto-subject article))
11227             (goto-char start)
11228             nil)
11229         (gnus-summary-position-point)))))
11230
11231 (defun gnus-summary-go-to-next-thread (&optional previous)
11232   "Go to the same level (or less) next thread.
11233 If PREVIOUS is non-nil, go to previous thread instead.
11234 Return the article number moved to, or nil if moving was impossible."
11235   (let* ((level (gnus-summary-thread-level))
11236          (article (gnus-summary-article-number))
11237          (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
11238          oart)
11239     (while data
11240       (if (<= (gnus-data-level (car data)) level)
11241           (setq oart (gnus-data-number (car data))
11242                 data nil)
11243         (setq data (cdr data))))
11244     (and oart 
11245          (gnus-summary-goto-subject oart))))
11246
11247 (defun gnus-summary-next-thread (n &optional silent)
11248   "Go to the same level next N'th thread.
11249 If N is negative, search backward instead.
11250 Returns the difference between N and the number of skips actually
11251 done.
11252
11253 If SILENT, don't output messages."
11254   (interactive "p")
11255   (gnus-set-global-variables)
11256   (let ((backward (< n 0))
11257         (n (abs n)))
11258     (while (and (> n 0)
11259                 (gnus-summary-go-to-next-thread backward))
11260       (decf n))
11261     (gnus-summary-position-point)
11262     (when (and (not silent) (/= 0 n))
11263       (gnus-message 7 "No more threads"))
11264     n))
11265
11266 (defun gnus-summary-prev-thread (n)
11267   "Go to the same level previous N'th thread.
11268 Returns the difference between N and the number of skips actually
11269 done."
11270   (interactive "p")
11271   (gnus-set-global-variables)
11272   (gnus-summary-next-thread (- n)))
11273
11274 (defun gnus-summary-go-down-thread ()
11275   "Go down one level in the current thread."
11276   (let ((children (gnus-summary-article-children)))
11277     (and children
11278          (gnus-summary-goto-subject (car children)))))
11279
11280 (defun gnus-summary-go-up-thread ()
11281   "Go up one level in the current thread."
11282   (let ((parent (gnus-summary-article-parent)))
11283     (and parent
11284          (gnus-summary-goto-subject parent))))
11285
11286 (defun gnus-summary-down-thread (n)
11287   "Go down thread N steps.
11288 If N is negative, go up instead.
11289 Returns the difference between N and how many steps down that were
11290 taken."
11291   (interactive "p")
11292   (gnus-set-global-variables)
11293   (let ((up (< n 0))
11294         (n (abs n)))
11295     (while (and (> n 0)
11296                 (if up (gnus-summary-go-up-thread)
11297                   (gnus-summary-go-down-thread)))
11298       (setq n (1- n)))
11299     (gnus-summary-position-point)
11300     (if (/= 0 n) (gnus-message 7 "Can't go further"))
11301     n))
11302
11303 (defun gnus-summary-up-thread (n)
11304   "Go up thread N steps.
11305 If N is negative, go up instead.
11306 Returns the difference between N and how many steps down that were
11307 taken."
11308   (interactive "p")
11309   (gnus-set-global-variables)
11310   (gnus-summary-down-thread (- n)))
11311
11312 (defun gnus-summary-kill-thread (&optional unmark)
11313   "Mark articles under current thread as read.
11314 If the prefix argument is positive, remove any kinds of marks.
11315 If the prefix argument is negative, tick articles instead."
11316   (interactive "P")
11317   (gnus-set-global-variables)
11318   (if unmark
11319       (setq unmark (prefix-numeric-value unmark)))
11320   (let ((articles (gnus-summary-articles-in-thread)))
11321     (save-excursion
11322       ;; Expand the thread.
11323       (gnus-summary-show-thread)
11324       ;; Mark all the articles.
11325       (while articles
11326         (gnus-summary-goto-subject (car articles))
11327         (cond ((null unmark) 
11328                (gnus-summary-mark-article-as-read gnus-killed-mark))
11329               ((> unmark 0) 
11330                (gnus-summary-mark-article-as-unread gnus-unread-mark))
11331               (t 
11332                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
11333         (setq articles (cdr articles))))
11334     ;; Hide killed subtrees.
11335     (and (null unmark)
11336          gnus-thread-hide-killed
11337          (gnus-summary-hide-thread))
11338     ;; If marked as read, go to next unread subject.
11339     (if (null unmark)
11340         ;; Go to next unread subject.
11341         (gnus-summary-next-subject 1 t)))
11342   (gnus-set-mode-line 'summary))
11343
11344 ;; Summary sorting commands
11345
11346 (defun gnus-summary-sort-by-number (&optional reverse)
11347   "Sort summary buffer by article number.
11348 Argument REVERSE means reverse order."
11349   (interactive "P")
11350   (gnus-set-global-variables)
11351   (gnus-summary-sort 
11352    ;; `gnus-summary-article-number' is a macro, and `sort-subr' wants
11353    ;; a function, so we wrap it.
11354    (cons (lambda () (gnus-summary-article-number))
11355          'gnus-thread-sort-by-number) reverse))
11356
11357 (defun gnus-summary-sort-by-author (&optional reverse)
11358   "Sort summary buffer by author name alphabetically.
11359 If case-fold-search is non-nil, case of letters is ignored.
11360 Argument REVERSE means reverse order."
11361   (interactive "P")
11362   (gnus-set-global-variables)
11363   (gnus-summary-sort
11364    (cons
11365     (lambda ()
11366       (let* ((header (gnus-summary-article-header))
11367              (extract (funcall
11368                        gnus-extract-address-components
11369                        (mail-header-from header))))
11370         (concat (or (car extract) (cdr extract))
11371                 "\r" (mail-header-subject header))))
11372     'gnus-thread-sort-by-author)
11373    reverse))
11374
11375 (defun gnus-summary-sort-by-subject (&optional reverse)
11376   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
11377 If case-fold-search is non-nil, case of letters is ignored.
11378 Argument REVERSE means reverse order."
11379   (interactive "P")
11380   (gnus-set-global-variables)
11381   (gnus-summary-sort
11382    (cons
11383     (lambda ()
11384       (let* ((header (gnus-summary-article-header))
11385              (extract (funcall
11386                        gnus-extract-address-components
11387                        (mail-header-from header))))
11388         (concat 
11389          (downcase (gnus-simplify-subject (gnus-summary-article-subject) t))
11390          "\r" (or (car extract) (cdr extract)))))
11391     'gnus-thread-sort-by-subject)
11392    reverse))
11393
11394 (defun gnus-summary-sort-by-date (&optional reverse)
11395   "Sort summary buffer by date.
11396 Argument REVERSE means reverse order."
11397   (interactive "P")
11398   (gnus-set-global-variables)
11399   (gnus-summary-sort
11400    (cons
11401     (lambda ()
11402       (gnus-sortable-date
11403        (mail-header-date 
11404         (gnus-summary-article-header))))
11405     'gnus-thread-sort-by-date)
11406    reverse))
11407
11408 (defun gnus-summary-sort-by-score (&optional reverse)
11409   "Sort summary buffer by score.
11410 Argument REVERSE means reverse order."
11411   (interactive "P")
11412   (gnus-set-global-variables)
11413   (gnus-summary-sort 
11414    (cons (lambda () (gnus-summary-article-score))
11415          'gnus-thread-sort-by-score)
11416    (not reverse)))
11417
11418 (defun gnus-summary-sort (predicate reverse)
11419   "Sort summary buffer by PREDICATE.  REVERSE means reverse order. 
11420 PREDICATE is a cons of `(unthreaded-func . threaded-func)'."
11421   (let (buffer-read-only)
11422     (if (not gnus-show-threads)
11423         ;; We do untreaded sorting...
11424         (progn
11425           (goto-char (point-min))
11426           (sort-subr reverse 'forward-line 'end-of-line (car predicate))
11427           (gnus-data-compute-positions))
11428       ;; ... or we do threaded sorting.
11429       (let ((gnus-thread-sort-functions (list (cdr predicate)))
11430             (gnus-summary-prepare-hook nil))
11431         ;; We do that by simply regenerating the threads.
11432         (gnus-summary-prepare)
11433         ;; Hide subthreads if needed.
11434         (when gnus-thread-hide-subtree
11435           (gnus-summary-hide-all-threads))))
11436     ;; If in async mode, we send some info to the backend.
11437     (when gnus-newsgroup-async
11438       (gnus-request-asynchronous 
11439        gnus-newsgroup-name gnus-newsgroup-data))))
11440   
11441 (defun gnus-sortable-date (date)
11442   "Make sortable string by string-lessp from DATE.
11443 Timezone package is used."
11444   (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
11445          (year (aref date 0))
11446          (month (aref date 1))
11447          (day (aref date 2)))
11448     (timezone-make-sortable-date 
11449      year month day 
11450      (timezone-make-time-string
11451       (aref date 3) (aref date 4) (aref date 5)))))
11452
11453
11454 ;; Summary saving commands.
11455
11456 (defun gnus-summary-save-article (&optional n)
11457   "Save the current article using the default saver function.
11458 If N is a positive number, save the N next articles.
11459 If N is a negative number, save the N previous articles.
11460 If N is nil and any articles have been marked with the process mark,
11461 save those articles instead.
11462 The variable `gnus-default-article-saver' specifies the saver function."
11463   (interactive "P")
11464   (gnus-set-global-variables)
11465   (let ((articles (gnus-summary-work-articles n))
11466         file)
11467     (while articles
11468       (let ((header (gnus-summary-article-header (car articles))))
11469         (if (vectorp header)
11470             (progn
11471               (save-window-excursion
11472                 (gnus-summary-select-article t nil nil (car articles)))
11473               (or gnus-save-all-headers
11474                   ;; Remove headers accoring to `gnus-saved-headers'.
11475                   (let ((gnus-visible-headers 
11476                          (or gnus-saved-headers gnus-visible-headers)))
11477                     (gnus-article-hide-headers t)))
11478               ;; Remove any X-Gnus lines.
11479               (save-excursion
11480                 (save-restriction
11481                   (set-buffer gnus-article-buffer)
11482                   (let ((buffer-read-only nil))
11483                     (goto-char (point-min))
11484                     (narrow-to-region (point) (or (search-forward "\n\n" nil t)
11485                                                   (point-max)))
11486                     (while (re-search-forward "^X-Gnus" nil t)
11487                       (beginning-of-line)
11488                       (delete-region (point)
11489                                      (progn (forward-line 1) (point))))
11490                     (widen))))
11491               (save-window-excursion
11492                 (if gnus-default-article-saver
11493                     (setq file (funcall
11494                                 gnus-default-article-saver
11495                                 (cond
11496                                  ((not gnus-prompt-before-saving)
11497                                   'default)
11498                                  ((eq gnus-prompt-before-saving 'always)
11499                                   nil)
11500                                  (t file))))
11501                   (error "No default saver is defined."))))
11502           (if (assq 'name header)
11503               (gnus-copy-file (cdr (assq 'name header)))
11504             (gnus-message 1 "Article %d is unsaveable" (car articles)))))
11505       (gnus-summary-remove-process-mark (car articles))
11506       (setq articles (cdr articles)))
11507     (gnus-summary-position-point)
11508     n))
11509
11510 (defun gnus-summary-pipe-output (&optional arg)
11511   "Pipe the current article to a subprocess.
11512 If N is a positive number, pipe the N next articles.
11513 If N is a negative number, pipe the N previous articles.
11514 If N is nil and any articles have been marked with the process mark,
11515 pipe those articles instead."
11516   (interactive "P")
11517   (gnus-set-global-variables)
11518   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
11519     (gnus-summary-save-article arg))
11520   (gnus-configure-windows 'pipe))
11521
11522 (defun gnus-summary-save-article-mail (&optional arg)
11523   "Append the current article to an mail file.
11524 If N is a positive number, save the N next articles.
11525 If N is a negative number, save the N previous articles.
11526 If N is nil and any articles have been marked with the process mark,
11527 save those articles instead."
11528   (interactive "P")
11529   (gnus-set-global-variables)
11530   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
11531     (gnus-summary-save-article arg)))
11532
11533 (defun gnus-summary-save-article-rmail (&optional arg)
11534   "Append the current article to an rmail file.
11535 If N is a positive number, save the N next articles.
11536 If N is a negative number, save the N previous articles.
11537 If N is nil and any articles have been marked with the process mark,
11538 save those articles instead."
11539   (interactive "P")
11540   (gnus-set-global-variables)
11541   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
11542     (gnus-summary-save-article arg)))
11543
11544 (defun gnus-summary-save-article-file (&optional arg)
11545   "Append the current article to a file.
11546 If N is a positive number, save the N next articles.
11547 If N is a negative number, save the N previous articles.
11548 If N is nil and any articles have been marked with the process mark,
11549 save those articles instead."
11550   (interactive "P")
11551   (gnus-set-global-variables)
11552   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
11553     (gnus-summary-save-article arg)))
11554
11555 (defun gnus-summary-save-article-body-file (&optional arg)
11556   "Append the current article body to a file.
11557 If N is a positive number, save the N next articles.
11558 If N is a negative number, save the N previous articles.
11559 If N is nil and any articles have been marked with the process mark,
11560 save those articles instead."
11561   (interactive "P")
11562   (gnus-set-global-variables)
11563   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
11564     (gnus-summary-save-article arg)))
11565
11566 (defun gnus-read-save-file-name (prompt default-name)
11567   (let ((methods gnus-split-methods)
11568         split-name method)
11569     ;; Let the split methods have their say.
11570     (when gnus-split-methods
11571       (save-excursion
11572         (set-buffer gnus-original-article-buffer)
11573         (gnus-narrow-to-headers)
11574         (while methods
11575           (goto-char (point-min))
11576           (setq method (pop methods))
11577           (when (cond ((stringp (car method))
11578                        (condition-case () 
11579                            (re-search-forward (car method) nil t)
11580                          (error nil)))
11581                       ((gnus-functionp (car method))
11582                        (funcall (car method)))
11583                       ((consp (car method))
11584                        (eval (car method))))
11585             (setq split-name (cons (nth 1 methods) split-name))))
11586         (widen)))
11587     (cond
11588      ;; No split name was found
11589      ((null split-name)
11590       (read-file-name
11591        (concat prompt " (default " (file-name-nondirectory default-name) ") ")
11592        (file-name-directory default-name)
11593        default-name))
11594      ;; A single split name was found
11595      ((= 1 (length split-name))
11596       (read-file-name
11597        (concat prompt " (default " (car split-name) ") ")
11598        gnus-article-save-directory
11599        (concat gnus-article-save-directory (car split-name))))
11600      ;; A list of splits was found.
11601      (t
11602       (setq split-name (mapcar (lambda (el) (list el)) (nreverse split-name)))
11603       (let ((result (completing-read (concat prompt " ") split-name nil nil)))
11604         (concat gnus-article-save-directory
11605                 (if (string= result "")
11606                     (car (car split-name))
11607                   result)))))))
11608
11609 (defun gnus-summary-save-in-rmail (&optional filename)
11610   "Append this article to Rmail file.
11611 Optional argument FILENAME specifies file name.
11612 Directory to save to is default to `gnus-article-save-directory' which
11613 is initialized from the SAVEDIR environment variable."
11614   (interactive)
11615   (gnus-set-global-variables)
11616   (let ((default-name
11617           (funcall gnus-rmail-save-name gnus-newsgroup-name
11618                    gnus-current-headers gnus-newsgroup-last-rmail)))
11619     (setq filename
11620           (cond ((eq filename 'default)
11621                  default-name)
11622                 (filename filename)
11623                 (t (gnus-read-save-file-name 
11624                     "Save in rmail file:" default-name))))
11625     (gnus-make-directory (file-name-directory filename))
11626     (gnus-eval-in-buffer-window 
11627      gnus-original-article-buffer
11628      (save-excursion
11629        (save-restriction
11630          (widen)
11631          (gnus-output-to-rmail filename))))
11632     ;; Remember the directory name to save articles
11633     (setq gnus-newsgroup-last-rmail filename)))
11634
11635 (defun gnus-summary-save-in-mail (&optional filename)
11636   "Append this article to Unix mail file.
11637 Optional argument FILENAME specifies file name.
11638 Directory to save to is default to `gnus-article-save-directory' which
11639 is initialized from the SAVEDIR environment variable."
11640   (interactive)
11641   (gnus-set-global-variables)
11642   (let ((default-name
11643           (funcall gnus-mail-save-name gnus-newsgroup-name
11644                    gnus-current-headers gnus-newsgroup-last-mail)))
11645     (setq filename
11646           (cond ((eq filename 'default)
11647                  default-name)
11648                 (filename filename)
11649                 (t (gnus-read-save-file-name 
11650                     "Save in Unix mail file:" default-name))))
11651     (setq filename
11652           (expand-file-name filename
11653                             (and default-name
11654                                  (file-name-directory default-name))))
11655     (gnus-make-directory (file-name-directory filename))
11656     (gnus-eval-in-buffer-window 
11657      gnus-original-article-buffer
11658      (save-excursion
11659        (save-restriction
11660          (widen)
11661          (if (and (file-readable-p filename) (mail-file-babyl-p filename))
11662              (gnus-output-to-rmail filename)
11663            (rmail-output filename 1 t t)))))
11664     ;; Remember the directory name to save articles.
11665     (setq gnus-newsgroup-last-mail filename)))
11666
11667 (defun gnus-summary-save-in-file (&optional filename)
11668   "Append this article to file.
11669 Optional argument FILENAME specifies file name.
11670 Directory to save to is default to `gnus-article-save-directory' which
11671 is initialized from the SAVEDIR environment variable."
11672   (interactive)
11673   (gnus-set-global-variables)
11674   (let ((default-name
11675           (funcall gnus-file-save-name gnus-newsgroup-name
11676                    gnus-current-headers gnus-newsgroup-last-file)))
11677     (setq filename
11678           (cond ((eq filename 'default)
11679                  default-name)
11680                 (filename filename)
11681                 (t (gnus-read-save-file-name 
11682                     "Save in file:" default-name))))
11683     (gnus-make-directory (file-name-directory filename))
11684     (gnus-eval-in-buffer-window 
11685      gnus-article-buffer
11686      (save-excursion
11687        (save-restriction
11688          (widen)
11689          (gnus-output-to-file filename))))
11690     ;; Remember the directory name to save articles.
11691     (setq gnus-newsgroup-last-file filename)))
11692
11693 (defun gnus-summary-save-body-in-file (&optional filename)
11694   "Append this article body to a file.
11695 Optional argument FILENAME specifies file name.
11696 The directory to save in defaults to `gnus-article-save-directory' which
11697 is initialized from the SAVEDIR environment variable."
11698   (interactive)
11699   (gnus-set-global-variables)
11700   (let ((default-name
11701           (funcall gnus-file-save-name gnus-newsgroup-name
11702                    gnus-current-headers gnus-newsgroup-last-file)))
11703     (setq filename
11704           (cond ((eq filename 'default)
11705                  default-name)
11706                 (filename filename)
11707                 (t (gnus-read-save-file-name 
11708                     "Save body in file:" default-name))))
11709     (gnus-make-directory (file-name-directory filename))
11710     (gnus-eval-in-buffer-window 
11711      gnus-article-buffer
11712      (save-excursion
11713        (save-restriction
11714          (widen)
11715          (goto-char (point-min))
11716          (and (search-forward "\n\n" nil t)
11717               (narrow-to-region (point) (point-max)))
11718          (gnus-output-to-file filename))))
11719     ;; Remember the directory name to save articles.
11720     (setq gnus-newsgroup-last-file filename)))
11721
11722 (defun gnus-summary-save-in-pipe (&optional command)
11723   "Pipe this article to subprocess."
11724   (interactive)
11725   (gnus-set-global-variables)
11726   (setq command
11727         (cond ((eq command 'default)
11728                gnus-last-shell-command)
11729               (command command)
11730               (t (read-string "Shell command on article: "
11731                               gnus-last-shell-command))))
11732   (if (string-equal command "")
11733       (setq command gnus-last-shell-command))
11734   (gnus-eval-in-buffer-window 
11735    gnus-article-buffer
11736    (save-restriction
11737      (widen)
11738      (shell-command-on-region (point-min) (point-max) command nil)))
11739   (setq gnus-last-shell-command command))
11740
11741 ;; Summary extract commands
11742
11743 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
11744   (let ((buffer-read-only nil)
11745         (article (gnus-summary-article-number))
11746         after-article b e)
11747     (or (gnus-summary-goto-subject article)
11748         (error (format "No such article: %d" article)))
11749     (gnus-summary-position-point)
11750     ;; If all commands are to be bunched up on one line, we collect
11751     ;; them here.  
11752     (if gnus-view-pseudos-separately
11753         ()
11754       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
11755             files action)
11756         (while ps
11757           (setq action (cdr (assq 'action (car ps))))
11758           (setq files (list (cdr (assq 'name (car ps)))))
11759           (while (and ps (cdr ps)
11760                       (string= (or action "1")
11761                                (or (cdr (assq 'action (car (cdr ps)))) "2")))
11762             (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
11763             (setcdr ps (cdr (cdr ps))))
11764           (if (not files)
11765               ()
11766             (if (not (string-match "%s" action))
11767                 (setq files (cons " " files)))
11768             (setq files (cons " " files))
11769             (and (assq 'execute (car ps))
11770                  (setcdr (assq 'execute (car ps))
11771                          (funcall (if (string-match "%s" action)
11772                                       'format 'concat)
11773                                   action 
11774                                   (mapconcat (lambda (f) f) files " ")))))
11775           (setq ps (cdr ps)))))
11776     (if (and gnus-view-pseudos (not not-view))
11777         (while pslist
11778           (and (assq 'execute (car pslist))
11779                (gnus-execute-command (cdr (assq 'execute (car pslist)))
11780                                      (eq gnus-view-pseudos 'not-confirm)))
11781           (setq pslist (cdr pslist)))
11782       (save-excursion
11783         (while pslist
11784           (setq after-article (or (cdr (assq 'article (car pslist)))
11785                                   (gnus-summary-article-number)))
11786           (gnus-summary-goto-subject after-article)
11787           (forward-line 1)
11788           (setq b (point))
11789           (insert "          " (file-name-nondirectory
11790                                 (cdr (assq 'name (car pslist))))
11791                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
11792           (setq e (point))
11793           (forward-line -1)             ; back to `b'
11794           (put-text-property b e 'gnus-number gnus-reffed-article-number)
11795           (gnus-data-enter after-article
11796                            gnus-reffed-article-number
11797                            gnus-unread-mark 
11798                            b
11799                            (car pslist) 
11800                            0 
11801                            (- e b))
11802           (setq gnus-newsgroup-unreads
11803                 (cons gnus-reffed-article-number gnus-newsgroup-unreads))
11804           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
11805           (setq pslist (cdr pslist)))))))
11806
11807 (defun gnus-pseudos< (p1 p2)
11808   (let ((c1 (cdr (assq 'action p1)))
11809         (c2 (cdr (assq 'action p2))))
11810     (and c1 c2 (string< c1 c2))))
11811
11812 (defun gnus-request-pseudo-article (props)
11813   (cond ((assq 'execute props)
11814          (gnus-execute-command (cdr (assq 'execute props)))))
11815   (let ((gnus-current-article (gnus-summary-article-number)))
11816     (run-hooks 'gnus-mark-article-hook)))
11817
11818 (defun gnus-execute-command (command &optional automatic)
11819   (save-excursion
11820     (gnus-article-setup-buffer)
11821     (set-buffer gnus-article-buffer)
11822     (let ((command (if automatic command (read-string "Command: " command)))
11823           (buffer-read-only nil))
11824       (erase-buffer)
11825       (insert "$ " command "\n\n")
11826       (if gnus-view-pseudo-asynchronously
11827           (start-process "gnus-execute" nil "sh" "-c" command)
11828         (call-process "sh" nil t nil "-c" command)))))
11829
11830 (defun gnus-copy-file (file &optional to)
11831   "Copy FILE to TO."
11832   (interactive
11833    (list (read-file-name "Copy file: " default-directory)
11834          (read-file-name "Copy file to: " default-directory)))
11835   (gnus-set-global-variables)
11836   (or to (setq to (read-file-name "Copy file to: " default-directory)))
11837   (and (file-directory-p to) 
11838        (setq to (concat (file-name-as-directory to)
11839                         (file-name-nondirectory file))))
11840   (copy-file file to))
11841
11842 ;; Summary kill commands.
11843
11844 (defun gnus-summary-edit-global-kill (article)
11845   "Edit the \"global\" kill file."
11846   (interactive (list (gnus-summary-article-number)))
11847   (gnus-set-global-variables)
11848   (gnus-group-edit-global-kill article))
11849
11850 (defun gnus-summary-edit-local-kill ()
11851   "Edit a local kill file applied to the current newsgroup."
11852   (interactive)
11853   (gnus-set-global-variables)
11854   (setq gnus-current-headers (gnus-summary-article-header))
11855   (gnus-set-global-variables)
11856   (gnus-group-edit-local-kill 
11857    (gnus-summary-article-number) gnus-newsgroup-name))
11858
11859 \f
11860 ;;;
11861 ;;; Gnus article mode
11862 ;;;
11863
11864 (put 'gnus-article-mode 'mode-class 'special)
11865
11866 (if gnus-article-mode-map
11867     nil
11868   (setq gnus-article-mode-map (make-keymap))
11869   (suppress-keymap gnus-article-mode-map)
11870   (define-key gnus-article-mode-map " " 'gnus-article-next-page)
11871   (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
11872   (define-key gnus-article-mode-map "\C-c^" 'gnus-article-refer-article)
11873   (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
11874   (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
11875   (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail)
11876   (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
11877   (define-key gnus-article-mode-map gnus-mouse-2 'gnus-article-push-button)
11878   (define-key gnus-article-mode-map "\r" 'gnus-article-press-button)
11879   (define-key gnus-article-mode-map "\t" 'gnus-article-next-button)
11880   (define-key gnus-article-mode-map "\C-c\C-b" 'gnus-bug)
11881   
11882   ;; Duplicate almost all summary keystrokes in the article mode map.
11883   (let ((commands 
11884          (list 
11885           "p" "N" "P" "\M-\C-n" "\M-\C-p"
11886           "\M-n" "\M-p" "." "," "\M-s" "\M-r" "<" ">" "j"
11887           "u" "!" "U" "d" "D" "E" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k"
11888           "\M-\C-l" "e" "#" "\M-#" "\M-\C-t" "\M-\C-s" "\M-\C-h"
11889           "\M-\C-f" "\M-\C-b" "\M-\C-u" "\M-\C-d" "&" "\C-w"
11890           "\C-t" "?" "\C-c\M-\C-s" "\C-c\C-s\C-n" "\C-c\C-s\C-a"
11891           "\C-c\C-s\C-s" "\C-c\C-s\C-d" "\C-c\C-s\C-i" "\C-x\C-s"
11892           "\M-g" "w" "\C-c\C-r" "\M-t" "C"
11893           "o" "\C-o" "|" "\M-k" "\M-K" "V" "\C-c\C-d"
11894           "\C-c\C-i" "x" "X" "t" "g" "?" "l"
11895           "\C-c\C-v\C-v" "\C-d" "v" 
11896 ;;        "Mt" "M!" "Md" "Mr"
11897 ;;        "Mc" "M " "Me" "Mx" "M?" "Mb" "MB" "M#" "M\M-#" "M\M-r"
11898 ;;        "M\M-\C-r" "MD" "M\M-D" "MS" "MC" "MH" "M\C-c" "Mk" "MK"
11899 ;;        "Ms" "Mc" "Mu" "Mm" "Mk" "Gn" "Gp" "GN" "GP" "G\C-n" "G\C-p"
11900 ;;        "G\M-n" "G\M-p" "Gf" "Gb" "Gg" "Gl" "Gp" "Tk" "Tl" "Ti" "TT"
11901 ;;        "Ts" "TS" "Th" "TH" "Tn" "Tp" "Tu" "Td" "T#" "A " "An" "A\177" "Ap"
11902 ;;        "A\r" "A<" "A>" "Ab" "Ae" "A^" "Ar" "Aw" "Ac" "Ag" "At" "Am"
11903 ;;        "As" "Wh" "Ws" "Wc" "Wo" "Ww" "Wd" "Wq" "Wf" "Wt" "W\C-t"
11904 ;;        "WT" "WA" "Wa" "WH" "WC" "WS" "Wb" "Hv" "Hf" "Hd" "Hh" "Hi"
11905 ;;        "Be" "B\177" "Bm" "Br" "Bw" "Bc" "Bq" "Bi" "Oo" "Om" "Or"
11906 ;;        "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve"
11907 ;;        "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi"
11908           )))
11909     (while commands
11910       (define-key gnus-article-mode-map (car commands) 
11911         'gnus-article-summary-command)
11912       (setq commands (cdr commands))))
11913
11914   (let ((commands (list "q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
11915 ;;                      "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" 
11916                          "=" "n"  "^" "\M-^")))
11917     (while commands
11918       (define-key gnus-article-mode-map (car commands) 
11919         'gnus-article-summary-command-nosave)
11920       (setq commands (cdr commands)))))
11921
11922
11923 (defun gnus-article-mode ()
11924   "Major mode for displaying an article.
11925
11926 All normal editing commands are switched off.
11927
11928 The following commands are available:
11929
11930 \\<gnus-article-mode-map>
11931 \\[gnus-article-next-page]\t Scroll the article one page forwards
11932 \\[gnus-article-prev-page]\t Scroll the article one page backwards
11933 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
11934 \\[gnus-article-show-summary]\t Display the summary buffer
11935 \\[gnus-article-mail]\t Send a reply to the address near point
11936 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
11937 \\[gnus-info-find-node]\t Go to the Gnus info node"
11938   (interactive)
11939   (when (and menu-bar-mode
11940              (gnus-visual-p 'article-menu 'menu))
11941     (gnus-article-make-menu-bar))
11942   (kill-all-local-variables)
11943   (setq mode-line-modified "-- ")
11944   (make-local-variable 'mode-line-format)
11945   (setq mode-line-format (copy-sequence mode-line-format))
11946   (and (equal (nth 3 mode-line-format) "   ")
11947        (setcar (nthcdr 3 mode-line-format) ""))
11948   (setq mode-name "Article")
11949   (setq major-mode 'gnus-article-mode)
11950   (make-local-variable 'minor-mode-alist)
11951   (or (assq 'gnus-show-mime minor-mode-alist)
11952       (setq minor-mode-alist
11953             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
11954   (use-local-map gnus-article-mode-map)
11955   (make-local-variable 'page-delimiter)
11956   (setq page-delimiter gnus-page-delimiter)
11957   (buffer-disable-undo (current-buffer))
11958   (setq buffer-read-only t)             ;Disable modification
11959   (run-hooks 'gnus-article-mode-hook))
11960
11961 (defun gnus-article-setup-buffer ()
11962   "Initialize article mode buffer."
11963   ;; Returns the article buffer.
11964   (if (get-buffer gnus-article-buffer)
11965       (save-excursion
11966         (set-buffer gnus-article-buffer)
11967         (buffer-disable-undo (current-buffer))
11968         (setq buffer-read-only t)
11969         (gnus-add-current-to-buffer-list)
11970         (or (eq major-mode 'gnus-article-mode)
11971             (gnus-article-mode))
11972         (current-buffer))
11973     (save-excursion
11974       (set-buffer (get-buffer-create gnus-article-buffer))
11975       (gnus-add-current-to-buffer-list)
11976       (gnus-article-mode)
11977       (current-buffer))))
11978
11979 ;; Set article window start at LINE, where LINE is the number of lines
11980 ;; from the head of the article.
11981 (defun gnus-article-set-window-start (&optional line)
11982   (set-window-start 
11983    (get-buffer-window gnus-article-buffer)
11984    (save-excursion
11985      (set-buffer gnus-article-buffer)
11986      (goto-char (point-min))
11987      (if (not line)
11988          (point-min)
11989        (gnus-message 6 "Moved to bookmark")
11990        (search-forward "\n\n" nil t)
11991        (forward-line line)
11992        (point)))))
11993
11994 (defun gnus-request-article-this-buffer (article group)
11995   "Get an article and insert it into this buffer."
11996   (prog1
11997       (save-excursion
11998         (if (get-buffer gnus-original-article-buffer)
11999             (set-buffer (get-buffer gnus-original-article-buffer))
12000           (set-buffer (get-buffer-create gnus-original-article-buffer))
12001           (buffer-disable-undo (current-buffer))
12002           (setq major-mode 'gnus-original-article-mode)
12003           (setq buffer-read-only t)
12004           (gnus-add-current-to-buffer-list))
12005
12006         (setq group (or group gnus-newsgroup-name))
12007
12008         ;; Open server if it has closed.
12009         (gnus-check-server (gnus-find-method-for-group group))
12010
12011         ;; Using `gnus-request-article' directly will insert the article into
12012         ;; `nntp-server-buffer' - so we'll save some time by not having to
12013         ;; copy it from the server buffer into the article buffer.
12014
12015         ;; We only request an article by message-id when we do not have the
12016         ;; headers for it, so we'll have to get those.
12017         (and (stringp article) 
12018              (let ((gnus-override-method gnus-refer-article-method))
12019                (gnus-read-header article)))
12020
12021         ;; If the article number is negative, that means that this article
12022         ;; doesn't belong in this newsgroup (possibly), so we find its
12023         ;; message-id and request it by id instead of number.
12024         (if (not (numberp article))
12025             ()
12026           (save-excursion
12027             (set-buffer gnus-summary-buffer)
12028             (let ((header (gnus-summary-article-header article)))
12029               (if (< article 0)
12030                   (if (vectorp header)
12031                       ;; It's a real article.
12032                       (setq article (mail-header-id header))
12033                     ;; It is an extracted pseudo-article.
12034                     (setq article 'pseudo)
12035                     (gnus-request-pseudo-article header)))
12036
12037               (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
12038                 (if (not (eq (car method) 'nneething))
12039                     ()
12040                   (let ((dir (concat (file-name-as-directory (nth 1 method))
12041                                      (mail-header-subject header))))
12042                     (if (file-directory-p dir)
12043                         (progn
12044                           (setq article 'nneething)
12045                           (gnus-group-enter-directory dir)))))))))
12046
12047         (cond 
12048          ;; We first check `gnus-original-article-buffer'.
12049          ((and (equal (car gnus-original-article) group)
12050                (eq (cdr gnus-original-article) article))
12051           ;; We don't have to do anything, since it's already where we
12052           ;; want it.  
12053           'article)
12054          ;; Check the backlog.
12055          ((and gnus-keep-backlog
12056                (gnus-backlog-request-article group article (current-buffer)))
12057           'article)
12058          ;; Check the cache.
12059          ((and gnus-use-cache
12060                (numberp article)
12061                (gnus-cache-request-article article group))
12062           'article)
12063          ;; Get the article and put into the article buffer.
12064          ((or (stringp article) (numberp article))
12065           (let ((gnus-override-method 
12066                  (and (stringp article) gnus-refer-article-method))
12067                 (buffer-read-only nil))
12068             (erase-buffer)
12069             ;; There may be some overlays that we have to kill...
12070             (insert "i")
12071             (let ((overlays (and (fboundp 'overlays-at)
12072                                  (overlays-at (point-min)))))
12073               (while overlays
12074                 (delete-overlay (car overlays))
12075                 (setq overlays (cdr overlays))))
12076             (erase-buffer)        
12077             (if (gnus-request-article article group (current-buffer))
12078                 (progn
12079                   (and gnus-keep-backlog 
12080                        (gnus-backlog-enter-article 
12081                         group article (current-buffer)))
12082                   'article))))
12083          ;; It was a pseudo.
12084          (t article)))
12085     (setq gnus-original-article (cons group article))
12086     (let (buffer-read-only)
12087       (erase-buffer)
12088       ;; There may be some overlays that we have to kill...
12089       (insert "i")
12090       (let ((overlays (and (fboundp 'overlays-at)
12091                            (overlays-at (point-min)))))
12092         (while overlays
12093           (delete-overlay (pop overlays))))
12094       (erase-buffer)
12095       (insert-buffer-substring gnus-original-article-buffer))))
12096
12097 (defun gnus-read-header (id)
12098   "Read the headers of article ID and enter them into the Gnus system."
12099   (let ((group gnus-newsgroup-name)
12100         (headers gnus-newsgroup-headers)
12101         header where)
12102     ;; First we check to see whether the header in question is already
12103     ;; fetched. 
12104     (if (stringp id)
12105         ;; This is a Message-ID.
12106         (while headers
12107           (if (string= id (mail-header-id (car headers)))
12108               (setq header (car headers)
12109                     headers nil)
12110             (setq headers (cdr headers))))
12111       ;; This is an article number.
12112       (while headers
12113         (if (= id (mail-header-number (car headers)))
12114             (setq header (car headers)
12115                   headers nil)
12116           (setq headers (cdr headers)))))
12117     (if header
12118         ;; We have found the header.
12119         header
12120       ;; We have to really fetch the header to this article.
12121       (when (setq where
12122                   (if (gnus-check-backend-function 'request-head group)
12123                       (gnus-request-head id group)
12124                     (gnus-request-article id group)))
12125         (save-excursion
12126           (set-buffer nntp-server-buffer)
12127           (and (search-forward "\n\n" nil t)
12128                (delete-region (1- (point)) (point-max)))
12129           (goto-char (point-max))
12130           (insert ".\n")
12131           (goto-char (point-min))
12132           (insert "211 "
12133                   (int-to-string
12134                    (cond
12135                     ((numberp id)
12136                      id)
12137                     ((cdr where)
12138                      (cdr where))
12139                     (t
12140                      gnus-reffed-article-number)))
12141                   " Article retrieved.\n"))
12142         (if (not (setq header (car (gnus-get-newsgroup-headers))))
12143             () ; Malformed head.
12144           (if (and (stringp id)
12145                    (not (string= (gnus-group-real-name group)
12146                                  (car where))))
12147               ;; If we fetched by Message-ID and the article came
12148               ;; from a different group, we fudge some bogus article
12149               ;; numbers for this article.
12150               (mail-header-set-number header gnus-reffed-article-number))
12151           (decf gnus-reffed-article-number)
12152           (push header gnus-newsgroup-headers)
12153           (setq gnus-current-headers header)
12154           (push (mail-header-number header) gnus-newsgroup-limit)
12155           header)))))
12156
12157 (defun gnus-article-prepare (article &optional all-headers header)
12158   "Prepare ARTICLE in article mode buffer.
12159 ARTICLE should either be an article number or a Message-ID.
12160 If ARTICLE is an id, HEADER should be the article headers.
12161 If ALL-HEADERS is non-nil, no headers are hidden."
12162   (save-excursion
12163     ;; Make sure we start in a summary buffer.
12164     (unless (eq major-mode 'gnus-summary-mode)
12165       (set-buffer gnus-summary-buffer))
12166     (setq gnus-summary-buffer (current-buffer))
12167     ;; Make sure the connection to the server is alive.
12168     (unless (gnus-server-opened
12169              (gnus-find-method-for-group gnus-newsgroup-name))
12170       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
12171       (gnus-request-group gnus-newsgroup-name t))
12172     (let* ((article (if header (mail-header-number header) article))
12173            (summary-buffer (current-buffer))
12174            (internal-hook gnus-article-internal-prepare-hook)
12175            (group gnus-newsgroup-name)
12176            result)
12177       (save-excursion
12178         (gnus-article-setup-buffer)
12179         (set-buffer gnus-article-buffer)
12180         ;; Deactivate active regions.
12181         (when (and (boundp 'transient-mark-mode)
12182                    transient-mark-mode)
12183           (setq mark-active nil))
12184         (if (not (setq result (let ((buffer-read-only nil))
12185                                 (gnus-request-article-this-buffer 
12186                                  article group))))
12187             ;; There is no such article.
12188             (save-excursion
12189               (if (not (numberp article))
12190                   ()
12191                 (setq gnus-article-current 
12192                       (cons gnus-newsgroup-name article))
12193                 (set-buffer gnus-summary-buffer)
12194                 (setq gnus-current-article article)
12195                 (gnus-summary-mark-article article gnus-canceled-mark))
12196               (gnus-message 
12197                1 "No such article (may have expired or been canceled)")
12198               (ding)
12199               nil)
12200           (if (or (eq result 'pseudo) (eq result 'nneething))
12201               (progn
12202                 (save-excursion
12203                   (set-buffer summary-buffer)
12204                   (setq gnus-last-article gnus-current-article
12205                         gnus-newsgroup-history (cons gnus-current-article
12206                                                      gnus-newsgroup-history)
12207                         gnus-current-article 0
12208                         gnus-current-headers nil
12209                         gnus-article-current nil)
12210                   (if (eq result 'nneething)
12211                       (gnus-configure-windows 'summary)
12212                     (gnus-configure-windows 'article))
12213                   (gnus-set-global-variables))
12214                 (gnus-set-mode-line 'article))
12215             ;; The result from the `request' was an actual article -
12216             ;; or at least some text that is now displayed in the
12217             ;; article buffer.
12218             (if (and (numberp article)
12219                      (not (eq article gnus-current-article)))
12220                 ;; Seems like a new article has been selected.
12221                 ;; `gnus-current-article' must be an article number.
12222                 (save-excursion
12223                   (set-buffer summary-buffer)
12224                   (setq gnus-last-article gnus-current-article
12225                         gnus-newsgroup-history (cons gnus-current-article
12226                                                      gnus-newsgroup-history)
12227                         gnus-current-article article
12228                         gnus-current-headers 
12229                         (gnus-summary-article-header gnus-current-article)
12230                         gnus-article-current 
12231                         (cons gnus-newsgroup-name gnus-current-article))
12232                   (gnus-summary-show-thread)
12233                   (run-hooks 'gnus-mark-article-hook)
12234                   (gnus-set-mode-line 'summary)
12235                   (and (gnus-visual-p 'article-highlight 'highlight)
12236                        (run-hooks 'gnus-visual-mark-article-hook))
12237                   ;; Set the global newsgroup variables here.
12238                   ;; Suggested by Jim Sisolak
12239                   ;; <sisolak@trans4.neep.wisc.edu>.
12240                   (gnus-set-global-variables)
12241                   (setq gnus-have-all-headers 
12242                         (or all-headers gnus-show-all-headers))
12243                   (and gnus-use-cache 
12244                        (vectorp (gnus-summary-article-header article))
12245                        (gnus-cache-possibly-enter-article
12246                         group article
12247                         (gnus-summary-article-header article)
12248                         (memq article gnus-newsgroup-marked)
12249                         (memq article gnus-newsgroup-dormant)
12250                         (memq article gnus-newsgroup-unreads)))))
12251             ;; Hooks for getting information from the article.
12252             ;; This hook must be called before being narrowed.
12253             (let (buffer-read-only)
12254               (run-hooks 'internal-hook)
12255               (run-hooks 'gnus-article-prepare-hook)
12256               ;; Decode MIME message.
12257               (if gnus-show-mime
12258                   (if (or (not gnus-strict-mime)
12259                           (gnus-fetch-field "Mime-Version"))
12260                       (funcall gnus-show-mime-method)
12261                     (funcall gnus-decode-encoded-word-method)))
12262               ;; Perform the article display hooks.
12263               (run-hooks 'gnus-article-display-hook))
12264             ;; Do page break.
12265             (goto-char (point-min))
12266             (and gnus-break-pages (gnus-narrow-to-page))
12267             (gnus-set-mode-line 'article)
12268             (gnus-configure-windows 'article)
12269             (goto-char (point-min))
12270             t))))))
12271
12272 (defun gnus-article-show-all-headers ()
12273   "Show all article headers in article mode buffer."
12274   (save-excursion 
12275     (gnus-article-setup-buffer)
12276     (set-buffer gnus-article-buffer)
12277     (let ((buffer-read-only nil))
12278       (remove-text-properties (point-min) (point-max) 
12279                               gnus-hidden-properties))))
12280
12281 (defun gnus-article-hide-headers-if-wanted ()
12282   "Hide unwanted headers if `gnus-have-all-headers' is nil.
12283 Provided for backwards compatability."
12284   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
12285       gnus-inhibit-hiding
12286       (gnus-article-hide-headers)))
12287
12288 (defun gnus-article-hide-headers (&optional delete)
12289   "Hide unwanted headers and possibly sort them as well."
12290   (interactive "P")
12291   (unless gnus-inhibit-hiding
12292     (save-excursion
12293       (set-buffer gnus-article-buffer)
12294       (save-restriction
12295         (let ((sorted gnus-sorted-header-list)
12296               (buffer-read-only nil)
12297               want-list beg want-l)
12298           ;; First we narrow to just the headers.
12299           (widen)
12300           (goto-char (point-min))
12301           ;; Hide any "From " lines at the beginning of (mail) articles. 
12302           (while (looking-at "From ")
12303             (forward-line 1))
12304           (or (bobp) 
12305               (add-text-properties (point-min) (point) gnus-hidden-properties))
12306           ;; Then treat the rest of the header lines.
12307           (narrow-to-region 
12308            (point) 
12309            (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
12310           ;; Then we use the two regular expressions
12311           ;; `gnus-ignored-headers' and `gnus-visible-headers' to
12312           ;; select which header lines is to remain visible in the
12313           ;; article buffer.
12314           (goto-char (point-min))
12315           (while (re-search-forward "^[^ \t]*:" nil t)
12316             (beginning-of-line)
12317             ;; We add the headers we want to keep to a list and delete
12318             ;; them from the buffer.
12319             (if (or (and (stringp gnus-visible-headers)
12320                          (looking-at gnus-visible-headers))
12321                     (and (not (stringp gnus-visible-headers))
12322                          (stringp gnus-ignored-headers)
12323                          (not (looking-at gnus-ignored-headers))))
12324                 (progn
12325                   (setq beg (point))
12326                   (forward-line 1)
12327                   ;; Be sure to get multi-line headers...
12328                   (re-search-forward "^[^ \t]*:" nil t)
12329                   (beginning-of-line)
12330                   (setq want-list 
12331                         (cons (buffer-substring beg (point)) want-list))
12332                   (delete-region beg (point))
12333                   (goto-char beg))
12334               (forward-line 1)))
12335           ;; Next we perform the sorting by looking at
12336           ;; `gnus-sorted-header-list'. 
12337           (goto-char (point-min))
12338           (while (and sorted want-list)
12339             (setq want-l want-list)
12340             (while (and want-l
12341                         (not (string-match (car sorted) (car want-l))))
12342               (setq want-l (cdr want-l)))
12343             (if want-l 
12344                 (progn
12345                   (insert (car want-l))
12346                   (setq want-list (delq (car want-l) want-list))))
12347             (setq sorted (cdr sorted)))
12348           ;; Any headers that were not matched by the sorted list we
12349           ;; just tack on the end of the visible header list.
12350           (while want-list
12351             (insert (car want-list))
12352             (setq want-list (cdr want-list)))
12353           ;; And finally we make the unwanted headers invisible.
12354           (if delete
12355               (delete-region (point) (point-max))
12356             ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
12357             (add-text-properties 
12358              (point) (point-max) gnus-hidden-properties)))))))
12359
12360 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
12361 (defun gnus-article-treat-overstrike ()
12362   "Translate overstrikes into bold text."
12363   (interactive)
12364   (save-excursion
12365     (set-buffer gnus-article-buffer)
12366     (let ((buffer-read-only nil))
12367       (while (search-forward "\b" nil t)
12368         (let ((next (following-char))
12369               (previous (char-after (- (point) 2))))
12370           (cond ((eq next previous)
12371                  (put-text-property (- (point) 2) (point) 'invisible t)
12372                  (put-text-property (point) (1+ (point)) 'face 'bold))
12373                 ((eq next ?_)
12374                  (put-text-property (1- (point)) (1+ (point)) 'invisible t)
12375                  (put-text-property
12376                   (- (point) 2) (1- (point)) 'face 'underline))
12377                 ((eq previous ?_)
12378                  (put-text-property (- (point) 2) (point) 'invisible t)
12379                  (put-text-property 
12380                   (point) (1+ (point))  'face 'underline))))))))
12381
12382 (defun gnus-article-word-wrap ()
12383   "Format too long lines."
12384   (interactive)
12385   (save-excursion
12386     (set-buffer gnus-article-buffer)
12387     (let ((buffer-read-only nil)
12388           p)
12389       (widen)
12390       (goto-char (point-min))
12391       (search-forward "\n\n" nil t)
12392       (end-of-line 1)
12393       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
12394             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
12395             (adaptive-fill-mode t))
12396         (while (not (eobp))
12397           (and (>= (current-column) (min fill-column (window-width)))
12398                (/= (preceding-char) ?:)
12399                (fill-paragraph nil))
12400           (end-of-line 2))))))
12401
12402 (defun gnus-article-remove-cr ()
12403   "Remove carriage returns from an article."
12404   (interactive)
12405   (save-excursion
12406     (set-buffer gnus-article-buffer)
12407     (let ((buffer-read-only nil))
12408       (goto-char (point-min))
12409       (while (search-forward "\r" nil t)
12410         (replace-match "" t t)))))
12411
12412 (defun gnus-article-display-x-face (&optional force)
12413   "Look for an X-Face header and display it if present."
12414   (interactive (list 'force))
12415   (save-excursion
12416     (set-buffer gnus-article-buffer)
12417     ;; Delete the old process, if any.
12418     (when (process-status "gnus-x-face")
12419       (delete-process "gnus-x-face"))
12420     (let ((inhibit-point-motion-hooks t)
12421           (case-fold-search nil)
12422           from)
12423       (save-restriction
12424         (gnus-narrow-to-headers)
12425         (setq from (mail-fetch-field "from"))
12426         (goto-char (point-min))
12427         (when (and gnus-article-x-face-command 
12428                    (or force
12429                        ;; Check whether this face is censored.
12430                        (not gnus-article-x-face-too-ugly)
12431                        (and gnus-article-x-face-too-ugly from
12432                             (not (string-match gnus-article-x-face-too-ugly 
12433                                                from))))
12434                    ;; Has to be present.
12435                    (re-search-forward "^X-Face: " nil t))
12436           ;; We now have the area of the buffer where the X-Face is stored.
12437           (let ((beg (point))
12438                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
12439             ;; We display the face.
12440             (if (symbolp gnus-article-x-face-command)
12441                 ;; The command is a lisp function, so we call it.
12442                 (if (gnus-functionp gnus-article-x-face-command)
12443                     (funcall gnus-article-x-face-command beg end)
12444                   (error "%s is not a function" gnus-article-x-face-command))
12445               ;; The command is a string, so we interpret the command
12446               ;; as a, well, command, and fork it off.
12447               (let ((process-connection-type nil))
12448                 (process-kill-without-query
12449                  (start-process 
12450                   "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
12451                 (process-send-region "gnus-x-face" beg end)
12452                 (process-send-eof "gnus-x-face")))))))))
12453
12454 (defun gnus-headers-decode-quoted-printable ()
12455   "Hack to remove QP encoding from headers."
12456   (let ((case-fold-search t)
12457         (inhibit-point-motion-hooks t)
12458         string)
12459     (goto-char (point-min))
12460     (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
12461       (setq string (match-string 1))
12462       (narrow-to-region (match-beginning 0) (match-end 0))
12463       (delete-region (point-min) (point-max))
12464       (insert string)
12465       (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
12466       (subst-char-in-region (point-min) (point-max) ?_ ? )
12467       (widen)
12468       (goto-char (point-min)))))
12469        
12470 (defun gnus-article-de-quoted-unreadable (&optional force)
12471   "Do a naive translation of a quoted-printable-encoded article.
12472 This is in no way, shape or form meant as a replacement for real MIME
12473 processing, but is simply a stop-gap measure until MIME support is
12474 written.
12475 If FORCE, decode the article whether it is marked as quoted-printable
12476 or not." 
12477   (interactive (list 'force))
12478   (save-excursion
12479     (set-buffer gnus-article-buffer)
12480     (let ((case-fold-search t)
12481           (buffer-read-only nil)
12482           (type (gnus-fetch-field "content-transfer-encoding")))
12483       (when (or force
12484                 (and type (string-match "quoted-printable" type)))
12485         (goto-char (point-min))
12486         (search-forward "\n\n" nil 'move)
12487         (gnus-mime-decode-quoted-printable (point) (point-max))
12488         (gnus-headers-decode-quoted-printable)))))
12489
12490 (defun gnus-mime-decode-quoted-printable (from to)
12491   "Decode Quoted-Printable in the region between FROM and TO."
12492   (goto-char from)
12493   (while (search-forward "=" to t)
12494     (cond ((eq (following-char) ?\n)
12495            (delete-char -1)
12496            (delete-char 1))
12497           ((looking-at "[0-9A-F][0-9A-F]")
12498            (delete-char -1)
12499            (insert (hexl-hex-string-to-integer
12500                     (buffer-substring (point) (+ 2 (point)))))
12501            (delete-char 2))
12502           ((looking-at "=")
12503            (delete-char 1))
12504           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
12505
12506 (defun gnus-article-hide-pgp ()
12507   "Hide any PGP headers and signatures in the current article."
12508   (interactive)
12509   (save-excursion
12510     (set-buffer gnus-article-buffer)
12511     (let (buffer-read-only beg end)
12512       (widen)
12513       (goto-char (point-min))
12514       ;; Hide the "header".
12515       (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
12516            (add-text-properties (match-beginning 0) (match-end 0)
12517                                 gnus-hidden-properties))
12518       (setq beg (point))
12519       ;; Hide the actual signature.
12520       (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
12521            (setq end (match-beginning 0))
12522            (add-text-properties 
12523             (match-beginning 0)
12524             (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
12525                 (match-end 0)
12526               ;; Perhaps we shouldn't hide to the end of the buffer
12527               ;; if there is no end to the signature?
12528               (point-max))
12529             gnus-hidden-properties))
12530       (when (and beg end)
12531         (narrow-to-region beg end)
12532         (goto-char (point-min))
12533         (while (re-search-forward "^- " nil t)
12534           (replace-match "" t t))
12535         (widen)))))
12536
12537 (defvar gnus-article-time-units
12538   `((year . ,(* 365.25 24 60 60))
12539     (week . ,(* 7 24 60 60))
12540     (day . ,(* 24 60 60))
12541     (hour . ,(* 60 60))
12542     (minute . 60)
12543     (second . 1))
12544   "Mapping from time units to seconds.")
12545
12546 (defun gnus-article-date-ut (&optional type highlight)
12547   "Convert DATE date to universal time in the current article.
12548 If TYPE is `local', convert to local time; if it is `lapsed', output
12549 how much time has lapsed since DATE."
12550   (interactive (list 'ut t))
12551   (let ((date (mail-header-date (or gnus-current-headers 
12552                                     (gnus-summary-article-header) "")))
12553         (date-regexp "^Date: \\|^X-Sent: ")
12554         (inhibit-point-motion-hooks t))
12555     (when (and date (not (string= date "")))
12556       (save-excursion
12557         (set-buffer gnus-article-buffer)
12558         (save-restriction
12559           (gnus-narrow-to-headers)
12560           (let ((buffer-read-only nil))
12561             ;; Delete any old Date headers.
12562             (if (zerop (nnheader-remove-header date-regexp t))
12563                 (beginning-of-line)
12564               (goto-char (point-max)))
12565             (insert
12566              (cond 
12567               ;; Convert to the local timezone.  We have to slap a
12568               ;; `condition-case' round the calls to the timezone
12569               ;; functions since they aren't particularly resistant to
12570               ;; buggy dates.
12571               ((eq type 'local)
12572                (concat "Date: " (condition-case ()
12573                                     (timezone-make-date-arpa-standard date)
12574                                   (error date))
12575                        "\n"))
12576               ;; Convert to Universal Time.
12577               ((eq type 'ut)
12578                (concat "Date: "
12579                        (condition-case ()
12580                            (timezone-make-date-arpa-standard date nil "UT")
12581                          (error date))
12582                        "\n"))
12583               ;; Get the original date from the article.
12584               ((eq type 'original)
12585                (concat "Date: " date "\n"))
12586               ;; Do an X-Sent lapsed format.
12587               ((eq type 'lapsed)
12588                ;; If the date is seriously mangled, the timezone
12589                ;; functions are liable to bug out, so we condition-case
12590                ;; the entire thing.  
12591                (let* ((real-sec (condition-case ()
12592                                     (- (gnus-seconds-since-epoch 
12593                                         (timezone-make-date-arpa-standard
12594                                          (current-time-string) 
12595                                          (current-time-zone) "UT"))
12596                                        (gnus-seconds-since-epoch 
12597                                         (timezone-make-date-arpa-standard 
12598                                          date nil "UT")))
12599                                   (error 0)))
12600                       (sec (abs real-sec))
12601                       num prev)
12602                  (if (zerop sec)
12603                      "X-Sent: Now\n"
12604                    (concat
12605                     "X-Sent: "
12606                     ;; This is a bit convoluted, but basically we go
12607                     ;; through the time units for years, weeks, etc,
12608                     ;; and divide things to see whether that results
12609                     ;; in positive answers.
12610                     (mapconcat 
12611                      (lambda (unit)
12612                        (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
12613                            ;; The (remaining) seconds are too few to
12614                            ;; be divided into this time unit.
12615                            "" 
12616                          ;; It's big enough, so we output it.
12617                          (setq sec (- sec (* num (cdr unit))))
12618                          (prog1
12619                              (concat (if prev ", " "") (int-to-string 
12620                                                         (floor num))
12621                                      " " (symbol-name (car unit))
12622                                      (if (> num 1) "s" ""))
12623                            (setq prev t))))
12624                      gnus-article-time-units "")
12625                     ;; If dates are odd, then it might appear like the
12626                     ;; article was sent in the future.
12627                     (if (> real-sec 0)
12628                         " ago\n"
12629                       " in the future\n")))))
12630               (t
12631                (error "Unknown conversion type: %s" type)))))
12632           ;; Do highlighting.
12633           (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
12634             (gnus-article-highlight-headers)))))))
12635
12636 (defun gnus-article-date-local (&optional highlight)
12637   "Convert the current article date to the local timezone."
12638   (interactive (list t))
12639   (gnus-article-date-ut 'local highlight))
12640
12641 (defun gnus-article-date-original (&optional highlight)
12642   "Convert the current article date to what it was originally.
12643 This is only useful if you have used some other date conversion
12644 function and want to see what the date was before converting."
12645   (interactive (list t))
12646   (gnus-article-date-ut 'original highlight))
12647
12648 (defun gnus-article-date-lapsed (&optional highlight)
12649   "Convert the current article date to time lapsed since it was sent."
12650   (interactive (list t))
12651   (gnus-article-date-ut 'lapsed highlight))
12652
12653 (defun gnus-article-maybe-highlight ()
12654   "Do some article highlighting if `gnus-visual' is non-nil."
12655   (if (gnus-visual-p 'article-highlight 'highlight)
12656       (gnus-article-highlight-some)))
12657
12658 ;; Article savers.
12659
12660 (defun gnus-output-to-rmail (file-name)
12661   "Append the current article to an Rmail file named FILE-NAME."
12662   (require 'rmail)
12663   ;; Most of these codes are borrowed from rmailout.el.
12664   (setq file-name (expand-file-name file-name))
12665   (setq rmail-default-rmail-file file-name)
12666   (let ((artbuf (current-buffer))
12667         (tmpbuf (get-buffer-create " *Gnus-output*")))
12668     (save-excursion
12669       (or (get-file-buffer file-name)
12670           (file-exists-p file-name)
12671           (if (gnus-yes-or-no-p
12672                (concat "\"" file-name "\" does not exist, create it? "))
12673               (let ((file-buffer (create-file-buffer file-name)))
12674                 (save-excursion
12675                   (set-buffer file-buffer)
12676                   (rmail-insert-rmail-file-header)
12677                   (let ((require-final-newline nil))
12678                     (write-region (point-min) (point-max) file-name t 1)))
12679                 (kill-buffer file-buffer))
12680             (error "Output file does not exist")))
12681       (set-buffer tmpbuf)
12682       (buffer-disable-undo (current-buffer))
12683       (erase-buffer)
12684       (insert-buffer-substring artbuf)
12685       (gnus-convert-article-to-rmail)
12686       ;; Decide whether to append to a file or to an Emacs buffer.
12687       (let ((outbuf (get-file-buffer file-name)))
12688         (if (not outbuf)
12689             (append-to-file (point-min) (point-max) file-name)
12690           ;; File has been visited, in buffer OUTBUF.
12691           (set-buffer outbuf)
12692           (let ((buffer-read-only nil)
12693                 (msg (and (boundp 'rmail-current-message)
12694                           (symbol-value 'rmail-current-message))))
12695             ;; If MSG is non-nil, buffer is in RMAIL mode.
12696             (if msg
12697                 (progn (widen)
12698                        (narrow-to-region (point-max) (point-max))))
12699             (insert-buffer-substring tmpbuf)
12700             (if msg
12701                 (progn
12702                   (goto-char (point-min))
12703                   (widen)
12704                   (search-backward "\^_")
12705                   (narrow-to-region (point) (point-max))
12706                   (goto-char (1+ (point-min)))
12707                   (rmail-count-new-messages t)
12708                   (rmail-show-message msg)))))))
12709     (kill-buffer tmpbuf)))
12710
12711 (defun gnus-output-to-file (file-name)
12712   "Append the current article to a file named FILE-NAME."
12713   (setq file-name (expand-file-name file-name))
12714   (let ((artbuf (current-buffer))
12715         (tmpbuf (get-buffer-create " *Gnus-output*")))
12716     (save-excursion
12717       (set-buffer tmpbuf)
12718       (buffer-disable-undo (current-buffer))
12719       (erase-buffer)
12720       (insert-buffer-substring artbuf)
12721       ;; Append newline at end of the buffer as separator, and then
12722       ;; save it to file.
12723       (goto-char (point-max))
12724       (insert "\n")
12725       (append-to-file (point-min) (point-max) file-name))
12726     (kill-buffer tmpbuf)))
12727
12728 (defun gnus-convert-article-to-rmail ()
12729   "Convert article in current buffer to Rmail message format."
12730   (let ((buffer-read-only nil))
12731     ;; Convert article directly into Babyl format.
12732     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
12733     (goto-char (point-min))
12734     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
12735     (while (search-forward "\n\^_" nil t) ;single char
12736       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
12737     (goto-char (point-max))
12738     (insert "\^_")))
12739
12740 (defun gnus-narrow-to-page (&optional arg)
12741   "Make text outside current page invisible except for page delimiter.
12742 A numeric arg specifies to move forward or backward by that many pages,
12743 thus showing a page other than the one point was originally in."
12744   (interactive "P")
12745   (setq arg (if arg (prefix-numeric-value arg) 0))
12746   (save-excursion
12747     (forward-page -1)                   ;Beginning of current page.
12748     (widen)
12749     (if (> arg 0)
12750         (forward-page arg)
12751       (if (< arg 0)
12752           (forward-page (1- arg))))
12753     ;; Find the end of the page.
12754     (forward-page)
12755     ;; If we stopped due to end of buffer, stay there.
12756     ;; If we stopped after a page delimiter, put end of restriction
12757     ;; at the beginning of that line.
12758     ;; These are commented out.
12759     ;;    (if (save-excursion (beginning-of-line)
12760     ;;                  (looking-at page-delimiter))
12761     ;;  (beginning-of-line))
12762     (narrow-to-region (point)
12763                       (progn
12764                         ;; Find the top of the page.
12765                         (forward-page -1)
12766                         ;; If we found beginning of buffer, stay there.
12767                         ;; If extra text follows page delimiter on same line,
12768                         ;; include it.
12769                         ;; Otherwise, show text starting with following line.
12770                         (if (and (eolp) (not (bobp)))
12771                             (forward-line 1))
12772                         (point)))))
12773
12774 (defun gnus-gmt-to-local ()
12775   "Rewrite Date header described in GMT to local in current buffer.
12776 Intended to be used with gnus-article-prepare-hook."
12777   (save-excursion
12778     (save-restriction
12779       (widen)
12780       (goto-char (point-min))
12781       (narrow-to-region (point-min)
12782                         (progn (search-forward "\n\n" nil 'move) (point)))
12783       (goto-char (point-min))
12784       (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
12785           (let ((buffer-read-only nil)
12786                 (date (buffer-substring-no-properties
12787                        (match-beginning 1) (match-end 1))))
12788             (delete-region (match-beginning 1) (match-end 1))
12789             (insert
12790              (timezone-make-date-arpa-standard 
12791               date nil (current-time-zone))))))))
12792
12793 ;; Article mode commands
12794
12795 (defun gnus-article-next-page (&optional lines)
12796   "Show next page of current article.
12797 If end of article, return non-nil.  Otherwise return nil.
12798 Argument LINES specifies lines to be scrolled up."
12799   (interactive "P")
12800   (move-to-window-line -1)
12801   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
12802   (if (save-excursion
12803         (end-of-line)
12804         (and (pos-visible-in-window-p)  ;Not continuation line.
12805              (eobp)))
12806       ;; Nothing in this page.
12807       (if (or (not gnus-break-pages)
12808               (save-excursion
12809                 (save-restriction
12810                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
12811           t                             ;Nothing more.
12812         (gnus-narrow-to-page 1)         ;Go to next page.
12813         nil)
12814     ;; More in this page.
12815     (condition-case ()
12816         (scroll-up lines)
12817       (end-of-buffer
12818        ;; Long lines may cause an end-of-buffer error.
12819        (goto-char (point-max))))
12820     nil))
12821
12822 (defun gnus-article-prev-page (&optional lines)
12823   "Show previous page of current article.
12824 Argument LINES specifies lines to be scrolled down."
12825   (interactive "P")
12826   (move-to-window-line 0)
12827   (if (and gnus-break-pages
12828            (bobp)
12829            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
12830       (progn
12831         (gnus-narrow-to-page -1)        ;Go to previous page.
12832         (goto-char (point-max))
12833         (recenter -1))
12834     (scroll-down lines)))
12835
12836 (defun gnus-article-refer-article ()
12837   "Read article specified by message-id around point."
12838   (interactive)
12839   (search-forward ">" nil t)            ;Move point to end of "<....>".
12840   (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
12841       (let ((message-id (match-string 1)))
12842         (set-buffer gnus-summary-buffer)
12843         (gnus-summary-refer-article message-id))
12844     (error "No references around point")))
12845
12846 (defun gnus-article-show-summary ()
12847   "Reconfigure windows to show summary buffer."
12848   (interactive)
12849   (gnus-configure-windows 'article)
12850   (gnus-summary-goto-subject gnus-current-article))
12851
12852 (defun gnus-article-describe-briefly ()
12853   "Describe article mode commands briefly."
12854   (interactive)
12855   (gnus-message 6
12856                 (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")))
12857
12858 (defun gnus-article-summary-command ()
12859   "Execute the last keystroke in the summary buffer."
12860   (interactive)
12861   (let ((obuf (current-buffer))
12862         (owin (current-window-configuration))
12863         func)
12864     (switch-to-buffer gnus-summary-buffer 'norecord)
12865     (setq func (lookup-key (current-local-map) (this-command-keys)))
12866     (call-interactively func)
12867     (set-buffer obuf)
12868     (set-window-configuration owin)
12869     (set-window-point (get-buffer-window (current-buffer)) (point))))
12870
12871 (defun gnus-article-summary-command-nosave ()
12872   "Execute the last keystroke in the summary buffer."
12873   (interactive)
12874   (let (func)
12875     (pop-to-buffer gnus-summary-buffer 'norecord)
12876     (setq func (lookup-key (current-local-map) (this-command-keys)))
12877     (call-interactively func)))
12878
12879 \f
12880 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
12881
12882 ;;;###autoload
12883 (defalias 'gnus-batch-kill 'gnus-batch-score)
12884 ;;;###autoload
12885 (defun gnus-batch-score ()
12886   "Run batched scoring.
12887 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
12888 Newsgroups is a list of strings in Bnews format.  If you want to score
12889 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
12890 score the alt hierarchy, you'd say \"!alt.all\"."
12891   (interactive)
12892   (let* ((yes-and-no
12893           (gnus-newsrc-parse-options
12894            (apply (function concat)
12895                   (mapcar (lambda (g) (concat g " "))
12896                           command-line-args-left))))
12897          (gnus-expert-user t)
12898          (nnmail-spool-file nil)
12899          (gnus-use-dribble-file nil)
12900          (yes (car yes-and-no))
12901          (no (cdr yes-and-no))
12902          group newsrc entry
12903          ;; Disable verbose message.
12904          gnus-novice-user gnus-large-newsgroup)
12905     ;; Eat all arguments.
12906     (setq command-line-args-left nil)
12907     ;; Start Gnus.
12908     (gnus)
12909     ;; Apply kills to specified newsgroups in command line arguments.
12910     (setq newsrc (cdr gnus-newsrc-alist))
12911     (while newsrc
12912       (setq group (car (car newsrc)))
12913       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
12914       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
12915                (and (car entry)
12916                     (or (eq (car entry) t)
12917                         (not (zerop (car entry)))))
12918                (if yes (string-match yes group) t)
12919                (or (null no) (not (string-match no group))))
12920           (progn
12921             (gnus-summary-read-group group nil t nil t)
12922             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
12923                  (gnus-summary-exit))))
12924       (setq newsrc (cdr newsrc)))
12925     ;; Exit Emacs.
12926     (switch-to-buffer gnus-group-buffer)
12927     (gnus-group-save-newsrc)))
12928
12929 (defun gnus-apply-kill-file ()
12930   "Apply a kill file to the current newsgroup.
12931 Returns the number of articles marked as read."
12932   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
12933           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
12934       (gnus-apply-kill-file-internal)
12935     0))
12936
12937 (defun gnus-kill-save-kill-buffer ()
12938   (save-excursion
12939     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
12940       (if (get-file-buffer file)
12941           (progn
12942             (set-buffer (get-file-buffer file))
12943             (and (buffer-modified-p) (save-buffer))
12944             (kill-buffer (current-buffer)))))))
12945
12946 (defvar gnus-kill-file-name "KILL"
12947   "Suffix of the kill files.")
12948
12949 (defun gnus-newsgroup-kill-file (newsgroup)
12950   "Return the name of a kill file name for NEWSGROUP.
12951 If NEWSGROUP is nil, return the global kill file name instead."
12952   (cond ((or (null newsgroup)
12953              (string-equal newsgroup ""))
12954          ;; The global KILL file is placed at top of the directory.
12955          (expand-file-name gnus-kill-file-name
12956                            (or gnus-kill-files-directory "~/News")))
12957         ((gnus-use-long-file-name 'not-kill)
12958          ;; Append ".KILL" to newsgroup name.
12959          (expand-file-name (concat (gnus-newsgroup-saveable-name newsgroup)
12960                                    "." gnus-kill-file-name)
12961                            (or gnus-kill-files-directory "~/News")))
12962         (t
12963          ;; Place "KILL" under the hierarchical directory.
12964          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
12965                                    "/" gnus-kill-file-name)
12966                            (or gnus-kill-files-directory "~/News")))))
12967
12968 \f
12969 ;;;
12970 ;;; Dribble file
12971 ;;;
12972
12973 (defvar gnus-dribble-ignore nil)
12974 (defvar gnus-dribble-eval-file nil)
12975
12976 (defun gnus-dribble-file-name ()
12977   (concat 
12978    (if gnus-dribble-directory
12979        (concat (file-name-as-directory gnus-dribble-directory)
12980                (file-name-nondirectory gnus-current-startup-file))
12981      gnus-current-startup-file)
12982    "-dribble"))
12983
12984 (defun gnus-dribble-enter (string)
12985   (if (and (not gnus-dribble-ignore)
12986            (or gnus-dribble-buffer
12987                gnus-slave)
12988            (buffer-name gnus-dribble-buffer))
12989       (let ((obuf (current-buffer)))
12990         (set-buffer gnus-dribble-buffer)
12991         (insert string "\n")
12992         (set-window-point (get-buffer-window (current-buffer)) (point-max))
12993         (set-buffer obuf))))
12994
12995 (defun gnus-dribble-read-file ()
12996   (let ((dribble-file (gnus-dribble-file-name)))
12997     (save-excursion 
12998       (set-buffer (setq gnus-dribble-buffer 
12999                         (get-buffer-create 
13000                          (file-name-nondirectory dribble-file))))
13001       (gnus-add-current-to-buffer-list)
13002       (erase-buffer)
13003       (setq buffer-file-name dribble-file)
13004       (auto-save-mode t)
13005       (buffer-disable-undo (current-buffer))
13006       (bury-buffer (current-buffer))
13007       (set-buffer-modified-p nil)
13008       (let ((auto (make-auto-save-file-name))
13009             (gnus-dribble-ignore t))
13010         (if (or (file-exists-p auto) (file-exists-p dribble-file))
13011             (progn
13012               (if (file-newer-than-file-p auto dribble-file)
13013                   (setq dribble-file auto))
13014               (insert-file-contents dribble-file)
13015               (if (not (zerop (buffer-size)))
13016                   (set-buffer-modified-p t))
13017               (if (gnus-y-or-n-p 
13018                    "Auto-save file exists.  Do you want to read it? ")
13019                   (setq gnus-dribble-eval-file t))))))))
13020
13021 (defun gnus-dribble-eval-file ()
13022   (if (not gnus-dribble-eval-file)
13023       ()
13024     (setq gnus-dribble-eval-file nil)
13025     (save-excursion
13026       (let ((gnus-dribble-ignore t))
13027         (set-buffer gnus-dribble-buffer)
13028         (eval-buffer (current-buffer))))))
13029
13030 (defun gnus-dribble-delete-file ()
13031   (if (file-exists-p (gnus-dribble-file-name))
13032       (delete-file (gnus-dribble-file-name)))
13033   (if gnus-dribble-buffer
13034       (save-excursion
13035         (set-buffer gnus-dribble-buffer)
13036         (let ((auto (make-auto-save-file-name)))
13037           (if (file-exists-p auto)
13038               (delete-file auto))
13039           (erase-buffer)
13040           (set-buffer-modified-p nil)))))
13041
13042 (defun gnus-dribble-save ()
13043   (if (and gnus-dribble-buffer
13044            (buffer-name gnus-dribble-buffer))
13045       (save-excursion
13046         (set-buffer gnus-dribble-buffer)
13047         (save-buffer))))
13048
13049 (defun gnus-dribble-clear ()
13050   (save-excursion
13051     (if (gnus-buffer-exists-p gnus-dribble-buffer)
13052         (progn
13053           (set-buffer gnus-dribble-buffer)
13054           (erase-buffer)
13055           (set-buffer-modified-p nil)
13056           (setq buffer-saved-size (buffer-size))))))
13057
13058 ;;;
13059 ;;; Server Communication
13060 ;;;
13061
13062 (defun gnus-start-news-server (&optional confirm)
13063   "Open a method for getting news.
13064 If CONFIRM is non-nil, the user will be asked for an NNTP server."
13065   (let (how)
13066     (if gnus-current-select-method
13067         ;; Stream is already opened.
13068         nil
13069       ;; Open NNTP server.
13070       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
13071       (if confirm
13072           (progn
13073             ;; Read server name with completion.
13074             (setq gnus-nntp-server
13075                   (completing-read "NNTP server: "
13076                                    (mapcar (lambda (server) (list server))
13077                                            (cons (list gnus-nntp-server)
13078                                                  gnus-secondary-servers))
13079                                    nil nil gnus-nntp-server))))
13080
13081       (if (and gnus-nntp-server 
13082                (stringp gnus-nntp-server)
13083                (not (string= gnus-nntp-server "")))
13084           (setq gnus-select-method
13085                 (cond ((or (string= gnus-nntp-server "")
13086                            (string= gnus-nntp-server "::"))
13087                        (list 'nnspool (system-name)))
13088                       ((string-match "^:" gnus-nntp-server)
13089                        (list 'nnmh gnus-nntp-server 
13090                              (list 'nnmh-directory 
13091                                    (file-name-as-directory
13092                                     (expand-file-name
13093                                      (concat "~/" (substring
13094                                                    gnus-nntp-server 1)))))
13095                              (list 'nnmh-get-new-mail nil)))
13096                       (t
13097                        (list 'nntp gnus-nntp-server)))))
13098
13099       (setq how (car gnus-select-method))
13100       (cond ((eq how 'nnspool)
13101              (require 'nnspool)
13102              (gnus-message 5 "Looking up local news spool..."))
13103             ((eq how 'nnmh)
13104              (require 'nnmh)
13105              (gnus-message 5 "Looking up mh spool..."))
13106             (t
13107              (require 'nntp)))
13108       (setq gnus-current-select-method gnus-select-method)
13109       (run-hooks 'gnus-open-server-hook)
13110       (or 
13111        ;; gnus-open-server-hook might have opened it
13112        (gnus-server-opened gnus-select-method)  
13113        (gnus-open-server gnus-select-method)
13114        (gnus-y-or-n-p
13115         (format
13116          "%s open error: '%s'.  Continue? "
13117          (nth 1 gnus-select-method)
13118          (gnus-status-message gnus-select-method)))
13119        (progn
13120          (gnus-message 1 "Couldn't open server on %s" 
13121                        (nth 1 gnus-select-method))
13122          (ding)
13123          nil)))))
13124
13125 (defun gnus-check-server (&optional method)
13126   "Check whether the connection to METHOD is down.
13127 If METHOD is nil, use `gnus-select-method'.
13128 If it is down, start it up (again)."
13129   (let ((method (or method gnus-select-method)))
13130     ;; Transform virtual server names into select methods.
13131     (when (stringp method)
13132       (setq method (gnus-server-to-method method)))
13133     (if (gnus-server-opened method)
13134         ;; The stream is already opened.
13135         t
13136       ;; Open the server.
13137       (gnus-message 5 "Opening %s server on %s..." (car method) (nth 1 method))
13138       (run-hooks 'gnus-open-server-hook)
13139       (prog1
13140           (gnus-open-server method)
13141         (message "")))))
13142
13143 (defun gnus-get-function (method function)
13144   "Return a function symbol based on METHOD and FUNCTION."
13145   ;; Translate server names into methods.
13146   (unless method
13147     (error "Attempted use of a nil select method"))
13148   (when (stringp method)
13149     (setq method (gnus-server-to-method method)))
13150   (let ((func (intern (format "%s-%s" (car method) function))))
13151     ;; If the functions isn't bound, we require the backend in
13152     ;; question.  
13153     (unless (fboundp func)
13154       (require (car method))
13155       (unless (fboundp func)
13156         ;; This backend doesn't implement this function.
13157         (error "No such function: %s" func)))
13158     func))
13159
13160 ;;; Interface functions to the backends.
13161
13162 (defun gnus-open-server (method)
13163   "Open a connection to METHOD."
13164   (let ((elem (assoc method gnus-opened-servers)))
13165     ;; If this method was previously denied, we just return nil.
13166     (if (eq (nth 1 elem) 'denied)
13167         (progn
13168           (gnus-message 1 "Denied server")
13169           nil)
13170       ;; Open the server.
13171       (let ((result
13172              (funcall (gnus-get-function method 'open-server)
13173                       (nth 1 method) (nthcdr 2 method))))
13174         ;; If this hasn't been opened before, we add it to the list.
13175         (unless elem 
13176           (setq elem (list method nil)
13177                 gnus-opened-servers (cons elem gnus-opened-servers)))
13178         ;; Set the status of this server.
13179         (setcar (cdr elem) (if result 'ok 'denied))
13180         ;; Return the result from the "open" call.
13181         result))))
13182
13183 (defun gnus-close-server (method)
13184   "Close the connection to METHOD."
13185   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
13186
13187 (defun gnus-request-list (method)
13188   "Request the active file from METHOD."
13189   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
13190
13191 (defun gnus-request-list-newsgroups (method)
13192   "Request the newsgroups file from METHOD."
13193   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
13194
13195 (defun gnus-request-newgroups (date method)
13196   "Request all new groups since DATE from METHOD."
13197   (funcall (gnus-get-function method 'request-newgroups) 
13198            date (nth 1 method)))
13199
13200 (defun gnus-server-opened (method)
13201   "Check whether a connection to METHOD has been opened."
13202   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
13203
13204 (defun gnus-status-message (method)
13205   "Return the status message from METHOD.
13206 If METHOD is a string, it is interpreted as a group name.   The method
13207 this group uses will be queried."
13208   (let ((method (if (stringp method) (gnus-find-method-for-group method)
13209                   method)))
13210     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
13211
13212 (defun gnus-request-group (group &optional dont-check)
13213   "Request GROUP.  If DONT-CHECK, no information is required."
13214   (let ((method (gnus-find-method-for-group group)))
13215     (funcall (gnus-get-function method 'request-group) 
13216              (gnus-group-real-name group) (nth 1 method) dont-check)))
13217
13218 (defun gnus-request-asynchronous (group &optional articles)
13219   "Request that GROUP behave asynchronously.
13220 ARTICLES is the `data' of the group."
13221   (let ((method (gnus-find-method-for-group group)))
13222     (funcall (gnus-get-function method 'request-asynchronous) 
13223              (gnus-group-real-name group) (nth 1 method) articles)))
13224
13225 (defun gnus-list-active-group (group)
13226   "Request active information on GROUP."
13227   (let ((method (gnus-find-method-for-group group))
13228         (func 'list-active-group))
13229     (when (gnus-check-backend-function func group)
13230       (funcall (gnus-get-function method func) 
13231                (gnus-group-real-name group) (nth 1 method)))))
13232
13233 (defun gnus-request-group-description (group)
13234   "Request a description of GROUP."
13235   (let ((method (gnus-find-method-for-group group))
13236         (func 'request-group-description))
13237     (when (gnus-check-backend-function func group)
13238       (funcall (gnus-get-function method func) 
13239                (gnus-group-real-name group) (nth 1 method)))))
13240
13241 (defun gnus-close-group (group)
13242   "Request the GROUP be closed."
13243   (let ((method (gnus-find-method-for-group group)))
13244     (funcall (gnus-get-function method 'close-group) 
13245              (gnus-group-real-name group) (nth 1 method))))
13246
13247 (defun gnus-retrieve-headers (articles group &optional fetch-old)
13248   "Request headers for ARTICLES in GROUP.
13249 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
13250   (let ((method (gnus-find-method-for-group group)))
13251     (if (and gnus-use-cache (numberp (car articles)))
13252         (gnus-cache-retrieve-headers articles group)
13253       (funcall (gnus-get-function method 'retrieve-headers) 
13254                articles (gnus-group-real-name group) (nth 1 method)
13255                fetch-old))))
13256
13257 (defun gnus-retrieve-groups (groups method)
13258   "Request active information on GROUPS from METHOD."
13259   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
13260
13261 (defun gnus-request-article (article group &optional buffer)
13262   "Request the ARTICLE in GROUP.
13263 ARTICLE can either be an article number or an article Message-ID.
13264 If BUFFER, insert the article in that group."
13265   (let ((method (gnus-find-method-for-group group)))
13266     (funcall (gnus-get-function method 'request-article) 
13267              article (gnus-group-real-name group) (nth 1 method) buffer)))
13268
13269 (defun gnus-request-head (article group)
13270   "Request the head of ARTICLE in GROUP."
13271   (let ((method (gnus-find-method-for-group group)))
13272     (funcall (gnus-get-function method 'request-head) 
13273              article (gnus-group-real-name group) (nth 1 method))))
13274
13275 (defun gnus-request-body (article group)
13276   "Request the body of ARTICLE in GROUP."
13277   (let ((method (gnus-find-method-for-group group)))
13278     (funcall (gnus-get-function method 'request-body) 
13279              article (gnus-group-real-name group) (nth 1 method))))
13280
13281 (defun gnus-request-post (method)
13282   "Post the current buffer using METHOD."
13283   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
13284
13285 (defun gnus-request-scan (group method)
13286   "Request a SCAN being performed in GROUP from METHOD.
13287 If GROUP is nil, all groups on METHOD are scanned."
13288   (let ((method (if group (gnus-find-method-for-group group) method)))
13289     (funcall (gnus-get-function method 'request-scan) 
13290              (and group (gnus-group-real-name group)) (nth 1 method))))
13291
13292 (defun gnus-request-update-info (info method)
13293   "Request that METHOD update INFO."
13294   (when (gnus-check-backend-function 'request-update-info method)
13295     (funcall (gnus-get-function method 'request-update-info) 
13296              (gnus-group-real-name (gnus-info-group info)) 
13297              info (nth 1 method))))
13298
13299 (defun gnus-request-expire-articles (articles group &optional force)
13300   (let ((method (gnus-find-method-for-group group)))
13301     (funcall (gnus-get-function method 'request-expire-articles) 
13302              articles (gnus-group-real-name group) (nth 1 method)
13303              force)))
13304
13305 (defun gnus-request-move-article 
13306   (article group server accept-function &optional last)
13307   (let ((method (gnus-find-method-for-group group)))
13308     (funcall (gnus-get-function method 'request-move-article) 
13309              article (gnus-group-real-name group) 
13310              (nth 1 method) accept-function last)))
13311
13312 (defun gnus-request-accept-article (group &optional last)
13313   (let ((func (if (symbolp group) group
13314                 (car (gnus-find-method-for-group group)))))
13315     (funcall (intern (format "%s-request-accept-article" func))
13316              (if (stringp group) (gnus-group-real-name group) group)
13317              last)))
13318
13319 (defun gnus-request-replace-article (article group buffer)
13320   (let ((func (car (gnus-find-method-for-group group))))
13321     (funcall (intern (format "%s-request-replace-article" func))
13322              article (gnus-group-real-name group) buffer)))
13323
13324 (defun gnus-request-create-group (group)
13325   (let ((method (gnus-find-method-for-group group)))
13326     (funcall (gnus-get-function method 'request-create-group) 
13327              (gnus-group-real-name group) (nth 1 method))))
13328
13329 (defun gnus-request-delete-group (group &optional force)
13330   (let ((method (gnus-find-method-for-group group)))
13331     (funcall (gnus-get-function method 'request-delete-group) 
13332              (gnus-group-real-name group) force (nth 1 method))))
13333
13334 (defun gnus-request-rename-group (group new-name)
13335   (let ((method (gnus-find-method-for-group group)))
13336     (funcall (gnus-get-function method 'request-rename-group) 
13337              (gnus-group-real-name group) 
13338              (gnus-group-real-name new-name) (nth 1 method))))
13339
13340 (defun gnus-post-method (group force-group-method)
13341   "Return the posting method based on GROUP and FORCE."
13342   (let ((group-method (if (stringp group)
13343                           (gnus-find-method-for-group group)
13344                         group)))
13345     (cond 
13346      ;; If the group-method is nil (which shouldn't happen) we use 
13347      ;; the default method.
13348      ((null group-method)
13349       gnus-select-method)
13350      ;; We want this group's method.
13351      (force-group-method group-method)
13352      ;; Override normal method.
13353      ((and gnus-post-method
13354            (gnus-method-option-p group-method 'post))
13355       gnus-post-method)
13356      ;; Perhaps this is a mail group?
13357      ((not (gnus-member-of-valid 'post group))
13358       group-method)
13359      ;; Use the normal select method.
13360      (t gnus-select-method))))
13361
13362 (defun gnus-member-of-valid (symbol group)
13363   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
13364   (memq symbol (assoc
13365                 (format "%s" (car (gnus-find-method-for-group group)))
13366                 gnus-valid-select-methods)))
13367
13368 (defun gnus-method-option-p (method option)
13369   "Return non-nil if select METHOD has OPTION as a parameter."
13370   (memq 'post (assoc (format "%s" (car method))
13371                      gnus-valid-select-methods)))
13372
13373
13374 (defmacro gnus-server-equal (ss1 ss2)
13375   "Say whether two servers are equal."
13376   `(let ((s1 ,ss1)
13377          (s2 ,ss2))
13378      (or (equal s1 s2)
13379          (and (= (length s1) (length s2))
13380               (progn
13381                 (while (and s1 (member (car s1) s2))
13382                   (setq s1 (cdr s1)))
13383                 (null s1))))))
13384
13385 (defun gnus-server-extend-method (group method)
13386   ;; This function "extends" a virtual server.  If the server is
13387   ;; "hello", and the select method is ("hello" (my-var "something")) 
13388   ;; in the group "alt.alt", this will result in a new virtual server
13389   ;; called "helly+alt.alt".
13390   (let ((entry
13391          (gnus-copy-sequence 
13392           (if (equal (car method) "native") gnus-select-method
13393             (cdr (assoc (car method) gnus-server-alist))))))
13394     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
13395     (nconc entry (cdr method))))
13396
13397 (defun gnus-find-method-for-group (group &optional info)
13398   "Find the select method that GROUP uses."
13399   (or gnus-override-method
13400       (and (not group)
13401            gnus-select-method)
13402       (let ((info (or info (gnus-get-info group)))
13403             method)
13404         (if (or (not info)
13405                 (not (setq method (gnus-info-method info))))
13406             (setq method gnus-select-method)
13407           (setq method
13408                 (cond ((stringp method)
13409                        (gnus-server-to-method method))
13410                       ((stringp (car method))
13411                        (gnus-server-extend-method group method))
13412                       (t
13413                        method))))
13414         (gnus-server-add-address method))))
13415
13416 (defun gnus-check-backend-function (func group)
13417   "Check whether GROUP supports function FUNC."
13418   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
13419                   group)))
13420     (fboundp (intern (format "%s-%s" method func)))))
13421
13422 (defun gnus-methods-using (feature)
13423   "Find all methods that have FEATURE."
13424   (let ((valids gnus-valid-select-methods)
13425         outs)
13426     (while valids
13427       (if (memq feature (car valids)) 
13428           (setq outs (cons (car valids) outs)))
13429       (setq valids (cdr valids)))
13430     outs))
13431
13432 ;;; 
13433 ;;; Active & Newsrc File Handling
13434 ;;;
13435
13436 ;; Newsrc related functions.
13437 ;; Gnus internal format of gnus-newsrc-alist:
13438 ;; (("alt.general" 3 (1 . 1))
13439 ;;  ("alt.misc"    3 ((1 . 10) (12 . 15)))
13440 ;;  ("alt.test"    7 (1 . 99) (45 57 93)) ...)
13441 ;; The first item is the group name; the second is the subscription
13442 ;; level; the third is either a range of a list of ranges of read
13443 ;; articles, the optional fourth element is a list of marked articles,
13444 ;; the optional fifth element is the select method.
13445 ;;
13446 ;; Gnus internal format of gnus-newsrc-hashtb:
13447 ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...)
13448 ;; This is the entry for "alt.misc". The first element is the number
13449 ;; of unread articles in "alt.misc". The cdr of this entry is the
13450 ;; element *before* "alt.misc" in gnus-newsrc-alist, which makes is
13451 ;; trivial to remove or add new elements into gnus-newsrc-alist
13452 ;; without scanning the entire list.  So, to get the actual information
13453 ;; of "alt.misc", you'd say something like 
13454 ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb))
13455 ;;
13456 ;; Gnus internal format of gnus-active-hashtb:
13457 ;; ((1 . 1))
13458 ;;  (5 . 10))
13459 ;;  (67 . 99)) ...)
13460 ;; The only element in each entry in this hash table is a range of
13461 ;; (possibly) available articles. (Articles in this range may have
13462 ;; been expired or canceled.)
13463 ;;
13464 ;; Gnus internal format of gnus-killed-list and gnus-zombie-list:
13465 ;; ("alt.misc" "alt.test" "alt.general" ...)
13466
13467 (defun gnus-setup-news (&optional rawfile level)
13468   "Setup news information.
13469 If RAWFILE is non-nil, the .newsrc file will also be read.
13470 If LEVEL is non-nil, the news will be set up at level LEVEL."
13471   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
13472     ;; Clear some variables to re-initialize news information.
13473     (if init (setq gnus-newsrc-alist nil 
13474                    gnus-active-hashtb nil))
13475
13476     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
13477     (if init (gnus-read-newsrc-file rawfile))
13478
13479     ;; If we don't read the complete active file, we fill in the
13480     ;; hashtb here. 
13481     (if (or (null gnus-read-active-file)
13482             (eq gnus-read-active-file 'some))
13483         (gnus-update-active-hashtb-from-killed))
13484
13485     ;; Read the active file and create `gnus-active-hashtb'.
13486     ;; If `gnus-read-active-file' is nil, then we just create an empty
13487     ;; hash table.  The partial filling out of the hash table will be
13488     ;; done in `gnus-get-unread-articles'.
13489     (and gnus-read-active-file 
13490          (not level)
13491          (gnus-read-active-file))
13492
13493     (or gnus-active-hashtb
13494         (setq gnus-active-hashtb (make-vector 4095 0)))
13495
13496     ;; Possibly eval the dribble file.
13497     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
13498
13499     (gnus-update-format-specifications)
13500
13501     ;; Find new newsgroups and treat them.
13502     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
13503              (gnus-server-opened gnus-select-method))
13504         (gnus-find-new-newsgroups))
13505
13506     ;; Find the number of unread articles in each non-dead group.
13507     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
13508       (gnus-get-unread-articles (or level (1+ gnus-level-subscribed))))
13509
13510     (if (and init gnus-check-bogus-newsgroups 
13511              gnus-read-active-file (not level)
13512              (gnus-server-opened gnus-select-method))
13513         (gnus-check-bogus-newsgroups))))
13514
13515 (defun gnus-find-new-newsgroups ()
13516   "Search for new newsgroups and add them.
13517 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
13518 The `-n' option line from .newsrc is respected."
13519   (interactive)
13520   (or (gnus-check-first-time-used)
13521       (if (or (consp gnus-check-new-newsgroups)
13522               (eq gnus-check-new-newsgroups 'ask-server))
13523           (gnus-ask-server-for-new-groups)
13524         (let ((groups 0)
13525               group new-newsgroups)
13526           (gnus-message 5 "Looking for new newsgroups...")
13527           (or gnus-have-read-active-file (gnus-read-active-file))
13528           (setq gnus-newsrc-last-checked-date (current-time-string))
13529           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
13530           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
13531           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
13532           (mapatoms
13533            (lambda (sym)
13534              (if (or (null (setq group (symbol-name sym)))
13535                      (not (boundp sym))
13536                      (null (symbol-value sym))
13537                      (gnus-gethash group gnus-killed-hashtb)
13538                      (gnus-gethash group gnus-newsrc-hashtb))
13539                  ()
13540                (let ((do-sub (gnus-matches-options-n group)))
13541                  (cond 
13542                   ((eq do-sub 'subscribe)
13543                    (setq groups (1+ groups))
13544                    (gnus-sethash group group gnus-killed-hashtb)
13545                    (funcall gnus-subscribe-options-newsgroup-method group))
13546                   ((eq do-sub 'ignore)
13547                    nil)
13548                   (t
13549                    (setq groups (1+ groups))
13550                    (gnus-sethash group group gnus-killed-hashtb)
13551                    (if gnus-subscribe-hierarchical-interactive
13552                        (setq new-newsgroups (cons group new-newsgroups))
13553                      (funcall gnus-subscribe-newsgroup-method group)))))))
13554            gnus-active-hashtb)
13555           (if new-newsgroups 
13556               (gnus-subscribe-hierarchical-interactive new-newsgroups))
13557           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
13558           (if (> groups 0)
13559               (gnus-message 6 "%d new newsgroup%s arrived." 
13560                             groups (if (> groups 1) "s have" " has"))
13561             (gnus-message 6 "No new newsgroups."))))))
13562
13563 (defun gnus-matches-options-n (group)
13564   ;; Returns `subscribe' if the group is to be uncoditionally
13565   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
13566   ;; no match for the group.
13567
13568   ;; First we check the two user variables.
13569   (cond
13570    ((and gnus-options-subscribe
13571          (string-match gnus-options-subscribe group))
13572     'subscribe)
13573    ((and gnus-auto-subscribed-groups 
13574          (string-match gnus-auto-subscribed-groups group))
13575     'subscribe)
13576    ((and gnus-options-not-subscribe
13577          (string-match gnus-options-not-subscribe group))
13578     'ignore)
13579    ;; Then we go through the list that was retrieved from the .newsrc
13580    ;; file.  This list has elements on the form 
13581    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
13582    ;; is in the reverse order of the options line) is returned.
13583    (t
13584     (let ((regs gnus-newsrc-options-n))
13585       (while (and regs
13586                   (not (string-match (car (car regs)) group)))
13587         (setq regs (cdr regs)))
13588       (and regs (cdr (car regs)))))))
13589
13590 (defun gnus-ask-server-for-new-groups ()
13591   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
13592          (methods (cons gnus-select-method 
13593                         (append
13594                          (and (consp gnus-check-new-newsgroups)
13595                               gnus-check-new-newsgroups)
13596                          gnus-secondary-select-methods)))
13597          (groups 0)
13598          (new-date (current-time-string))
13599          (hashtb (gnus-make-hashtable 100))
13600          group new-newsgroups got-new method)
13601     ;; Go through both primary and secondary select methods and
13602     ;; request new newsgroups.  
13603     (while methods
13604       (setq method (gnus-server-get-method nil (car methods)))
13605       (and (gnus-check-server method)
13606            (gnus-request-newgroups date method)
13607            (save-excursion
13608              (setq got-new t)
13609              (set-buffer nntp-server-buffer)
13610              ;; Enter all the new groups in a hashtable.
13611              (gnus-active-to-gnus-format method hashtb 'ignore)))
13612       (setq methods (cdr methods)))
13613     (and got-new (setq gnus-newsrc-last-checked-date new-date))
13614     ;; Now all new groups from all select methods are in `hashtb'.
13615     (mapatoms
13616      (lambda (group-sym)
13617        (setq group (symbol-name group-sym))
13618        (if (or (null group)
13619                (null (symbol-value group-sym))
13620                (gnus-gethash group gnus-newsrc-hashtb)
13621                (member group gnus-zombie-list)
13622                (member group gnus-killed-list))
13623            ;; The group is already known.
13624            ()
13625          (and (symbol-value group-sym)
13626               (gnus-set-active group (symbol-value group-sym)))
13627          (let ((do-sub (gnus-matches-options-n group)))
13628            (cond ((eq do-sub 'subscribe)
13629                   (setq groups (1+ groups))
13630                   (gnus-sethash group group gnus-killed-hashtb)
13631                   (funcall 
13632                    gnus-subscribe-options-newsgroup-method group))
13633                  ((eq do-sub 'ignore)
13634                   nil)
13635                  (t
13636                   (setq groups (1+ groups))
13637                   (gnus-sethash group group gnus-killed-hashtb)
13638                   (if gnus-subscribe-hierarchical-interactive
13639                       (setq new-newsgroups (cons group new-newsgroups))
13640                     (funcall gnus-subscribe-newsgroup-method group)))))))
13641      hashtb)
13642     (if new-newsgroups 
13643         (gnus-subscribe-hierarchical-interactive new-newsgroups))
13644     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
13645     (if (> groups 0)
13646         (gnus-message 6 "%d new newsgroup%s arrived." 
13647                       groups (if (> groups 1) "s have" " has")))
13648     got-new))
13649
13650 (defun gnus-check-first-time-used ()
13651   (if (or (> (length gnus-newsrc-alist) 1)
13652           (file-exists-p gnus-startup-file)
13653           (file-exists-p (concat gnus-startup-file ".el"))
13654           (file-exists-p (concat gnus-startup-file ".eld")))
13655       nil
13656     (gnus-message 6 "First time user; subscribing you to default groups")
13657     (or gnus-have-read-active-file (gnus-read-active-file))
13658     (setq gnus-newsrc-last-checked-date (current-time-string))
13659     (let ((groups gnus-default-subscribed-newsgroups)
13660           group)
13661       (if (eq groups t)
13662           nil
13663         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
13664         (mapatoms
13665          (lambda (sym)
13666            (if (null (setq group (symbol-name sym)))
13667                ()
13668              (let ((do-sub (gnus-matches-options-n group)))
13669                (cond 
13670                 ((eq do-sub 'subscribe)
13671                  (gnus-sethash group group gnus-killed-hashtb)
13672                  (funcall gnus-subscribe-options-newsgroup-method group))
13673                 ((eq do-sub 'ignore)
13674                  nil)
13675                 (t
13676                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
13677          gnus-active-hashtb)
13678         (while groups
13679           (if (gnus-active (car groups))
13680               (gnus-group-change-level 
13681                (car groups) gnus-level-default-subscribed gnus-level-killed))
13682           (setq groups (cdr groups)))
13683         (gnus-group-make-help-group)
13684         (and gnus-novice-user
13685              (gnus-message 7 "`A k' to list killed groups"))))))
13686
13687 (defun gnus-subscribe-group (group previous &optional method)
13688   (gnus-group-change-level 
13689    (if method
13690        (list t group gnus-level-default-subscribed nil nil method)
13691      group) 
13692    gnus-level-default-subscribed gnus-level-killed previous t))
13693
13694 ;; `gnus-group-change-level' is the fundamental function for changing
13695 ;; subscription levels of newsgroups.  This might mean just changing
13696 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
13697 ;; again, which subscribes/unsubscribes a group, which is equally
13698 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
13699 ;; from 8-9 to 1-7 means that you remove the group from the list of
13700 ;; killed (or zombie) groups and add them to the (kinda) subscribed
13701 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
13702 ;; which is trivial.
13703 ;; ENTRY can either be a string (newsgroup name) or a list (if
13704 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
13705 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
13706 ;; entries. 
13707 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
13708 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
13709 ;; after. 
13710 (defun gnus-group-change-level (entry level &optional oldlevel
13711                                       previous fromkilled)
13712   (let (group info active num)
13713     ;; Glean what info we can from the arguments
13714     (if (consp entry)
13715         (if fromkilled (setq group (nth 1 entry))
13716           (setq group (car (nth 2 entry))))
13717       (setq group entry))
13718     (if (and (stringp entry)
13719              oldlevel 
13720              (< oldlevel gnus-level-zombie))
13721         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
13722     (if (and (not oldlevel)
13723              (consp entry))
13724         (setq oldlevel (car (cdr (nth 2 entry)))))
13725     (if (stringp previous)
13726         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
13727
13728     (if (and (>= oldlevel gnus-level-zombie)
13729              (gnus-gethash group gnus-newsrc-hashtb))
13730         ;; We are trying to subscribe a group that is already
13731         ;; subscribed. 
13732         ()                              ; Do nothing. 
13733
13734       (or (gnus-ephemeral-group-p group)
13735           (gnus-dribble-enter
13736            (format "(gnus-group-change-level %S %S %S %S %S)" 
13737                    group level oldlevel (car (nth 2 previous)) fromkilled)))
13738     
13739       ;; Then we remove the newgroup from any old structures, if needed.
13740       ;; If the group was killed, we remove it from the killed or zombie
13741       ;; list.  If not, and it is in fact going to be killed, we remove
13742       ;; it from the newsrc hash table and assoc.
13743       (cond ((>= oldlevel gnus-level-zombie)
13744              (if (= oldlevel gnus-level-zombie)
13745                  (setq gnus-zombie-list (delete group gnus-zombie-list))
13746                (setq gnus-killed-list (delete group gnus-killed-list))))
13747             (t
13748              (if (and (>= level gnus-level-zombie)
13749                       entry)
13750                  (progn
13751                    (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
13752                    (if (nth 3 entry)
13753                        (setcdr (gnus-gethash (car (nth 3 entry))
13754                                              gnus-newsrc-hashtb)
13755                                (cdr entry)))
13756                    (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
13757
13758       ;; Finally we enter (if needed) the list where it is supposed to
13759       ;; go, and change the subscription level.  If it is to be killed,
13760       ;; we enter it into the killed or zombie list.
13761       (cond ((>= level gnus-level-zombie)
13762              ;; Remove from the hash table.
13763              (gnus-sethash group nil gnus-newsrc-hashtb)
13764              ;; We do not enter foreign groups into the list of dead
13765              ;; groups.  
13766              (unless (gnus-group-foreign-p group)
13767                (if (= level gnus-level-zombie)
13768                    (setq gnus-zombie-list (cons group gnus-zombie-list))
13769                  (setq gnus-killed-list (cons group gnus-killed-list)))))
13770             (t
13771              ;; If the list is to be entered into the newsrc assoc, and
13772              ;; it was killed, we have to create an entry in the newsrc
13773              ;; hashtb format and fix the pointers in the newsrc assoc.
13774              (if (>= oldlevel gnus-level-zombie)
13775                  (progn
13776                    (if (listp entry)
13777                        (progn
13778                          (setq info (cdr entry))
13779                          (setq num (car entry)))
13780                      (setq active (gnus-active group))
13781                      (setq num 
13782                            (if active (- (1+ (cdr active)) (car active)) t))
13783                      ;; Check whether the group is foreign.  If so, the
13784                      ;; foreign select method has to be entered into the
13785                      ;; info. 
13786                      (let ((method (gnus-group-method-name group)))
13787                        (if (eq method gnus-select-method)
13788                            (setq info (list group level nil))
13789                          (setq info (list group level nil nil method)))))
13790                    (or previous 
13791                        (setq previous 
13792                              (let ((p gnus-newsrc-alist))
13793                                (while (cdr (cdr p))
13794                                  (setq p (cdr p)))
13795                                p)))
13796                    (setq entry (cons info (cdr (cdr previous))))
13797                    (if (cdr previous)
13798                        (progn
13799                          (setcdr (cdr previous) entry)
13800                          (gnus-sethash group (cons num (cdr previous)) 
13801                                        gnus-newsrc-hashtb))
13802                      (setcdr previous entry)
13803                      (gnus-sethash group (cons num previous)
13804                                    gnus-newsrc-hashtb))
13805                    (if (cdr entry)
13806                        (setcdr (gnus-gethash (car (car (cdr entry)))
13807                                              gnus-newsrc-hashtb)
13808                                entry)))
13809                ;; It was alive, and it is going to stay alive, so we
13810                ;; just change the level and don't change any pointers or
13811                ;; hash table entries.
13812                (setcar (cdr (car (cdr (cdr entry)))) level)))))))
13813
13814 (defun gnus-kill-newsgroup (newsgroup)
13815   "Obsolete function.  Kills a newsgroup."
13816   (gnus-group-change-level
13817    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
13818
13819 (defun gnus-check-bogus-newsgroups (&optional confirm)
13820   "Remove bogus newsgroups.
13821 If CONFIRM is non-nil, the user has to confirm the deletion of every
13822 newsgroup." 
13823   (let ((newsrc (cdr gnus-newsrc-alist))
13824         bogus group entry info)
13825     (gnus-message 5 "Checking bogus newsgroups...")
13826     (unless gnus-have-read-active-file 
13827       (gnus-read-active-file))
13828     (when (member gnus-select-method gnus-have-read-active-file)
13829       ;; Find all bogus newsgroup that are subscribed.
13830       (while newsrc
13831         (setq info (pop newsrc)
13832               group (gnus-info-group info))
13833         (unless (or (gnus-active group) ; Active
13834                     (gnus-info-method info) ; Foreign
13835                     (and confirm
13836                          (not (gnus-y-or-n-p
13837                                (format "Remove bogus newsgroup: %s " group)))))
13838           ;; Found a bogus newsgroup.
13839           (push group bogus)))
13840       ;; Remove all bogus subscribed groups by first killing them, and
13841       ;; then removing them from the list of killed groups.
13842       (while bogus
13843         (when (setq entry (gnus-gethash (setq group (pop bogus))
13844                                         gnus-newsrc-hashtb))
13845           (gnus-group-change-level entry gnus-level-killed)
13846           (setq gnus-killed-list (delete group gnus-killed-list))))
13847       ;; Then we remove all bogus groups from the list of killed and
13848       ;; zombie groups.  They are are removed without confirmation.
13849       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
13850             killed)
13851         (while dead-lists
13852           (setq killed (symbol-value (car dead-lists)))
13853           (while killed
13854             (unless (gnus-active (setq group (pop killed)))
13855               ;; The group is bogus.
13856               ;; !!!Slow as hell.
13857               (set (car dead-lists)
13858                    (delete group (symbol-value (car dead-lists))))))
13859           (setq dead-lists (cdr dead-lists))))
13860       (gnus-message 5 "Checking bogus newsgroups...done"))))
13861
13862 (defun gnus-check-duplicate-killed-groups ()
13863   "Remove duplicates from the list of killed groups."
13864   (interactive)
13865   (let ((killed gnus-killed-list))
13866     (while killed
13867       (gnus-message 9 "%d" (length killed))
13868       (setcdr killed (delete (car killed) (cdr killed)))
13869       (setq killed (cdr killed)))))
13870
13871 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
13872 ;; and compute how many unread articles there are in each group.
13873 (defun gnus-get-unread-articles (&optional level) 
13874   (let* ((newsrc (cdr gnus-newsrc-alist))
13875          (level (or level (1+ gnus-level-subscribed)))
13876          (foreign-level
13877           (min 
13878            (cond ((and gnus-activate-foreign-newsgroups 
13879                        (not (numberp gnus-activate-foreign-newsgroups)))
13880                   (1+ gnus-level-subscribed))
13881                  ((numberp gnus-activate-foreign-newsgroups)
13882                   gnus-activate-foreign-newsgroups)
13883                  (t 0))
13884            level))
13885          (update
13886           (fboundp (intern (format "%s-request-update-info"
13887                                    (car gnus-select-method)))))
13888          info group active virtuals method fmethod)
13889     (gnus-message 5 "Checking new news...")
13890
13891     (while newsrc
13892       (setq info (car newsrc)
13893             group (gnus-info-group info)
13894             active (gnus-active group))
13895
13896       ;; Check newsgroups.  If the user doesn't want to check them, or
13897       ;; they can't be checked (for instance, if the news server can't
13898       ;; be reached) we just set the number of unread articles in this
13899       ;; newsgroup to t.  This means that Gnus thinks that there are
13900       ;; unread articles, but it has no idea how many.
13901       (if (and (setq method (gnus-info-method info))
13902                (not (gnus-server-equal
13903                      gnus-select-method
13904                      (prog1
13905                          (setq fmethod (gnus-server-get-method nil method))
13906                        ;; We do this here because it would be awkward
13907                        ;; to do it anywhere else.  Hell, it's pretty
13908                        ;; awkward here as well, but at least it's
13909                        ;; reasonably efficient. 
13910                        (and (<= (gnus-info-level info) foreign-level)
13911                             (gnus-request-update-info info method)))))
13912                (not (gnus-secondary-method-p method)))
13913           ;; These groups are foreign.  Check the level.
13914           (if (<= (gnus-info-level info) foreign-level)
13915               (setq active (gnus-activate-group (gnus-info-group info) 'scan)))
13916
13917         ;; These groups are native or secondary. 
13918         (if (<= (gnus-info-level info) level)
13919             (progn
13920               (if (and update (not method))
13921                   (progn
13922                     ;; Allow updating of native groups as well, even
13923                     ;; though that's pretty unlikely.
13924                     (gnus-request-update-info info gnus-select-method)
13925                     (setq active (gnus-activate-group 
13926                                   (gnus-info-group info) 'scan)))
13927                 (or gnus-read-active-file
13928                     (setq active (gnus-activate-group 
13929                                   (gnus-info-group info) 'scan)))))))
13930       
13931       (if active
13932           (gnus-get-unread-articles-in-group info active)
13933         ;; The group couldn't be reached, so we nix out the number of
13934         ;; unread articles and stuff.
13935         (gnus-set-active group nil)
13936         (setcar (gnus-gethash group gnus-newsrc-hashtb) t))
13937       
13938       (setq newsrc (cdr newsrc)))
13939
13940     (gnus-message 5 "Checking new news...done")))
13941
13942 ;; Create a hash table out of the newsrc alist.  The `car's of the
13943 ;; alist elements are used as keys.
13944 (defun gnus-make-hashtable-from-newsrc-alist ()
13945   (let ((alist gnus-newsrc-alist)
13946         (ohashtb gnus-newsrc-hashtb)
13947         prev)
13948     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
13949     (setq alist 
13950           (setq prev (setq gnus-newsrc-alist 
13951                            (if (equal (car (car gnus-newsrc-alist))
13952                                       "dummy.group")
13953                                gnus-newsrc-alist
13954                              (cons (list "dummy.group" 0 nil) alist)))))
13955     (while alist
13956       (gnus-sethash 
13957        (car (car alist)) 
13958        (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb))) 
13959              prev)
13960        gnus-newsrc-hashtb)
13961       (setq prev alist
13962             alist (cdr alist)))))
13963
13964 (defun gnus-make-hashtable-from-killed ()
13965   "Create a hash table from the killed and zombie lists."
13966   (let ((lists '(gnus-killed-list gnus-zombie-list))
13967         list)
13968     (setq gnus-killed-hashtb 
13969           (gnus-make-hashtable 
13970            (+ (length gnus-killed-list) (length gnus-zombie-list))))
13971     (while lists
13972       (setq list (symbol-value (car lists)))
13973       (setq lists (cdr lists))
13974       (while list
13975         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
13976         (setq list (cdr list))))))
13977
13978 (defun gnus-get-unread-articles-in-group (info active)
13979   (let* ((range (gnus-info-read info))
13980          (num 0)
13981          (marked (gnus-info-marks info)))
13982     ;; If a cache is present, we may have to alter the active info.
13983     (and gnus-use-cache
13984          (gnus-cache-possibly-alter-active (gnus-info-group info) active))
13985     ;; Modify the list of read articles according to what articles 
13986     ;; are available; then tally the unread articles and add the
13987     ;; number to the group hash table entry.
13988     (cond 
13989      ((zerop (cdr active))
13990       (setq num 0))
13991      ((not range)
13992       (setq num (- (1+ (cdr active)) (car active))))
13993      ((not (listp (cdr range)))
13994       ;; Fix a single (num . num) range according to the
13995       ;; active hash table.
13996       ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
13997       (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
13998       (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
13999       ;; Compute number of unread articles.
14000       (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
14001      (t
14002       ;; The read list is a list of ranges.  Fix them according to
14003       ;; the active hash table.
14004       ;; First peel off any elements that are below the lower
14005       ;; active limit. 
14006       (while (and (cdr range) 
14007                   (>= (car active) 
14008                       (or (and (atom (car (cdr range))) (car (cdr range)))
14009                           (car (car (cdr range))))))
14010         (if (numberp (car range))
14011             (setcar range 
14012                     (cons (car range) 
14013                           (or (and (numberp (car (cdr range)))
14014                                    (car (cdr range))) 
14015                               (cdr (car (cdr range))))))
14016           (setcdr (car range) 
14017                   (or (and (numberp (nth 1 range)) (nth 1 range))
14018                       (cdr (car (cdr range))))))
14019         (setcdr range (cdr (cdr range))))
14020       ;; Adjust the first element to be the same as the lower limit. 
14021       (if (and (not (atom (car range))) 
14022                (< (cdr (car range)) (car active)))
14023           (setcdr (car range) (1- (car active))))
14024       ;; Then we want to peel off any elements that are higher
14025       ;; than the upper active limit.  
14026       (let ((srange range))
14027         ;; Go past all legal elements.
14028         (while (and (cdr srange) 
14029                     (<= (or (and (atom (car (cdr srange)))
14030                                  (car (cdr srange)))
14031                             (car (car (cdr srange)))) (cdr active)))
14032           (setq srange (cdr srange)))
14033         (if (cdr srange)
14034             ;; Nuke all remaining illegal elements.
14035             (setcdr srange nil))
14036
14037         ;; Adjust the final element.
14038         (if (and (not (atom (car srange)))
14039                  (> (cdr (car srange)) (cdr active)))
14040             (setcdr (car srange) (cdr active))))
14041       ;; Compute the number of unread articles.
14042       (while range
14043         (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
14044                                     (cdr (car range))))
14045                             (or (and (atom (car range)) (car range))
14046                                 (car (car range))))))
14047         (setq range (cdr range)))
14048       (setq num (max 0 (- (cdr active) num)))))
14049     ;; Set the number of unread articles.
14050     (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)
14051     num))
14052
14053 (defun gnus-activate-group (group &optional scan)
14054   ;; Check whether a group has been activated or not.
14055   ;; If SCAN, request a scan of that group as well.
14056   (let ((method (gnus-find-method-for-group group))
14057         active)
14058     (and (gnus-check-server method)
14059          ;; We escape all bugs and quit here to make it possible to
14060          ;; continue if a group is so out-there that it reports bugs
14061          ;; and stuff.
14062          (progn
14063            (and scan
14064                 (gnus-check-backend-function 'request-scan (car method))
14065                 (gnus-request-scan group method))
14066            t)
14067          (condition-case ()
14068              (gnus-request-group group)
14069            (error nil)
14070            (quit nil))
14071          (save-excursion
14072            (set-buffer nntp-server-buffer)
14073            (goto-char (point-min))
14074            ;; Parse the result we got from `gnus-request-group'.
14075            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
14076                 (progn
14077                   (goto-char (match-beginning 1))
14078                   (gnus-set-active 
14079                    group (setq active (cons (read (current-buffer))
14080                                             (read (current-buffer)))))
14081                   ;; Return the new active info.
14082                   active))))))
14083
14084 (defun gnus-update-read-articles (group unread)
14085   "Update the list of read and ticked articles in GROUP using the
14086 UNREAD and TICKED lists.
14087 Note: UNSELECTED has to be sorted over `<'.
14088 Returns whether the updating was successful."
14089   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
14090          (entry (gnus-gethash group gnus-newsrc-hashtb))
14091          (info (nth 2 entry))
14092          (marked (gnus-info-marks info))
14093          (prev 1)
14094          (unread (sort (copy-sequence unread) '<))
14095          read)
14096     (if (or (not info) (not active))
14097         ;; There is no info on this group if it was, in fact,
14098         ;; killed.  Gnus stores no information on killed groups, so
14099         ;; there's nothing to be done. 
14100         ;; One could store the information somewhere temporarily,
14101         ;; perhaps...  Hmmm... 
14102         ()
14103       ;; Remove any negative articles numbers.
14104       (while (and unread (< (car unread) 0))
14105         (setq unread (cdr unread)))
14106       ;; Remove any expired article numbers
14107       (while (and unread (< (car unread) (car active)))
14108         (setq unread (cdr unread)))
14109       ;; Compute the ranges of read articles by looking at the list of
14110       ;; unread articles.  
14111       (while unread
14112         (if (/= (car unread) prev)
14113             (setq read (cons (if (= prev (1- (car unread))) prev
14114                                (cons prev (1- (car unread)))) read)))
14115         (setq prev (1+ (car unread)))
14116         (setq unread (cdr unread)))
14117       (when (<= prev (cdr active))
14118         (setq read (cons (cons prev (cdr active)) read)))
14119       ;; Enter this list into the group info.
14120       (gnus-info-set-read 
14121        info (if (> (length read) 1) (nreverse read) read))
14122       ;; Set the number of unread articles in gnus-newsrc-hashtb.
14123       (gnus-get-unread-articles-in-group info (gnus-active group))
14124       t)))
14125
14126 (defun gnus-make-articles-unread (group articles)
14127   "Mark ARTICLES in GROUP as unread."
14128   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
14129                           (gnus-gethash (gnus-group-real-name group)
14130                                         gnus-newsrc-hashtb))))
14131          (ranges (gnus-info-read info))
14132          news article)
14133     (while articles
14134       (when (gnus-member-of-range 
14135              (setq article (pop articles)) ranges)
14136         (setq news (cons article news))))
14137     (when news
14138       (gnus-info-set-read 
14139        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
14140       (gnus-group-update-group group t))))
14141
14142 ;; Enter all dead groups into the hashtb.
14143 (defun gnus-update-active-hashtb-from-killed ()
14144   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
14145         (lists (list gnus-killed-list gnus-zombie-list))
14146         killed)
14147     (while lists
14148       (setq killed (car lists))
14149       (while killed
14150         (gnus-sethash (car killed) nil hashtb)
14151         (setq killed (cdr killed)))
14152       (setq lists (cdr lists)))))
14153
14154 ;; Get the active file(s) from the backend(s).
14155 (defun gnus-read-active-file ()
14156   (gnus-group-set-mode-line)
14157   (let ((methods (if (gnus-check-server gnus-select-method)
14158                      ;; The native server is available.
14159                      (cons gnus-select-method gnus-secondary-select-methods)
14160                    ;; The native server is down, so we just do the
14161                    ;; secondary ones.   
14162                    gnus-secondary-select-methods))
14163         list-type)
14164     (setq gnus-have-read-active-file nil)
14165     (save-excursion
14166       (set-buffer nntp-server-buffer)
14167       (while methods
14168         (let* ((method (gnus-server-get-method nil (car methods)))
14169                (where (nth 1 method))
14170                (mesg (format "Reading active file%s via %s..."
14171                              (if (and where (not (zerop (length where))))
14172                                  (concat " from " where) "")
14173                              (car method))))
14174           (gnus-message 5 mesg)
14175           (if (not (gnus-check-server method))
14176               ()
14177             ;; Request that the backend scan its incoming messages.
14178             (and (gnus-check-backend-function 'request-scan (car method))
14179                  (gnus-request-scan nil method))
14180             (cond 
14181              ((and (eq gnus-read-active-file 'some)
14182                    (gnus-check-backend-function 'retrieve-groups (car method)))
14183               (let ((newsrc (cdr gnus-newsrc-alist))
14184                     (gmethod (gnus-server-get-method nil method))
14185                     groups)
14186                 (while newsrc
14187                   (and (gnus-server-equal 
14188                         (gnus-find-method-for-group 
14189                          (car (car newsrc)) (car newsrc))
14190                         gmethod)
14191                        (setq groups (cons (gnus-group-real-name 
14192                                            (car (car newsrc))) groups)))
14193                   (setq newsrc (cdr newsrc)))
14194                 (gnus-check-server method)
14195                 (setq list-type (gnus-retrieve-groups groups method))
14196                 (cond 
14197                  ((not list-type)
14198                   (gnus-message 
14199                    1 "Cannot read partial active file from %s server." 
14200                    (car method))
14201                   (ding)
14202                   (sit-for 2))
14203                  ((eq list-type 'active)
14204                   (gnus-active-to-gnus-format method gnus-active-hashtb))
14205                  (t
14206                   (gnus-groups-to-gnus-format method gnus-active-hashtb)))))
14207              (t
14208               (if (not (gnus-request-list method))
14209                   (progn
14210                     (gnus-message 1 "Cannot read active file from %s server." 
14211                                   (car method))
14212                     (ding))
14213                 (gnus-active-to-gnus-format method)
14214                 ;; We mark this active file as read.
14215                 (setq gnus-have-read-active-file
14216                       (cons method gnus-have-read-active-file))
14217                 (gnus-message 5 "%sdone" mesg))))))
14218         (setq methods (cdr methods))))))
14219
14220 ;; Read an active file and place the results in `gnus-active-hashtb'.
14221 (defun gnus-active-to-gnus-format (method &optional hashtb ignore-errors)
14222   (let ((cur (current-buffer))
14223         (hashtb (or hashtb 
14224                     (if (and gnus-active-hashtb 
14225                              (not (equal method gnus-select-method)))
14226                         gnus-active-hashtb
14227                       (setq gnus-active-hashtb
14228                             (if (equal method gnus-select-method)
14229                                 (gnus-make-hashtable 
14230                                  (count-lines (point-min) (point-max)))
14231                               (gnus-make-hashtable 4096))))))
14232         (flag-hashtb (gnus-make-hashtable 60)))
14233     ;; Delete unnecessary lines.
14234     (goto-char (point-min))
14235     (while (search-forward "\nto." nil t)
14236       (delete-region (1+ (match-beginning 0)) 
14237                      (progn (forward-line 1) (point))))
14238     (or (string= gnus-ignored-newsgroups "")
14239         (progn
14240           (goto-char (point-min))
14241           (delete-matching-lines gnus-ignored-newsgroups)))
14242     ;; Make the group names readable as a lisp expression even if they
14243     ;; contain special characters.
14244     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
14245     (goto-char (point-max))
14246     (while (re-search-backward "[][';?()#]" nil t)
14247       (insert ?\\))
14248     ;; If these are groups from a foreign select method, we insert the
14249     ;; group prefix in front of the group names. 
14250     (and method (not (gnus-server-equal
14251                       (gnus-server-get-method nil method)
14252                       (gnus-server-get-method nil gnus-select-method)))
14253          (let ((prefix (gnus-group-prefixed-name "" method)))
14254            (goto-char (point-min))
14255            (while (and (not (eobp))
14256                        (progn (insert prefix)
14257                               (zerop (forward-line 1)))))))
14258     ;; Store the active file in a hash table.
14259     (goto-char (point-min))
14260     (if (string-match "%[oO]" gnus-group-line-format)
14261         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
14262         ;; If we want information on moderated groups, we use this
14263         ;; loop...   
14264         (let* ((mod-hashtb (make-vector 7 0))
14265                (m (intern "m" mod-hashtb))
14266                group max min)
14267           (while (not (eobp))
14268             (condition-case nil
14269                 (progn
14270                   (narrow-to-region (point) (gnus-point-at-eol))
14271                   (setq group (let ((obarray hashtb)) (read cur)))
14272                   (if (and (numberp (setq max (read cur)))
14273                            (numberp (setq min (read cur)))
14274                            (progn 
14275                              (skip-chars-forward " \t")
14276                              (not
14277                               (or (= (following-char) ?=)
14278                                   (= (following-char) ?x)
14279                                   (= (following-char) ?j)))))
14280                       (set group (cons min max))
14281                     (set group nil))
14282                   ;; Enter moderated groups into a list.
14283                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
14284                       (setq gnus-moderated-list 
14285                             (cons (symbol-name group) gnus-moderated-list))))
14286               (error 
14287                (and group
14288                     (symbolp group)
14289                     (set group nil))))
14290             (widen)
14291             (forward-line 1)))
14292       ;; And if we do not care about moderation, we use this loop,
14293       ;; which is faster.
14294       (let (group max min)
14295         (while (not (eobp))
14296           (condition-case ()
14297               (progn
14298                 (narrow-to-region (point) (gnus-point-at-eol))
14299                 ;; group gets set to a symbol interned in the hash table
14300                 ;; (what a hack!!) - jwz
14301                 (setq group (let ((obarray hashtb)) (read cur)))
14302                 (if (and (numberp (setq max (read cur)))
14303                          (numberp (setq min (read cur)))
14304                          (progn 
14305                            (skip-chars-forward " \t")
14306                            (not
14307                             (or (= (following-char) ?=)
14308                                 (= (following-char) ?x)
14309                                 (= (following-char) ?j)))))
14310                     (set group (cons min max))
14311                   (set group nil)))
14312             (error 
14313              (progn 
14314                (and group
14315                     (symbolp group)
14316                     (set group nil))
14317                (or ignore-errors
14318                    (gnus-message 3 "Warning - illegal active: %s"
14319                                  (buffer-substring 
14320                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
14321           (widen)
14322           (forward-line 1))))))
14323
14324 (defun gnus-groups-to-gnus-format (method &optional hashtb)
14325   ;; Parse a "groups" active file.
14326   (let ((cur (current-buffer))
14327         (hashtb (or hashtb 
14328                     (if (and method gnus-active-hashtb)
14329                         gnus-active-hashtb
14330                       (setq gnus-active-hashtb
14331                             (gnus-make-hashtable 
14332                              (count-lines (point-min) (point-max)))))))
14333         (prefix (and method 
14334                      (not (gnus-server-equal
14335                            (gnus-server-get-method nil method)
14336                            (gnus-server-get-method nil gnus-select-method)))
14337                      (gnus-group-prefixed-name "" method))))
14338
14339     (goto-char (point-min))
14340     ;; We split this into to separate loops, one with the prefix
14341     ;; and one without to speed the reading up somewhat.
14342     (if prefix
14343         (let (min max opoint group)
14344           (while (not (eobp))
14345             (condition-case ()
14346                 (progn
14347                   (read cur) (read cur)
14348                   (setq min (read cur)
14349                         max (read cur)
14350                         opoint (point))
14351                   (skip-chars-forward " \t")
14352                   (insert prefix)
14353                   (goto-char opoint)
14354                   (set (let ((obarray hashtb)) (read cur)) 
14355                        (cons min max)))
14356               (error (and group (symbolp group) (set group nil))))
14357             (forward-line 1)))
14358       (let (min max group)
14359         (while (not (eobp))
14360           (condition-case ()
14361               (if (= (following-char) ?2)
14362                   (progn
14363                     (read cur) (read cur)
14364                     (setq min (read cur)
14365                           max (read cur))
14366                     (set (setq group (let ((obarray hashtb)) (read cur)))
14367                          (cons min max))))
14368             (error (and group (symbolp group) (set group nil))))
14369           (forward-line 1))))))
14370
14371 (defun gnus-read-newsrc-file (&optional force)
14372   "Read startup file.
14373 If FORCE is non-nil, the .newsrc file is read."
14374   ;; Reset variables that might be defined in the .newsrc.eld file.
14375   (let ((variables gnus-variable-list))
14376     (while variables
14377       (set (car variables) nil)
14378       (setq variables (cdr variables))))
14379   (let* ((newsrc-file gnus-current-startup-file)
14380          (quick-file (concat newsrc-file ".el")))
14381     (save-excursion
14382       ;; We always load the .newsrc.eld file.  If always contains
14383       ;; much information that can not be gotten from the .newsrc
14384       ;; file (ticked articles, killed groups, foreign methods, etc.)
14385       (gnus-read-newsrc-el-file quick-file)
14386  
14387       (if (or force
14388               (and (file-newer-than-file-p newsrc-file quick-file)
14389                    (file-newer-than-file-p newsrc-file 
14390                                            (concat quick-file "d")))
14391               (not gnus-newsrc-alist))
14392           ;; We read the .newsrc file.  Note that if there if a
14393           ;; .newsrc.eld file exists, it has already been read, and
14394           ;; the `gnus-newsrc-hashtb' has been created.  While reading
14395           ;; the .newsrc file, Gnus will only use the information it
14396           ;; can find there for changing the data already read -
14397           ;; ie. reading the .newsrc file will not trash the data
14398           ;; already read (except for read articles).
14399           (save-excursion
14400             (gnus-message 5 "Reading %s..." newsrc-file)
14401             (set-buffer (find-file-noselect newsrc-file))
14402             (buffer-disable-undo (current-buffer))
14403             (gnus-newsrc-to-gnus-format)
14404             (kill-buffer (current-buffer))
14405             (gnus-message 5 "Reading %s...done" newsrc-file)))
14406
14407       ;; Read any slave files.
14408       (or gnus-slave
14409           (gnus-master-read-slave-newsrc)))))
14410
14411 (defun gnus-read-newsrc-el-file (file)
14412   (let ((ding-file (concat file "d")))
14413     ;; We always, always read the .eld file.
14414     (gnus-message 5 "Reading %s..." ding-file)
14415     (let (gnus-newsrc-assoc)
14416       (condition-case nil
14417           (load ding-file t t t)
14418         (error
14419          (gnus-message 1 "Error in %s" ding-file)
14420          (ding)))
14421       (when gnus-newsrc-assoc 
14422         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
14423     (gnus-make-hashtable-from-newsrc-alist)
14424     (when (file-newer-than-file-p file ding-file)
14425       ;; Old format quick file
14426       (gnus-message 5 "Reading %s..." file)
14427       ;; The .el file is newer than the .eld file, so we read that one
14428       ;; as well. 
14429       (gnus-read-old-newsrc-el-file file))))
14430
14431 ;; Parse the old-style quick startup file
14432 (defun gnus-read-old-newsrc-el-file (file)
14433   (let (newsrc killed marked group m)
14434     (prog1
14435         (let ((gnus-killed-assoc nil)
14436               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
14437           (prog1
14438               (condition-case nil
14439                   (load file t t t)
14440                 (error nil))
14441             (setq newsrc gnus-newsrc-assoc
14442                   killed gnus-killed-assoc
14443                   marked gnus-marked-assoc)))
14444       (setq gnus-newsrc-alist nil)
14445       (while newsrc
14446         (setq group (car newsrc))
14447         (let ((info (gnus-get-info (car group))))
14448           (if info
14449               (progn
14450                 (gnus-info-set-read info (cdr (cdr group)))
14451                 (gnus-info-set-level
14452                  info (if (nth 1 group) gnus-level-default-subscribed 
14453                         gnus-level-default-unsubscribed))
14454                 (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
14455             (setq gnus-newsrc-alist
14456                   (cons 
14457                    (setq info
14458                          (list (car group)
14459                                (if (nth 1 group) gnus-level-default-subscribed
14460                                  gnus-level-default-unsubscribed) 
14461                                (cdr (cdr group))))
14462                    gnus-newsrc-alist)))
14463           (if (setq m (assoc (car group) marked))
14464               (gnus-info-set-marks 
14465                info (cons (list (cons 'tick (gnus-compress-sequence
14466                                              (sort (cdr m) '<) t)))
14467                           nil))))
14468         (setq newsrc (cdr newsrc)))
14469       (setq newsrc killed)
14470       (while newsrc
14471         (setcar newsrc (car (car newsrc)))
14472         (setq newsrc (cdr newsrc)))
14473       (setq gnus-killed-list killed))
14474     ;; The .el file version of this variable does not begin with
14475     ;; "options", while the .eld version does, so we just add it if it
14476     ;; isn't there.
14477     (and
14478      gnus-newsrc-options 
14479      (progn
14480        (and (not (string-match "^ *options" gnus-newsrc-options))
14481             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
14482        (and (not (string-match "\n$" gnus-newsrc-options))
14483             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
14484        ;; Finally, if we read some options lines, we parse them.
14485        (or (string= gnus-newsrc-options "")
14486            (gnus-newsrc-parse-options gnus-newsrc-options))))
14487
14488     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
14489     (gnus-make-hashtable-from-newsrc-alist)))
14490       
14491 (defun gnus-make-newsrc-file (file)
14492   "Make server dependent file name by catenating FILE and server host name."
14493   (let* ((file (expand-file-name file nil))
14494          (real-file (concat file "-" (nth 1 gnus-select-method))))
14495     (if (or (file-exists-p real-file)
14496             (file-exists-p (concat real-file ".el"))
14497             (file-exists-p (concat real-file ".eld")))
14498         real-file file)))
14499
14500 (defun gnus-newsrc-to-gnus-format ()
14501   (setq gnus-newsrc-options "")
14502   (setq gnus-newsrc-options-n nil)
14503
14504   (or gnus-active-hashtb
14505       (setq gnus-active-hashtb (make-vector 4095 0)))
14506   (let ((buf (current-buffer))
14507         (already-read (> (length gnus-newsrc-alist) 1))
14508         group subscribed options-symbol newsrc Options-symbol
14509         symbol reads num1)
14510     (goto-char (point-min))
14511     ;; We intern the symbol `options' in the active hashtb so that we
14512     ;; can `eq' against it later.
14513     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
14514     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
14515   
14516     (while (not (eobp))
14517       ;; We first read the first word on the line by narrowing and
14518       ;; then reading into `gnus-active-hashtb'.  Most groups will
14519       ;; already exist in that hashtb, so this will save some string
14520       ;; space.
14521       (narrow-to-region
14522        (point)
14523        (progn (skip-chars-forward "^ \t!:\n") (point)))
14524       (goto-char (point-min))
14525       (setq symbol 
14526             (and (/= (point-min) (point-max))
14527                  (let ((obarray gnus-active-hashtb)) (read buf))))
14528       (widen)
14529       ;; Now, the symbol we have read is either `options' or a group
14530       ;; name.  If it is an options line, we just add it to a string. 
14531       (cond 
14532        ((or (eq symbol options-symbol)
14533             (eq symbol Options-symbol))
14534         (setq gnus-newsrc-options
14535               ;; This concatting is quite inefficient, but since our
14536               ;; thorough studies show that approx 99.37% of all
14537               ;; .newsrc files only contain a single options line, we
14538               ;; don't give a damn, frankly, my dear.
14539               (concat gnus-newsrc-options
14540                       (buffer-substring 
14541                        (gnus-point-at-bol)
14542                        ;; Options may continue on the next line.
14543                        (or (and (re-search-forward "^[^ \t]" nil 'move)
14544                                 (progn (beginning-of-line) (point)))
14545                            (point)))))
14546         (forward-line -1))
14547        (symbol
14548         (or (boundp symbol) (set symbol nil))
14549         ;; It was a group name.
14550         (setq subscribed (= (following-char) ?:)
14551               group (symbol-name symbol)
14552               reads nil)
14553         (if (eolp)
14554             ;; If the line ends here, this is clearly a buggy line, so
14555             ;; we put point a the beginning of line and let the cond
14556             ;; below do the error handling.
14557             (beginning-of-line)
14558           ;; We skip to the beginning of the ranges.
14559           (skip-chars-forward "!: \t"))
14560         ;; We are now at the beginning of the list of read articles.
14561         ;; We read them range by range.
14562         (while
14563             (cond 
14564              ((looking-at "[0-9]+")
14565               ;; We narrow and read a number instead of buffer-substring/
14566               ;; string-to-int because it's faster.  narrow/widen is
14567               ;; faster than save-restriction/narrow, and save-restriction
14568               ;; produces a garbage object.
14569               (setq num1 (progn
14570                            (narrow-to-region (match-beginning 0) (match-end 0))
14571                            (read buf)))
14572               (widen)
14573               ;; If the next character is a dash, then this is a range.
14574               (if (= (following-char) ?-)
14575                   (progn
14576                     ;; We read the upper bound of the range.
14577                     (forward-char 1)
14578                     (if (not (looking-at "[0-9]+"))
14579                         ;; This is a buggy line, by we pretend that
14580                         ;; it's kinda OK.  Perhaps the user should be
14581                         ;; dinged? 
14582                         (setq reads (cons num1 reads))
14583                       (setq reads 
14584                             (cons 
14585                              (cons num1
14586                                    (progn
14587                                      (narrow-to-region (match-beginning 0) 
14588                                                        (match-end 0))
14589                                      (read buf)))
14590                              reads))
14591                       (widen)))
14592                 ;; It was just a simple number, so we add it to the
14593                 ;; list of ranges.
14594                 (setq reads (cons num1 reads)))
14595               ;; If the next char in ?\n, then we have reached the end
14596               ;; of the line and return nil.
14597               (/= (following-char) ?\n))
14598              ((= (following-char) ?\n)
14599               ;; End of line, so we end.
14600               nil)
14601              (t
14602               ;; Not numbers and not eol, so this might be a buggy
14603               ;; line... 
14604               (or (eobp)                
14605                   ;; If it was eob instead of ?\n, we allow it.
14606                   (progn
14607                     ;; The line was buggy.
14608                     (setq group nil)
14609                     (gnus-message 3 "Mangled line: %s" 
14610                                   (buffer-substring (gnus-point-at-bol) 
14611                                                     (gnus-point-at-eol)))
14612                     (ding)
14613                     (sit-for 1)))
14614               nil))
14615           ;; Skip past ", ".  Spaces are illegal in these ranges, but
14616           ;; we allow them, because it's a common mistake to put a
14617           ;; space after the comma.
14618           (skip-chars-forward ", "))
14619
14620         ;; We have already read .newsrc.eld, so we gently update the
14621         ;; data in the hash table with the information we have just
14622         ;; read. 
14623         (when group
14624           (let ((info (gnus-get-info group))
14625                 level)
14626             (if info
14627                 ;; There is an entry for this file in the alist.
14628                 (progn
14629                   (gnus-info-set-read info (nreverse reads))
14630                   ;; We update the level very gently.  In fact, we
14631                   ;; only change it if there's been a status change
14632                   ;; from subscribed to unsubscribed, or vice versa.
14633                   (setq level (gnus-info-level info))
14634                   (cond ((and (<= level gnus-level-subscribed)
14635                               (not subscribed))
14636                          (setq level (if reads
14637                                          gnus-level-default-unsubscribed 
14638                                        (1+ gnus-level-default-unsubscribed))))
14639                         ((and (> level gnus-level-subscribed) subscribed)
14640                          (setq level gnus-level-default-subscribed)))
14641                   (gnus-info-set-level info level))
14642               ;; This is a new group.
14643               (setq info (list group 
14644                                (if subscribed
14645                                    gnus-level-default-subscribed 
14646                                  (if reads
14647                                      (1+ gnus-level-subscribed)
14648                                    gnus-level-default-unsubscribed))
14649                                (nreverse reads))))
14650             (setq newsrc (cons info newsrc))))))
14651       (forward-line 1))
14652     
14653     (setq newsrc (nreverse newsrc))
14654
14655     (if (not already-read)
14656         ()
14657       ;; We now have two newsrc lists - `newsrc', which is what we
14658       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
14659       ;; what we've read from .newsrc.eld.  We have to merge these
14660       ;; lists.  We do this by "attaching" any (foreign) groups in the
14661       ;; gnus-newsrc-alist to the (native) group that precedes them. 
14662       (let ((rc (cdr gnus-newsrc-alist))
14663             (prev gnus-newsrc-alist)
14664             entry mentry)
14665         (while rc
14666           (or (null (nth 4 (car rc)))   ; It's a native group.
14667               (assoc (car (car rc)) newsrc) ; It's already in the alist.
14668               (if (setq entry (assoc (car (car prev)) newsrc))
14669                   (setcdr (setq mentry (memq entry newsrc))
14670                           (cons (car rc) (cdr mentry)))
14671                 (setq newsrc (cons (car rc) newsrc))))
14672           (setq prev rc
14673                 rc (cdr rc)))))
14674
14675     (setq gnus-newsrc-alist newsrc)
14676     ;; We make the newsrc hashtb.
14677     (gnus-make-hashtable-from-newsrc-alist)
14678
14679     ;; Finally, if we read some options lines, we parse them.
14680     (or (string= gnus-newsrc-options "")
14681         (gnus-newsrc-parse-options gnus-newsrc-options))))
14682
14683 ;; Parse options lines to find "options -n !all rec.all" and stuff.
14684 ;; The return value will be a list on the form
14685 ;; ((regexp1 . ignore)
14686 ;;  (regexp2 . subscribe)...)
14687 ;; When handling new newsgroups, groups that match a `ignore' regexp
14688 ;; will be ignored, and groups that match a `subscribe' regexp will be
14689 ;; subscribed.  A line like
14690 ;; options -n !all rec.all
14691 ;; will lead to a list that looks like
14692 ;; (("^rec\\..+" . subscribe) 
14693 ;;  ("^.+" . ignore))
14694 ;; So all "rec.*" groups will be subscribed, while all the other
14695 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
14696 ;; different from "options -n rec.all !all". 
14697 (defun gnus-newsrc-parse-options (options)
14698   (let (out eol)
14699     (save-excursion
14700       (gnus-set-work-buffer)
14701       (insert (regexp-quote options))
14702       ;; First we treat all continuation lines.
14703       (goto-char (point-min))
14704       (while (re-search-forward "\n[ \t]+" nil t)
14705         (replace-match " " t t))
14706       ;; Then we transform all "all"s into ".+"s.
14707       (goto-char (point-min))
14708       (while (re-search-forward "\\ball\\b" nil t)
14709         (replace-match ".+" t t))
14710       (goto-char (point-min))
14711       ;; We remove all other options than the "-n" ones.
14712       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
14713         (replace-match " ")
14714         (forward-char -1))
14715       (goto-char (point-min))
14716
14717       ;; We are only interested in "options -n" lines - we
14718       ;; ignore the other option lines.
14719       (while (re-search-forward "[ \t]-n" nil t)
14720         (setq eol 
14721               (or (save-excursion
14722                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
14723                          (- (point) 2)))
14724                   (gnus-point-at-eol)))
14725         ;; Search for all "words"...
14726         (while (re-search-forward "[^ \t,\n]+" eol t)
14727           (if (= (char-after (match-beginning 0)) ?!)
14728               ;; If the word begins with a bang (!), this is a "not"
14729               ;; spec.  We put this spec (minus the bang) and the
14730               ;; symbol `ignore' into the list.
14731               (setq out (cons (cons (concat 
14732                                      "^" (buffer-substring 
14733                                           (1+ (match-beginning 0))
14734                                           (match-end 0)))
14735                                     'ignore) out))
14736             ;; There was no bang, so this is a "yes" spec.
14737             (setq out (cons (cons (concat "^" (match-string 0))
14738                                   'subscribe) out)))))
14739     
14740       (setq gnus-newsrc-options-n out))))
14741
14742 (defun gnus-save-newsrc-file (&optional force)
14743   "Save .newsrc file."
14744   ;; Note: We cannot save .newsrc file if all newsgroups are removed
14745   ;; from the variable gnus-newsrc-alist.
14746   (when (and (or gnus-newsrc-alist gnus-killed-list)
14747              gnus-current-startup-file)
14748     (save-excursion
14749       (if (and (or gnus-use-dribble-file gnus-slave)
14750                (not force)
14751                (or (not gnus-dribble-buffer)
14752                    (not (buffer-name gnus-dribble-buffer))
14753                    (zerop (save-excursion
14754                             (set-buffer gnus-dribble-buffer)
14755                             (buffer-size)))))
14756           (gnus-message 4 "(No changes need to be saved)")
14757         (run-hooks 'gnus-save-newsrc-hook)
14758         (if gnus-slave
14759             (gnus-slave-save-newsrc)
14760           ;; Save .newsrc.
14761           (when gnus-save-newsrc-file
14762             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
14763             (gnus-gnus-to-newsrc-format)
14764             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
14765           ;; Save .newsrc.eld.
14766           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
14767           (make-local-variable 'version-control)
14768           (setq version-control 'never)
14769           (setq buffer-file-name 
14770                 (concat gnus-current-startup-file ".eld"))
14771           (gnus-add-current-to-buffer-list)
14772           (buffer-disable-undo (current-buffer))
14773           (erase-buffer)
14774           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
14775           (gnus-gnus-to-quick-newsrc-format)
14776           (run-hooks 'gnus-save-quick-newsrc-hook)
14777           (save-buffer)
14778           (kill-buffer (current-buffer))
14779           (gnus-message 
14780            5 "Saving %s.eld...done" gnus-current-startup-file))
14781         (gnus-dribble-delete-file)))))
14782
14783 (defun gnus-gnus-to-quick-newsrc-format ()
14784   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
14785   (insert ";; Gnus startup file.\n")
14786   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
14787   (insert ";; to read .newsrc.\n")
14788   (insert "(setq gnus-newsrc-file-version "
14789           (prin1-to-string gnus-version) ")\n")
14790   (let ((variables 
14791          (if gnus-save-killed-list gnus-variable-list
14792            ;; Remove the `gnus-killed-list' from the list of variables
14793            ;; to be saved, if required.
14794            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
14795         ;; Peel off the "dummy" group.
14796         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
14797         variable)
14798     ;; Insert the variables into the file.
14799     (while variables
14800       (when (and (boundp (setq variable (pop variables)))
14801                  (symbol-value variable))
14802         (insert "(setq " (symbol-name variable) " '"
14803                 (prin1-to-string (symbol-value variable)) ")\n")))))
14804
14805 (defun gnus-gnus-to-newsrc-format ()
14806   ;; Generate and save the .newsrc file.
14807   (let ((newsrc (cdr gnus-newsrc-alist))
14808         info ranges range)
14809     (save-excursion
14810       (set-buffer (create-file-buffer gnus-current-startup-file))
14811       (setq buffer-file-name gnus-current-startup-file)
14812       (buffer-disable-undo (current-buffer))
14813       (erase-buffer)
14814       ;; Write options.
14815       (if gnus-newsrc-options (insert gnus-newsrc-options))
14816       ;; Write subscribed and unsubscribed.
14817       (while newsrc
14818         (setq info (car newsrc))
14819         (if (not (gnus-info-method info))
14820             ;; Don't write foreign groups to .newsrc.
14821             (progn
14822               (insert (gnus-info-group info)
14823                       (if (> (nth 1 info) gnus-level-subscribed)
14824                           "!" ":"))
14825               (if (setq ranges (gnus-info-read info))
14826                   (progn
14827                     (insert " ")
14828                     (if (not (listp (cdr ranges)))
14829                         (if (= (car ranges) (cdr ranges))
14830                             (insert (int-to-string (car ranges)))
14831                           (insert (int-to-string (car ranges)) "-" 
14832                                   (int-to-string (cdr ranges))))
14833                       (while ranges
14834                         (setq range (car ranges)
14835                               ranges (cdr ranges))
14836                         (if (or (atom range) (= (car range) (cdr range)))
14837                             (insert (int-to-string 
14838                                      (or (and (atom range) range) 
14839                                          (car range))))
14840                           (insert (int-to-string (car range)) "-"
14841                                   (int-to-string (cdr range))))
14842                         (if ranges (insert ","))))))
14843               (insert "\n")))
14844         (setq newsrc (cdr newsrc)))
14845       (make-local-variable 'version-control)
14846       (setq version-control 'never)
14847       ;; It has been reported that sometime the modtime on the .newsrc
14848       ;; file seems to be off.  We really do want to overwrite it, so
14849       ;; we clear the modtime here before saving.  It's a bit odd,
14850       ;; though... 
14851       ;; sometimes the modtime clear isn't sufficient.  most brute force:
14852       ;; delete the silly thing entirely first.  but this fails to provide
14853       ;; such niceties as .newsrc~ creation.
14854       (if gnus-modtime-botch
14855           (delete-file gnus-startup-file)
14856         (clear-visited-file-modtime))
14857       (run-hooks 'gnus-save-standard-newsrc-hook)
14858       (save-buffer)
14859       (kill-buffer (current-buffer)))))
14860
14861
14862 ;;; Slave functions.
14863
14864 (defun gnus-slave-save-newsrc ()
14865   (save-excursion
14866     (set-buffer gnus-dribble-buffer)
14867     (let ((slave-name 
14868            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
14869       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
14870
14871 (defun gnus-master-read-slave-newsrc ()
14872   (let ((slave-files 
14873          (directory-files 
14874           (file-name-directory gnus-current-startup-file)
14875           t (concat 
14876              "^" (regexp-quote
14877                   (concat
14878                    (file-name-nondirectory gnus-current-startup-file)
14879                    "-slave-")))
14880           t))
14881         file)
14882     (if (not slave-files)
14883         ()                              ; There are no slave files to read.
14884       (gnus-message 7 "Reading slave newsrcs...")
14885       (save-excursion
14886         (set-buffer (get-buffer-create " *gnus slave*"))
14887         (buffer-disable-undo (current-buffer))
14888         (setq slave-files 
14889               (sort (mapcar (lambda (file) 
14890                               (list (nth 5 (file-attributes file)) file))
14891                             slave-files)
14892                     (lambda (f1 f2)
14893                       (or (< (car (car f1)) (car (car f2)))
14894                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
14895         (while slave-files
14896           (erase-buffer)
14897           (setq file (nth 1 (car slave-files)))
14898           (insert-file-contents file)
14899           (if (condition-case ()
14900                   (progn
14901                     (eval-buffer (current-buffer))
14902                     t)
14903                 (error 
14904                  (message "Possible error in %s" file)
14905                  (ding)
14906                  (sit-for 2)
14907                  nil))
14908               (or gnus-slave ; Slaves shouldn't delete these files.
14909                   (condition-case ()
14910                       (delete-file file)
14911                     (error nil))))
14912           (setq slave-files (cdr slave-files))))
14913       (gnus-message 7 "Reading slave newsrcs...done"))))
14914
14915
14916 ;;; Group description.
14917
14918 (defun gnus-read-all-descriptions-files ()
14919   (let ((methods (cons gnus-select-method gnus-secondary-select-methods)))
14920     (while methods
14921       (gnus-read-descriptions-file (car methods))
14922       (setq methods (cdr methods)))
14923     t))
14924
14925 (defun gnus-read-descriptions-file (&optional method)
14926   (let ((method (or method gnus-select-method)))
14927     ;; We create the hashtable whether we manage to read the desc file
14928     ;; to avoid trying to re-read after a failed read.
14929     (or gnus-description-hashtb
14930         (setq gnus-description-hashtb 
14931               (gnus-make-hashtable (length gnus-active-hashtb))))
14932     ;; Mark this method's desc file as read.
14933     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
14934                   gnus-description-hashtb)
14935
14936     (gnus-message 5 "Reading descriptions file via %s..." (car method))
14937     (cond 
14938      ((not (gnus-check-server method))
14939       (gnus-message 1 "Couldn't open server")
14940       nil)
14941      ((not (gnus-request-list-newsgroups method))
14942       (gnus-message 1 "Couldn't read newsgroups descriptions")
14943       nil)
14944      (t
14945       (let (group)
14946         (save-excursion
14947           (save-restriction
14948             (set-buffer nntp-server-buffer)
14949             (goto-char (point-min))
14950             (if (or (search-forward "\n.\n" nil t)
14951                     (goto-char (point-max)))
14952                 (progn
14953                   (beginning-of-line)
14954                   (narrow-to-region (point-min) (point))))
14955             (goto-char (point-min))
14956             (while (not (eobp))
14957               ;; If we get an error, we set group to 0, which is not a
14958               ;; symbol... 
14959               (setq group 
14960                     (condition-case ()
14961                         (let ((obarray gnus-description-hashtb))
14962                           ;; Group is set to a symbol interned in this
14963                           ;; hash table.
14964                           (read nntp-server-buffer))
14965                       (error 0)))
14966               (skip-chars-forward " \t")
14967               ;; ...  which leads to this line being effectively ignored.
14968               (and (symbolp group)
14969                    (set group (buffer-substring 
14970                                (point) (progn (end-of-line) (point)))))
14971               (forward-line 1))))
14972         (gnus-message 5 "Reading descriptions file...done")
14973         t)))))
14974
14975 (defun gnus-group-get-description (group)
14976   "Get the description of a group by sending XGTITLE to the server."
14977   (when (gnus-request-group-description group)
14978     (save-excursion
14979       (set-buffer nntp-server-buffer)
14980       (goto-char (point-min))
14981       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
14982         (match-string 1)))))
14983
14984 ;;;
14985 ;;; Buffering of read articles.
14986 ;;;
14987
14988 (defvar gnus-backlog-buffer " *Gnus Backlog*")
14989 (defvar gnus-backlog-articles nil)
14990 (defvar gnus-backlog-hashtb nil)
14991
14992 (defun gnus-backlog-buffer ()
14993   "Return the backlog buffer."
14994   (or (get-buffer gnus-backlog-buffer)
14995       (save-excursion
14996         (set-buffer (get-buffer-create gnus-backlog-buffer))
14997         (buffer-disable-undo (current-buffer))
14998         (setq buffer-read-only t)
14999         (gnus-add-current-to-buffer-list))))
15000
15001 (defun gnus-backlog-setup ()
15002   "Initialize backlog variables."
15003   (unless gnus-backlog-hashtb
15004     (setq gnus-backlog-hashtb (make-vector 1023 0))))
15005
15006 (defun gnus-backlog-enter-article (group number buffer)
15007   (gnus-backlog-setup)
15008   (let ((ident (intern (concat group ":" (int-to-string number))
15009                        gnus-backlog-hashtb))
15010         b)
15011     (if (memq ident gnus-backlog-articles)
15012         () ; It's already kept.
15013       ;; Remove the oldest article, if necessary.
15014       (and (numberp gnus-keep-backlog)
15015            (>= (length gnus-backlog-articles) gnus-keep-backlog)
15016            (gnus-backlog-remove-oldest-article))
15017       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
15018       ;; Insert the new article.
15019       (save-excursion
15020         (set-buffer (gnus-backlog-buffer))
15021         (let (buffer-read-only)
15022           (goto-char (point-max))
15023           (or (bolp) (insert "\n"))
15024           (setq b (point))
15025           (insert-buffer-substring buffer)
15026           ;; Tag the beginning of the article with the ident.
15027           (put-text-property b (1+ b) 'gnus-backlog ident))))))
15028
15029 (defun gnus-backlog-remove-oldest-article ()
15030   (save-excursion
15031     (set-buffer (gnus-backlog-buffer))
15032     (goto-char (point-min))
15033     (if (zerop (buffer-size))
15034         () ; The buffer is empty.
15035       (let ((ident (get-text-property (point) 'gnus-backlog))
15036             buffer-read-only)
15037         ;; Remove the ident from the list of articles.
15038         (when ident
15039           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
15040         ;; Delete the article itself.
15041         (delete-region 
15042          (point) (next-single-property-change
15043                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
15044
15045 (defun gnus-backlog-request-article (group number buffer)
15046   (gnus-backlog-setup)
15047   (let ((ident (intern (concat group ":" (int-to-string number))
15048                        gnus-backlog-hashtb))
15049         beg end)
15050     (when (memq ident gnus-backlog-articles)
15051       ;; It was in the backlog.
15052       (save-excursion
15053         (set-buffer (gnus-backlog-buffer))
15054         (if (not (setq beg (text-property-any 
15055                             (point-min) (point-max) 'gnus-backlog
15056                             ident)))
15057             ;; It wasn't in the backlog after all.
15058             (progn
15059               (setq gnus-backlog-articles (delq ident gnus-backlog-articles))
15060               nil)
15061           ;; Find the end (i. e., the beginning of the next article).
15062           (setq end
15063                 (next-single-property-change 
15064                  (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
15065       (let ((buffer-read-only nil))
15066         (erase-buffer)
15067         (insert-buffer-substring gnus-backlog-buffer beg end)))))
15068
15069 ;; Allow redefinition of Gnus functions.
15070
15071 (gnus-ems-redefine)
15072
15073 (provide 'gnus)
15074
15075 ;;; gnus.el ends here