f496629db105430cd9831f522bca4fe264e5f098
[gnus] / lisp / gnus.el
1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (eval '(run-hooks 'gnus-load-hook))
29
30 (require 'mail-utils)
31 (require 'timezone)
32 (require 'nnheader)
33
34 (eval-when-compile (require 'cl))
35
36 ;; Site dependent variables.  These variables should be defined in
37 ;; paths.el.
38
39 (defvar gnus-default-nntp-server nil
40   "Specify a default NNTP server.
41 This variable should be defined in paths.el, and should never be set
42 by the user.
43 If you want to change servers, you should use `gnus-select-method'.
44 See the documentation to that variable.")
45
46 (defconst gnus-backup-default-subscribed-newsgroups 
47   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
48   "Default default new newsgroups the first time Gnus is run.
49 Should be set in paths.el, and shouldn't be touched by the user.")
50
51 (defvar gnus-local-domain nil
52   "Local domain name without a host name.
53 The DOMAINNAME environment variable is used instead if it is defined.
54 If the `system-name' function returns the full Internet name, there is
55 no need to set this variable.")
56
57 (defvar gnus-local-organization nil
58   "String with a description of what organization (if any) the user belongs to.
59 The ORGANIZATION environment variable is used instead if it is defined.
60 If this variable contains a function, this function will be called
61 with the current newsgroup name as the argument.  The function should
62 return a string.
63
64 In any case, if the string (either in the variable, in the environment
65 variable, or returned by the function) is a file name, the contents of
66 this file will be used as the organization.")
67
68 (defvar gnus-use-generic-from nil
69   "If nil, the full host name will be the system name prepended to the domain name.
70 If this is a string, the full host name will be this string.
71 If this is non-nil, non-string, the domain name will be used as the
72 full host name.")
73
74 (defvar gnus-use-generic-path nil
75   "If nil, use the NNTP server name in the Path header.
76 If stringp, use this; if non-nil, use no host name (user name only).")
77
78
79 ;; Customization variables
80
81 ;; Don't touch this variable.
82 (defvar gnus-nntp-service "nntp"
83   "*NNTP service name (\"nntp\" or 119).
84 This is an obsolete variable, which is scarcely used.  If you use an
85 nntp server for your newsgroup and want to change the port number
86 used to 899, you would say something along these lines:
87
88  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
89
90 (defvar gnus-nntpserver-file "/etc/nntpserver"
91   "*A file with only the name of the nntp server in it.")
92
93 ;; This function is used to check both the environment variable
94 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
95 ;; an nntp server name default.
96 (defun gnus-getenv-nntpserver ()
97   (or (getenv "NNTPSERVER")
98       (and (file-readable-p gnus-nntpserver-file)
99            (save-excursion
100              (set-buffer (get-buffer-create " *gnus nntp*"))
101              (buffer-disable-undo (current-buffer))
102              (insert-file-contents gnus-nntpserver-file)
103              (let ((name (buffer-string)))
104                (prog1
105                    (if (string-match "^[ \t\n]*$" name)
106                        nil
107                      name)
108                  (kill-buffer (current-buffer))))))))
109                  
110 (defvar gnus-select-method 
111   (nconc
112    (list 'nntp (or (condition-case ()
113                        (gnus-getenv-nntpserver)
114                      (error nil))
115                    (if (and gnus-default-nntp-server
116                             (not (string= gnus-default-nntp-server "")))
117                        gnus-default-nntp-server)
118                    (system-name)))
119    (if (or (null gnus-nntp-service)
120            (equal gnus-nntp-service "nntp"))
121        nil 
122      (list gnus-nntp-service)))
123   "*Default method for selecting a newsgroup.
124 This variable should be a list, where the first element is how the
125 news is to be fetched, the second is the address. 
126
127 For instance, if you want to get your news via NNTP from
128 \"flab.flab.edu\", you could say:
129
130 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
131
132 If you want to use your local spool, say:
133
134 (setq gnus-select-method (list 'nnspool (system-name)))
135
136 If you use this variable, you must set `gnus-nntp-server' to nil.
137
138 There is a lot more to know about select methods and virtual servers -
139 see the manual for details.")
140
141 ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
142 (defvar gnus-post-method nil
143   "*Preferred method for posting USENET news.
144 If this variable is nil, Gnus will use the current method to decide
145 which method to use when posting.  If it is non-nil, it will override
146 the current method.  This method will not be used in mail groups and
147 the like, only in \"real\" newsgroups.
148
149 The value must be a valid method as discussed in the documentation of
150 `gnus-select-method'.")
151
152 (defvar gnus-refer-article-method nil
153   "*Preferred method for fetching an article by Message-ID.
154 If you are reading news from the local spool (with nnspool), fetching
155 articles by Message-ID is painfully slow.  By setting this method to an
156 nntp method, you might get acceptable results.
157
158 The value of this variable must be a valid select method as discussed
159 in the documentation of `gnus-select-method'")
160
161 (defvar gnus-secondary-select-methods nil
162   "*A list of secondary methods that will be used for reading news.
163 This is a list where each element is a complete select method (see
164 `gnus-select-method').  
165
166 If, for instance, you want to read your mail with the nnml backend,
167 you could set this variable:
168
169 (setq gnus-secondary-select-methods '((nnml \"\")))")
170
171 (defvar gnus-secondary-servers nil
172   "*List of NNTP servers that the user can choose between interactively.
173 To make Gnus query you for a server, you have to give `gnus' a
174 non-numeric prefix - `C-u M-x gnus', in short.")
175
176 (defvar gnus-nntp-server nil
177   "*The name of the host running the NNTP server.
178 This variable is semi-obsolete.  Use the `gnus-select-method'
179 variable instead.")
180
181 (defvar gnus-startup-file "~/.newsrc"
182   "*Your `.newsrc' file.
183 `.newsrc-SERVER' will be used instead if that exists.")
184
185 (defvar gnus-init-file "~/.gnus"
186   "*Your Gnus elisp startup file.
187 If a file with the .el or .elc suffixes exist, it will be read
188 instead.") 
189
190 (defvar gnus-group-faq-directory
191   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
192 ;    "/ftp@ftp.uu.net:/usenet/news.answers/"
193     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
194     "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
195     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
196 ;    "/ftp@ftp.Germany.EU.net:/pub/newsarchive/news.answers/"
197     "/ftp@ftp.sunet.se:/pub/usenet/"
198     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
199     "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
200     "/ftp@ftp.hk.super.net:/mirror/faqs/")
201   "*Directory where the group FAQs are stored.
202 This will most commonly be on a remote machine, and the file will be
203 fetched by ange-ftp.
204
205 This variable can also be a list of directories.  In that case, the
206 first element in the list will be used by default, and the others will
207 be used as backup sites.
208
209 Note that Gnus uses an aol machine as the default directory.  If this
210 feels fundamentally unclean, just think of it as a way to finally get
211 something of value back from them.
212
213 If the default site is too slow, try one of these:
214
215    North America: mirrors.aol.com                /pub/rtfm/usenet
216                   ftp.seas.gwu.edu               /pub/rtfm
217                   rtfm.mit.edu                   /pub/usenet/news.answers
218    Europe:        ftp.uni-paderborn.de           /pub/FAQ
219                   ftp.sunet.se                   /pub/usenet
220    Asia:          nctuccca.edu.tw                /USENET/FAQ
221                   hwarang.postech.ac.kr          /pub/usenet/news.answers
222                   ftp.hk.super.net               /mirror/faqs")
223
224 (defvar gnus-group-archive-directory
225   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" 
226   "*The address of the (ding) archives.")
227
228 (defvar gnus-group-recent-archive-directory
229   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
230   "*The address of the most recent (ding) articles.")
231
232 (defvar gnus-default-subscribed-newsgroups nil
233   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
234 It should be a list of strings.
235 If it is `t', Gnus will not do anything special the first time it is
236 started; it'll just use the normal newsgroups subscription methods.")
237
238 (defvar gnus-use-cross-reference t
239   "*Non-nil means that cross referenced articles will be marked as read.
240 If nil, ignore cross references.  If t, mark articles as read in
241 subscribed newsgroups.  If neither t nor nil, mark as read in all
242 newsgroups.") 
243
244 (defvar gnus-use-dribble-file t
245   "*Non-nil means that Gnus will use a dribble file to store user updates.
246 If Emacs should crash without saving the .newsrc files, complete
247 information can be restored from the dribble file.")
248
249 (defvar gnus-dribble-directory nil
250   "*The directory where dribble files will be saved.
251 If this variable is nil, the directory where the .newsrc files are
252 saved will be used.")
253
254 (defvar gnus-asynchronous nil
255   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
256
257 (defvar gnus-large-newsgroup 200
258   "*The number of articles which indicates a large newsgroup.
259 If the number of articles in a newsgroup is greater than this value,
260 confirmation is required for selecting the newsgroup.")
261
262 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
263 (defvar gnus-no-groups-message "No news is horrible news"
264   "*Message displayed by Gnus when no groups are available.")
265
266 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
267   "*Non-nil means that the default name of a file to save articles in is the group name.
268 If it's nil, the directory form of the group name is used instead.
269
270 If this variable is a list, and the list contains the element
271 `not-score', long file names will not be used for score files; if it
272 contains the element `not-save', long file names will not be used for
273 saving; and if it contains the element `not-kill', long file names
274 will not be used for kill files.")
275
276 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
277   "*Name of the directory articles will be saved in (default \"~/News\").
278 Initialized from the SAVEDIR environment variable.")
279
280 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
281   "*Name of the directory where kill files will be stored (default \"~/News\").
282 Initialized from the SAVEDIR environment variable.")
283
284 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
285   "*A function to save articles in your favorite format.
286 The function must be interactively callable (in other words, it must
287 be an Emacs command).
288
289 Gnus provides the following functions:
290
291 * gnus-summary-save-in-rmail (Rmail format)
292 * gnus-summary-save-in-mail (Unix mail format)
293 * gnus-summary-save-in-folder (MH folder)
294 * gnus-summary-save-in-file (article format).
295 * gnus-summary-save-in-vm (use VM's folder format).")
296
297 (defvar gnus-prompt-before-saving 'always
298   "*This variable says how much prompting is to be done when saving articles.
299 If it is nil, no prompting will be done, and the articles will be
300 saved to the default files.  If this variable is `always', each and
301 every article that is saved will be preceded by a prompt, even when
302 saving large batches of articles.  If this variable is neither nil not
303 `always', there the user will be prompted once for a file name for
304 each invocation of the saving commands.")
305
306 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
307   "*A function generating a file name to save articles in Rmail format.
308 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
309
310 (defvar gnus-mail-save-name (function gnus-plain-save-name)
311   "*A function generating a file name to save articles in Unix mail format.
312 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
313
314 (defvar gnus-folder-save-name (function gnus-folder-save-name)
315   "*A function generating a file name to save articles in MH folder.
316 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
317
318 (defvar gnus-file-save-name (function gnus-numeric-save-name)
319   "*A function generating a file name to save articles in article format.
320 The function is called with NEWSGROUP, HEADERS, and optional
321 LAST-FILE.")
322
323 (defvar gnus-split-methods nil
324   "*Variable used to suggest where articles are to be saved.
325 The syntax of this variable is the same as `nnmail-split-methods'.  
326
327 For instance, if you would like to save articles related to Gnus in
328 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
329 you could set this variable to something like:
330
331  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
332    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))")
333
334 (defvar gnus-save-score nil
335   "*If non-nil, save group scoring info.")
336
337 (defvar gnus-use-adaptive-scoring nil
338   "*If non-nil, use some adaptive scoring scheme.")
339
340 (defvar gnus-use-cache nil
341   "*If non-nil, Gnus will cache (some) articles locally.")
342
343 (defvar gnus-keep-backlog nil
344   "*If non-nil, Gnus will keep read articles for later re-retrieval.
345 If it is a number N, then Gnus will only keep the last N articles
346 read.  If it is neither nil nor a number, Gnus will keep all read
347 articles.  This is not a good idea.")
348
349 (defvar gnus-use-nocem nil
350   "*If non-nil, Gnus will read NoCeM cancel messages.")
351
352 (defvar gnus-use-demon nil
353   "If non-nil, Gnus might use some demons.")
354
355 (defvar gnus-use-scoring t
356   "*If non-nil, enable scoring.")
357
358 (defvar gnus-fetch-old-headers nil
359   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
360 If an unread article in the group refers to an older, already read (or
361 just marked as read) article, the old article will not normally be
362 displayed in the Summary buffer.  If this variable is non-nil, Gnus
363 will attempt to grab the headers to the old articles, and thereby
364 build complete threads.  If it has the value `some', only enough
365 headers to connect otherwise loose threads will be displayed.
366 This variable can also be a number.  In that case, no more than that
367 number of old headers will be fetched. 
368
369 The server has to support NOV for any of this to work.")
370
371 ;see gnus-cus.el
372 ;(defvar gnus-visual t
373 ;  "*If non-nil, will do various highlighting.
374 ;If nil, no mouse highlights (or any other highlights) will be
375 ;performed.  This might speed up Gnus some when generating large group
376 ;and summary buffers.")
377
378 (defvar gnus-novice-user t
379   "*Non-nil means that you are a usenet novice.
380 If non-nil, verbose messages may be displayed and confirmations may be
381 required.")
382
383 (defvar gnus-expert-user nil
384   "*Non-nil means that you will never be asked for confirmation about anything.
385 And that means *anything*.")
386
387 (defvar gnus-verbose 7
388   "*Integer that says how verbose Gnus should be.
389 The higher the number, the more messages Gnus will flash to say what
390 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
391 display most important messages; and at ten, Gnus will keep on
392 jabbering all the time.")
393
394 (defvar gnus-keep-same-level nil
395   "*Non-nil means that the next newsgroup after the current will be on the same level.
396 When you type, for instance, `n' after reading the last article in the
397 current newsgroup, you will go to the next newsgroup.  If this variable
398 is nil, the next newsgroup will be the next from the group
399 buffer. 
400 If this variable is non-nil, Gnus will either put you in the
401 next newsgroup with the same level, or, if no such newsgroup is
402 available, the next newsgroup with the lowest possible level higher
403 than the current level.
404 If this variable is `best', Gnus will make the next newsgroup the one
405 with the best level.")
406
407 (defvar gnus-summary-make-false-root 'adopt
408   "*nil means that Gnus won't gather loose threads.
409 If the root of a thread has expired or been read in a previous
410 session, the information necessary to build a complete thread has been
411 lost.  Instead of having many small sub-threads from this original thread
412 scattered all over the summary buffer, Gnus can gather them. 
413
414 If non-nil, Gnus will try to gather all loose sub-threads from an
415 original thread into one large thread.
416
417 If this variable is non-nil, it should be one of `none', `adopt',
418 `dummy' or `empty'.
419
420 If this variable is `none', Gnus will not make a false root, but just
421 present the sub-threads after another.
422 If this variable is `dummy', Gnus will create a dummy root that will
423 have all the sub-threads as children.
424 If this variable is `adopt', Gnus will make one of the \"children\"
425 the parent and mark all the step-children as such.
426 If this variable is `empty', the \"children\" are printed with empty
427 subject fields.  (Or rather, they will be printed with a string
428 given by the `gnus-summary-same-subject' variable.)")
429
430 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
431   "*A regexp to match subjects to be excluded from loose thread gathering.
432 As loose thread gathering is done on subjects only, that means that
433 there can be many false gatherings performed.  By rooting out certain
434 common subjects, gathering might become saner.")
435
436 (defvar gnus-summary-gather-subject-limit nil
437   "*Maximum length of subject comparisons when gathering loose threads.
438 Use nil to compare full subjects.  Setting this variable to a low
439 number will help gather threads that have been corrupted by
440 newsreaders chopping off subject lines, but it might also mean that
441 unrelated articles that have subject that happen to begin with the
442 same few characters will be incorrectly gathered.
443
444 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
445 comparing subjects.")
446
447 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
448 (defvar gnus-summary-same-subject ""
449   "*String indicating that the current article has the same subject as the previous.
450 This variable will only be used if the value of
451 `gnus-summary-make-false-root' is `empty'.")
452
453 (defvar gnus-summary-goto-unread t
454   "*If non-nil, marking commands will go to the next unread article.")
455
456 (defvar gnus-group-goto-unread t
457   "*If non-nil, movement commands will go to the next unread and subscribed group.")
458
459 (defvar gnus-check-new-newsgroups t
460   "*Non-nil means that Gnus will add new newsgroups at startup.
461 If this variable is `ask-server', Gnus will ask the server for new
462 groups since the last time it checked.  This means that the killed list
463 is no longer necessary, so you could set `gnus-save-killed-list' to
464 nil. 
465
466 A variant is to have this variable be a list of select methods.  Gnus
467 will then use the `ask-server' method on all these select methods to
468 query for new groups from all those servers.
469
470 Eg.
471   (setq gnus-check-new-newsgroups 
472         '((nntp \"some.server\") (nntp \"other.server\")))
473
474 If this variable is nil, then you have to tell Gnus explicitly to
475 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
476
477 (defvar gnus-check-bogus-newsgroups nil
478   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
479 If this variable is nil, then you have to tell Gnus explicitly to
480 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
481
482 (defvar gnus-read-active-file t
483   "*Non-nil means that Gnus will read the entire active file at startup.
484 If this variable is nil, Gnus will only know about the groups in your
485 `.newsrc' file.
486
487 If this variable is `some', Gnus will try to only read the relevant
488 parts of the active file from the server.  Not all servers support
489 this, and it might be quite slow with other servers, but this should
490 generally be faster than both the t and nil value.
491
492 If you set this variable to nil or `some', you probably still want to
493 be told about new newsgroups that arrive.  To do that, set
494 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
495 properly with all servers.")
496
497 (defvar gnus-level-subscribed 5
498   "*Groups with levels less than or equal to this variable are subscribed.")
499
500 (defvar gnus-level-unsubscribed 7
501   "*Groups with levels less than or equal to this variable are unsubscribed.
502 Groups with levels less than `gnus-level-subscribed', which should be
503 less than this variable, are subscribed.")
504
505 (defvar gnus-level-zombie 8
506   "*Groups with this level are zombie groups.")
507
508 (defvar gnus-level-killed 9
509   "*Groups with this level are killed.")
510
511 (defvar gnus-level-default-subscribed 3
512   "*New subscribed groups will be subscribed at this level.")
513
514 (defvar gnus-level-default-unsubscribed 6
515   "*New unsubscribed groups will be unsubscribed at this level.")
516
517 (defvar gnus-activate-foreign-newsgroups 4
518   "*If nil, Gnus will not check foreign newsgroups at startup.
519 If it is non-nil, it should be a number between one and nine.  Foreign
520 newsgroups that have a level lower or equal to this number will be
521 activated on startup.  For instance, if you want to active all
522 subscribed newsgroups, but not the rest, you'd set this variable to 
523 `gnus-level-subscribed'.
524
525 If you subscribe to lots of newsgroups from different servers, startup
526 might take a while.  By setting this variable to nil, you'll save time,
527 but you won't be told how many unread articles there are in the
528 groups.")
529
530 (defvar gnus-save-newsrc-file t
531   "*Non-nil means that Gnus will save the `.newsrc' file.
532 Gnus always saves its own startup file, which is called
533 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
534 be readily understood by other newsreaders.  If you don't plan on
535 using other newsreaders, set this variable to nil to save some time on
536 exit.")
537
538 (defvar gnus-save-killed-list t
539   "*If non-nil, save the list of killed groups to the startup file.
540 This will save both time (when starting and quitting) and space (both
541 memory and disk), but it will also mean that Gnus has no record of
542 which groups are new and which are old, so the automatic new
543 newsgroups subscription methods become meaningless.  You should always
544 set `gnus-check-new-newsgroups' to `ask-server' or nil if you set this
545 variable to nil.")
546
547 (defvar gnus-interactive-catchup t
548   "*If non-nil, require your confirmation when catching up a group.")
549
550 (defvar gnus-interactive-post t
551   "*If non-nil, group name will be asked for when posting.")
552
553 (defvar gnus-interactive-exit t
554   "*If non-nil, require your confirmation when exiting Gnus.")
555
556 (defvar gnus-kill-killed t
557   "*If non-nil, Gnus will apply kill files to already killed articles.
558 If it is nil, Gnus will never apply kill files to articles that have
559 already been through the scoring process, which might very well save lots
560 of time.")
561
562 (defvar gnus-extract-address-components 'gnus-extract-address-components
563   "*Function for extracting address components from a From header.
564 Two pre-defined function exist: `gnus-extract-address-components',
565 which is the default, quite fast, and too simplistic solution, and
566 `mail-extract-address-components', which works much better, but is
567 slower.")
568
569 (defvar gnus-summary-default-score 0
570   "*Default article score level.
571 If this variable is nil, scoring will be disabled.")
572
573 (defvar gnus-summary-zcore-fuzz 0
574   "*Fuzziness factor for the zcore in the summary buffer.
575 Articles with scores closer than this to `gnus-summary-default-score'
576 will not be marked.")
577
578 (defvar gnus-simplify-subject-fuzzy-regexp nil
579   "*Strings to be removed when doing fuzzy matches.
580 This can either be a egular expression or list of regular expressions
581 that will be removed from subject strings if fuzzy subject
582 simplification is selected.")
583
584 (defvar gnus-permanently-visible-groups nil
585   "*Regexp to match groups that should always be listed in the group buffer.
586 This means that they will still be listed when there are no unread
587 articles in the groups.")
588
589 (defvar gnus-group-default-list-level gnus-level-subscribed
590   "*Default listing level. 
591 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
592
593 (defvar gnus-group-use-permanent-levels nil
594   "*If non-nil, once you set a level, Gnus will use this level.")
595
596 (defvar gnus-show-mime nil
597   "*If non-nil, do mime processing of articles.
598 The articles will simply be fed to the function given by
599 `gnus-show-mime-method'.")
600
601 (defvar gnus-strict-mime t
602   "*If nil, decode MIME header even if there is not Mime-Version field.")
603  
604 (defvar gnus-show-mime-method 'metamail-buffer
605   "*Function to process a MIME message.
606 The function is called from the article buffer.")
607
608 (defvar gnus-decode-encoded-word-method (lambda ())
609   "*Function to decode a MIME encoded-words.
610 The function is called from the article buffer.")
611  
612 (defvar gnus-show-threads t
613   "*If non-nil, display threads in summary mode.")
614
615 (defvar gnus-thread-hide-subtree nil
616   "*If non-nil, hide all threads initially.
617 If threads are hidden, you have to run the command
618 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
619 to expose hidden threads.")
620
621 (defvar gnus-thread-hide-killed t
622   "*If non-nil, hide killed threads automatically.")
623
624 (defvar gnus-thread-ignore-subject nil
625   "*If non-nil, ignore subjects and do all threading based on the Reference header.
626 If nil, which is the default, articles that have different subjects
627 from their parents will start separate threads.")
628
629 (defvar gnus-thread-operation-ignore-subject t
630   "*If non-nil, subjects will be ignored when doing thread commands.
631 This affects commands like `gnus-summary-kill-thread' and
632 `gnus-summary-lower-thread'.  
633
634 If this variable is nil, articles in the same thread with different
635 subjects will not be included in the operation in question.  If this
636 variable is `fuzzy', only articles that have subjects that are fuzzily
637 equal will be included.")
638
639 (defvar gnus-thread-indent-level 4
640   "*Number that says how much each sub-thread should be indented.")
641
642 (defvar gnus-ignored-newsgroups 
643   (purecopy (mapconcat 'identity
644                        '("^to\\."       ; not "real" groups
645                          "^[0-9. \t]+ " ; all digits in name
646                          "[][\"#'()]"   ; bogus characters
647                          )
648                        "\\|"))
649   "*A regexp to match uninteresting newsgroups in the active file.
650 Any lines in the active file matching this regular expression are
651 removed from the newsgroup list before anything else is done to it,
652 thus making them effectively non-existent.")
653
654 (defvar gnus-ignored-headers
655   "^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:"
656   "*All headers that match this regexp will be hidden.
657 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
658
659 (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-"
660   "*All headers that do not match this regexp will be hidden.
661 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
662
663 (defvar gnus-sorted-header-list
664   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" 
665     "^Cc:" "^Date:" "^Organization:")
666   "*This variable is a list of regular expressions.
667 If it is non-nil, headers that match the regular expressions will
668 be placed first in the article buffer in the sequence specified by
669 this list.")
670
671 (defvar gnus-show-all-headers nil
672   "*If non-nil, don't hide any headers.")
673
674 (defvar gnus-save-all-headers t
675   "*If non-nil, don't remove any headers before saving.")
676
677 (defvar gnus-saved-headers gnus-visible-headers
678   "*Headers to keep if `gnus-save-all-headers' is nil.
679 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
680 If that variable is nil, however, all headers that match this regexp
681 will be kept while the rest will be deleted before saving.")
682
683 (defvar gnus-inhibit-startup-message nil
684   "*If non-nil, the startup message will not be displayed.")
685
686 (defvar gnus-signature-separator "^-- *$"
687   "Regexp matching signature separator.")
688
689 (defvar gnus-auto-extend-newsgroup t
690   "*If non-nil, extend newsgroup forward and backward when requested.")
691
692 (defvar gnus-auto-select-first t
693   "*If nil, don't select the first unread article when entering a group.
694 If this variable is `best', select the highest-scored unread article
695 in the group.  If neither nil nor `best', select the first unread
696 article.
697
698 If you want to prevent automatic selection of the first unread article
699 in some newsgroups, set the variable to nil in
700 `gnus-select-group-hook'.") 
701
702 (defvar gnus-auto-select-next t
703   "*If non-nil, offer to go to the next group from the end of the previous.
704 If the value is t and the next newsgroup is empty, Gnus will exit
705 summary mode and go back to group mode.  If the value is neither nil
706 nor t, Gnus will select the following unread newsgroup.  In
707 particular, if the value is the symbol `quietly', the next unread
708 newsgroup will be selected without any confirmation, and if it is
709 `almost-quietly', the next group will be selected without any
710 confirmation if you are located on the last article in the group.")
711
712 (defvar gnus-auto-select-same nil
713   "*If non-nil, select the next article with the same subject.")
714
715 (defvar gnus-summary-check-current nil
716   "*If non-nil, consider the current article when moving.
717 The \"unread\" movement commands will stay on the same line if the
718 current article is unread.")
719
720 (defvar gnus-auto-center-summary t
721   "*If non-nil, always center the current summary buffer.")
722
723 (defvar gnus-break-pages t
724   "*If non-nil, do page breaking on articles.
725 The page delimiter is specified by the `gnus-page-delimiter'
726 variable.")
727
728 (defvar gnus-page-delimiter "^\^L"
729   "*Regexp describing what to use as article page delimiters.
730 The default value is \"^\^L\", which is a form linefeed at the
731 beginning of a line.")
732
733 (defvar gnus-use-full-window t
734   "*If non-nil, use the entire Emacs screen.")
735
736 (defvar gnus-window-configuration nil
737   "Obsolete variable.  See `gnus-buffer-configuration'.")
738
739 (defvar gnus-buffer-configuration
740   '((group ([group 1.0 point] 
741             (if gnus-carpal [group-carpal 4])))
742     (summary ([summary 1.0 point]
743               (if gnus-carpal [summary-carpal 4])))
744     (article ([summary 0.25 point] 
745               (if gnus-carpal [summary-carpal 4]) 
746               [article 1.0]))
747     (server ([server 1.0 point]
748              (if gnus-carpal [server-carpal 2])))
749     (browse ([browse 1.0 point]
750              (if gnus-carpal [browse-carpal 2])))
751     (group-mail ([mail 1.0 point]))
752     (summary-mail ([mail 1.0 point]))
753     (summary-reply ([article 0.5]
754                     [mail 1.0 point]))
755     (info ([nil 1.0 point]))
756     (summary-faq ([summary 0.25]
757                   [faq 1.0 point]))
758     (edit-group ([group 0.5]
759                  [edit-group 1.0 point]))
760     (edit-server ([server 0.5]
761                   [edit-server 1.0 point]))
762     (edit-score ([summary 0.25]
763                  [edit-score 1.0 point]))
764     (post ([post 1.0 point]))
765     (reply ([article 0.5]
766             [mail 1.0 point]))
767     (mail-forward ([mail 1.0 point]))
768     (post-forward ([post 1.0 point]))
769     (reply-yank ([mail 1.0 point]))
770     (mail-bounce ([article 0.5]
771                   [mail 1.0 point]))
772     (draft ([draft 1.0 point]))
773     (pipe ([summary 0.25 point] 
774            (if gnus-carpal [summary-carpal 4]) 
775            ["*Shell Command Output*" 1.0]))
776     (followup ([article 0.5]
777                [post 1.0 point]))
778     (followup-yank ([post 1.0 point])))
779   "Window configuration for all possible Gnus buffers.
780 This variable is a list of lists.  Each of these lists has a NAME and
781 a RULE.  The NAMEs are commonsense names like `group', which names a
782 rule used when displaying the group buffer; `summary', which names a
783 rule for what happens when you enter a group and do not display an
784 article buffer; and so on.  See the value of this variable for a
785 complete list of NAMEs.
786
787 Each RULE is a list of vectors.  The first element in this vector is
788 the name of the buffer to be displayed; the second element is the
789 percentage of the screen this buffer is to occupy (a number in the
790 0.0-0.99 range); the optional third element is `point', which should
791 be present to denote which buffer point is to go to after making this
792 buffer configuration.")
793
794 (defvar gnus-window-to-buffer
795   '((group . gnus-group-buffer)
796     (summary . gnus-summary-buffer)
797     (article . gnus-article-buffer)
798     (server . gnus-server-buffer)
799     (browse . "*Gnus Browse Server*")
800     (edit-group . gnus-group-edit-buffer)
801     (edit-server . gnus-server-edit-buffer)
802     (group-carpal . gnus-carpal-group-buffer)
803     (summary-carpal . gnus-carpal-summary-buffer)
804     (server-carpal . gnus-carpal-server-buffer)
805     (browse-carpal . gnus-carpal-browse-buffer)
806     (edit-score . gnus-score-edit-buffer)
807     (mail . gnus-mail-buffer)
808     (post . gnus-post-news-buffer)
809     (faq . gnus-faq-buffer)
810     (draft . gnus-draft-buffer))
811   "Mapping from short symbols to buffer names or buffer variables.")
812
813 (defvar gnus-carpal nil
814   "*If non-nil, display clickable icons.")
815
816 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
817   "*Function called with a group name when new group is detected.
818 A few pre-made functions are supplied: `gnus-subscribe-randomly'
819 inserts new groups at the beginning of the list of groups;
820 `gnus-subscribe-alphabetically' inserts new groups in strict
821 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
822 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
823 for your decision.")
824
825 ;; Suggested by a bug report by Hallvard B Furuseth.
826 ;; <h.b.furuseth@usit.uio.no>. 
827 (defvar gnus-subscribe-options-newsgroup-method
828   (function gnus-subscribe-alphabetically)
829   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
830 If, for instance, you want to subscribe to all newsgroups in the
831 \"no\" and \"alt\" hierarchies, you'd put the following in your
832 .newsrc file:
833
834 options -n no.all alt.all
835
836 Gnus will the subscribe all new newsgroups in these hierarchies with
837 the subscription method in this variable.")
838
839 (defvar gnus-subscribe-hierarchical-interactive nil
840   "*If non-nil, Gnus will offer to subscribe hierarchically.
841 When a new hierarchy appears, Gnus will ask the user:
842
843 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
844
845 If the user pressed `d', Gnus will descend the hierarchy, `y' will
846 subscribe to all newsgroups in the hierarchy and `s' will skip this
847 hierarchy in its entirety.")
848
849 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
850   "*Function used for sorting the group buffer.
851 This function will be called with group info entries as the arguments
852 for the groups to be sorted.  Pre-made functions include
853 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
854 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
855 `gnus-group-sort-by-rank'.  
856
857 This variable can also be a list of sorting functions.  In that case,
858 the most significant sort function should be the last function in the
859 list.")
860
861 ;; Mark variables suggested by Thomas Michanek
862 ;; <Thomas.Michanek@telelogic.se>. 
863 (defvar gnus-unread-mark ? 
864   "*Mark used for unread articles.")
865 (defvar gnus-ticked-mark ?!
866   "*Mark used for ticked articles.")
867 (defvar gnus-dormant-mark ??
868   "*Mark used for dormant articles.")
869 (defvar gnus-del-mark ?r
870   "*Mark used for del'd articles.")
871 (defvar gnus-read-mark ?R
872   "*Mark used for read articles.")
873 (defvar gnus-expirable-mark ?E
874   "*Mark used for expirable articles.")
875 (defvar gnus-killed-mark ?K
876   "*Mark used for killed articles.")
877 (defvar gnus-souped-mark ?F
878   "*Mark used for killed articles.")
879 (defvar gnus-kill-file-mark ?X
880   "*Mark used for articles killed by kill files.")
881 (defvar gnus-low-score-mark ?Y
882   "*Mark used for articles with a low score.")
883 (defvar gnus-catchup-mark ?C
884   "*Mark used for articles that are caught up.")
885 (defvar gnus-replied-mark ?A
886   "*Mark used for articles that have been replied to.")
887 (defvar gnus-process-mark ?# 
888   "*Process mark.")
889 (defvar gnus-ancient-mark ?O
890   "*Mark used for ancient articles.")
891 (defvar gnus-canceled-mark ?G
892   "*Mark used for canceled articles.")
893 (defvar gnus-score-over-mark ?+
894   "*Score mark used for articles with high scores.")
895 (defvar gnus-score-below-mark ?-
896   "*Score mark used for articles with low scores.")
897 (defvar gnus-empty-thread-mark ? 
898   "*There is no thread under the article.")
899 (defvar gnus-not-empty-thread-mark ?=
900   "*There is a thread under the article.")
901
902 (defvar gnus-view-pseudo-asynchronously nil
903   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
904
905 (defvar gnus-view-pseudos nil
906   "*If `automatic', pseudo-articles will be viewed automatically.
907 If `not-confirm', pseudos will be viewed automatically, and the user
908 will not be asked to confirm the command.")
909
910 (defvar gnus-view-pseudos-separately t
911   "*If non-nil, one pseudo-article will be created for each file to be viewed.
912 If nil, all files that use the same viewing command will be given as a
913 list of parameters to that command.")
914
915 (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)\n"
916   "*Format of group lines.
917 It works along the same lines as a normal formatting string,
918 with some simple extensions.
919
920 %M    Only marked articles (character, \"*\" or \" \")
921 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
922 %L    Level of subscribedness (integer)
923 %N    Number of unread articles (integer)
924 %I    Number of dormant articles (integer)
925 %i    Number of ticked and dormant (integer)
926 %T    Number of ticked articles (integer)
927 %R    Number of read articles (integer)
928 %t    Total number of articles (integer)
929 %y    Number of unread, unticked articles (integer)
930 %G    Group name (string)
931 %g    Qualified group name (string)
932 %D    Group description (string)
933 %s    Select method (string)
934 %o    Moderated group (char, \"m\")
935 %p    Process mark (char)
936 %O    Moderated group (string, \"(m)\" or \"\")
937 %P    Topic indentation (string)
938 %n    Select from where (string)
939 %z    A string that look like `<%s:%n>' if a foreign select method is used
940 %u    User defined specifier.  The next character in the format string should
941       be a letter.  Gnus will call the function gnus-user-format-function-X,
942       where X is the letter following %u.  The function will be passed the
943       current header as argument.  The function should return a string, which
944       will be inserted into the buffer just like information from any other
945       group specifier.
946
947 Text between %( and %) will be highlighted with `gnus-mouse-face' when
948 the mouse point move inside the area.  There can only be one such area.
949
950 Note that this format specification is not always respected.  For
951 reasons of efficiency, when listing killed groups, this specification
952 is ignored altogether.  If the spec is changed considerably, your
953 output may end up looking strange when listing both alive and killed
954 groups.
955
956 If you use %o or %O, reading the active file will be slower and quite
957 a bit of extra memory will be used. %D will also worsen performance.
958 Also note that if you change the format specification to include any
959 of these specs, you must probably re-start Gnus to see them go into
960 effect.") 
961
962 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
963   "*The format specification of the lines in the summary buffer.
964
965 It works along the same lines as a normal formatting string,
966 with some simple extensions.
967
968 %N   Article number, left padded with spaces (string)
969 %S   Subject (string)
970 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
971 %n   Name of the poster (string)
972 %a   Extracted name of the poster (string)
973 %A   Extracted address of the poster (string)
974 %F   Contents of the From: header (string)
975 %x   Contents of the Xref: header (string)
976 %D   Date of the article (string)
977 %d   Date of the article (string) in DD-MMM format
978 %M   Message-id of the article (string)
979 %r   References of the article (string)
980 %c   Number of characters in the article (integer)
981 %L   Number of lines in the article (integer)
982 %I   Indentation based on thread level (a string of spaces)
983 %T   A string with two possible values: 80 spaces if the article
984      is on thread level two or larger and 0 spaces on level one
985 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
986 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
987 %[   Opening bracket (character, \"[\" or \"<\")
988 %]   Closing bracket (character, \"]\" or \">\")
989 %>   Spaces of length thread-level (string)
990 %<   Spaces of length (- 20 thread-level) (string)
991 %i   Article score (number)
992 %z   Article zcore (character)
993 %t   Number of articles under the current thread (number).
994 %e   Whether the thread is empty or not (character).
995 %u   User defined specifier.  The next character in the format string should
996      be a letter.  Gnus will call the function gnus-user-format-function-X,
997      where X is the letter following %u.  The function will be passed the
998      current header as argument.  The function should return a string, which
999      will be inserted into the summary just like information from any other
1000      summary specifier.
1001
1002 Text between %( and %) will be highlighted with `gnus-mouse-face'
1003 when the mouse point is placed inside the area.  There can only be one
1004 such area.
1005
1006 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1007 with care.  For reasons of efficiency, Gnus will compute what column
1008 these characters will end up in, and \"hard-code\" that.  This means that
1009 it is illegal to have these specs after a variable-length spec.  Well,
1010 you might not be arrested, but your summary buffer will look strange,
1011 which is bad enough.
1012
1013 The smart choice is to have these specs as for to the left as
1014 possible. 
1015
1016 This restriction may disappear in later versions of Gnus.")
1017
1018 (defvar gnus-summary-dummy-line-format 
1019   "*  %(:                          :%) %S\n"
1020   "*The format specification for the dummy roots in the summary buffer.
1021 It works along the same lines as a normal formatting string,
1022 with some simple extensions.
1023
1024 %S  The subject")
1025
1026 (defvar gnus-summary-mode-line-format "Gnus  %G/%A %Z"
1027   "*The format specification for the summary mode line.")
1028
1029 (defvar gnus-article-mode-line-format "Gnus  %G/%A %S"
1030   "*The format specification for the article mode line.")
1031
1032 (defvar gnus-group-mode-line-format "Gnus  List of groups   {%M:%S}  "
1033   "*The format specification for the group mode line.")
1034
1035 (defvar gnus-valid-select-methods
1036   '(("nntp" post address prompt-address)
1037     ("nnspool" post)
1038     ("nnvirtual" post-mail virtual prompt-address) 
1039     ("nnmbox" mail respool) 
1040     ("nnml" mail respool)
1041     ("nnmh" mail respool) 
1042     ("nndir" post-mail prompt-address address)
1043     ("nneething" none prompt-address)
1044     ("nndoc" none prompt-address) 
1045     ("nnbabyl" mail respool) 
1046     ("nnkiboze" post virtual) 
1047     ("nnsoup" post-mail)
1048     ("nnfolder" mail respool))
1049   "An alist of valid select methods.
1050 The first element of each list lists should be a string with the name
1051 of the select method.  The other elements may be be the category of
1052 this method (ie. `post', `mail', `none' or whatever) or other
1053 properties that this method has (like being respoolable).
1054 If you implement a new select method, all you should have to change is
1055 this variable.  I think.")
1056
1057 (defvar gnus-updated-mode-lines '(group article summary)
1058   "*List of buffers that should update their mode lines.
1059 The list may contain the symbols `group', `article' and `summary'.  If
1060 the corresponding symbol is present, Gnus will keep that mode line
1061 updated with information that may be pertinent. 
1062 If this variable is nil, screen refresh may be quicker.")
1063
1064 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1065 (defvar gnus-mode-non-string-length 25
1066   "*Max length of mode-line non-string contents.
1067 If this is nil, Gnus will take space as is needed, leaving the rest
1068 of the modeline intact.")
1069
1070 ;see gnus-cus.el
1071 ;(defvar gnus-mouse-face 'highlight
1072 ;  "*Face used for mouse highlighting in Gnus.
1073 ;No mouse highlights will be done if `gnus-visual' is nil.")
1074
1075 (defvar gnus-summary-mark-below nil
1076   "*Mark all articles with a score below this variable as read.
1077 This variable is local to each summary buffer and usually set by the
1078 score file.")  
1079
1080 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1081   "*List of functions used for sorting threads in the summary buffer.
1082 By default, threads are sorted by article number.
1083
1084 Each function takes two threads and return non-nil if the first thread
1085 should be sorted before the other.  If you use more than one function,
1086 the primary sort function should be the last.
1087
1088 Ready-mady functions include `gnus-thread-sort-by-number',
1089 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1090 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1091 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1092
1093 (defvar gnus-thread-score-function '+
1094   "*Function used for calculating the total score of a thread.
1095
1096 The function is called with the scores of the article and each
1097 subthread and should then return the score of the thread.
1098
1099 Some functions you can use are `+', `max', or `min'.")
1100
1101 (defvar gnus-auto-subscribed-groups 
1102   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1103   "*All new groups that match this regexp will be subscribed automatically.
1104 Note that this variable only deals with new groups.  It has no effect
1105 whatsoever on old groups.")
1106
1107 (defvar gnus-options-subscribe nil
1108   "*All new groups matching this regexp will be subscribed unconditionally.
1109 Note that this variable deals only with new newsgroups.  This variable
1110 does not affect old newsgroups.")
1111
1112 (defvar gnus-options-not-subscribe nil
1113   "*All new groups matching this regexp will be ignored.
1114 Note that this variable deals only with new newsgroups.  This variable
1115 does not affect old (already subscribed) newsgroups.")
1116
1117 (defvar gnus-auto-expirable-newsgroups nil
1118   "*Groups in which to automatically mark read articles as expirable.
1119 If non-nil, this should be a regexp that should match all groups in
1120 which to perform auto-expiry.  This only makes sense for mail groups.")
1121
1122 (defvar gnus-total-expirable-newsgroups nil
1123   "*Groups in which to perform expiry of all read articles.
1124 Use with extreme caution.  All groups that match this regexp will be
1125 expiring - which means that all read articles will be deleted after
1126 (say) one week.  (This only goes for mail groups and the like, of
1127 course.)")
1128
1129 (defvar gnus-hidden-properties '(invisible t intangible t)
1130   "Property list to use for hiding text.")
1131
1132 (defvar gnus-modtime-botch nil
1133   "*Non-nil means .newsrc should be deleted prior to save.  Its use is
1134 due to the bogus appearance that .newsrc was modified on disc.")
1135
1136 ;; Hooks.
1137
1138 (defvar gnus-group-mode-hook nil
1139   "*A hook for Gnus group mode.")
1140
1141 (defvar gnus-summary-mode-hook nil
1142   "*A hook for Gnus summary mode.
1143 This hook is run before any variables are set in the summary buffer.")
1144
1145 (defvar gnus-article-mode-hook nil
1146   "*A hook for Gnus article mode.")
1147
1148 (defun gnus-summary-prepare-exit-hook nil
1149   "*A hook called when preparing to exit from the summary buffer.
1150 It calls `gnus-summary-expire-articles' by default.")
1151 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1152
1153 (defun gnus-summary-exit-hook nil
1154   "*A hook called on exit from the summary buffer.")
1155
1156 (defvar gnus-open-server-hook nil
1157   "*A hook called just before opening connection to the news server.")
1158
1159 (defvar gnus-load-hook nil
1160   "*A hook run while Gnus is loaded.")
1161
1162 (defvar gnus-startup-hook nil
1163   "*A hook called at startup.
1164 This hook is called after Gnus is connected to the NNTP server.")
1165
1166 (defvar gnus-get-new-news-hook nil
1167   "*A hook run just before Gnus checks for new news.")
1168
1169 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1170   "*A function that is called to generate the group buffer.
1171 The function is called with three arguments: The first is a number;
1172 all group with a level less or equal to that number should be listed,
1173 if the second is non-nil, empty groups should also be displayed.  If
1174 the third is non-nil, it is a number.  No groups with a level lower
1175 than this number should be displayed.
1176
1177 The only current function implemented is `gnus-group-prepare-flat'.")
1178
1179 (defvar gnus-group-prepare-hook nil
1180   "*A hook called after the group buffer has been generated.
1181 If you want to modify the group buffer, you can use this hook.")
1182
1183 (defvar gnus-summary-prepare-hook nil
1184   "*A hook called after the summary buffer has been generated.
1185 If you want to modify the summary buffer, you can use this hook.")
1186
1187 (defvar gnus-summary-generate-hook nil
1188   "*A hook run just before generating the summary buffer.
1189 This hook is commonly used to customize threading variables and the
1190 like.")
1191
1192 (defvar gnus-article-prepare-hook nil
1193   "*A hook called after an article has been prepared in the article buffer.
1194 If you want to run a special decoding program like nkf, use this hook.")
1195
1196 ;(defvar gnus-article-display-hook nil
1197 ;  "*A hook called after the article is displayed in the article buffer.
1198 ;The hook is designed to change the contents of the article
1199 ;buffer.  Typical functions that this hook may contain are
1200 ;`gnus-article-hide-headers' (hide selected headers),
1201 ;`gnus-article-maybe-highlight' (perform fancy article highlighting), 
1202 ;`gnus-article-hide-signature' (hide signature) and
1203 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1204 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1205 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1206 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1207
1208 (defvar gnus-article-x-face-command
1209   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1210   "String or function to be executed to display an X-Face header.
1211 If it is a string, the command will be executed in a sub-shell
1212 asynchronously.  The compressed face will be piped to this command.") 
1213
1214 (defvar gnus-article-x-face-too-ugly nil
1215   "Regexp matching posters whose face shouldn't be shown automatically.")
1216
1217 (defvar gnus-select-group-hook nil
1218   "*A hook called when a newsgroup is selected.
1219
1220 If you'd like to simplify subjects like the
1221 `gnus-summary-next-same-subject' command does, you can use the
1222 following hook:
1223
1224  (setq gnus-select-group-hook
1225       (list
1226         (lambda ()
1227           (mapcar (lambda (header)
1228                      (mail-header-set-subject
1229                       header
1230                       (gnus-simplify-subject
1231                        (mail-header-subject header) 're-only)))
1232                   gnus-newsgroup-headers))))")
1233
1234 (defvar gnus-select-article-hook
1235   '(gnus-summary-show-thread)
1236   "*A hook called when an article is selected.
1237 The default hook shows conversation thread subtrees of the selected
1238 article automatically using `gnus-summary-show-thread'.")
1239
1240 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1241   "*A hook called to apply kill files to a group.
1242 This hook is intended to apply a kill file to the selected newsgroup.
1243 The function `gnus-apply-kill-file' is called by default.
1244
1245 Since a general kill file is too heavy to use only for a few
1246 newsgroups, I recommend you to use a lighter hook function.  For
1247 example, if you'd like to apply a kill file to articles which contains
1248 a string `rmgroup' in subject in newsgroup `control', you can use the
1249 following hook:
1250
1251  (setq gnus-apply-kill-hook
1252       (list
1253         (lambda ()
1254           (cond ((string-match \"control\" gnus-newsgroup-name)
1255                  (gnus-kill \"Subject\" \"rmgroup\")
1256                  (gnus-expunge \"X\"))))))")
1257
1258 (defvar gnus-visual-mark-article-hook 
1259   (list 'gnus-highlight-selected-summary)
1260   "*Hook run after selecting an article in the summary buffer.
1261 It is meant to be used for highlighting the article in some way.  It
1262 is not run if `gnus-visual' is nil.")
1263
1264 (defun gnus-parse-headers-hook nil
1265   "*A hook called before parsing the headers.")
1266
1267 (defvar gnus-exit-group-hook nil
1268   "*A hook called when exiting (not quitting) summary mode.")
1269
1270 (defvar gnus-suspend-gnus-hook nil
1271   "*A hook called when suspending (not exiting) Gnus.")
1272
1273 (defvar gnus-exit-gnus-hook nil
1274   "*A hook called when exiting Gnus.")
1275
1276 (defvar gnus-save-newsrc-hook nil
1277   "*A hook called before saving any of the newsrc files.")
1278
1279 (defvar gnus-save-quick-newsrc-hook nil
1280   "*A hook called just before saving the quick newsrc file.
1281 Can be used to turn version control on or off.")
1282
1283 (defvar gnus-save-standard-newsrc-hook nil
1284   "*A hook called just before saving the standard newsrc file.
1285 Can be used to turn version control on or off.")
1286
1287 (defvar gnus-summary-update-hook 
1288   (list 'gnus-summary-highlight-line)
1289   "*A hook called when a summary line is changed.
1290 The hook will not be called if `gnus-visual' is nil.
1291
1292 The default function `gnus-summary-highlight-line' will
1293 highlight the line according to the `gnus-summary-highlight'
1294 variable.")
1295
1296 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1297   "*A hook called when an article is selected for the first time.
1298 The hook is intended to mark an article as read (or unread)
1299 automatically when it is selected.")
1300
1301 ;; Remove any hilit infestation.
1302 (add-hook 'gnus-startup-hook
1303           (lambda ()
1304             (remove-hook 'gnus-summary-prepare-hook
1305                          'hilit-rehighlight-buffer-quietly)
1306             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1307             (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
1308             (remove-hook 'gnus-article-prepare-hook
1309                          'hilit-rehighlight-buffer-quietly)))
1310
1311
1312 \f
1313 ;; Internal variables
1314
1315 ;; Avoid highlighting in kill files.
1316 (defvar gnus-summary-inhibit-highlight nil)
1317 (defvar gnus-newsgroup-selected-overlay nil)
1318
1319 (defvar gnus-inhibit-hiding nil)
1320 (defvar gnus-topic-indentation "")
1321
1322 (defvar gnus-article-mode-map nil)
1323 (defvar gnus-dribble-buffer nil)
1324 (defvar gnus-headers-retrieved-by nil)
1325 (defvar gnus-article-reply nil)
1326 (defvar gnus-override-method nil)
1327 (defvar gnus-article-check-size nil)
1328
1329 (defvar gnus-nocem-hashtb nil)
1330
1331 (defvar gnus-current-score-file nil)
1332 (defvar gnus-scores-exclude-files nil)
1333
1334 (defvar gnus-opened-servers nil)
1335
1336 (defvar gnus-current-move-group nil)
1337
1338 (defvar gnus-newsgroup-dependencies nil)
1339 (defvar gnus-newsgroup-async nil)
1340 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1341
1342 (defvar gnus-newsgroup-adaptive nil)
1343
1344 (defvar gnus-summary-display-table nil)
1345
1346 (defconst gnus-group-line-format-alist
1347   `((?M gnus-tmp-marked ?c)
1348     (?S gnus-tmp-subscribed ?c)
1349     (?L gnus-tmp-level ?d)
1350     (?N gnus-tmp-number ?s)
1351     (?R gnus-tmp-number-of-read ?s)
1352     (?t gnus-tmp-number-total ?d)
1353     (?y gnus-tmp-number-of-unread ?s)
1354     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1355     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1356     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1357            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1358     (?g gnus-tmp-group ?s)
1359     (?G gnus-tmp-qualified-group ?s)
1360     (?c (gnus-group-short-name gnus-tmp-group) ?s)
1361     (?D gnus-tmp-newsgroup-description ?s)
1362     (?o gnus-tmp-moderated ?c)
1363     (?O gnus-tmp-moderated-string ?s)
1364     (?p gnus-tmp-process-marked ?c)
1365     (?s gnus-tmp-news-server ?s)
1366     (?n gnus-tmp-news-method ?s)
1367     (?P gnus-topic-indentation ?s)
1368     (?z gnus-tmp-news-method-string ?s)
1369     (?u gnus-tmp-user-defined ?s)))
1370
1371 (defconst gnus-summary-line-format-alist 
1372   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1373     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1374     (?s gnus-tmp-subject-or-nil ?s)
1375     (?n gnus-tmp-name ?s)
1376     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1377         ?s)
1378     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) 
1379             gnus-tmp-from) ?s)
1380     (?F gnus-tmp-from ?s)
1381     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1382     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1383     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1384     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1385     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1386     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1387     (?L gnus-tmp-lines ?d)
1388     (?I gnus-tmp-indentation ?s)
1389     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1390     (?R gnus-tmp-replied ?c)
1391     (?\[ gnus-tmp-opening-bracket ?c)
1392     (?\] gnus-tmp-closing-bracket ?c)
1393     (?\> (make-string gnus-tmp-level ? ) ?s)
1394     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1395     (?i gnus-tmp-score ?d)
1396     (?z gnus-tmp-score-char ?c)
1397     (?U gnus-tmp-unread ?c)
1398     (?t (gnus-summary-number-of-articles-in-thread 
1399          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1400         ?d)
1401     (?e (gnus-summary-number-of-articles-in-thread 
1402          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1403         ?c)
1404     (?u gnus-tmp-user-defined ?s))
1405   "An alist of format specifications that can appear in summary lines,
1406 and what variables they correspond with, along with the type of the
1407 variable (string, integer, character, etc).")
1408
1409 (defconst gnus-summary-dummy-line-format-alist
1410   (` ((?S gnus-tmp-subject ?s)
1411       (?N gnus-tmp-number ?d)
1412       (?u gnus-tmp-user-defined ?s))))
1413
1414 (defconst gnus-summary-mode-line-format-alist 
1415   (` ((?G gnus-tmp-group-name ?s)
1416       (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1417       (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1418       (?A gnus-tmp-article-number ?d)
1419       (?Z gnus-tmp-unread-and-unselected ?s)
1420       (?V gnus-version ?s)
1421       (?U gnus-tmp-unread ?d)
1422       (?S gnus-tmp-subject ?s)
1423       (?e gnus-tmp-unselected ?d)
1424       (?u gnus-tmp-user-defined ?s)
1425       (?d (length gnus-newsgroup-dormant) ?d)
1426       (?t (length gnus-newsgroup-marked) ?d)
1427       (?r (length gnus-newsgroup-reads) ?d)
1428       (?E gnus-newsgroup-expunged-tally ?d)
1429       (?s (gnus-current-score-file-nondirectory) ?s))))
1430
1431 (defconst gnus-group-mode-line-format-alist 
1432   (` ((?S gnus-tmp-news-server ?s)
1433       (?M gnus-tmp-news-method ?s)
1434       (?u gnus-tmp-user-defined ?s))))
1435
1436 (defvar gnus-have-read-active-file nil)
1437
1438 (defconst gnus-maintainer
1439   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1440   "The mail address of the Gnus maintainers.")
1441
1442 (defconst gnus-version "September Gnus v0.21"
1443   "Version number for this version of Gnus.")
1444
1445 (defvar gnus-info-nodes
1446   '((gnus-group-mode            "(gnus)The Group Buffer")
1447     (gnus-summary-mode          "(gnus)The Summary Buffer")
1448     (gnus-article-mode          "(gnus)The Article Buffer"))
1449   "Assoc list of major modes and related Info nodes.")
1450
1451 (defvar gnus-group-buffer "*Group*")
1452 (defvar gnus-summary-buffer "*Summary*")
1453 (defvar gnus-article-buffer "*Article*")
1454 (defvar gnus-server-buffer "*Server*")
1455
1456 (defvar gnus-work-buffer " *gnus work*")
1457
1458 (defvar gnus-original-article-buffer " *Original Article*")
1459 (defvar gnus-original-article nil)
1460
1461 (defvar gnus-buffer-list nil
1462   "Gnus buffers that should be killed on exit.")
1463
1464 (defvar gnus-server-alist nil
1465   "List of available servers.")
1466
1467 (defvar gnus-slave nil
1468   "Whether this Gnus is a slave or not.")
1469
1470 (defvar gnus-variable-list
1471   '(gnus-newsrc-options gnus-newsrc-options-n
1472     gnus-newsrc-last-checked-date 
1473     gnus-newsrc-alist gnus-server-alist
1474     gnus-killed-list gnus-zombie-list
1475     gnus-topic-topology gnus-topic-alist)
1476   "Gnus variables saved in the quick startup file.")
1477
1478 (defvar gnus-newsrc-options nil
1479   "Options line in the .newsrc file.")
1480
1481 (defvar gnus-newsrc-options-n nil
1482   "List of regexps representing groups to be subscribed/ignored unconditionally.") 
1483
1484 (defvar gnus-newsrc-last-checked-date nil
1485   "Date Gnus last asked server for new newsgroups.")
1486
1487 (defvar gnus-topic-topology nil
1488   "The complete topic hierarchy.")
1489
1490 (defvar gnus-topic-alist nil
1491   "The complete topic-group alist.")
1492
1493 (defvar gnus-newsrc-alist nil
1494   "Assoc list of read articles.
1495 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1496
1497 (defvar gnus-newsrc-hashtb nil
1498   "Hashtable of gnus-newsrc-alist.")
1499
1500 (defvar gnus-killed-list nil
1501   "List of killed newsgroups.")
1502
1503 (defvar gnus-killed-hashtb nil
1504   "Hash table equivalent of gnus-killed-list.")
1505
1506 (defvar gnus-zombie-list nil
1507   "List of almost dead newsgroups.")
1508
1509 (defvar gnus-description-hashtb nil
1510   "Descriptions of newsgroups.")
1511
1512 (defvar gnus-list-of-killed-groups nil
1513   "List of newsgroups that have recently been killed by the user.")
1514
1515 (defvar gnus-active-hashtb nil
1516   "Hashtable of active articles.")
1517
1518 (defvar gnus-moderated-list nil
1519   "List of moderated newsgroups.")
1520
1521 (defvar gnus-group-marked nil)
1522
1523 (defvar gnus-current-startup-file nil
1524   "Startup file for the current host.")
1525
1526 (defvar gnus-last-search-regexp nil
1527   "Default regexp for article search command.")
1528
1529 (defvar gnus-last-shell-command nil
1530   "Default shell command on article.")
1531
1532 (defvar gnus-current-select-method nil
1533   "The current method for selecting a newsgroup.")
1534
1535 (defvar gnus-group-list-mode nil)
1536
1537 (defvar gnus-article-internal-prepare-hook nil)
1538
1539 (defvar gnus-newsgroup-name nil)
1540 (defvar gnus-newsgroup-begin nil)
1541 (defvar gnus-newsgroup-end nil)
1542 (defvar gnus-newsgroup-last-rmail nil)
1543 (defvar gnus-newsgroup-last-mail nil)
1544 (defvar gnus-newsgroup-last-folder nil)
1545 (defvar gnus-newsgroup-last-file nil)
1546 (defvar gnus-newsgroup-auto-expire nil)
1547 (defvar gnus-newsgroup-active nil)
1548
1549 (defvar gnus-newsgroup-data nil)
1550 (defvar gnus-newsgroup-data-reverse nil)
1551 (defvar gnus-newsgroup-limit nil)
1552 (defvar gnus-newsgroup-limits nil)
1553
1554 (defvar gnus-newsgroup-unreads nil
1555   "List of unread articles in the current newsgroup.")
1556
1557 (defvar gnus-newsgroup-unselected nil
1558   "List of unselected unread articles in the current newsgroup.")
1559
1560 (defvar gnus-newsgroup-reads nil
1561   "Alist of read articles and article marks in the current newsgroup.")
1562
1563 (defvar gnus-newsgroup-expunged-tally nil)
1564
1565 (defvar gnus-newsgroup-marked nil
1566   "List of ticked articles in the current newsgroup (a subset of unread art).")
1567
1568 (defvar gnus-newsgroup-killed nil
1569   "List of ranges of articles that have been through the scoring process.")
1570
1571 (defvar gnus-newsgroup-kill-headers nil)
1572
1573 (defvar gnus-newsgroup-replied nil
1574   "List of articles that have been replied to in the current newsgroup.")
1575
1576 (defvar gnus-newsgroup-expirable nil
1577   "List of articles in the current newsgroup that can be expired.")
1578
1579 (defvar gnus-newsgroup-processable nil
1580   "List of articles in the current newsgroup that can be processed.")
1581
1582 (defvar gnus-newsgroup-bookmarks nil
1583   "List of articles in the current newsgroup that have bookmarks.")
1584
1585 (defvar gnus-newsgroup-dormant nil
1586   "List of dormant articles in the current newsgroup.")
1587
1588 (defvar gnus-newsgroup-scored nil
1589   "List of scored articles in the current newsgroup.")
1590
1591 (defvar gnus-newsgroup-headers nil
1592   "List of article headers in the current newsgroup.")
1593
1594 (defvar gnus-newsgroup-threads nil)
1595
1596 (defvar gnus-newsgroup-prepared nil
1597   "Whether the current group has been prepared properly.")
1598
1599 (defvar gnus-newsgroup-ancient nil
1600   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1601
1602 (defvar gnus-current-article nil)
1603 (defvar gnus-article-current nil)
1604 (defvar gnus-current-headers nil)
1605 (defvar gnus-have-all-headers nil)
1606 (defvar gnus-last-article nil)
1607 (defvar gnus-newsgroup-history nil)
1608 (defvar gnus-current-kill-article nil)
1609
1610 ;; Save window configuration.
1611 (defvar gnus-prev-winconf nil)
1612
1613 (defvar gnus-summary-mark-positions nil)
1614 (defvar gnus-group-mark-positions nil)
1615
1616 (defvar gnus-summary-expunge-below nil)
1617 (defvar gnus-reffed-article-number nil)
1618
1619 ;;; Let the byte-compiler know that we know about this variable.
1620 (defvar rmail-default-rmail-file)
1621
1622 (defvar gnus-cache-removeable-articles nil)
1623
1624 (defconst gnus-summary-local-variables 
1625   '(gnus-newsgroup-name 
1626     gnus-newsgroup-begin gnus-newsgroup-end 
1627     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail 
1628     gnus-newsgroup-last-folder gnus-newsgroup-last-file 
1629     gnus-newsgroup-auto-expire gnus-newsgroup-unreads 
1630     gnus-newsgroup-unselected gnus-newsgroup-marked
1631     gnus-newsgroup-reads
1632     gnus-newsgroup-replied gnus-newsgroup-expirable
1633     gnus-newsgroup-processable gnus-newsgroup-killed
1634     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1635     gnus-newsgroup-headers gnus-newsgroup-threads
1636     gnus-newsgroup-prepared
1637     gnus-current-article gnus-current-headers gnus-have-all-headers
1638     gnus-last-article gnus-article-internal-prepare-hook
1639     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1640     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1641     gnus-newsgroup-async
1642     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below 
1643     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1644     gnus-newsgroup-history gnus-newsgroup-ancient
1645     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1646     (gnus-newsgroup-expunged-tally . 0)
1647     gnus-cache-removeable-articles
1648     gnus-newsgroup-data gnus-newsgroup-data-reverse
1649     gnus-newsgroup-limit gnus-newsgroup-limits)
1650   "Variables that are buffer-local to the summary buffers.")
1651
1652 (defconst gnus-bug-message
1653   "Sending a bug report to the Gnus Towers.
1654 ========================================
1655
1656 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1657 be sent to the Gnus Bug Exterminators. 
1658
1659 At the bottom of the buffer you'll see lots of variable settings.
1660 Please do not delete those.  They will tell the Bug People what your
1661 environment is, so that it will be easier to locate the bugs.
1662
1663 If you have found a bug that makes Emacs go \"beep\", set
1664 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') 
1665 and include the backtrace in your bug report.
1666
1667 Please describe the bug in annoying, painstaking detail.
1668
1669 Thank you for your help in stamping out bugs.
1670 ")
1671
1672 ;;; End of variables.
1673
1674 ;; Define some autoload functions Gnus might use.
1675 (eval-and-compile
1676
1677   ;; This little mapcar goes through the list below and marks the
1678   ;; symbols in question as autoloaded functions.
1679   (mapcar 
1680    (lambda (package)
1681      (let ((interactive (nth 1 (memq ':interactive package))))
1682        (mapcar 
1683         (lambda (function)
1684           (let (keymap)
1685             (when (consp function)
1686               (setq keymap (car (memq 'keymap function)))
1687               (setq function (car function)))
1688             (autoload function (car package) nil interactive keymap)))
1689         (if (eq (nth 1 package) ':interactive)
1690             (cdddr package)
1691           (cdr package)))))
1692    '(("metamail" metamail-buffer)
1693      ("info" Info-goto-node)
1694      ("hexl" hexl-hex-string-to-integer)
1695      ("pp" pp pp-to-string pp-eval-expression)
1696      ("mail-extr" mail-extract-address-components)
1697      ("nnmail" nnmail-split-fancy nnmail-article-group)
1698      ("nnvirtual" nnvirtual-catchup-group)
1699      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1700       timezone-make-sortable-date timezone-make-time-string)
1701      ("sendmail" mail-position-on-field mail-setup)
1702      ("rmailout" rmail-output)
1703      ("rnewspost" news-mail-other-window news-reply-yank-original 
1704       news-caesar-buffer-body)
1705      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1706       rmail-show-message)
1707      ("gnus-soup" :interactive t
1708       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article 
1709       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1710      ("nnsoup" nnsoup-pack-replies)
1711      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder 
1712       gnus-Folder-save-name gnus-folder-save-name)
1713      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1714      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1715       gnus-server-make-menu-bar gnus-article-make-menu-bar
1716       gnus-browse-make-menu-bar gnus-highlight-selected-summary
1717       gnus-summary-highlight-line gnus-carpal-setup-buffer
1718       gnus-article-add-button)
1719      ("gnus-vis" :interactive t
1720       gnus-article-push-button gnus-article-press-button 
1721       gnus-article-highlight gnus-article-highlight-some 
1722       gnus-article-hide gnus-article-hide-signature 
1723       gnus-article-highlight-headers gnus-article-highlight-signature 
1724       gnus-article-add-buttons gnus-article-add-buttons-to-head 
1725       gnus-article-next-button)
1726      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1727       gnus-demon-add-disconnection gnus-demon-add-handler
1728       gnus-demon-remove-handler)
1729      ("gnus-demon" :interactive t
1730       gnus-demon-init gnus-demon-cancel)
1731      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
1732      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1733      ("gnus-cite" :interactive t
1734       gnus-article-highlight-citation gnus-article-hide-citation-maybe 
1735       gnus-article-hide-citation)
1736      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal 
1737       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author 
1738       gnus-execute gnus-expunge)
1739      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
1740       gnus-cache-possibly-remove-articles gnus-cache-request-article
1741       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
1742       gnus-cache-enter-remove-article
1743       gnus-cache-open gnus-cache-close)
1744      ("gnus-cache" :interactive t gnus-jog-cache)
1745      ("gnus-score" :interactive t
1746       gnus-summary-increase-score gnus-summary-lower-score
1747       gnus-score-flush-cache gnus-score-close 
1748       gnus-score-raise-same-subject-and-select 
1749       gnus-score-raise-same-subject gnus-score-default 
1750       gnus-score-raise-thread gnus-score-lower-same-subject-and-select 
1751       gnus-score-lower-same-subject gnus-score-lower-thread 
1752       gnus-possibly-score-headers)
1753      ("gnus-score" 
1754       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
1755       gnus-current-score-file-nondirectory gnus-score-adaptive
1756       gnus-score-find-trace gnus-score-file-name)
1757      ("gnus-edit" :interactive t gnus-score-customize)
1758      ("gnus-topic" :interactive t gnus-topic-mode)
1759      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
1760      ("gnus-uu" :interactive t
1761       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward 
1762       gnus-uu-mark-series gnus-uu-mark-region 
1763       gnus-uu-mark-by-regexp gnus-uu-mark-all 
1764       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu 
1765       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar 
1766       gnus-uu-decode-unshar-and-save gnus-uu-decode-save 
1767       gnus-uu-decode-binhex gnus-uu-decode-uu-view 
1768       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view 
1769       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view 
1770       gnus-uu-decode-binhex-view)
1771      ("gnus-msg" (gnus-summary-send-map keymap)
1772       gnus-mail-yank-original gnus-mail-send-and-exit
1773       gnus-sendmail-setup-mail gnus-article-mail 
1774       gnus-inews-message-id gnus-news-mail gnus-mail-reply)
1775      ("gnus-msg" :interactive t
1776       gnus-group-post-news gnus-group-mail gnus-summary-post-news
1777       gnus-summary-followup gnus-summary-followup-with-original
1778       gnus-summary-followup-and-reply
1779       gnus-summary-followup-and-reply-with-original
1780       gnus-summary-cancel-article gnus-summary-supersede-article
1781       gnus-post-news gnus-inews-news gnus-cancel-news
1782       gnus-summary-reply gnus-summary-reply-with-original
1783       gnus-summary-mail-forward gnus-summary-mail-other-window
1784       gnus-bug)
1785      ("gnus-vm" gnus-vm-mail-setup)
1786      ("gnus-vm" :interactive t gnus-summary-save-in-vm
1787       gnus-summary-save-article-vm gnus-yank-article))))
1788
1789 \f
1790
1791 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1792 ;; If you want the cursor to go somewhere else, set these two
1793 ;; functions in some startup hook to whatever you want.
1794 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
1795 (defalias 'gnus-group-position-point 'gnus-goto-colon)
1796
1797 ;;; Various macros and substs.
1798
1799 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
1800   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
1801   `(let ((GnusStartBufferWindow (selected-window)))
1802      (unwind-protect
1803          (progn
1804            (pop-to-buffer ,buffer)
1805            ,@forms)
1806        (select-window GnusStartBufferWindow))))
1807
1808 (defmacro gnus-gethash (string hashtable)
1809   "Get hash value of STRING in HASHTABLE."
1810   `(symbol-value (intern-soft ,string ,hashtable)))
1811
1812 (defmacro gnus-sethash (string value hashtable)
1813   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
1814   `(set (intern ,string ,hashtable) ,value))
1815
1816 (defmacro gnus-intern-safe (string hashtable)
1817   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
1818   `(let ((symbol (intern ,string ,hashtable)))
1819      (or (boundp symbol)
1820          (set symbol nil))
1821      symbol))
1822
1823 (defmacro gnus-group-unread (group)
1824   "Get the currently computed number of unread articles in GROUP."
1825   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
1826
1827 (defmacro gnus-active (group)
1828   "Get active info on GROUP."
1829   `(gnus-gethash ,group gnus-active-hashtb))
1830
1831 (defmacro gnus-set-active (group active)
1832   "Set GROUP's active info."
1833   `(gnus-sethash ,group ,active gnus-active-hashtb))
1834
1835 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
1836 ;;   function `substring' might cut on a middle of multi-octet
1837 ;;   character.
1838 (defun gnus-truncate-string (str width)
1839   (substring str 0 width))
1840
1841 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
1842 ;; to limit the length of a string.  This function is necessary since
1843 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
1844 (defsubst gnus-limit-string (str width)
1845   (if (> (length str) width)
1846       (substring str 0 width)
1847     str))
1848
1849 (defsubst gnus-simplify-subject-re (subject)
1850   "Remove \"Re:\" from subject lines."
1851   (if (string-match "^[Rr][Ee]: *" subject)
1852       (substring subject (match-end 0))
1853     subject))
1854
1855 (defsubst gnus-goto-char (point)
1856   (and point (goto-char point)))
1857
1858 (defmacro gnus-buffer-exists-p (buffer)
1859   `(and ,buffer
1860         (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
1861                  ,buffer)))
1862
1863 (defmacro gnus-kill-buffer (buffer)
1864   `(let ((buf ,buffer))
1865      (if (gnus-buffer-exists-p buf)
1866          (kill-buffer buf))))
1867
1868 (defsubst gnus-point-at-bol ()
1869   "Return point at the beginning of the line."
1870   (let ((p (point)))
1871     (beginning-of-line)
1872     (prog1
1873         (point)
1874       (goto-char p))))
1875
1876 (defsubst gnus-point-at-eol ()
1877   "Return point at the end of the line."
1878   (let ((p (point)))
1879     (end-of-line)
1880     (prog1
1881         (point)
1882       (goto-char p))))
1883
1884 ;; Delete the current line (and the next N lines.);
1885 (defmacro gnus-delete-line (&optional n)
1886   `(delete-region (progn (beginning-of-line) (point))
1887                   (progn (forward-line ,(or n 1)) (point))))
1888
1889 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
1890 (defvar gnus-init-inhibit nil)
1891 (defun gnus-read-init-file (&optional inhibit-next)
1892   (if gnus-init-inhibit
1893       (setq gnus-init-inhibit nil)
1894     (setq gnus-init-inhibit inhibit-next)
1895     (and gnus-init-file
1896          (or (and (file-exists-p gnus-init-file) 
1897                   ;; Don't try to load a directory.
1898                   (not (file-directory-p gnus-init-file)))
1899              (file-exists-p (concat gnus-init-file ".el"))
1900              (file-exists-p (concat gnus-init-file ".elc")))
1901          (load gnus-init-file nil t))))
1902
1903 ;; Info access macros.
1904
1905 (defmacro gnus-info-group (info)
1906   `(nth 0 ,info))
1907 (defmacro gnus-info-rank (info)
1908   `(nth 1 ,info))
1909 (defmacro gnus-info-read (info)
1910   `(nth 2 ,info))
1911 (defmacro gnus-info-marks (info)
1912   `(nth 3 ,info))
1913 (defmacro gnus-info-method (info)
1914   `(nth 4 ,info))
1915 (defmacro gnus-info-params (info)
1916   `(nth 5 ,info))
1917
1918 (defmacro gnus-info-level (info)
1919   `(let ((rank (gnus-info-rank ,info)))
1920      (if (consp rank)
1921          (car rank)
1922        rank)))
1923 (defmacro gnus-info-score (info)
1924   `(let ((rank (gnus-info-rank ,info)))
1925      (or (and (consp rank) (cdr rank)) 0)))
1926
1927 (defmacro gnus-info-set-group (info group)
1928   `(setcar ,info ,group))
1929 (defmacro gnus-info-set-rank (info rank)
1930   `(setcar (nthcdr 1 ,info) ,rank))
1931 (defmacro gnus-info-set-read (info read)
1932   `(setcar (nthcdr 2 ,info) ,read))
1933 (defmacro gnus-info-set-marks (info marks)
1934   `(setcar (nthcdr 3 ,info) ,marks))
1935 (defmacro gnus-info-set-method (info method)
1936   `(setcar (nthcdr 4 ,info) ,method))
1937 (defmacro gnus-info-set-params (info params)
1938   `(setcar (nthcdr 5 ,info) ,params))
1939
1940 (defmacro gnus-info-set-level (info level)
1941   `(let ((rank (cdr ,info)))
1942      (if (consp (car rank))
1943          (setcar (car rank) ,level)
1944        (setcar rank ,level))))
1945 (defmacro gnus-info-set-score (info score)
1946   `(let ((rank (cdr ,info)))
1947      (if (consp (car rank))
1948          (setcdr (car rank) ,score)
1949        (setcar rank (cons (car rank) ,score)))))
1950
1951 (defmacro gnus-get-info (group)
1952   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
1953
1954 (defun gnus-byte-code (func)
1955   "Return a form that can be `eval'ed based on FUNC."
1956   (let ((fval (symbol-function func)))
1957     (if (byte-code-function-p fval)
1958         (let ((flist (append fval nil)))
1959           (setcar flist 'byte-code)
1960           flist)
1961       (cons 'progn (cdr (cdr fval))))))
1962
1963 ;;; Load the user startup file.
1964 ;; (eval '(gnus-read-init-file 'inhibit))
1965
1966 ;;; Load the compatability functions. 
1967
1968 (require 'gnus-cus)
1969 (require 'gnus-ems)
1970
1971 \f
1972
1973 ;; Format specs.  The chunks below are the machine-generated forms
1974 ;; that are to be evaled as the result of the default format strings.
1975 ;; We write them in here to get them byte-compiled.  That way the
1976 ;; default actions will be quite fast, while still retaining the full
1977 ;; flexibility of the user-defined format specs. 
1978
1979 ;; First we have lots of dummy defvars to let the compiler know these
1980 ;; are really dynamic variables.
1981
1982 (defvar gnus-tmp-unread)
1983 (defvar gnus-tmp-replied)
1984 (defvar gnus-tmp-score-char)
1985 (defvar gnus-tmp-indentation)
1986 (defvar gnus-tmp-opening-bracket)
1987 (defvar gnus-tmp-lines)
1988 (defvar gnus-tmp-name)
1989 (defvar gnus-tmp-closing-bracket)
1990 (defvar gnus-tmp-subject-or-nil)
1991 (defvar gnus-tmp-subject)
1992 (defvar gnus-tmp-marked)
1993 (defvar gnus-tmp-subscribed)
1994 (defvar gnus-tmp-process-marked)
1995 (defvar gnus-tmp-number-of-unread)
1996 (defvar gnus-tmp-group-name)
1997 (defvar gnus-tmp-group)
1998 (defvar gnus-tmp-article-number)
1999 (defvar gnus-tmp-unread-and-unselected)
2000 (defvar gnus-tmp-news-method)
2001 (defvar gnus-tmp-news-server)
2002 (defvar gnus-tmp-article-number)
2003 (defvar gnus-mouse-face)
2004 (defvar gnus-mouse-face-prop)
2005
2006 (defun gnus-summary-line-format-spec ()
2007   (insert gnus-tmp-unread gnus-tmp-replied 
2008           gnus-tmp-score-char gnus-tmp-indentation)
2009   (put-text-property
2010    (point)
2011    (progn
2012      (insert 
2013       gnus-tmp-opening-bracket 
2014       (format "%4d: %-20s" 
2015               gnus-tmp-lines 
2016               (if (> (length gnus-tmp-name) 20) 
2017                   (substring gnus-tmp-name 0 20) 
2018                 gnus-tmp-name))
2019       gnus-tmp-closing-bracket)
2020      (point))
2021    gnus-mouse-face-prop gnus-mouse-face)
2022   (insert " " gnus-tmp-subject-or-nil "\n"))
2023
2024 (defvar gnus-summary-line-format-spec 
2025   (gnus-byte-code 'gnus-summary-line-format-spec))
2026
2027 (defun gnus-summary-dummy-line-format-spec ()
2028   (insert "*  ")
2029   (put-text-property
2030    (point)
2031    (progn
2032      (insert ":                          :")
2033      (point))
2034    gnus-mouse-face-prop gnus-mouse-face)
2035   (insert " " gnus-tmp-subject "\n"))
2036
2037 (defvar gnus-summary-dummy-line-format-spec 
2038   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2039
2040 (defun gnus-group-line-format-spec ()
2041   (insert gnus-tmp-marked gnus-tmp-subscribed 
2042           gnus-tmp-process-marked
2043           gnus-topic-indentation
2044           (format "%5s: " gnus-tmp-number-of-unread))
2045   (put-text-property 
2046    (point)
2047    (progn
2048      (insert gnus-tmp-group "\n")
2049      (1- (point)))
2050    gnus-mouse-face-prop gnus-mouse-face))
2051 (defvar gnus-group-line-format-spec 
2052   (gnus-byte-code 'gnus-group-line-format-spec))
2053
2054 (defun gnus-summary-mode-line-format-spec ()
2055   (format "Gnus  %s/%d %s" gnus-tmp-group-name
2056           gnus-tmp-article-number gnus-tmp-unread-and-unselected))
2057 (defvar gnus-summary-mode-line-format-spec
2058   (gnus-byte-code 'gnus-summary-mode-line-format-spec))
2059
2060 (defun gnus-group-mode-line-format-spec ()
2061   (format "Gnus  List of groups   {%s:%s}  "
2062           gnus-tmp-news-method gnus-tmp-news-server))
2063 (defvar gnus-group-mode-line-format-spec 
2064   (gnus-byte-code 'gnus-group-mode-line-format-spec))
2065
2066 (defun gnus-article-mode-line-format-spec ()
2067   (format "Gnus  %s/%d %s" gnus-tmp-group-name
2068           gnus-tmp-article-number gnus-tmp-subject))
2069 (defvar gnus-article-mode-line-format-spec
2070   (gnus-byte-code 'gnus-article-mode-line-format-spec))
2071
2072 (defvar gnus-old-specs 
2073   '((article-mode . "Gnus  %G/%A %S")
2074     (group-mode . "Gnus  List of groups   {%M:%S}  ")
2075     (summary-mode . "Gnus  %G/%A %Z")
2076     (group . "%M%S%p%5y: %(%g%)\n")
2077     (summary-dummy . "*  :                          : %S\n")
2078     (summary . "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n")))
2079
2080 ;;; Phew.  All that gruft is over, fortunately.  
2081
2082 \f
2083 ;;;
2084 ;;; Gnus Utility Functions
2085 ;;;
2086
2087 (defun gnus-extract-address-components (from)
2088   (let (name address)
2089     ;; First find the address - the thing with the @ in it.  This may
2090     ;; not be accurate in mail addresses, but does the trick most of
2091     ;; the time in news messages.
2092     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2093         (setq address (substring from (match-beginning 0) (match-end 0))))
2094     ;; Then we check whether the "name <address>" format is used.
2095     (and address
2096          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2097          ;; Linear white space is not required.
2098          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2099          (and (setq name (substring from 0 (match-beginning 0)))
2100               ;; Strip any quotes from the name.
2101               (string-match "\".*\"" name)
2102               (setq name (substring name 1 (1- (match-end 0))))))
2103     ;; If not, then "address (name)" is used.
2104     (or name
2105         (and (string-match "(.+)" from)
2106              (setq name (substring from (1+ (match-beginning 0)) 
2107                                    (1- (match-end 0)))))
2108         (and (string-match "()" from)
2109              (setq name address))
2110         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2111         ;; XOVER might not support folded From headers.
2112         (and (string-match "(.*" from)
2113              (setq name (substring from (1+ (match-beginning 0)) 
2114                                    (match-end 0)))))
2115     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2116     (list (or name from) (or address from))))
2117
2118 (defun gnus-fetch-field (field)
2119   "Return the value of the header FIELD of current article."
2120   (save-excursion
2121     (save-restriction
2122       (let ((case-fold-search t))
2123         (gnus-narrow-to-headers)
2124         (mail-fetch-field field)))))
2125
2126 (defun gnus-goto-colon ()
2127   (beginning-of-line)
2128   (search-forward ":" (gnus-point-at-eol) t))
2129
2130 (defun gnus-narrow-to-headers ()
2131   "Narrow to the head of an article."
2132   (widen)
2133   (narrow-to-region
2134    (goto-char (point-min))
2135    (if (search-forward "\n\n" nil t)
2136        (1- (point))
2137      (point-max)))
2138   (goto-char (point-min)))
2139
2140 ;;;###autoload
2141 (defun gnus-update-format (var)
2142   "Update the format specification near point."
2143   (interactive
2144    (list
2145     (save-excursion
2146       (eval-defun nil)
2147       ;; Find the end of the current word.
2148       (re-search-forward "[ \t\n]" nil t)
2149       ;; Search backward.
2150       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2151         (match-string 1)))))
2152   (set
2153    (intern (format "%s-spec" var))
2154    (gnus-parse-format (symbol-value (intern var))
2155                       (symbol-value (intern (format "%s-alist" var)))
2156                       (not (string-match "mode" var))))
2157   (pop-to-buffer "*Gnus Format*")
2158   (erase-buffer)
2159   (lisp-interaction-mode)
2160   (insert (pp-to-string (symbol-value (intern (format "%s-spec" var))))))
2161
2162
2163 (defun gnus-update-format-specifications (&optional force)
2164   (gnus-make-thread-indent-array)
2165
2166   (when force
2167     (setq gnus-old-specs nil))
2168
2169   (let ((formats '(summary summary-dummy group 
2170                            summary-mode group-mode article-mode))
2171         old-format new-format)
2172     (while formats
2173       (setq new-format (symbol-value
2174                         (intern (format "gnus-%s-line-format" (car formats)))))
2175       (or (and (setq old-format (cdr (assq (car formats) gnus-old-specs)))
2176                (equal old-format new-format))
2177           (set (intern (format "gnus-%s-line-format-spec" (car formats)))
2178                (if (not (stringp new-format)) new-format
2179                  (gnus-parse-format
2180                   new-format
2181                   (symbol-value 
2182                    (intern (format "gnus-%s-line-format-alist"
2183                                    (if (eq (car formats) 'article-mode)
2184                                        'summary-mode (car formats)))))
2185                   (not (string-match "mode$" (symbol-name (car formats))))))))
2186       (setq gnus-old-specs (cons (cons (car formats) new-format)
2187                                  (delq (assq (car formats) gnus-old-specs)
2188                                        gnus-old-specs)))
2189       (setq formats (cdr formats))))
2190       
2191   (gnus-update-group-mark-positions)
2192   (gnus-update-summary-mark-positions)
2193
2194   (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
2195            (not gnus-description-hashtb)
2196            gnus-read-active-file)
2197       (gnus-read-all-descriptions-files)))
2198
2199 (defun gnus-update-summary-mark-positions ()
2200   (save-excursion
2201     (let ((gnus-replied-mark 129)
2202           (gnus-score-below-mark 130)
2203           (gnus-score-over-mark 130)
2204           (thread nil)
2205           (gnus-visual nil)
2206           pos)
2207       (gnus-set-work-buffer)
2208       (gnus-summary-insert-line 
2209        [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2210       (goto-char (point-min))
2211       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2212                                          (- (point) 2)))))
2213       (goto-char (point-min))
2214       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
2215                                           (- (point) 2))) pos))
2216       (goto-char (point-min))
2217       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
2218                                         (- (point) 2))) pos))
2219       (setq gnus-summary-mark-positions pos))))
2220
2221 (defun gnus-update-group-mark-positions ()
2222   (save-excursion
2223     (let ((gnus-process-mark 128)
2224           (gnus-group-marked '("dummy.group")))
2225       (gnus-set-active "dummy.group" '(0 . 0))
2226       (gnus-set-work-buffer)
2227       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2228       (goto-char (point-min))
2229       (setq gnus-group-mark-positions
2230             (list (cons 'process (and (search-forward "\200" nil t)
2231                                       (- (point) 2))))))))
2232
2233 (defvar gnus-mouse-face-0 'highlight)
2234 (defvar gnus-mouse-face-1 'highlight)
2235 (defvar gnus-mouse-face-2 'highlight)
2236 (defvar gnus-mouse-face-3 'highlight)
2237 (defvar gnus-mouse-face-4 'highlight)
2238
2239 (defun gnus-mouse-face-function (form type)
2240   `(put-text-property
2241     (point) (progn ,@form (point))
2242     gnus-mouse-face-prop 
2243     ,(if (equal type 0)
2244          'gnus-mouse-face
2245        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2246
2247 (defvar gnus-face-0 'bold)
2248 (defvar gnus-face-1 'italic)
2249 (defvar gnus-face-2 'bold-italic)
2250 (defvar gnus-face-3 'bold)
2251 (defvar gnus-face-4 'bold)
2252
2253 (defun gnus-face-face-function (form type)
2254   `(put-text-property
2255     (point) (progn ,@form (point))
2256     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2257
2258 (defun gnus-max-width-function (el max-width)
2259   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2260   (if (symbolp el)
2261       `(if (> (length ,el) ,max-width)
2262            (substring ,el 0 ,max-width)
2263          ,el)
2264     `(let ((val (eval ,el)))
2265        (if (numberp val)
2266            (setq val (int-to-string val)))
2267        (if (> (length val) ,max-width)
2268            (substring val 0 ,max-width))
2269        val)))
2270
2271 (defun gnus-parse-format (format spec-alist &optional insert)
2272   ;; This function parses the FORMAT string with the help of the
2273   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2274   ;; string.  If the FORMAT string contains the specifiers %( and %)
2275   ;; the text between them will have the mouse-face text property.
2276   (if (string-match 
2277        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2278        format)
2279       (gnus-parse-complex-format format spec-alist)
2280     ;; This is a simple format.
2281     (gnus-parse-simple-format format spec-alist insert)))
2282
2283 (defun gnus-parse-complex-format (format spec-alist)
2284   (save-excursion
2285     (gnus-set-work-buffer)
2286     (insert format)
2287     (goto-char (point-min))
2288     (while (re-search-forward "\"" nil t)
2289       (replace-match "\\\"" nil t))
2290     (goto-char (point-min))
2291     (insert "(\"")
2292     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2293       (let ((number (if (match-beginning 1)
2294                         (match-string 1) "0"))
2295             (delim (aref (match-string 2) 0)))
2296         (if (or (= delim ?\() (= delim ?\{))
2297             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2298                                    " " number " \""))
2299           (replace-match "\")\""))))
2300     (goto-char (point-max))
2301     (insert "\")")
2302     (goto-char (point-min))
2303     (let ((form (read (current-buffer))))
2304       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2305
2306 (defun gnus-complex-form-to-spec (form spec-alist)
2307   (delq nil
2308         (mapcar
2309          (lambda (sform)
2310            (if (stringp sform)
2311                (gnus-parse-simple-format sform spec-alist t)
2312              (funcall (intern (format "gnus-%s-face-function"
2313                                       (car sform)))
2314                       (gnus-complex-form-to-spec 
2315                        (cdr (cdr sform)) spec-alist)
2316                       (nth 1 sform))))
2317          form)))
2318     
2319 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2320   ;; This function parses the FORMAT string with the help of the
2321   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2322   ;; string.  
2323   (let ((max-width 0)
2324         spec flist fstring newspec elem beg result dontinsert)
2325     (save-excursion
2326       (gnus-set-work-buffer)
2327       (insert format)
2328       (goto-char (point-min))
2329       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2330                                 nil t)
2331         (setq spec (string-to-char (match-string 2)))
2332         ;; First check if there are any specs that look anything like
2333         ;; "%12,12A", ie. with a "max width specification".  These have
2334         ;; to be treated specially.
2335         (if (setq beg (match-beginning 1))
2336             (setq max-width 
2337                   (string-to-int 
2338                    (buffer-substring (1+ (match-beginning 1)) (match-end 1))))
2339           (setq max-width 0)
2340           (setq beg (match-beginning 2)))
2341         ;; Find the specification from `spec-alist'.
2342         (unless (setq elem (cdr (assq spec spec-alist)))
2343           (setq elem '("*" ?s)))
2344         ;; Treat user defined format specifiers specially.
2345         (when (eq (car elem) 'gnus-tmp-user-defined)
2346           (setq elem
2347                 (list 
2348                  (list (intern (concat "gnus-user-format-function-"
2349                                        (match-string 3)))
2350                        'gnus-tmp-header) ?s))
2351           (delete-region (match-beginning 3) (match-end 3)))
2352         (if (not (zerop max-width))
2353             (let ((el (car elem)))
2354               (cond ((= (car (cdr elem)) ?c) 
2355                      (setq el (list 'char-to-string el)))
2356                     ((= (car (cdr elem)) ?d)
2357                      (numberp el) (setq el (list 'int-to-string el))))
2358               (setq flist (cons (gnus-max-width-function el max-width)
2359                                 flist))
2360               (setq newspec ?s))
2361           (setq flist (cons (car elem) flist))
2362           (setq newspec (car (cdr elem))))
2363         ;; Remove the old specification (and possibly a ",12" string).
2364         (delete-region beg (match-end 2))
2365         ;; Insert the new specification.
2366         (goto-char beg)
2367         (insert newspec))
2368       (setq fstring (buffer-substring 1 (point-max))))
2369     ;; Do some postprocessing to increase efficiency.
2370     (setq 
2371      result
2372      (cond 
2373       ;; Emptyness.
2374       ((string= fstring "")
2375        nil)
2376       ;; Not a format string.
2377       ((not (string-match "%" fstring))
2378        (list fstring))
2379       ;; A format string with just a single string spec.
2380       ((string= fstring "%s")
2381        (list (car flist)))
2382       ;; A single character.
2383       ((string= fstring "%c")
2384        (list (car flist)))
2385       ;; A single number.
2386       ((string= fstring "%d")
2387        (setq dontinsert)
2388        (if insert
2389            (list `(princ ,(car flist)))
2390          (list `(int-to-string ,(car flist)))))
2391       ;; Just lots of chars and strings.
2392       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2393        (nreverse flist))
2394       ;; A single string spec at the beginning of the spec.
2395       ((string-match "\\`%[sc][^%]+\\'" fstring)
2396        (list (car flist) (substring fstring 2)))
2397       ;; A single string spec in the middle of the spec.
2398       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2399        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2400       ;; A single string spec in the end of the spec.
2401       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2402        (list (match-string 1 fstring) (car flist)))
2403       ;; A more complex spec.
2404       (t
2405        (list (cons 'format (cons fstring (nreverse flist)))))))
2406
2407     (if insert
2408         (when result
2409           (if dontinsert
2410               result
2411             (cons 'insert result)))
2412       (or (car result) ""))))
2413
2414 (defun gnus-set-work-buffer ()
2415   (if (get-buffer gnus-work-buffer)
2416       (progn
2417         (set-buffer gnus-work-buffer)
2418         (erase-buffer))
2419     (set-buffer (get-buffer-create gnus-work-buffer))
2420     (kill-all-local-variables)
2421     (buffer-disable-undo (current-buffer))
2422     (gnus-add-current-to-buffer-list)))
2423
2424 ;; Article file names when saving.
2425
2426 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2427   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2428 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2429 Otherwise, it is like ~/News/news/group/num."
2430   (let ((default
2431           (expand-file-name
2432            (concat (if (gnus-use-long-file-name 'not-save)
2433                        (gnus-capitalize-newsgroup newsgroup)
2434                      (gnus-newsgroup-directory-form newsgroup))
2435                    "/" (int-to-string (mail-header-number headers)))
2436            (or gnus-article-save-directory "~/News"))))
2437     (if (and last-file
2438              (string-equal (file-name-directory default)
2439                            (file-name-directory last-file))
2440              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2441         default
2442       (or last-file default))))
2443
2444 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2445   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2446 If variable `gnus-use-long-file-name' is non-nil, it is
2447 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2448   (let ((default
2449           (expand-file-name
2450            (concat (if (gnus-use-long-file-name 'not-save)
2451                        newsgroup
2452                      (gnus-newsgroup-directory-form newsgroup))
2453                    "/" (int-to-string (mail-header-number headers)))
2454            (or gnus-article-save-directory "~/News"))))
2455     (if (and last-file
2456              (string-equal (file-name-directory default)
2457                            (file-name-directory last-file))
2458              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2459         default
2460       (or last-file default))))
2461
2462 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2463   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2464 If variable `gnus-use-long-file-name' is non-nil, it is
2465 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2466   (or last-file
2467       (expand-file-name
2468        (if (gnus-use-long-file-name 'not-save)
2469            (gnus-capitalize-newsgroup newsgroup)
2470          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2471        (or gnus-article-save-directory "~/News"))))
2472
2473 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2474   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2475 If variable `gnus-use-long-file-name' is non-nil, it is
2476 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2477   (or last-file
2478       (expand-file-name
2479        (if (gnus-use-long-file-name 'not-save)
2480            newsgroup
2481          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2482        (or gnus-article-save-directory "~/News"))))
2483
2484 ;; For subscribing new newsgroup
2485
2486 (defun gnus-subscribe-hierarchical-interactive (groups)
2487   (let ((groups (sort groups 'string<))
2488         prefixes prefix start ans group starts)
2489     (while groups
2490       (setq prefixes (list "^"))
2491       (while (and groups prefixes)
2492         (while (not (string-match (car prefixes) (car groups)))
2493           (setq prefixes (cdr prefixes)))
2494         (setq prefix (car prefixes))
2495         (setq start (1- (length prefix)))
2496         (if (and (string-match "[^\\.]\\." (car groups) start)
2497                  (cdr groups)
2498                  (setq prefix 
2499                        (concat "^" (substring (car groups) 0 (match-end 0))))
2500                  (string-match prefix (car (cdr groups))))
2501             (progn
2502               (setq prefixes (cons prefix prefixes))
2503               (message "Descend hierarchy %s? ([y]nsq): " 
2504                        (substring prefix 1 (1- (length prefix))))
2505               (setq ans (read-char))
2506               (cond ((= ans ?n)
2507                      (while (and groups 
2508                                  (string-match prefix 
2509                                                (setq group (car groups))))
2510                        (setq gnus-killed-list 
2511                              (cons group gnus-killed-list))
2512                        (gnus-sethash group group gnus-killed-hashtb)
2513                        (setq groups (cdr groups)))
2514                      (setq starts (cdr starts)))
2515                     ((= ans ?s)
2516                      (while (and groups 
2517                                  (string-match prefix 
2518                                                (setq group (car groups))))
2519                        (gnus-sethash group group gnus-killed-hashtb)
2520                        (gnus-subscribe-alphabetically (car groups))
2521                        (setq groups (cdr groups)))
2522                      (setq starts (cdr starts)))
2523                     ((= ans ?q)
2524                      (while groups
2525                        (setq group (car groups))
2526                        (setq gnus-killed-list (cons group gnus-killed-list))
2527                        (gnus-sethash group group gnus-killed-hashtb)
2528                        (setq groups (cdr groups))))
2529                     (t nil)))
2530           (message "Subscribe %s? ([n]yq)" (car groups))
2531           (setq ans (read-char))
2532           (setq group (car groups))
2533           (cond ((= ans ?y)
2534                  (gnus-subscribe-alphabetically (car groups))
2535                  (gnus-sethash group group gnus-killed-hashtb))
2536                 ((= ans ?q)
2537                  (while groups
2538                    (setq group (car groups))
2539                    (setq gnus-killed-list (cons group gnus-killed-list))
2540                    (gnus-sethash group group gnus-killed-hashtb)
2541                    (setq groups (cdr groups))))
2542                 (t 
2543                  (setq gnus-killed-list (cons group gnus-killed-list))
2544                  (gnus-sethash group group gnus-killed-hashtb)))
2545           (setq groups (cdr groups)))))))
2546
2547 (defun gnus-subscribe-randomly (newsgroup)
2548   "Subscribe new NEWSGROUP by making it the first newsgroup."
2549   (gnus-subscribe-newsgroup newsgroup))
2550
2551 (defun gnus-subscribe-alphabetically (newgroup)
2552   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2553   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2554   (let ((groups (cdr gnus-newsrc-alist))
2555         before)
2556     (while (and (not before) groups)
2557       (if (string< newgroup (car (car groups)))
2558           (setq before (car (car groups)))
2559         (setq groups (cdr groups))))
2560     (gnus-subscribe-newsgroup newgroup before)))
2561
2562 (defun gnus-subscribe-hierarchically (newgroup)
2563   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2564   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2565   (save-excursion
2566     (set-buffer (find-file-noselect gnus-current-startup-file))
2567     (let ((groupkey newgroup)
2568           before)
2569       (while (and (not before) groupkey)
2570         (goto-char (point-min))
2571         (let ((groupkey-re
2572                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2573           (while (and (re-search-forward groupkey-re nil t)
2574                       (progn
2575                         (setq before (match-string 1))
2576                         (string< before newgroup)))))
2577         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2578         (setq groupkey
2579               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2580                   (substring groupkey (match-beginning 1) (match-end 1)))))
2581       (gnus-subscribe-newsgroup newgroup before))))
2582
2583 (defun gnus-subscribe-interactively (newsgroup)
2584   "Subscribe new NEWSGROUP interactively.
2585 It is inserted in hierarchical newsgroup order if subscribed.  If not,
2586 it is killed."
2587   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
2588       (gnus-subscribe-hierarchically newsgroup)
2589     (setq gnus-killed-list (cons newsgroup gnus-killed-list))))
2590
2591 (defun gnus-subscribe-zombies (newsgroup)
2592   "Make new NEWSGROUP a zombie group."
2593   (setq gnus-zombie-list (cons newsgroup gnus-zombie-list)))
2594
2595 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2596   "Subscribe new NEWSGROUP.
2597 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
2598 the first newsgroup."
2599   ;; We subscribe the group by changing its level to `subscribed'.
2600   (gnus-group-change-level 
2601    newsgroup gnus-level-default-subscribed
2602    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2603   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2604
2605 ;; For directories
2606
2607 (defun gnus-newsgroup-directory-form (newsgroup)
2608   "Make hierarchical directory name from NEWSGROUP name."
2609   (let ((newsgroup (gnus-newsgroup-saveable-name newsgroup))
2610         (len (length newsgroup))
2611         idx)
2612     ;; If this is a foreign group, we don't want to translate the
2613     ;; entire name.  
2614     (if (setq idx (string-match ":" newsgroup))
2615         (aset newsgroup idx ?/)
2616       (setq idx 0))
2617     ;; Replace all occurrences of `.' with `/'.
2618     (while (< idx len)
2619       (if (= (aref newsgroup idx) ?.)
2620           (aset newsgroup idx ?/))
2621       (setq idx (1+ idx)))
2622     newsgroup))
2623
2624 (defun gnus-newsgroup-saveable-name (group)
2625   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2626   ;; with dots.
2627   (gnus-replace-chars-in-string group ?/ ?.))
2628
2629 (defun gnus-make-directory (dir)
2630   "Make DIRECTORY recursively."
2631   ;; Why don't we use `(make-directory dir 'parents)'? That's just one
2632   ;; of the many mysteries of the universe.
2633   (let* ((dir (expand-file-name dir default-directory))
2634          dirs err)
2635     (if (string-match "/$" dir)
2636         (setq dir (substring dir 0 (match-beginning 0))))
2637     ;; First go down the path until we find a directory that exists.
2638     (while (not (file-exists-p dir))
2639       (setq dirs (cons dir dirs))
2640       (string-match "/[^/]+$" dir)
2641       (setq dir (substring dir 0 (match-beginning 0))))
2642     ;; Then create all the subdirs.
2643     (while (and dirs (not err))
2644       (condition-case ()
2645           (make-directory (car dirs))
2646         (error (setq err t)))
2647       (setq dirs (cdr dirs)))
2648     ;; We return whether we were successful or not. 
2649     (not dirs)))
2650
2651 (defun gnus-capitalize-newsgroup (newsgroup)
2652   "Capitalize NEWSGROUP name."
2653   (and (not (zerop (length newsgroup)))
2654        (concat (char-to-string (upcase (aref newsgroup 0)))
2655                (substring newsgroup 1))))
2656
2657 ;; Var
2658
2659 (defun gnus-simplify-subject (subject &optional re-only)
2660   "Remove `Re:' and words in parentheses.
2661 If optional argument RE-ONLY is non-nil, strip `Re:' only."
2662   (let ((case-fold-search t))           ;Ignore case.
2663     ;; Remove `Re:' and `Re^N:'.
2664     (if (string-match "^re:[ \t]*" subject)
2665         (setq subject (substring subject (match-end 0))))
2666     ;; Remove words in parentheses from end.
2667     (or re-only
2668         (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2669           (setq subject (substring subject 0 (match-beginning 0)))))
2670     ;; Return subject string.
2671     subject))
2672
2673 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2674 ;; all whitespace.
2675 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2676 (defun gnus-simplify-buffer-fuzzy ()
2677   (goto-char (point-min))
2678   (while (or
2679           (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
2680           (looking-at "^[[].*:[ \t].*[]]$"))
2681     (goto-char (point-min))
2682     (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2683                               nil t)
2684       (replace-match "" t t))
2685     (goto-char (point-min))
2686     (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
2687       (goto-char (match-end 0))
2688       (delete-char -1)
2689       (delete-region 
2690        (progn (goto-char (match-beginning 0)))
2691        (re-search-forward ":"))))
2692   (goto-char (point-min))
2693   (while (re-search-forward "[ \t\n]*([^()]*)[ \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   (while (re-search-forward "[ \t]+$" nil t)
2700     (replace-match "" t t))
2701   (goto-char (point-min))
2702   (while (re-search-forward "^[ \t]+" nil t)
2703     (replace-match "" t t))
2704   (goto-char (point-min))
2705   (if gnus-simplify-subject-fuzzy-regexp
2706       (if (listp gnus-simplify-subject-fuzzy-regexp)
2707           (let ((list gnus-simplify-subject-fuzzy-regexp))
2708             (while list
2709               (goto-char (point-min))
2710               (while (re-search-forward (car list) nil t)
2711                 (replace-match "" t t))
2712               (setq list (cdr list))))
2713         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
2714           (replace-match "" t t)))))
2715
2716 (defun gnus-simplify-subject-fuzzy (subject)
2717   "Siplify a subject string fuzzily."
2718   (let ((case-fold-search t))
2719     (save-excursion
2720       (gnus-set-work-buffer)
2721       (insert subject)
2722       (inline (gnus-simplify-buffer-fuzzy))
2723       (buffer-string))))
2724
2725 ;; Add the current buffer to the list of buffers to be killed on exit. 
2726 (defun gnus-add-current-to-buffer-list ()
2727   (or (memq (current-buffer) gnus-buffer-list)
2728       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
2729
2730 (defun gnus-string> (s1 s2)
2731   (not (or (string< s1 s2)
2732            (string= s1 s2))))
2733
2734 ;; Functions accessing headers.
2735 ;; Functions are more convenient than macros in some cases.
2736
2737 (defun gnus-header-number (header)
2738   (mail-header-number header))
2739
2740 (defun gnus-header-subject (header)
2741   (mail-header-subject header))
2742
2743 (defun gnus-header-from (header)
2744   (mail-header-from header))
2745
2746 (defun gnus-header-xref (header)
2747   (mail-header-xref header))
2748
2749 (defun gnus-header-lines (header)
2750   (mail-header-lines header))
2751
2752 (defun gnus-header-date (header)
2753   (mail-header-date header))
2754
2755 (defun gnus-header-id (header)
2756   (mail-header-id header))
2757
2758 (defun gnus-header-message-id (header)
2759   (mail-header-id header))
2760
2761 (defun gnus-header-chars (header)
2762   (mail-header-chars header))
2763
2764 (defun gnus-header-references (header)
2765   (mail-header-references header))
2766
2767 ;;; General various misc type functions.
2768
2769 (defun gnus-clear-system ()
2770   "Clear all variables and buffers."
2771   ;; Clear Gnus variables.
2772   (let ((variables gnus-variable-list))
2773     (while variables
2774       (set (car variables) nil)
2775       (setq variables (cdr variables))))
2776   ;; Clear other internal variables.
2777   (setq gnus-list-of-killed-groups nil
2778         gnus-have-read-active-file nil
2779         gnus-newsrc-alist nil
2780         gnus-newsrc-hashtb nil
2781         gnus-killed-list nil
2782         gnus-zombie-list nil
2783         gnus-killed-hashtb nil
2784         gnus-active-hashtb nil
2785         gnus-moderated-list nil
2786         gnus-description-hashtb nil
2787         gnus-newsgroup-headers nil
2788         gnus-newsgroup-name nil
2789         gnus-server-alist nil
2790         gnus-opened-servers nil
2791         gnus-current-select-method nil)
2792   ;; Reset any score variables.
2793   (and gnus-use-scoring (gnus-score-close))
2794   ;; Kill the startup file.
2795   (and gnus-current-startup-file
2796        (get-file-buffer gnus-current-startup-file)
2797        (kill-buffer (get-file-buffer gnus-current-startup-file)))
2798   ;; Save any cache buffers.
2799   (and gnus-use-cache (gnus-cache-save-buffers))
2800   ;; Clear the dribble buffer.
2801   (gnus-dribble-clear)
2802   ;; Close down NoCeM.
2803   (and gnus-use-nocem (gnus-nocem-close))
2804   ;; Shut down the demons.
2805   (and gnus-use-demon (gnus-demon-cancel))
2806   ;; Kill global KILL file buffer.
2807   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
2808       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
2809   (gnus-kill-buffer nntp-server-buffer)
2810   ;; Backlog.
2811   (and gnus-keep-backlog (gnus-backlog-shutdown))
2812   ;; Kill Gnus buffers.
2813   (while gnus-buffer-list
2814     (gnus-kill-buffer (car gnus-buffer-list))
2815     (setq gnus-buffer-list (cdr gnus-buffer-list))))
2816
2817 (defun gnus-windows-old-to-new (setting)
2818   ;; First we take care of the really, really old Gnus 3 actions.
2819   (if (symbolp setting)
2820       (setq setting 
2821             (cond ((memq setting '(SelectArticle))
2822                    'article)
2823                   ((memq setting '(SelectSubject ExpandSubject))
2824                    'summary)
2825                   ((memq setting '(SelectNewsgroup ExitNewsgroup))
2826                    'group)
2827                   (t setting))))
2828   (if (or (listp setting)
2829           (not (and gnus-window-configuration
2830                     (memq setting '(group summary article)))))
2831       setting
2832     (let* ((setting (if (eq setting 'group) 
2833                         (if (assq 'newsgroup gnus-window-configuration)
2834                             'newsgroup
2835                           'newsgroups) setting))
2836            (elem (car (cdr (assq setting gnus-window-configuration))))
2837            (total (apply '+ elem))
2838            (types '(group summary article))
2839            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
2840            (i 0)
2841            perc
2842            out)
2843       (while (< i 3)
2844         (or (not (numberp (nth i elem)))
2845             (zerop (nth i elem))
2846             (progn
2847               (setq perc  (/ (* 1.0 (nth 0 elem)) total))
2848               (setq out (cons (if (eq pbuf (nth i types))
2849                                   (vector (nth i types) perc 'point)
2850                                 (vector (nth i types) perc))
2851                               out))))
2852         (setq i (1+ i)))
2853       (list (nreverse out)))))
2854            
2855 (defun gnus-add-configuration (conf)
2856   (setq gnus-buffer-configuration 
2857         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
2858                          gnus-buffer-configuration))))
2859
2860 (defun gnus-configure-windows (setting &optional force)
2861   (setq setting (gnus-windows-old-to-new setting))
2862   (let ((r (if (symbolp setting)
2863                (cdr (assq setting gnus-buffer-configuration))
2864              setting))
2865         (in-buf (current-buffer))
2866         rule val w height hor ohor heights sub jump-buffer
2867         rel total to-buf all-visible)
2868     (or r (error "No such setting: %s" setting))
2869
2870     (if (and (not force) (setq all-visible (gnus-all-windows-visible-p r)))
2871         ;; All the windows mentioned are already visible, so we just
2872         ;; put point in the assigned buffer, and do not touch the
2873         ;; winconf. 
2874         (select-window (get-buffer-window all-visible t))
2875          
2876
2877       ;; Either remove all windows or just remove all Gnus windows.
2878       (if gnus-use-full-window
2879           (delete-other-windows)
2880         (gnus-remove-some-windows)
2881         (switch-to-buffer nntp-server-buffer))
2882
2883       (while r
2884         (setq hor (car r)
2885               ohor nil)
2886
2887         ;; We have to do the (possible) horizontal splitting before the
2888         ;; vertical. 
2889         (if (and (listp (car hor)) 
2890                  (eq (car (car hor)) 'horizontal))
2891             (progn
2892               (split-window 
2893                nil
2894                (if (integerp (nth 1 (car hor)))
2895                    (nth 1 (car hor))
2896                  (- (frame-width) (floor (* (frame-width) (nth 1 (car hor))))))
2897                t)
2898               (setq hor (cdr hor))))
2899
2900         ;; Go through the rules and eval the elements that are to be
2901         ;; evaled.  
2902         (while hor
2903           (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor))))
2904               (progn
2905                 ;; Expand short buffer name.
2906                 (setq w (aref val 0))
2907                 (and (setq w (cdr (assq w gnus-window-to-buffer)))
2908                      (progn
2909                        (setq val (apply 'vector (mapcar 'identity val)))
2910                        (aset val 0 w)))
2911                 (setq ohor (cons val ohor))))
2912           (setq hor (cdr hor)))
2913         (setq rule (cons (nreverse ohor) rule))
2914         (setq r (cdr r)))
2915       (setq rule (nreverse rule))
2916
2917       ;; We tally the window sizes.
2918       (setq total (window-height))
2919       (while rule
2920         (setq hor (car rule))
2921         (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal))
2922             (setq hor (cdr hor)))
2923         (setq sub 0)
2924         (while hor
2925           (setq rel (aref (car hor) 1)
2926                 heights (cons
2927                          (cond ((and (floatp rel) (= 1.0 rel))
2928                                 'x)
2929                                ((integerp rel)
2930                                 rel)
2931                                (t
2932                                 (max (floor (* total rel)) 4)))
2933                          heights)
2934                 sub (+ sub (if (numberp (car heights)) (car heights) 0))
2935                 hor (cdr hor)))
2936         (setq heights (nreverse heights)
2937               hor (car rule))
2938
2939         ;; We then go through these heighs and create windows for them.
2940         (while heights
2941           (setq height (car heights)
2942                 heights (cdr heights))
2943           (and (eq height 'x)
2944                (setq height (- total sub)))
2945           (and heights
2946                (split-window nil height))
2947           (setq to-buf (aref (car hor) 0))
2948           (switch-to-buffer 
2949            (cond ((not to-buf)
2950                   in-buf)
2951                  ((symbolp to-buf)
2952                   (symbol-value (aref (car hor) 0)))
2953                  (t
2954                   (aref (car hor) 0))))
2955           (and (> (length (car hor)) 2)
2956                (eq (aref (car hor) 2) 'point)
2957                (setq jump-buffer (current-buffer)))
2958           (other-window 1)
2959           (setq hor (cdr hor)))
2960       
2961         (setq rule (cdr rule)))
2962
2963       ;; Finally, we pop to the buffer that's supposed to have point. 
2964       (or jump-buffer (error "Missing `point' in spec for %s" setting))
2965
2966       (select-window (get-buffer-window jump-buffer t))
2967       (set-buffer jump-buffer))))
2968
2969 (defun gnus-all-windows-visible-p (rule)
2970   (let (invisible hor jump-buffer val buffer)
2971     ;; Go through the rules and eval the elements that are to be
2972     ;; evaled.  
2973     (while (and rule (not invisible))
2974       (setq hor (car rule)
2975             rule (cdr rule))
2976       (while (and hor (not invisible))
2977         (if (setq val (if (vectorp (car hor)) 
2978                           (car hor)
2979                         (if (not (eq (car (car hor)) 'horizontal))
2980                             (eval (car hor)))))
2981             (progn
2982               ;; Expand short buffer name.
2983               (setq buffer (or (cdr (assq (aref val 0) gnus-window-to-buffer))
2984                                (aref val 0)))
2985               (setq buffer (if (symbolp buffer) (symbol-value buffer)
2986                              buffer))
2987               (and (> (length val) 2) (eq 'point (aref val 2))
2988                    (setq jump-buffer buffer))
2989               (setq invisible (not (and buffer (get-buffer-window buffer))))))
2990         (setq hor (cdr hor))))
2991     (and (not invisible) jump-buffer)))
2992
2993 (defun gnus-window-top-edge (&optional window)
2994   (nth 1 (window-edges window)))
2995
2996 (defun gnus-remove-some-windows ()
2997   (let ((buffers gnus-window-to-buffer)
2998         buf bufs lowest-buf lowest)
2999     (save-excursion
3000       ;; Remove windows on all known Gnus buffers.
3001       (while buffers
3002         (setq buf (cdr (car buffers)))
3003         (if (symbolp buf)
3004             (setq buf (and (boundp buf) (symbol-value buf))))
3005         (and buf 
3006              (get-buffer-window buf)
3007              (progn
3008                (setq bufs (cons buf bufs))
3009                (pop-to-buffer buf)
3010                (if (or (not lowest)
3011                        (< (gnus-window-top-edge) lowest))
3012                    (progn
3013                      (setq lowest (gnus-window-top-edge))
3014                      (setq lowest-buf buf)))))
3015         (setq buffers (cdr buffers)))
3016       ;; Remove windows on *all* summary buffers.
3017       (let (wins)
3018         (walk-windows
3019          (lambda (win)
3020            (let ((buf (window-buffer win)))
3021              (if (string-match  "^\\*Summary" (buffer-name buf))
3022                  (progn
3023                    (setq bufs (cons buf bufs))
3024                    (pop-to-buffer buf)
3025                    (if (or (not lowest)
3026                            (< (gnus-window-top-edge) lowest))
3027                        (progn
3028                          (setq lowest-buf buf)
3029                          (setq lowest (gnus-window-top-edge))))))))))
3030       (and lowest-buf 
3031            (progn
3032              (pop-to-buffer lowest-buf)
3033              (switch-to-buffer nntp-server-buffer)))
3034       (while bufs
3035         (and (not (eq (car bufs) lowest-buf))
3036              (delete-windows-on (car bufs)))
3037         (setq bufs (cdr bufs))))))
3038                           
3039 (defun gnus-version ()
3040   "Version numbers of this version of Gnus."
3041   (interactive)
3042   (let ((methods gnus-valid-select-methods)
3043         (mess gnus-version)
3044         meth)
3045     ;; Go through all the legal select methods and add their version
3046     ;; numbers to the total version string.  Only the backends that are
3047     ;; currently in use will have their message numbers taken into
3048     ;; consideration. 
3049     (while methods
3050       (setq meth (intern (concat (car (car methods)) "-version")))
3051       (and (boundp meth)
3052            (stringp (symbol-value meth))
3053            (setq mess (concat mess "; " (symbol-value meth))))
3054       (setq methods (cdr methods)))
3055     (gnus-message 2 mess)))
3056
3057 (defun gnus-info-find-node ()
3058   "Find Info documentation of Gnus."
3059   (interactive)
3060   ;; Enlarge info window if needed.
3061   (let ((mode major-mode))
3062     (gnus-configure-windows 'info)
3063     (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))))
3064
3065 (defun gnus-replace-chars-in-string (string &rest pairs)
3066   "Replace characters in STRING from FROM to TO."
3067   (let ((string (substring string 0))   ;Copy string.
3068         (len (length string))
3069         (idx 0)
3070         sym to)
3071     (or (zerop (% (length pairs) 2)) 
3072         (error "Odd number of translation pairs"))
3073     (setplist 'sym pairs)
3074     ;; Replace all occurrences of FROM with TO.
3075     (while (< idx len)
3076       (if (setq to (get 'sym (aref string idx)))
3077           (aset string idx to))
3078       (setq idx (1+ idx)))
3079     string))
3080
3081 (defun gnus-days-between (date1 date2)
3082   ;; Return the number of days between date1 and date2.
3083   (- (gnus-day-number date1) (gnus-day-number date2)))
3084
3085 (defun gnus-day-number (date)
3086   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3087                      (timezone-parse-date date))))
3088     (timezone-absolute-from-gregorian 
3089      (nth 1 dat) (nth 2 dat) (car dat))))
3090
3091 ;; Returns a floating point number that says how many seconds have
3092 ;; lapsed between Jan 1 12:00:00 1970 and DATE.
3093 (defun gnus-seconds-since-epoch (date)
3094   (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
3095                         (timezone-parse-date date)))
3096          (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
3097                         (timezone-parse-time
3098                          (aref (timezone-parse-date date) 3))))
3099          (edate (mapcar (lambda (ti) (and ti (string-to-int ti)))
3100                         (timezone-parse-date "Jan 1 12:00:00 1970")))
3101          (tday (- (timezone-absolute-from-gregorian 
3102                    (nth 1 tdate) (nth 2 tdate) (nth 0 tdate))
3103                   (timezone-absolute-from-gregorian 
3104                    (nth 1 edate) (nth 2 edate) (nth 0 edate)))))
3105     (+ (nth 2 ttime)
3106        (* (nth 1 ttime) 60)
3107        (* 1.0 (nth 0 ttime) 60 60)
3108        (* 1.0 tday 60 60 24))))
3109
3110 (defun gnus-file-newer-than (file date)
3111   (let ((fdate (nth 5 (file-attributes file))))
3112     (or (> (car fdate) (car date))
3113         (and (= (car fdate) (car date))
3114              (> (nth 1 fdate) (nth 1 date))))))
3115
3116 (defun gnus-group-read-only-p (&optional group)
3117   "Check whether GROUP supports editing or not.
3118 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3119 that that variable is buffer-local to the summary buffers."
3120   (let ((group (or group gnus-newsgroup-name)))
3121     (not (gnus-check-backend-function 'request-replace-article group))))
3122
3123 (defun gnus-group-total-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 'total-expire params) 
3127         (cdr (assq 'total-expire params)) ; (total-expire . t)
3128         (and gnus-total-expirable-newsgroups ; Check var.
3129              (string-match gnus-total-expirable-newsgroups group)))))
3130
3131 (defun gnus-group-auto-expirable-p (group)
3132   "Check whether GROUP is total-expirable or not."
3133   (let ((params (gnus-info-params (gnus-get-info group))))
3134     (or (memq 'auto-expire params) 
3135         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3136         (and gnus-auto-expirable-newsgroups ; Check var.
3137              (string-match gnus-auto-expirable-newsgroups group)))))
3138
3139 (defun gnus-subject-equal (s1 s2)
3140   "Check whether two subjects are equal."
3141   (cond
3142    ((null gnus-summary-gather-subject-limit)
3143     (equal (gnus-simplify-subject-re s1)
3144            (gnus-simplify-subject-re s2)))
3145    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3146     (equal (gnus-simplify-subject-fuzzy s1)
3147            (gnus-simplify-subject-fuzzy s2)))
3148    ((numberp gnus-summary-gather-subject-limit)
3149     (equal (gnus-limit-string s1 gnus-summary-gather-subject-limit)
3150            (gnus-limit-string s2 gnus-summary-gather-subject-limit)))
3151    (t
3152     (equal s1 s2))))
3153
3154 ;; Returns a list of writable groups.
3155 (defun gnus-writable-groups ()
3156   (let ((alist gnus-newsrc-alist)
3157         groups)
3158     (while alist
3159       (or (gnus-group-read-only-p (car (car alist)))
3160           (setq groups (cons (car (car alist)) groups)))
3161       (setq alist (cdr alist)))
3162     (nreverse groups)))
3163
3164 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3165 ;; the echo area.
3166 (defun gnus-y-or-n-p (prompt)
3167   (prog1
3168       (y-or-n-p prompt)
3169     (message "")))
3170
3171 (defun gnus-yes-or-no-p (prompt)
3172   (prog1
3173       (yes-or-no-p prompt)
3174     (message "")))
3175
3176 ;; Check whether to use long file names.
3177 (defun gnus-use-long-file-name (symbol)
3178   ;; The variable has to be set...
3179   (and gnus-use-long-file-name
3180        ;; If it isn't a list, then we return t.
3181        (or (not (listp gnus-use-long-file-name))
3182            ;; If it is a list, and the list contains `symbol', we
3183            ;; return nil.  
3184            (not (memq symbol gnus-use-long-file-name)))))
3185
3186 ;; I suspect there's a better way, but I haven't taken the time to do
3187 ;; it yet. -erik selberg@cs.washington.edu
3188 (defun gnus-dd-mmm (messy-date)
3189   "Return a string like DD-MMM from a big messy string"
3190   (let ((datevec (timezone-parse-date messy-date)))
3191     (format "%2s-%s"
3192             (or (aref datevec 2) "??")
3193             (capitalize
3194              (or (car 
3195                   (nth (1- (string-to-number (aref datevec 1)))
3196                        timezone-months-assoc))
3197                  "???")))))
3198
3199 ;; Make a hash table (default and minimum size is 255).
3200 ;; Optional argument HASHSIZE specifies the table size.
3201 (defun gnus-make-hashtable (&optional hashsize)
3202   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3203
3204 ;; Make a number that is suitable for hashing; bigger than MIN and one
3205 ;; less than 2^x.
3206 (defun gnus-create-hash-size (min)
3207   (let ((i 1))
3208     (while (< i min)
3209       (setq i (* 2 i)))
3210     (1- i)))
3211
3212 ;; Show message if message has a lower level than `gnus-verbose'. 
3213 ;; Guide-line for numbers:
3214 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3215 ;; for things that take a long time, 7 - not very important messages
3216 ;; on stuff, 9 - messages inside loops.
3217 (defun gnus-message (level &rest args)
3218   (if (<= level gnus-verbose)
3219       (apply 'message args)
3220     ;; We have to do this format thingie here even if the result isn't
3221     ;; shown - the return value has to be the same as the return value
3222     ;; from `message'.
3223     (apply 'format args)))
3224
3225 (defun gnus-functionp (form)
3226   "Return non-nil if FORM is funcallable."
3227   (or (and (symbolp form) (fboundp form))
3228       (and (listp form) (eq (car form) 'lambda))))
3229
3230 ;; Generate a unique new group name.
3231 (defun gnus-generate-new-group-name (leaf)
3232   (let ((name leaf)
3233         (num 0))
3234     (while (gnus-gethash name gnus-newsrc-hashtb)
3235       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3236     name))
3237
3238 ;; Find out whether the gnus-visual TYPE is wanted.
3239 (defun gnus-visual-p (&optional type class)
3240   (and gnus-visual                      ; Has to be non-nil, at least.
3241        (if (not type)                   ; We don't care about type.
3242            gnus-visual
3243          (if (listp gnus-visual)        ; It's a list, so we check it.
3244              (or (memq type gnus-visual)
3245                  (memq class gnus-visual))
3246            t))))
3247
3248 (defun gnus-parent-id (references)
3249   "Return the last Message-ID in REFERENCES."
3250   (and references
3251        (string-match "\\(<[^<>]+>\\) *$" references)
3252        (substring references (match-beginning 1) (match-end 1))))
3253
3254 (defun gnus-ephemeral-group-p (group)
3255   "Say whether GROUP is ephemeral or not."
3256   (assoc 'quit-config (gnus-find-method-for-group group)))
3257
3258 (defun gnus-group-quit-config (group)
3259   "Return the quit-config of GROUP."
3260   (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
3261
3262 (defun gnus-simplify-mode-line ()
3263   "Make mode lines a bit simpler."
3264   (setq mode-line-modified "-- ")
3265   (when (listp mode-line-format)
3266     (make-local-variable 'mode-line-format)
3267     (setq mode-line-format (copy-sequence mode-line-format))
3268     (and (equal (nth 3 mode-line-format) "   ")
3269          (setcar (nthcdr 3 mode-line-format) ""))))
3270
3271 ;;; List and range functions
3272
3273 (defun gnus-last-element (list)
3274   "Return last element of LIST."
3275   (while (cdr list)
3276     (setq list (cdr list)))
3277   (car list))
3278
3279 (defun gnus-copy-sequence (list)
3280   "Do a complete, total copy of a list."
3281   (if (and (consp list) (not (consp (cdr list))))
3282       (cons (car list) (cdr list))
3283     (mapcar (lambda (elem) (if (consp elem) 
3284                                (if (consp (cdr elem))
3285                                    (gnus-copy-sequence elem)
3286                                  (cons (car elem) (cdr elem)))
3287                              elem))
3288             list)))
3289
3290 (defun gnus-set-difference (list1 list2)
3291   "Return a list of elements of LIST1 that do not appear in LIST2."
3292   (let ((list1 (copy-sequence list1)))
3293     (while list2
3294       (setq list1 (delq (car list2) list1))
3295       (setq list2 (cdr list2)))
3296     list1))
3297
3298 (defun gnus-sorted-complement (list1 list2)
3299   "Return a list of elements of LIST1 that do not appear in LIST2.
3300 Both lists have to be sorted over <."
3301   (let (out)
3302     (if (or (null list1) (null list2))
3303         (or list1 list2)
3304       (while (and list1 list2)
3305         (cond ((= (car list1) (car list2))
3306                (setq list1 (cdr list1)
3307                      list2 (cdr list2)))
3308               ((< (car list1) (car list2))
3309                (setq out (cons (car list1) out))
3310                (setq list1 (cdr list1)))
3311               (t
3312                (setq out (cons (car list2) out))
3313                (setq list2 (cdr list2)))))
3314       (nconc (nreverse out) (or list1 list2)))))
3315
3316 (defun gnus-intersection (list1 list2)      
3317   (let ((result nil))
3318     (while list2
3319       (if (memq (car list2) list1)
3320           (setq result (cons (car list2) result)))
3321       (setq list2 (cdr list2)))
3322     result))
3323
3324 (defun gnus-sorted-intersection (list1 list2)
3325   ;; LIST1 and LIST2 have to be sorted over <.
3326   (let (out)
3327     (while (and list1 list2)
3328       (cond ((= (car list1) (car list2))
3329              (setq out (cons (car list1) out)
3330                    list1 (cdr list1)
3331                    list2 (cdr list2)))
3332             ((< (car list1) (car list2))
3333              (setq list1 (cdr list1)))
3334             (t
3335              (setq list2 (cdr list2)))))
3336     (nreverse out)))
3337
3338 (defun gnus-set-sorted-intersection (list1 list2)
3339   ;; LIST1 and LIST2 have to be sorted over <.
3340   ;; This function modifies LIST1.
3341   (let* ((top (cons nil list1))
3342          (prev top))
3343     (while (and list1 list2)
3344       (cond ((= (car list1) (car list2))
3345              (setq prev list1
3346                    list1 (cdr list1)
3347                    list2 (cdr list2)))
3348             ((< (car list1) (car list2))
3349              (setcdr prev (cdr list1))
3350              (setq list1 (cdr list1)))
3351             (t
3352              (setq list2 (cdr list2)))))
3353     (setcdr prev nil)
3354     (cdr top)))
3355
3356 (defun gnus-compress-sequence (numbers &optional always-list)
3357   "Convert list of numbers to a list of ranges or a single range.
3358 If ALWAYS-LIST is non-nil, this function will always release a list of
3359 ranges."
3360   (let* ((first (car numbers))
3361          (last (car numbers))
3362          result)
3363     (if (null numbers)
3364         nil
3365       (if (not (listp (cdr numbers)))
3366           numbers
3367         (while numbers
3368           (cond ((= last (car numbers)) nil) ;Omit duplicated number
3369                 ((= (1+ last) (car numbers)) ;Still in sequence
3370                  (setq last (car numbers)))
3371                 (t                      ;End of one sequence
3372                  (setq result 
3373                        (cons (if (= first last) first
3374                                (cons first last)) result))
3375                  (setq first (car numbers))
3376                  (setq last  (car numbers))))
3377           (setq numbers (cdr numbers)))
3378         (if (and (not always-list) (null result))
3379             (if (= first last) (list first) (cons first last))
3380           (nreverse (cons (if (= first last) first (cons first last))
3381                           result)))))))
3382
3383 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3384 (defun gnus-uncompress-range (ranges)
3385   "Expand a list of ranges into a list of numbers.
3386 RANGES is either a single range on the form `(num . num)' or a list of
3387 these ranges."
3388   (let (first last result)
3389     (cond 
3390      ((null ranges)
3391       nil)
3392      ((not (listp (cdr ranges)))
3393       (setq first (car ranges))
3394       (setq last (cdr ranges))
3395       (while (<= first last)
3396         (setq result (cons first result))
3397         (setq first (1+ first)))
3398       (nreverse result))
3399      (t
3400       (while ranges
3401         (if (atom (car ranges))
3402             (if (numberp (car ranges))
3403                 (setq result (cons (car ranges) result)))
3404           (setq first (car (car ranges)))
3405           (setq last  (cdr (car ranges)))
3406           (while (<= first last)
3407             (setq result (cons first result))
3408             (setq first (1+ first))))
3409         (setq ranges (cdr ranges)))
3410       (nreverse result)))))
3411
3412 (defun gnus-add-to-range (ranges list)
3413   "Return a list of ranges that has all articles from both RANGES and LIST.
3414 Note: LIST has to be sorted over `<'."
3415   (if (not ranges)
3416       (gnus-compress-sequence list t)
3417     (setq list (copy-sequence list))
3418     (or (listp (cdr ranges))
3419         (setq ranges (list ranges)))
3420     (let ((out ranges)
3421           ilist lowest highest temp)
3422       (while (and ranges list)
3423         (setq ilist list)
3424         (setq lowest (or (and (atom (car ranges)) (car ranges))
3425                          (car (car ranges))))
3426         (while (and list (cdr list) (< (car (cdr list)) lowest))
3427           (setq list (cdr list)))
3428         (if (< (car ilist) lowest)
3429             (progn
3430               (setq temp list)
3431               (setq list (cdr list))
3432               (setcdr temp nil)
3433               (setq out (nconc (gnus-compress-sequence ilist t) out))))
3434         (setq highest (or (and (atom (car ranges)) (car ranges))
3435                           (cdr (car ranges))))
3436         (while (and list (<= (car list) highest))
3437           (setq list (cdr list)))
3438         (setq ranges (cdr ranges)))
3439       (if list
3440           (setq out (nconc (gnus-compress-sequence list t) out)))
3441       (setq out (sort out (lambda (r1 r2) 
3442                             (< (or (and (atom r1) r1) (car r1))
3443                                (or (and (atom r2) r2) (car r2))))))
3444       (setq ranges out)
3445       (while ranges
3446         (if (atom (car ranges))
3447             (if (cdr ranges)
3448                 (if (atom (car (cdr ranges)))
3449                     (if (= (1+ (car ranges)) (car (cdr ranges)))
3450                         (progn
3451                           (setcar ranges (cons (car ranges) 
3452                                                (car (cdr ranges))))
3453                           (setcdr ranges (cdr (cdr ranges)))))
3454                   (if (= (1+ (car ranges)) (car (car (cdr ranges))))
3455                       (progn
3456                         (setcar (car (cdr ranges)) (car ranges))
3457                         (setcar ranges (car (cdr ranges)))
3458                         (setcdr ranges (cdr (cdr ranges)))))))
3459           (if (cdr ranges)
3460               (if (atom (car (cdr ranges)))
3461                   (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
3462                       (progn
3463                         (setcdr (car ranges) (car (cdr ranges)))
3464                         (setcdr ranges (cdr (cdr ranges)))))
3465                 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
3466                     (progn
3467                       (setcdr (car ranges) (cdr (car (cdr ranges))))
3468                       (setcdr ranges (cdr (cdr ranges))))))))
3469         (setq ranges (cdr ranges)))
3470       out)))
3471
3472 (defun gnus-remove-from-range (ranges list)
3473   "Return a list of ranges that has all articles from LIST removed from RANGES.
3474 Note: LIST has to be sorted over `<'."
3475   ;; !!! This function shouldn't look like this, but I've got a headache.
3476   (gnus-compress-sequence 
3477    (gnus-sorted-complement
3478     (gnus-uncompress-range ranges) list)))
3479
3480 (defun gnus-member-of-range (number ranges)
3481   (if (not (listp (cdr ranges)))
3482       (and (>= number (car ranges)) 
3483            (<= number (cdr ranges)))
3484     (let ((not-stop t))
3485       (while (and ranges 
3486                   (if (numberp (car ranges))
3487                       (>= number (car ranges))
3488                     (>= number (car (car ranges))))
3489                   not-stop)
3490         (if (if (numberp (car ranges))
3491                 (= number (car ranges))
3492               (and (>= number (car (car ranges)))
3493                    (<= number (cdr (car ranges)))))
3494             (setq not-stop nil))
3495         (setq ranges (cdr ranges)))
3496       (not not-stop))))
3497
3498 (defun gnus-range-length (range)
3499   "Return the length RANGE would have if uncompressed."
3500   (length (gnus-uncompress-range range)))
3501
3502 (defun gnus-sublist-p (list sublist)
3503   "Test whether all elements in SUBLIST are members of LIST."
3504   (let ((sublistp t))
3505     (while sublist
3506       (unless (memq (pop sublist) list)
3507         (setq sublistp nil
3508               sublist nil)))
3509     sublistp))
3510
3511 \f
3512 ;;;
3513 ;;; Gnus group mode
3514 ;;;
3515
3516 (defvar gnus-group-mode-map nil)
3517 (defvar gnus-group-group-map nil)
3518 (defvar gnus-group-mark-map nil)
3519 (defvar gnus-group-list-map nil)
3520 (defvar gnus-group-sort-map nil)
3521 (defvar gnus-group-soup-map nil)
3522 (defvar gnus-group-sub-map nil)
3523 (defvar gnus-group-help-map nil)
3524 (defvar gnus-group-score-map nil)
3525 (put 'gnus-group-mode 'mode-class 'special)
3526
3527 (if gnus-group-mode-map
3528     nil
3529   (setq gnus-group-mode-map (make-keymap))
3530   (suppress-keymap gnus-group-mode-map)
3531   (define-key gnus-group-mode-map " " 'gnus-group-read-group)
3532   (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
3533   (define-key gnus-group-mode-map "\r" 'gnus-group-select-group)
3534   (define-key gnus-group-mode-map "\M-\r" 'gnus-group-quick-select-group)
3535   (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
3536   (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
3537   (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
3538   (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
3539   (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
3540   (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
3541   (define-key gnus-group-mode-map
3542     "\M-n" 'gnus-group-next-unread-group-same-level)
3543   (define-key gnus-group-mode-map 
3544     "\M-p" 'gnus-group-prev-unread-group-same-level)
3545   (define-key gnus-group-mode-map "," 'gnus-group-best-unread-group)
3546   (define-key gnus-group-mode-map "." 'gnus-group-first-unread-group)
3547   (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
3548   (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
3549   (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current)
3550   (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all)
3551   (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
3552   (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
3553   (define-key gnus-group-mode-map "m" 'gnus-group-mail)
3554   (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
3555   (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group)
3556   (define-key gnus-group-mode-map "R" 'gnus-group-restart)
3557   (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file)
3558   (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server)
3559   (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
3560   (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups)
3561   (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group)
3562   (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups)
3563   (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos)
3564   (define-key gnus-group-mode-map "\C-c\M-\C-a" 'gnus-group-description-apropos)
3565   (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
3566   (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
3567   (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
3568   (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
3569   (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
3570   (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
3571   (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
3572   (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed)
3573   (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles)
3574   (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups)
3575   (define-key gnus-group-mode-map "V" 'gnus-version)
3576   (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc)
3577   (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
3578   (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble)
3579   (define-key gnus-group-mode-map "q" 'gnus-group-exit)
3580   (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
3581   (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
3582   (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
3583   (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method)
3584   (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode)
3585   (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group)
3586   (define-key gnus-group-mode-map "<" 'beginning-of-buffer)
3587   (define-key gnus-group-mode-map ">" 'end-of-buffer)
3588   (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug)
3589   (define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups)
3590   (define-key gnus-group-mode-map "t" 'gnus-topic-mode)
3591
3592   (define-key gnus-group-mode-map "#" 'gnus-group-mark-group)
3593   (define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group)
3594   (define-prefix-command 'gnus-group-mark-map)
3595   (define-key gnus-group-mode-map "M" 'gnus-group-mark-map)
3596   (define-key gnus-group-mark-map "m" 'gnus-group-mark-group)
3597   (define-key gnus-group-mark-map "u" 'gnus-group-unmark-group)
3598   (define-key gnus-group-mark-map "w" 'gnus-group-mark-region)
3599   (define-key gnus-group-mark-map "r" 'gnus-group-mark-regexp)
3600
3601   (define-prefix-command 'gnus-group-group-map)
3602   (define-key gnus-group-mode-map "G" 'gnus-group-group-map)
3603   (define-key gnus-group-group-map "d" 'gnus-group-make-directory-group)
3604   (define-key gnus-group-group-map "h" 'gnus-group-make-help-group)
3605   (define-key gnus-group-group-map "a" 'gnus-group-make-archive-group)
3606   (define-key gnus-group-group-map "k" 'gnus-group-make-kiboze-group)
3607   (define-key gnus-group-group-map "m" 'gnus-group-make-group)
3608   (define-key gnus-group-group-map "E" 'gnus-group-edit-group)
3609   (define-key gnus-group-group-map "e" 'gnus-group-edit-group-method)
3610   (define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters)
3611   (define-key gnus-group-group-map "v" 'gnus-group-add-to-virtual)
3612   (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual)
3613   (define-key gnus-group-group-map "D" 'gnus-group-enter-directory)
3614   (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group)
3615   (define-key gnus-group-group-map "r" 'gnus-group-rename-group)
3616   (define-key gnus-group-group-map "\177" 'gnus-group-delete-group)
3617
3618   (define-prefix-command 'gnus-group-soup-map)
3619   (define-key gnus-group-group-map "s" 'gnus-group-soup-map)
3620   (define-key gnus-group-soup-map "b" 'gnus-group-brew-soup)
3621   (define-key gnus-group-soup-map "w" 'gnus-soup-save-areas)
3622   (define-key gnus-group-soup-map "s" 'gnus-soup-send-replies)
3623   (define-key gnus-group-soup-map "p" 'gnus-soup-pack-packet)
3624   (define-key gnus-group-soup-map "r" 'nnsoup-pack-replies)
3625
3626   (define-prefix-command 'gnus-group-sort-map)
3627   (define-key gnus-group-group-map "S" 'gnus-group-sort-map)
3628   (define-key gnus-group-sort-map "s" 'gnus-group-sort-groups)
3629   (define-key gnus-group-sort-map "a" 'gnus-group-sort-groups-by-alphabet)
3630   (define-key gnus-group-sort-map "u" 'gnus-group-sort-groups-by-unread)
3631   (define-key gnus-group-sort-map "l" 'gnus-group-sort-groups-by-level)
3632   (define-key gnus-group-sort-map "v" 'gnus-group-sort-groups-by-score)
3633   (define-key gnus-group-sort-map "r" 'gnus-group-sort-groups-by-rank)
3634   (define-key gnus-group-sort-map "m" 'gnus-group-sort-groups-by-method)
3635
3636   (define-prefix-command 'gnus-group-list-map)
3637   (define-key gnus-group-mode-map "A" 'gnus-group-list-map)
3638   (define-key gnus-group-list-map "k" 'gnus-group-list-killed)
3639   (define-key gnus-group-list-map "z" 'gnus-group-list-zombies)
3640   (define-key gnus-group-list-map "s" 'gnus-group-list-groups)
3641   (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups)
3642   (define-key gnus-group-list-map "A" 'gnus-group-list-active)
3643   (define-key gnus-group-list-map "a" 'gnus-group-apropos)
3644   (define-key gnus-group-list-map "d" 'gnus-group-description-apropos)
3645   (define-key gnus-group-list-map "m" 'gnus-group-list-matching)
3646   (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching)
3647   (define-key gnus-group-list-map "l" 'gnus-group-list-level)
3648
3649   (define-prefix-command 'gnus-group-score-map)
3650   (define-key gnus-group-mode-map "W" 'gnus-group-score-map)
3651   (define-key gnus-group-score-map "f" 'gnus-score-flush-cache)
3652
3653   (define-prefix-command 'gnus-group-help-map)
3654   (define-key gnus-group-mode-map "H" 'gnus-group-help-map)
3655   (define-key gnus-group-help-map "f" 'gnus-group-fetch-faq)
3656
3657   (define-prefix-command 'gnus-group-sub-map)
3658   (define-key gnus-group-mode-map "S" 'gnus-group-sub-map)
3659   (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level)
3660   (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group)
3661   (define-key gnus-group-sub-map "s" 'gnus-group-unsubscribe-group)
3662   (define-key gnus-group-sub-map "k" 'gnus-group-kill-group)
3663   (define-key gnus-group-sub-map "y" 'gnus-group-yank-group)
3664   (define-key gnus-group-sub-map "w" 'gnus-group-kill-region)
3665   (define-key gnus-group-sub-map "z" 'gnus-group-kill-all-zombies))
3666
3667 (defun gnus-group-mode ()
3668   "Major mode for reading news.
3669
3670 All normal editing commands are switched off.
3671 \\<gnus-group-mode-map>
3672 The group buffer lists (some of) the groups available.  For instance,
3673 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
3674 lists all zombie groups. 
3675
3676 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe 
3677 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. 
3678
3679 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). 
3680
3681 The following commands are available:
3682
3683 \\{gnus-group-mode-map}"
3684   (interactive)
3685   (when (and menu-bar-mode
3686              (gnus-visual-p 'group-menu 'menu))
3687     (gnus-group-make-menu-bar))
3688   (kill-all-local-variables)
3689   (gnus-simplify-mode-line)
3690   (setq major-mode 'gnus-group-mode)
3691   (setq mode-name "Group")
3692   (gnus-group-set-mode-line)
3693   (setq mode-line-process nil)
3694   (use-local-map gnus-group-mode-map)
3695   (buffer-disable-undo (current-buffer))
3696   (setq truncate-lines t)
3697   (setq buffer-read-only t)
3698   (run-hooks 'gnus-group-mode-hook))
3699
3700 (defun gnus-mouse-pick-group (e)
3701   "Enter the group under the mouse pointer."
3702   (interactive "e")
3703   (mouse-set-point e)
3704   (gnus-group-read-group nil))
3705
3706 ;; Look at LEVEL and find out what the level is really supposed to be.
3707 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
3708 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
3709 (defun gnus-group-default-level (&optional level number-or-nil)
3710   (cond  
3711    (gnus-group-use-permanent-levels
3712     (setq gnus-group-default-list-level 
3713           (or level gnus-group-default-list-level))
3714     (or gnus-group-default-list-level gnus-level-subscribed))
3715    (number-or-nil
3716     level)
3717    (t
3718     (or level gnus-group-default-list-level gnus-level-subscribed))))
3719   
3720 ;;;###autoload
3721 (defun gnus-slave-no-server (&optional arg)
3722   "Read network news as a slave, without connecting to local server"
3723   (interactive "P")
3724   (gnus-no-server arg t))
3725
3726 ;;;###autoload
3727 (defun gnus-no-server (&optional arg slave)
3728   "Read network news.
3729 If ARG is a positive number, Gnus will use that as the
3730 startup level.  If ARG is nil, Gnus will be started at level 2. 
3731 If ARG is non-nil and not a positive number, Gnus will
3732 prompt the user for the name of an NNTP server to use.
3733 As opposed to `gnus', this command will not connect to the local server."
3734   (interactive "P")
3735   (make-local-variable 'gnus-group-use-permanent-levels)
3736   (setq gnus-group-use-permanent-levels t)
3737   (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
3738
3739 ;;;###autoload
3740 (defun gnus-slave (&optional arg)
3741   "Read news as a slave."
3742   (interactive "P")
3743   (gnus arg nil 'slave))
3744
3745 ;;;###autoload
3746 (defun gnus (&optional arg dont-connect slave)
3747   "Read network news.
3748 If ARG is non-nil and a positive number, Gnus will use that as the
3749 startup level.  If ARG is non-nil and not a positive number, Gnus will
3750 prompt the user for the name of an NNTP server to use."
3751   (interactive "P")
3752   (if (get-buffer gnus-group-buffer)
3753       (progn
3754         (switch-to-buffer gnus-group-buffer)
3755         (gnus-group-get-new-news))
3756
3757     (gnus-clear-system)
3758     (nnheader-init-server-buffer)
3759     (gnus-read-init-file)
3760     (setq gnus-slave slave)
3761
3762     (gnus-group-setup-buffer)
3763     (let ((buffer-read-only nil))
3764       (erase-buffer)
3765       (if (not gnus-inhibit-startup-message)
3766           (progn
3767             (gnus-group-startup-message)
3768             (sit-for 0))))
3769     
3770     (let ((level (and arg (numberp arg) (> arg 0) arg))
3771           did-connect)
3772       (unwind-protect
3773           (progn
3774             (or dont-connect 
3775                 (setq did-connect
3776                       (gnus-start-news-server (and arg (not level))))))
3777         (if (and (not dont-connect) 
3778                  (not did-connect))
3779             (gnus-group-quit)
3780           (run-hooks 'gnus-startup-hook)
3781           ;; NNTP server is successfully open. 
3782
3783           ;; Find the current startup file name.
3784           (setq gnus-current-startup-file 
3785                 (gnus-make-newsrc-file gnus-startup-file))
3786
3787           ;; Read the dribble file.
3788           (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
3789
3790           (gnus-summary-make-display-table)
3791           ;; Do the actual startup.
3792           (gnus-setup-news nil level)
3793           ;; Generate the group buffer.
3794           (gnus-group-list-groups level)
3795           (gnus-configure-windows 'group)
3796           (gnus-group-set-mode-line))))))
3797
3798 (defun gnus-unload ()
3799   "Unload all Gnus features."
3800   (interactive)
3801   (or (boundp 'load-history)
3802       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
3803   (let ((history load-history)
3804         feature)
3805     (while history
3806       (and (string-match "^gnus" (car (car history)))
3807            (setq feature (cdr (assq 'provide (car history))))
3808            (unload-feature feature 'force))
3809       (setq history (cdr history)))))
3810
3811 (defun gnus-compile ()
3812   "Byte-compile the Gnus startup file.
3813 This will also compile the user-defined format specs."
3814   (interactive)
3815   (let ((file (concat (make-temp-name "/tmp/gnuss") ".el")))
3816     (save-excursion
3817       (gnus-message 7 "Compiling user file...")
3818       (nnheader-set-temp-buffer " *compile gnus*")
3819       (and (file-exists-p gnus-init-file)
3820            (insert-file gnus-init-file))
3821       (goto-char (point-max))
3822
3823       (let ((formats '(summary summary-dummy group 
3824                                summary-mode group-mode article-mode))
3825             format fs)
3826         
3827         (while formats
3828           (setq format (symbol-name (car formats))
3829                 formats (cdr formats)
3830                 fs (cons (symbol-value 
3831                           (intern (format "gnus-%s-line-format" format)))
3832                          fs))
3833           (insert "(defun gnus-" format "-line-format-spec ()\n")
3834           (insert 
3835            (prin1-to-string
3836             (symbol-value 
3837              (intern (format "gnus-%s-line-format-spec" format)))))
3838           (insert ")\n")
3839           (insert "(setq gnus-" format 
3840                   "-line-format-spec (list 'gnus-byte-code 'gnus-"
3841                   format "-line-format-spec))\n"))
3842
3843         (insert "(setq gnus-old-specs '" (prin1-to-string fs) ")\n")
3844
3845         (write-region (point-min) (point-max) file nil 'silent)
3846         (byte-compile-file file)
3847         (rename-file
3848          (concat file "c") 
3849          (concat gnus-init-file 
3850                  (if (string-match "\\.el$" gnus-init-file) "c" ".elc"))
3851          t)
3852         (when (file-exists-p file)
3853           (delete-file file))
3854         (kill-buffer (current-buffer)))
3855       (gnus-message 7 "Compiling user file...done"))))
3856
3857 (defun gnus-indent-rigidly (start end arg)
3858   "Indent rigidly using only spaces and no tabs."
3859   (save-excursion
3860     (save-restriction
3861       (narrow-to-region start end)
3862       (indent-rigidly start end arg)
3863       (goto-char (point-min))
3864       (while (search-forward "\t" nil t)
3865         (replace-match "        " t t)))))
3866
3867 (defun gnus-group-startup-message (&optional x y)
3868   "Insert startup message in current buffer."
3869   ;; Insert the message.
3870   (erase-buffer)
3871   (insert
3872    (format "              %s
3873           _    ___ _             _      
3874           _ ___ __ ___  __    _ ___     
3875           __   _     ___    __  ___     
3876               _           ___     _     
3877              _  _ __             _      
3878              ___   __            _      
3879                    __           _       
3880                     _      _   _        
3881                    _      _    _        
3882                       _  _    _         
3883                   __  ___               
3884                  _   _ _     _          
3885                 _   _                   
3886               _    _                    
3887              _    _                     
3888             _                         
3889           __                             
3890
3891
3892            ""))
3893   ;; And then hack it.
3894   (gnus-indent-rigidly (point-min) (point-max) 
3895                        (/ (max (- (window-width) (or x 46)) 0) 2))
3896   (goto-char (point-min))
3897   (forward-line 1)
3898   (let* ((pheight (count-lines (point-min) (point-max)))
3899          (wheight (window-height))
3900          (rest (- wheight pheight)))
3901     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
3902   ;; Fontify some.
3903   (goto-char (point-min))
3904   (and (search-forward "Praxis" nil t)
3905        (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
3906   (goto-char (point-min))
3907   (let* ((mode-string (gnus-group-set-mode-line)))
3908     (setq mode-line-buffer-identification 
3909           (concat gnus-version (substring mode-string 4)))
3910     (set-buffer-modified-p t)))
3911
3912 (defun gnus-group-startup-message-old (&optional x y)
3913   "Insert startup message in current buffer."
3914   ;; Insert the message.
3915   (erase-buffer)
3916   (insert
3917    (format "
3918      %s
3919            A newsreader 
3920       for GNU Emacs
3921
3922         Based on GNUS 
3923              written by 
3924      Masanobu UMEDA
3925
3926        A Praxis Release
3927       larsi@ifi.uio.no
3928
3929            gnus-version))
3930   ;; And then hack it.
3931   ;; 18 is the longest line.
3932   (indent-rigidly (point-min) (point-max) 
3933                   (/ (max (- (window-width) (or x 28)) 0) 2))
3934   (goto-char (point-min))
3935   ;; +4 is fuzzy factor.
3936   (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))
3937
3938   ;; Fontify some.
3939   (goto-char (point-min))
3940   (search-forward "Praxis")
3941   (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
3942   (goto-char (point-min)))
3943
3944 (defun gnus-group-setup-buffer ()
3945   (or (get-buffer gnus-group-buffer)
3946       (progn
3947         (switch-to-buffer gnus-group-buffer)
3948         (gnus-add-current-to-buffer-list)
3949         (gnus-group-mode)
3950         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
3951
3952 (defun gnus-group-list-groups (&optional level unread lowest)
3953   "List newsgroups with level LEVEL or lower that have unread articles.
3954 Default is all subscribed groups.
3955 If argument UNREAD is non-nil, groups with no unread articles are also
3956 listed." 
3957   (interactive (list (if current-prefix-arg
3958                          (prefix-numeric-value current-prefix-arg)
3959                        (or
3960                         (gnus-group-default-level nil t)
3961                         gnus-group-default-list-level
3962                         gnus-level-subscribed))))
3963   (or level
3964       (setq level (car gnus-group-list-mode)
3965             unread (cdr gnus-group-list-mode)))
3966   (setq level (gnus-group-default-level level))
3967   (gnus-group-setup-buffer)             ;May call from out of group buffer
3968   (gnus-update-format-specifications)
3969   (let ((case-fold-search nil)
3970         (group (gnus-group-group-name)))
3971     (funcall gnus-group-prepare-function level unread lowest)
3972     (if (zerop (buffer-size))
3973         (gnus-message 5 gnus-no-groups-message)
3974       (goto-char (point-min))
3975       (if (not group)
3976           ;; Go to the first group with unread articles.
3977           (gnus-group-search-forward nil nil nil t)
3978         ;; Find the right group to put point on.  If the current group
3979         ;; has disapeared in the new listing, try to find the next
3980         ;; one.  If no next one can be found, just leave point at the
3981         ;; first newsgroup in the buffer.
3982         (if (not (gnus-goto-char
3983                   (text-property-any
3984                    (point-min) (point-max) 
3985                    'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
3986             (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
3987               (while (and newsrc
3988                           (not (gnus-goto-char 
3989                                 (text-property-any 
3990                                  (point-min) (point-max) 'gnus-group 
3991                                  (gnus-intern-safe 
3992                                   (car (car newsrc)) gnus-active-hashtb)))))
3993                 (setq newsrc (cdr newsrc)))
3994               (or newsrc (progn (goto-char (point-max))
3995                                 (forward-line -1))))))
3996       ;; Adjust cursor point.
3997       (gnus-group-position-point))))
3998
3999 (defun gnus-group-list-level (level &optional all)
4000   "List groups on LEVEL.
4001 If ALL (the prefix), also list groups that have no unread articles."
4002   (interactive "nList groups on level: \nP")
4003   (gnus-group-list-groups level all level))
4004
4005 (defun gnus-group-prepare-flat (level &optional all lowest regexp) 
4006   "List all newsgroups with unread articles of level LEVEL or lower.
4007 If ALL is non-nil, list groups that have no unread articles.
4008 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4009 If REGEXP, only list groups matching REGEXP."
4010   (set-buffer gnus-group-buffer)
4011   (setq gnus-topic-indentation "")
4012   (let ((buffer-read-only nil)
4013         (newsrc (cdr gnus-newsrc-alist))
4014         (lowest (or lowest 1))
4015         info clevel unread group params)
4016     (erase-buffer)
4017     (if (< lowest gnus-level-zombie)
4018         ;; List living groups.
4019         (while newsrc
4020           (setq info (car newsrc)
4021                 group (gnus-info-group info)
4022                 params (gnus-info-params info)
4023                 newsrc (cdr newsrc)
4024                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4025           (and unread                   ; This group might be bogus
4026                (or (not regexp)
4027                    (string-match regexp group))
4028                (<= (setq clevel (gnus-info-level info)) level) 
4029                (>= clevel lowest)
4030                (or all                  ; We list all groups?
4031                    (eq unread t)        ; We list unactivated groups
4032                    (> unread 0)         ; We list groups with unread articles
4033                    (cdr (assq 'tick (gnus-info-marks info)))
4034                                         ; And groups with tickeds
4035                    ;; Check for permanent visibility.
4036                    (and gnus-permanently-visible-groups
4037                         (string-match gnus-permanently-visible-groups
4038                                       group))
4039                    (memq 'visible params)
4040                    (cdr (assq 'visible params)))
4041                (gnus-group-insert-group-line 
4042                 group (gnus-info-level info) 
4043                 (gnus-info-marks info) unread (gnus-info-method info)))))
4044       
4045     ;; List dead groups.
4046     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4047          (gnus-group-prepare-flat-list-dead 
4048           (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 
4049           gnus-level-zombie ?Z
4050           regexp))
4051     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4052          (gnus-group-prepare-flat-list-dead 
4053           (setq gnus-killed-list (sort gnus-killed-list 'string<)) 
4054           gnus-level-killed ?K regexp))
4055
4056     (gnus-group-set-mode-line)
4057     (setq gnus-group-list-mode (cons level all))
4058     (run-hooks 'gnus-group-prepare-hook)))
4059
4060 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4061   ;; List zombies and killed lists somehwat faster, which was
4062   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4063   ;; this by ignoring the group format specification altogether.
4064   (let (group beg)
4065     (if regexp
4066         ;; This loop is used when listing groups that match some
4067         ;; regexp. 
4068         (while groups
4069           (setq group (pop groups))
4070           (when (string-match regexp group)
4071             (add-text-properties 
4072              (point) (prog1 (1+ (point))
4073                        (insert " " mark "     *: " group "\n"))
4074              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4075                    'gnus-unread t
4076                    'gnus-level level))))
4077       ;; This loop is used when listing all groups.
4078       (while groups
4079         (add-text-properties 
4080          (point) (prog1 (1+ (point))
4081                    (insert " " mark "     *: " 
4082                            (setq group (pop groups)) "\n"))
4083          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4084                'gnus-unread t
4085                'gnus-level level))))))
4086
4087 (defmacro gnus-group-real-name (group)
4088   "Find the real name of a foreign newsgroup."
4089   `(let ((gname ,group))
4090      (if (string-match ":[^:]+$" gname)
4091          (substring gname (1+ (match-beginning 0)))
4092        gname)))
4093
4094 (defsubst gnus-server-add-address (method)
4095   (let ((method-name (symbol-name (car method))))
4096     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4097              (not (assq (intern (concat method-name "-address")) method)))
4098         (append method (list (list (intern (concat method-name "-address"))
4099                                    (nth 1 method))))
4100       method)))
4101
4102 (defsubst gnus-server-get-method (group method)
4103   ;; Input either a server name, and extended server name, or a
4104   ;; select method, and return a select method. 
4105   (cond ((stringp method)
4106          (gnus-server-to-method method))
4107         ((and (stringp (car method)) group)
4108          (gnus-server-extend-method group method))
4109         (t
4110          (gnus-server-add-address method))))
4111
4112 (defun gnus-server-to-method (server)
4113   "Map virtual server names to select methods."
4114   (or (and (equal server "native") gnus-select-method)
4115       (cdr (assoc server gnus-server-alist))))
4116
4117 (defun gnus-group-prefixed-name (group method)
4118   "Return the whole name from GROUP and METHOD."
4119   (and (stringp method) (setq method (gnus-server-to-method method)))
4120   (concat (format "%s" (car method))
4121           (if (and 
4122                (assoc (format "%s" (car method)) (gnus-methods-using 'address))
4123                (not (string= (nth 1 method) "")))
4124               (concat "+" (nth 1 method)))
4125           ":" group))
4126
4127 (defun gnus-group-real-prefix (group)
4128   "Return the prefix of the current group name."
4129   (if (string-match "^[^:]+:" group)
4130       (substring group 0 (match-end 0))
4131     ""))
4132
4133 (defun gnus-group-method-name (group)
4134   "Return the method used for selecting GROUP."
4135   (let ((prefix (gnus-group-real-prefix group)))
4136     (if (equal prefix "")
4137         gnus-select-method
4138       (if (string-match "^[^\\+]+\\+" prefix)
4139           (list (intern (substring prefix 0 (1- (match-end 0))))
4140                 (substring prefix (match-end 0) (1- (length prefix))))
4141         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
4142
4143 (defsubst gnus-secondary-method-p (method)
4144   "Return whether METHOD is a secondary select method."
4145   (let ((methods gnus-secondary-select-methods)
4146         (gmethod (gnus-server-get-method nil method)))
4147     (while (and methods
4148                 (not (equal (gnus-server-get-method nil (car methods)) 
4149                             gmethod)))
4150       (setq methods (cdr methods)))
4151     methods))
4152
4153 (defun gnus-group-foreign-p (group)
4154   "Say whether a group is foreign or not."
4155   (and (not (gnus-group-native-p group))
4156        (not (gnus-group-secondary-p group))))
4157
4158 (defun gnus-group-native-p (group)
4159   "Say whether the group is native or not."
4160   (not (string-match ":" group)))
4161
4162 (defun gnus-group-secondary-p (group)
4163   "Say whether the group is secondary or not."
4164   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4165
4166 (defun gnus-group-get-parameter (group &optional symbol)
4167   "Returns the group parameters for GROUP.
4168 If SYMBOL, return the value of that symbol in the group parameters."
4169   (let ((params (gnus-info-params (gnus-get-info group))))
4170     (if symbol
4171         (gnus-group-parameter-value params symbol)
4172       params)))
4173
4174 (defun gnus-group-parameter-value (params symbol)
4175   "Return the value of SYMBOL in group PARAMS."
4176   (or (car (memq symbol params))        ; It's either a simple symbol
4177       (cdr (assq symbol params))))      ; or a cons.
4178
4179 (defun gnus-group-add-parameter (group param)
4180   "Add parameter PARAM to GROUP."
4181   (let ((info (gnus-get-info group)))
4182     (if (not info)
4183         () ; This is a dead group.  We just ignore it.
4184       ;; Cons the new param to the old one and update.
4185       (gnus-group-set-info (cons param (gnus-info-params info)) 
4186                            group 'params))))
4187
4188 (defun gnus-group-add-score (group &optional score)
4189   "Add SCORE to the GROUP score.  
4190 If SCORE is nil, add 1 to the score of GROUP."
4191   (let ((info (gnus-get-info group)))
4192     (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
4193
4194 (defun gnus-summary-bubble-group ()
4195   "Increase the score of the current group.
4196 This is a handy function to add to `gnus-summary-exit-hook' to
4197 increase the score of each group you read."
4198   (gnus-group-add-score gnus-newsgroup-name))
4199
4200 (defun gnus-group-set-info (info &optional method-only-group part)
4201   (let* ((entry (gnus-gethash
4202                  (or method-only-group (gnus-info-group info))
4203                  gnus-newsrc-hashtb))
4204          (part-info info)
4205          (info (if method-only-group (nth 2 entry) info)))
4206     (when method-only-group
4207       (unless entry
4208         (error "Trying to change non-existent group %s" method-only-group))
4209       ;; We have recevied parts of the actual group info - either the
4210       ;; select method or the group parameters.  We first check
4211       ;; whether we have to extend the info, and if so, do that.
4212       (let ((len (length info))
4213             (total (if (eq part 'method) 5 6)))
4214         (when (< len total)
4215           (setcdr (nthcdr (1- len) info)
4216                   (make-list (- total len) nil)))
4217         ;; Then we enter the new info.
4218         (setcar (nthcdr (1- total) info) part-info)))
4219     (unless entry
4220       ;; This is a new group, so we just create it.
4221       (save-excursion
4222         (set-buffer gnus-group-buffer)
4223         (if (gnus-info-method info)
4224             ;; It's a foreign group...
4225             (gnus-group-make-group 
4226              (gnus-group-real-name (gnus-info-group info))
4227              (prin1-to-string (car (gnus-info-method info)))
4228              (nth 1 (gnus-info-method info)))
4229           ;; It's a native group.
4230           (gnus-group-make-group (gnus-info-group info)))
4231         (gnus-message 6 "Note: New group created")
4232         (setq entry 
4233               (gnus-gethash (gnus-group-prefixed-name 
4234                              (gnus-group-real-name (gnus-info-group info))
4235                              (or (gnus-info-method info) gnus-select-method))
4236                             gnus-newsrc-hashtb))))
4237     ;; Whether it was a new group or not, we now have the entry, so we
4238     ;; can do the update.
4239     (if entry
4240         (progn
4241           (setcar (nthcdr 2 entry) info)
4242           (when (and (not (eq (car entry) t)) 
4243                      (gnus-active (gnus-info-group info)))
4244             (let ((marked (gnus-info-marks info)))
4245               (setcar entry (length (gnus-list-of-unread-articles 
4246                                      (car info)))))))
4247       (error "No such group: %s" (gnus-info-group info)))))
4248
4249 (defun gnus-group-set-method-info (group select-method)
4250   (gnus-group-set-info select-method group 'method))
4251
4252 (defun gnus-group-set-params-info (group params)
4253   (gnus-group-set-info params group 'params))
4254
4255 (defun gnus-group-update-group-line ()
4256   "Update the current line in the group buffer."
4257   (let* ((buffer-read-only nil)
4258          (group (gnus-group-group-name))
4259          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4260     (and entry 
4261          (not (gnus-ephemeral-group-p group))
4262          (gnus-dribble-enter 
4263           (concat "(gnus-group-set-info '" 
4264                   (prin1-to-string (nth 2 entry)) ")")))
4265     (gnus-delete-line)
4266     (gnus-group-insert-group-line-info group)
4267     (forward-line -1)
4268     (gnus-group-position-point)))
4269
4270 (defun gnus-group-insert-group-line-info (group)
4271   "Insert GROUP on the current line."
4272   (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) 
4273         active info)
4274     (if entry
4275         (progn
4276           ;; (Un)subscribed group.
4277           (setq info (nth 2 entry))
4278           (gnus-group-insert-group-line 
4279            group (gnus-info-level info) (gnus-info-marks info)
4280            (or (car entry) t) (gnus-info-method info)))
4281       ;; This group is dead.
4282       (gnus-group-insert-group-line 
4283        group 
4284        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4285        nil 
4286        (if (setq active (gnus-active group))
4287            (- (1+ (cdr active)) (car active)) 0) 
4288        nil))))
4289
4290 ;; Dummy function redefined when running under XEmacs.
4291 (defalias 'gnus-group-remove-excess-properties 'ignore)
4292
4293 (defun gnus-group-insert-group-line 
4294   (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
4295                   gnus-tmp-method)
4296   "Insert a group line in the group buffer."
4297   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4298          (gnus-tmp-number-total 
4299           (if gnus-tmp-active 
4300               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4301             0))
4302          (gnus-tmp-number-of-unread 
4303           (if (numberp number) (int-to-string (max 0 number))
4304             "*"))
4305          (gnus-tmp-number-of-read
4306           (if (numberp number)
4307               (max 0 (- gnus-tmp-number-total number))
4308             "*"))
4309          (gnus-tmp-subscribed
4310           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4311                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4312                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4313                 (t ?K)))
4314          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4315          (gnus-tmp-newsgroup-description 
4316           (if gnus-description-hashtb
4317               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4318             ""))
4319          (gnus-tmp-moderated
4320           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4321          (gnus-tmp-moderated-string 
4322           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4323          (gnus-tmp-method
4324           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4325          (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) ""))
4326          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4327          (gnus-tmp-news-method-string 
4328           (if gnus-tmp-method
4329               (format "(%s:%s)" (car gnus-tmp-method)
4330                       (car (cdr gnus-tmp-method))) ""))
4331          (gnus-tmp-marked 
4332           (if (and (numberp number) 
4333                    (zerop number)
4334                    (cdr (assq 'tick gnus-tmp-marked)))
4335               ?* ? ))
4336          (gnus-tmp-number
4337           (cond ((eq number t) "*" )
4338                 ((numberp number) (int-to-string number))
4339                 (t number)))
4340          (gnus-tmp-process-marked
4341           (if (member gnus-tmp-group gnus-group-marked)
4342               gnus-process-mark ? ))
4343          (buffer-read-only nil)
4344          header)                        ; passed as parameter to user-funcs.
4345     (beginning-of-line)
4346     (add-text-properties
4347      (point)
4348      (prog1 (1+ (point))
4349        ;; Insert the text.
4350        (eval gnus-group-line-format-spec))
4351      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4352        gnus-unread ,(if (numberp number)
4353                         (string-to-int gnus-tmp-number-of-unread)
4354                       t)
4355        gnus-marked ,gnus-tmp-marked
4356        gnus-level ,gnus-tmp-level))
4357     ;; Allow XEmacs to remove front-sticky text properties.
4358     (gnus-group-remove-excess-properties)))
4359
4360 (defun gnus-group-update-group (group &optional visible-only)
4361   "Update all lines where GROUP appear.
4362 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4363 already." 
4364   (save-excursion
4365     (set-buffer gnus-group-buffer)
4366     ;; The buffer may be narrowed.
4367     (save-restriction
4368       (widen)
4369       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4370             (loc (point-min))
4371             found buffer-read-only visible)
4372         ;; Enter the current status into the dribble buffer.
4373         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4374           (if (and entry (not (gnus-ephemeral-group-p group)))
4375               (gnus-dribble-enter 
4376                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4377                        ")"))))
4378         ;; Find all group instances.  If topics are in use, each group
4379         ;; may be listed in more than once.
4380         (while (setq loc (text-property-any 
4381                           loc (point-max) 'gnus-group ident))
4382           (setq found t)
4383           (goto-char loc)
4384           (gnus-delete-line)
4385           (gnus-group-insert-group-line-info group)
4386           (setq loc (1+ loc)))
4387         (if (or found visible-only)
4388             ()
4389           ;; No such line in the buffer, find out where it's supposed to
4390           ;; go, and insert it there (or at the end of the buffer).
4391           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
4392           (let ((entry (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
4393             (while (and entry (car entry)
4394                         (not
4395                          (gnus-goto-char
4396                           (text-property-any
4397                            (point-min) (point-max) 
4398                            'gnus-group (gnus-intern-safe 
4399                                         (car (car entry)) 
4400                                         gnus-active-hashtb)))))
4401               (setq entry (cdr entry)))
4402             (or entry (goto-char (point-max))))
4403           ;; Finally insert the line.
4404           (gnus-group-insert-group-line-info group))
4405         (gnus-group-set-mode-line)))))
4406
4407 (defun gnus-group-set-mode-line ()
4408   (when (memq 'group gnus-updated-mode-lines)
4409     (let* ((gformat (or gnus-group-mode-line-format-spec
4410                         (setq gnus-group-mode-line-format-spec
4411                               (gnus-parse-format 
4412                                gnus-group-mode-line-format 
4413                                gnus-group-mode-line-format-alist))))
4414            (gnus-tmp-news-server (car (cdr gnus-select-method)))
4415            (gnus-tmp-news-method (car gnus-select-method))
4416            (max-len 60)
4417            header                       ;Dummy binding for user-defined formats
4418            ;; Get the resulting string.
4419            (mode-string (eval gformat)))
4420       ;; If the line is too long, we chop it off.
4421       (when (> (length mode-string) max-len) 
4422         (setq mode-string (substring mode-string 0 (- max-len 4))))
4423       (prog1
4424           (setq mode-line-buffer-identification mode-string)
4425         (set-buffer-modified-p t)))))
4426
4427 (defun gnus-group-group-name ()
4428   "Get the name of the newsgroup on the current line."
4429   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4430     (and group (symbol-name group))))
4431
4432 (defun gnus-group-group-level ()
4433   "Get the level of the newsgroup on the current line."
4434   (get-text-property (gnus-point-at-bol) 'gnus-level))
4435
4436 (defun gnus-group-group-unread ()
4437   "Get the number of unread articles of the newsgroup on the current line."
4438   (get-text-property (gnus-point-at-bol) 'gnus-unread))
4439
4440 (defun gnus-group-search-forward (&optional backward all level first-too)
4441   "Find the next newsgroup with unread articles.
4442 If BACKWARD is non-nil, find the previous newsgroup instead.
4443 If ALL is non-nil, just find any newsgroup.
4444 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4445 group exists.
4446 If FIRST-TOO, the current line is also eligible as a target."
4447   (let ((way (if backward -1 1))
4448         (low gnus-level-killed)
4449         (beg (point))
4450         pos found lev)
4451     (if (and backward (progn (beginning-of-line)) (bobp))
4452         nil
4453       (or first-too (forward-line way))
4454       (while (and 
4455               (not (eobp))
4456               (not (setq 
4457                     found 
4458                     (and (or all
4459                              (and
4460                               (let ((unread 
4461                                      (get-text-property (point) 'gnus-unread)))
4462                                 (and (numberp unread) (> unread 0)))
4463                               (setq lev (get-text-property (point)
4464                                                            'gnus-level))
4465                               (<= lev gnus-level-subscribed)))
4466                          (or (not level)
4467                              (and (setq lev (get-text-property (point)
4468                                                                'gnus-level))
4469                                   (or (= lev level)
4470                                       (and (< lev low)
4471                                            (< level lev)
4472                                            (progn
4473                                              (setq low lev)
4474                                              (setq pos (point))
4475                                              nil))))))))
4476               (zerop (forward-line way)))))
4477     (if found 
4478         (progn (gnus-group-position-point) t)
4479       (goto-char (or pos beg))
4480       (and pos t))))
4481
4482 ;;; Gnus group mode commands
4483
4484 ;; Group marking.
4485
4486 (defun gnus-group-mark-group (n &optional unmark no-advance)
4487   "Mark the current group."
4488   (interactive "p")
4489   (let ((buffer-read-only nil)
4490         group)
4491     (while 
4492         (and (> n 0) 
4493              (setq group (gnus-group-group-name))
4494              (progn
4495                (beginning-of-line)
4496                (forward-char 
4497                 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
4498                (delete-char 1)
4499                (if unmark
4500                    (progn
4501                      (insert " ")
4502                      (setq gnus-group-marked (delete group gnus-group-marked)))
4503                  (insert "#")
4504                  (setq gnus-group-marked
4505                        (cons group (delete group gnus-group-marked))))
4506                t)
4507              (or no-advance (zerop (gnus-group-next-group 1))))
4508       (setq n (1- n)))
4509     (gnus-summary-position-point)
4510     n))
4511
4512 (defun gnus-group-unmark-group (n)
4513   "Remove the mark from the current group."
4514   (interactive "p")
4515   (gnus-group-mark-group n 'unmark))
4516
4517 (defun gnus-group-mark-region (unmark beg end)
4518   "Mark all groups between point and mark.
4519 If UNMARK, remove the mark instead."
4520   (interactive "P\nr")
4521   (let ((num (count-lines beg end)))
4522     (save-excursion
4523       (goto-char beg)
4524       (- num (gnus-group-mark-group num unmark)))))
4525
4526 (defun gnus-group-mark-regexp (regexp)
4527   "Mark all groups that match some regexp."
4528   (interactive "sMark (regexp): ")
4529   (let ((alist (cdr gnus-newsrc-alist))
4530         group)
4531     (while alist
4532       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
4533         (gnus-group-set-mark group)))))
4534
4535 (defun gnus-group-remove-mark (group)
4536   (if (gnus-group-goto-group group)
4537       (save-excursion
4538         (gnus-group-mark-group 1 'unmark t))
4539     (setq gnus-group-marked
4540           (cons group (delete group gnus-group-marked)))))
4541                 
4542 (defun gnus-group-set-mark (group)
4543   (if (gnus-group-goto-group group)
4544       (save-excursion
4545         (gnus-group-mark-group 1 nil t))
4546     (setq gnus-group-marked
4547           (cons group (delete group gnus-group-marked)))))
4548                 
4549 ;; Return a list of groups to work on.  Take into consideration N (the
4550 ;; prefix) and the list of marked groups.
4551 (defun gnus-group-process-prefix (n)
4552   (cond
4553    (n
4554     (setq n (prefix-numeric-value n))
4555     ;; There is a prefix, so we return a list of the N next
4556     ;; groups. 
4557     (let ((way (if (< n 0) -1 1))
4558           (n (abs n))
4559           group groups)
4560       (save-excursion
4561         (while (and (> n 0)
4562                     (setq group (gnus-group-group-name)))
4563           (setq groups (cons group groups))
4564           (setq n (1- n))
4565           (gnus-group-next-group way)))
4566       (nreverse groups)))
4567    ((and (boundp 'transient-mark-mode)
4568          transient-mark-mode
4569          mark-active)
4570     ;; Work on the region between point and mark.
4571     (let ((max (max (point) (mark)))
4572           groups)
4573       (save-excursion
4574         (goto-char (min (point) (mark)))
4575         (while 
4576             (and 
4577              (push (gnus-group-group-name) groups)
4578              (zerop (gnus-group-next-group 1))
4579              (< (point) max)))
4580         (nreverse groups))))
4581    (gnus-group-marked
4582     ;; No prefix, but a list of marked articles.
4583     (reverse gnus-group-marked))
4584    (t
4585     ;; Neither marked articles or a prefix, so we return the
4586     ;; current group.
4587     (let ((group (gnus-group-group-name)))
4588       (and group (list group))))))
4589
4590 ;; Selecting groups.
4591
4592 (defun gnus-group-read-group (&optional all no-article group)
4593   "Read news in this newsgroup.
4594 If the prefix argument ALL is non-nil, already read articles become
4595 readable.  IF ALL is a number, fetch this number of articles.  If the
4596 optional argument NO-ARTICLE is non-nil, no article will be
4597 auto-selected upon group entry.  If GROUP is non-nil, fetch that
4598 group."
4599   (interactive "P")
4600   (let ((group (or group (gnus-group-group-name)))
4601         number active marked entry)
4602     (or group (error "No group on current line"))
4603     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
4604                                             group gnus-newsrc-hashtb)))))
4605     ;; This group might be a dead group.  In that case we have to get
4606     ;; the number of unread articles from `gnus-active-hashtb'.
4607     (setq number
4608           (cond ((numberp all) all)
4609                 (entry (car entry))
4610                 ((setq active (gnus-active group))
4611                  (- (1+ (cdr active)) (car active)))))
4612     (gnus-summary-read-group 
4613      group (or all (and (numberp number) 
4614                         (zerop (+ number (length (cdr (assq 'tick marked)))
4615                                   (length (cdr (assq 'dormant marked)))))))
4616      no-article)))
4617
4618 (defun gnus-group-select-group (&optional all)
4619   "Select this newsgroup.
4620 No article is selected automatically.
4621 If ALL is non-nil, already read articles become readable.
4622 If ALL is a number, fetch this number of articles."
4623   (interactive "P")
4624   (gnus-group-read-group all t))
4625
4626 (defun gnus-group-quick-select-group (&optional all)
4627   "Select the current group \"quickly\". 
4628 This means that no highlighting or scoring will be performed."
4629   (interactive "P")
4630   (let (gnus-visual
4631         gnus-score-find-score-files-function
4632         gnus-apply-kill-hook
4633         gnus-summary-expunge-below)
4634     (gnus-group-read-group all t)))
4635
4636 ;;;###autoload
4637 (defun gnus-fetch-group (group)
4638   "Start Gnus if necessary and enter GROUP.
4639 Returns whether the fetching was successful or not."
4640   (interactive "sGroup name: ")
4641   (or (get-buffer gnus-group-buffer)
4642       (gnus))
4643   (gnus-group-select-group))
4644
4645 ;; Enter a group that is not in the group buffer.  Non-nil is returned
4646 ;; if selection was successful.
4647 (defun gnus-group-read-ephemeral-group 
4648   (group method &optional activate quit-config)
4649   (let ((group (if (gnus-group-foreign-p group) group
4650                  (gnus-group-prefixed-name group method)))
4651         (cur (current-buffer)))
4652     (gnus-sethash 
4653      group
4654      (list t nil (list group gnus-level-default-subscribed nil nil 
4655                        (append method
4656                                (list
4657                                 (list 'quit-config 
4658                                       (if quit-config quit-config
4659                                         (cons (current-buffer) 'summary)))))))
4660      gnus-newsrc-hashtb)
4661     (set-buffer gnus-group-buffer)
4662     (or (gnus-check-server method)
4663         (error "Unable to contact server: %s" (gnus-status-message method)))
4664     (if activate (or (gnus-request-group group)
4665                      (error "Couldn't request group")))
4666     (condition-case ()
4667         (gnus-group-read-group t t group)
4668       (error nil)
4669       (quit nil))
4670 ;    (debug (current-buffer))
4671     (not (equal (current-buffer) cur))))
4672   
4673 (defun gnus-group-jump-to-group (group)
4674   "Jump to newsgroup GROUP."
4675   (interactive 
4676    (list (completing-read 
4677           "Group: " gnus-active-hashtb nil 
4678           (memq gnus-select-method gnus-have-read-active-file))))
4679
4680   (if (equal group "")
4681       (error "Empty group name"))
4682
4683   (let ((b (text-property-any 
4684             (point-min) (point-max) 
4685             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4686     (if b
4687         ;; Either go to the line in the group buffer...
4688         (goto-char b)
4689       ;; ... or insert the line.
4690       (or
4691        (gnus-active group)
4692        (gnus-activate-group group)
4693        (error "%s error: %s" group (gnus-status-message group)))
4694
4695       (gnus-group-update-group group)
4696       (goto-char (text-property-any 
4697                   (point-min) (point-max)
4698                   'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
4699   ;; Adjust cursor point.
4700   (gnus-group-position-point))
4701
4702 (defun gnus-group-goto-group (group)
4703   "Goto to newsgroup GROUP."
4704   (when group
4705     (let ((b (text-property-any (point-min) (point-max) 
4706                                 'gnus-group (gnus-intern-safe
4707                                              group gnus-active-hashtb))))
4708       (and b (goto-char b)))))
4709
4710 (defun gnus-group-next-group (n)
4711   "Go to next N'th newsgroup.
4712 If N is negative, search backward instead.
4713 Returns the difference between N and the number of skips actually
4714 done."
4715   (interactive "p")
4716   (gnus-group-next-unread-group n t))
4717
4718 (defun gnus-group-next-unread-group (n &optional all level)
4719   "Go to next N'th unread newsgroup.
4720 If N is negative, search backward instead.
4721 If ALL is non-nil, choose any newsgroup, unread or not.
4722 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
4723 such group can be found, the next group with a level higher than
4724 LEVEL.
4725 Returns the difference between N and the number of skips actually
4726 made."
4727   (interactive "p")
4728   (let ((backward (< n 0))
4729         (n (abs n)))
4730     (while (and (> n 0)
4731                 (gnus-group-search-forward 
4732                  backward (or (not gnus-group-goto-unread) all) level))
4733       (setq n (1- n)))
4734     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
4735                                (if level " on this level or higher" "")))
4736     n))
4737
4738 (defun gnus-group-prev-group (n)
4739   "Go to previous N'th newsgroup.
4740 Returns the difference between N and the number of skips actually
4741 done."
4742   (interactive "p")
4743   (gnus-group-next-unread-group (- n) t))
4744
4745 (defun gnus-group-prev-unread-group (n)
4746   "Go to previous N'th unread newsgroup.
4747 Returns the difference between N and the number of skips actually
4748 done."  
4749   (interactive "p")
4750   (gnus-group-next-unread-group (- n)))
4751
4752 (defun gnus-group-next-unread-group-same-level (n)
4753   "Go to next N'th unread newsgroup on the same level.
4754 If N is negative, search backward instead.
4755 Returns the difference between N and the number of skips actually
4756 done."
4757   (interactive "p")
4758   (gnus-group-next-unread-group n t (gnus-group-group-level))
4759   (gnus-group-position-point))
4760
4761 (defun gnus-group-prev-unread-group-same-level (n)
4762   "Go to next N'th unread newsgroup on the same level.
4763 Returns the difference between N and the number of skips actually
4764 done."
4765   (interactive "p")
4766   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
4767   (gnus-group-position-point))
4768
4769 (defun gnus-group-best-unread-group (&optional exclude-group)
4770   "Go to the group with the highest level.
4771 If EXCLUDE-GROUP, do not go to that group."
4772   (interactive)
4773   (goto-char (point-min))
4774   (let ((best 100000)
4775         unread best-point)
4776     (while (setq unread (get-text-property (point) 'gnus-unread))
4777       (if (and (numberp unread) (> unread 0))
4778           (progn
4779             (if (and (< (get-text-property (point) 'gnus-level) best)
4780                      (or (not exclude-group)
4781                          (not (equal exclude-group (gnus-group-group-name)))))
4782                 (progn 
4783                   (setq best (get-text-property (point) 'gnus-level))
4784                   (setq best-point (point))))))
4785       (forward-line 1))
4786     (if best-point (goto-char best-point))
4787     (gnus-summary-position-point)
4788     (and best-point (gnus-group-group-name))))
4789
4790 (defun gnus-group-first-unread-group ()
4791   "Go to the first group with unread articles."
4792   (interactive)
4793   (prog1
4794       (let ((opoint (point))
4795             unread)
4796         (goto-char (point-min))
4797         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
4798                 (and (numberp unread)   ; Not a topic.
4799                      (not (zerop unread))) ; Has unread articles.
4800                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
4801             (point)                     ; Success.
4802           (goto-char opoint)
4803           nil))                         ; Not success.
4804     (gnus-group-position-point)))
4805
4806 (defun gnus-group-enter-server-mode ()
4807   "Jump to the server buffer."
4808   (interactive)
4809   (gnus-enter-server-buffer))
4810
4811 (defun gnus-group-make-group (name &optional method address)
4812   "Add a new newsgroup.
4813 The user will be prompted for a NAME, for a select METHOD, and an
4814 ADDRESS."
4815   (interactive
4816    (cons 
4817     (read-string "Group name: ")
4818     (let ((method
4819            (completing-read 
4820             "Method: " (append gnus-valid-select-methods gnus-server-alist)
4821             nil t)))
4822       (if (assoc method gnus-valid-select-methods)
4823           (list method
4824                 (if (memq 'prompt-address
4825                           (assoc method gnus-valid-select-methods))
4826                     (read-string "Address: ")
4827                   ""))
4828         (list method nil)))))
4829   
4830   (save-excursion
4831     (set-buffer gnus-group-buffer)
4832     (let* ((meth (and method (if address (list (intern method) address) 
4833                                method)))
4834            (nname (if method (gnus-group-prefixed-name name meth) name))
4835            info)
4836       (and (gnus-gethash nname gnus-newsrc-hashtb)
4837            (error "Group %s already exists" nname))
4838       (gnus-group-change-level 
4839        (setq info (list t nname gnus-level-default-subscribed nil nil meth))
4840        gnus-level-default-subscribed gnus-level-killed 
4841        (and (gnus-group-group-name)
4842             (gnus-gethash (gnus-group-group-name)
4843                           gnus-newsrc-hashtb))
4844        t)
4845       (gnus-set-active nname (cons 1 0))
4846       (or (gnus-ephemeral-group-p name)
4847           (gnus-dribble-enter 
4848            (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
4849       (gnus-group-insert-group-line-info nname)
4850
4851       (if (assoc method gnus-valid-select-methods)
4852           (require (intern method)))
4853       (and (gnus-check-backend-function 'request-create-group nname)
4854            (gnus-request-create-group nname))
4855       t)))
4856
4857 (defun gnus-group-delete-group (group &optional force)
4858   "Delete the current group.
4859 If FORCE (the prefix) is non-nil, all the articles in the group will
4860 be deleted.  This is \"deleted\" as in \"removed forever from the face
4861 of the Earth\".  There is no undo."
4862   (interactive 
4863    (list (gnus-group-group-name)
4864          current-prefix-arg))
4865   (or group (error "No group to rename"))
4866   (or (gnus-check-backend-function 'request-delete-group group)
4867       (error "This backend does not support group deletion"))
4868   (prog1
4869       (if (not (gnus-yes-or-no-p
4870                 (format
4871                  "Do you really want to delete %s%s? " 
4872                  group (if force " and all its contents" ""))))
4873           () ; Whew!
4874         (gnus-message 6 "Deleting group %s..." group)
4875         (if (not (gnus-request-delete-group group force))
4876             (progn
4877               (gnus-message 3 "Couldn't delete group %s" group)
4878               (ding))
4879           (gnus-message 6 "Deleting group %s...done" group)
4880           (gnus-group-goto-group group)
4881           (gnus-group-kill-group 1 t)
4882           t))
4883     (gnus-group-position-point)))
4884
4885 (defun gnus-group-rename-group (group new-name)
4886   (interactive
4887    (list
4888     (gnus-group-group-name)
4889     (progn
4890       (or (gnus-check-backend-function 
4891            'request-rename-group (gnus-group-group-name))
4892           (error "This backend does not support renaming groups"))
4893       (read-string "New group name: "))))
4894
4895   (or (gnus-check-backend-function 'request-rename-group group)
4896       (error "This backend does not support renaming groups"))
4897
4898   (or group (error "No group to rename"))
4899   (and (string-match "^[ \t]*$" new-name) 
4900        (error "Not a valid group name"))
4901
4902   ;; We find the proper prefixed name.
4903   (setq new-name
4904         (gnus-group-prefixed-name 
4905          (gnus-group-real-name new-name)
4906          (gnus-info-method (gnus-get-info group))))
4907
4908   (gnus-message 6 "Renaming group %s to %s..." group new-name)
4909   (prog1
4910       (if (not (gnus-request-rename-group group new-name))
4911           (progn
4912             (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
4913             (ding))
4914         ;; We rename the group internally by killing it...
4915         (gnus-group-goto-group group)
4916         (gnus-group-kill-group)
4917         ;; ... changing its name ...
4918         (setcar (cdr (car gnus-list-of-killed-groups))
4919                 new-name)
4920         ;; ... and then yanking it.  Magic!
4921         (gnus-group-yank-group) 
4922         (gnus-set-active new-name (gnus-active group))
4923         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
4924         new-name)
4925     (gnus-group-position-point)))
4926
4927
4928 (defun gnus-group-edit-group (group &optional part)
4929   "Edit the group on the current line."
4930   (interactive (list (gnus-group-group-name)))
4931   (let ((done-func '(lambda () 
4932                       "Exit editing mode and update the information."
4933                       (interactive)
4934                       (gnus-group-edit-group-done 'part 'group)))
4935         (part (or part 'info))
4936         (winconf (current-window-configuration))
4937         info)
4938     (or group (error "No group on current line"))
4939     (or (setq info (gnus-get-info group))
4940         (error "Killed group; can't be edited"))
4941     (set-buffer (get-buffer-create gnus-group-edit-buffer))
4942     (gnus-configure-windows 'edit-group)
4943     (gnus-add-current-to-buffer-list)
4944     (emacs-lisp-mode)
4945     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
4946     (use-local-map (copy-keymap emacs-lisp-mode-map))
4947     (local-set-key "\C-c\C-c" done-func)
4948     (make-local-variable 'gnus-prev-winconf)
4949     (setq gnus-prev-winconf winconf)
4950     ;; We modify the func to let it know what part it is editing.
4951     (setcar (cdr (nth 4 done-func)) (list 'quote part))
4952     (setcar (cdr (cdr (nth 4 done-func))) group)
4953     (erase-buffer)
4954     (insert
4955      (cond 
4956       ((eq part 'method)
4957        ";; Type `C-c C-c' after editing the select method.\n\n")
4958       ((eq part 'params)
4959        ";; Type `C-c C-c' after editing the group parameters.\n\n")
4960       ((eq part 'info)
4961        ";; Type `C-c C-c' after editing the group info.\n\n")))
4962     (insert 
4963      (pp-to-string
4964       (cond ((eq part 'method)
4965              (or (gnus-info-method info) "native"))
4966             ((eq part 'params)
4967              (gnus-info-params info))
4968             (t info)))
4969      "\n")))
4970
4971 (defun gnus-group-edit-group-method (group)
4972   "Edit the select method of GROUP."
4973   (interactive (list (gnus-group-group-name)))
4974   (gnus-group-edit-group group 'method))
4975
4976 (defun gnus-group-edit-group-parameters (group)
4977   "Edit the group parameters of GROUP."
4978   (interactive (list (gnus-group-group-name)))
4979   (gnus-group-edit-group group 'params))
4980
4981 (defun gnus-group-edit-group-done (part group)
4982   "Get info from buffer, update variables and jump to the group buffer."
4983   (set-buffer (get-buffer-create gnus-group-edit-buffer))
4984   (goto-char (point-min))
4985   (let* ((form (read (current-buffer)))
4986          (winconf gnus-prev-winconf)
4987          (new-group (when (eq part 'info)
4988                       (if (or (not (nth 4 form))
4989                               (gnus-server-equal
4990                                gnus-select-method (nth 4 form)))
4991                           (gnus-group-real-name (car form))
4992                         (gnus-group-prefixed-name
4993                          (gnus-group-real-name (car form)) (nth 4 form))))))
4994     ;; Set the info.
4995     (if (eq part 'info) 
4996         (progn
4997           (when new-group (setcar form new-group))
4998           (gnus-group-set-info form))
4999       (gnus-group-set-info form group part))
5000     (kill-buffer (current-buffer))
5001     (and winconf (set-window-configuration winconf))
5002     (set-buffer gnus-group-buffer)
5003     (when (and new-group 
5004              (not (equal new-group group)))
5005       (when (gnus-group-goto-group group)
5006         (gnus-group-kill-group 1))
5007       (gnus-activate-group new-group))
5008     (gnus-group-update-group (or new-group group))
5009     (gnus-group-position-point)))
5010
5011 (defun gnus-group-make-help-group ()
5012   "Create the Gnus documentation group."
5013   (interactive)
5014   (let ((path (cons (concat installation-directory "etc/") load-path))
5015         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
5016         file)
5017     (and (gnus-gethash name gnus-newsrc-hashtb)
5018          (error "Documentation group already exists"))
5019     (while (and path
5020                 (not (file-exists-p 
5021                       (setq file (concat (file-name-as-directory (car path))
5022                                          "gnus-tut.txt")))))
5023       (setq path (cdr path)))
5024     (if (not path)
5025         (message "Couldn't find doc group")
5026       (gnus-group-make-group 
5027        (gnus-group-real-name name)
5028        (list 'nndoc name
5029              (list 'nndoc-address file)
5030              (list 'nndoc-article-type 'mbox)))))
5031   (gnus-group-position-point))
5032
5033 (defun gnus-group-make-doc-group (file type)
5034   "Create a group that uses a single file as the source."
5035   (interactive 
5036    (list (read-file-name "File name: ") 
5037          (and current-prefix-arg 'ask)))
5038   (when (eq type 'ask)
5039     (let ((err "")
5040           char found)
5041       (while (not found)
5042         (message 
5043          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5044          err)
5045         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5046                           ((= char ?b) 'babyl)
5047                           ((= char ?d) 'digest)
5048                           ((= char ?f) 'forward)
5049                           ((= char ?a) 'mmfd)
5050                           (t (setq err (format "%c unknown. " char))
5051                              nil))))
5052       (setq type found)))
5053   (let* ((file (expand-file-name file))
5054          (name (gnus-generate-new-group-name
5055                 (gnus-group-prefixed-name
5056                  (file-name-nondirectory file) '(nndoc "")))))
5057     (gnus-group-make-group 
5058      (gnus-group-real-name name)
5059      (list 'nndoc name
5060            (list 'nndoc-address file)
5061            (list 'nndoc-article-type (or type 'guess))))
5062     (forward-line -1)
5063     (gnus-group-position-point)))
5064
5065 (defun gnus-group-make-archive-group (&optional all)
5066   "Create the (ding) Gnus archive group of the most recent articles.
5067 Given a prefix, create a full group."
5068   (interactive "P")
5069   (let ((group (gnus-group-prefixed-name 
5070                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5071     (and (gnus-gethash group gnus-newsrc-hashtb)
5072          (error "Archive group already exists"))
5073     (gnus-group-make-group
5074      (gnus-group-real-name group)
5075      (list 'nndir (if all "hpc" "edu")
5076            (list 'nndir-directory  
5077                  (if all gnus-group-archive-directory 
5078                    gnus-group-recent-archive-directory)))))
5079   (forward-line -1)
5080   (gnus-group-position-point))
5081
5082 (defun gnus-group-make-directory-group (dir)
5083   "Create an nndir group.
5084 The user will be prompted for a directory.  The contents of this
5085 directory will be used as a newsgroup.  The directory should contain
5086 mail messages or news articles in files that have numeric names."
5087   (interactive
5088    (list (read-file-name "Create group from directory: ")))
5089   (or (file-exists-p dir) (error "No such directory"))
5090   (or (file-directory-p dir) (error "Not a directory"))
5091   (let ((ext "")
5092         (i 0)
5093         group)
5094     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5095       (setq group
5096             (gnus-group-prefixed-name 
5097              (concat (file-name-as-directory (directory-file-name dir))
5098                      ext)
5099              '(nndir "")))
5100       (setq ext (format "<%d>" (setq i (1+ i)))))
5101     (gnus-group-make-group 
5102      (gnus-group-real-name group)
5103      (list 'nndir group (list 'nndir-directory dir))))
5104   (forward-line -1)
5105   (gnus-group-position-point))
5106
5107 (defun gnus-group-make-kiboze-group (group address scores)
5108   "Create an nnkiboze group.
5109 The user will be prompted for a name, a regexp to match groups, and
5110 score file entries for articles to include in the group."
5111   (interactive
5112    (list
5113     (read-string "nnkiboze group name: ")
5114     (read-string "Source groups (regexp): ")
5115     (let ((headers (mapcar (lambda (group) (list group))
5116                            '("subject" "from" "number" "date" "message-id"
5117                              "references" "chars" "lines" "xref"
5118                              "followup" "all" "body" "head")))
5119           scores header regexp regexps)
5120       (while (not (equal "" (setq header (completing-read 
5121                                           "Match on header: " headers nil t))))
5122         (setq regexps nil)
5123         (while (not (equal "" (setq regexp (read-string 
5124                                             (format "Match on %s (string): "
5125                                                     header)))))
5126           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5127         (setq scores (cons (cons header regexps) scores)))
5128       scores)))
5129   (gnus-group-make-group group "nnkiboze" address)
5130   (save-excursion
5131     (gnus-set-work-buffer)
5132     (let (emacs-lisp-mode-hook)
5133       (pp scores (current-buffer)))
5134     (write-region (point-min) (point-max) 
5135                   (gnus-score-file-name (concat "nnkiboze:" group))))
5136   (forward-line -1)
5137   (gnus-group-position-point))
5138
5139 (defun gnus-group-add-to-virtual (n vgroup)
5140   "Add the current group to a virtual group."
5141   (interactive
5142    (list current-prefix-arg
5143          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5144                           "nnvirtual:")))
5145   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5146       (error "%s is not an nnvirtual group" vgroup))
5147   (let* ((groups (gnus-group-process-prefix n))
5148          (method (gnus-info-method (gnus-get-info vgroup))))
5149     (setcar (cdr method)
5150             (concat 
5151              (nth 1 method) "\\|"
5152              (mapconcat 
5153               (lambda (s) 
5154                 (gnus-group-remove-mark s)
5155                 (concat "\\(^" (regexp-quote s) "$\\)"))
5156               groups "\\|"))))
5157   (gnus-group-position-point))
5158
5159 (defun gnus-group-make-empty-virtual (group)
5160   "Create a new, fresh, empty virtual group."
5161   (interactive "sCreate new, empty virtual group: ")
5162   (let* ((method (list 'nnvirtual "^$"))
5163          (pgroup (gnus-group-prefixed-name group method)))
5164     ;; Check whether it exists already.
5165     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
5166          (error "Group %s already exists." pgroup))
5167     ;; Subscribe the new group after the group on the current line.
5168     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
5169     (gnus-group-update-group pgroup)
5170     (forward-line -1)
5171     (gnus-group-position-point)))
5172
5173 (defun gnus-group-enter-directory (dir)
5174   "Enter an ephemeral nneething group."
5175   (interactive "DDirectory to read: ")
5176   (let* ((method (list 'nneething dir))
5177          (leaf (gnus-group-prefixed-name
5178                 (file-name-nondirectory (directory-file-name dir))
5179                 method))
5180          (name (gnus-generate-new-group-name leaf)))
5181     (let ((nneething-read-only t))
5182       (or (gnus-group-read-ephemeral-group 
5183            name method t
5184            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
5185                                       'summary 'group)))
5186           (error "Couldn't enter %s" dir)))))
5187
5188 ;; Group sorting commands
5189 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
5190
5191 (defun gnus-group-sort-groups (func &optional reverse)
5192   "Sort the group buffer according to FUNC.
5193 If REVERSE, reverse the sorting order."
5194   (interactive (list gnus-group-sort-function
5195                      current-prefix-arg))
5196   (unless (listp func)
5197     (setq func (list func)))
5198   ;; We peel off the dummy group from the alist.
5199   (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
5200     (pop gnus-newsrc-alist))
5201   ;; Do the sorting.
5202   (while func
5203     (setq gnus-newsrc-alist 
5204           (sort gnus-newsrc-alist (pop func))))
5205   (when reverse
5206     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
5207   ;; Regenerate the hash table.
5208   (gnus-make-hashtable-from-newsrc-alist)
5209   (gnus-group-list-groups))
5210
5211 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
5212   "Sort the group buffer alphabetically by group name.
5213 If REVERSE, sort in reverse order."
5214   (interactive "P")
5215   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
5216
5217 (defun gnus-group-sort-groups-by-unread (&optional reverse)
5218   "Sort the group buffer by number of unread articles.
5219 If REVERSE, sort in reverse order."
5220   (interactive "P")
5221   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
5222
5223 (defun gnus-group-sort-groups-by-level (&optional reverse)
5224   "Sort the group buffer by group level.
5225 If REVERSE, sort in reverse order."
5226   (interactive "P")
5227   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
5228
5229 (defun gnus-group-sort-groups-by-score (&optional reverse)
5230   "Sort the group buffer by group score.
5231 If REVERSE, sort in reverse order."
5232   (interactive "P")
5233   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
5234
5235 (defun gnus-group-sort-groups-by-rank (&optional reverse)
5236   "Sort the group buffer by group rank.
5237 If REVERSE, sort in reverse order."
5238   (interactive "P")
5239   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
5240
5241 (defun gnus-group-sort-groups-by-method (&optional reverse)
5242   "Sort the group buffer alphabetically by backend name.
5243 If REVERSE, sort in reverse order."
5244   (interactive "P")
5245   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
5246
5247 (defun gnus-group-sort-by-alphabet (info1 info2)
5248   "Sort alphabetically."
5249   (string< (gnus-info-group info1) (gnus-info-group info2)))
5250
5251 (defun gnus-group-sort-by-unread (info1 info2)
5252   "Sort by number of unread articles."
5253   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
5254         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
5255     (< (or (and (numberp n1) n1) 0)
5256        (or (and (numberp n2) n2) 0))))
5257
5258 (defun gnus-group-sort-by-level (info1 info2)
5259   "Sort by level."
5260   (< (gnus-info-level info1) (gnus-info-level info2)))
5261
5262 (defun gnus-group-sort-by-method (info1 info2)
5263   "Sort alphabetically by backend name."
5264   (string< (symbol-name (car (gnus-find-method-for-group
5265                               (gnus-info-group info1) info1)))
5266            (symbol-name (car (gnus-find-method-for-group 
5267                               (gnus-info-group info2) info2)))))
5268
5269 (defun gnus-group-sort-by-score (info1 info2)
5270   "Sort by group score."
5271   (< (gnus-info-score info1) (gnus-info-score info2)))
5272
5273 (defun gnus-group-sort-by-rank (info1 info2)
5274   "Sort by level and score."
5275   (let ((level1 (gnus-info-level info1))
5276         (level2 (gnus-info-level info2)))
5277     (or (< level1 level2)
5278         (and (= level1 level2)
5279              (< (gnus-info-score info1) (gnus-info-score info2))))))
5280
5281 ;; Group catching up.
5282
5283 (defun gnus-group-catchup-current (&optional n all)
5284   "Mark all articles not marked as unread in current newsgroup as read.
5285 If prefix argument N is numeric, the ARG next newsgroups will be
5286 caught up.  If ALL is non-nil, marked articles will also be marked as
5287 read.  Cross references (Xref: header) of articles are ignored.
5288 The difference between N and actual number of newsgroups that were
5289 caught up is returned."
5290   (interactive "P")
5291   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
5292                gnus-expert-user
5293                (gnus-y-or-n-p
5294                 (if all
5295                     "Do you really want to mark all articles as read? "
5296                   "Mark all unread articles as read? "))))
5297       n
5298     (let ((groups (gnus-group-process-prefix n))
5299           (ret 0))
5300       (while groups
5301         ;; Virtual groups have to be given special treatment. 
5302         (let ((method (gnus-find-method-for-group (car groups))))
5303           (if (eq 'nnvirtual (car method))
5304               (nnvirtual-catchup-group
5305                (gnus-group-real-name (car groups)) (nth 1 method) all)))
5306         (gnus-group-remove-mark (car groups))
5307         (if (prog1
5308                 (gnus-group-goto-group (car groups))
5309               (gnus-group-catchup (car groups) all))
5310             (gnus-group-update-group-line)
5311           (setq ret (1+ ret)))
5312         (setq groups (cdr groups)))
5313       (gnus-group-next-unread-group 1)
5314       ret)))
5315
5316 (defun gnus-group-catchup-current-all (&optional n)
5317   "Mark all articles in current newsgroup as read.
5318 Cross references (Xref: header) of articles are ignored."
5319   (interactive "P")
5320   (gnus-group-catchup-current n 'all))
5321
5322 (defun gnus-group-catchup (group &optional all)
5323   "Mark all articles in GROUP as read.
5324 If ALL is non-nil, all articles are marked as read.
5325 The return value is the number of articles that were marked as read,
5326 or nil if no action could be taken."
5327   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
5328          (num (car entry))
5329          (marked (nth 3 (nth 2 entry))))
5330     (if (not (numberp (car entry)))
5331         (gnus-message 1 "Can't catch up; non-active group")
5332       ;; Do the updating only if the newsgroup isn't killed.
5333       (when entry
5334         (gnus-update-read-articles group nil)
5335         ;; Also nix out the lists of marks and dormants. 
5336         (when all 
5337           (gnus-add-marked-articles group 'tick nil nil 'force)
5338           (gnus-add-marked-articles group 'dormant nil nil 'force))
5339         num))))
5340
5341 (defun gnus-group-expire-articles (&optional n)
5342   "Expire all expirable articles in the current newsgroup."
5343   (interactive "P")
5344   (let ((groups (gnus-group-process-prefix n))
5345         group)
5346     (unless groups
5347       (error "No groups to expire"))
5348     (while groups
5349       (setq group (pop groups))
5350       (gnus-group-remove-mark group)
5351       (when (gnus-check-backend-function 'request-expire-articles group)
5352         (let* ((info (gnus-get-info group))
5353                (expirable (if (gnus-group-total-expirable-p group)
5354                               (cons nil (gnus-list-of-read-articles group))
5355                             (assq 'expire (gnus-info-marks info))))
5356                (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
5357           (when expirable 
5358             (setcdr expirable
5359                     (gnus-compress-sequence
5360                      (if expiry-wait
5361                          (let ((nnmail-expiry-wait-function nil)
5362                                (nnmail-expiry-wait expiry-wait))
5363                            (gnus-request-expire-articles 
5364                             (gnus-uncompress-sequence (cdr expirable)) group))
5365                        (gnus-request-expire-articles 
5366                         (gnus-uncompress-sequence (cdr expirable))
5367                         group))))))))))
5368
5369 (defun gnus-group-expire-all-groups ()
5370   "Expire all expirable articles in all newsgroups."
5371   (interactive)
5372   (save-excursion
5373     (gnus-message 5 "Expiring...")
5374     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
5375                                      (cdr gnus-newsrc-alist))))
5376       (gnus-group-expire-articles nil)))
5377   (gnus-group-position-point)
5378   (gnus-message 5 "Expiring...done"))
5379
5380 (defun gnus-group-set-current-level (n level)
5381   "Set the level of the next N groups to LEVEL."
5382   (interactive 
5383    (list
5384     current-prefix-arg
5385     (string-to-int
5386      (let ((s (read-string 
5387                (format "Level (default %s): " (gnus-group-group-level)))))
5388        (if (string-match "^\\s-*$" s)
5389            (int-to-string (gnus-group-group-level))
5390          s)))))
5391   (or (and (>= level 1) (<= level gnus-level-killed))
5392       (error "Illegal level: %d" level))
5393   (let ((groups (gnus-group-process-prefix n))
5394         group)
5395     (while groups
5396       (setq group (car groups)
5397             groups (cdr groups))
5398       (gnus-group-remove-mark group)
5399       (gnus-message 6 "Changed level of %s from %d to %d" 
5400                     group (gnus-group-group-level) level)
5401       (gnus-group-change-level group level
5402                                (gnus-group-group-level))
5403       (gnus-group-update-group-line)))
5404   (gnus-group-position-point))
5405
5406 (defun gnus-group-unsubscribe-current-group (&optional n)
5407   "Toggle subscription of the current group.
5408 If given numerical prefix, toggle the N next groups."
5409   (interactive "P")
5410   (let ((groups (gnus-group-process-prefix n))
5411         group)
5412     (while groups
5413       (setq group (car groups)
5414             groups (cdr groups))
5415       (gnus-group-remove-mark group)
5416       (gnus-group-unsubscribe-group
5417        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
5418                  gnus-level-default-unsubscribed
5419                gnus-level-default-subscribed) t)
5420       (gnus-group-update-group-line))
5421     (gnus-group-next-group 1)))
5422
5423 (defun gnus-group-unsubscribe-group (group &optional level silent)
5424   "Toggle subscription to GROUP.
5425 Killed newsgroups are subscribed.  If SILENT, don't try to update the
5426 group line."
5427   (interactive
5428    (list (completing-read
5429           "Group: " gnus-active-hashtb nil 
5430           (memq gnus-select-method gnus-have-read-active-file))))
5431   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
5432     (cond
5433      ((string-match "^[ \t]$" group)
5434       (error "Empty group name"))
5435      (newsrc
5436       ;; Toggle subscription flag.
5437       (gnus-group-change-level 
5438        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) 
5439                                       gnus-level-subscribed) 
5440                                   (1+ gnus-level-subscribed)
5441                                 gnus-level-default-subscribed)))
5442       (unless silent
5443         (gnus-group-update-group group)))
5444      ((and (stringp group)
5445            (or (not (memq gnus-select-method gnus-have-read-active-file))
5446                (gnus-active group)))
5447       ;; Add new newsgroup.
5448       (gnus-group-change-level 
5449        group 
5450        (if level level gnus-level-default-subscribed) 
5451        (or (and (member group gnus-zombie-list) 
5452                 gnus-level-zombie) 
5453            gnus-level-killed)
5454        (and (gnus-group-group-name)
5455             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
5456       (unless silent
5457         (gnus-group-update-group group)))
5458      (t (error "No such newsgroup: %s" group)))
5459     (gnus-group-position-point)))
5460
5461 (defun gnus-group-transpose-groups (n)
5462   "Move the current newsgroup up N places.
5463 If given a negative prefix, move down instead.  The difference between
5464 N and the number of steps taken is returned." 
5465   (interactive "p")
5466   (or (gnus-group-group-name)
5467       (error "No group on current line"))
5468   (gnus-group-kill-group 1)
5469   (prog1
5470       (forward-line (- n))
5471     (gnus-group-yank-group)
5472     (gnus-group-position-point)))
5473
5474 (defun gnus-group-kill-all-zombies ()
5475   "Kill all zombie newsgroups."
5476   (interactive)
5477   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
5478   (setq gnus-zombie-list nil)
5479   (gnus-group-list-groups))
5480
5481 (defun gnus-group-kill-region (begin end)
5482   "Kill newsgroups in current region (excluding current point).
5483 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
5484   (interactive "r")
5485   (let ((lines
5486          ;; Count lines.
5487          (save-excursion
5488            (count-lines
5489             (progn
5490               (goto-char begin)
5491               (beginning-of-line)
5492               (point))
5493             (progn
5494               (goto-char end)
5495               (beginning-of-line)
5496               (point))))))
5497     (goto-char begin)
5498     (beginning-of-line)                 ;Important when LINES < 1
5499     (gnus-group-kill-group lines)))
5500
5501 (defun gnus-group-kill-group (&optional n discard)
5502   "Kill the next N groups.
5503 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
5504 However, only groups that were alive can be yanked; already killed 
5505 groups or zombie groups can't be yanked.
5506 The return value is the name of the (last) group that was killed."
5507   (interactive "P")
5508   (let ((buffer-read-only nil)
5509         (groups (gnus-group-process-prefix n))
5510         group entry level)
5511     (if (or t (< (length groups) 10))
5512         ;; This is faster when there are few groups.
5513         (while groups
5514           (setq group (car groups)
5515                 groups (cdr groups))
5516           (gnus-group-remove-mark group)
5517           (setq level (gnus-group-group-level))
5518           (gnus-delete-line)
5519           (if (and (not discard)
5520                    (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
5521               (setq gnus-list-of-killed-groups 
5522                     (cons (cons (car entry) (nth 2 entry)) 
5523                           gnus-list-of-killed-groups)))
5524           (gnus-group-change-level 
5525            (if entry entry group) gnus-level-killed (if entry nil level)))
5526       ;; If there are lots and lots of groups to be killed, we use
5527       ;; this thing instead.
5528       ;; !!! Not written.
5529       )
5530       
5531     (gnus-group-position-point)
5532     group))
5533
5534 (defun gnus-group-yank-group (&optional arg)
5535   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
5536 inserting it before the current newsgroup.  The numeric ARG specifies
5537 how many newsgroups are to be yanked.  The name of the (last)
5538 newsgroup yanked is returned."
5539   (interactive "p")
5540   (if (not arg) (setq arg 1))
5541   (let (info group prev)
5542     (while (>= (setq arg (1- arg)) 0)
5543       (if (not (setq info (car gnus-list-of-killed-groups)))
5544           (error "No more newsgroups to yank"))
5545       (setq group (nth 1 info))
5546       ;; Find which newsgroup to insert this one before - search
5547       ;; backward until something suitable is found.  If there are no
5548       ;; other newsgroups in this buffer, just make this newsgroup the
5549       ;; first newsgroup.
5550       (setq prev (gnus-group-group-name))
5551       (gnus-group-change-level 
5552        info (nth 2 info) gnus-level-killed 
5553        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
5554        t)
5555       (gnus-group-insert-group-line-info group)
5556       (setq gnus-list-of-killed-groups 
5557             (cdr gnus-list-of-killed-groups)))
5558     (forward-line -1)
5559     (gnus-group-position-point)
5560     group))
5561       
5562 (defun gnus-group-list-all-groups (&optional arg)
5563   "List all newsgroups with level ARG or lower.
5564 Default is gnus-level-unsubscribed, which lists all subscribed and most
5565 unsubscribed groups."
5566   (interactive "P")
5567   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
5568
5569 ;; Redefine this to list ALL killed groups if prefix arg used.
5570 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
5571 (defun gnus-group-list-killed (&optional arg)
5572   "List all killed newsgroups in the group buffer.
5573 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
5574 entail asking the server for the groups."
5575   (interactive "P")
5576   ;; Find all possible killed newsgroups if arg.
5577   (when arg
5578     ;; First make sure active file has been read.
5579     (unless gnus-have-read-active-file
5580       (let ((gnus-read-active-file t))
5581         (gnus-read-active-file)))
5582     (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
5583     ;; Go through all newsgroups that are known to Gnus - enlarge kill list
5584     (mapatoms
5585      (lambda (sym)
5586        (let ((groups 0)
5587              (group (symbol-name sym)))
5588          (if (or (null group)
5589                  (gnus-gethash group gnus-killed-hashtb)
5590                  (gnus-gethash group gnus-newsrc-hashtb))
5591              ()
5592            (let ((do-sub (gnus-matches-options-n group)))
5593              (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
5594                  ()
5595                (setq groups (1+ groups))
5596                (setq gnus-killed-list 
5597                      (cons group gnus-killed-list))
5598                (gnus-sethash group group gnus-killed-hashtb))))))
5599      gnus-active-hashtb))
5600   (if (not gnus-killed-list)
5601       (gnus-message 6 "No killed groups")
5602     (let (gnus-group-list-mode)
5603       (funcall gnus-group-prepare-function 
5604                gnus-level-killed t gnus-level-killed))
5605     (goto-char (point-min)))
5606   (gnus-group-position-point))
5607
5608 (defun gnus-group-list-zombies ()
5609   "List all zombie newsgroups in the group buffer."
5610   (interactive)
5611   (if (not gnus-zombie-list)
5612       (gnus-message 6 "No zombie groups")
5613     (let (gnus-group-list-mode)
5614       (funcall gnus-group-prepare-function
5615                gnus-level-zombie t gnus-level-zombie))
5616     (goto-char (point-min)))
5617   (gnus-group-position-point))
5618
5619 (defun gnus-group-list-active ()
5620   "List all groups that are available from the server(s)."
5621   (interactive)
5622   ;; First we make sure that we have really read the active file. 
5623   (unless gnus-have-read-active-file
5624     (let ((gnus-read-active-file t))
5625       (gnus-read-active-file)))
5626   ;; Find all groups and sort them.
5627   (let ((groups 
5628          (sort 
5629           (let (list)
5630             (mapatoms
5631              (lambda (sym)
5632                (and (symbol-value sym)
5633                     (setq list (cons (symbol-name sym) list))))
5634              gnus-active-hashtb)
5635             list)
5636           'string<))
5637         (buffer-read-only nil))
5638     (erase-buffer)
5639     (while groups
5640       (gnus-group-insert-group-line-info (car groups))
5641       (setq groups (cdr groups)))
5642     (goto-char (point-min))))
5643
5644 (defun gnus-group-get-new-news (&optional arg)
5645   "Get newly arrived articles.
5646 If ARG is a number, it specifies which levels you are interested in
5647 re-scanning.  If ARG is non-nil and not a number, this will force
5648 \"hard\" re-reading of the active files from all servers."
5649   (interactive "P")
5650   (run-hooks 'gnus-get-new-news-hook)
5651   ;; We might read in new NoCeM messages here.
5652   (and gnus-use-nocem (gnus-nocem-scan-groups))
5653   ;; If ARG is not a number, then we read the active file.
5654   (and arg
5655        (not (numberp arg))
5656        (progn
5657          (let ((gnus-read-active-file t))
5658            (gnus-read-active-file))
5659          (setq arg nil)))
5660
5661   (setq arg (gnus-group-default-level arg t))
5662   (if (and gnus-read-active-file (not arg))
5663       (progn
5664         (gnus-read-active-file)
5665         (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed))))
5666     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
5667       (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed)))))
5668   (gnus-group-list-groups))
5669
5670 (defun gnus-group-get-new-news-this-group (&optional n)
5671   "Check for newly arrived news in the current group (and the N-1 next groups).
5672 The difference between N and the number of newsgroup checked is returned.
5673 If N is negative, this group and the N-1 previous groups will be checked."
5674   (interactive "P")
5675   (let* ((groups (gnus-group-process-prefix n))
5676          (ret (if (numberp n) (- n (length groups)) 0))
5677          group)
5678     (while groups
5679       (setq group (car groups)
5680             groups (cdr groups))
5681       (gnus-group-remove-mark group)
5682       (or (gnus-get-new-news-in-group group)
5683           (progn 
5684             (ding) 
5685             (message "%s error: %s" group (gnus-status-message group))
5686             (sit-for 2))))
5687     (gnus-group-next-unread-group 1 t)
5688     (gnus-summary-position-point)
5689     ret))
5690
5691 (defun gnus-get-new-news-in-group (group)
5692   (when (and group (gnus-activate-group group 'scan))
5693     (gnus-get-unread-articles-in-group 
5694      (gnus-get-info group) (gnus-active group))
5695     (when (gnus-group-goto-group group)
5696       (gnus-group-update-group-line))
5697     t))
5698
5699 (defun gnus-group-fetch-faq (group &optional faq-dir)
5700   "Fetch the FAQ for the current group."
5701   (interactive 
5702    (list
5703     (gnus-group-real-name (gnus-group-group-name))
5704     (cond (current-prefix-arg
5705            (completing-read 
5706             "Faq dir: " (and (listp gnus-group-faq-directory) 
5707                              gnus-group-faq-directory))))))
5708   (or faq-dir
5709       (setq faq-dir (if (listp gnus-group-faq-directory)
5710                         (car gnus-group-faq-directory)
5711                       gnus-group-faq-directory)))
5712   (or group (error "No group name given"))
5713   (let ((file (concat (file-name-as-directory faq-dir)
5714                       (gnus-group-real-name group))))
5715     (if (not (file-exists-p file))
5716         (error "No such file: %s" file)
5717       (find-file file))))
5718   
5719 (defun gnus-group-describe-group (force &optional group)
5720   "Display a description of the current newsgroup."
5721   (interactive (list current-prefix-arg (gnus-group-group-name)))
5722   (and force (setq gnus-description-hashtb nil))
5723   (let ((method (gnus-find-method-for-group group))
5724         desc)
5725     (or group (error "No group name given"))
5726     (and (or (and gnus-description-hashtb
5727                   ;; We check whether this group's method has been
5728                   ;; queried for a description file.  
5729                   (gnus-gethash 
5730                    (gnus-group-prefixed-name "" method) 
5731                    gnus-description-hashtb))
5732              (setq desc (gnus-group-get-description group))
5733              (gnus-read-descriptions-file method))
5734          (message
5735           (or desc (gnus-gethash group gnus-description-hashtb)
5736               "No description available")))))
5737
5738 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
5739 (defun gnus-group-describe-all-groups (&optional force)
5740   "Pop up a buffer with descriptions of all newsgroups."
5741   (interactive "P")
5742   (and force (setq gnus-description-hashtb nil))
5743   (if (not (or gnus-description-hashtb
5744                (gnus-read-all-descriptions-files)))
5745       (error "Couldn't request descriptions file"))
5746   (let ((buffer-read-only nil)
5747         b)
5748     (erase-buffer)
5749     (mapatoms
5750      (lambda (group)
5751        (setq b (point))
5752        (insert (format "      *: %-20s %s\n" (symbol-name group)
5753                        (symbol-value group)))
5754        (add-text-properties 
5755         b (1+ b) (list 'gnus-group group
5756                        'gnus-unread t 'gnus-marked nil
5757                        'gnus-level (1+ gnus-level-subscribed))))
5758      gnus-description-hashtb)
5759     (goto-char (point-min))
5760     (gnus-group-position-point)))
5761
5762 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
5763 (defun gnus-group-apropos (regexp &optional search-description)
5764   "List all newsgroups that have names that match a regexp."
5765   (interactive "sGnus apropos (regexp): ")
5766   (let ((prev "")
5767         (obuf (current-buffer))
5768         groups des)
5769     ;; Go through all newsgroups that are known to Gnus.
5770     (mapatoms 
5771      (lambda (group)
5772        (and (symbol-name group)
5773             (string-match regexp (symbol-name group))
5774             (setq groups (cons (symbol-name group) groups))))
5775      gnus-active-hashtb)
5776     ;; Go through all descriptions that are known to Gnus. 
5777     (if search-description
5778         (mapatoms 
5779          (lambda (group)
5780            (and (string-match regexp (symbol-value group))
5781                 (gnus-active (symbol-name group))
5782                 (setq groups (cons (symbol-name group) groups))))
5783          gnus-description-hashtb))
5784     (if (not groups)
5785         (gnus-message 3 "No groups matched \"%s\"." regexp)
5786       ;; Print out all the groups.
5787       (save-excursion
5788         (pop-to-buffer "*Gnus Help*")
5789         (buffer-disable-undo (current-buffer))
5790         (erase-buffer)
5791         (setq groups (sort groups 'string<))
5792         (while groups
5793           ;; Groups may be entered twice into the list of groups.
5794           (if (not (string= (car groups) prev))
5795               (progn
5796                 (insert (setq prev (car groups)) "\n")
5797                 (if (and gnus-description-hashtb
5798                          (setq des (gnus-gethash (car groups) 
5799                                                  gnus-description-hashtb)))
5800                     (insert "  " des "\n"))))
5801           (setq groups (cdr groups)))
5802         (goto-char (point-min))))
5803     (pop-to-buffer obuf)))
5804
5805 (defun gnus-group-description-apropos (regexp)
5806   "List all newsgroups that have names or descriptions that match a regexp."
5807   (interactive "sGnus description apropos (regexp): ")
5808   (if (not (or gnus-description-hashtb
5809                (gnus-read-all-descriptions-files)))
5810       (error "Couldn't request descriptions file"))
5811   (gnus-group-apropos regexp t))
5812
5813 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
5814 (defun gnus-group-list-matching (level regexp &optional all lowest) 
5815   "List all groups with unread articles that match REGEXP.
5816 If the prefix LEVEL is non-nil, it should be a number that says which
5817 level to cut off listing groups. 
5818 If ALL, also list groups with no unread articles.
5819 If LOWEST, don't list groups with level lower than LOWEST."
5820   (interactive "P\nsList newsgroups matching: ")
5821   (gnus-group-prepare-flat (or level gnus-level-subscribed)
5822                            all (or lowest 1) regexp)
5823   (goto-char (point-min))
5824   (gnus-group-position-point))
5825
5826 (defun gnus-group-list-all-matching (level regexp &optional lowest) 
5827   "List all groups that match REGEXP.
5828 If the prefix LEVEL is non-nil, it should be a number that says which
5829 level to cut off listing groups. 
5830 If LOWEST, don't list groups with level lower than LOWEST."
5831   (interactive "P\nsList newsgroups matching: ")
5832   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
5833
5834 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
5835 (defun gnus-group-save-newsrc (&optional force)
5836   "Save the Gnus startup files.
5837 If FORCE, force saving whether it is necessary or not."
5838   (interactive "P")
5839   (gnus-save-newsrc-file force))
5840
5841 (defun gnus-group-restart (&optional arg)
5842   "Force Gnus to read the .newsrc file."
5843   (interactive "P")
5844   (gnus-save-newsrc-file)
5845   (gnus-setup-news 'force)
5846   (gnus-group-list-groups arg))
5847
5848 (defun gnus-group-read-init-file ()
5849   "Read the Gnus elisp init file."
5850   (interactive)
5851   (gnus-read-init-file))
5852
5853 (defun gnus-group-check-bogus-groups (&optional silent)
5854   "Check bogus newsgroups.
5855 If given a prefix, don't ask for confirmation before removing a bogus
5856 group."
5857   (interactive "P")
5858   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
5859   (gnus-group-list-groups))
5860
5861 (defun gnus-group-edit-global-kill (&optional article group)
5862   "Edit the global kill file.
5863 If GROUP, edit that local kill file instead."
5864   (interactive "P")
5865   (setq gnus-current-kill-article article)
5866   (gnus-kill-file-edit-file group)
5867   (gnus-message 
5868    6
5869    (substitute-command-keys
5870     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
5871             (if group "local" "global")))))
5872
5873 (defun gnus-group-edit-local-kill (article group)
5874   "Edit a local kill file."
5875   (interactive (list nil (gnus-group-group-name)))
5876   (gnus-group-edit-global-kill article group))
5877
5878 (defun gnus-group-force-update ()
5879   "Update `.newsrc' file."
5880   (interactive)
5881   (gnus-save-newsrc-file))
5882
5883 (defun gnus-group-suspend ()
5884   "Suspend the current Gnus session.
5885 In fact, cleanup buffers except for group mode buffer.
5886 The hook gnus-suspend-gnus-hook is called before actually suspending."
5887   (interactive)
5888   (run-hooks 'gnus-suspend-gnus-hook)
5889   ;; Kill Gnus buffers except for group mode buffer.
5890   (let ((group-buf (get-buffer gnus-group-buffer)))
5891     ;; Do this on a separate list in case the user does a ^G before we finish
5892     (let ((gnus-buffer-list
5893            (delq group-buf (delq gnus-dribble-buffer
5894                                  (append gnus-buffer-list nil)))))
5895       (while gnus-buffer-list
5896         (gnus-kill-buffer (car gnus-buffer-list))
5897         (setq gnus-buffer-list (cdr gnus-buffer-list))))
5898     (if group-buf
5899         (progn
5900           (setq gnus-buffer-list (list group-buf))
5901           (bury-buffer group-buf)
5902           (delete-windows-on group-buf t)))))
5903
5904 (defun gnus-group-clear-dribble ()
5905   "Clear all information from the dribble buffer."
5906   (interactive)
5907   (gnus-dribble-clear))
5908
5909 (defun gnus-group-exit ()
5910   "Quit reading news after updating .newsrc.eld and .newsrc.
5911 The hook `gnus-exit-gnus-hook' is called before actually exiting."
5912   (interactive)
5913   (if (or noninteractive                ;For gnus-batch-kill
5914           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
5915           (not gnus-interactive-exit)   ;Without confirmation
5916           gnus-expert-user
5917           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
5918       (progn
5919         (run-hooks 'gnus-exit-gnus-hook)
5920         ;; Offer to save data from non-quitted summary buffers.
5921         (gnus-offer-save-summaries)
5922         ;; Save the newsrc file(s).
5923         (gnus-save-newsrc-file)
5924         ;; Kill-em-all.
5925         (gnus-close-backends)
5926         ;; Shut down the cache.
5927         (when gnus-use-cache
5928           (gnus-cache-open))
5929         ;; Reset everything.
5930         (gnus-clear-system))))
5931
5932 (defun gnus-close-backends ()
5933   ;; Send a close request to all backends that support such a request. 
5934   (let ((methods gnus-valid-select-methods)
5935         func)
5936     (while methods
5937       (if (fboundp (setq func (intern (concat (car (car methods))
5938                                               "-request-close"))))
5939           (funcall func))
5940       (setq methods (cdr methods)))))
5941
5942 (defun gnus-group-quit ()
5943   "Quit reading news without updating .newsrc.eld or .newsrc.
5944 The hook `gnus-exit-gnus-hook' is called before actually exiting."
5945   (interactive)
5946   (when (or noninteractive              ;For gnus-batch-kill
5947             (zerop (buffer-size))
5948             (not (gnus-server-opened gnus-select-method))
5949             gnus-expert-user
5950             (not gnus-current-startup-file)
5951             (gnus-yes-or-no-p
5952              (format "Quit reading news without saving %s? "
5953                      (file-name-nondirectory gnus-current-startup-file))))
5954     (run-hooks 'gnus-exit-gnus-hook)
5955     (if gnus-use-full-window
5956         (delete-other-windows)
5957       (gnus-remove-some-windows))
5958     (gnus-dribble-save)
5959     (gnus-close-backends)
5960     ;; Shut down the cache.
5961     (when gnus-use-cache
5962       (gnus-cache-open))
5963     (gnus-clear-system)))
5964
5965 (defun gnus-offer-save-summaries ()
5966   "Offer to save all active summary buffers."
5967   (save-excursion
5968     (let ((buflist (buffer-list)) 
5969           buffers bufname)
5970       ;; Go through all buffers and find all summaries.
5971       (while buflist
5972         (and (setq bufname (buffer-name (car buflist)))
5973              (string-match "Summary" bufname)
5974              (save-excursion
5975                (set-buffer bufname)
5976                ;; We check that this is, indeed, a summary buffer.
5977                (and (eq major-mode 'gnus-summary-mode)
5978                     ;; Also make sure this isn't bogus.
5979                     gnus-newsgroup-prepared))
5980              (push bufname buffers))
5981         (setq buflist (cdr buflist)))
5982       ;; Go through all these summary buffers and offer to save them.
5983       (when buffers
5984         (map-y-or-n-p 
5985          "Update summary buffer %s? "
5986          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
5987          buffers)))))
5988
5989 (defun gnus-group-describe-briefly ()
5990   "Give a one line description of the group mode commands."
5991   (interactive)
5992   (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")))
5993
5994 (defun gnus-group-browse-foreign-server (method)
5995   "Browse a foreign news server.
5996 If called interactively, this function will ask for a select method
5997  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). 
5998 If not, METHOD should be a list where the first element is the method
5999 and the second element is the address."
6000   (interactive
6001    (list (let ((how (completing-read 
6002                      "Which backend: "
6003                      (append gnus-valid-select-methods gnus-server-alist)
6004                      nil t "nntp")))
6005            ;; We either got a backend name or a virtual server name.
6006            ;; If the first, we also need an address.
6007            (if (assoc how gnus-valid-select-methods)
6008                (list (intern how)
6009                      ;; Suggested by mapjph@bath.ac.uk.
6010                      (completing-read 
6011                       "Address: " 
6012                       (mapcar (lambda (server) (list server))
6013                               gnus-secondary-servers)))
6014              ;; We got a server name, so we find the method.
6015              (gnus-server-to-method how)))))
6016   (gnus-browse-foreign-server method))
6017
6018 \f
6019 ;;;
6020 ;;; Browse Server Mode
6021 ;;;
6022
6023 (defvar gnus-browse-mode-hook nil)
6024 (defvar gnus-browse-mode-map nil)
6025 (put 'gnus-browse-mode 'mode-class 'special)
6026
6027 (if gnus-browse-mode-map
6028     nil
6029   (setq gnus-browse-mode-map (make-keymap))
6030   (suppress-keymap gnus-browse-mode-map)
6031   (define-key gnus-browse-mode-map " " 'gnus-browse-read-group)
6032   (define-key gnus-browse-mode-map "=" 'gnus-browse-select-group)
6033   (define-key gnus-browse-mode-map "n" 'gnus-browse-next-group)
6034   (define-key gnus-browse-mode-map "p" 'gnus-browse-prev-group)
6035   (define-key gnus-browse-mode-map "\177" 'gnus-browse-prev-group)
6036   (define-key gnus-browse-mode-map "N" 'gnus-browse-next-group)
6037   (define-key gnus-browse-mode-map "P" 'gnus-browse-prev-group)
6038   (define-key gnus-browse-mode-map "\M-n" 'gnus-browse-next-group)
6039   (define-key gnus-browse-mode-map "\M-p" 'gnus-browse-prev-group)
6040   (define-key gnus-browse-mode-map "\r" 'gnus-browse-select-group)
6041   (define-key gnus-browse-mode-map "u" 'gnus-browse-unsubscribe-current-group)
6042   (define-key gnus-browse-mode-map "l" 'gnus-browse-exit)
6043   (define-key gnus-browse-mode-map "L" 'gnus-browse-exit)
6044   (define-key gnus-browse-mode-map "q" 'gnus-browse-exit)
6045   (define-key gnus-browse-mode-map "Q" 'gnus-browse-exit)
6046   (define-key gnus-browse-mode-map "\C-c\C-c" 'gnus-browse-exit)
6047   (define-key gnus-browse-mode-map "?" 'gnus-browse-describe-briefly)
6048   (define-key gnus-browse-mode-map "\C-c\C-i" 'gnus-info-find-node)
6049   )
6050
6051 (defvar gnus-browse-current-method nil)
6052 (defvar gnus-browse-return-buffer nil)
6053
6054 (defvar gnus-browse-buffer "*Gnus Browse Server*")
6055
6056 (defun gnus-browse-foreign-server (method &optional return-buffer)
6057   "Browse the server METHOD."
6058   (setq gnus-browse-current-method method)
6059   (setq gnus-browse-return-buffer return-buffer)
6060   (let ((gnus-select-method method)
6061         groups group)
6062     (gnus-message 5 "Connecting to %s..." (nth 1 method))
6063     (cond 
6064      ((not (gnus-check-server method))
6065       (gnus-message 
6066        1 "Unable to contact server: %s" (gnus-status-message method))
6067       nil)
6068      ((not (gnus-request-list method))
6069       (gnus-message 
6070        1 "Couldn't request list: %s" (gnus-status-message method))
6071       nil)
6072      (t
6073       (get-buffer-create gnus-browse-buffer)
6074       (gnus-add-current-to-buffer-list)
6075       (and gnus-carpal (gnus-carpal-setup-buffer 'browse))
6076       (gnus-configure-windows 'browse)
6077       (buffer-disable-undo (current-buffer))
6078       (let ((buffer-read-only nil))
6079         (erase-buffer))
6080       (gnus-browse-mode)
6081       (setq mode-line-buffer-identification
6082             (format
6083              "Gnus  Browse Server {%s:%s}" (car method) (car (cdr method))))
6084       (save-excursion
6085         (set-buffer nntp-server-buffer)
6086         (let ((cur (current-buffer)))
6087           (goto-char (point-min))
6088           (or (string= gnus-ignored-newsgroups "")
6089               (delete-matching-lines gnus-ignored-newsgroups))
6090           (while (re-search-forward 
6091                   "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
6092             (goto-char (match-end 1))
6093             (setq groups (cons (cons (match-string 1)
6094                                      (max 0 (- (1+ (read cur)) (read cur))))
6095                                groups)))))
6096       (setq groups (sort groups 
6097                          (lambda (l1 l2)
6098                            (string< (car l1) (car l2)))))
6099       (let ((buffer-read-only nil))
6100         (while groups
6101           (setq group (car groups))
6102           (insert 
6103            (format "K%7d: %s\n" (cdr group) (car group)))
6104           (setq groups (cdr groups))))
6105       (switch-to-buffer (current-buffer))
6106       (goto-char (point-min))
6107       (gnus-group-position-point)
6108       t))))
6109
6110 (defun gnus-browse-mode ()
6111   "Major mode for browsing a foreign server.
6112
6113 All normal editing commands are switched off.
6114
6115 \\<gnus-browse-mode-map>
6116 The only things you can do in this buffer is
6117
6118 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
6119 The group will be inserted into the group buffer upon exit from this
6120 buffer.  
6121
6122 2) `\\[gnus-browse-read-group]' to read a group ephemerally.
6123
6124 3) `\\[gnus-browse-exit]' to return to the group buffer."
6125   (interactive)
6126   (kill-all-local-variables)
6127   (when (and menu-bar-mode
6128              (gnus-visual-p 'browse-menu 'menu))
6129     (gnus-browse-make-menu-bar))
6130   (gnus-simplify-mode-line)
6131   (setq major-mode 'gnus-browse-mode)
6132   (setq mode-name "Browse Server")
6133   (setq mode-line-process nil)
6134   (use-local-map gnus-browse-mode-map)
6135   (buffer-disable-undo (current-buffer))
6136   (setq truncate-lines t)
6137   (setq buffer-read-only t)
6138   (run-hooks 'gnus-browse-mode-hook))
6139
6140 (defun gnus-browse-read-group (&optional no-article)
6141   "Enter the group at the current line."
6142   (interactive)
6143   (let ((group (gnus-browse-group-name)))
6144     (or (gnus-group-read-ephemeral-group 
6145          group gnus-browse-current-method nil
6146          (cons (current-buffer) 'browse))
6147         (error "Couldn't enter %s" group))))
6148
6149 (defun gnus-browse-select-group ()
6150   "Select the current group."
6151   (interactive)
6152   (gnus-browse-read-group 'no))
6153
6154 (defun gnus-browse-next-group (n)
6155   "Go to the next group."
6156   (interactive "p")
6157   (prog1
6158       (forward-line n)
6159     (gnus-group-position-point)))
6160
6161 (defun gnus-browse-prev-group (n)
6162   "Go to the next group."
6163   (interactive "p")
6164   (gnus-browse-next-group (- n)))
6165
6166 (defun gnus-browse-unsubscribe-current-group (arg)
6167   "(Un)subscribe to the next ARG groups."
6168   (interactive "p")
6169   (and (eobp)
6170        (error "No group at current line."))
6171   (let ((ward (if (< arg 0) -1 1))
6172         (arg (abs arg)))
6173     (while (and (> arg 0)
6174                 (not (eobp))
6175                 (gnus-browse-unsubscribe-group)
6176                 (zerop (gnus-browse-next-group ward)))
6177       (setq arg (1- arg)))
6178     (gnus-group-position-point)
6179     (if (/= 0 arg) (gnus-message 7 "No more newsgroups"))
6180     arg))
6181
6182 (defun gnus-browse-group-name ()
6183   (save-excursion
6184     (beginning-of-line)
6185     (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
6186       (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method))))
6187   
6188 (defun gnus-browse-unsubscribe-group ()
6189   "Toggle subscription of the current group in the browse buffer."
6190   (let ((sub nil)
6191         (buffer-read-only nil)
6192         group)
6193     (save-excursion
6194       (beginning-of-line)
6195       ;; If this group it killed, then we want to subscribe it.
6196       (if (= (following-char) ?K) (setq sub t))
6197       (setq group (gnus-browse-group-name))
6198       (delete-char 1)
6199       (if sub
6200           (progn
6201             (gnus-group-change-level 
6202              (list t group gnus-level-default-subscribed
6203                    nil nil gnus-browse-current-method) 
6204              gnus-level-default-subscribed gnus-level-killed
6205              (and (car (nth 1 gnus-newsrc-alist))
6206                   (gnus-gethash (car (nth 1 gnus-newsrc-alist))
6207                                 gnus-newsrc-hashtb))
6208              t)
6209             (insert ? ))
6210         (gnus-group-change-level 
6211          group gnus-level-killed gnus-level-default-subscribed)
6212         (insert ?K)))
6213     t))
6214
6215 (defun gnus-browse-exit ()
6216   "Quit browsing and return to the group buffer."
6217   (interactive)
6218   (if (eq major-mode 'gnus-browse-mode)
6219       (kill-buffer (current-buffer)))
6220   (if gnus-browse-return-buffer
6221       (gnus-configure-windows 'server 'force)
6222     (gnus-configure-windows 'group 'force)
6223     (gnus-group-list-groups nil)))
6224
6225 (defun gnus-browse-describe-briefly ()
6226   "Give a one line description of the group mode commands."
6227   (interactive)
6228   (gnus-message 6
6229                 (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")))
6230       
6231 \f
6232 ;;;
6233 ;;; Gnus summary mode
6234 ;;;
6235
6236 (defvar gnus-summary-mode-map nil)
6237 (defvar gnus-summary-mark-map nil)
6238 (defvar gnus-summary-mscore-map nil)
6239 (defvar gnus-summary-article-map nil)
6240 (defvar gnus-summary-thread-map nil)
6241 (defvar gnus-summary-goto-map nil)
6242 (defvar gnus-summary-exit-map nil)
6243 (defvar gnus-summary-interest-map nil)
6244 (defvar gnus-summary-sort-map nil)
6245 (defvar gnus-summary-backend-map nil)
6246 (defvar gnus-summary-save-map nil)
6247 (defvar gnus-summary-wash-map nil)
6248 (defvar gnus-summary-wash-hide-map nil)
6249 (defvar gnus-summary-wash-highlight-map nil)
6250 (defvar gnus-summary-wash-time-map nil)
6251 (defvar gnus-summary-help-map nil)
6252 (defvar gnus-summary-limit-map nil)
6253
6254 (put 'gnus-summary-mode 'mode-class 'special)
6255
6256 (if gnus-summary-mode-map
6257     nil
6258   (setq gnus-summary-mode-map (make-keymap))
6259   (suppress-keymap gnus-summary-mode-map)
6260
6261   ;; Non-orthogonal keys
6262
6263   (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
6264   (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
6265   (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
6266   (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
6267   (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
6268   (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
6269   (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
6270   (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject)
6271   (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject)
6272   (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject)
6273   (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject)
6274   (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
6275   (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article)
6276   (define-key gnus-summary-mode-map 
6277     "\M-s" 'gnus-summary-search-article-forward)
6278   (define-key gnus-summary-mode-map 
6279     "\M-r" 'gnus-summary-search-article-backward)
6280   (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
6281   (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
6282   (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-article)
6283   (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
6284   (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article)
6285   (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward)
6286   (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward)
6287   (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward)
6288   (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
6289   (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
6290   (define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable)
6291   (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward)
6292   (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward)
6293   (define-key gnus-summary-mode-map 
6294     "k" 'gnus-summary-kill-same-subject-and-select)
6295   (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
6296   (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread)
6297   (define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread)
6298   (define-key gnus-summary-mode-map "e" 'gnus-summary-edit-article)
6299   (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable)
6300   (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable)
6301   (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads)
6302   (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread)
6303   (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread)
6304   (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread)
6305   (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread)
6306   (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread)
6307   (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread)
6308   (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
6309   (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
6310   (define-key gnus-summary-mode-map "\C-w" 'gnus-summary-mark-region-as-read)
6311   (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
6312   (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant)
6313   (define-key gnus-summary-mode-map 
6314     "\C-c\M-\C-s" 'gnus-summary-limit-include-expunged)
6315   (define-key gnus-summary-mode-map 
6316     "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
6317   (define-key gnus-summary-mode-map 
6318     "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
6319   (define-key gnus-summary-mode-map 
6320     "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
6321   (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
6322   (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score)
6323   (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
6324   (define-key gnus-summary-mode-map 
6325     "\C-x\C-s" 'gnus-summary-reselect-current-group)
6326   (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group)
6327   (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
6328   (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
6329   (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime)
6330   (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
6331   (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
6332   (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
6333   (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
6334   (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
6335   (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
6336   (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
6337   (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail)
6338   (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
6339   (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill)
6340   (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill)
6341   (define-key gnus-summary-mode-map "V" 'gnus-version)
6342   (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group)
6343   (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
6344   (define-key gnus-summary-mode-map "Q" 'gnus-summary-exit-no-update)
6345   (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
6346   (define-key gnus-summary-mode-map gnus-mouse-2 'gnus-mouse-pick-article)
6347   (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
6348   (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
6349   (define-key gnus-summary-mode-map "x" 'gnus-summary-limit-to-unread)
6350   (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
6351   (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
6352   (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
6353 ;  (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
6354   (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
6355   (define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu-view)
6356   (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-enter-digest-group)
6357   (define-key gnus-summary-mode-map "v" 'gnus-summary-verbose-headers)
6358   (define-key gnus-summary-mode-map "\C-c\C-b" 'gnus-bug)
6359
6360
6361   ;; Sort of orthogonal keymap
6362   (define-prefix-command 'gnus-summary-mark-map)
6363   (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map)
6364   (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward)
6365   (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward)
6366   (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward)
6367   (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward)
6368   (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward)
6369   (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward)
6370   (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable)
6371   (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable)
6372   (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant)
6373   (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark)
6374   (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark)
6375   (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable)
6376   (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable)
6377   (define-key gnus-summary-mark-map "S" 'gnus-summary-limit-include-expunged)
6378   (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup)
6379   (define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here)
6380   (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all)
6381   (define-key gnus-summary-mark-map 
6382     "k" 'gnus-summary-kill-same-subject-and-select)
6383   (define-key gnus-summary-mark-map "K" 'gnus-summary-kill-same-subject)
6384
6385   (define-prefix-command 'gnus-summary-mscore-map)
6386   (define-key gnus-summary-mark-map "V" 'gnus-summary-mscore-map)
6387   (define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above)
6388   (define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above)
6389   (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above)
6390   (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below)
6391
6392   (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map)
6393   
6394   (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
6395
6396   (define-prefix-command 'gnus-summary-limit-map)
6397   (define-key gnus-summary-mode-map "/" 'gnus-summary-limit-map)
6398   (define-key gnus-summary-limit-map "/" 'gnus-summary-limit-to-subject)
6399   (define-key gnus-summary-limit-map "n" 'gnus-summary-limit-to-articles)
6400   (define-key gnus-summary-limit-map "w" 'gnus-summary-pop-limit)
6401   (define-key gnus-summary-limit-map "s" 'gnus-summary-limit-to-subject)
6402   (define-key gnus-summary-limit-map "u" 'gnus-summary-limit-to-unread)
6403   (define-key gnus-summary-limit-map "m" 'gnus-summary-limit-to-marks)
6404   (define-key gnus-summary-limit-map "v" 'gnus-summary-limit-to-score)
6405   (define-key gnus-summary-limit-map "D" 'gnus-summary-limit-include-dormant)
6406   (define-key gnus-summary-limit-map "d" 'gnus-summary-limit-exclude-dormant)
6407   (define-key gnus-summary-mark-map "E" 'gnus-summary-limit-include-expunged)
6408   (define-key gnus-summary-limit-map "c" 
6409     'gnus-summary-limit-exclude-childless-dormant)
6410
6411   (define-prefix-command 'gnus-summary-goto-map)
6412   (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map)
6413   (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article)
6414   (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article)
6415   (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article)
6416   (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article)
6417   (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject)
6418   (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject)
6419   (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject)
6420   (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject)
6421   (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article)
6422   (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article)
6423   (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject)
6424   (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article)
6425   (define-key gnus-summary-goto-map "p" 'gnus-summary-pop-article)
6426
6427
6428   (define-prefix-command 'gnus-summary-thread-map)
6429   (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map)
6430   (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread)
6431   (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread)
6432   (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread)
6433   (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads)
6434   (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread)
6435   (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads)
6436   (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread)
6437   (define-key gnus-summary-thread-map "H" 'gnus-summary-hide-all-threads)
6438   (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread)
6439   (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread)
6440   (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread)
6441   (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread)
6442   (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread)
6443   (define-key gnus-summary-thread-map "\M-#" 'gnus-uu-unmark-thread)
6444
6445   
6446   (define-prefix-command 'gnus-summary-exit-map)
6447   (define-key gnus-summary-mode-map "Z" 'gnus-summary-exit-map)
6448   (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit)
6449   (define-key gnus-summary-exit-map "C" 'gnus-summary-catchup-all-and-exit)
6450   (define-key gnus-summary-exit-map "E" 'gnus-summary-exit-no-update)
6451   (define-key gnus-summary-exit-map "Q" 'gnus-summary-exit)
6452   (define-key gnus-summary-exit-map "Z" 'gnus-summary-exit)
6453   (define-key gnus-summary-exit-map 
6454     "n" 'gnus-summary-catchup-and-goto-next-group)
6455   (define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group)
6456   (define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group)
6457   (define-key gnus-summary-exit-map "N" 'gnus-summary-next-group)
6458   (define-key gnus-summary-exit-map "P" 'gnus-summary-prev-group)
6459
6460
6461   (define-prefix-command 'gnus-summary-article-map)
6462   (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map)
6463   (define-key gnus-summary-article-map " " 'gnus-summary-next-page)
6464   (define-key gnus-summary-article-map "n" 'gnus-summary-next-page)
6465   (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page)
6466   (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page)
6467   (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up)
6468   (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article)
6469   (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article)
6470   (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article)
6471   (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article)
6472   (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article)
6473   (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article)
6474   (define-key gnus-summary-article-map "R" 'gnus-summary-refer-references)
6475   (define-key gnus-summary-article-map "g" 'gnus-summary-show-article)
6476   (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article)
6477
6478
6479
6480   (define-prefix-command 'gnus-summary-wash-map)
6481   (define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map)
6482
6483   (define-prefix-command 'gnus-summary-wash-hide-map)
6484   (define-key gnus-summary-wash-map "W" 'gnus-summary-wash-hide-map)
6485   (define-key gnus-summary-wash-hide-map "a" 'gnus-article-hide)
6486   (define-key gnus-summary-wash-hide-map "h" 'gnus-article-hide-headers)
6487   (define-key gnus-summary-wash-hide-map "s" 'gnus-article-hide-signature)
6488   (define-key gnus-summary-wash-hide-map "c" 'gnus-article-hide-citation)
6489   (define-key gnus-summary-wash-hide-map "p" 'gnus-article-hide-pgp)
6490   (define-key gnus-summary-wash-hide-map 
6491     "\C-c" 'gnus-article-hide-citation-maybe)
6492
6493   (define-prefix-command 'gnus-summary-wash-highlight-map)
6494   (define-key gnus-summary-wash-map "H" 'gnus-summary-wash-highlight-map)
6495   (define-key gnus-summary-wash-highlight-map "a" 'gnus-article-highlight)
6496   (define-key gnus-summary-wash-highlight-map 
6497     "h" 'gnus-article-highlight-headers)
6498   (define-key gnus-summary-wash-highlight-map
6499     "c" 'gnus-article-highlight-citation)
6500   (define-key gnus-summary-wash-highlight-map
6501     "s" 'gnus-article-highlight-signature)
6502
6503   (define-prefix-command 'gnus-summary-wash-time-map)
6504   (define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map)
6505   (define-key gnus-summary-wash-time-map "z" 'gnus-article-date-ut)
6506   (define-key gnus-summary-wash-time-map "u" 'gnus-article-date-ut)
6507   (define-key gnus-summary-wash-time-map "l" 'gnus-article-date-local)
6508   (define-key gnus-summary-wash-time-map "e" 'gnus-article-date-lapsed)
6509   (define-key gnus-summary-wash-time-map "o" 'gnus-article-date-original)
6510
6511   (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons)
6512   (define-key gnus-summary-wash-map "B" 'gnus-article-add-buttons-to-head)
6513   (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike)
6514   (define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap)
6515   (define-key gnus-summary-wash-map "c" 'gnus-article-remove-cr)
6516   (define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable)
6517   (define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face)
6518   (define-key gnus-summary-wash-map "l" 'gnus-summary-stop-page-breaking)
6519   (define-key gnus-summary-wash-map "r" 'gnus-summary-caesar-message)
6520   (define-key gnus-summary-wash-map "t" 'gnus-summary-toggle-header)
6521   (define-key gnus-summary-wash-map "m" 'gnus-summary-toggle-mime)
6522
6523
6524   (define-prefix-command 'gnus-summary-help-map)
6525   (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map)
6526   (define-key gnus-summary-help-map "v" 'gnus-version)
6527   (define-key gnus-summary-help-map "f" 'gnus-summary-fetch-faq)
6528   (define-key gnus-summary-help-map "d" 'gnus-summary-describe-group)
6529   (define-key gnus-summary-help-map "h" 'gnus-summary-describe-briefly)
6530   (define-key gnus-summary-help-map "i" 'gnus-info-find-node)
6531
6532
6533   (define-prefix-command 'gnus-summary-backend-map)
6534   (define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map)
6535   (define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles)
6536   (define-key gnus-summary-backend-map "\M-\C-e" 
6537     'gnus-summary-expire-articles-now)
6538   (define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article)
6539   (define-key gnus-summary-backend-map "m" 'gnus-summary-move-article)
6540   (define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article)
6541   (define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article)
6542   (define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article)
6543   (define-key gnus-summary-backend-map "q" 'gnus-summary-respool-query)
6544   (define-key gnus-summary-backend-map "i" 'gnus-summary-import-article)
6545
6546
6547   (define-prefix-command 'gnus-summary-save-map)
6548   (define-key gnus-summary-mode-map "O" 'gnus-summary-save-map)
6549   (define-key gnus-summary-save-map "o" 'gnus-summary-save-article)
6550   (define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail)
6551   (define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail)
6552   (define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file)
6553   (define-key gnus-summary-save-map "b" 'gnus-summary-save-article-body-file)
6554   (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder)
6555   (define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm)
6556   (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output)
6557   (define-key gnus-summary-save-map "s" 'gnus-soup-add-article)
6558
6559   (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map)
6560
6561   (define-key gnus-summary-mode-map "\M-&" 'gnus-summary-universal-argument)
6562   (define-key gnus-summary-article-map "D" 'gnus-summary-enter-digest-group)
6563
6564   (define-key gnus-summary-mode-map "V" 'gnus-summary-score-map)
6565
6566   (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-score)
6567   (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-score)
6568   )
6569
6570
6571 \f
6572
6573 (defun gnus-summary-mode (&optional group)
6574   "Major mode for reading articles.
6575
6576 All normal editing commands are switched off.
6577 \\<gnus-summary-mode-map>
6578 Each line in this buffer represents one article.  To read an
6579 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
6580 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', 
6581 respectively.
6582
6583 You can also post articles and send mail from this buffer.  To 
6584 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author 
6585 of an article, type `\\[gnus-summary-reply]'.
6586
6587 There are approx. one gazillion commands you can execute in this 
6588 buffer; read the info pages for more information (`\\[gnus-info-find-node]'). 
6589
6590 The following commands are available:
6591
6592 \\{gnus-summary-mode-map}"
6593   (interactive)
6594   (when (and menu-bar-mode
6595              (gnus-visual-p 'summary-menu 'menu))
6596     (gnus-summary-make-menu-bar))
6597   (kill-all-local-variables)
6598   (let ((locals gnus-summary-local-variables))
6599     (while locals
6600       (if (consp (car locals))
6601           (progn
6602             (make-local-variable (car (car locals)))
6603             (set (car (car locals)) (eval (cdr (car locals)))))
6604         (make-local-variable (car locals))
6605         (set (car locals) nil))
6606       (setq locals (cdr locals))))
6607   (gnus-make-thread-indent-array)
6608   (gnus-simplify-mode-line)
6609   (setq major-mode 'gnus-summary-mode)
6610   (setq mode-name "Summary")
6611   (make-local-variable 'minor-mode-alist)
6612   (use-local-map gnus-summary-mode-map)
6613   (buffer-disable-undo (current-buffer))
6614   (setq buffer-read-only t)             ;Disable modification
6615   (setq truncate-lines t)
6616   (setq selective-display t)
6617   (setq selective-display-ellipses t)   ;Display `...'
6618   (setq buffer-display-table gnus-summary-display-table)
6619   (setq gnus-newsgroup-name group)
6620   (run-hooks 'gnus-summary-mode-hook))
6621
6622 (defun gnus-summary-make-display-table ()
6623   ;; Change the display table.  Odd characters have a tendency to mess
6624   ;; up nicely formatted displays - we make all possible glyphs
6625   ;; display only a single character.
6626
6627   ;; We start from the standard display table, if any.
6628   (setq gnus-summary-display-table 
6629         (or (copy-sequence standard-display-table)
6630             (make-display-table)))
6631   ;; Nix out all the control chars...
6632   (let ((i 32))
6633     (while (>= (setq i (1- i)) 0)
6634       (aset gnus-summary-display-table i [??])))
6635   ;; ... but not newline and cr, of course. (cr is necessary for the
6636   ;; selective display).  
6637   (aset gnus-summary-display-table ?\n nil)
6638   (aset gnus-summary-display-table ?\r nil)
6639   ;; We nix out any glyphs over 126 that are not set already.  
6640   (let ((i 256))
6641     (while (>= (setq i (1- i)) 127)
6642       ;; Only modify if the entry is nil.
6643       (or (aref gnus-summary-display-table i) 
6644           (aset gnus-summary-display-table i [??])))))
6645
6646 (defun gnus-summary-clear-local-variables ()
6647   (let ((locals gnus-summary-local-variables))
6648     (while locals
6649       (if (consp (car locals))
6650           (and (vectorp (car (car locals)))
6651                (set (car (car locals)) nil))
6652         (and (vectorp (car locals))
6653              (set (car locals) nil)))
6654       (setq locals (cdr locals)))))
6655
6656 ;; Summary data functions.
6657
6658 (defmacro gnus-data-number (data)
6659   `(car ,data))
6660
6661 (defmacro gnus-data-mark (data)
6662   `(nth 1 ,data))
6663
6664 (defmacro gnus-data-set-mark (data mark)
6665   `(setcar (nthcdr 1 ,data) ,mark))
6666
6667 (defmacro gnus-data-pos (data)
6668   `(nth 2 ,data))
6669
6670 (defmacro gnus-data-set-pos (data pos)
6671   `(setcar (nthcdr 2 ,data) ,pos))
6672
6673 (defmacro gnus-data-header (data)
6674   `(nth 3 ,data))
6675
6676 (defmacro gnus-data-level (data)
6677   `(nth 4 ,data))
6678
6679 (defmacro gnus-data-unread-p (data)
6680   `(= (nth 1 ,data) gnus-unread-mark))
6681
6682 (defmacro gnus-data-pseudo-p (data)
6683   `(consp (nth 3 ,data)))
6684
6685 (defmacro gnus-data-find (number)
6686   `(assq ,number gnus-newsgroup-data))
6687
6688 (defmacro gnus-data-find-list (number &optional data)
6689   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
6690      (memq (assq ,number bdata)
6691            bdata)))
6692
6693 (defmacro gnus-data-make (number mark pos header level)
6694   `(list ,number ,mark ,pos ,header ,level))
6695
6696 (defun gnus-data-enter (after-article number mark pos header level offset)
6697   (let ((data (gnus-data-find-list after-article)))
6698     (or data (error "No such article: %d" after-article))
6699     (setcdr data (cons (gnus-data-make number mark pos header level)
6700                        (cdr data)))
6701     (setq gnus-newsgroup-data-reverse nil)
6702     (gnus-data-update-list (cdr (cdr data)) offset)))
6703
6704 (defun gnus-data-enter-list (after-article list &optional offset)
6705   (when list
6706     (let ((data (and after-article (gnus-data-find-list after-article)))
6707           (ilist list))
6708       (or data (not after-article) (error "No such article: %d" after-article))
6709       ;; Find the last element in the list to be spliced into the main
6710       ;; list.  
6711       (while (cdr list)
6712         (setq list (cdr list)))
6713       (if (not data)
6714           (progn
6715             (setcdr list gnus-newsgroup-data)
6716             (setq gnus-newsgroup-data ilist)
6717             (and offset (gnus-data-update-list (cdr list) offset)))
6718         (setcdr list (cdr data))
6719         (setcdr data ilist)
6720         (and offset (gnus-data-update-list (cdr data) offset)))
6721       (setq gnus-newsgroup-data-reverse nil))))
6722
6723 (defun gnus-data-remove (article &optional offset)
6724   (let ((data gnus-newsgroup-data))
6725     (if (= (gnus-data-number (car data)) article)
6726         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
6727               gnus-newsgroup-data-reverse nil)
6728       (while (cdr data)
6729         (and (= (gnus-data-number (car (cdr data))) article)
6730              (progn
6731                (setcdr data (cdr (cdr data)))
6732                (and offset (gnus-data-update-list (cdr data) offset))
6733                (setq data nil
6734                      gnus-newsgroup-data-reverse nil)))
6735         (setq data (cdr data))))))
6736
6737 (defmacro gnus-data-list (backward)
6738   `(if ,backward
6739        (or gnus-newsgroup-data-reverse
6740            (setq gnus-newsgroup-data-reverse
6741                  (reverse gnus-newsgroup-data)))
6742      gnus-newsgroup-data))
6743
6744 (defun gnus-data-update-list (data offset)
6745   "Add OFFSET to the POS of all data entries in DATA."
6746   (while data
6747     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
6748     (setq data (cdr data))))
6749
6750 (defun gnus-data-compute-positions ()
6751   "Compute the positions of all articles."
6752   (let ((data gnus-newsgroup-data)
6753         pos)
6754     (while data
6755       (when (setq pos (text-property-any 
6756                        (point-min) (point-max)
6757                        'gnus-number (gnus-data-number (car data))))
6758         (gnus-data-set-pos (car data) (+ pos 3)))
6759       (setq data (cdr data)))))
6760
6761 (defun gnus-summary-article-pseudo-p (article)
6762   "Say whether this article is a pseudo article or not."
6763   (not (vectorp (gnus-data-header (gnus-data-find article)))))
6764
6765 (defun gnus-article-parent-p (number)
6766   "Say whether this article is a parent or not."
6767   (let* ((data (gnus-data-find-list number)))
6768     (and (cdr data)                     ; There has to be an article after...
6769          (< (gnus-data-level (car data)) ; And it has to have a higher level.
6770             (gnus-data-level (nth 1 data))))))
6771     
6772 (defmacro gnus-summary-skip-intangible ()
6773   "If the current article is intangible, then jump to a different article."
6774   '(let ((to (get-text-property (point) 'gnus-intangible)))
6775     (when to
6776       (gnus-summary-goto-subject to))))
6777
6778 (defmacro gnus-summary-article-intangible-p ()
6779   "Say whether this article is intangible or not."
6780   '(get-text-property (point) 'gnus-intangible))
6781
6782 ;; Some summary mode macros.
6783
6784 (defmacro gnus-summary-article-number ()
6785   "The article number of the article on the current line.
6786 If there isn's an article number here, then we return the current
6787 article number."
6788   '(progn
6789      (gnus-summary-skip-intangible)
6790      (or (get-text-property (point) 'gnus-number) 
6791          (progn
6792            (forward-line -1)
6793            gnus-newsgroup-end))))
6794
6795 (defmacro gnus-summary-article-header (&optional number)
6796   `(gnus-data-header (gnus-data-find
6797                       ,(or number '(gnus-summary-article-number)))))
6798
6799 (defmacro gnus-summary-thread-level (&optional number)
6800   `(gnus-data-level (gnus-data-find
6801                      ,(or number '(gnus-summary-article-number)))))
6802
6803 (defmacro gnus-summary-article-mark (&optional number)
6804   `(gnus-data-mark (gnus-data-find
6805                     ,(or number '(gnus-summary-article-number)))))
6806
6807 (defmacro gnus-summary-article-pos (&optional number)
6808   `(gnus-data-pos (gnus-data-find
6809                    ,(or number '(gnus-summary-article-number)))))
6810
6811 (defmacro gnus-summary-article-subject (&optional number)
6812   "Return current subject string or nil if nothing."
6813   `(let ((headers 
6814           ,(if number
6815                `(gnus-data-header (assq ,number gnus-newsgroup-data))
6816              '(gnus-data-header (assq (gnus-summary-article-number)
6817                                       gnus-newsgroup-data)))))
6818      (and headers
6819           (vectorp headers)
6820           (mail-header-subject headers))))
6821
6822 (defmacro gnus-summary-article-score (&optional number)
6823   "Return current article score."
6824   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
6825                   gnus-newsgroup-scored))
6826        gnus-summary-default-score 0))
6827
6828 (defun gnus-summary-article-children (&optional number)
6829   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
6830          (level (gnus-data-level (car data)))
6831          l children)
6832     (while (and (setq data (cdr data))
6833                 (> (setq l (gnus-data-level (car data))) level))
6834       (and (= (1+ level) l)
6835            (setq children (cons (gnus-data-number (car data))
6836                                 children))))
6837     (nreverse children)))
6838
6839 (defun gnus-summary-article-parent (&optional number)
6840   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
6841                                     (gnus-data-list t)))
6842          (level (gnus-data-level (car data)))
6843          l)
6844     (if (zerop level)
6845         () ; This is a root.
6846       ;; We search until we find an article with a level less than
6847       ;; this one.  That function has to be the parent.
6848       (while (and (setq data (cdr data))
6849                   (not (< (gnus-data-level (car data)) level))))
6850       (and data (gnus-data-number (car data))))))
6851
6852
6853 ;; Various summary mode internalish functions.
6854
6855 (defun gnus-mouse-pick-article (e)
6856   (interactive "e")
6857   (mouse-set-point e)
6858   (gnus-summary-next-page nil t))
6859
6860 (defun gnus-summary-setup-buffer (group)
6861   "Initialize summary buffer."
6862   (let ((buffer (concat "*Summary " group "*")))
6863     (if (get-buffer buffer)
6864         (progn
6865           (set-buffer buffer)
6866           (setq gnus-summary-buffer (current-buffer))
6867           (not gnus-newsgroup-prepared))
6868       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
6869       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
6870       (gnus-add-current-to-buffer-list)
6871       (gnus-summary-mode group)
6872       (and gnus-carpal (gnus-carpal-setup-buffer 'summary))
6873       (setq gnus-newsgroup-name group)
6874       t)))
6875
6876 (defun gnus-set-global-variables ()
6877   ;; Set the global equivalents of the summary buffer-local variables
6878   ;; to the latest values they had.  These reflect the summary buffer
6879   ;; that was in action when the last article was fetched.
6880   (if (eq major-mode 'gnus-summary-mode) 
6881       (progn
6882         (setq gnus-summary-buffer (current-buffer))
6883         (let ((name gnus-newsgroup-name)
6884               (marked gnus-newsgroup-marked)
6885               (unread gnus-newsgroup-unreads)
6886               (headers gnus-current-headers)
6887               (data gnus-newsgroup-data)
6888               (score-file gnus-current-score-file))
6889           (save-excursion
6890             (set-buffer gnus-group-buffer)
6891             (setq gnus-newsgroup-name name)
6892             (setq gnus-newsgroup-marked marked)
6893             (setq gnus-newsgroup-unreads unread)
6894             (setq gnus-current-headers headers)
6895             (setq gnus-newsgroup-data data)
6896             (setq gnus-current-score-file score-file))))))
6897
6898 (defun gnus-summary-last-article-p (&optional article)
6899   "Return whether ARTICLE is the last article in the buffer."
6900   (if (not (setq article (or article (gnus-summary-article-number))))
6901       t ; All non-existant numbers are the last article. :-)
6902     (cdr (gnus-data-find-list article))))
6903     
6904 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
6905   "Insert a dummy root in the summary buffer."
6906   (beginning-of-line)
6907   (add-text-properties
6908    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
6909    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
6910
6911 (defvar gnus-thread-indent-array nil)
6912 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
6913 (defun gnus-make-thread-indent-array ()
6914   (let ((n 200))
6915     (if (and gnus-thread-indent-array
6916              (= gnus-thread-indent-level gnus-thread-indent-array-level))
6917         nil
6918       (setq gnus-thread-indent-array (make-vector 201 "")
6919             gnus-thread-indent-array-level gnus-thread-indent-level)
6920       (while (>= n 0)
6921         (aset gnus-thread-indent-array n
6922               (make-string (* n gnus-thread-indent-level) ? ))
6923         (setq n (1- n))))))
6924
6925 (defun gnus-summary-insert-line 
6926   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread 
6927                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
6928                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
6929   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
6930          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
6931          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
6932          (gnus-tmp-score-char
6933           (if (or (null gnus-summary-default-score)
6934                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
6935                       gnus-summary-zcore-fuzz)) ? 
6936             (if (< gnus-tmp-score gnus-summary-default-score)
6937                 gnus-score-below-mark gnus-score-over-mark)))
6938          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
6939                                  (gnus-tmp-replied gnus-replied-mark)
6940                                  (t gnus-unread-mark)))
6941          (gnus-tmp-from (mail-header-from gnus-tmp-header))
6942          (gnus-tmp-name 
6943           (cond 
6944            ((string-match "(.+)" gnus-tmp-from)
6945             (substring gnus-tmp-from 
6946                        (1+ (match-beginning 0)) (1- (match-end 0))))
6947            ((string-match "<[^>]+> *$" gnus-tmp-from)
6948             (let ((beg (match-beginning 0)))
6949               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
6950                        (substring gnus-tmp-from (1+ (match-beginning 0))
6951                                   (1- (match-end 0))))
6952                   (substring gnus-tmp-from 0 beg))))
6953            (t gnus-tmp-from)))
6954          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
6955          (gnus-tmp-number (mail-header-number gnus-tmp-header))
6956          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
6957          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
6958          (buffer-read-only nil))
6959     (when (string= gnus-tmp-name "")
6960       (setq gnus-tmp-name gnus-tmp-from))
6961     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
6962     (put-text-property
6963      (point)
6964      (progn (eval gnus-summary-line-format-spec) (point))
6965      'gnus-number gnus-tmp-number)
6966     (when (gnus-visual-p 'summary-highlight 'highlight)
6967       (forward-line -1)
6968       (run-hooks 'gnus-summary-update-hook)
6969       (forward-line 1))))
6970
6971 (defun gnus-summary-update-line (&optional dont-update)
6972   ;; Update summary line after change.
6973   (when (and gnus-summary-default-score
6974              (not gnus-summary-inhibit-highlight))
6975     (let ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
6976           (article (gnus-summary-article-number)))
6977       (unless dont-update
6978         (if (and gnus-summary-mark-below
6979                  (< (gnus-summary-article-score)
6980                     gnus-summary-mark-below))
6981             ;; This article has a low score, so we mark it as read.
6982             (when (memq article gnus-newsgroup-unreads)
6983               (gnus-summary-mark-article-as-read gnus-low-score-mark))
6984           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
6985             ;; This article was previously marked as read on account
6986             ;; of a low score, but now it has risen, so we mark it as
6987             ;; unread. 
6988             (gnus-summary-mark-article-as-unread gnus-unread-mark))))
6989       ;; Do visual highlighting.
6990       (when (gnus-visual-p 'summary-highlight 'highlight)
6991         (run-hooks 'gnus-summary-update-hook)))))
6992
6993 (defvar gnus-tmp-new-adopts)
6994
6995 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
6996   ;; Sum up all elements (and sub-elements) in a list.
6997   (let* ((number
6998           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
6999           (cond ((and (consp thread) (cdr thread))
7000                  (apply
7001                   '+ 1 (mapcar
7002                         'gnus-summary-number-of-articles-in-thread 
7003                         (cdr thread))))
7004                 ((null thread)
7005                  1)
7006                 ((and level (zerop level) gnus-tmp-new-adopts)
7007                  (apply '+ 1 (mapcar 
7008                               'gnus-summary-number-of-articles-in-thread 
7009                               gnus-tmp-new-adopts)))
7010                 ((memq (mail-header-number (car thread))
7011                        gnus-newsgroup-limit)
7012                  1) 
7013                 (t 0))))
7014     (if char 
7015         (if (> number 1) gnus-not-empty-thread-mark
7016           gnus-empty-thread-mark)
7017       number)))
7018
7019 (defun gnus-summary-set-local-parameters (group)
7020  "Go through the local params of GROUP and set all variable specs in that list."
7021   (let ((params (gnus-info-params (gnus-get-info group)))
7022         elem)
7023     (while params
7024       (setq elem (car params)
7025             params (cdr params))
7026       (and (consp elem)                 ; Has to be a cons.
7027            (consp (cdr elem))           ; The cdr has to be a list.
7028            (symbolp (car elem))         ; Has to be a symbol in there.
7029            (progn                       ; So we set it.
7030              (make-local-variable (car elem))
7031              (set (car elem) (eval (nth 1 elem))))))))
7032
7033 (defun gnus-summary-read-group 
7034   (group &optional show-all no-article kill-buffer no-display)
7035   "Start reading news in newsgroup GROUP.
7036 If SHOW-ALL is non-nil, already read articles are also listed.
7037 If NO-ARTICLE is non-nil, no article is selected initially.
7038 If NO-DISPLAY, don't generate a summary buffer."
7039   (gnus-message 5 "Retrieving newsgroup: %s..." group)
7040   (let* ((new-group (gnus-summary-setup-buffer group))
7041          (quit-config (gnus-group-quit-config group))
7042          (did-select (and new-group (gnus-select-newsgroup group show-all))))
7043     (cond 
7044      ;; This summary buffer exists already, so we just select it. 
7045      ((not new-group)
7046       (gnus-set-global-variables)
7047       (gnus-kill-buffer kill-buffer)
7048       (gnus-configure-windows 'summary 'force)
7049       (gnus-set-mode-line 'summary)
7050       (gnus-summary-position-point)
7051       (message "")
7052       t)
7053      ;; We couldn't select this group.
7054      ((null did-select) 
7055       (when (and (eq major-mode 'gnus-summary-mode)
7056                  (not (equal (current-buffer) kill-buffer)))
7057         (kill-buffer (current-buffer))
7058         (if (not quit-config)
7059             (progn
7060               (set-buffer gnus-group-buffer)
7061               (gnus-group-jump-to-group group)
7062               (gnus-group-next-unread-group 1))
7063           (if (not (buffer-name (car quit-config)))
7064               (gnus-configure-windows 'group 'force)
7065             (set-buffer (car quit-config))
7066             (and (eq major-mode 'gnus-summary-mode)
7067                  (gnus-set-global-variables))
7068             (gnus-configure-windows (cdr quit-config)))))
7069       (message "Can't select group")
7070       nil)
7071      ;; The user did a `C-g' while prompting for number of articles,
7072      ;; so we exit this group.
7073      ((eq did-select 'quit)
7074       (and (eq major-mode 'gnus-summary-mode)
7075            (not (equal (current-buffer) kill-buffer))
7076            (kill-buffer (current-buffer)))
7077       (gnus-kill-buffer kill-buffer)
7078       (if (not quit-config)
7079           (progn
7080             (set-buffer gnus-group-buffer)
7081             (gnus-group-jump-to-group group)
7082             (gnus-group-next-unread-group 1)
7083             (gnus-configure-windows 'group 'force))
7084         (if (not (buffer-name (car quit-config)))
7085             (gnus-configure-windows 'group 'force)
7086           (set-buffer (car quit-config))
7087           (and (eq major-mode 'gnus-summary-mode)
7088                (gnus-set-global-variables))
7089           (gnus-configure-windows (cdr quit-config))))
7090       ;; Finallt signal the quit.
7091       (signal 'quit nil))
7092      ;; The group was successfully selected.
7093      (t
7094       (gnus-set-global-variables)
7095       ;; Save the active value in effect when the group was entered.
7096       (setq gnus-newsgroup-active 
7097             (gnus-copy-sequence
7098              (gnus-active gnus-newsgroup-name)))
7099       ;; You can change the summary buffer in some way with this hook.
7100       (run-hooks 'gnus-select-group-hook)
7101       ;; Set any local variables in the group parameters.
7102       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7103       ;; Do score processing.
7104       (when gnus-use-scoring
7105         (gnus-possibly-score-headers))
7106       (gnus-update-format-specifications)
7107       ;; Find the initial limit.
7108       (gnus-summary-initial-limit)
7109       ;; Generate the summary buffer.
7110       (unless no-display
7111         (gnus-summary-prepare))
7112       ;; If the summary buffer is empty, but there are some low-scored
7113       ;; articles or some excluded dormants, we include these in the
7114       ;; buffer. 
7115       (when (zerop (buffer-size))
7116         (cond (gnus-newsgroup-dormant
7117                (gnus-summary-limit-include-dormant))
7118               ((and gnus-newsgroup-scored show-all)
7119                (gnus-summary-limit-include-expunged))))
7120       ;; Function `gnus-apply-kill-file' must be called in this hook.
7121       (run-hooks 'gnus-apply-kill-hook)
7122       (if (zerop (buffer-size))
7123           (progn
7124             ;; This newsgroup is empty.
7125             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7126             (gnus-message 6 "No unread news")
7127             (gnus-kill-buffer kill-buffer)
7128             ;; Return nil from this function.
7129             nil)
7130         ;; Hide conversation thread subtrees.  We cannot do this in
7131         ;; gnus-summary-prepare-hook since kill processing may not
7132         ;; work with hidden articles.
7133         (and gnus-show-threads
7134              gnus-thread-hide-subtree
7135              (gnus-summary-hide-all-threads))
7136         ;; Show first unread article if requested.
7137         (if (and (not no-article)
7138                  gnus-newsgroup-unreads
7139                  gnus-auto-select-first)
7140             (progn
7141               (if (eq gnus-auto-select-first 'best)
7142                   (gnus-summary-best-unread-article)
7143                 (gnus-summary-first-unread-article)))
7144           ;; Don't select any articles, just move point to the first
7145           ;; article in the group.
7146           (goto-char (point-min))
7147           (gnus-summary-position-point)
7148           (gnus-set-mode-line 'summary)
7149           (gnus-configure-windows 'summary 'force))
7150         ;; If we are in async mode, we send some info to the backend.
7151         (when gnus-newsgroup-async
7152           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7153         (gnus-kill-buffer kill-buffer)
7154         (when (get-buffer-window gnus-group-buffer)
7155           ;; Gotta use windows, because recenter does wierd stuff if
7156           ;; the current buffer ain't the displayed window.
7157           (let ((owin (selected-window))) 
7158             (select-window (get-buffer-window gnus-group-buffer))
7159             (when (gnus-group-goto-group group)
7160               (recenter))
7161             (select-window owin))))
7162       ;; Mark this buffer as "prepared".
7163       (setq gnus-newsgroup-prepared t)
7164       t))))
7165
7166 (defun gnus-summary-prepare ()
7167   "Generate the summary buffer."
7168   (let ((buffer-read-only nil))
7169     (erase-buffer)
7170     (setq gnus-newsgroup-data nil
7171           gnus-newsgroup-data-reverse nil)
7172     (run-hooks 'gnus-summary-generate-hook)
7173     ;; Generate the buffer, either with threads or without.
7174     (gnus-summary-prepare-threads 
7175      (if gnus-show-threads
7176          (gnus-gather-threads (gnus-sort-threads (gnus-make-threads)))
7177        gnus-newsgroup-headers))
7178     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7179     ;; Call hooks for modifying summary buffer.
7180     (goto-char (point-min))
7181     (run-hooks 'gnus-summary-prepare-hook)))
7182
7183 (defun gnus-gather-threads (threads)
7184   "Gather threads that have lost their roots."
7185   (if (not gnus-summary-make-false-root)
7186       threads 
7187     (let ((hashtb (gnus-make-hashtable 1023))
7188           (prev threads)
7189           (result threads)
7190           subject hthread whole-subject)
7191       (while threads
7192         (setq whole-subject 
7193               (setq subject (mail-header-subject (car (car threads)))))
7194         (if (and gnus-summary-gather-exclude-subject
7195                  (string-match gnus-summary-gather-exclude-subject
7196                                subject))
7197             () ; We don't want to do anything with this.
7198           (if gnus-summary-gather-subject-limit
7199               (or (and (numberp gnus-summary-gather-subject-limit)
7200                        (> (length subject) gnus-summary-gather-subject-limit)
7201                        (setq subject
7202                              (substring subject 0 
7203                                         gnus-summary-gather-subject-limit)))
7204                   (and (eq 'fuzzy gnus-summary-gather-subject-limit)
7205                        (setq subject (gnus-simplify-subject-fuzzy subject))))
7206             (setq subject (gnus-simplify-subject-re subject)))
7207           (if (setq hthread 
7208                     (gnus-gethash subject hashtb))
7209               (progn
7210                 (or (stringp (car (car hthread)))
7211                     (setcar hthread (list whole-subject (car hthread))))
7212                 (setcdr (car hthread) (nconc (cdr (car hthread)) 
7213                                              (list (car threads))))
7214                 (setcdr prev (cdr threads))
7215                 (setq threads prev))
7216             (gnus-sethash subject threads hashtb)))
7217         (setq prev threads)
7218         (setq threads (cdr threads)))
7219       result)))
7220
7221 (defun gnus-make-threads ()
7222   "Go through the dependency hashtb and find the roots.  Return all threads."
7223   ;; Then we find all the roots and return all the threads.
7224   (let (threads)
7225     (mapatoms
7226      (lambda (refs)
7227        (or (car (symbol-value refs))
7228            (setq threads (append (cdr (symbol-value refs)) threads))))
7229      gnus-newsgroup-dependencies)
7230     threads))
7231   
7232 (defun gnus-build-old-threads ()
7233   ;; Look at all the articles that refer back to old articles, and
7234   ;; fetch the headers for the articles that aren't there.  This will
7235   ;; build complete threads - if the roots haven't been expired by the
7236   ;; server, that is.
7237   (let (id heads)
7238     (mapatoms
7239      (lambda (refs)
7240        (when (not (car (symbol-value refs)))
7241          (setq heads (cdr (symbol-value refs)))
7242          (while heads
7243            (if (memq (mail-header-number (car (car heads)))
7244                      gnus-newsgroup-dormant)
7245                (setq heads (cdr heads))
7246              (setq id (symbol-name refs))
7247              (while (and (setq id (gnus-build-get-header id))
7248                          (not (car (gnus-gethash 
7249                                     id gnus-newsgroup-dependencies)))))
7250              (setq heads nil)))))
7251      gnus-newsgroup-dependencies)))
7252
7253 (defun gnus-build-get-header (id)
7254   ;; Look through the buffer of NOV lines and find the header to
7255   ;; ID.  Enter this line into the dependencies hash table, and return
7256   ;; the id of the parent article (if any).
7257   (let ((deps gnus-newsgroup-dependencies)
7258         found header)
7259     (prog1
7260         (save-excursion
7261           (set-buffer nntp-server-buffer)
7262           (goto-char (point-min))
7263           (while (and (not found) (search-forward id nil t))
7264             (beginning-of-line)
7265             (setq found (looking-at 
7266                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
7267                                  (regexp-quote id))))
7268             (or found (beginning-of-line 2)))
7269           (when found
7270             (let (ref)
7271               (beginning-of-line)
7272               (and
7273                (setq header (gnus-nov-parse-line 
7274                              (read (current-buffer)) deps))
7275                (gnus-parent-id (mail-header-references header))))))
7276       (when header
7277         (let ((number (mail-header-number header)))
7278           (push number gnus-newsgroup-limit)
7279           (push header gnus-newsgroup-headers)
7280           (push number gnus-newsgroup-ancient))))))
7281
7282 (defun gnus-rebuild-thread (id)
7283   "Rebuild the thread containing ID."
7284   (let ((dep gnus-newsgroup-dependencies)
7285         (buffer-read-only nil)
7286         current headers refs thread art data)
7287     (if (not gnus-show-threads)
7288         (setq thread (list (car (gnus-gethash (downcase id) dep))))
7289       ;; Get the thread this article is part of.
7290       (setq thread (gnus-remove-thread id)))
7291     (setq current (save-excursion
7292                     (and (zerop (forward-line -1))
7293                          (gnus-summary-article-number))))
7294     ;; If this is a gathered thread, we have to go some re-gathering.
7295     (when (stringp (car thread))
7296       (let ((subject (car thread))
7297             roots thr)
7298         (setq thread (cdr thread))
7299         (while thread
7300           (unless (memq (setq thr (gnus-id-to-thread 
7301                                       (gnus-root-id
7302                                        (mail-header-id (car (car thread))))))
7303                         roots)
7304             (push thr roots))
7305           (setq thread (cdr thread)))
7306         ;; We now have all (unique) roots.
7307         (if (= (length roots) 1)
7308             ;; All the loose roots are now one solid root.
7309             (setq thread (car roots))
7310           (setq thread (cons subject (gnus-sort-threads roots))))))
7311     (let ((beg (point)) 
7312           threads)
7313       ;; We then insert this thread into the summary buffer.
7314       (let (gnus-newsgroup-data gnus-newsgroup-threads)
7315         (gnus-summary-prepare-threads (list thread))
7316         (setq data (nreverse gnus-newsgroup-data))
7317         (setq threads gnus-newsgroup-threads))
7318       ;; We splice the new data into the data structure.
7319       (gnus-data-enter-list current data)
7320       (gnus-data-compute-positions)
7321       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
7322
7323 (defun gnus-id-to-thread (id)
7324   "Return the (sub-)thread where ID appears."
7325   (gnus-gethash (downcase id) gnus-newsgroup-dependencies))
7326
7327 (defun gnus-root-id (id)
7328   "Return the id of the root of the thread where ID appears."
7329   (let (last-id prev)
7330     (while (and id (setq prev (car (gnus-gethash 
7331                                     (downcase id)
7332                                     gnus-newsgroup-dependencies))))
7333       (setq last-id id
7334             id (gnus-parent-id (mail-header-references prev))))
7335     last-id))
7336
7337 (defun gnus-remove-thread (id)
7338   "Remove the thread that has ID in it."
7339   (let ((dep gnus-newsgroup-dependencies)
7340         headers thread prev last-id)
7341     ;; First go up in this thread until we find the root.
7342     (setq last-id (gnus-root-id id))
7343     (setq headers (list (car (gnus-id-to-thread last-id))
7344                         (car (car (cdr (gnus-id-to-thread last-id))))))
7345     ;; We have now found the real root of this thread.  It might have
7346     ;; been gathered into some loose thread, so we have to search
7347     ;; through the threads to find the thread we wanted.
7348     (let ((threads gnus-newsgroup-threads)
7349           sub)
7350       (while threads
7351         (setq sub (car threads))
7352         (if (stringp (car sub))
7353             ;; This is a gathered threads, so we look at the roots
7354             ;; below it to find whether this article in in this
7355             ;; gathered root.
7356             (progn
7357               (setq sub (cdr sub))
7358               (while sub
7359                 (when (member (car (car sub)) headers)
7360                   (setq thread (car threads)
7361                         threads nil
7362                         sub nil))
7363                 (setq sub (cdr sub))))
7364           ;; It's an ordinary thread, so we check it.
7365           (when (eq (car sub) (car headers))
7366             (setq thread sub
7367                   threads nil)))
7368         (setq threads (cdr threads)))
7369       ;; If this article is in no thread, then it's a root. 
7370       (if thread 
7371           (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))
7372         (setq thread (gnus-gethash (downcase last-id) dep)))
7373       (when thread
7374         (prog1 
7375             thread ; We return this thread.
7376           (if (stringp (car thread))
7377               (progn
7378                 ;; If we use dummy roots, then we have to remove the
7379                 ;; dummy root as well.
7380                 (when (eq gnus-summary-make-false-root 'dummy)
7381                   ;; Uhm.
7382                   )
7383                 (setq thread (cdr thread))
7384                 (while thread
7385                   (gnus-remove-thread-1 (car thread))
7386                   (setq thread (cdr thread))))
7387             (gnus-remove-thread-1 thread)))))))
7388
7389 (defun gnus-remove-thread-1 (thread)
7390   "Remove the thread THREAD recursively."
7391   (let ((number (mail-header-number (car thread)))
7392         pos)
7393     (when (setq pos (text-property-any 
7394                      (point-min) (point-max) 'gnus-number number))
7395       (goto-char pos)
7396       (gnus-delete-line)
7397       (gnus-data-remove number))
7398     (setq thread (cdr thread))
7399     (while thread
7400       (gnus-remove-thread-1 (car thread))
7401       (setq thread (cdr thread)))))
7402
7403 (defun gnus-sort-threads (threads)
7404   "Sort THREADS as specified in `gnus-thread-sort-functions'."
7405   (let ((funs gnus-thread-sort-functions))
7406     (when funs
7407       (while funs
7408         (gnus-message 7 "Sorting with %S..." (car funs))
7409         (setq threads (sort threads (pop funs))))
7410       (gnus-message 7 "Sorting...done")))
7411   threads)
7412
7413 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
7414 (defmacro gnus-thread-header (thread)
7415   ;; Return header of first article in THREAD.
7416   ;; Note that THREAD must never, evr be anything else than a variable -
7417   ;; using some other form will lead to serious barfage.
7418   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
7419   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
7420   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; 
7421         (vector thread) 2))
7422
7423 (defun gnus-thread-sort-by-number (h1 h2)
7424   "Sort threads by root article number."
7425   (< (mail-header-number (gnus-thread-header h1))
7426      (mail-header-number (gnus-thread-header h2))))
7427
7428 (defun gnus-thread-sort-by-author (h1 h2)
7429   "Sort threads by root author."
7430   (string-lessp
7431    (let ((extract (funcall 
7432                    gnus-extract-address-components
7433                    (mail-header-from (gnus-thread-header h1)))))
7434      (or (car extract) (cdr extract)))
7435    (let ((extract (funcall
7436                    gnus-extract-address-components 
7437                    (mail-header-from (gnus-thread-header h2)))))
7438      (or (car extract) (cdr extract)))))
7439
7440 (defun gnus-thread-sort-by-subject (h1 h2)
7441   "Sort threads by root subject."
7442   (string-lessp
7443    (downcase (gnus-simplify-subject-re
7444               (mail-header-subject (gnus-thread-header h1))))
7445    (downcase (gnus-simplify-subject-re 
7446               (mail-header-subject (gnus-thread-header h2))))))
7447
7448 (defun gnus-thread-sort-by-date (h1 h2)
7449   "Sort threads by root article date."
7450   (string-lessp
7451    (gnus-sortable-date (mail-header-date (gnus-thread-header h1)))
7452    (gnus-sortable-date (mail-header-date (gnus-thread-header h2)))))
7453
7454 (defun gnus-thread-sort-by-score (h1 h2)
7455   "Sort threads by root article score.
7456 Unscored articles will be counted as having a score of zero."
7457   (> (or (cdr (assq (mail-header-number (gnus-thread-header h1))
7458                     gnus-newsgroup-scored))
7459          gnus-summary-default-score 0)
7460      (or (cdr (assq (mail-header-number (gnus-thread-header h2))
7461                     gnus-newsgroup-scored))
7462          gnus-summary-default-score 0)))
7463
7464 (defun gnus-thread-sort-by-total-score (h1 h2)
7465   "Sort threads by the sum of all scores in the thread.
7466 Unscored articles will be counted as having a score of zero."
7467   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
7468
7469 (defun gnus-thread-total-score (thread)
7470   ;;  This function find the total score of THREAD.
7471   (if (consp thread)
7472       (if (stringp (car thread))
7473           (apply gnus-thread-score-function 0
7474                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
7475         (gnus-thread-total-score-1 thread))
7476     (gnus-thread-total-score-1 (list thread))))
7477
7478 (defun gnus-thread-total-score-1 (root)
7479   ;; This function find the total score of the thread below ROOT.
7480   (setq root (car root))
7481   (apply gnus-thread-score-function
7482          (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
7483              gnus-summary-default-score 0)
7484          (mapcar 'gnus-thread-total-score
7485                  (cdr (gnus-gethash (downcase (mail-header-id root))
7486                                     gnus-newsgroup-dependencies)))))
7487
7488 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
7489 (defvar gnus-tmp-prev-subject nil)
7490 (defvar gnus-tmp-false-parent nil)
7491 (defvar gnus-tmp-root-expunged nil)
7492 (defvar gnus-tmp-dummy-line nil)
7493
7494 (defun gnus-summary-prepare-threads (threads)
7495   "Prepare summary buffer from THREADS and indentation LEVEL.  
7496 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'  
7497 or a straight list of headers."
7498   (message "Generating summary...")
7499
7500   (setq gnus-newsgroup-threads threads)
7501   (beginning-of-line)
7502
7503   (let ((gnus-tmp-level 0)
7504         (default-score (or gnus-summary-default-score 0))
7505         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
7506         thread number subject stack state gnus-tmp-gathered beg-match
7507         new-roots gnus-tmp-new-adopts thread-end
7508         gnus-tmp-header gnus-tmp-unread
7509         gnus-tmp-replied gnus-tmp-subject-or-nil
7510         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
7511         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
7512         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
7513
7514     (setq gnus-tmp-prev-subject nil)
7515
7516     (if (vectorp (car threads))
7517         ;; If this is a straight (sic) list of headers, then a
7518         ;; threaded summary display isn't required, so we just create
7519         ;; an unthreaded one.
7520         (gnus-summary-prepare-unthreaded threads)
7521
7522       ;; Do the threaded display.
7523
7524       (while (or threads stack gnus-tmp-new-adopts new-roots)
7525
7526         (if (and (= gnus-tmp-level 0)
7527                  (not (setq gnus-tmp-dummy-line nil))
7528                  (or (not stack)
7529                      (= (car (car stack)) 0))
7530                  (not gnus-tmp-false-parent)
7531                  (or gnus-tmp-new-adopts new-roots))
7532             (if gnus-tmp-new-adopts
7533                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
7534                       thread (list (car gnus-tmp-new-adopts))
7535                       gnus-tmp-header (car (car thread))
7536                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
7537               (if new-roots
7538                   (setq thread (list (car new-roots))
7539                         gnus-tmp-header (car (car thread))
7540                         new-roots (cdr new-roots))))
7541
7542           (if threads
7543               ;; If there are some threads, we do them before the
7544               ;; threads on the stack.
7545               (setq thread threads
7546                     gnus-tmp-header (car (car thread)))
7547             ;; There were no current threads, so we pop something off
7548             ;; the stack. 
7549             (setq state (car stack)
7550                   gnus-tmp-level (car state)
7551                   thread (cdr state)
7552                   stack (cdr stack)
7553                   gnus-tmp-header (car (car thread)))))
7554
7555         (setq gnus-tmp-false-parent nil)
7556         (setq gnus-tmp-root-expunged nil)
7557         (setq thread-end nil)
7558
7559         (if (stringp gnus-tmp-header)
7560             ;; The header is a dummy root.
7561             (cond 
7562              ((eq gnus-summary-make-false-root 'adopt)
7563               ;; We let the first article adopt the rest.
7564               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
7565                                                (cdr (cdr (car thread)))))
7566               (setq gnus-tmp-gathered 
7567                     (nconc (mapcar
7568                             (lambda (h) (mail-header-number (car h)))
7569                             (cdr (cdr (car thread))))
7570                            gnus-tmp-gathered))
7571               (setq thread (cons (list (car (car thread))
7572                                        (car (cdr (car thread))))
7573                                  (cdr thread)))
7574               (setq gnus-tmp-level -1
7575                     gnus-tmp-false-parent t))
7576              ((eq gnus-summary-make-false-root 'empty)
7577               ;; We print adopted articles with empty subject fields.
7578               (setq gnus-tmp-gathered 
7579                     (nconc (mapcar
7580                             (lambda (h) (mail-header-number (car h)))
7581                             (cdr (cdr (car thread))))
7582                            gnus-tmp-gathered))
7583               (setq gnus-tmp-level -1))
7584              ((eq gnus-summary-make-false-root 'dummy)
7585               ;; We remember that we probably want to output a dummy
7586               ;; root.   
7587               (setq gnus-tmp-dummy-line gnus-tmp-header)
7588               (setq gnus-tmp-prev-subject gnus-tmp-header))
7589              (t
7590               ;; We do not make a root for the gathered
7591               ;; sub-threads at all.  
7592               (setq gnus-tmp-level -1)))
7593       
7594           (setq number (mail-header-number gnus-tmp-header)
7595                 subject (mail-header-subject gnus-tmp-header))
7596
7597           (cond 
7598            ;; If the thread has changed subject, we might want to make 
7599            ;; this subthread into a root.
7600            ((and (null gnus-thread-ignore-subject)
7601                  (not (zerop gnus-tmp-level))
7602                  gnus-tmp-prev-subject
7603                  (not (inline
7604                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
7605             (setq new-roots (nconc new-roots (list (car thread)))
7606                   thread-end t
7607                   gnus-tmp-header nil))
7608            ;; If the article lies outside the current limit,
7609            ;; then we do not display it.
7610            ((not (memq number gnus-newsgroup-limit))
7611             (setq gnus-tmp-gathered 
7612                   (nconc (mapcar
7613                           (lambda (h) (mail-header-number (car h)))
7614                           (cdr (car thread)))
7615                          gnus-tmp-gathered))
7616             (setq gnus-tmp-new-adopts (if (cdr (car thread))
7617                                           (append gnus-tmp-new-adopts 
7618                                                   (cdr (car thread)))
7619                                         gnus-tmp-new-adopts)
7620                   thread-end t
7621                   gnus-tmp-header nil)
7622             (when (zerop gnus-tmp-level)
7623               (setq gnus-tmp-root-expunged t)))
7624            ;; Perhaps this article is to be marked as read?
7625            ((and gnus-summary-mark-below
7626                  (< (or (cdr (assq number gnus-newsgroup-scored))
7627                         default-score)
7628                     gnus-summary-mark-below))
7629             (setq gnus-newsgroup-unreads 
7630                   (delq number gnus-newsgroup-unreads))
7631             (if gnus-newsgroup-auto-expire
7632                 (push number gnus-newsgroup-expirable)
7633               (push (cons number gnus-low-score-mark)
7634                     gnus-newsgroup-reads))))
7635           
7636           (when gnus-tmp-header
7637             ;; We may have an old dummy line to output before this
7638             ;; article.  
7639             (when gnus-tmp-dummy-line
7640               (gnus-summary-insert-dummy-line 
7641                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
7642               (setq gnus-tmp-dummy-line nil))
7643
7644             ;; Compute the mark.
7645             (setq 
7646              gnus-tmp-unread
7647              (cond 
7648               ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
7649               ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
7650               ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
7651               ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
7652               (t (or (cdr (assq number gnus-newsgroup-reads))
7653                      gnus-ancient-mark))))
7654
7655             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
7656                                   gnus-tmp-header gnus-tmp-level)
7657                   gnus-newsgroup-data)
7658
7659             ;; Actually insert the line.
7660             (setq 
7661              gnus-tmp-subject-or-nil
7662              (cond
7663               ((and gnus-thread-ignore-subject
7664                     gnus-tmp-prev-subject
7665                     (not (inline (gnus-subject-equal 
7666                                   gnus-tmp-prev-subject subject))))
7667                subject)
7668               ((zerop gnus-tmp-level)
7669                (if (and (eq gnus-summary-make-false-root 'empty)
7670                         (memq number gnus-tmp-gathered)
7671                         gnus-tmp-prev-subject
7672                         (inline (gnus-subject-equal
7673                                  gnus-tmp-prev-subject subject)))
7674                    gnus-summary-same-subject
7675                  subject))
7676               (t gnus-summary-same-subject)))
7677             (if (and (eq gnus-summary-make-false-root 'adopt)
7678                      (= gnus-tmp-level 1)
7679                      (memq number gnus-tmp-gathered))
7680                 (setq gnus-tmp-opening-bracket ?\<
7681                       gnus-tmp-closing-bracket ?\>)
7682               (setq gnus-tmp-opening-bracket ?\[
7683                     gnus-tmp-closing-bracket ?\]))
7684             (setq 
7685              gnus-tmp-indentation 
7686              (aref gnus-thread-indent-array gnus-tmp-level)
7687              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
7688              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
7689                                 gnus-summary-default-score 0)
7690              gnus-tmp-score-char
7691              (if (or (null gnus-summary-default-score)
7692                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7693                          gnus-summary-zcore-fuzz)) ? 
7694                (if (< gnus-tmp-score gnus-summary-default-score)
7695                    gnus-score-below-mark gnus-score-over-mark))
7696              gnus-tmp-replied
7697              (cond ((memq number gnus-newsgroup-processable)
7698                     gnus-process-mark)
7699                    ((memq number gnus-newsgroup-replied)
7700                     gnus-replied-mark)
7701                    (t gnus-unread-mark))
7702              gnus-tmp-from (mail-header-from gnus-tmp-header)
7703              gnus-tmp-name 
7704              (cond 
7705               ((string-match "(.+)" gnus-tmp-from)
7706                (substring gnus-tmp-from 
7707                           (1+ (match-beginning 0)) (1- (match-end 0))))
7708               ((string-match "<[^>]+> *$" gnus-tmp-from)
7709                (setq beg-match (match-beginning 0))
7710                (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7711                         (substring gnus-tmp-from (1+ (match-beginning 0))
7712                                    (1- (match-end 0))))
7713                    (substring gnus-tmp-from 0 beg-match)))
7714               (t gnus-tmp-from)))
7715             (when (string= gnus-tmp-name "")
7716               (setq gnus-tmp-name gnus-tmp-from))
7717             (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7718             (put-text-property
7719              (point)
7720              (progn (eval gnus-summary-line-format-spec) (point))
7721              'gnus-number number)
7722             (when gnus-visual-p
7723               (forward-line -1)
7724               (run-hooks 'gnus-summary-update-hook)
7725               (forward-line 1))
7726
7727             (setq gnus-tmp-prev-subject subject)))
7728
7729         (when (nth 1 thread) 
7730           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
7731         (incf gnus-tmp-level)
7732         (setq threads (if thread-end nil (cdr (car thread))))
7733         (unless threads
7734           (setq gnus-tmp-level 0)))))
7735   (message "Generating summary...done"))
7736
7737 (defun gnus-summary-prepare-unthreaded (headers)
7738   "Generate an unthreaded summary buffer based on HEADERS."
7739   (let (header number mark)
7740
7741     (while headers
7742       (setq header (car headers)
7743             headers (cdr headers)
7744             number (mail-header-number header))
7745
7746       ;; We may have to root out some bad articles...
7747       (when (memq number gnus-newsgroup-limit)
7748         (when (and gnus-summary-mark-below
7749                    (< (or (cdr (assq number gnus-newsgroup-scored))
7750                           gnus-summary-default-score 0)
7751                       gnus-summary-mark-below))
7752           (setq gnus-newsgroup-unreads 
7753                 (delq number gnus-newsgroup-unreads))
7754           (if gnus-newsgroup-auto-expire
7755               (push number gnus-newsgroup-expirable)
7756             (push (cons number gnus-low-score-mark)
7757                   gnus-newsgroup-reads)))
7758           
7759         (setq mark
7760               (cond 
7761                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
7762                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
7763                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
7764                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
7765                (t (or (cdr (assq number gnus-newsgroup-reads))
7766                       gnus-ancient-mark))))
7767         (setq gnus-newsgroup-data 
7768               (cons (gnus-data-make number mark (1+ (point)) header 0)
7769                     gnus-newsgroup-data))
7770         (gnus-summary-insert-line
7771          header 0 nil mark (memq number gnus-newsgroup-replied)
7772          (memq number gnus-newsgroup-expirable)
7773          (mail-header-subject header) nil
7774          (cdr (assq number gnus-newsgroup-scored))
7775          (memq number gnus-newsgroup-processable))))))
7776
7777 (defun gnus-select-newsgroup (group &optional read-all)
7778   "Select newsgroup GROUP.
7779 If READ-ALL is non-nil, all articles in the group are selected."
7780   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
7781          (info (nth 2 entry))
7782          articles)
7783
7784     (or (gnus-check-server
7785          (setq gnus-current-select-method (gnus-find-method-for-group group)))
7786         (error "Couldn't open server"))
7787     
7788     (or (and entry (not (eq (car entry) t))) ; Either it's active...
7789         (gnus-activate-group group) ; Or we can activate it...
7790         (progn ; Or we bug out.
7791           (kill-buffer (current-buffer))
7792           (error "Couldn't request group %s: %s" 
7793                  group (gnus-status-message group))))
7794
7795     (setq gnus-newsgroup-name group)
7796     (setq gnus-newsgroup-unselected nil)
7797     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
7798
7799     (and gnus-asynchronous
7800          (gnus-check-backend-function 
7801           'request-asynchronous gnus-newsgroup-name)
7802          (setq gnus-newsgroup-async
7803                (gnus-request-asynchronous gnus-newsgroup-name)))
7804
7805     ;; Adjust and set lists of article marks.
7806     (when info
7807       (gnus-adjust-marked-articles info))
7808
7809     (setq gnus-newsgroup-unreads 
7810           (gnus-set-difference
7811            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
7812            gnus-newsgroup-dormant))
7813
7814     (setq gnus-newsgroup-processable nil)
7815     
7816     (setq articles (gnus-articles-to-read group read-all))
7817     
7818     (cond 
7819      ((null articles) 
7820       (gnus-message 3 "Couldn't select newsgroup")
7821       'quit)
7822      ((eq articles 0) nil)
7823      (t
7824       ;; Init the dependencies hash table.
7825       (setq gnus-newsgroup-dependencies 
7826             (gnus-make-hashtable (length articles)))
7827       ;; Retrieve the headers and read them in.
7828       (gnus-message 5 "Fetching headers...")
7829       (setq gnus-newsgroup-headers 
7830             (if (eq 'nov 
7831                     (setq gnus-headers-retrieved-by
7832                           (gnus-retrieve-headers 
7833                            articles gnus-newsgroup-name
7834                            ;; We might want to fetch old headers, but
7835                            ;; not if there is only 1 article.
7836                            (and gnus-fetch-old-headers
7837                                 (or (and 
7838                                      (not (eq gnus-fetch-old-headers 'some))
7839                                      (not (numberp gnus-fetch-old-headers)))
7840                                     (> (length articles) 1))))))
7841                 (gnus-get-newsgroup-headers-xover articles)
7842               (gnus-get-newsgroup-headers)))
7843       (gnus-message 5 "Fetching headers...done")      
7844       ;; Set the initial limit.
7845       (setq gnus-newsgroup-limit (copy-sequence articles))
7846       ;; Remove canceled articles from the list of unread articles.
7847       (setq gnus-newsgroup-unreads
7848             (gnus-set-sorted-intersection 
7849              gnus-newsgroup-unreads
7850              (mapcar (lambda (headers) (mail-header-number headers))
7851                      gnus-newsgroup-headers)))
7852       ;; We might want to build some more threads first.
7853       (and gnus-fetch-old-headers
7854            (eq gnus-headers-retrieved-by 'nov)
7855            (gnus-build-old-threads))
7856       ;; Check whether auto-expire is to be done in this group.
7857       (setq gnus-newsgroup-auto-expire
7858             (gnus-group-auto-expirable-p group))
7859       ;; First and last article in this newsgroup.
7860       (and gnus-newsgroup-headers
7861            (setq gnus-newsgroup-begin 
7862                  (mail-header-number (car gnus-newsgroup-headers)))
7863            (setq gnus-newsgroup-end
7864                  (mail-header-number
7865                   (gnus-last-element gnus-newsgroup-headers))))
7866       (setq gnus-reffed-article-number -1)
7867       ;; GROUP is successfully selected.
7868       (or gnus-newsgroup-headers t)))))
7869
7870 (defun gnus-articles-to-read (group read-all)
7871   ;; Find out what articles the user wants to read.
7872   (let* ((articles
7873           ;; Select all articles if `read-all' is non-nil, or if there
7874           ;; are no unread articles.
7875           (if (or read-all
7876                   (and (zerop (length gnus-newsgroup-marked))
7877                        (zerop (length gnus-newsgroup-unreads))))
7878               (gnus-uncompress-range (gnus-active group))
7879             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked 
7880                           (copy-sequence gnus-newsgroup-unreads))
7881                   '<)))
7882          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
7883          (scored (length scored-list))
7884          (number (length articles))
7885          (marked (+ (length gnus-newsgroup-marked)
7886                     (length gnus-newsgroup-dormant)))
7887          (select
7888           (cond 
7889            ((numberp read-all)
7890             read-all)
7891            (t
7892             (condition-case ()
7893                 (cond 
7894                  ((and (or (<= scored marked) (= scored number))
7895                        (numberp gnus-large-newsgroup)
7896                        (> number gnus-large-newsgroup))
7897                   (let ((input
7898                          (read-string
7899                           (format
7900                            "How many articles from %s (default %d): "
7901                            gnus-newsgroup-name number))))
7902                     (if (string-match "^[ \t]*$" input) number input)))
7903                  ((and (> scored marked) (< scored number))
7904                   (let ((input
7905                          (read-string
7906                           (format "%s %s (%d scored, %d total): "
7907                                   "How many articles from"
7908                                   group scored number))))
7909                     (if (string-match "^[ \t]*$" input)
7910                         number input)))
7911                  (t number))
7912               (quit nil))))))
7913     (setq select (if (stringp select) (string-to-number select) select))
7914     (if (or (null select) (zerop select))
7915         select
7916       (if (and (not (zerop scored)) (<= (abs select) scored))
7917           (progn
7918             (setq articles (sort scored-list '<))
7919             (setq number (length articles)))
7920         (setq articles (copy-sequence articles)))
7921
7922       (if (< (abs select) number)
7923           (if (< select 0) 
7924               ;; Select the N oldest articles.
7925               (setcdr (nthcdr (1- (abs select)) articles) nil)
7926             ;; Select the N most recent articles.
7927             (setq articles (nthcdr (- number select) articles))))
7928       (setq gnus-newsgroup-unselected
7929             (gnus-sorted-intersection
7930              gnus-newsgroup-unreads
7931              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
7932       articles)))
7933
7934 (defun gnus-killed-articles (killed articles)
7935   (let (out)
7936     (while articles
7937       (if (inline (gnus-member-of-range (car articles) killed))
7938           (setq out (cons (car articles) out)))
7939       (setq articles (cdr articles)))
7940     out))
7941
7942 (defun gnus-adjust-marked-articles (info)
7943   "Set all article lists and remove all marks that are no longer legal."
7944   (let* ((marked-lists (gnus-info-marks info))
7945          (active (gnus-active (gnus-info-group info)))
7946          (min (car active))
7947          (max (cdr active))
7948          (types '((marked . tick) (replied . reply) 
7949                   (expirable . expire) (killed . killed)
7950                   (bookmarks . bookmark) (dormant . dormant)
7951                   (scored . score)))
7952          (uncompressed '(score bookmark))
7953          marks var articles article mark)
7954
7955     (while marked-lists
7956       (setq marks (pop marked-lists))
7957       (set (setq var (intern (format "gnus-newsgroup-%s" 
7958                                      (car (rassq (setq mark (car marks)) 
7959                                                  types)))))
7960            (if (memq (car marks) uncompressed) (cdr marks)
7961              (gnus-uncompress-range (cdr marks))))
7962
7963       (setq articles (symbol-value var))
7964
7965       ;; All articles have to be subsets of the active articles.  
7966       (cond 
7967        ;; Adjust "simple" lists.
7968        ((memq mark '(tick dormant expirable reply killed))
7969         (while articles
7970           (when (or (< (setq article (pop articles)) min) (> article max))
7971             (set var (delq article (symbol-value var))))))
7972        ;; Adjust assocs.
7973        ((memq mark '(score bookmark))
7974         (while articles 
7975           (when (or (< (car (setq article (pop articles))) min) 
7976                     (> (car article) max))
7977             (set var (delq article (symbol-value var))))))))))
7978
7979 (defun gnus-update-marks ()
7980   "Enter the various lists of marked articles into the newsgroup info list."
7981   (let ((types '((marked . tick) (replied . reply) 
7982                  (expirable . expire) (killed . killed)
7983                  (bookmarks . bookmark) (dormant . dormant)
7984                  (scored . score)))
7985         (info (gnus-get-info gnus-newsgroup-name))
7986         (uncompressed '(score bookmark killed))
7987         var type list newmarked symbol)
7988     ;; Add all marks lists that are non-nil to the list of marks lists. 
7989     (while types
7990       (setq type (pop types))
7991       (when (setq list (symbol-value 
7992                         (setq symbol
7993                               (intern (format "gnus-newsgroup-%s" 
7994                                               (car type))))))
7995         (setq list (set symbol (sort list '<)))
7996         (push (cons (cdr type) 
7997                     (if (memq (cdr type) uncompressed) list
7998                       (gnus-compress-sequence list t)))
7999               newmarked)))
8000
8001     ;; Enter these new marks into the info of the group.
8002     (if (nthcdr 3 info)
8003         (setcar (nthcdr 3 info) newmarked)
8004       ;; Add the marks lists to the end of the info.
8005       (when newmarked
8006         (setcdr (nthcdr 2 info) (list newmarked))))
8007
8008     ;; Cut off the end of the info if there's nothing else there. 
8009     (let ((i 5))
8010       (while (and (> i 2)
8011                   (not (nth i info)))
8012         (when (nthcdr (decf i) info)
8013           (setcdr (nthcdr i info) nil))))))
8014
8015 (defun gnus-add-marked-articles (group type articles &optional info force)
8016   ;; Add ARTICLES of TYPE to the info of GROUP.
8017   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
8018   ;; add, but replace marked articles of TYPE with ARTICLES.
8019   (let ((info (or info (gnus-get-info group)))
8020         (uncompressed '(score bookmark killed))
8021         marked m)
8022     (or (not info)
8023         (and (not (setq marked (nthcdr 3 info)))
8024              (setcdr (nthcdr 2 info)
8025                      (list (list (cons type (gnus-compress-sequence
8026                                              articles t))))))
8027         (and (not (setq m (assq type (car marked))))
8028              (setcar marked 
8029                      (cons (cons type (gnus-compress-sequence articles t) )
8030                            (car marked))))
8031         (if force
8032             (setcdr m (gnus-compress-sequence articles t))
8033           (setcdr m (gnus-compress-sequence
8034                      (sort (nconc (gnus-uncompress-range m) 
8035                                   (copy-sequence articles)) '<) t))))))
8036          
8037 (defun gnus-set-mode-line (where)
8038   "This function sets the mode line of the article or summary buffers.
8039 If WHERE is `summary', the summary mode line format will be used."
8040   ;; Is this mode line one we keep updated?
8041   (when (memq where gnus-updated-mode-lines)
8042     (let (mode-string)
8043       (save-excursion
8044         ;; We evaluate this in the summary buffer since these
8045         ;; variables are buffer-local to that buffer.
8046         (set-buffer gnus-summary-buffer)
8047         ;; We bind all these variables that are used in the `eval' form
8048         ;; below. 
8049         (let* ((mformat (if (eq where 'article) 
8050                             gnus-article-mode-line-format-spec
8051                           gnus-summary-mode-line-format-spec))
8052                (gnus-tmp-group-name gnus-newsgroup-name)
8053                (gnus-tmp-article-number (or gnus-current-article 0))
8054                (gnus-tmp-unread gnus-newsgroup-unreads)
8055                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
8056                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
8057                (gnus-tmp-unread-and-unselected
8058                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
8059                             (zerop gnus-tmp-unselected)) "")
8060                       ((zerop gnus-tmp-unselected) 
8061                        (format "{%d more}" gnus-tmp-unread-and-unticked))
8062                       (t (format "{%d(+%d) more}"
8063                                  gnus-tmp-unread-and-unticked
8064                                  gnus-tmp-unselected))))
8065                (gnus-tmp-subject
8066                 (if (and gnus-current-headers
8067                          (vectorp gnus-current-headers))
8068                     (mail-header-subject gnus-current-headers) ""))
8069                max-len 
8070                header);; passed as argument to any user-format-funcs
8071           (setq mode-string (eval mformat))
8072           (setq max-len (max 4 (if gnus-mode-non-string-length
8073                                    (- (frame-width) 
8074                                       gnus-mode-non-string-length)
8075                                  (length mode-string))))
8076           ;; We might have to chop a bit of the string off...
8077           (when (> (length mode-string) max-len)
8078             (setq mode-string 
8079                   (concat (gnus-truncate-string mode-string (- max-len 3))
8080                           "...")))
8081           ;; Pad the mode string a bit.
8082           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
8083       ;; Update the mode line.
8084       (setq mode-line-buffer-identification mode-string)
8085       (set-buffer-modified-p t))))
8086
8087 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
8088   "Go through the HEADERS list and add all Xrefs to a hash table.
8089 The resulting hash table is returned, or nil if no Xrefs were found."
8090   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
8091          (virtual (memq 'virtual 
8092                         (assoc (symbol-name (car (gnus-find-method-for-group 
8093                                                   from-newsgroup)))
8094                                gnus-valid-select-methods)))     
8095          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
8096          (xref-hashtb (make-vector 63 0))
8097          start group entry number xrefs header)
8098     (while headers
8099       (setq header (pop headers))
8100       (when (and (setq xrefs (mail-header-xref header))
8101                  (not (memq (setq number (mail-header-number header))
8102                             unreads)))
8103         (setq start 0)
8104         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
8105           (setq start (match-end 0))
8106           (setq group (concat prefix (substring xrefs (match-beginning 1) 
8107                                                 (match-end 1))))
8108           (setq number 
8109                 (string-to-int (substring xrefs (match-beginning 2) 
8110                                           (match-end 2))))
8111           (if (setq entry (gnus-gethash group xref-hashtb))
8112               (setcdr entry (cons number (cdr entry)))
8113             (gnus-sethash group (cons number nil) xref-hashtb)))))
8114     (and start xref-hashtb)))
8115
8116 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
8117   "Look through all the headers and mark the Xrefs as read."
8118   (let ((virtual (memq 'virtual 
8119                        (assoc (symbol-name (car (gnus-find-method-for-group 
8120                                                  from-newsgroup)))
8121                               gnus-valid-select-methods)))
8122         name entry info xref-hashtb idlist method
8123         nth4)
8124     (save-excursion
8125       (set-buffer gnus-group-buffer)
8126       (when (setq xref-hashtb 
8127                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
8128         (mapatoms 
8129          (lambda (group)
8130            (unless (string= from-newsgroup (setq name (symbol-name group)))
8131              (setq idlist (symbol-value group))
8132              ;; Dead groups are not updated.
8133              (and (prog1 
8134                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
8135                             info (nth 2 entry))
8136                     (if (stringp (setq nth4 (gnus-info-method info)))
8137                         (setq nth4 (gnus-server-to-method nth4))))
8138                   ;; Only do the xrefs if the group has the same
8139                   ;; select method as the group we have just read.
8140                   (or (gnus-methods-equal-p 
8141                        nth4 (gnus-find-method-for-group from-newsgroup))
8142                       virtual
8143                       (equal nth4 (setq method (gnus-find-method-for-group 
8144                                                 from-newsgroup)))
8145                       (and (equal (car nth4) (car method))
8146                            (equal (nth 1 nth4) (nth 1 method))))
8147                   gnus-use-cross-reference
8148                   (or (not (eq gnus-use-cross-reference t))
8149                       virtual
8150                       ;; Only do cross-references on subscribed
8151                       ;; groups, if that is what is wanted.  
8152                       (<= (gnus-info-level info) gnus-level-subscribed))
8153                   (gnus-group-make-articles-read name idlist))))
8154          xref-hashtb)))))
8155
8156 (defun gnus-group-make-articles-read (group articles)
8157   (let* ((num 0)
8158          (entry (gnus-gethash group gnus-newsrc-hashtb))
8159          (info (nth 2 entry))
8160          (active (gnus-active group))
8161          range)
8162     ;; First peel off all illegal article numbers.
8163     (if active
8164         (let ((ids articles)
8165               id first)
8166           (while ids
8167             (setq id (car ids))
8168             (if (and first (> id (cdr active)))
8169                 (progn
8170                   ;; We'll end up in this situation in one particular
8171                   ;; obscure situation.  If you re-scan a group and get
8172                   ;; a new article that is cross-posted to a different
8173                   ;; group that has not been re-scanned, you might get
8174                   ;; crossposted article that has a higher number than
8175                   ;; Gnus believes possible.  So we re-activate this
8176                   ;; group as well.  This might mean doing the
8177                   ;; crossposting thingie will *increase* the number
8178                   ;; of articles in some groups.  Tsk, tsk.
8179                   (setq active (or (gnus-activate-group group) active))))
8180             (if (or (> id (cdr active))
8181                     (< id (car active)))
8182                 (setq articles (delq id articles)))
8183             (setq ids (cdr ids)))))
8184     ;; If the read list is nil, we init it.
8185     (and active
8186          (null (gnus-info-read info))
8187          (> (car active) 1)
8188          (gnus-info-set-read info (cons 1 (1- (car active)))))
8189     ;; Then we add the read articles to the range.
8190     (gnus-info-set-read
8191      info
8192      (setq range
8193            (gnus-add-to-range 
8194             (gnus-info-read info) (setq articles (sort articles '<)))))
8195     ;; Then we have to re-compute how many unread
8196     ;; articles there are in this group.
8197     (if active
8198         (progn
8199           (cond 
8200            ((not range)
8201             (setq num (- (1+ (cdr active)) (car active))))
8202            ((not (listp (cdr range)))
8203             (setq num (- (cdr active) (- (1+ (cdr range)) 
8204                                          (car range)))))
8205            (t
8206             (while range
8207               (if (numberp (car range))
8208                   (setq num (1+ num))
8209                 (setq num (+ num (- (1+ (cdr (car range)))
8210                                     (car (car range))))))
8211               (setq range (cdr range)))
8212             (setq num (- (cdr active) num))))
8213           ;; Update the number of unread articles.
8214           (setcar entry num)
8215           ;; Update the group buffer.
8216           (gnus-group-update-group group t)))))
8217
8218 (defun gnus-methods-equal-p (m1 m2)
8219   (let ((m1 (or m1 gnus-select-method))
8220         (m2 (or m2 gnus-select-method)))
8221     (or (equal m1 m2)
8222         (and (eq (car m1) (car m2))
8223              (or (not (memq 'address (assoc (symbol-name (car m1))
8224                                             gnus-valid-select-methods)))
8225                  (equal (nth 1 m1) (nth 1 m2)))))))
8226
8227 (defsubst gnus-header-value ()
8228   (buffer-substring (match-end 0) (gnus-point-at-eol)))
8229
8230 (defvar gnus-newsgroup-none-id 0)
8231
8232 (defun gnus-get-newsgroup-headers (&optional dependencies)
8233   (let ((cur nntp-server-buffer)
8234         (dependencies 
8235          (or dependencies
8236              (save-excursion (set-buffer gnus-summary-buffer)
8237                              gnus-newsgroup-dependencies)))
8238         headers id id-dep ref-dep end ref)
8239     (save-excursion
8240       (set-buffer nntp-server-buffer)
8241       (let ((case-fold-search t)
8242             in-reply-to header number p lines)
8243         (goto-char (point-min))
8244         ;; Search to the beginning of the next header.  Error messages
8245         ;; do not begin with 2 or 3.
8246         (while (re-search-forward "^[23][0-9]+ " nil t)
8247           (setq id nil
8248                 ref nil)
8249           ;; This implementation of this function, with nine
8250           ;; search-forwards instead of the one re-search-forward and
8251           ;; a case (which basically was the old function) is actually
8252           ;; about twice as fast, even though it looks messier.  You
8253           ;; can't have everything, I guess.  Speed and elegance
8254           ;; doesn't always go hand in hand.
8255           (setq 
8256            header
8257            (vector
8258             ;; Number.
8259             (prog1
8260                 (read cur)
8261               (end-of-line)
8262               (setq p (point))
8263               (narrow-to-region (point) 
8264                                 (or (and (search-forward "\n.\n" nil t)
8265                                          (- (point) 2))
8266                                     (point))))
8267             ;; Subject.
8268             (progn
8269               (goto-char p)
8270               (if (search-forward "\nsubject: " nil t)
8271                   (gnus-header-value) "(none)"))
8272             ;; From.
8273             (progn
8274               (goto-char p)
8275               (if (search-forward "\nfrom: " nil t)
8276                   (gnus-header-value) "(nobody)"))
8277             ;; Date.
8278             (progn
8279               (goto-char p)
8280               (if (search-forward "\ndate: " nil t)
8281                   (gnus-header-value) ""))
8282             ;; Message-ID.
8283             (progn
8284               (goto-char p)
8285               (if (search-forward "\nmessage-id: " nil t)
8286                   (setq id (gnus-header-value))
8287                 ;; If there was no message-id, we just fake one to make
8288                 ;; subsequent routines simpler.
8289                 (setq id (concat "none+" 
8290                                  (int-to-string 
8291                                   (setq gnus-newsgroup-none-id 
8292                                         (1+ gnus-newsgroup-none-id)))))))
8293             ;; References.
8294             (progn
8295               (goto-char p)
8296               (if (search-forward "\nreferences: " nil t)
8297                   (prog1
8298                       (gnus-header-value)
8299                     (setq end (match-end 0))
8300                     (save-excursion
8301                       (setq ref 
8302                             (downcase
8303                              (buffer-substring
8304                               (progn 
8305                                 (end-of-line)
8306                                 (search-backward ">" end t)
8307                                 (1+ (point)))
8308                               (progn
8309                                 (search-backward "<" end t)
8310                                 (point)))))))
8311                 ;; Get the references from the in-reply-to header if there
8312                 ;; were no references and the in-reply-to header looks
8313                 ;; promising. 
8314                 (if (and (search-forward "\nin-reply-to: " nil t)
8315                          (setq in-reply-to (gnus-header-value))
8316                          (string-match "<[^>]+>" in-reply-to))
8317                     (prog1
8318                         (setq ref (substring in-reply-to (match-beginning 0)
8319                                              (match-end 0)))
8320                       (setq ref (downcase ref))))
8321                 (setq ref "")))
8322             ;; Chars.
8323             0
8324             ;; Lines.
8325             (progn
8326               (goto-char p)
8327               (if (search-forward "\nlines: " nil t)
8328                   (if (numberp (setq lines (read cur)))
8329                       lines 0)
8330                 0))
8331             ;; Xref.
8332             (progn
8333               (goto-char p)
8334               (and (search-forward "\nxref: " nil t)
8335                    (gnus-header-value)))))
8336           (if (and gnus-nocem-hashtb
8337                    (gnus-gethash id gnus-nocem-hashtb))
8338               ;; Banned article.
8339               (setq header nil)
8340             ;; We do the threading while we read the headers.  The
8341             ;; message-id and the last reference are both entered into
8342             ;; the same hash table.  Some tippy-toeing around has to be
8343             ;; done in case an article has arrived before the article
8344             ;; which it refers to.
8345             (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8346                 (if (car (symbol-value id-dep))
8347                     ;; An article with this Message-ID has already
8348                     ;; been seen, so we ignore this one, except we add
8349                     ;; any additional Xrefs (in case the two articles
8350                     ;; came from different servers).
8351                     (progn
8352                       (mail-header-set-xref 
8353                        (car (symbol-value id-dep))
8354                        (concat (or (mail-header-xref 
8355                                     (car (symbol-value id-dep))) "")
8356                                (or (mail-header-xref header) "")))
8357                       (setq header nil))
8358                   (setcar (symbol-value id-dep) header))
8359               (set id-dep (list header))))
8360           (if header
8361               (progn
8362                 (if (boundp (setq ref-dep (intern ref dependencies)))
8363                     (setcdr (symbol-value ref-dep) 
8364                             (nconc (cdr (symbol-value ref-dep))
8365                                    (list (symbol-value id-dep))))
8366                   (set ref-dep (list nil (symbol-value id-dep))))
8367                 (setq headers (cons header headers))))
8368           (goto-char (point-max))
8369           (widen))
8370         (nreverse headers)))))
8371
8372 ;; The following macros and functions were written by Felix Lee
8373 ;; <flee@cse.psu.edu>. 
8374
8375 (defmacro gnus-nov-read-integer ()
8376   '(prog1
8377        (if (= (following-char) ?\t)
8378            0
8379          (let ((num (condition-case nil (read buffer) (error nil))))
8380            (if (numberp num) num 0)))
8381      (or (eobp) (forward-char 1))))
8382
8383 (defmacro gnus-nov-skip-field ()
8384   '(search-forward "\t" eol 'move))
8385
8386 (defmacro gnus-nov-field ()
8387   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
8388
8389 ;; Goes through the xover lines and returns a list of vectors
8390 (defun gnus-get-newsgroup-headers-xover (sequence)
8391   "Parse the news overview data in the server buffer, and return a
8392 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
8393   ;; Get the Xref when the users reads the articles since most/some
8394   ;; NNTP servers do not include Xrefs when using XOVER.
8395   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
8396   (let ((cur nntp-server-buffer)
8397         (dependencies gnus-newsgroup-dependencies)
8398         number headers header)
8399     (save-excursion
8400       (set-buffer nntp-server-buffer)
8401       ;; Allow the user to mangle the headers before parsing them.
8402       (run-hooks 'gnus-parse-headers-hook)
8403       ;; Allow the user to mangle the headers before parsing them.
8404       (run-hooks 'gnus-parse-headers-hook)
8405       (goto-char (point-min))
8406       (while (and sequence (not (eobp)))
8407         (setq number (read cur))
8408         (while (and sequence (< (car sequence) number))
8409           (setq sequence (cdr sequence)))
8410         (and sequence 
8411              (eq number (car sequence))
8412              (progn
8413                (setq sequence (cdr sequence))
8414                (if (setq header 
8415                          (inline (gnus-nov-parse-line number dependencies)))
8416                    (setq headers (cons header headers)))))
8417         (forward-line 1))
8418       (setq headers (nreverse headers)))
8419     headers))
8420
8421 ;; This function has to be called with point after the article number
8422 ;; on the beginning of the line.
8423 (defun gnus-nov-parse-line (number dependencies)
8424   (let ((none 0)
8425         (eol (gnus-point-at-eol)) 
8426         (buffer (current-buffer))
8427         header ref id id-dep ref-dep)
8428
8429     ;; overview: [num subject from date id refs chars lines misc]
8430     (narrow-to-region (point) eol)
8431     (or (eobp) (forward-char))
8432
8433     (condition-case nil
8434         (setq header
8435               (vector 
8436                number                   ; number
8437                (gnus-nov-field)         ; subject
8438                (gnus-nov-field)         ; from
8439                (gnus-nov-field)         ; date
8440                (setq id (or (gnus-nov-field)
8441                             (concat "none+"
8442                                     (int-to-string 
8443                                      (setq none (1+ none)))))) ; id
8444                (progn
8445                  (save-excursion
8446                    (let ((beg (point)))
8447                      (search-forward "\t" eol)
8448                      (if (search-backward ">" beg t)
8449                          (setq ref 
8450                                (downcase 
8451                                 (buffer-substring 
8452                                  (1+ (point))
8453                                  (progn
8454                                    (search-backward "<" beg t)
8455                                    (point)))))
8456                        (setq ref nil))))
8457                  (gnus-nov-field))      ; refs
8458                (gnus-nov-read-integer)  ; chars
8459                (gnus-nov-read-integer)  ; lines
8460                (if (= (following-char) ?\n)
8461                    nil
8462                  (gnus-nov-field))      ; misc
8463                ))
8464       (error (progn 
8465                (ding)
8466                (message "Strange nov line.")
8467                (setq header nil)
8468                (goto-char eol))))
8469
8470     (widen)
8471
8472     ;; We build the thread tree.
8473     (and header
8474          (if (and gnus-nocem-hashtb
8475                   (gnus-gethash id gnus-nocem-hashtb))
8476              ;; Banned article.
8477              (setq header nil)
8478            (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8479                (if (car (symbol-value id-dep))
8480                    ;; An article with this Message-ID has already been seen,
8481                    ;; so we ignore this one, except we add any additional
8482                    ;; Xrefs (in case the two articles came from different
8483                    ;; servers.
8484                    (progn
8485                      (mail-header-set-xref 
8486                       (car (symbol-value id-dep))
8487                       (concat (or (mail-header-xref 
8488                                    (car (symbol-value id-dep))) "")
8489                               (or (mail-header-xref header) "")))
8490                      (setq header nil))
8491                  (setcar (symbol-value id-dep) header))
8492              (set id-dep (list header)))))
8493     (if header
8494         (progn
8495           (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
8496               (setcdr (symbol-value ref-dep) 
8497                       (nconc (cdr (symbol-value ref-dep))
8498                              (list (symbol-value id-dep))))
8499             (set ref-dep (list nil (symbol-value id-dep))))))
8500     header))
8501
8502 (defun gnus-article-get-xrefs ()
8503   "Fill in the Xref value in `gnus-current-headers', if necessary.
8504 This is meant to be called in `gnus-article-internal-prepare-hook'."
8505   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
8506                                  gnus-current-headers)))
8507     (or (not gnus-use-cross-reference)
8508         (not headers)
8509         (and (mail-header-xref headers)
8510              (not (string= (mail-header-xref headers) "")))
8511         (let ((case-fold-search t)
8512               xref)
8513           (save-restriction
8514             (gnus-narrow-to-headers)
8515             (goto-char (point-min))
8516             (if (or (and (eq (downcase (following-char)) ?x)
8517                          (looking-at "Xref:"))
8518                     (search-forward "\nXref:" nil t))
8519                 (progn
8520                   (goto-char (1+ (match-end 0)))
8521                   (setq xref (buffer-substring (point) 
8522                                                (progn (end-of-line) (point))))
8523                   (mail-header-set-xref headers xref))))))))
8524
8525 (defun gnus-summary-insert-subject (id)
8526   "Find article ID and insert the summary line for that article."
8527   (let ((header (gnus-read-header id))
8528         number)
8529     (when header
8530       ;; Rebuild the thread that this article is part of and go to the
8531       ;; article we have fetched.
8532       (gnus-rebuild-thread (mail-header-id header))
8533       (gnus-summary-goto-subject (setq number (mail-header-number header)))
8534       (when (> number 0)
8535         ;; We have to update the boundaries, possibly.
8536         (and (> number gnus-newsgroup-end)
8537              (setq gnus-newsgroup-end number))
8538         (and (< number gnus-newsgroup-begin)
8539              (setq gnus-newsgroup-begin number))
8540         (setq gnus-newsgroup-unselected
8541               (delq number gnus-newsgroup-unselected)))
8542       ;; Report back a success.
8543       number)))
8544
8545 (defun gnus-summary-work-articles (n)
8546   "Return a list of articles to be worked upon.  The prefix argument,
8547 the list of process marked articles, and the current article will be
8548 taken into consideration."
8549   (cond
8550    ((and n (numberp n))
8551     ;; A numerical prefix has been given.
8552     (let ((backward (< n 0))
8553           (n (abs n))
8554           articles article)
8555       (save-excursion
8556         (while 
8557             (and (> n 0)
8558                  (push (setq article (gnus-summary-article-number))
8559                        articles)
8560                  (if backward
8561                      (gnus-summary-find-prev nil article)
8562                    (gnus-summary-find-next nil article)))
8563           (decf n)))
8564       (nreverse articles)))
8565    ((and (boundp 'transient-mark-mode)
8566          transient-mark-mode
8567          mark-active)
8568     ;; Work on the region between point and mark.
8569     (let ((max (max (point) (mark)))
8570           articles article)
8571       (save-excursion
8572         (goto-char (min (point) (mark)))
8573         (while 
8574             (and 
8575              (push (setq article (gnus-summary-article-number)) articles)
8576              (gnus-summary-find-next nil article)
8577              (< (point) max)))
8578         (nreverse articles))))
8579    (gnus-newsgroup-processable
8580     ;; There are process-marked articles present.
8581     (reverse gnus-newsgroup-processable))
8582    (t
8583     ;; Just return the current article.
8584     (list (gnus-summary-article-number)))))
8585
8586 (defun gnus-summary-search-group (&optional backward use-level)
8587   "Search for next unread newsgroup.
8588 If optional argument BACKWARD is non-nil, search backward instead."
8589   (save-excursion
8590     (set-buffer gnus-group-buffer)
8591     (if (gnus-group-search-forward 
8592          backward nil (if use-level (gnus-group-group-level) nil))
8593         (gnus-group-group-name))))
8594
8595 (defun gnus-summary-best-group (&optional exclude-group)
8596   "Find the name of the best unread group.
8597 If EXCLUDE-GROUP, do not go to this group."
8598   (save-excursion
8599     (set-buffer gnus-group-buffer)
8600     (save-excursion
8601       (gnus-group-best-unread-group exclude-group))))
8602
8603 (defun gnus-summary-find-next (&optional unread article backward)
8604   (if backward (gnus-summary-find-prev)
8605     (let* ((article (or article (gnus-summary-article-number)))
8606            (arts (gnus-data-find-list article))
8607            result)
8608       (when (or (not gnus-summary-check-current)
8609                 (not unread)
8610                 (not (gnus-data-unread-p (car arts))))
8611         (setq arts (cdr arts)))
8612       (when (setq result
8613                 (if unread
8614                     (progn
8615                       (while arts
8616                         (when (gnus-data-unread-p (car arts))
8617                           (setq result (car arts)
8618                                 arts nil))
8619                         (setq arts (cdr arts)))
8620                       result)
8621                   (car arts)))
8622         (goto-char (gnus-data-pos result))
8623         (gnus-data-number result)))))
8624
8625 (defun gnus-summary-find-prev (&optional unread article)
8626   (let* ((article (or article (gnus-summary-article-number)))
8627          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
8628          result)
8629     (when (or (not gnus-summary-check-current)
8630               (not unread)
8631               (not (gnus-data-unread-p (car arts))))
8632       (setq arts (cdr arts)))
8633     (if (setq result
8634               (if unread
8635                   (progn
8636                     (while arts
8637                       (and (gnus-data-unread-p (car arts))
8638                            (setq result (car arts)
8639                                  arts nil))
8640                       (setq arts (cdr arts)))
8641                     result)
8642                 (car arts)))
8643         (progn
8644           (goto-char (gnus-data-pos result))
8645           (gnus-data-number result)))))
8646
8647 (defun gnus-summary-find-subject (subject &optional unread backward article)
8648   (let* ((article (or article (gnus-summary-article-number)))
8649          (articles (gnus-data-list backward))
8650          (arts (gnus-data-find-list article articles))
8651          result)
8652     (when (or (not gnus-summary-check-current)
8653               (not unread)
8654               (not (gnus-data-unread-p (car arts))))
8655       (setq arts (cdr arts)))
8656     (while arts
8657       (and (or (not unread)
8658                (gnus-data-unread-p (car arts)))
8659            (vectorp (gnus-data-header (car arts)))
8660            (gnus-subject-equal 
8661             subject (mail-header-subject (gnus-data-header (car arts))))
8662            (setq result (car arts)
8663                  arts nil))
8664       (setq arts (cdr arts)))
8665     (and result
8666          (goto-char (gnus-data-pos result))
8667          (gnus-data-number result))))
8668
8669 (defun gnus-summary-search-forward (&optional unread subject backward)
8670   (cond (subject
8671          (gnus-summary-find-subject subject unread backward))
8672         (backward
8673          (gnus-summary-find-prev unread))
8674         (t
8675          (gnus-summary-find-next unread))))
8676
8677 (defun gnus-summary-recenter ()
8678   "Center point in the summary window.
8679 If `gnus-auto-center-summary' is nil, or the article buffer isn't
8680 displayed, no centering will be performed." 
8681   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
8682   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
8683   (let* ((top (cond ((< (window-height) 4) 0)
8684                     ((< (window-height) 7) 1)
8685                     (t 2)))
8686          (height (1- (window-height)))
8687          (bottom (save-excursion (goto-char (point-max))
8688                                  (forward-line (- height))
8689                                  (point)))
8690          (window (get-buffer-window (current-buffer))))
8691     (and 
8692      ;; The user has to want it,
8693      gnus-auto-center-summary 
8694      ;; the article buffer must be displayed,
8695      (get-buffer-window gnus-article-buffer)
8696      ;; Set the window start to either `bottom', which is the biggest
8697      ;; possible valid number, or the second line from the top,
8698      ;; whichever is the least.
8699      (set-window-start
8700       window (min bottom (save-excursion (forward-line (- top)) (point)))))))
8701
8702 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
8703 (defun gnus-short-group-name (group &optional levels)
8704   "Collapse GROUP name LEVELS."
8705   (let* ((name "") (foreign "") (depth -1) (skip 1)
8706          (levels (or levels
8707                      (progn
8708                        (while (string-match "\\." group skip)
8709                          (setq skip (match-end 0)
8710                                depth (+ depth 1)))
8711                        depth))))
8712     (if (string-match ":" group)
8713         (setq foreign (substring group 0 (match-end 0))
8714               group (substring group (match-end 0))))
8715     (while group
8716       (if (and (string-match "\\." group) (> levels 0))
8717           (setq name (concat name (substring group 0 1))
8718                 group (substring group (match-end 0))
8719                 levels (- levels 1)
8720                 name (concat name "."))
8721         (setq name (concat foreign name group)
8722               group nil)))
8723     name))
8724
8725 (defun gnus-summary-jump-to-group (newsgroup)
8726   "Move point to NEWSGROUP in group mode buffer."
8727   ;; Keep update point of group mode buffer if visible.
8728   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
8729       (save-window-excursion
8730         ;; Take care of tree window mode.
8731         (if (get-buffer-window gnus-group-buffer)
8732             (pop-to-buffer gnus-group-buffer))
8733         (gnus-group-jump-to-group newsgroup))
8734     (save-excursion
8735       ;; Take care of tree window mode.
8736       (if (get-buffer-window gnus-group-buffer)
8737           (pop-to-buffer gnus-group-buffer)
8738         (set-buffer gnus-group-buffer))
8739       (gnus-group-jump-to-group newsgroup))))
8740
8741 ;; This function returns a list of article numbers based on the
8742 ;; difference between the ranges of read articles in this group and
8743 ;; the range of active articles.
8744 (defun gnus-list-of-unread-articles (group)
8745   (let* ((read (gnus-info-read (gnus-get-info group)))
8746          (active (gnus-active group))
8747          (last (cdr active))
8748          first nlast unread)
8749     ;; If none are read, then all are unread. 
8750     (if (not read)
8751         (setq first (car active))
8752       ;; If the range of read articles is a single range, then the
8753       ;; first unread article is the article after the last read
8754       ;; article.  Sounds logical, doesn't it?
8755       (if (not (listp (cdr read)))
8756           (setq first (1+ (cdr read)))
8757         ;; `read' is a list of ranges.
8758         (if (/= (setq nlast (or (and (numberp (car read)) (car read)) 
8759                                 (car (car read)))) 1)
8760             (setq first 1))
8761         (while read
8762           (if first 
8763               (while (< first nlast)
8764                 (setq unread (cons first unread))
8765                 (setq first (1+ first))))
8766           (setq first (1+ (if (atom (car read)) (car read) (cdr (car read)))))
8767           (setq nlast (if (atom (car (cdr read))) 
8768                           (car (cdr read))
8769                         (car (car (cdr read)))))
8770           (setq read (cdr read)))))
8771     ;; And add the last unread articles.
8772     (while (<= first last)
8773       (setq unread (cons first unread))
8774       (setq first (1+ first)))
8775     ;; Return the list of unread articles.
8776     (nreverse unread)))
8777
8778 (defun gnus-list-of-read-articles (group)
8779   "Return a list of unread, unticked and non-dormant articles."
8780   (let* ((info (gnus-get-info group))
8781          (marked (gnus-info-marks info))
8782          (active (gnus-active group)))
8783     (and info active
8784          (gnus-set-difference
8785           (gnus-sorted-complement 
8786            (gnus-uncompress-range active) 
8787            (gnus-list-of-unread-articles group))
8788           (append 
8789            (gnus-uncompress-range (cdr (assq 'dormant marked)))
8790            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
8791
8792 ;; Various summary commands
8793
8794 (defun gnus-summary-universal-argument ()
8795   "Perform any operation on all articles marked with the process mark."
8796   (interactive)
8797   (gnus-set-global-variables)
8798   (let ((articles (reverse gnus-newsgroup-processable))
8799         func)
8800     (or articles (error "No articles marked"))
8801     (or (setq func (key-binding (read-key-sequence "C-c C-u")))
8802         (error "Undefined key"))
8803     (while articles
8804       (gnus-summary-goto-subject (car articles))
8805       (command-execute func)
8806       (gnus-summary-remove-process-mark (car articles))
8807       (setq articles (cdr articles)))))
8808
8809 (defun gnus-summary-toggle-truncation (&optional arg)
8810   "Toggle truncation of summary lines.
8811 With arg, turn line truncation on iff arg is positive."
8812   (interactive "P")
8813   (setq truncate-lines
8814         (if (null arg) (not truncate-lines)
8815           (> (prefix-numeric-value arg) 0)))
8816   (redraw-display))
8817
8818 (defun gnus-summary-reselect-current-group (&optional all)
8819   "Once exit and then reselect the current newsgroup.
8820 The prefix argument ALL means to select all articles."
8821   (interactive "P")
8822   (gnus-set-global-variables)
8823   (let ((current-subject (gnus-summary-article-number))
8824         (group gnus-newsgroup-name))
8825     (setq gnus-newsgroup-begin nil)
8826     (gnus-summary-exit t)
8827     ;; We have to adjust the point of group mode buffer because the
8828     ;; current point was moved to the next unread newsgroup by
8829     ;; exiting.
8830     (gnus-summary-jump-to-group group)
8831     (gnus-group-read-group all t)
8832     (gnus-summary-goto-subject current-subject)))
8833
8834 (defun gnus-summary-rescan-group (&optional all)
8835   "Exit the newsgroup, ask for new articles, and select the newsgroup."
8836   (interactive "P")
8837   (gnus-set-global-variables)
8838   ;; Fix by Ilja Weis <kult@uni-paderborn.de>.
8839   (let ((group gnus-newsgroup-name))
8840     (gnus-summary-exit)
8841     (gnus-summary-jump-to-group group)
8842     (save-excursion
8843       (set-buffer gnus-group-buffer)
8844       (gnus-group-get-new-news-this-group 1))
8845     (gnus-summary-jump-to-group group)
8846     (gnus-group-read-group all)))
8847
8848 (defun gnus-summary-update-info ()
8849   (let* ((group gnus-newsgroup-name))
8850     (when gnus-newsgroup-kill-headers
8851       (setq gnus-newsgroup-killed
8852             (gnus-compress-sequence
8853              (nconc
8854               (gnus-set-sorted-intersection
8855                (gnus-uncompress-range gnus-newsgroup-killed)
8856                (setq gnus-newsgroup-unselected
8857                      (sort gnus-newsgroup-unselected '<)))
8858               (setq gnus-newsgroup-unreads
8859                     (sort gnus-newsgroup-unreads '<))) t)))
8860     (unless (listp (cdr gnus-newsgroup-killed))
8861       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
8862     (let ((headers gnus-newsgroup-headers))
8863       (gnus-close-group group)
8864       (run-hooks 'gnus-exit-group-hook)
8865       (unless gnus-save-score
8866         (setq gnus-newsgroup-scored nil))
8867       ;; Set the new ranges of read articles.
8868       (gnus-update-read-articles
8869        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
8870       ;; Set the current article marks.
8871       (gnus-update-marks)
8872       ;; Do the cross-ref thing.
8873       (when gnus-use-cross-reference
8874         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
8875       ;; Do adaptive scoring, and possibly save score files.
8876       (when gnus-newsgroup-adaptive
8877         (gnus-score-adaptive))
8878       (when gnus-use-scoring 
8879         (gnus-score-save))
8880       ;; Do not switch windows but change the buffer to work.
8881       (set-buffer gnus-group-buffer)
8882       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
8883           (gnus-group-update-group group)))))
8884   
8885 (defun gnus-summary-exit (&optional temporary)
8886   "Exit reading current newsgroup, and then return to group selection mode.
8887 gnus-exit-group-hook is called with no arguments if that value is non-nil."
8888   (interactive)
8889   (gnus-set-global-variables)
8890   (gnus-kill-save-kill-buffer)
8891   (let* ((group gnus-newsgroup-name)
8892          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
8893          (mode major-mode)
8894          (buf (current-buffer)))
8895     (run-hooks 'gnus-summary-prepare-exit-hook)
8896     ;; Make all changes in this group permanent.
8897     (gnus-summary-update-info)          
8898     (set-buffer buf)
8899     (and gnus-use-cache (gnus-cache-possibly-remove-articles))
8900     ;; Make sure where I was, and go to next newsgroup.
8901     (set-buffer gnus-group-buffer)
8902     (or quit-config
8903         (progn
8904           (gnus-group-jump-to-group group)
8905           (gnus-group-next-unread-group 1)))
8906     (if temporary
8907         nil                             ;Nothing to do.
8908       ;; We set all buffer-local variables to nil.  It is unclear why
8909       ;; this is needed, but if we don't, buffer-local variables are
8910       ;; not garbage-collected, it seems.  This would the lead to en
8911       ;; ever-growing Emacs.
8912       (set-buffer buf)
8913       (gnus-summary-clear-local-variables)
8914       ;; We clear the global counterparts of the buffer-local
8915       ;; variables as well, just to be on the safe side.
8916       (gnus-configure-windows 'group 'force)
8917       (gnus-summary-clear-local-variables)
8918       ;; Return to group mode buffer. 
8919       (if (eq mode 'gnus-summary-mode)
8920           (gnus-kill-buffer buf))
8921       (if (get-buffer gnus-article-buffer)
8922           (bury-buffer gnus-article-buffer))
8923       (setq gnus-current-select-method gnus-select-method)
8924       (pop-to-buffer gnus-group-buffer)
8925       ;; Clear the current group name.
8926       (setq gnus-newsgroup-name nil)
8927       (if (not quit-config)
8928           (progn
8929             (gnus-group-jump-to-group group)
8930             (gnus-group-next-unread-group 1))
8931         (if (not (buffer-name (car quit-config)))
8932             (gnus-configure-windows 'group 'force)
8933           (set-buffer (car quit-config))
8934           (and (eq major-mode 'gnus-summary-mode)
8935                (gnus-set-global-variables))
8936           (gnus-configure-windows (cdr quit-config))))
8937       (run-hooks 'gnus-summary-exit-hook))))
8938
8939 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
8940 (defun gnus-summary-exit-no-update (&optional no-questions)
8941   "Quit reading current newsgroup without updating read article info."
8942   (interactive)
8943   (gnus-set-global-variables)
8944   (let* ((group gnus-newsgroup-name)
8945          (quit-config (gnus-group-quit-config group)))
8946     (when (or no-questions
8947               gnus-expert-user
8948               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
8949       (gnus-close-group group)
8950       (gnus-summary-clear-local-variables)
8951       (set-buffer gnus-group-buffer)
8952       (gnus-summary-clear-local-variables)
8953       ;; Return to the group buffer.
8954       (gnus-configure-windows 'group 'force)
8955       ;; Clear the current group name.
8956       (setq gnus-newsgroup-name nil)
8957       (when (get-buffer gnus-summary-buffer)
8958         (kill-buffer gnus-summary-buffer))
8959       (when (get-buffer gnus-article-buffer)
8960         (bury-buffer gnus-article-buffer))
8961       (when (equal (gnus-group-group-name) group)
8962         (gnus-group-next-unread-group 1))
8963       (when quit-config
8964         (if (not (buffer-name (car quit-config)))
8965             (gnus-configure-windows 'group 'force)
8966           (set-buffer (car quit-config))
8967           (when (eq major-mode 'gnus-summary-mode)
8968             (gnus-set-global-variables))
8969           (gnus-configure-windows (cdr quit-config)))))))
8970
8971 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
8972 (defun gnus-summary-fetch-faq (&optional faq-dir)
8973   "Fetch the FAQ for the current group.
8974 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
8975 in."
8976   (interactive 
8977    (list
8978     (if current-prefix-arg
8979         (completing-read 
8980          "Faq dir: " (and (listp gnus-group-faq-directory)
8981                           gnus-group-faq-directory)))))
8982   (let (gnus-faq-buffer)
8983     (and (setq gnus-faq-buffer 
8984                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
8985          (gnus-configure-windows 'summary-faq))))
8986
8987 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
8988 (defun gnus-summary-describe-group (&optional force)
8989   "Describe the current newsgroup."
8990   (interactive "P")
8991   (gnus-group-describe-group force gnus-newsgroup-name))
8992
8993 (defun gnus-summary-describe-briefly ()
8994   "Describe summary mode commands briefly."
8995   (interactive)
8996   (gnus-message 6
8997                 (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")))
8998
8999 ;; Walking around group mode buffer from summary mode.
9000
9001 (defun gnus-summary-next-group (&optional no-article target-group backward)
9002   "Exit current newsgroup and then select next unread newsgroup.
9003 If prefix argument NO-ARTICLE is non-nil, no article is selected
9004 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
9005 previous group instead."
9006   (interactive "P")
9007   (gnus-set-global-variables)
9008   (let ((current-group gnus-newsgroup-name)
9009         (current-buffer (current-buffer))
9010         entered)
9011     ;; First we semi-exit this group to update Xrefs and all variables.
9012     ;; We can't do a real exit, because the window conf must remain
9013     ;; the same in case the user is prompted for info, and we don't
9014     ;; want the window conf to change before that...
9015     (gnus-summary-exit t)
9016     (while (not entered)
9017       ;; Then we find what group we are supposed to enter.
9018       (set-buffer gnus-group-buffer)
9019       (gnus-group-jump-to-group current-group)
9020       (setq target-group 
9021             (or target-group        
9022                 (if (eq gnus-keep-same-level 'best) 
9023                     (gnus-summary-best-group gnus-newsgroup-name)
9024                   (gnus-summary-search-group backward gnus-keep-same-level))))
9025       (if (not target-group)
9026           ;; There are no further groups, so we return to the group
9027           ;; buffer.
9028           (progn
9029             (gnus-message 5 "Returning to the group buffer")
9030             (setq entered t)
9031             (set-buffer current-buffer)
9032             (gnus-summary-exit))
9033         ;; We try to enter the target group.
9034         (gnus-group-jump-to-group target-group)
9035         (let ((unreads (gnus-group-group-unread)))
9036           (if (and (or (eq t unreads)
9037                        (and unreads (not (zerop unreads))))
9038                    (gnus-summary-read-group
9039                     target-group nil no-article current-buffer))
9040               (setq entered t)
9041             (setq current-group target-group
9042                   target-group nil)))))))
9043
9044 (defun gnus-summary-prev-group (&optional no-article)
9045   "Exit current newsgroup and then select previous unread newsgroup.
9046 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
9047   (interactive "P")
9048   (gnus-summary-next-group no-article nil t))
9049
9050 ;; Walking around summary lines.
9051
9052 (defun gnus-summary-first-subject (&optional unread)
9053   "Go to the first unread subject.
9054 If UNREAD is non-nil, go to the first unread article.
9055 Returns the article selected or nil if there are no unread articles."
9056   (interactive "P")
9057   (prog1
9058       (cond 
9059        ;; Empty summary.
9060        ((null gnus-newsgroup-data)
9061         (gnus-message 3 "No articles in the group")
9062         nil)
9063        ;; Pick the first article.
9064        ((not unread)
9065         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
9066         (gnus-data-number (car gnus-newsgroup-data)))
9067        ;; No unread articles.
9068        ((null gnus-newsgroup-unreads)
9069         (gnus-message 3 "No more unread articles")
9070         nil)
9071        ;; Find the first unread article.
9072        (t
9073         (let ((data gnus-newsgroup-data))
9074           (while (and data
9075                       (not (gnus-data-unread-p (car data))))
9076             (setq data (cdr data)))
9077           (if data
9078               (progn
9079                 (goto-char (gnus-data-pos (car data)))
9080                 (gnus-data-number (car data)))))))
9081     (gnus-summary-position-point)))
9082
9083 (defun gnus-summary-next-subject (n &optional unread dont-display)
9084   "Go to next N'th summary line.
9085 If N is negative, go to the previous N'th subject line.
9086 If UNREAD is non-nil, only unread articles are selected.
9087 The difference between N and the actual number of steps taken is
9088 returned."
9089   (interactive "p")
9090   (let ((backward (< n 0))
9091         (n (abs n)))
9092     (while (and (> n 0)
9093                 (if backward
9094                     (gnus-summary-find-prev unread)
9095                   (gnus-summary-find-next unread)))
9096       (setq n (1- n)))
9097     (if (/= 0 n) (gnus-message 7 "No more%s articles"
9098                                (if unread " unread" "")))
9099     (or dont-display
9100         (progn
9101           (gnus-summary-recenter)
9102           (gnus-summary-position-point)))
9103     n))
9104
9105 (defun gnus-summary-next-unread-subject (n)
9106   "Go to next N'th unread summary line."
9107   (interactive "p")
9108   (gnus-summary-next-subject n t))
9109
9110 (defun gnus-summary-prev-subject (n &optional unread)
9111   "Go to previous N'th summary line.
9112 If optional argument UNREAD is non-nil, only unread article is selected."
9113   (interactive "p")
9114   (gnus-summary-next-subject (- n) unread))
9115
9116 (defun gnus-summary-prev-unread-subject (n)
9117   "Go to previous N'th unread summary line."
9118   (interactive "p")
9119   (gnus-summary-next-subject (- n) t))
9120
9121 (defun gnus-summary-goto-subject (article &optional force silent)
9122   "Go the subject line of ARTICLE.
9123 If FORCE, also allow jumping to articles not currently shown."
9124   (let ((b (point))
9125         (data (gnus-data-find article)))
9126     ;; We read in the article if we have to.
9127     (and (not data) 
9128          force
9129          (gnus-summary-insert-subject article)
9130          (setq data (gnus-data-find article)))
9131     (goto-char b)
9132     (if (and (not silent) (not data))
9133         (progn
9134           (message "Can't find article %d" article)
9135           nil)
9136       (goto-char (gnus-data-pos data))
9137       article)))
9138
9139 ;; Walking around summary lines with displaying articles.
9140
9141 (defun gnus-summary-expand-window (&optional arg)
9142   "Make the summary buffer take up the entire Emacs frame.
9143 Given a prefix, will force an `article' buffer configuration."
9144   (interactive "P")
9145   (gnus-set-global-variables)
9146   (if arg
9147       (gnus-configure-windows 'article 'force)
9148     (gnus-configure-windows 'summary 'force)))
9149
9150 (defun gnus-summary-display-article (article &optional all-header)
9151   "Display ARTICLE in article buffer."
9152   (gnus-set-global-variables)
9153   (if (null article)
9154       nil
9155     (prog1
9156         (gnus-article-prepare article all-header)
9157       (gnus-summary-show-thread)
9158       (run-hooks 'gnus-select-article-hook)
9159       (gnus-summary-recenter)
9160       (gnus-summary-goto-subject article)
9161       ;; Successfully display article.
9162       (gnus-summary-update-line)
9163       (gnus-article-set-window-start 
9164        (cdr (assq article gnus-newsgroup-bookmarks)))
9165       t)))
9166
9167 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
9168   "Select the current article.
9169 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
9170 non-nil, the article will be re-fetched even if it already present in
9171 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
9172 be displayed."
9173   (let ((article (or article (gnus-summary-article-number)))
9174         (all-headers (not (not all-headers))) ;Must be T or NIL.
9175         did) 
9176     (and (not pseudo) 
9177          (gnus-summary-article-pseudo-p article)
9178          (error "This is a pseudo-article."))
9179     (prog1
9180         (save-excursion
9181           (set-buffer gnus-summary-buffer)
9182           (if (or (null gnus-current-article)
9183                   (null gnus-article-current)
9184                   (null (get-buffer gnus-article-buffer))
9185                   (not (eq article (cdr gnus-article-current)))
9186                   (not (equal (car gnus-article-current) gnus-newsgroup-name))
9187                   force)
9188               ;; The requested article is different from the current article.
9189               (progn
9190                 (gnus-summary-display-article article all-headers)
9191                 (setq did article))
9192             (if (or all-headers gnus-show-all-headers) 
9193                 (gnus-article-show-all-headers))
9194             nil))
9195       (if did 
9196           (gnus-article-set-window-start 
9197            (cdr (assq article gnus-newsgroup-bookmarks)))))))
9198
9199 (defun gnus-summary-set-current-mark (&optional current-mark)
9200   "Obsolete function."
9201   nil)
9202
9203 (defun gnus-summary-next-article (&optional unread subject backward)
9204   "Select the next article.
9205 If UNREAD, only unread articles are selected.
9206 If SUBJECT, only articles with SUBJECT are selected.
9207 If BACKWARD, the previous article is selected instead of the next."
9208   (interactive "P")
9209   (gnus-set-global-variables)
9210   (let (header)
9211     (cond
9212      ;; Is there such an article?
9213      ((and (gnus-summary-search-forward unread subject backward)
9214            (or (gnus-summary-display-article (gnus-summary-article-number))
9215                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9216       (gnus-summary-position-point))
9217      ;; If not, we try the first unread, if that is wanted.
9218      ((and subject
9219            gnus-auto-select-same
9220            (or (gnus-summary-first-unread-article)
9221                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9222       (gnus-summary-position-point)
9223       (gnus-message 6 "Wrapped"))
9224      ;; Try to get next/previous article not displayed in this group.
9225      ((and gnus-auto-extend-newsgroup
9226            (not unread) (not subject))
9227       (gnus-summary-goto-article 
9228        (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
9229        nil t))
9230      ;; Go to next/previous group.
9231      (t
9232       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9233           (gnus-summary-jump-to-group gnus-newsgroup-name))
9234       (let ((cmd last-command-char)
9235             (group 
9236              (if (eq gnus-keep-same-level 'best) 
9237                  (gnus-summary-best-group gnus-newsgroup-name)
9238                (gnus-summary-search-group backward gnus-keep-same-level))))
9239         ;; For some reason, the group window gets selected.  We change
9240         ;; it back.  
9241         (select-window (get-buffer-window (current-buffer)))
9242         ;; Keep just the event type of CMD.
9243                                         ;(and (listp cmd) (setq cmd (car cmd)))
9244         ;; Select next unread newsgroup automagically.
9245         (cond 
9246          ((not gnus-auto-select-next)
9247           (gnus-message 7 "No more%s articles" (if unread " unread" "")))
9248          ((or (eq gnus-auto-select-next 'quietly)
9249               (and (eq gnus-auto-select-next 'almost-quietly)
9250                    (gnus-summary-last-article-p)))
9251           ;; Select quietly.
9252           (if (gnus-ephemeral-group-p gnus-newsgroup-name)
9253               (gnus-summary-exit)
9254             (gnus-message 7 "No more%s articles (%s)..."
9255                           (if unread " unread" "") 
9256                           (if group (concat "selecting " group)
9257                             "exiting"))
9258             (gnus-summary-next-group nil group backward)))
9259          (t
9260           (let ((keystrokes '(?\C-n ?\C-p))
9261                 key)
9262             (while (or (null key) (memq key keystrokes))
9263               (gnus-message 
9264                7 "No more%s articles%s" (if unread " unread" "")
9265                (if (and group 
9266                         (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
9267                    (format " (Type %s for %s [%s])"
9268                            (single-key-description cmd) group
9269                            (car (gnus-gethash group gnus-newsrc-hashtb)))
9270                  (format " (Type %s to exit %s)"
9271                          (single-key-description cmd)
9272                          gnus-newsgroup-name)))
9273               ;; Confirm auto selection.
9274               (let* ((event (read-char-exclusive)))
9275                 (setq key (if (listp event) (car event) event))
9276                 (if (memq key keystrokes)
9277                     (let ((obuf (current-buffer)))
9278                       (switch-to-buffer gnus-group-buffer)
9279                       (and group
9280                            (gnus-group-jump-to-group group))
9281                       (condition-case ()
9282                           (cond ((= key ?\C-n)
9283                                  (gnus-group-next-unread-group 1))
9284                                 ((= key ?\C-p)
9285                                  (gnus-group-prev-unread-group 1)))
9286                         (error (ding) nil))
9287                       (setq group (gnus-group-group-name))
9288                       (switch-to-buffer obuf)))))
9289             (if (equal key cmd)
9290                 (if (or (not group)
9291                         (gnus-ephemeral-group-p gnus-newsgroup-name))
9292                     (gnus-summary-exit)
9293                   (gnus-summary-next-group nil group backward))
9294               (execute-kbd-macro (char-to-string key)))))))))))
9295
9296 (defun gnus-summary-next-unread-article ()
9297   "Select unread article after current one."
9298   (interactive)
9299   (gnus-summary-next-article t (and gnus-auto-select-same
9300                                     (gnus-summary-article-subject))))
9301
9302 (defun gnus-summary-prev-article (&optional unread subject)
9303   "Select the article after the current one.
9304 If UNREAD is non-nil, only unread articles are selected."
9305   (interactive "P")
9306   (gnus-summary-next-article unread subject t))
9307
9308 (defun gnus-summary-prev-unread-article ()
9309   "Select unred article before current one."
9310   (interactive)
9311   (gnus-summary-prev-article t (and gnus-auto-select-same
9312                                     (gnus-summary-article-subject))))
9313
9314 (defun gnus-summary-next-page (&optional lines circular)
9315   "Show next page of selected article.
9316 If end of article, select next article.
9317 Argument LINES specifies lines to be scrolled up.
9318 If CIRCULAR is non-nil, go to the start of the article instead of 
9319 instead of selecting the next article when reaching the end of the
9320 current article." 
9321   (interactive "P")
9322   (setq gnus-summary-buffer (current-buffer))
9323   (gnus-set-global-variables)
9324   (let ((article (gnus-summary-article-number))
9325         (endp nil))
9326     (gnus-configure-windows 'article)
9327     (if (or (null gnus-current-article)
9328             (null gnus-article-current)
9329             (/= article (cdr gnus-article-current))
9330             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9331         ;; Selected subject is different from current article's.
9332         (gnus-summary-display-article article)
9333       (gnus-eval-in-buffer-window
9334        gnus-article-buffer
9335        (setq endp (gnus-article-next-page lines)))
9336       (if endp
9337           (cond (circular
9338                  (gnus-summary-beginning-of-article))
9339                 (lines
9340                  (gnus-message 3 "End of message"))
9341                 ((null lines)
9342                  (gnus-summary-next-unread-article)))))
9343     (gnus-summary-recenter)
9344     (gnus-summary-position-point)))
9345
9346 (defun gnus-summary-prev-page (&optional lines)
9347   "Show previous page of selected article.
9348 Argument LINES specifies lines to be scrolled down."
9349   (interactive "P")
9350   (gnus-set-global-variables)
9351   (let ((article (gnus-summary-article-number)))
9352     (gnus-configure-windows 'article)
9353     (if (or (null gnus-current-article)
9354             (null gnus-article-current)
9355             (/= article (cdr gnus-article-current))
9356             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9357         ;; Selected subject is different from current article's.
9358         (gnus-summary-display-article article)
9359       (gnus-summary-recenter)
9360       (gnus-eval-in-buffer-window gnus-article-buffer
9361                                   (gnus-article-prev-page lines))))
9362   (gnus-summary-position-point))
9363
9364 (defun gnus-summary-scroll-up (lines)
9365   "Scroll up (or down) one line current article.
9366 Argument LINES specifies lines to be scrolled up (or down if negative)."
9367   (interactive "p")
9368   (gnus-set-global-variables)
9369   (gnus-configure-windows 'article)
9370   (or (gnus-summary-select-article nil nil 'pseudo)
9371       (gnus-eval-in-buffer-window 
9372        gnus-article-buffer
9373        (cond ((> lines 0)
9374               (if (gnus-article-next-page lines)
9375                   (gnus-message 3 "End of message")))
9376              ((< lines 0)
9377               (gnus-article-prev-page (- lines))))))
9378   (gnus-summary-recenter)
9379   (gnus-summary-position-point))
9380
9381 (defun gnus-summary-next-same-subject ()
9382   "Select next article which has the same subject as current one."
9383   (interactive)
9384   (gnus-set-global-variables)
9385   (gnus-summary-next-article nil (gnus-summary-article-subject)))
9386
9387 (defun gnus-summary-prev-same-subject ()
9388   "Select previous article which has the same subject as current one."
9389   (interactive)
9390   (gnus-set-global-variables)
9391   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
9392
9393 (defun gnus-summary-next-unread-same-subject ()
9394   "Select next unread article which has the same subject as current one."
9395   (interactive)
9396   (gnus-set-global-variables)
9397   (gnus-summary-next-article t (gnus-summary-article-subject)))
9398
9399 (defun gnus-summary-prev-unread-same-subject ()
9400   "Select previous unread article which has the same subject as current one."
9401   (interactive)
9402   (gnus-set-global-variables)
9403   (gnus-summary-prev-article t (gnus-summary-article-subject)))
9404
9405 (defun gnus-summary-first-unread-article ()
9406   "Select the first unread article. 
9407 Return nil if there are no unread articles."
9408   (interactive)
9409   (gnus-set-global-variables)
9410   (prog1
9411       (if (gnus-summary-first-subject t)
9412           (progn
9413             (gnus-summary-show-thread)
9414             (gnus-summary-first-subject t)
9415             (gnus-summary-display-article (gnus-summary-article-number))))
9416     (gnus-summary-position-point)))
9417
9418 (defun gnus-summary-best-unread-article ()
9419   "Select the unread article with the highest score."
9420   (interactive)
9421   (gnus-set-global-variables)
9422   (let ((best -1000000)
9423         (data gnus-newsgroup-data)
9424         article score)
9425     (while data
9426       (and (gnus-data-unread-p (car data))
9427            (> (setq score 
9428                     (gnus-summary-article-score (gnus-data-number (car data))))
9429               best)
9430            (setq best score
9431                  article (gnus-data-number (car data))))
9432       (setq data (cdr data)))
9433     (if article
9434         (gnus-summary-goto-article article)
9435       (error "No unread articles"))
9436     (gnus-summary-position-point)))
9437
9438 (defun gnus-summary-goto-article (article &optional all-headers force)
9439   "Fetch ARTICLE and display it if it exists.
9440 If ALL-HEADERS is non-nil, no header lines are hidden."
9441   (interactive
9442    (list
9443     (string-to-int
9444      (completing-read 
9445       "Article number: "
9446       (mapcar (lambda (number) (list (int-to-string number)))
9447               gnus-newsgroup-limit)))
9448     current-prefix-arg
9449     t))
9450   (prog1
9451       (if (gnus-summary-goto-subject article force)
9452           (gnus-summary-display-article article all-headers)
9453         (message "Couldn't go to article %s" article) nil)
9454     (gnus-summary-position-point)))
9455
9456 (defun gnus-summary-goto-last-article ()
9457   "Go to the previously read article."
9458   (interactive)
9459   (prog1
9460       (and gnus-last-article
9461            (gnus-summary-goto-article gnus-last-article))
9462     (gnus-summary-position-point)))
9463
9464 (defun gnus-summary-pop-article (number)
9465   "Pop one article off the history and go to the previous.
9466 NUMBER articles will be popped off."
9467   (interactive "p")
9468   (let (to)
9469     (setq gnus-newsgroup-history
9470           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
9471     (if to
9472         (gnus-summary-goto-article (car to))
9473       (error "Article history empty")))
9474   (gnus-summary-position-point))
9475
9476 ;; Summary commands and functions for limiting the summary buffer.
9477
9478 (defun gnus-summary-limit-to-articles (n)
9479   "Limit the summary buffer to the next N articles.
9480 If not given a prefix, use the process marked articles instead."
9481   (interactive "P")
9482   (gnus-set-global-variables)
9483   (prog1
9484       (let ((articles (gnus-summary-work-articles n)))
9485         (gnus-summary-limit articles))
9486     (gnus-summary-position-point)))
9487
9488 (defun gnus-summary-pop-limit (&optional total)
9489   "Restore the previous limit.
9490 If given a prefix, remove all limits."
9491   (interactive "P")
9492   (gnus-set-global-variables)
9493   (prog2
9494       (if total (setq gnus-newsgroup-limits 
9495                       (list (mapcar (lambda (h) (mail-header-number h))
9496                                     gnus-newsgroup-headers))))
9497       (gnus-summary-limit nil 'pop)
9498     (gnus-summary-position-point)))
9499
9500 (defun gnus-summary-limit-to-subject (subject)
9501   "Limit the summary buffer to articles that have subjects that match a regexp."
9502   (interactive "sRegexp: ")
9503   (when (not (equal "" subject))
9504     (prog1
9505         (let ((articles (gnus-summary-find-matching "subject" subject 'all)))
9506           (or articles (error "Found no matches for \"%s\"" subject))
9507           (gnus-summary-limit articles))
9508       (gnus-summary-position-point))))
9509
9510 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
9511 (make-obsolete 
9512  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
9513
9514 (defun gnus-summary-limit-to-unread (&optional all)
9515   "Limit the summary buffer to articles that are not marked as read.
9516 If ALL is non-nil, limit strictly to unread articles."
9517   (interactive "P")
9518   (if all
9519       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
9520     (gnus-summary-limit-to-marks
9521      ;; Concat all the marks that say that an article is read and have
9522      ;; those removed.  
9523      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
9524            gnus-killed-mark gnus-kill-file-mark
9525            gnus-low-score-mark gnus-expirable-mark
9526            gnus-canceled-mark gnus-catchup-mark)
9527      'reverse)))
9528
9529 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
9530 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
9531
9532 (defun gnus-summary-limit-to-marks (marks &optional reverse)
9533   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
9534 If REVERSE, limit the summary buffer to articles that are not marked
9535 with MARKS.  MARKS can either be a string of marks or a list of marks. 
9536 Returns how many articles were removed."
9537   (interactive "sMarks: ")
9538   (gnus-set-global-variables)
9539   (prog1
9540       (let ((data gnus-newsgroup-data)
9541             (marks (if (listp marks) marks
9542                      (append marks nil))) ; Transform to list.
9543             articles)
9544         (while data
9545           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
9546                  (memq (gnus-data-mark (car data)) marks))
9547                (setq articles (cons (gnus-data-number (car data)) articles)))
9548           (setq data (cdr data)))
9549         (gnus-summary-limit articles))
9550     (gnus-summary-position-point)))
9551
9552 (defun gnus-summary-limit-to-score (&optional score)
9553   "Limit to articles with score at or above SCORE."
9554   (interactive "P")
9555   (gnus-set-global-variables)
9556   (setq score (if score
9557                   (prefix-numeric-value score)
9558                 (or gnus-summary-default-score 0)))
9559   (let ((data gnus-newsgroup-data)
9560         articles)
9561     (while data
9562       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
9563                 score)
9564         (push (gnus-data-number (car data)) articles))
9565       (setq data (cdr data)))
9566     (prog1
9567         (gnus-summary-limit articles)
9568       (gnus-summary-position-point))))
9569
9570 (defun gnus-summary-limit-include-dormant ()
9571   "Display all the hidden articles that are marked as dormant."
9572   (interactive)
9573   (gnus-set-global-variables)
9574   (or gnus-newsgroup-dormant 
9575       (error "There are no dormant articles in this group"))
9576   (prog1
9577       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
9578     (gnus-summary-position-point)))
9579
9580 (defun gnus-summary-limit-exclude-dormant ()
9581   "Hide all dormant articles."
9582   (interactive)
9583   (gnus-set-global-variables)
9584   (prog1
9585       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
9586     (gnus-summary-position-point)))
9587
9588 (defun gnus-summary-limit-exclude-childless-dormant ()
9589   "Hide all dormant articles that have no children."
9590   (interactive)
9591   (gnus-set-global-variables)
9592   (let ((data gnus-newsgroup-data)
9593         articles)
9594     ;; Find all articles that are either not dormant or have
9595     ;; children. 
9596     (while data
9597       (and (or (not (= (gnus-data-mark (car data)) gnus-dormant-mark))
9598                (gnus-article-parent-p (gnus-data-number (car data))))
9599            (setq articles (cons (gnus-data-number (car data))
9600                                 articles)))
9601       (setq data (cdr data)))
9602     ;; Do the limiting.
9603     (prog1
9604         (gnus-summary-limit articles)
9605       (gnus-summary-position-point))))
9606  
9607 (defun gnus-summary-limit (articles &optional pop)
9608   (if pop
9609       ;; We pop the previous limit off the stack and use that.
9610       (setq articles (car gnus-newsgroup-limits)
9611             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
9612     ;; We use the new limit, so we push the old limit on the stack. 
9613     (setq gnus-newsgroup-limits 
9614           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
9615   ;; Set the limit.
9616   (setq gnus-newsgroup-limit articles)
9617   (let ((total (length gnus-newsgroup-data))
9618         (data (gnus-data-find-list (gnus-summary-article-number)))
9619         found)
9620     ;; This will do all the work of generating the new summary buffer
9621     ;; according to the new limit.
9622     (gnus-summary-prepare)
9623     ;; Try to return to the article you were at, or on in the
9624     ;; neighborhood.  
9625     (if data
9626         ;; We try to find some article after the current one.
9627         (while data
9628           (and (gnus-summary-goto-subject (gnus-data-number (car data)))
9629                (setq data nil
9630                      found t))
9631           (setq data (cdr data))))
9632     (or found
9633         ;; If there is no data, that means that we were after the last
9634         ;; article.  The same goes when we can't find any articles
9635         ;; after the current one.
9636         (progn
9637           (goto-char (point-max))
9638           (gnus-summary-find-prev)))
9639     ;; We return how many articles were removed from the summary
9640     ;; buffer as a result of the new limit.
9641     (- total (length gnus-newsgroup-data))))
9642
9643 (defun gnus-summary-initial-limit ()
9644   "Figure out what the initial limit is supposed to be on group entry.
9645 This entails weeding out unwanted dormants, low-scored articles,
9646 fetch-old-headers verbiage, and so on."
9647   ;; Most groups have nothing to remove.
9648   (if (and (null gnus-newsgroup-dormant)
9649            (not (eq gnus-fetch-old-headers 'some))
9650            (null gnus-summary-expunge-below))
9651       () ; Do nothing.
9652     (setq gnus-newsgroup-limits 
9653           (cons gnus-newsgroup-limit gnus-newsgroup-limits))
9654     (setq gnus-newsgroup-limit nil)
9655     (mapatoms
9656      (lambda (node)
9657        (if (null (car (symbol-value node)))
9658            (let ((nodes (cdr (symbol-value node))))
9659              (while nodes
9660                (gnus-summary-limit-children (car nodes))
9661                (setq nodes (cdr nodes))))))
9662      gnus-newsgroup-dependencies)
9663     (when (not gnus-newsgroup-limit)
9664       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
9665     gnus-newsgroup-limit))
9666
9667 (defun gnus-summary-limit-children (thread)
9668   "Return 1 if this subthread is visible and 0 if it is not."
9669   ;; First we get the number of visible children to this thread.  This
9670   ;; is done by recursing down the thread using this function, so this
9671   ;; will really go down to a leaf article first, before slowly
9672   ;; working its way up towards the root.
9673   (let ((children 
9674          (if (cdr thread)
9675              (apply '+ (mapcar (lambda (th)
9676                                  (gnus-summary-limit-children th))
9677                                (cdr thread)))
9678            0))
9679         (number (mail-header-number (car thread)))
9680         score)
9681     (if (or 
9682          ;; If this article is dormant and has absolutely no visible
9683          ;; children, then this article isn't visible.
9684          (and (memq number gnus-newsgroup-dormant)
9685               (= children 0))
9686          ;; If this is a "fetch-old-headered" and there is only one
9687          ;; visible child (or less), then we don't want this article. 
9688          (and (eq gnus-fetch-old-headers 'some)
9689               (memq number gnus-newsgroup-ancient)
9690               (<= children 1))
9691          ;; If we use expunging, and this article is really
9692          ;; low-scored, then we don't want this article.
9693          (when (and gnus-summary-expunge-below
9694                     (< (setq score 
9695                              (or (cdr (assq number gnus-newsgroup-scored)) 
9696                                  gnus-summary-default-score))
9697                        gnus-summary-expunge-below))
9698            ;; We increase the expunge-tally here, but that has
9699            ;; nothing to do with the limits, really.
9700            (incf gnus-newsgroup-expunged-tally)
9701            ;; We also mark as read here, if that's wanted.
9702            (when (and gnus-summary-mark-below
9703                       (< score gnus-summary-mark-below))
9704              (setq gnus-newsgroup-unreads 
9705                    (delq number gnus-newsgroup-unreads))
9706              (if gnus-newsgroup-auto-expire
9707                  (push number gnus-newsgroup-expirable)
9708                (push (cons number gnus-low-score-mark)
9709                      gnus-newsgroup-reads)))
9710            t))
9711         ;; Nope, invisible article.
9712         0
9713       ;; Ok, this article is to be visible, so we add it to the limit
9714       ;; and return 1.
9715       (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
9716       1)))
9717
9718 ;; Summary article oriented commands
9719
9720 (defun gnus-summary-refer-parent-article (n)
9721   "Refer parent article N times.
9722 The difference between N and the number of articles fetched is returned."
9723   (interactive "p")
9724   (gnus-set-global-variables)
9725   (while 
9726       (and 
9727        (> n 0)
9728        (let* ((header (gnus-summary-article-header))
9729               (ref 
9730                ;; If we try to find the parent of the currently
9731                ;; displayed article, then we take a look at the actual
9732                ;; References header, since this is slightly more
9733                ;; reliable than the References field we got from the
9734                ;; server. 
9735                (if (and (eq (mail-header-number header) 
9736                             (cdr gnus-article-current))
9737                         (equal gnus-newsgroup-name 
9738                                (car gnus-article-current)))
9739                    (save-excursion
9740                      (set-buffer gnus-original-article-buffer)
9741                      (gnus-narrow-to-headers)
9742                      (prog1
9743                          (mail-fetch-field "references")
9744                        (widen)))
9745                  ;; It's not the current article, so we take a bet on
9746                  ;; the value we got from the server. 
9747                  (mail-header-references header))))
9748          (if ref
9749              (or (gnus-summary-refer-article (gnus-parent-id ref))
9750                  (gnus-message 1 "Couldn't find parent"))
9751            (gnus-message 1 "No references in article %d"
9752                          (gnus-summary-article-number))
9753            nil)))
9754     (setq n (1- n)))
9755   (gnus-summary-position-point)
9756   n)
9757
9758 (defun gnus-summary-refer-references ()
9759   "Fetch all articles mentioned in the References header.
9760 Return how many articles were fetched."
9761   (interactive)
9762   (gnus-set-global-variables)
9763   (let ((ref (mail-header-references (gnus-summary-article-header)))
9764         (current (gnus-summary-article-number))
9765         (n 0))
9766     ;; For each Message-ID in the References header...
9767     (while (string-match "<[^>]*>" ref)
9768       (incf n)
9769       ;; ... fetch that article.
9770       (gnus-summary-refer-article 
9771        (prog1 (match-string 0 ref)
9772          (setq ref (substring ref (match-end 0))))))
9773     (gnus-summary-goto-subject current)
9774     (gnus-summary-position-point)
9775     n))
9776     
9777 (defun gnus-summary-refer-article (message-id)
9778   "Fetch an article specified by MESSAGE-ID."
9779   (interactive "sMessage-ID: ")
9780   (when (and (stringp message-id)
9781              (not (zerop (length message-id))))
9782     ;; Construct the correct Message-ID if necessary.
9783     ;; Suggested by tale@pawl.rpi.edu.
9784     (unless (string-match "^<" message-id)
9785       (setq message-id (concat "<" message-id)))
9786     (unless (string-match ">$" message-id)
9787       (setq message-id (concat message-id ">")))
9788     (let ((header (car (gnus-gethash (downcase message-id)
9789                                      gnus-newsgroup-dependencies))))
9790       (if header
9791           ;; The article is present in the buffer, to we just go to it.
9792           (gnus-summary-goto-article (mail-header-number header) nil t)
9793         ;; We fetch the article
9794         (let ((gnus-override-method gnus-refer-article-method)
9795               number)
9796           ;; Start the special refer-article method, if necessary.
9797           (when gnus-refer-article-method
9798             (gnus-check-server gnus-refer-article-method))
9799           ;; Fetch the header, and display the article.
9800           (when (setq number (gnus-summary-insert-subject message-id))
9801             (gnus-summary-select-article nil nil nil number)))))))
9802
9803 (defun gnus-summary-enter-digest-group (&optional force)
9804   "Enter a digest group based on the current article."
9805   (interactive "P")
9806   (gnus-set-global-variables)
9807   (gnus-summary-select-article)
9808   (let ((name (format "%s-%d" 
9809                       (gnus-group-prefixed-name 
9810                        gnus-newsgroup-name (list 'nndoc "")) 
9811                       gnus-current-article))
9812         (ogroup gnus-newsgroup-name)
9813         (buf (current-buffer)))
9814     (save-excursion
9815       (set-buffer gnus-original-article-buffer)
9816       (goto-char (point-min))
9817       (search-forward "\n\n" nil t)
9818       (narrow-to-region (point) (point-max)))
9819     (unwind-protect
9820         (if (gnus-group-read-ephemeral-group 
9821              name `(nndoc ,name (nndoc-address 
9822                                  ,(get-buffer gnus-original-article-buffer))
9823                           (nndoc-article-type ,(if force 'digest 'guess))) t)
9824             ;; Make all postings to this group go to the parent group.
9825             (setcdr (nthcdr 4 (gnus-get-info name))
9826                     (list (list (cons 'to-group ogroup))))
9827           ;; Couldn't select this doc group.
9828           (switch-to-buffer buf)
9829           (gnus-set-global-variables)
9830           (gnus-configure-windows 'summary)
9831           (gnus-message 3 "Article couldn't be entered?"))
9832       (save-excursion
9833         (set-buffer gnus-original-article-buffer)
9834         (widen)))))
9835
9836 (defun gnus-summary-isearch-article (&optional regexp-p)
9837   "Do incremental search forward on the current article.
9838 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
9839   (interactive "P")
9840   (gnus-set-global-variables)
9841   (gnus-summary-select-article)
9842   (gnus-eval-in-buffer-window 
9843    gnus-article-buffer
9844    (goto-char (point-min))
9845    (isearch-forward regexp-p)))
9846
9847 (defun gnus-summary-search-article-forward (regexp &optional backward)
9848   "Search for an article containing REGEXP forward.
9849 If BACKWARD, search backward instead."
9850   (interactive
9851    (list (read-string
9852           (format "Search article %s (regexp%s): "
9853                   (if current-prefix-arg "backward" "forward")
9854                   (if gnus-last-search-regexp
9855                       (concat ", default " gnus-last-search-regexp)
9856                     "")))
9857          current-prefix-arg))
9858   (gnus-set-global-variables)
9859   (if (string-equal regexp "")
9860       (setq regexp (or gnus-last-search-regexp ""))
9861     (setq gnus-last-search-regexp regexp))
9862   (if (gnus-summary-search-article regexp backward)
9863       (gnus-article-set-window-start 
9864        (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
9865     (error "Search failed: \"%s\"" regexp)))
9866
9867 (defun gnus-summary-search-article-backward (regexp)
9868   "Search for an article containing REGEXP backward."
9869   (interactive
9870    (list (read-string
9871           (format "Search article backward (regexp%s): "
9872                   (if gnus-last-search-regexp
9873                       (concat ", default " gnus-last-search-regexp)
9874                     "")))))
9875   (gnus-summary-search-article-forward regexp 'backward))
9876
9877 (defun gnus-summary-search-article (regexp &optional backward)
9878   "Search for an article containing REGEXP.
9879 Optional argument BACKWARD means do search for backward.
9880 gnus-select-article-hook is not called during the search."
9881   (let ((gnus-select-article-hook nil)  ;Disable hook.
9882         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
9883         (re-search
9884          (if backward
9885              (function re-search-backward) (function re-search-forward)))
9886         (found nil)
9887         (last nil))
9888     ;; Hidden thread subtrees must be searched for ,too.
9889     (gnus-summary-show-all-threads)
9890     ;; First of all, search current article.
9891     ;; We don't want to read article again from NNTP server nor reset
9892     ;; current point.
9893     (gnus-summary-select-article)
9894     (gnus-message 9 "Searching article: %d..." gnus-current-article)
9895     (setq last gnus-current-article)
9896     (gnus-eval-in-buffer-window
9897      gnus-article-buffer
9898      (save-restriction
9899        (widen)
9900        ;; Begin search from current point.
9901        (setq found (funcall re-search regexp nil t))))
9902     ;; Then search next articles.
9903     (while (and (not found)
9904                 (gnus-summary-display-article 
9905                  (if backward (gnus-summary-find-prev)
9906                    (gnus-summary-find-next))))
9907       (gnus-message 9 "Searching article: %d..." gnus-current-article)
9908       (gnus-eval-in-buffer-window
9909        gnus-article-buffer
9910        (save-restriction
9911          (widen)
9912          (goto-char (if backward (point-max) (point-min)))
9913          (setq found (funcall re-search regexp nil t)))))
9914     (message "")
9915     ;; Adjust article pointer.
9916     (or (eq last gnus-current-article)
9917         (setq gnus-last-article last))
9918     ;; Return T if found such article.
9919     found))
9920
9921 (defun gnus-summary-find-matching (header regexp &optional backward unread
9922                                           not-case-fold)
9923   "Return a list of all articles that match REGEXP on HEADER.
9924 The search stars on the current article and goes forwards unless
9925 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
9926 If UNREAD is non-nil, only unread articles will
9927 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
9928 in the comparisons."
9929   (let ((data (if (eq backward 'all) gnus-newsgroup-data
9930                 (gnus-data-find-list 
9931                  (gnus-summary-article-number) (gnus-data-list backward))))
9932         (func (intern (concat "gnus-header-" header)))
9933         (case-fold-search (not not-case-fold))
9934         articles d)
9935     (or (fboundp func) (error "%s is not a valid header" header))
9936     (while data
9937       (setq d (car data))
9938       (and (or (not unread)             ; We want all articles...
9939                (gnus-data-unread-p d))  ; Or just unreads.
9940            (vectorp (gnus-data-header d)) ; It's not a pseudo.
9941            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
9942            (setq articles (cons (gnus-data-number d) articles))) ; Success!
9943       (setq data (cdr data)))
9944     (nreverse articles)))
9945     
9946 (defun gnus-summary-execute-command (header regexp command &optional backward)
9947   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
9948 If HEADER is an empty string (or nil), the match is done on the entire
9949 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
9950   (interactive
9951    (list (let ((completion-ignore-case t))
9952            (completing-read 
9953             "Header name: "
9954             (mapcar (lambda (string) (list string))
9955                     '("Number" "Subject" "From" "Lines" "Date"
9956                       "Message-ID" "Xref" "References"))
9957             nil 'require-match))
9958          (read-string "Regexp: ")
9959          (read-key-sequence "Command: ")
9960          current-prefix-arg))
9961   (gnus-set-global-variables)
9962   ;; Hidden thread subtrees must be searched as well.
9963   (gnus-summary-show-all-threads)
9964   ;; We don't want to change current point nor window configuration.
9965   (save-excursion
9966     (save-window-excursion
9967       (gnus-message 6 "Executing %s..." (key-description command))
9968       ;; We'd like to execute COMMAND interactively so as to give arguments.
9969       (gnus-execute header regexp
9970                     `(lambda () (call-interactively ',(key-binding command)))
9971                     backward)
9972       (gnus-message 6 "Executing %s...done" (key-description command)))))
9973
9974 (defun gnus-summary-beginning-of-article ()
9975   "Scroll the article back to the beginning."
9976   (interactive)
9977   (gnus-set-global-variables)
9978   (gnus-summary-select-article)
9979   (gnus-configure-windows 'article)
9980   (gnus-eval-in-buffer-window
9981    gnus-article-buffer
9982    (widen)
9983    (goto-char (point-min))
9984    (and gnus-break-pages (gnus-narrow-to-page))))
9985
9986 (defun gnus-summary-end-of-article ()
9987   "Scroll to the end of the article."
9988   (interactive)
9989   (gnus-set-global-variables)
9990   (gnus-summary-select-article)
9991   (gnus-configure-windows 'article)
9992   (gnus-eval-in-buffer-window 
9993    gnus-article-buffer
9994    (widen)
9995    (goto-char (point-max))
9996    (recenter -3)
9997    (and gnus-break-pages (gnus-narrow-to-page))))
9998
9999 (defun gnus-summary-show-article (&optional arg)
10000   "Force re-fetching of the current article.
10001 If ARG (the prefix) is non-nil, show the raw article without any
10002 article massaging functions being run."
10003   (interactive "P")
10004   (gnus-set-global-variables)
10005   (if (not arg)
10006       ;; Select the article the normal way.
10007       (gnus-summary-select-article nil 'force)
10008     ;; Bind the article treatment functions to nil.
10009     (let ((gnus-have-all-headers t)
10010           gnus-article-display-hook
10011           gnus-article-prepare-hook
10012           gnus-visual)
10013       (gnus-summary-select-article nil 'force)))
10014   (gnus-configure-windows 'article)
10015   (gnus-summary-position-point))
10016
10017 (defun gnus-summary-verbose-headers (&optional arg)
10018   "Toggle permanent full header display.
10019 If ARG is a positive number, turn header display on.
10020 If ARG is a negative number, turn header display off."
10021   (interactive "P")
10022   (gnus-set-global-variables)
10023   (gnus-summary-toggle-header arg)
10024   (setq gnus-show-all-headers
10025         (cond ((or (not (numberp arg))
10026                    (zerop arg))
10027                (not gnus-show-all-headers))
10028               ((natnump arg)
10029                t))))
10030
10031 (defun gnus-summary-toggle-header (&optional arg)
10032   "Show the headers if they are hidden, or hide them if they are shown.
10033 If ARG is a positive number, show the entire header.
10034 If ARG is a negative number, hide the unwanted header lines."
10035   (interactive "P")
10036   (gnus-set-global-variables)
10037   (save-excursion
10038     (set-buffer gnus-article-buffer)
10039     (let* ((buffer-read-only nil)
10040            (inhibit-point-motion-hooks t) 
10041            (hidden (text-property-any 
10042                     (goto-char (point-min)) (search-forward "\n\n")
10043                     'invisible t))
10044            e)
10045       (goto-char (point-min))
10046       (when (search-forward "\n\n" nil t)
10047         (delete-region (point-min) (1- (point))))
10048       (goto-char (point-min))
10049       (save-excursion 
10050         (set-buffer gnus-original-article-buffer)
10051         (goto-char (point-min))
10052         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
10053       (insert-buffer-substring gnus-original-article-buffer 1 e)
10054       (let ((hook (delq 'gnus-article-hide-headers-if-wanted
10055                         (delq 'gnus-article-hide-headers
10056                               (copy-sequence gnus-article-display-hook))))
10057             (gnus-inhibit-hiding t))
10058         (run-hooks 'hook))
10059       (if (or (not hidden) (and (numberp arg) (< arg 0)))
10060           (gnus-article-hide-headers)))))
10061
10062 (defun gnus-summary-show-all-headers ()
10063   "Make all header lines visible."
10064   (interactive)
10065   (gnus-set-global-variables)
10066   (gnus-article-show-all-headers))
10067
10068 (defun gnus-summary-toggle-mime (&optional arg)
10069   "Toggle MIME processing.
10070 If ARG is a positive number, turn MIME processing on."
10071   (interactive "P")
10072   (gnus-set-global-variables)
10073   (setq gnus-show-mime
10074         (if (null arg) (not gnus-show-mime)
10075           (> (prefix-numeric-value arg) 0)))
10076   (gnus-summary-select-article t 'force))
10077
10078 (defun gnus-summary-caesar-message (&optional arg)
10079   "Caesar rotate the current article by 13.
10080 The numerical prefix specifies how manu places to rotate each letter
10081 forward."
10082   (interactive "P")
10083   (gnus-set-global-variables)
10084   (gnus-summary-select-article)
10085   (let ((mail-header-separator ""))
10086     (gnus-eval-in-buffer-window 
10087      gnus-article-buffer
10088      (save-restriction
10089        (widen)
10090        (let ((start (window-start)))
10091          (news-caesar-buffer-body arg)
10092          (set-window-start (get-buffer-window (current-buffer)) start))))))
10093
10094 (defun gnus-summary-stop-page-breaking ()
10095   "Stop page breaking in the current article."
10096   (interactive)
10097   (gnus-set-global-variables)
10098   (gnus-summary-select-article)
10099   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
10100
10101 ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
10102
10103 (defun gnus-summary-move-article (&optional n to-newsgroup select-method)
10104   "Move the current article to a different newsgroup.
10105 If N is a positive number, move the N next articles.
10106 If N is a negative number, move the N previous articles.
10107 If N is nil and any articles have been marked with the process mark,
10108 move those articles instead.
10109 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
10110 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10111 re-spool using this method.
10112 For this function to work, both the current newsgroup and the
10113 newsgroup that you want to move to have to support the `request-move'
10114 and `request-accept' functions. (Ie. mail newsgroups at present.)"
10115   (interactive "P")
10116   (gnus-set-global-variables)
10117   (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)
10118       (error "The current newsgroup does not support article moving"))
10119   (let ((articles (gnus-summary-work-articles n))
10120         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
10121         art-group to-method sel-met)
10122     (if (and (not to-newsgroup) (not select-method))
10123         (setq to-newsgroup
10124               (completing-read 
10125                (format "Where do you want to move %s? %s"
10126                        (if (> (length articles) 1)
10127                            (format "these %d articles" (length articles))
10128                          "this article")
10129                        (if gnus-current-move-group
10130                            (format "(default %s) " gnus-current-move-group)
10131                          ""))
10132                gnus-active-hashtb nil nil prefix)))
10133     (if to-newsgroup
10134         (progn
10135           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
10136               (setq to-newsgroup (or gnus-current-move-group "")))
10137           (or (gnus-active to-newsgroup)
10138               (gnus-activate-group to-newsgroup)
10139               (error "No such group: %s" to-newsgroup))
10140           (setq gnus-current-move-group to-newsgroup)))
10141     (setq to-method (if select-method (list select-method "")
10142                       (gnus-find-method-for-group to-newsgroup)))
10143     (or (gnus-check-backend-function 'request-accept-article (car to-method))
10144         (error "%s does not support article copying" (car to-method)))
10145     (or (gnus-check-server to-method)
10146         (error "Can't open server %s" (car to-method)))
10147     (gnus-message 6 "Moving to %s: %s..." 
10148                   (or select-method to-newsgroup) articles)
10149     (while articles
10150       (if (setq art-group
10151                 (gnus-request-move-article 
10152                  (car articles)         ; Article to move
10153                  gnus-newsgroup-name    ; From newsgrouo
10154                  (nth 1 (gnus-find-method-for-group 
10155                          gnus-newsgroup-name)) ; Server
10156                  (list 'gnus-request-accept-article 
10157                        (if select-method
10158                            (list 'quote select-method)
10159                          to-newsgroup)
10160                        (not (cdr articles))) ; Accept form
10161                  (not (cdr articles)))) ; Only save nov last time
10162           (let* ((buffer-read-only nil)
10163                  (entry 
10164                   (or
10165                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
10166                    (gnus-gethash 
10167                     (gnus-group-prefixed-name 
10168                      (car art-group) 
10169                      (if select-method (list select-method "")
10170                        (gnus-find-method-for-group to-newsgroup)))
10171                     gnus-newsrc-hashtb)))
10172                  (info (nth 2 entry))
10173                  (article (car articles)))
10174             ;; Update the group that has been moved to.
10175             (if (not info)
10176                 ()                      ; This group does not exist yet.
10177               (unless (memq article gnus-newsgroup-unreads)
10178                 (gnus-info-set-read 
10179                  info (gnus-add-to-range (gnus-info-read info) 
10180                                          (list (cdr art-group)))))
10181
10182               ;; Copy any marks over to the new group.
10183               (let ((marks '((tick . gnus-newsgroup-marked)
10184                              (dormant . gnus-newsgroup-dormant)
10185                              (expire . gnus-newsgroup-expirable)
10186                              (bookmark . gnus-newsgroup-bookmarks)
10187                              (reply . gnus-newsgroup-replied)))
10188                     (to-article (cdr art-group)))
10189
10190                 ;; See whether the article is to be put in the cache.
10191                 (when gnus-use-cache
10192                   (gnus-cache-possibly-enter-article 
10193                    (gnus-info-group info) to-article
10194                    (let ((header (copy-sequence
10195                                   (gnus-summary-article-header article))))
10196                      (mail-header-set-number header to-article)
10197                      header)
10198                    (memq article gnus-newsgroup-marked)
10199                    (memq article gnus-newsgroup-dormant)
10200                    (memq article gnus-newsgroup-unreads)))
10201
10202                 (while marks
10203                   (if (memq article (symbol-value (cdr (car marks))))
10204                       (gnus-add-marked-articles 
10205                        (gnus-info-group info) (car (car marks))
10206                        (list to-article) info))
10207                   (setq marks (cdr marks)))))
10208             (gnus-summary-goto-subject article)
10209             (gnus-summary-mark-article article gnus-canceled-mark))
10210         (gnus-message 1 "Couldn't move article %s" (car articles)))
10211       (gnus-summary-remove-process-mark (car articles))
10212       (setq articles (cdr articles)))
10213     (gnus-set-mode-line 'summary)))
10214
10215 (defun gnus-summary-respool-article (&optional n respool-method)
10216   "Respool the current article.
10217 The article will be squeezed through the mail spooling process again,
10218 which means that it will be put in some mail newsgroup or other
10219 depending on `nnmail-split-methods'.
10220 If N is a positive number, respool the N next articles.
10221 If N is a negative number, respool the N previous articles.
10222 If N is nil and any articles have been marked with the process mark,
10223 respool those articles instead.
10224
10225 Respooling can be done both from mail groups and \"real\" newsgroups.
10226 In the former case, the articles in question will be moved from the
10227 current group into whatever groups they are destined to.  In the
10228 latter case, they will be copied into the relevant groups."
10229   (interactive "P")
10230   (gnus-set-global-variables)
10231   (let ((respool-methods (gnus-methods-using 'respool))
10232         (methname 
10233          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
10234     (or respool-method
10235         (setq respool-method
10236               (completing-read
10237                "What method do you want to use when respooling? "
10238                respool-methods nil t methname)))
10239     (or (string= respool-method "")
10240         (if (assoc (symbol-name
10241                     (car (gnus-find-method-for-group gnus-newsgroup-name)))
10242                    respool-methods)
10243             (gnus-summary-move-article n nil (intern respool-method))
10244           (gnus-summary-copy-article n nil (intern respool-method))))))
10245
10246 ;; Suggested by gregj@unidata.com (Gregory J. Grubbs).
10247 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
10248   "Move the current article to a different newsgroup.
10249 If N is a positive number, move the N next articles.
10250 If N is a negative number, move the N previous articles.
10251 If N is nil and any articles have been marked with the process mark,
10252 move those articles instead.
10253 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
10254 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10255 re-spool using this method.
10256 For this function to work, the newsgroup that you want to move to have
10257 to support the `request-move' and `request-accept'
10258 functions. (Ie. mail newsgroups at present.)"
10259   (interactive "P")
10260   (gnus-set-global-variables)
10261   (let ((articles (gnus-summary-work-articles n))
10262         (copy-buf (get-buffer-create "*copy work*"))
10263         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
10264         art-group to-method)
10265     (buffer-disable-undo copy-buf)
10266     (if (and (not to-newsgroup) (not select-method))
10267         (setq to-newsgroup
10268               (completing-read 
10269                (format "Where do you want to copy %s? %s"
10270                        (if (> (length articles) 1)
10271                            (format "these %d articles" (length articles))
10272                          "this article")
10273                        (if gnus-current-move-group
10274                            (format "(default %s) " gnus-current-move-group)
10275                          ""))
10276                gnus-active-hashtb nil nil prefix)))
10277     (if to-newsgroup
10278         (progn
10279           (if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
10280               (setq to-newsgroup (or gnus-current-move-group "")))
10281           (or (gnus-active to-newsgroup)
10282               (gnus-activate-group to-newsgroup)
10283               (error "No such group: %s" to-newsgroup))
10284           (setq gnus-current-move-group to-newsgroup)))
10285     (setq to-method (if select-method (list select-method "")
10286                       (gnus-find-method-for-group to-newsgroup)))
10287     (or (gnus-check-backend-function 'request-accept-article (car to-method))
10288         (error "%s does not support article copying" (car to-method)))
10289     (or (gnus-check-server to-method)
10290         (error "Can't open server %s" (car to-method)))
10291     (while articles
10292       (gnus-message 6 "Copying to %s: %s..." 
10293                     (or select-method to-newsgroup) articles)
10294       (if (setq art-group
10295                 (save-excursion
10296                   (set-buffer copy-buf)
10297                   (gnus-request-article-this-buffer
10298                    (car articles) gnus-newsgroup-name)
10299                   (gnus-request-accept-article
10300                    (if select-method select-method to-newsgroup)
10301                    (not (cdr articles)))))
10302           (let* ((entry 
10303                   (or
10304                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
10305                    (gnus-gethash 
10306                     (gnus-group-prefixed-name 
10307                      (car art-group) 
10308                      (if select-method (list select-method "")
10309                        (gnus-find-method-for-group to-newsgroup)))
10310                     gnus-newsrc-hashtb)))
10311                  (info (nth 2 entry))
10312                  (article (car articles)))
10313             ;; We copy the info over to the new group.
10314             (if (not info)
10315                 ()                      ; This group does not exist (yet).
10316               (if (not (memq article gnus-newsgroup-unreads))
10317                   (gnus-info-set-read 
10318                    info (gnus-add-to-range (gnus-info-read info) 
10319                                            (list (cdr art-group)))))
10320
10321               ;; Copy any marks over to the new group.
10322               (let ((marks '((tick . gnus-newsgroup-marked)
10323                              (dormant . gnus-newsgroup-dormant)
10324                              (expire . gnus-newsgroup-expirable)
10325                              (bookmark . gnus-newsgroup-bookmarks)
10326                              (reply . gnus-newsgroup-replied)))
10327                     (to-article (cdr art-group)))
10328
10329               ;; See whether the article is to be put in the cache.
10330               (when gnus-use-cache
10331                 (gnus-cache-possibly-enter-article 
10332                  (gnus-info-group info) to-article 
10333                  (let ((header (copy-sequence
10334                                 (gnus-summary-article-header article))))
10335                    (mail-header-set-number header to-article)
10336                    header)
10337                  (memq article gnus-newsgroup-marked)
10338                  (memq article gnus-newsgroup-dormant)
10339                  (memq article gnus-newsgroup-unreads)))
10340
10341               (while marks
10342                 (if (memq article (symbol-value (cdr (car marks))))
10343                     (gnus-add-marked-articles 
10344                      (gnus-info-group info) (car (car marks)) 
10345                      (list to-article) info))
10346                 (setq marks (cdr marks))))))
10347         (gnus-message 1 "Couldn't copy article %s" (car articles)))
10348       (gnus-summary-remove-process-mark (car articles))
10349       (setq articles (cdr articles)))
10350     (kill-buffer copy-buf)))
10351
10352 (defun gnus-summary-import-article (file)
10353   "Import a random file into a mail newsgroup."
10354   (interactive "fImport file: ")
10355   (gnus-set-global-variables)
10356   (let ((group gnus-newsgroup-name)
10357         atts lines)
10358     (or (gnus-check-backend-function 'request-accept-article group)
10359         (error "%s does not support article importing" group))
10360     (or (file-readable-p file)
10361         (not (file-regular-p file))
10362         (error "Can't read %s" file))
10363     (save-excursion
10364       (set-buffer (get-buffer-create " *import file*"))
10365       (buffer-disable-undo (current-buffer))
10366       (erase-buffer)
10367       (insert-file-contents file)
10368       (goto-char (point-min))
10369       (if (nnheader-article-p)
10370           ()
10371         (setq atts (file-attributes file)
10372               lines (count-lines (point-min) (point-max)))
10373         (insert "From: " (read-string "From: ") "\n"
10374                 "Subject: " (read-string "Subject: ") "\n"
10375                 "Date: " (current-time-string (nth 5 atts)) "\n"
10376                 "Message-ID: " (gnus-inews-message-id) "\n"
10377                 "Lines: " (int-to-string lines) "\n"
10378                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
10379       (gnus-request-accept-article group t)
10380       (kill-buffer (current-buffer)))))
10381
10382 (defun gnus-summary-expire-articles ()
10383   "Expire all articles that are marked as expirable in the current group."
10384   (interactive)
10385   (gnus-set-global-variables)
10386   (when (gnus-check-backend-function 
10387          'request-expire-articles gnus-newsgroup-name)
10388     ;; This backend supports expiry.
10389     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
10390            (expirable (if total
10391                           (gnus-list-of-read-articles gnus-newsgroup-name)
10392                         (setq gnus-newsgroup-expirable
10393                               (sort gnus-newsgroup-expirable '<))))
10394            (expiry-wait (gnus-group-get-parameter 
10395                          gnus-newsgroup-name 'expiry-wait))
10396            es)
10397       (when expirable
10398         ;; There are expirable articles in this group, so we run them
10399         ;; through the expiry process.
10400         (gnus-message 6 "Expiring articles...")
10401         ;; The list of articles that weren't expired is returned.
10402         (if expiry-wait
10403             (let ((nnmail-expiry-wait-function nil)
10404                   (nnmail-expiry-wait expiry-wait))
10405               (setq es (gnus-request-expire-articles
10406                         expirable gnus-newsgroup-name)))
10407           (setq es (gnus-request-expire-articles
10408                     expirable gnus-newsgroup-name)))
10409         (or total (setq gnus-newsgroup-expirable es))
10410         ;; We go through the old list of expirable, and mark all
10411         ;; really expired articles as non-existant.
10412         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
10413           (let ((gnus-use-cache nil))
10414             (while expirable
10415               (unless (memq (car expirable) es)
10416                 (when (gnus-data-find (car expirable))
10417                   (gnus-summary-mark-article
10418                    (car expirable) gnus-canceled-mark)))
10419               (setq expirable (cdr expirable)))))
10420         (gnus-message 6 "Expiring articles...done")))))
10421
10422 (defun gnus-summary-expire-articles-now ()
10423   "Expunge all expirable articles in the current group.
10424 This means that *all* articles that are marked as expirable will be
10425 deleted forever, right now."
10426   (interactive)
10427   (gnus-set-global-variables)
10428   (or gnus-expert-user
10429       (gnus-y-or-n-p
10430        "Are you really, really, really sure you want to expunge? ")
10431       (error "Phew!"))
10432   (let ((nnmail-expiry-wait 'immediate)
10433         (nnmail-expiry-wait-function nil))
10434     (gnus-summary-expire-articles)))
10435
10436 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
10437 (defun gnus-summary-delete-article (&optional n)
10438   "Delete the N next (mail) articles.
10439 This command actually deletes articles.  This is not a marking
10440 command.  The article will disappear forever from your life, never to
10441 return. 
10442 If N is negative, delete backwards.
10443 If N is nil and articles have been marked with the process mark,
10444 delete these instead."
10445   (interactive "P")
10446   (gnus-set-global-variables)
10447   (or (gnus-check-backend-function 'request-expire-articles 
10448                                    gnus-newsgroup-name)
10449       (error "The current newsgroup does not support article deletion."))
10450   ;; Compute the list of articles to delete.
10451   (let ((articles (gnus-summary-work-articles n))
10452         not-deleted)
10453     (if (and gnus-novice-user
10454              (not (gnus-y-or-n-p 
10455                    (format "Do you really want to delete %s forever? "
10456                            (if (> (length articles) 1) "these articles"
10457                              "this article")))))
10458         ()
10459       ;; Delete the articles.
10460       (setq not-deleted (gnus-request-expire-articles 
10461                          articles gnus-newsgroup-name 'force))
10462       (while articles
10463         (gnus-summary-remove-process-mark (car articles))       
10464         ;; The backend might not have been able to delete the article
10465         ;; after all.  
10466         (or (memq (car articles) not-deleted)
10467             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
10468         (setq articles (cdr articles))))
10469     (gnus-summary-position-point)
10470     (gnus-set-mode-line 'summary)
10471     not-deleted))
10472
10473 (defun gnus-summary-edit-article (&optional force)
10474   "Enter into a buffer and edit the current article.
10475 This will have permanent effect only in mail groups.
10476 If FORCE is non-nil, allow editing of articles even in read-only
10477 groups."
10478   (interactive "P")
10479   (gnus-set-global-variables)
10480   (when (and (not force)
10481              (gnus-group-read-only-p))
10482     (error "The current newsgroup does not support article editing."))
10483   (gnus-summary-select-article t nil t)
10484   (gnus-configure-windows 'article)
10485   (select-window (get-buffer-window gnus-article-buffer))
10486   (gnus-message 6 "C-c C-c to end edits")
10487   (setq buffer-read-only nil)
10488   (text-mode)
10489   (use-local-map (copy-keymap (current-local-map)))
10490   (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
10491   (buffer-enable-undo)
10492   (widen)
10493   (goto-char (point-min))
10494   (search-forward "\n\n" nil t))
10495
10496 (defun gnus-summary-edit-article-done ()
10497   "Make edits to the current article permanent."
10498   (interactive)
10499   (if (gnus-group-read-only-p)
10500       (progn
10501         (gnus-summary-edit-article-postpone)
10502         (message "The current newsgroup does not support article editing.")
10503         (ding))
10504     (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
10505       (erase-buffer)
10506       (insert buf)
10507       (if (not (gnus-request-replace-article 
10508                 (cdr gnus-article-current) (car gnus-article-current) 
10509                 (current-buffer)))
10510           (error "Couldn't replace article.")
10511         (gnus-article-mode)
10512         (use-local-map gnus-article-mode-map)
10513         (setq buffer-read-only t)
10514         (buffer-disable-undo (current-buffer))
10515         (gnus-configure-windows 'summary))
10516       (and (gnus-visual-p 'summary-highlight 'highlight)
10517            (run-hooks 'gnus-visual-mark-article-hook)))))
10518
10519 (defun gnus-summary-edit-article-postpone ()
10520   "Postpone changes to the current article."
10521   (interactive)
10522   (gnus-article-mode)
10523   (use-local-map gnus-article-mode-map)
10524   (setq buffer-read-only t)
10525   (buffer-disable-undo (current-buffer))
10526   (gnus-configure-windows 'summary)
10527   (and (gnus-visual-p 'summary-highlight 'highlight)
10528        (run-hooks 'gnus-visual-mark-article-hook)))
10529
10530 (defun gnus-summary-respool-query ()
10531   "Query where the respool algorithm would put this article."
10532   (interactive)
10533   (gnus-set-global-variables)
10534   (gnus-summary-select-article)
10535   (save-excursion
10536     (set-buffer gnus-article-buffer)
10537     (save-restriction
10538       (goto-char (point-min))
10539       (search-forward "\n\n")
10540       (narrow-to-region (point-min) (point))
10541       (pp-eval-expression
10542        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
10543
10544 ;; Summary score commands.
10545
10546 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
10547
10548 (defun gnus-summary-raise-score (n)
10549   "Raise the score of the current article by N."
10550   (interactive "p")
10551   (gnus-set-global-variables)
10552   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
10553
10554 (defun gnus-summary-set-score (n)
10555   "Set the score of the current article to N."
10556   (interactive "p")
10557   (gnus-set-global-variables)
10558   (save-excursion
10559     (gnus-summary-show-thread)
10560     (let ((buffer-read-only nil))
10561       ;; Set score.
10562       (gnus-summary-update-mark
10563        (if (= n (or gnus-summary-default-score 0)) ? 
10564          (if (< n (or gnus-summary-default-score 0)) 
10565              gnus-score-below-mark gnus-score-over-mark)) 'score))
10566     (let* ((article (gnus-summary-article-number))
10567            (score (assq article gnus-newsgroup-scored)))
10568       (if score (setcdr score n)
10569         (setq gnus-newsgroup-scored 
10570               (cons (cons article n) gnus-newsgroup-scored))))
10571     (gnus-summary-update-line)))
10572
10573 (defun gnus-summary-current-score ()
10574   "Return the score of the current article."
10575   (interactive)
10576   (gnus-set-global-variables)
10577   (message "%s" (gnus-summary-article-score)))
10578
10579 ;; Summary marking commands.
10580
10581 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
10582   "Mark articles which has the same subject as read, and then select the next.
10583 If UNMARK is positive, remove any kind of mark.
10584 If UNMARK is negative, tick articles."
10585   (interactive "P")
10586   (gnus-set-global-variables)
10587   (if unmark
10588       (setq unmark (prefix-numeric-value unmark)))
10589   (let ((count
10590          (gnus-summary-mark-same-subject
10591           (gnus-summary-article-subject) unmark)))
10592     ;; Select next unread article.  If auto-select-same mode, should
10593     ;; select the first unread article.
10594     (gnus-summary-next-article t (and gnus-auto-select-same
10595                                       (gnus-summary-article-subject)))
10596     (gnus-message 7 "%d article%s marked as %s"
10597                   count (if (= count 1) " is" "s are")
10598                   (if unmark "unread" "read"))))
10599
10600 (defun gnus-summary-kill-same-subject (&optional unmark)
10601   "Mark articles which has the same subject as read. 
10602 If UNMARK is positive, remove any kind of mark.
10603 If UNMARK is negative, tick articles."
10604   (interactive "P")
10605   (gnus-set-global-variables)
10606   (if unmark
10607       (setq unmark (prefix-numeric-value unmark)))
10608   (let ((count
10609          (gnus-summary-mark-same-subject
10610           (gnus-summary-article-subject) unmark)))
10611     ;; If marked as read, go to next unread subject.
10612     (if (null unmark)
10613         ;; Go to next unread subject.
10614         (gnus-summary-next-subject 1 t))
10615     (gnus-message 7 "%d articles are marked as %s"
10616                   count (if unmark "unread" "read"))))
10617
10618 (defun gnus-summary-mark-same-subject (subject &optional unmark)
10619   "Mark articles with same SUBJECT as read, and return marked number.
10620 If optional argument UNMARK is positive, remove any kinds of marks.
10621 If optional argument UNMARK is negative, mark articles as unread instead."
10622   (let ((count 1))
10623     (save-excursion
10624       (cond 
10625        ((null unmark)                   ; Mark as read.
10626         (while (and 
10627                 (progn
10628                   (gnus-summary-mark-article-as-read gnus-killed-mark)
10629                   (gnus-summary-show-thread) t)
10630                 (gnus-summary-find-subject subject))
10631           (setq count (1+ count))))
10632        ((> unmark 0)                    ; Tick.
10633         (while (and
10634                 (progn
10635                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
10636                   (gnus-summary-show-thread) t)
10637                 (gnus-summary-find-subject subject))
10638           (setq count (1+ count))))
10639        (t                               ; Mark as unread.
10640         (while (and
10641                 (progn
10642                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
10643                   (gnus-summary-show-thread) t)
10644                 (gnus-summary-find-subject subject))
10645           (setq count (1+ count)))))
10646       (gnus-set-mode-line 'summary)
10647       ;; Return the number of marked articles.
10648       count)))
10649
10650 (defun gnus-summary-mark-as-processable (n &optional unmark)
10651   "Set the process mark on the next N articles.
10652 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
10653 the process mark instead.  The difference between N and the actual
10654 number of articles marked is returned."
10655   (interactive "p")
10656   (gnus-set-global-variables)
10657   (let ((backward (< n 0))
10658         (n (abs n)))
10659     (while (and 
10660             (> n 0)
10661             (if unmark
10662                 (gnus-summary-remove-process-mark
10663                  (gnus-summary-article-number))
10664               (gnus-summary-set-process-mark (gnus-summary-article-number)))
10665             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
10666       (setq n (1- n)))
10667     (if (/= 0 n) (gnus-message 7 "No more articles"))
10668     (gnus-summary-recenter)
10669     (gnus-summary-position-point)
10670     n))
10671
10672 (defun gnus-summary-unmark-as-processable (n)
10673   "Remove the process mark from the next N articles.
10674 If N is negative, mark backward instead.  The difference between N and
10675 the actual number of articles marked is returned."
10676   (interactive "p")
10677   (gnus-set-global-variables)
10678   (gnus-summary-mark-as-processable n t))
10679
10680 (defun gnus-summary-unmark-all-processable ()
10681   "Remove the process mark from all articles."
10682   (interactive)
10683   (gnus-set-global-variables)
10684   (save-excursion
10685     (while gnus-newsgroup-processable
10686       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
10687   (gnus-summary-position-point))
10688
10689 (defun gnus-summary-mark-as-expirable (n)
10690   "Mark N articles forward as expirable.
10691 If N is negative, mark backward instead.  The difference between N and
10692 the actual number of articles marked is returned."
10693   (interactive "p")
10694   (gnus-set-global-variables)
10695   (gnus-summary-mark-forward n gnus-expirable-mark))
10696
10697 (defun gnus-summary-mark-article-as-replied (article)
10698   "Mark ARTICLE replied and update the summary line."
10699   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
10700   (let ((buffer-read-only nil))
10701     (if (gnus-summary-goto-subject article)
10702         (progn
10703           (gnus-summary-update-mark gnus-replied-mark 'replied)
10704           t))))
10705
10706 (defun gnus-summary-set-bookmark (article)
10707   "Set a bookmark in current article."
10708   (interactive (list (gnus-summary-article-number)))
10709   (gnus-set-global-variables)
10710   (if (or (not (get-buffer gnus-article-buffer))
10711           (not gnus-current-article)
10712           (not gnus-article-current)
10713           (not (equal gnus-newsgroup-name (car gnus-article-current))))
10714       (error "No current article selected"))
10715   ;; Remove old bookmark, if one exists.
10716   (let ((old (assq article gnus-newsgroup-bookmarks)))
10717     (if old (setq gnus-newsgroup-bookmarks 
10718                   (delq old gnus-newsgroup-bookmarks))))
10719   ;; Set the new bookmark, which is on the form 
10720   ;; (article-number . line-number-in-body).
10721   (setq gnus-newsgroup-bookmarks 
10722         (cons 
10723          (cons article 
10724                (save-excursion
10725                  (set-buffer gnus-article-buffer)
10726                  (count-lines
10727                   (min (point)
10728                        (save-excursion
10729                          (goto-char (point-min))
10730                          (search-forward "\n\n" nil t)
10731                          (point)))
10732                   (point))))
10733          gnus-newsgroup-bookmarks))
10734   (gnus-message 6 "A bookmark has been added to the current article."))
10735
10736 (defun gnus-summary-remove-bookmark (article)
10737   "Remove the bookmark from the current article."
10738   (interactive (list (gnus-summary-article-number)))
10739   (gnus-set-global-variables)
10740   ;; Remove old bookmark, if one exists.
10741   (let ((old (assq article gnus-newsgroup-bookmarks)))
10742     (if old 
10743         (progn
10744           (setq gnus-newsgroup-bookmarks 
10745                 (delq old gnus-newsgroup-bookmarks))
10746           (gnus-message 6 "Removed bookmark."))
10747       (gnus-message 6 "No bookmark in current article."))))
10748
10749 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
10750 (defun gnus-summary-mark-as-dormant (n)
10751   "Mark N articles forward as dormant.
10752 If N is negative, mark backward instead.  The difference between N and
10753 the actual number of articles marked is returned."
10754   (interactive "p")
10755   (gnus-set-global-variables)
10756   (gnus-summary-mark-forward n gnus-dormant-mark))
10757
10758 (defun gnus-summary-set-process-mark (article)
10759   "Set the process mark on ARTICLE and update the summary line."
10760   (setq gnus-newsgroup-processable 
10761         (cons article 
10762               (delq article gnus-newsgroup-processable)))
10763   (let ((buffer-read-only nil))
10764     (if (gnus-summary-goto-subject article)
10765         (progn
10766           (gnus-summary-show-thread)
10767           (gnus-summary-update-mark gnus-process-mark 'replied)
10768           t))))
10769
10770 (defun gnus-summary-remove-process-mark (article)
10771   "Remove the process mark from ARTICLE and update the summary line."
10772   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
10773   (let ((buffer-read-only nil))
10774     (if (gnus-summary-goto-subject article)
10775         (progn
10776           (gnus-summary-show-thread)
10777           (gnus-summary-update-mark ?  'replied)
10778           (if (memq article gnus-newsgroup-replied) 
10779               (gnus-summary-update-mark gnus-replied-mark 'replied))
10780           t))))
10781
10782 (defun gnus-summary-mark-forward (n &optional mark no-expire)
10783   "Mark N articles as read forwards.
10784 If N is negative, mark backwards instead.
10785 Mark with MARK.  If MARK is ? , ?! or ??, articles will be
10786 marked as unread. 
10787 The difference between N and the actual number of articles marked is
10788 returned."
10789   (interactive "p")
10790   (gnus-set-global-variables)
10791   (let ((backward (< n 0))
10792         (gnus-summary-goto-unread
10793          (and gnus-summary-goto-unread
10794               (not (memq mark (list gnus-unread-mark
10795                                     gnus-ticked-mark gnus-dormant-mark)))))
10796         (n (abs n))
10797         (mark (or mark gnus-del-mark)))
10798     (while (and (> n 0)
10799                 (gnus-summary-mark-article nil mark no-expire)
10800                 (zerop (gnus-summary-next-subject 
10801                         (if backward -1 1) gnus-summary-goto-unread t)))
10802       (setq n (1- n)))
10803     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
10804     (gnus-summary-recenter)
10805     (gnus-summary-position-point)
10806     (gnus-set-mode-line 'summary)
10807     n))
10808
10809 (defun gnus-summary-mark-article-as-read (mark)
10810   "Mark the current article quickly as read with MARK."
10811   (let ((article (gnus-summary-article-number)))
10812     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10813     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10814     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10815     (setq gnus-newsgroup-reads
10816           (cons (cons article mark) gnus-newsgroup-reads))
10817     ;; Possibly remove from cache, if that is used. 
10818     (and gnus-use-cache (gnus-cache-enter-remove-article article))
10819     (and gnus-newsgroup-auto-expire 
10820          (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
10821              (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
10822              (= mark gnus-read-mark) (= mark gnus-souped-mark))
10823          (progn
10824            (setq mark gnus-expirable-mark)
10825            (setq gnus-newsgroup-expirable 
10826                  (cons article gnus-newsgroup-expirable))))
10827     ;; Fix the mark.
10828     (gnus-summary-update-mark mark 'unread)
10829     t))
10830
10831 (defun gnus-summary-mark-article-as-unread (mark)
10832   "Mark the current article quickly as unread with MARK."
10833   (let ((article (gnus-summary-article-number)))
10834     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10835     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10836     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
10837     (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
10838     (cond ((= mark gnus-ticked-mark)
10839            (push article gnus-newsgroup-marked))
10840           ((= mark gnus-dormant-mark)
10841            (push article gnus-newsgroup-dormant))
10842           (t     
10843            (push article gnus-newsgroup-unreads)))
10844     (setq gnus-newsgroup-reads
10845           (delq (assq article gnus-newsgroup-reads)
10846                 gnus-newsgroup-reads))
10847
10848     ;; See whether the article is to be put in the cache.
10849     (and gnus-use-cache
10850          (vectorp (gnus-summary-article-header article))
10851          (save-excursion
10852            (gnus-cache-possibly-enter-article 
10853             gnus-newsgroup-name article 
10854             (gnus-summary-article-header article)
10855             (= mark gnus-ticked-mark)
10856             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
10857
10858     ;; Fix the mark.
10859     (gnus-summary-update-mark mark 'unread)
10860     t))
10861
10862 (defun gnus-summary-mark-article (&optional article mark no-expire)
10863   "Mark ARTICLE with MARK.  MARK can be any character.
10864 Four MARK strings are reserved: `? ' (unread), `?!' (ticked), 
10865 `??' (dormant) and `?E' (expirable).
10866 If MARK is nil, then the default character `?D' is used.
10867 If ARTICLE is nil, then the article on the current line will be
10868 marked." 
10869   ;; The mark might be a string.
10870   (and (stringp mark)
10871        (setq mark (aref mark 0)))
10872   ;; If no mark is given, then we check auto-expiring.
10873   (and (not no-expire)
10874        gnus-newsgroup-auto-expire 
10875        (or (not mark)
10876            (and (numberp mark) 
10877                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
10878                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
10879                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
10880        (setq mark gnus-expirable-mark))
10881   (let* ((mark (or mark gnus-del-mark))
10882          (article (or article (gnus-summary-article-number))))
10883     (or article (error "No article on current line"))
10884     (if (or (= mark gnus-unread-mark) 
10885             (= mark gnus-ticked-mark) 
10886             (= mark gnus-dormant-mark))
10887         (gnus-mark-article-as-unread article mark)
10888       (gnus-mark-article-as-read article mark))
10889
10890     ;; See whether the article is to be put in the cache.
10891     (and gnus-use-cache
10892          (not (= mark gnus-canceled-mark))
10893          (vectorp (gnus-summary-article-header article))
10894          (save-excursion
10895            (gnus-cache-possibly-enter-article 
10896             gnus-newsgroup-name article 
10897             (gnus-summary-article-header article)
10898             (= mark gnus-ticked-mark)
10899             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
10900
10901     (if (gnus-summary-goto-subject article nil t)
10902         (let ((buffer-read-only nil))
10903           (gnus-summary-show-thread)
10904           ;; Fix the mark.
10905           (gnus-summary-update-mark mark 'unread)
10906           t))))
10907
10908 (defun gnus-summary-update-mark (mark type)
10909   (beginning-of-line)
10910   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
10911         (buffer-read-only nil))
10912     (when forward
10913       ;; Go to the right position on the line.
10914       (forward-char forward)
10915       ;; Replace the old mark with the new mark.
10916       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
10917       ;; Optionally update the marks by some user rule.
10918       (when (eq type 'unread)
10919         (gnus-data-set-mark 
10920          (gnus-data-find (gnus-summary-article-number)) mark)
10921         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
10922   
10923 (defun gnus-mark-article-as-read (article &optional mark)
10924   "Enter ARTICLE in the pertinent lists and remove it from others."
10925   ;; Make the article expirable.
10926   (let ((mark (or mark gnus-del-mark)))
10927     (if (= mark gnus-expirable-mark)
10928         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
10929       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
10930     ;; Remove from unread and marked lists.
10931     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10932     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10933     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10934     (push (cons article mark) gnus-newsgroup-reads)
10935     ;; Possibly remove from cache, if that is used. 
10936     (when gnus-use-cache 
10937       (gnus-cache-enter-remove-article article))))
10938
10939 (defun gnus-mark-article-as-unread (article &optional mark)
10940   "Enter ARTICLE in the pertinent lists and remove it from others."
10941   (let ((mark (or mark gnus-ticked-mark)))
10942     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
10943     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
10944     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
10945     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
10946     (cond ((= mark gnus-ticked-mark)
10947            (push article gnus-newsgroup-marked))
10948           ((= mark gnus-dormant-mark)
10949            (push article gnus-newsgroup-dormant))
10950           (t     
10951            (push article gnus-newsgroup-unreads)))
10952     (setq gnus-newsgroup-reads
10953           (delq (assq article gnus-newsgroup-reads)
10954                 gnus-newsgroup-reads))))
10955
10956 (defalias 'gnus-summary-mark-as-unread-forward 
10957   'gnus-summary-tick-article-forward)
10958 (make-obsolete 'gnus-summary-mark-as-unread-forward 
10959                'gnus-summary-tick-article-forward)
10960 (defun gnus-summary-tick-article-forward (n)
10961   "Tick N articles forwards.
10962 If N is negative, tick backwards instead.
10963 The difference between N and the number of articles ticked is returned."
10964   (interactive "p")
10965   (gnus-summary-mark-forward n gnus-ticked-mark))
10966
10967 (defalias 'gnus-summary-mark-as-unread-backward 
10968   'gnus-summary-tick-article-backward)
10969 (make-obsolete 'gnus-summary-mark-as-unread-backward 
10970                'gnus-summary-tick-article-backward)
10971 (defun gnus-summary-tick-article-backward (n)
10972   "Tick N articles backwards.
10973 The difference between N and the number of articles ticked is returned."
10974   (interactive "p")
10975   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
10976
10977 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
10978 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
10979 (defun gnus-summary-tick-article (&optional article clear-mark)
10980   "Mark current article as unread.
10981 Optional 1st argument ARTICLE specifies article number to be marked as unread.
10982 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
10983   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
10984                                        gnus-ticked-mark)))
10985
10986 (defun gnus-summary-mark-as-read-forward (n)
10987   "Mark N articles as read forwards.
10988 If N is negative, mark backwards instead.
10989 The difference between N and the actual number of articles marked is
10990 returned."
10991   (interactive "p")
10992   (gnus-summary-mark-forward n gnus-del-mark t))
10993
10994 (defun gnus-summary-mark-as-read-backward (n)
10995   "Mark the N articles as read backwards.
10996 The difference between N and the actual number of articles marked is
10997 returned."
10998   (interactive "p")
10999   (gnus-summary-mark-forward (- n) gnus-del-mark t))
11000
11001 (defun gnus-summary-mark-as-read (&optional article mark)
11002   "Mark current article as read.
11003 ARTICLE specifies the article to be marked as read.
11004 MARK specifies a string to be inserted at the beginning of the line."
11005   (gnus-summary-mark-article article mark))
11006
11007 (defun gnus-summary-clear-mark-forward (n)
11008   "Clear marks from N articles forward.
11009 If N is negative, clear backward instead.
11010 The difference between N and the number of marks cleared is returned."
11011   (interactive "p")
11012   (gnus-summary-mark-forward n gnus-unread-mark))
11013
11014 (defun gnus-summary-clear-mark-backward (n)
11015   "Clear marks from N articles backward.
11016 The difference between N and the number of marks cleared is returned."
11017   (interactive "p")
11018   (gnus-summary-mark-forward (- n) gnus-unread-mark))
11019
11020 (defun gnus-summary-mark-unread-as-read ()
11021   "Intended to be used by `gnus-summary-mark-article-hook'."
11022   (when (memq gnus-current-article gnus-newsgroup-unreads)
11023     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
11024
11025 (defun gnus-summary-mark-region-as-read (point mark all)
11026   "Mark all unread articles between point and mark as read.
11027 If given a prefix, mark all articles between point and mark as read,
11028 even ticked and dormant ones."
11029   (interactive "r\nP")
11030   (save-excursion
11031     (let (article)
11032       (goto-char point)
11033       (beginning-of-line)
11034       (while (and 
11035               (< (point) mark)
11036               (progn
11037                 (when (or all 
11038                           (memq (setq article (gnus-summary-article-number))
11039                                 gnus-newsgroup-unreads))
11040                   (gnus-summary-mark-article article gnus-del-mark))
11041                 t)
11042               (gnus-summary-find-next))))))
11043
11044 (defun gnus-summary-mark-below (score mark)
11045   "Mark articles with score less than SCORE with MARK."
11046   (interactive "P\ncMark: ")
11047   (gnus-set-global-variables)
11048   (setq score (if score
11049                   (prefix-numeric-value score)
11050                 (or gnus-summary-default-score 0)))
11051   (save-excursion
11052     (set-buffer gnus-summary-buffer)
11053     (goto-char (point-min))
11054     (while (not (eobp))
11055       (and (< (gnus-summary-article-score) score)
11056            (gnus-summary-mark-article nil mark))
11057       (gnus-summary-find-next))))
11058
11059 (defun gnus-summary-kill-below (&optional score)
11060   "Mark articles with score below SCORE as read."
11061   (interactive "P")
11062   (gnus-set-global-variables)
11063   (gnus-summary-mark-below score gnus-killed-mark))
11064
11065 (defun gnus-summary-clear-above (&optional score)
11066   "Clear all marks from articles with score above SCORE."
11067   (interactive "P")
11068   (gnus-set-global-variables)
11069   (gnus-summary-mark-above score gnus-unread-mark))
11070
11071 (defun gnus-summary-tick-above (&optional score)
11072   "Tick all articles with score above SCORE."
11073   (interactive "P")
11074   (gnus-set-global-variables)
11075   (gnus-summary-mark-above score gnus-ticked-mark))
11076
11077 (defun gnus-summary-mark-above (score mark)
11078   "Mark articles with score over SCORE with MARK."
11079   (interactive "P\ncMark: ")
11080   (gnus-set-global-variables)
11081   (setq score (if score
11082                   (prefix-numeric-value score)
11083                 (or gnus-summary-default-score 0)))
11084   (save-excursion
11085     (set-buffer gnus-summary-buffer)
11086     (goto-char (point-min))
11087     (while (and (progn
11088                   (if (> (gnus-summary-article-score) score)
11089                       (gnus-summary-mark-article nil mark))
11090                   t)
11091                 (gnus-summary-find-next)))))
11092
11093 ;; Suggested by Daniel Quinlan <quinlan@best.com>.  
11094 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
11095 (defun gnus-summary-limit-include-expunged ()
11096   "Display all the hidden articles that were expunged for low scores."
11097   (interactive)
11098   (gnus-set-global-variables)
11099   (let ((buffer-read-only nil))
11100     (let ((scored gnus-newsgroup-scored)
11101           headers h)
11102       (while scored
11103         (or (gnus-summary-goto-subject (car (car scored)))
11104             (and (setq h (gnus-summary-article-header (car (car scored))))
11105                  (< (cdr (car scored)) gnus-summary-expunge-below)
11106                  (setq headers (cons h headers))))
11107         (setq scored (cdr scored)))
11108       (or headers (error "No expunged articles hidden."))
11109       (goto-char (point-min))
11110       (gnus-summary-prepare-unthreaded (nreverse headers)))
11111     (goto-char (point-min))
11112     (gnus-summary-position-point)))
11113
11114 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
11115   "Mark all articles not marked as unread in this newsgroup as read.
11116 If prefix argument ALL is non-nil, all articles are marked as read.
11117 If QUIETLY is non-nil, no questions will be asked.
11118 If TO-HERE is non-nil, it should be a point in the buffer.  All
11119 articles before this point will be marked as read.
11120 The number of articles marked as read is returned."
11121   (interactive "P")
11122   (gnus-set-global-variables)
11123   (prog1
11124       (if (or quietly
11125               (not gnus-interactive-catchup) ;Without confirmation?
11126               gnus-expert-user
11127               (gnus-y-or-n-p
11128                (if all
11129                    "Mark absolutely all articles as read? "
11130                  "Mark all unread articles as read? ")))
11131           (if (and not-mark 
11132                    (not gnus-newsgroup-adaptive)
11133                    (not gnus-newsgroup-auto-expire))
11134               (progn
11135                 (when all
11136                   (setq gnus-newsgroup-marked nil
11137                         gnus-newsgroup-dormant nil))
11138                 (setq gnus-newsgroup-unreads nil))
11139             ;; We actually mark all articles as canceled, which we
11140             ;; have to do when using auto-expiry or adaptive scoring. 
11141             (gnus-summary-show-all-threads)
11142             (if (gnus-summary-first-subject (not all))
11143                 (while (and 
11144                         (if to-here (< (point) to-here) t)
11145                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
11146                         (gnus-summary-find-next (not all)))))
11147             (unless to-here
11148               (setq gnus-newsgroup-unreads nil))
11149             (gnus-set-mode-line 'summary)))
11150     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
11151       (if (and (not to-here) (eq 'nnvirtual (car method)))
11152           (nnvirtual-catchup-group
11153            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
11154     (gnus-summary-position-point)))
11155
11156 (defun gnus-summary-catchup-to-here (&optional all)
11157   "Mark all unticked articles before the current one as read.
11158 If ALL is non-nil, also mark ticked and dormant articles as read."
11159   (interactive "P")
11160   (gnus-set-global-variables)
11161   (save-excursion
11162     (let ((beg (point)))
11163       ;; We check that there are unread articles.
11164       (when (or all (gnus-summary-find-prev))
11165         (gnus-summary-catchup all t beg))))
11166   (gnus-summary-position-point))
11167
11168 (defun gnus-summary-catchup-all (&optional quietly)
11169   "Mark all articles in this newsgroup as read."
11170   (interactive "P")
11171   (gnus-set-global-variables)
11172   (gnus-summary-catchup t quietly))
11173
11174 (defun gnus-summary-catchup-and-exit (&optional all quietly)
11175   "Mark all articles not marked as unread in this newsgroup as read, then exit.
11176 If prefix argument ALL is non-nil, all articles are marked as read."
11177   (interactive "P")
11178   (gnus-set-global-variables)
11179   (gnus-summary-catchup all quietly nil 'fast)
11180   ;; Select next newsgroup or exit.
11181   (if (eq gnus-auto-select-next 'quietly)
11182       (gnus-summary-next-group nil)
11183     (gnus-summary-exit)))
11184
11185 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
11186   "Mark all articles in this newsgroup as read, and then exit."
11187   (interactive "P")
11188   (gnus-set-global-variables)
11189   (gnus-summary-catchup-and-exit t quietly))
11190
11191 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
11192 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
11193   "Mark all articles in this group as read and select the next group.
11194 If given a prefix, mark all articles, unread as well as ticked, as
11195 read." 
11196   (interactive "P")
11197   (gnus-set-global-variables)
11198   (gnus-summary-catchup all)
11199   (gnus-summary-next-group))
11200
11201 ;; Thread-based commands.
11202
11203 (defun gnus-summary-articles-in-thread (&optional article)
11204   "Return a list of all articles in the current thread.
11205 If ARTICLE is non-nil, return all articles in the thread that starts
11206 with that article."
11207   (let* ((article (or article (gnus-summary-article-number)))
11208          (data (gnus-data-find-list article))
11209          (top-level (gnus-data-level (car data)))
11210          (top-subject 
11211           (cond ((null gnus-thread-operation-ignore-subject)
11212                  (gnus-simplify-subject-re
11213                   (mail-header-subject (gnus-data-header (car data)))))
11214                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
11215                  (gnus-simplify-subject-fuzzy
11216                   (mail-header-subject (gnus-data-header (car data)))))
11217                 (t nil)))
11218          articles)
11219     (if (not data)
11220         ()                              ; This article doesn't exist.
11221       (while data
11222         (and (or (not top-subject)
11223                  (string= top-subject
11224                           (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
11225                               (gnus-simplify-subject-fuzzy
11226                                (mail-header-subject 
11227                                 (gnus-data-header (car data))))
11228                             (gnus-simplify-subject-re
11229                              (mail-header-subject 
11230                               (gnus-data-header (car data)))))))
11231              (setq articles (cons (gnus-data-number (car data)) articles)))
11232         (if (and (setq data (cdr data))
11233                  (> (gnus-data-level (car data)) top-level))
11234             ()
11235           (setq data nil)))
11236       ;; Return the list of articles.
11237       (nreverse articles))))
11238
11239 (defun gnus-summary-toggle-threads (&optional arg)
11240   "Toggle showing conversation threads.
11241 If ARG is positive number, turn showing conversation threads on."
11242   (interactive "P")
11243   (gnus-set-global-variables)
11244   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
11245     (setq gnus-show-threads
11246           (if (null arg) (not gnus-show-threads)
11247             (> (prefix-numeric-value arg) 0)))
11248     (gnus-summary-prepare)
11249     (gnus-summary-goto-subject current)
11250     (gnus-summary-position-point)))
11251
11252 (defun gnus-summary-show-all-threads ()
11253   "Show all threads."
11254   (interactive)
11255   (gnus-set-global-variables)
11256   (save-excursion
11257     (let ((buffer-read-only nil))
11258       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
11259   (gnus-summary-position-point))
11260
11261 (defun gnus-summary-show-thread ()
11262   "Show thread subtrees.
11263 Returns nil if no thread was there to be shown."
11264   (interactive)
11265   (gnus-set-global-variables)
11266   (let ((buffer-read-only nil)
11267         (orig (point))
11268         ;; first goto end then to beg, to have point at beg after let
11269         (end (progn (end-of-line) (point)))
11270         (beg (progn (beginning-of-line) (point))))
11271     (prog1
11272         ;; Any hidden lines here?
11273         (search-forward "\r" end t)
11274       (subst-char-in-region beg end ?\^M ?\n t)
11275       (goto-char orig)
11276       (gnus-summary-position-point))))
11277
11278 (defun gnus-summary-hide-all-threads ()
11279   "Hide all thread subtrees."
11280   (interactive)
11281   (gnus-set-global-variables)
11282   (save-excursion
11283     (goto-char (point-min))
11284     (gnus-summary-hide-thread)
11285     (while (zerop (gnus-summary-next-thread 1 t))
11286       (gnus-summary-hide-thread)))
11287   (gnus-summary-position-point))
11288
11289 (defun gnus-summary-hide-thread ()
11290   "Hide thread subtrees.
11291 Returns nil if no threads were there to be hidden."
11292   (interactive)
11293   (gnus-set-global-variables)
11294   (let ((buffer-read-only nil)
11295         (start (point))
11296         (article (gnus-summary-article-number))
11297         end)
11298     ;; Go forward until either the buffer ends or the subthread
11299     ;; ends. 
11300     (when (and (not (eobp))
11301                (or (and (zerop (gnus-summary-next-thread 1 t))
11302                         (gnus-summary-find-prev))
11303                    (goto-char (gnus-data-pos (car (gnus-data-list 'rev))))))
11304       (setq end (point))
11305       (prog1
11306           (if (and (> (point) start)
11307                    (search-backward "\n" start t))
11308               (progn
11309                 (subst-char-in-region start end ?\n ?\^M)
11310                 (gnus-summary-goto-subject article))
11311             (goto-char start)
11312             nil)
11313         (gnus-summary-position-point)))))
11314
11315 (defun gnus-summary-go-to-next-thread (&optional previous)
11316   "Go to the same level (or less) next thread.
11317 If PREVIOUS is non-nil, go to previous thread instead.
11318 Return the article number moved to, or nil if moving was impossible."
11319   (let* ((level (gnus-summary-thread-level))
11320          (article (gnus-summary-article-number))
11321          (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
11322          oart)
11323     (while data
11324       (if (<= (gnus-data-level (car data)) level)
11325           (setq oart (gnus-data-number (car data))
11326                 data nil)
11327         (setq data (cdr data))))
11328     (and oart 
11329          (gnus-summary-goto-subject oart))))
11330
11331 (defun gnus-summary-next-thread (n &optional silent)
11332   "Go to the same level next N'th thread.
11333 If N is negative, search backward instead.
11334 Returns the difference between N and the number of skips actually
11335 done.
11336
11337 If SILENT, don't output messages."
11338   (interactive "p")
11339   (gnus-set-global-variables)
11340   (let ((backward (< n 0))
11341         (n (abs n)))
11342     (while (and (> n 0)
11343                 (gnus-summary-go-to-next-thread backward))
11344       (decf n))
11345     (gnus-summary-position-point)
11346     (when (and (not silent) (/= 0 n))
11347       (gnus-message 7 "No more threads"))
11348     n))
11349
11350 (defun gnus-summary-prev-thread (n)
11351   "Go to the same level previous N'th thread.
11352 Returns the difference between N and the number of skips actually
11353 done."
11354   (interactive "p")
11355   (gnus-set-global-variables)
11356   (gnus-summary-next-thread (- n)))
11357
11358 (defun gnus-summary-go-down-thread ()
11359   "Go down one level in the current thread."
11360   (let ((children (gnus-summary-article-children)))
11361     (and children
11362          (gnus-summary-goto-subject (car children)))))
11363
11364 (defun gnus-summary-go-up-thread ()
11365   "Go up one level in the current thread."
11366   (let ((parent (gnus-summary-article-parent)))
11367     (and parent
11368          (gnus-summary-goto-subject parent))))
11369
11370 (defun gnus-summary-down-thread (n)
11371   "Go down thread N steps.
11372 If N is negative, go up instead.
11373 Returns the difference between N and how many steps down that were
11374 taken."
11375   (interactive "p")
11376   (gnus-set-global-variables)
11377   (let ((up (< n 0))
11378         (n (abs n)))
11379     (while (and (> n 0)
11380                 (if up (gnus-summary-go-up-thread)
11381                   (gnus-summary-go-down-thread)))
11382       (setq n (1- n)))
11383     (gnus-summary-position-point)
11384     (if (/= 0 n) (gnus-message 7 "Can't go further"))
11385     n))
11386
11387 (defun gnus-summary-up-thread (n)
11388   "Go up thread N steps.
11389 If N is negative, go up instead.
11390 Returns the difference between N and how many steps down that were
11391 taken."
11392   (interactive "p")
11393   (gnus-set-global-variables)
11394   (gnus-summary-down-thread (- n)))
11395
11396 (defun gnus-summary-kill-thread (&optional unmark)
11397   "Mark articles under current thread as read.
11398 If the prefix argument is positive, remove any kinds of marks.
11399 If the prefix argument is negative, tick articles instead."
11400   (interactive "P")
11401   (gnus-set-global-variables)
11402   (if unmark
11403       (setq unmark (prefix-numeric-value unmark)))
11404   (let ((articles (gnus-summary-articles-in-thread)))
11405     (save-excursion
11406       ;; Expand the thread.
11407       (gnus-summary-show-thread)
11408       ;; Mark all the articles.
11409       (while articles
11410         (gnus-summary-goto-subject (car articles))
11411         (cond ((null unmark) 
11412                (gnus-summary-mark-article-as-read gnus-killed-mark))
11413               ((> unmark 0) 
11414                (gnus-summary-mark-article-as-unread gnus-unread-mark))
11415               (t 
11416                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
11417         (setq articles (cdr articles))))
11418     ;; Hide killed subtrees.
11419     (and (null unmark)
11420          gnus-thread-hide-killed
11421          (gnus-summary-hide-thread))
11422     ;; If marked as read, go to next unread subject.
11423     (if (null unmark)
11424         ;; Go to next unread subject.
11425         (gnus-summary-next-subject 1 t)))
11426   (gnus-set-mode-line 'summary))
11427
11428 ;; Summary sorting commands
11429
11430 (defun gnus-summary-sort-by-number (&optional reverse)
11431   "Sort summary buffer by article number.
11432 Argument REVERSE means reverse order."
11433   (interactive "P")
11434   (gnus-set-global-variables)
11435   (gnus-summary-sort 
11436    ;; `gnus-summary-article-number' is a macro, and `sort-subr' wants
11437    ;; a function, so we wrap it.
11438    (cons (lambda () (gnus-summary-article-number))
11439          'gnus-thread-sort-by-number) reverse))
11440
11441 (defun gnus-summary-sort-by-author (&optional reverse)
11442   "Sort summary buffer by author name alphabetically.
11443 If case-fold-search is non-nil, case of letters is ignored.
11444 Argument REVERSE means reverse order."
11445   (interactive "P")
11446   (gnus-set-global-variables)
11447   (gnus-summary-sort
11448    (cons
11449     (lambda ()
11450       (let* ((header (gnus-summary-article-header))
11451              extract)
11452         (if (not (vectorp header))
11453             ""
11454           (setq extract (funcall gnus-extract-address-components
11455                          (mail-header-from header)))
11456           (concat (or (car extract) (cdr extract))
11457                   "\r" (mail-header-subject header)))))
11458     'gnus-thread-sort-by-author)
11459    reverse))
11460
11461 (defun gnus-summary-sort-by-subject (&optional reverse)
11462   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
11463 If case-fold-search is non-nil, case of letters is ignored.
11464 Argument REVERSE means reverse order."
11465   (interactive "P")
11466   (gnus-set-global-variables)
11467   (gnus-summary-sort
11468    (cons
11469     (lambda ()
11470       (let* ((header (gnus-summary-article-header))
11471              extract)
11472         (if (not (vectorp header))
11473             ""
11474           (setq extract (funcall gnus-extract-address-components
11475                                  (mail-header-from header)))
11476           (concat 
11477            (downcase (gnus-simplify-subject (gnus-summary-article-subject) t))
11478            "\r" (or (car extract) (cdr extract))))))
11479     'gnus-thread-sort-by-subject)
11480    reverse))
11481
11482 (defun gnus-summary-sort-by-date (&optional reverse)
11483   "Sort summary buffer by date.
11484 Argument REVERSE means reverse order."
11485   (interactive "P")
11486   (gnus-set-global-variables)
11487   (gnus-summary-sort
11488    (cons
11489     (lambda ()
11490       (gnus-sortable-date
11491        (mail-header-date 
11492         (gnus-summary-article-header))))
11493     'gnus-thread-sort-by-date)
11494    reverse))
11495
11496 (defun gnus-summary-sort-by-score (&optional reverse)
11497   "Sort summary buffer by score.
11498 Argument REVERSE means reverse order."
11499   (interactive "P")
11500   (gnus-set-global-variables)
11501   (gnus-summary-sort 
11502    (cons (lambda () (gnus-summary-article-score))
11503          'gnus-thread-sort-by-score)
11504    (not reverse)))
11505
11506 (defun gnus-summary-sort (predicate reverse)
11507   "Sort summary buffer by PREDICATE.  REVERSE means reverse order. 
11508 PREDICATE is a cons of `(unthreaded-func . threaded-func)'."
11509   (let (buffer-read-only)
11510     (if (not gnus-show-threads)
11511         ;; We do untreaded sorting...
11512         (progn
11513           (goto-char (point-min))
11514           (sort-subr reverse 'forward-line 'end-of-line (car predicate))
11515           (gnus-data-compute-positions))
11516       ;; ... or we do threaded sorting.
11517       (let ((gnus-thread-sort-functions (list (cdr predicate)))
11518             (gnus-summary-prepare-hook nil))
11519         ;; We do that by simply regenerating the threads.
11520         (gnus-summary-prepare)
11521         ;; Hide subthreads if needed.
11522         (when gnus-thread-hide-subtree
11523           (gnus-summary-hide-all-threads))))
11524     ;; If in async mode, we send some info to the backend.
11525     (when gnus-newsgroup-async
11526       (gnus-request-asynchronous 
11527        gnus-newsgroup-name gnus-newsgroup-data))))
11528   
11529 (defun gnus-sortable-date (date)
11530   "Make sortable string by string-lessp from DATE.
11531 Timezone package is used."
11532   (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
11533          (year (aref date 0))
11534          (month (aref date 1))
11535          (day (aref date 2)))
11536     (timezone-make-sortable-date 
11537      year month day 
11538      (timezone-make-time-string
11539       (aref date 3) (aref date 4) (aref date 5)))))
11540
11541
11542 ;; Summary saving commands.
11543
11544 (defun gnus-summary-save-article (&optional n)
11545   "Save the current article using the default saver function.
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 The variable `gnus-default-article-saver' specifies the saver function."
11551   (interactive "P")
11552   (gnus-set-global-variables)
11553   (let ((articles (gnus-summary-work-articles n))
11554         file)
11555     (while articles
11556       (let ((header (gnus-summary-article-header (car articles))))
11557         (if (vectorp header)
11558             (progn
11559               (save-window-excursion
11560                 (gnus-summary-select-article t nil nil (car articles)))
11561               (or gnus-save-all-headers
11562                   ;; Remove headers accoring to `gnus-saved-headers'.
11563                   (let ((gnus-visible-headers 
11564                          (or gnus-saved-headers gnus-visible-headers)))
11565                     (gnus-article-hide-headers t)))
11566               ;; Remove any X-Gnus lines.
11567               (save-excursion
11568                 (save-restriction
11569                   (set-buffer gnus-article-buffer)
11570                   (let ((buffer-read-only nil))
11571                     (goto-char (point-min))
11572                     (narrow-to-region (point) (or (search-forward "\n\n" nil t)
11573                                                   (point-max)))
11574                     (while (re-search-forward "^X-Gnus" nil t)
11575                       (beginning-of-line)
11576                       (delete-region (point)
11577                                      (progn (forward-line 1) (point))))
11578                     (widen))))
11579               (save-window-excursion
11580                 (if gnus-default-article-saver
11581                     (setq file (funcall
11582                                 gnus-default-article-saver
11583                                 (cond
11584                                  ((not gnus-prompt-before-saving)
11585                                   'default)
11586                                  ((eq gnus-prompt-before-saving 'always)
11587                                   nil)
11588                                  (t file))))
11589                   (error "No default saver is defined."))))
11590           (if (assq 'name header)
11591               (gnus-copy-file (cdr (assq 'name header)))
11592             (gnus-message 1 "Article %d is unsaveable" (car articles)))))
11593       (gnus-summary-remove-process-mark (car articles))
11594       (setq articles (cdr articles)))
11595     (gnus-summary-position-point)
11596     n))
11597
11598 (defun gnus-summary-pipe-output (&optional arg)
11599   "Pipe the current article to a subprocess.
11600 If N is a positive number, pipe the N next articles.
11601 If N is a negative number, pipe the N previous articles.
11602 If N is nil and any articles have been marked with the process mark,
11603 pipe those articles instead."
11604   (interactive "P")
11605   (gnus-set-global-variables)
11606   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
11607     (gnus-summary-save-article arg))
11608   (gnus-configure-windows 'pipe))
11609
11610 (defun gnus-summary-save-article-mail (&optional arg)
11611   "Append the current article to an mail file.
11612 If N is a positive number, save the N next articles.
11613 If N is a negative number, save the N previous articles.
11614 If N is nil and any articles have been marked with the process mark,
11615 save those articles instead."
11616   (interactive "P")
11617   (gnus-set-global-variables)
11618   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
11619     (gnus-summary-save-article arg)))
11620
11621 (defun gnus-summary-save-article-rmail (&optional arg)
11622   "Append the current article to an rmail file.
11623 If N is a positive number, save the N next articles.
11624 If N is a negative number, save the N previous articles.
11625 If N is nil and any articles have been marked with the process mark,
11626 save those articles instead."
11627   (interactive "P")
11628   (gnus-set-global-variables)
11629   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
11630     (gnus-summary-save-article arg)))
11631
11632 (defun gnus-summary-save-article-file (&optional arg)
11633   "Append the current article to a file.
11634 If N is a positive number, save the N next articles.
11635 If N is a negative number, save the N previous articles.
11636 If N is nil and any articles have been marked with the process mark,
11637 save those articles instead."
11638   (interactive "P")
11639   (gnus-set-global-variables)
11640   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
11641     (gnus-summary-save-article arg)))
11642
11643 (defun gnus-summary-save-article-body-file (&optional arg)
11644   "Append the current article body to a file.
11645 If N is a positive number, save the N next articles.
11646 If N is a negative number, save the N previous articles.
11647 If N is nil and any articles have been marked with the process mark,
11648 save those articles instead."
11649   (interactive "P")
11650   (gnus-set-global-variables)
11651   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
11652     (gnus-summary-save-article arg)))
11653
11654 (defun gnus-read-save-file-name (prompt default-name)
11655   (let ((methods gnus-split-methods)
11656         split-name method)
11657     ;; Let the split methods have their say.
11658     (when gnus-split-methods
11659       (save-excursion
11660         (set-buffer gnus-original-article-buffer)
11661         (gnus-narrow-to-headers)
11662         (while methods
11663           (goto-char (point-min))
11664           (setq method (pop methods))
11665           (when (cond ((stringp (car method))
11666                        (condition-case () 
11667                            (re-search-forward (car method) nil t)
11668                          (error nil)))
11669                       ((gnus-functionp (car method))
11670                        (funcall (car method)))
11671                       ((consp (car method))
11672                        (eval (car method))))
11673             (setq split-name (cons (nth 1 methods) split-name))))
11674         (widen)))
11675     (cond
11676      ;; No split name was found
11677      ((null split-name)
11678       (read-file-name
11679        (concat prompt " (default " (file-name-nondirectory default-name) ") ")
11680        (file-name-directory default-name)
11681        default-name))
11682      ;; A single split name was found
11683      ((= 1 (length split-name))
11684       (read-file-name
11685        (concat prompt " (default " (car split-name) ") ")
11686        gnus-article-save-directory
11687        (concat gnus-article-save-directory (car split-name))))
11688      ;; A list of splits was found.
11689      (t
11690       (setq split-name (mapcar (lambda (el) (list el)) (nreverse split-name)))
11691       (let ((result (completing-read (concat prompt " ") split-name nil nil)))
11692         (concat gnus-article-save-directory
11693                 (if (string= result "")
11694                     (car (car split-name))
11695                   result)))))))
11696
11697 (defun gnus-summary-save-in-rmail (&optional filename)
11698   "Append this article to Rmail file.
11699 Optional argument FILENAME specifies file name.
11700 Directory to save to is default to `gnus-article-save-directory' which
11701 is initialized from the SAVEDIR environment variable."
11702   (interactive)
11703   (gnus-set-global-variables)
11704   (let ((default-name
11705           (funcall gnus-rmail-save-name gnus-newsgroup-name
11706                    gnus-current-headers gnus-newsgroup-last-rmail)))
11707     (setq filename
11708           (cond ((eq filename 'default)
11709                  default-name)
11710                 (filename filename)
11711                 (t (gnus-read-save-file-name 
11712                     "Save in rmail file:" default-name))))
11713     (gnus-make-directory (file-name-directory filename))
11714     (gnus-eval-in-buffer-window 
11715      gnus-original-article-buffer
11716      (save-excursion
11717        (save-restriction
11718          (widen)
11719          (gnus-output-to-rmail filename))))
11720     ;; Remember the directory name to save articles
11721     (setq gnus-newsgroup-last-rmail filename)))
11722
11723 (defun gnus-summary-save-in-mail (&optional filename)
11724   "Append this article to Unix mail file.
11725 Optional argument FILENAME specifies file name.
11726 Directory to save to is default to `gnus-article-save-directory' which
11727 is initialized from the SAVEDIR environment variable."
11728   (interactive)
11729   (gnus-set-global-variables)
11730   (let ((default-name
11731           (funcall gnus-mail-save-name gnus-newsgroup-name
11732                    gnus-current-headers gnus-newsgroup-last-mail)))
11733     (setq filename
11734           (cond ((eq filename 'default)
11735                  default-name)
11736                 (filename filename)
11737                 (t (gnus-read-save-file-name 
11738                     "Save in Unix mail file:" default-name))))
11739     (setq filename
11740           (expand-file-name filename
11741                             (and default-name
11742                                  (file-name-directory default-name))))
11743     (gnus-make-directory (file-name-directory filename))
11744     (gnus-eval-in-buffer-window 
11745      gnus-original-article-buffer
11746      (save-excursion
11747        (save-restriction
11748          (widen)
11749          (if (and (file-readable-p filename) (mail-file-babyl-p filename))
11750              (gnus-output-to-rmail filename)
11751            (let ((mail-use-rfc822 t))
11752              (rmail-output filename 1 t t))))))
11753     ;; Remember the directory name to save articles.
11754     (setq gnus-newsgroup-last-mail filename)))
11755
11756 (defun gnus-summary-save-in-file (&optional filename)
11757   "Append this article to file.
11758 Optional argument FILENAME specifies file name.
11759 Directory to save to is default to `gnus-article-save-directory' which
11760 is initialized from the SAVEDIR environment variable."
11761   (interactive)
11762   (gnus-set-global-variables)
11763   (let ((default-name
11764           (funcall gnus-file-save-name gnus-newsgroup-name
11765                    gnus-current-headers gnus-newsgroup-last-file)))
11766     (setq filename
11767           (cond ((eq filename 'default)
11768                  default-name)
11769                 (filename filename)
11770                 (t (gnus-read-save-file-name 
11771                     "Save in file:" default-name))))
11772     (gnus-make-directory (file-name-directory filename))
11773     (gnus-eval-in-buffer-window 
11774      gnus-article-buffer
11775      (save-excursion
11776        (save-restriction
11777          (widen)
11778          (gnus-output-to-file filename))))
11779     ;; Remember the directory name to save articles.
11780     (setq gnus-newsgroup-last-file filename)))
11781
11782 (defun gnus-summary-save-body-in-file (&optional filename)
11783   "Append this article body to a file.
11784 Optional argument FILENAME specifies file name.
11785 The directory to save in defaults to `gnus-article-save-directory' which
11786 is initialized from the SAVEDIR environment variable."
11787   (interactive)
11788   (gnus-set-global-variables)
11789   (let ((default-name
11790           (funcall gnus-file-save-name gnus-newsgroup-name
11791                    gnus-current-headers gnus-newsgroup-last-file)))
11792     (setq filename
11793           (cond ((eq filename 'default)
11794                  default-name)
11795                 (filename filename)
11796                 (t (gnus-read-save-file-name 
11797                     "Save body in file:" default-name))))
11798     (gnus-make-directory (file-name-directory filename))
11799     (gnus-eval-in-buffer-window 
11800      gnus-article-buffer
11801      (save-excursion
11802        (save-restriction
11803          (widen)
11804          (goto-char (point-min))
11805          (and (search-forward "\n\n" nil t)
11806               (narrow-to-region (point) (point-max)))
11807          (gnus-output-to-file filename))))
11808     ;; Remember the directory name to save articles.
11809     (setq gnus-newsgroup-last-file filename)))
11810
11811 (defun gnus-summary-save-in-pipe (&optional command)
11812   "Pipe this article to subprocess."
11813   (interactive)
11814   (gnus-set-global-variables)
11815   (setq command
11816         (cond ((eq command 'default)
11817                gnus-last-shell-command)
11818               (command command)
11819               (t (read-string "Shell command on article: "
11820                               gnus-last-shell-command))))
11821   (if (string-equal command "")
11822       (setq command gnus-last-shell-command))
11823   (gnus-eval-in-buffer-window 
11824    gnus-article-buffer
11825    (save-restriction
11826      (widen)
11827      (shell-command-on-region (point-min) (point-max) command nil)))
11828   (setq gnus-last-shell-command command))
11829
11830 ;; Summary extract commands
11831
11832 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
11833   (let ((buffer-read-only nil)
11834         (article (gnus-summary-article-number))
11835         after-article b e)
11836     (or (gnus-summary-goto-subject article)
11837         (error (format "No such article: %d" article)))
11838     (gnus-summary-position-point)
11839     ;; If all commands are to be bunched up on one line, we collect
11840     ;; them here.  
11841     (if gnus-view-pseudos-separately
11842         ()
11843       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
11844             files action)
11845         (while ps
11846           (setq action (cdr (assq 'action (car ps))))
11847           (setq files (list (cdr (assq 'name (car ps)))))
11848           (while (and ps (cdr ps)
11849                       (string= (or action "1")
11850                                (or (cdr (assq 'action (car (cdr ps)))) "2")))
11851             (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
11852             (setcdr ps (cdr (cdr ps))))
11853           (if (not files)
11854               ()
11855             (if (not (string-match "%s" action))
11856                 (setq files (cons " " files)))
11857             (setq files (cons " " files))
11858             (and (assq 'execute (car ps))
11859                  (setcdr (assq 'execute (car ps))
11860                          (funcall (if (string-match "%s" action)
11861                                       'format 'concat)
11862                                   action 
11863                                   (mapconcat (lambda (f) f) files " ")))))
11864           (setq ps (cdr ps)))))
11865     (if (and gnus-view-pseudos (not not-view))
11866         (while pslist
11867           (and (assq 'execute (car pslist))
11868                (gnus-execute-command (cdr (assq 'execute (car pslist)))
11869                                      (eq gnus-view-pseudos 'not-confirm)))
11870           (setq pslist (cdr pslist)))
11871       (save-excursion
11872         (while pslist
11873           (setq after-article (or (cdr (assq 'article (car pslist)))
11874                                   (gnus-summary-article-number)))
11875           (gnus-summary-goto-subject after-article)
11876           (forward-line 1)
11877           (setq b (point))
11878           (insert "          " (file-name-nondirectory
11879                                 (cdr (assq 'name (car pslist))))
11880                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
11881           (setq e (point))
11882           (forward-line -1)             ; back to `b'
11883           (put-text-property b e 'gnus-number gnus-reffed-article-number)
11884           (gnus-data-enter after-article
11885                            gnus-reffed-article-number
11886                            gnus-unread-mark 
11887                            b
11888                            (car pslist) 
11889                            0 
11890                            (- e b))
11891           (setq gnus-newsgroup-unreads
11892                 (cons gnus-reffed-article-number gnus-newsgroup-unreads))
11893           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
11894           (setq pslist (cdr pslist)))))))
11895
11896 (defun gnus-pseudos< (p1 p2)
11897   (let ((c1 (cdr (assq 'action p1)))
11898         (c2 (cdr (assq 'action p2))))
11899     (and c1 c2 (string< c1 c2))))
11900
11901 (defun gnus-request-pseudo-article (props)
11902   (cond ((assq 'execute props)
11903          (gnus-execute-command (cdr (assq 'execute props)))))
11904   (let ((gnus-current-article (gnus-summary-article-number)))
11905     (run-hooks 'gnus-mark-article-hook)))
11906
11907 (defun gnus-execute-command (command &optional automatic)
11908   (save-excursion
11909     (gnus-article-setup-buffer)
11910     (set-buffer gnus-article-buffer)
11911     (let ((command (if automatic command (read-string "Command: " command)))
11912           (buffer-read-only nil))
11913       (erase-buffer)
11914       (insert "$ " command "\n\n")
11915       (if gnus-view-pseudo-asynchronously
11916           (start-process "gnus-execute" nil "sh" "-c" command)
11917         (call-process "sh" nil t nil "-c" command)))))
11918
11919 (defun gnus-copy-file (file &optional to)
11920   "Copy FILE to TO."
11921   (interactive
11922    (list (read-file-name "Copy file: " default-directory)
11923          (read-file-name "Copy file to: " default-directory)))
11924   (gnus-set-global-variables)
11925   (or to (setq to (read-file-name "Copy file to: " default-directory)))
11926   (and (file-directory-p to) 
11927        (setq to (concat (file-name-as-directory to)
11928                         (file-name-nondirectory file))))
11929   (copy-file file to))
11930
11931 ;; Summary kill commands.
11932
11933 (defun gnus-summary-edit-global-kill (article)
11934   "Edit the \"global\" kill file."
11935   (interactive (list (gnus-summary-article-number)))
11936   (gnus-set-global-variables)
11937   (gnus-group-edit-global-kill article))
11938
11939 (defun gnus-summary-edit-local-kill ()
11940   "Edit a local kill file applied to the current newsgroup."
11941   (interactive)
11942   (gnus-set-global-variables)
11943   (setq gnus-current-headers (gnus-summary-article-header))
11944   (gnus-set-global-variables)
11945   (gnus-group-edit-local-kill 
11946    (gnus-summary-article-number) gnus-newsgroup-name))
11947
11948 \f
11949 ;;;
11950 ;;; Gnus article mode
11951 ;;;
11952
11953 (put 'gnus-article-mode 'mode-class 'special)
11954
11955 (if gnus-article-mode-map
11956     nil
11957   (setq gnus-article-mode-map (make-keymap))
11958   (suppress-keymap gnus-article-mode-map)
11959   (define-key gnus-article-mode-map " " 'gnus-article-next-page)
11960   (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
11961   (define-key gnus-article-mode-map "\C-c^" 'gnus-article-refer-article)
11962   (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
11963   (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
11964   (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail)
11965   (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
11966   (define-key gnus-article-mode-map gnus-mouse-2 'gnus-article-push-button)
11967   (define-key gnus-article-mode-map "\r" 'gnus-article-press-button)
11968   (define-key gnus-article-mode-map "\t" 'gnus-article-next-button)
11969   (define-key gnus-article-mode-map "\C-c\C-b" 'gnus-bug)
11970   
11971   ;; Duplicate almost all summary keystrokes in the article mode map.
11972   (let ((commands 
11973          (list 
11974           "p" "N" "P" "\M-\C-n" "\M-\C-p"
11975           "\M-n" "\M-p" "." "," "\M-s" "\M-r" "<" ">" "j"
11976           "u" "!" "U" "d" "D" "E" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k"
11977           "\M-\C-l" "e" "#" "\M-#" "\M-\C-t" "\M-\C-s" "\M-\C-h"
11978           "\M-\C-f" "\M-\C-b" "\M-\C-u" "\M-\C-d" "&" "\C-w"
11979           "\C-t" "?" "\C-c\M-\C-s" "\C-c\C-s\C-n" "\C-c\C-s\C-a"
11980           "\C-c\C-s\C-s" "\C-c\C-s\C-d" "\C-c\C-s\C-i" "\C-x\C-s"
11981           "\M-g" "w" "\C-c\C-r" "\M-t" "C"
11982           "o" "\C-o" "|" "\M-k" "\M-K" "V" "\C-c\C-d"
11983           "\C-c\C-i" "x" "X" "t" "g" "?" "l"
11984           "\C-c\C-v\C-v" "\C-d" "v" 
11985 ;;        "Mt" "M!" "Md" "Mr"
11986 ;;        "Mc" "M " "Me" "Mx" "M?" "Mb" "MB" "M#" "M\M-#" "M\M-r"
11987 ;;        "M\M-\C-r" "MD" "M\M-D" "MS" "MC" "MH" "M\C-c" "Mk" "MK"
11988 ;;        "Ms" "Mc" "Mu" "Mm" "Mk" "Gn" "Gp" "GN" "GP" "G\C-n" "G\C-p"
11989 ;;        "G\M-n" "G\M-p" "Gf" "Gb" "Gg" "Gl" "Gp" "Tk" "Tl" "Ti" "TT"
11990 ;;        "Ts" "TS" "Th" "TH" "Tn" "Tp" "Tu" "Td" "T#" "A " "An" "A\177" "Ap"
11991 ;;        "A\r" "A<" "A>" "Ab" "Ae" "A^" "Ar" "Aw" "Ac" "Ag" "At" "Am"
11992 ;;        "As" "Wh" "Ws" "Wc" "Wo" "Ww" "Wd" "Wq" "Wf" "Wt" "W\C-t"
11993 ;;        "WT" "WA" "Wa" "WH" "WC" "WS" "Wb" "Hv" "Hf" "Hd" "Hh" "Hi"
11994 ;;        "Be" "B\177" "Bm" "Br" "Bw" "Bc" "Bq" "Bi" "Oo" "Om" "Or"
11995 ;;        "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve"
11996 ;;        "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi"
11997           )))
11998     (while commands
11999       (define-key gnus-article-mode-map (car commands) 
12000         'gnus-article-summary-command)
12001       (setq commands (cdr commands))))
12002
12003   (let ((commands (list "q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
12004 ;;                      "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" 
12005                          "=" "n"  "^" "\M-^")))
12006     (while commands
12007       (define-key gnus-article-mode-map (car commands) 
12008         'gnus-article-summary-command-nosave)
12009       (setq commands (cdr commands)))))
12010
12011
12012 (defun gnus-article-mode ()
12013   "Major mode for displaying an article.
12014
12015 All normal editing commands are switched off.
12016
12017 The following commands are available:
12018
12019 \\<gnus-article-mode-map>
12020 \\[gnus-article-next-page]\t Scroll the article one page forwards
12021 \\[gnus-article-prev-page]\t Scroll the article one page backwards
12022 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
12023 \\[gnus-article-show-summary]\t Display the summary buffer
12024 \\[gnus-article-mail]\t Send a reply to the address near point
12025 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
12026 \\[gnus-info-find-node]\t Go to the Gnus info node"
12027   (interactive)
12028   (when (and menu-bar-mode
12029              (gnus-visual-p 'article-menu 'menu))
12030     (gnus-article-make-menu-bar))
12031   (kill-all-local-variables)
12032   (gnus-simplify-mode-line)
12033   (setq mode-name "Article")
12034   (setq major-mode 'gnus-article-mode)
12035   (make-local-variable 'minor-mode-alist)
12036   (or (assq 'gnus-show-mime minor-mode-alist)
12037       (setq minor-mode-alist
12038             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
12039   (use-local-map gnus-article-mode-map)
12040   (make-local-variable 'page-delimiter)
12041   (setq page-delimiter gnus-page-delimiter)
12042   (buffer-disable-undo (current-buffer))
12043   (setq buffer-read-only t)             ;Disable modification
12044   (run-hooks 'gnus-article-mode-hook))
12045
12046 (defun gnus-article-setup-buffer ()
12047   "Initialize article mode buffer."
12048   ;; Returns the article buffer.
12049   (if (get-buffer gnus-article-buffer)
12050       (save-excursion
12051         (set-buffer gnus-article-buffer)
12052         (buffer-disable-undo (current-buffer))
12053         (setq buffer-read-only t)
12054         (gnus-add-current-to-buffer-list)
12055         (or (eq major-mode 'gnus-article-mode)
12056             (gnus-article-mode))
12057         (current-buffer))
12058     (save-excursion
12059       (set-buffer (get-buffer-create gnus-article-buffer))
12060       (gnus-add-current-to-buffer-list)
12061       (gnus-article-mode)
12062       (current-buffer))))
12063
12064 ;; Set article window start at LINE, where LINE is the number of lines
12065 ;; from the head of the article.
12066 (defun gnus-article-set-window-start (&optional line)
12067   (set-window-start 
12068    (get-buffer-window gnus-article-buffer)
12069    (save-excursion
12070      (set-buffer gnus-article-buffer)
12071      (goto-char (point-min))
12072      (if (not line)
12073          (point-min)
12074        (gnus-message 6 "Moved to bookmark")
12075        (search-forward "\n\n" nil t)
12076        (forward-line line)
12077        (point)))))
12078
12079 (defun gnus-kill-all-overlays ()
12080   "Delete all overlays in the current buffer."
12081   (when (fboundp 'overlay-lists)
12082     (let* ((overlayss (overlay-lists))
12083            (buffer-read-only nil)
12084            (overlays (nconc (car overlayss) (cdr overlayss))))
12085       (while overlays
12086         (delete-overlay (pop overlays))))))
12087
12088 (defun gnus-request-article-this-buffer (article group)
12089   "Get an article and insert it into this buffer."
12090   (prog1
12091       (save-excursion
12092         (if (get-buffer gnus-original-article-buffer)
12093             (set-buffer (get-buffer gnus-original-article-buffer))
12094           (set-buffer (get-buffer-create gnus-original-article-buffer))
12095           (buffer-disable-undo (current-buffer))
12096           (setq major-mode 'gnus-original-article-mode)
12097           (setq buffer-read-only t)
12098           (gnus-add-current-to-buffer-list))
12099
12100         (setq group (or group gnus-newsgroup-name))
12101
12102         ;; Open server if it has closed.
12103         (gnus-check-server (gnus-find-method-for-group group))
12104
12105         ;; Using `gnus-request-article' directly will insert the article into
12106         ;; `nntp-server-buffer' - so we'll save some time by not having to
12107         ;; copy it from the server buffer into the article buffer.
12108
12109         ;; We only request an article by message-id when we do not have the
12110         ;; headers for it, so we'll have to get those.
12111         (and (stringp article) 
12112              (let ((gnus-override-method gnus-refer-article-method))
12113                (gnus-read-header article)))
12114
12115         ;; If the article number is negative, that means that this article
12116         ;; doesn't belong in this newsgroup (possibly), so we find its
12117         ;; message-id and request it by id instead of number.
12118         (if (not (numberp article))
12119             ()
12120           (save-excursion
12121             (set-buffer gnus-summary-buffer)
12122             (let ((header (gnus-summary-article-header article)))
12123               (if (< article 0)
12124                   (if (vectorp header)
12125                       ;; It's a real article.
12126                       (setq article (mail-header-id header))
12127                     ;; It is an extracted pseudo-article.
12128                     (setq article 'pseudo)
12129                     (gnus-request-pseudo-article header)))
12130
12131               (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
12132                 (if (not (eq (car method) 'nneething))
12133                     ()
12134                   (let ((dir (concat (file-name-as-directory (nth 1 method))
12135                                      (mail-header-subject header))))
12136                     (if (file-directory-p dir)
12137                         (progn
12138                           (setq article 'nneething)
12139                           (gnus-group-enter-directory dir)))))))))
12140
12141         (cond 
12142          ;; We first check `gnus-original-article-buffer'.
12143          ((and (equal (car gnus-original-article) group)
12144                (eq (cdr gnus-original-article) article))
12145           ;; We don't have to do anything, since it's already where we
12146           ;; want it.  
12147           'article)
12148          ;; Check the backlog.
12149          ((and gnus-keep-backlog
12150                (gnus-backlog-request-article group article (current-buffer)))
12151           'article)
12152          ;; Check the cache.
12153          ((and gnus-use-cache
12154                (numberp article)
12155                (gnus-cache-request-article article group))
12156           'article)
12157          ;; Get the article and put into the article buffer.
12158          ((or (stringp article) (numberp article))
12159           (let ((gnus-override-method 
12160                  (and (stringp article) gnus-refer-article-method))
12161                 (buffer-read-only nil))
12162             (erase-buffer)
12163             (gnus-kill-all-overlays)
12164             (if (gnus-request-article article group (current-buffer))
12165                 (progn
12166                   (and gnus-keep-backlog 
12167                        (gnus-backlog-enter-article 
12168                         group article (current-buffer)))
12169                   'article))))
12170          ;; It was a pseudo.
12171          (t article)))
12172     (setq gnus-original-article (cons group article))
12173     (let (buffer-read-only)
12174       (erase-buffer)
12175       (gnus-kill-all-overlays)
12176       (insert-buffer-substring gnus-original-article-buffer))))
12177
12178 (defun gnus-read-header (id)
12179   "Read the headers of article ID and enter them into the Gnus system."
12180   (let ((group gnus-newsgroup-name)
12181         (headers gnus-newsgroup-headers)
12182         header where)
12183     ;; First we check to see whether the header in question is already
12184     ;; fetched. 
12185     (if (stringp id)
12186         ;; This is a Message-ID.
12187         (while headers
12188           (if (string= id (mail-header-id (car headers)))
12189               (setq header (car headers)
12190                     headers nil)
12191             (setq headers (cdr headers))))
12192       ;; This is an article number.
12193       (while headers
12194         (if (= id (mail-header-number (car headers)))
12195             (setq header (car headers)
12196                   headers nil)
12197           (setq headers (cdr headers)))))
12198     (if header
12199         ;; We have found the header.
12200         header
12201       ;; We have to really fetch the header to this article.
12202       (when (setq where
12203                   (if (gnus-check-backend-function 'request-head group)
12204                       (gnus-request-head id group)
12205                     (gnus-request-article id group)))
12206         (save-excursion
12207           (set-buffer nntp-server-buffer)
12208           (and (search-forward "\n\n" nil t)
12209                (delete-region (1- (point)) (point-max)))
12210           (goto-char (point-max))
12211           (insert ".\n")
12212           (goto-char (point-min))
12213           (insert "211 "
12214                   (int-to-string
12215                    (cond
12216                     ((numberp id)
12217                      id)
12218                     ((cdr where)
12219                      (cdr where))
12220                     (t
12221                      gnus-reffed-article-number)))
12222                   " Article retrieved.\n"))
12223         (if (not (setq header (car (gnus-get-newsgroup-headers))))
12224             () ; Malformed head.
12225           (if (and (stringp id)
12226                    (not (string= (gnus-group-real-name group)
12227                                  (car where))))
12228               ;; If we fetched by Message-ID and the article came
12229               ;; from a different group, we fudge some bogus article
12230               ;; numbers for this article.
12231               (mail-header-set-number header gnus-reffed-article-number))
12232           (decf gnus-reffed-article-number)
12233           (push header gnus-newsgroup-headers)
12234           (setq gnus-current-headers header)
12235           (push (mail-header-number header) gnus-newsgroup-limit)
12236           header)))))
12237
12238 (defun gnus-article-prepare (article &optional all-headers header)
12239   "Prepare ARTICLE in article mode buffer.
12240 ARTICLE should either be an article number or a Message-ID.
12241 If ARTICLE is an id, HEADER should be the article headers.
12242 If ALL-HEADERS is non-nil, no headers are hidden."
12243   (save-excursion
12244     ;; Make sure we start in a summary buffer.
12245     (unless (eq major-mode 'gnus-summary-mode)
12246       (set-buffer gnus-summary-buffer))
12247     (setq gnus-summary-buffer (current-buffer))
12248     ;; Make sure the connection to the server is alive.
12249     (unless (gnus-server-opened
12250              (gnus-find-method-for-group gnus-newsgroup-name))
12251       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
12252       (gnus-request-group gnus-newsgroup-name t))
12253     (let* ((article (if header (mail-header-number header) article))
12254            (summary-buffer (current-buffer))
12255            (internal-hook gnus-article-internal-prepare-hook)
12256            (group gnus-newsgroup-name)
12257            result)
12258       (save-excursion
12259         (gnus-article-setup-buffer)
12260         (set-buffer gnus-article-buffer)
12261         ;; Deactivate active regions.
12262         (when (and (boundp 'transient-mark-mode)
12263                    transient-mark-mode)
12264           (setq mark-active nil))
12265         (if (not (setq result (let ((buffer-read-only nil))
12266                                 (gnus-request-article-this-buffer 
12267                                  article group))))
12268             ;; There is no such article.
12269             (save-excursion
12270               (if (not (numberp article))
12271                   ()
12272                 (setq gnus-article-current 
12273                       (cons gnus-newsgroup-name article))
12274                 (set-buffer gnus-summary-buffer)
12275                 (setq gnus-current-article article)
12276                 (gnus-summary-mark-article article gnus-canceled-mark))
12277               (gnus-message 
12278                1 "No such article (may have expired or been canceled)")
12279               (ding)
12280               nil)
12281           (if (or (eq result 'pseudo) (eq result 'nneething))
12282               (progn
12283                 (save-excursion
12284                   (set-buffer summary-buffer)
12285                   (setq gnus-last-article gnus-current-article
12286                         gnus-newsgroup-history (cons gnus-current-article
12287                                                      gnus-newsgroup-history)
12288                         gnus-current-article 0
12289                         gnus-current-headers nil
12290                         gnus-article-current nil)
12291                   (if (eq result 'nneething)
12292                       (gnus-configure-windows 'summary)
12293                     (gnus-configure-windows 'article))
12294                   (gnus-set-global-variables))
12295                 (gnus-set-mode-line 'article))
12296             ;; The result from the `request' was an actual article -
12297             ;; or at least some text that is now displayed in the
12298             ;; article buffer.
12299             (if (and (numberp article)
12300                      (not (eq article gnus-current-article)))
12301                 ;; Seems like a new article has been selected.
12302                 ;; `gnus-current-article' must be an article number.
12303                 (save-excursion
12304                   (set-buffer summary-buffer)
12305                   (setq gnus-last-article gnus-current-article
12306                         gnus-newsgroup-history (cons gnus-current-article
12307                                                      gnus-newsgroup-history)
12308                         gnus-current-article article
12309                         gnus-current-headers 
12310                         (gnus-summary-article-header gnus-current-article)
12311                         gnus-article-current 
12312                         (cons gnus-newsgroup-name gnus-current-article))
12313                   (unless (vectorp gnus-current-headers)
12314                     (setq gnus-current-headers nil))
12315                   (gnus-summary-show-thread)
12316                   (run-hooks 'gnus-mark-article-hook)
12317                   (gnus-set-mode-line 'summary)
12318                   (and (gnus-visual-p 'article-highlight 'highlight)
12319                        (run-hooks 'gnus-visual-mark-article-hook))
12320                   ;; Set the global newsgroup variables here.
12321                   ;; Suggested by Jim Sisolak
12322                   ;; <sisolak@trans4.neep.wisc.edu>.
12323                   (gnus-set-global-variables)
12324                   (setq gnus-have-all-headers 
12325                         (or all-headers gnus-show-all-headers))
12326                   (and gnus-use-cache 
12327                        (vectorp (gnus-summary-article-header article))
12328                        (gnus-cache-possibly-enter-article
12329                         group article
12330                         (gnus-summary-article-header article)
12331                         (memq article gnus-newsgroup-marked)
12332                         (memq article gnus-newsgroup-dormant)
12333                         (memq article gnus-newsgroup-unreads)))))
12334             ;; Hooks for getting information from the article.
12335             ;; This hook must be called before being narrowed.
12336             (let (buffer-read-only)
12337               (run-hooks 'internal-hook)
12338               (run-hooks 'gnus-article-prepare-hook)
12339               ;; Decode MIME message.
12340               (if gnus-show-mime
12341                   (if (or (not gnus-strict-mime)
12342                           (gnus-fetch-field "Mime-Version"))
12343                       (funcall gnus-show-mime-method)
12344                     (funcall gnus-decode-encoded-word-method)))
12345               ;; Perform the article display hooks.
12346               (run-hooks 'gnus-article-display-hook))
12347             ;; Do page break.
12348             (goto-char (point-min))
12349             (and gnus-break-pages (gnus-narrow-to-page))
12350             (gnus-set-mode-line 'article)
12351             (gnus-configure-windows 'article)
12352             (goto-char (point-min))
12353             t))))))
12354
12355 (defun gnus-article-show-all-headers ()
12356   "Show all article headers in article mode buffer."
12357   (save-excursion 
12358     (gnus-article-setup-buffer)
12359     (set-buffer gnus-article-buffer)
12360     (let ((buffer-read-only nil))
12361       (remove-text-properties (point-min) (point-max) 
12362                               gnus-hidden-properties))))
12363
12364 (defun gnus-article-hide-headers-if-wanted ()
12365   "Hide unwanted headers if `gnus-have-all-headers' is nil.
12366 Provided for backwards compatability."
12367   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
12368       gnus-inhibit-hiding
12369       (gnus-article-hide-headers)))
12370
12371 (defun gnus-article-hide-headers (&optional delete)
12372   "Hide unwanted headers and possibly sort them as well."
12373   (interactive "P")
12374   (unless gnus-inhibit-hiding
12375     (save-excursion
12376       (set-buffer gnus-article-buffer)
12377       (save-restriction
12378         (let ((sorted gnus-sorted-header-list)
12379               (buffer-read-only nil)
12380               want-list beg want-l)
12381           ;; First we narrow to just the headers.
12382           (widen)
12383           (goto-char (point-min))
12384           ;; Hide any "From " lines at the beginning of (mail) articles. 
12385           (while (looking-at "From ")
12386             (forward-line 1))
12387           (or (bobp) 
12388               (add-text-properties (point-min) (point) gnus-hidden-properties))
12389           ;; Then treat the rest of the header lines.
12390           (narrow-to-region 
12391            (point) 
12392            (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
12393           ;; Then we use the two regular expressions
12394           ;; `gnus-ignored-headers' and `gnus-visible-headers' to
12395           ;; select which header lines is to remain visible in the
12396           ;; article buffer.
12397           (goto-char (point-min))
12398           (while (re-search-forward "^[^ \t]*:" nil t)
12399             (beginning-of-line)
12400             ;; We add the headers we want to keep to a list and delete
12401             ;; them from the buffer.
12402             (if (or (and (stringp gnus-visible-headers)
12403                          (looking-at gnus-visible-headers))
12404                     (and (not (stringp gnus-visible-headers))
12405                          (stringp gnus-ignored-headers)
12406                          (not (looking-at gnus-ignored-headers))))
12407                 (progn
12408                   (setq beg (point))
12409                   (forward-line 1)
12410                   ;; Be sure to get multi-line headers...
12411                   (re-search-forward "^[^ \t]*:" nil t)
12412                   (beginning-of-line)
12413                   (setq want-list 
12414                         (cons (buffer-substring beg (point)) want-list))
12415                   (delete-region beg (point))
12416                   (goto-char beg))
12417               (forward-line 1)))
12418           ;; Next we perform the sorting by looking at
12419           ;; `gnus-sorted-header-list'. 
12420           (goto-char (point-min))
12421           (while (and sorted want-list)
12422             (setq want-l want-list)
12423             (while (and want-l
12424                         (not (string-match (car sorted) (car want-l))))
12425               (setq want-l (cdr want-l)))
12426             (if want-l 
12427                 (progn
12428                   (insert (car want-l))
12429                   (setq want-list (delq (car want-l) want-list))))
12430             (setq sorted (cdr sorted)))
12431           ;; Any headers that were not matched by the sorted list we
12432           ;; just tack on the end of the visible header list.
12433           (while want-list
12434             (insert (car want-list))
12435             (setq want-list (cdr want-list)))
12436           ;; And finally we make the unwanted headers invisible.
12437           (if delete
12438               (delete-region (point) (point-max))
12439             ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
12440             (add-text-properties 
12441              (point) (point-max) gnus-hidden-properties)))))))
12442
12443 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
12444 (defun gnus-article-treat-overstrike ()
12445   "Translate overstrikes into bold text."
12446   (interactive)
12447   (save-excursion
12448     (set-buffer gnus-article-buffer)
12449     (let ((buffer-read-only nil))
12450       (while (search-forward "\b" nil t)
12451         (let ((next (following-char))
12452               (previous (char-after (- (point) 2))))
12453           (cond ((eq next previous)
12454                  (put-text-property (- (point) 2) (point) 'invisible t)
12455                  (put-text-property (point) (1+ (point)) 'face 'bold))
12456                 ((eq next ?_)
12457                  (put-text-property (1- (point)) (1+ (point)) 'invisible t)
12458                  (put-text-property
12459                   (- (point) 2) (1- (point)) 'face 'underline))
12460                 ((eq previous ?_)
12461                  (put-text-property (- (point) 2) (point) 'invisible t)
12462                  (put-text-property 
12463                   (point) (1+ (point))  'face 'underline))))))))
12464
12465 (defun gnus-article-word-wrap ()
12466   "Format too long lines."
12467   (interactive)
12468   (save-excursion
12469     (set-buffer gnus-article-buffer)
12470     (let ((buffer-read-only nil)
12471           p)
12472       (widen)
12473       (goto-char (point-min))
12474       (search-forward "\n\n" nil t)
12475       (end-of-line 1)
12476       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
12477             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
12478             (adaptive-fill-mode t))
12479         (while (not (eobp))
12480           (and (>= (current-column) (min fill-column (window-width)))
12481                (/= (preceding-char) ?:)
12482                (fill-paragraph nil))
12483           (end-of-line 2))))))
12484
12485 (defun gnus-article-remove-cr ()
12486   "Remove carriage returns from an article."
12487   (interactive)
12488   (save-excursion
12489     (set-buffer gnus-article-buffer)
12490     (let ((buffer-read-only nil))
12491       (goto-char (point-min))
12492       (while (search-forward "\r" nil t)
12493         (replace-match "" t t)))))
12494
12495 (defun gnus-article-display-x-face (&optional force)
12496   "Look for an X-Face header and display it if present."
12497   (interactive (list 'force))
12498   (save-excursion
12499     (set-buffer gnus-article-buffer)
12500     ;; Delete the old process, if any.
12501     (when (process-status "gnus-x-face")
12502       (delete-process "gnus-x-face"))
12503     (let ((inhibit-point-motion-hooks t)
12504           (case-fold-search nil)
12505           from)
12506       (save-restriction
12507         (gnus-narrow-to-headers)
12508         (setq from (mail-fetch-field "from"))
12509         (goto-char (point-min))
12510         (when (and gnus-article-x-face-command 
12511                    (or force
12512                        ;; Check whether this face is censored.
12513                        (not gnus-article-x-face-too-ugly)
12514                        (and gnus-article-x-face-too-ugly from
12515                             (not (string-match gnus-article-x-face-too-ugly 
12516                                                from))))
12517                    ;; Has to be present.
12518                    (re-search-forward "^X-Face: " nil t))
12519           ;; We now have the area of the buffer where the X-Face is stored.
12520           (let ((beg (point))
12521                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
12522             ;; We display the face.
12523             (if (symbolp gnus-article-x-face-command)
12524                 ;; The command is a lisp function, so we call it.
12525                 (if (gnus-functionp gnus-article-x-face-command)
12526                     (funcall gnus-article-x-face-command beg end)
12527                   (error "%s is not a function" gnus-article-x-face-command))
12528               ;; The command is a string, so we interpret the command
12529               ;; as a, well, command, and fork it off.
12530               (let ((process-connection-type nil))
12531                 (process-kill-without-query
12532                  (start-process 
12533                   "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
12534                 (process-send-region "gnus-x-face" beg end)
12535                 (process-send-eof "gnus-x-face")))))))))
12536
12537 (defun gnus-headers-decode-quoted-printable ()
12538   "Hack to remove QP encoding from headers."
12539   (let ((case-fold-search t)
12540         (inhibit-point-motion-hooks t)
12541         string)
12542     (goto-char (point-min))
12543     (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
12544       (setq string (match-string 1))
12545       (narrow-to-region (match-beginning 0) (match-end 0))
12546       (delete-region (point-min) (point-max))
12547       (insert string)
12548       (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
12549       (subst-char-in-region (point-min) (point-max) ?_ ? )
12550       (widen)
12551       (goto-char (point-min)))))
12552        
12553 (defun gnus-article-de-quoted-unreadable (&optional force)
12554   "Do a naive translation of a quoted-printable-encoded article.
12555 This is in no way, shape or form meant as a replacement for real MIME
12556 processing, but is simply a stop-gap measure until MIME support is
12557 written.
12558 If FORCE, decode the article whether it is marked as quoted-printable
12559 or not." 
12560   (interactive (list 'force))
12561   (save-excursion
12562     (set-buffer gnus-article-buffer)
12563     (let ((case-fold-search t)
12564           (buffer-read-only nil)
12565           (type (gnus-fetch-field "content-transfer-encoding")))
12566       (when (or force
12567                 (and type (string-match "quoted-printable" type)))
12568         (goto-char (point-min))
12569         (search-forward "\n\n" nil 'move)
12570         (gnus-mime-decode-quoted-printable (point) (point-max))
12571         (gnus-headers-decode-quoted-printable)))))
12572
12573 (defun gnus-mime-decode-quoted-printable (from to)
12574   "Decode Quoted-Printable in the region between FROM and TO."
12575   (goto-char from)
12576   (while (search-forward "=" to t)
12577     (cond ((eq (following-char) ?\n)
12578            (delete-char -1)
12579            (delete-char 1))
12580           ((looking-at "[0-9A-F][0-9A-F]")
12581            (delete-char -1)
12582            (insert (hexl-hex-string-to-integer
12583                     (buffer-substring (point) (+ 2 (point)))))
12584            (delete-char 2))
12585           ((looking-at "=")
12586            (delete-char 1))
12587           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
12588
12589 (defun gnus-article-hide-pgp ()
12590   "Hide any PGP headers and signatures in the current article."
12591   (interactive)
12592   (save-excursion
12593     (set-buffer gnus-article-buffer)
12594     (let (buffer-read-only beg end)
12595       (widen)
12596       (goto-char (point-min))
12597       ;; Hide the "header".
12598       (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
12599            (add-text-properties (match-beginning 0) (match-end 0)
12600                                 gnus-hidden-properties))
12601       (setq beg (point))
12602       ;; Hide the actual signature.
12603       (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
12604            (setq end (match-beginning 0))
12605            (add-text-properties 
12606             (match-beginning 0)
12607             (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
12608                 (match-end 0)
12609               ;; Perhaps we shouldn't hide to the end of the buffer
12610               ;; if there is no end to the signature?
12611               (point-max))
12612             gnus-hidden-properties))
12613       ;; Hide "- " PGP quotation markers.
12614       (when (and beg end)
12615         (narrow-to-region beg end)
12616         (goto-char (point-min))
12617         (while (re-search-forward "^- " nil t)
12618           (add-text-properties (match-beginning 0) (match-end 0)
12619                                gnus-hidden-properties))
12620         (widen)))))
12621
12622 (defvar gnus-article-time-units
12623   `((year . ,(* 365.25 24 60 60))
12624     (week . ,(* 7 24 60 60))
12625     (day . ,(* 24 60 60))
12626     (hour . ,(* 60 60))
12627     (minute . 60)
12628     (second . 1))
12629   "Mapping from time units to seconds.")
12630
12631 (defun gnus-article-date-ut (&optional type highlight)
12632   "Convert DATE date to universal time in the current article.
12633 If TYPE is `local', convert to local time; if it is `lapsed', output
12634 how much time has lapsed since DATE."
12635   (interactive (list 'ut t))
12636   (let ((date (mail-header-date (or gnus-current-headers 
12637                                     (gnus-summary-article-header) "")))
12638         (date-regexp "^Date: \\|^X-Sent: ")
12639         (inhibit-point-motion-hooks t))
12640     (when (and date (not (string= date "")))
12641       (save-excursion
12642         (set-buffer gnus-article-buffer)
12643         (save-restriction
12644           (gnus-narrow-to-headers)
12645           (let ((buffer-read-only nil))
12646             ;; Delete any old Date headers.
12647             (if (zerop (nnheader-remove-header date-regexp t))
12648                 (beginning-of-line)
12649               (goto-char (point-max)))
12650             (insert
12651              (cond 
12652               ;; Convert to the local timezone.  We have to slap a
12653               ;; `condition-case' round the calls to the timezone
12654               ;; functions since they aren't particularly resistant to
12655               ;; buggy dates.
12656               ((eq type 'local)
12657                (concat "Date: " (condition-case ()
12658                                     (timezone-make-date-arpa-standard date)
12659                                   (error date))
12660                        "\n"))
12661               ;; Convert to Universal Time.
12662               ((eq type 'ut)
12663                (concat "Date: "
12664                        (condition-case ()
12665                            (timezone-make-date-arpa-standard date nil "UT")
12666                          (error date))
12667                        "\n"))
12668               ;; Get the original date from the article.
12669               ((eq type 'original)
12670                (concat "Date: " date "\n"))
12671               ;; Do an X-Sent lapsed format.
12672               ((eq type 'lapsed)
12673                ;; If the date is seriously mangled, the timezone
12674                ;; functions are liable to bug out, so we condition-case
12675                ;; the entire thing.  
12676                (let* ((real-sec (condition-case ()
12677                                     (- (gnus-seconds-since-epoch 
12678                                         (timezone-make-date-arpa-standard
12679                                          (current-time-string) 
12680                                          (current-time-zone) "UT"))
12681                                        (gnus-seconds-since-epoch 
12682                                         (timezone-make-date-arpa-standard 
12683                                          date nil "UT")))
12684                                   (error 0)))
12685                       (sec (abs real-sec))
12686                       num prev)
12687                  (if (zerop sec)
12688                      "X-Sent: Now\n"
12689                    (concat
12690                     "X-Sent: "
12691                     ;; This is a bit convoluted, but basically we go
12692                     ;; through the time units for years, weeks, etc,
12693                     ;; and divide things to see whether that results
12694                     ;; in positive answers.
12695                     (mapconcat 
12696                      (lambda (unit)
12697                        (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
12698                            ;; The (remaining) seconds are too few to
12699                            ;; be divided into this time unit.
12700                            "" 
12701                          ;; It's big enough, so we output it.
12702                          (setq sec (- sec (* num (cdr unit))))
12703                          (prog1
12704                              (concat (if prev ", " "") (int-to-string 
12705                                                         (floor num))
12706                                      " " (symbol-name (car unit))
12707                                      (if (> num 1) "s" ""))
12708                            (setq prev t))))
12709                      gnus-article-time-units "")
12710                     ;; If dates are odd, then it might appear like the
12711                     ;; article was sent in the future.
12712                     (if (> real-sec 0)
12713                         " ago\n"
12714                       " in the future\n")))))
12715               (t
12716                (error "Unknown conversion type: %s" type)))))
12717           ;; Do highlighting.
12718           (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
12719             (gnus-article-highlight-headers)))))))
12720
12721 (defun gnus-article-date-local (&optional highlight)
12722   "Convert the current article date to the local timezone."
12723   (interactive (list t))
12724   (gnus-article-date-ut 'local highlight))
12725
12726 (defun gnus-article-date-original (&optional highlight)
12727   "Convert the current article date to what it was originally.
12728 This is only useful if you have used some other date conversion
12729 function and want to see what the date was before converting."
12730   (interactive (list t))
12731   (gnus-article-date-ut 'original highlight))
12732
12733 (defun gnus-article-date-lapsed (&optional highlight)
12734   "Convert the current article date to time lapsed since it was sent."
12735   (interactive (list t))
12736   (gnus-article-date-ut 'lapsed highlight))
12737
12738 (defun gnus-article-maybe-highlight ()
12739   "Do some article highlighting if `gnus-visual' is non-nil."
12740   (if (gnus-visual-p 'article-highlight 'highlight)
12741       (gnus-article-highlight-some)))
12742
12743 ;; Article savers.
12744
12745 (defun gnus-output-to-rmail (file-name)
12746   "Append the current article to an Rmail file named FILE-NAME."
12747   (require 'rmail)
12748   ;; Most of these codes are borrowed from rmailout.el.
12749   (setq file-name (expand-file-name file-name))
12750   (setq rmail-default-rmail-file file-name)
12751   (let ((artbuf (current-buffer))
12752         (tmpbuf (get-buffer-create " *Gnus-output*")))
12753     (save-excursion
12754       (or (get-file-buffer file-name)
12755           (file-exists-p file-name)
12756           (if (gnus-yes-or-no-p
12757                (concat "\"" file-name "\" does not exist, create it? "))
12758               (let ((file-buffer (create-file-buffer file-name)))
12759                 (save-excursion
12760                   (set-buffer file-buffer)
12761                   (rmail-insert-rmail-file-header)
12762                   (let ((require-final-newline nil))
12763                     (write-region (point-min) (point-max) file-name t 1)))
12764                 (kill-buffer file-buffer))
12765             (error "Output file does not exist")))
12766       (set-buffer tmpbuf)
12767       (buffer-disable-undo (current-buffer))
12768       (erase-buffer)
12769       (insert-buffer-substring artbuf)
12770       (gnus-convert-article-to-rmail)
12771       ;; Decide whether to append to a file or to an Emacs buffer.
12772       (let ((outbuf (get-file-buffer file-name)))
12773         (if (not outbuf)
12774             (append-to-file (point-min) (point-max) file-name)
12775           ;; File has been visited, in buffer OUTBUF.
12776           (set-buffer outbuf)
12777           (let ((buffer-read-only nil)
12778                 (msg (and (boundp 'rmail-current-message)
12779                           (symbol-value 'rmail-current-message))))
12780             ;; If MSG is non-nil, buffer is in RMAIL mode.
12781             (if msg
12782                 (progn (widen)
12783                        (narrow-to-region (point-max) (point-max))))
12784             (insert-buffer-substring tmpbuf)
12785             (if msg
12786                 (progn
12787                   (goto-char (point-min))
12788                   (widen)
12789                   (search-backward "\^_")
12790                   (narrow-to-region (point) (point-max))
12791                   (goto-char (1+ (point-min)))
12792                   (rmail-count-new-messages t)
12793                   (rmail-show-message msg)))))))
12794     (kill-buffer tmpbuf)))
12795
12796 (defun gnus-output-to-file (file-name)
12797   "Append the current article to a file named FILE-NAME."
12798   (setq file-name (expand-file-name file-name))
12799   (let ((artbuf (current-buffer))
12800         (tmpbuf (get-buffer-create " *Gnus-output*")))
12801     (save-excursion
12802       (set-buffer tmpbuf)
12803       (buffer-disable-undo (current-buffer))
12804       (erase-buffer)
12805       (insert-buffer-substring artbuf)
12806       ;; Append newline at end of the buffer as separator, and then
12807       ;; save it to file.
12808       (goto-char (point-max))
12809       (insert "\n")
12810       (append-to-file (point-min) (point-max) file-name))
12811     (kill-buffer tmpbuf)))
12812
12813 (defun gnus-convert-article-to-rmail ()
12814   "Convert article in current buffer to Rmail message format."
12815   (let ((buffer-read-only nil))
12816     ;; Convert article directly into Babyl format.
12817     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
12818     (goto-char (point-min))
12819     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
12820     (while (search-forward "\n\^_" nil t) ;single char
12821       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
12822     (goto-char (point-max))
12823     (insert "\^_")))
12824
12825 (defun gnus-narrow-to-page (&optional arg)
12826   "Make text outside current page invisible except for page delimiter.
12827 A numeric arg specifies to move forward or backward by that many pages,
12828 thus showing a page other than the one point was originally in."
12829   (interactive "P")
12830   (setq arg (if arg (prefix-numeric-value arg) 0))
12831   (save-excursion
12832     (forward-page -1)                   ;Beginning of current page.
12833     (widen)
12834     (if (> arg 0)
12835         (forward-page arg)
12836       (if (< arg 0)
12837           (forward-page (1- arg))))
12838     ;; Find the end of the page.
12839     (forward-page)
12840     ;; If we stopped due to end of buffer, stay there.
12841     ;; If we stopped after a page delimiter, put end of restriction
12842     ;; at the beginning of that line.
12843     ;; These are commented out.
12844     ;;    (if (save-excursion (beginning-of-line)
12845     ;;                  (looking-at page-delimiter))
12846     ;;  (beginning-of-line))
12847     (narrow-to-region (point)
12848                       (progn
12849                         ;; Find the top of the page.
12850                         (forward-page -1)
12851                         ;; If we found beginning of buffer, stay there.
12852                         ;; If extra text follows page delimiter on same line,
12853                         ;; include it.
12854                         ;; Otherwise, show text starting with following line.
12855                         (if (and (eolp) (not (bobp)))
12856                             (forward-line 1))
12857                         (point)))))
12858
12859 (defun gnus-gmt-to-local ()
12860   "Rewrite Date header described in GMT to local in current buffer.
12861 Intended to be used with gnus-article-prepare-hook."
12862   (save-excursion
12863     (save-restriction
12864       (widen)
12865       (goto-char (point-min))
12866       (narrow-to-region (point-min)
12867                         (progn (search-forward "\n\n" nil 'move) (point)))
12868       (goto-char (point-min))
12869       (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
12870           (let ((buffer-read-only nil)
12871                 (date (buffer-substring-no-properties
12872                        (match-beginning 1) (match-end 1))))
12873             (delete-region (match-beginning 1) (match-end 1))
12874             (insert
12875              (timezone-make-date-arpa-standard 
12876               date nil (current-time-zone))))))))
12877
12878 ;; Article mode commands
12879
12880 (defun gnus-article-next-page (&optional lines)
12881   "Show next page of current article.
12882 If end of article, return non-nil.  Otherwise return nil.
12883 Argument LINES specifies lines to be scrolled up."
12884   (interactive "P")
12885   (move-to-window-line -1)
12886   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
12887   (if (save-excursion
12888         (end-of-line)
12889         (and (pos-visible-in-window-p)  ;Not continuation line.
12890              (eobp)))
12891       ;; Nothing in this page.
12892       (if (or (not gnus-break-pages)
12893               (save-excursion
12894                 (save-restriction
12895                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
12896           t                             ;Nothing more.
12897         (gnus-narrow-to-page 1)         ;Go to next page.
12898         nil)
12899     ;; More in this page.
12900     (condition-case ()
12901         (scroll-up lines)
12902       (end-of-buffer
12903        ;; Long lines may cause an end-of-buffer error.
12904        (goto-char (point-max))))
12905     nil))
12906
12907 (defun gnus-article-prev-page (&optional lines)
12908   "Show previous page of current article.
12909 Argument LINES specifies lines to be scrolled down."
12910   (interactive "P")
12911   (move-to-window-line 0)
12912   (if (and gnus-break-pages
12913            (bobp)
12914            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
12915       (progn
12916         (gnus-narrow-to-page -1)        ;Go to previous page.
12917         (goto-char (point-max))
12918         (recenter -1))
12919     (scroll-down lines)))
12920
12921 (defun gnus-article-refer-article ()
12922   "Read article specified by message-id around point."
12923   (interactive)
12924   (search-forward ">" nil t)            ;Move point to end of "<....>".
12925   (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
12926       (let ((message-id (match-string 1)))
12927         (set-buffer gnus-summary-buffer)
12928         (gnus-summary-refer-article message-id))
12929     (error "No references around point")))
12930
12931 (defun gnus-article-show-summary ()
12932   "Reconfigure windows to show summary buffer."
12933   (interactive)
12934   (gnus-configure-windows 'article)
12935   (gnus-summary-goto-subject gnus-current-article))
12936
12937 (defun gnus-article-describe-briefly ()
12938   "Describe article mode commands briefly."
12939   (interactive)
12940   (gnus-message 6
12941                 (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")))
12942
12943 (defun gnus-article-summary-command ()
12944   "Execute the last keystroke in the summary buffer."
12945   (interactive)
12946   (let ((obuf (current-buffer))
12947         (owin (current-window-configuration))
12948         func)
12949     (switch-to-buffer gnus-summary-buffer 'norecord)
12950     (setq func (lookup-key (current-local-map) (this-command-keys)))
12951     (call-interactively func)
12952     (set-buffer obuf)
12953     (set-window-configuration owin)
12954     (set-window-point (get-buffer-window (current-buffer)) (point))))
12955
12956 (defun gnus-article-summary-command-nosave ()
12957   "Execute the last keystroke in the summary buffer."
12958   (interactive)
12959   (let (func)
12960     (pop-to-buffer gnus-summary-buffer 'norecord)
12961     (setq func (lookup-key (current-local-map) (this-command-keys)))
12962     (call-interactively func)))
12963
12964 \f
12965 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
12966
12967 ;;;###autoload
12968 (defalias 'gnus-batch-kill 'gnus-batch-score)
12969 ;;;###autoload
12970 (defun gnus-batch-score ()
12971   "Run batched scoring.
12972 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
12973 Newsgroups is a list of strings in Bnews format.  If you want to score
12974 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
12975 score the alt hierarchy, you'd say \"!alt.all\"."
12976   (interactive)
12977   (let* ((yes-and-no
12978           (gnus-newsrc-parse-options
12979            (apply (function concat)
12980                   (mapcar (lambda (g) (concat g " "))
12981                           command-line-args-left))))
12982          (gnus-expert-user t)
12983          (nnmail-spool-file nil)
12984          (gnus-use-dribble-file nil)
12985          (yes (car yes-and-no))
12986          (no (cdr yes-and-no))
12987          group newsrc entry
12988          ;; Disable verbose message.
12989          gnus-novice-user gnus-large-newsgroup)
12990     ;; Eat all arguments.
12991     (setq command-line-args-left nil)
12992     ;; Start Gnus.
12993     (gnus)
12994     ;; Apply kills to specified newsgroups in command line arguments.
12995     (setq newsrc (cdr gnus-newsrc-alist))
12996     (while newsrc
12997       (setq group (car (car newsrc)))
12998       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
12999       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
13000                (and (car entry)
13001                     (or (eq (car entry) t)
13002                         (not (zerop (car entry)))))
13003                (if yes (string-match yes group) t)
13004                (or (null no) (not (string-match no group))))
13005           (progn
13006             (gnus-summary-read-group group nil t nil t)
13007             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
13008                  (gnus-summary-exit))))
13009       (setq newsrc (cdr newsrc)))
13010     ;; Exit Emacs.
13011     (switch-to-buffer gnus-group-buffer)
13012     (gnus-group-save-newsrc)))
13013
13014 (defun gnus-apply-kill-file ()
13015   "Apply a kill file to the current newsgroup.
13016 Returns the number of articles marked as read."
13017   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
13018           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
13019       (gnus-apply-kill-file-internal)
13020     0))
13021
13022 (defun gnus-kill-save-kill-buffer ()
13023   (save-excursion
13024     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
13025       (if (get-file-buffer file)
13026           (progn
13027             (set-buffer (get-file-buffer file))
13028             (and (buffer-modified-p) (save-buffer))
13029             (kill-buffer (current-buffer)))))))
13030
13031 (defvar gnus-kill-file-name "KILL"
13032   "Suffix of the kill files.")
13033
13034 (defun gnus-newsgroup-kill-file (newsgroup)
13035   "Return the name of a kill file name for NEWSGROUP.
13036 If NEWSGROUP is nil, return the global kill file name instead."
13037   (cond ((or (null newsgroup)
13038              (string-equal newsgroup ""))
13039          ;; The global KILL file is placed at top of the directory.
13040          (expand-file-name gnus-kill-file-name
13041                            (or gnus-kill-files-directory "~/News")))
13042         ((gnus-use-long-file-name 'not-kill)
13043          ;; Append ".KILL" to newsgroup name.
13044          (expand-file-name (concat (gnus-newsgroup-saveable-name newsgroup)
13045                                    "." gnus-kill-file-name)
13046                            (or gnus-kill-files-directory "~/News")))
13047         (t
13048          ;; Place "KILL" under the hierarchical directory.
13049          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
13050                                    "/" gnus-kill-file-name)
13051                            (or gnus-kill-files-directory "~/News")))))
13052
13053 \f
13054 ;;;
13055 ;;; Dribble file
13056 ;;;
13057
13058 (defvar gnus-dribble-ignore nil)
13059 (defvar gnus-dribble-eval-file nil)
13060
13061 (defun gnus-dribble-file-name ()
13062   (concat 
13063    (if gnus-dribble-directory
13064        (concat (file-name-as-directory gnus-dribble-directory)
13065                (file-name-nondirectory gnus-current-startup-file))
13066      gnus-current-startup-file)
13067    "-dribble"))
13068
13069 (defun gnus-dribble-enter (string)
13070   (if (and (not gnus-dribble-ignore)
13071            (or gnus-dribble-buffer
13072                gnus-slave)
13073            (buffer-name gnus-dribble-buffer))
13074       (let ((obuf (current-buffer)))
13075         (set-buffer gnus-dribble-buffer)
13076         (insert string "\n")
13077         (set-window-point (get-buffer-window (current-buffer)) (point-max))
13078         (set-buffer obuf))))
13079
13080 (defun gnus-dribble-read-file ()
13081   (let ((dribble-file (gnus-dribble-file-name)))
13082     (save-excursion 
13083       (set-buffer (setq gnus-dribble-buffer 
13084                         (get-buffer-create 
13085                          (file-name-nondirectory dribble-file))))
13086       (gnus-add-current-to-buffer-list)
13087       (erase-buffer)
13088       (setq buffer-file-name dribble-file)
13089       (auto-save-mode t)
13090       (buffer-disable-undo (current-buffer))
13091       (bury-buffer (current-buffer))
13092       (set-buffer-modified-p nil)
13093       (let ((auto (make-auto-save-file-name))
13094             (gnus-dribble-ignore t))
13095         (if (or (file-exists-p auto) (file-exists-p dribble-file))
13096             (progn
13097               (if (file-newer-than-file-p auto dribble-file)
13098                   (setq dribble-file auto))
13099               (insert-file-contents dribble-file)
13100               (if (not (zerop (buffer-size)))
13101                   (set-buffer-modified-p t))
13102               (if (gnus-y-or-n-p 
13103                    "Auto-save file exists.  Do you want to read it? ")
13104                   (setq gnus-dribble-eval-file t))))))))
13105
13106 (defun gnus-dribble-eval-file ()
13107   (if (not gnus-dribble-eval-file)
13108       ()
13109     (setq gnus-dribble-eval-file nil)
13110     (save-excursion
13111       (let ((gnus-dribble-ignore t))
13112         (set-buffer gnus-dribble-buffer)
13113         (eval-buffer (current-buffer))))))
13114
13115 (defun gnus-dribble-delete-file ()
13116   (if (file-exists-p (gnus-dribble-file-name))
13117       (delete-file (gnus-dribble-file-name)))
13118   (if gnus-dribble-buffer
13119       (save-excursion
13120         (set-buffer gnus-dribble-buffer)
13121         (let ((auto (make-auto-save-file-name)))
13122           (if (file-exists-p auto)
13123               (delete-file auto))
13124           (erase-buffer)
13125           (set-buffer-modified-p nil)))))
13126
13127 (defun gnus-dribble-save ()
13128   (if (and gnus-dribble-buffer
13129            (buffer-name gnus-dribble-buffer))
13130       (save-excursion
13131         (set-buffer gnus-dribble-buffer)
13132         (save-buffer))))
13133
13134 (defun gnus-dribble-clear ()
13135   (save-excursion
13136     (if (gnus-buffer-exists-p gnus-dribble-buffer)
13137         (progn
13138           (set-buffer gnus-dribble-buffer)
13139           (erase-buffer)
13140           (set-buffer-modified-p nil)
13141           (setq buffer-saved-size (buffer-size))))))
13142
13143 ;;;
13144 ;;; Server Communication
13145 ;;;
13146
13147 (defun gnus-start-news-server (&optional confirm)
13148   "Open a method for getting news.
13149 If CONFIRM is non-nil, the user will be asked for an NNTP server."
13150   (let (how)
13151     (if gnus-current-select-method
13152         ;; Stream is already opened.
13153         nil
13154       ;; Open NNTP server.
13155       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
13156       (if confirm
13157           (progn
13158             ;; Read server name with completion.
13159             (setq gnus-nntp-server
13160                   (completing-read "NNTP server: "
13161                                    (mapcar (lambda (server) (list server))
13162                                            (cons (list gnus-nntp-server)
13163                                                  gnus-secondary-servers))
13164                                    nil nil gnus-nntp-server))))
13165
13166       (if (and gnus-nntp-server 
13167                (stringp gnus-nntp-server)
13168                (not (string= gnus-nntp-server "")))
13169           (setq gnus-select-method
13170                 (cond ((or (string= gnus-nntp-server "")
13171                            (string= gnus-nntp-server "::"))
13172                        (list 'nnspool (system-name)))
13173                       ((string-match "^:" gnus-nntp-server)
13174                        (list 'nnmh gnus-nntp-server 
13175                              (list 'nnmh-directory 
13176                                    (file-name-as-directory
13177                                     (expand-file-name
13178                                      (concat "~/" (substring
13179                                                    gnus-nntp-server 1)))))
13180                              (list 'nnmh-get-new-mail nil)))
13181                       (t
13182                        (list 'nntp gnus-nntp-server)))))
13183
13184       (setq how (car gnus-select-method))
13185       (cond ((eq how 'nnspool)
13186              (require 'nnspool)
13187              (gnus-message 5 "Looking up local news spool..."))
13188             ((eq how 'nnmh)
13189              (require 'nnmh)
13190              (gnus-message 5 "Looking up mh spool..."))
13191             (t
13192              (require 'nntp)))
13193       (setq gnus-current-select-method gnus-select-method)
13194       (run-hooks 'gnus-open-server-hook)
13195       (or 
13196        ;; gnus-open-server-hook might have opened it
13197        (gnus-server-opened gnus-select-method)  
13198        (gnus-open-server gnus-select-method)
13199        (gnus-y-or-n-p
13200         (format
13201          "%s open error: '%s'.  Continue? "
13202          (nth 1 gnus-select-method)
13203          (gnus-status-message gnus-select-method)))
13204        (progn
13205          (gnus-message 1 "Couldn't open server on %s" 
13206                        (nth 1 gnus-select-method))
13207          (ding)
13208          nil)))))
13209
13210 (defun gnus-check-server (&optional method)
13211   "Check whether the connection to METHOD is down.
13212 If METHOD is nil, use `gnus-select-method'.
13213 If it is down, start it up (again)."
13214   (let ((method (or method gnus-select-method)))
13215     ;; Transform virtual server names into select methods.
13216     (when (stringp method)
13217       (setq method (gnus-server-to-method method)))
13218     (if (gnus-server-opened method)
13219         ;; The stream is already opened.
13220         t
13221       ;; Open the server.
13222       (gnus-message 5 "Opening %s server on %s..." (car method) (nth 1 method))
13223       (run-hooks 'gnus-open-server-hook)
13224       (prog1
13225           (gnus-open-server method)
13226         (message "")))))
13227
13228 (defun gnus-get-function (method function)
13229   "Return a function symbol based on METHOD and FUNCTION."
13230   ;; Translate server names into methods.
13231   (unless method
13232     (error "Attempted use of a nil select method"))
13233   (when (stringp method)
13234     (setq method (gnus-server-to-method method)))
13235   (let ((func (intern (format "%s-%s" (car method) function))))
13236     ;; If the functions isn't bound, we require the backend in
13237     ;; question.  
13238     (unless (fboundp func)
13239       (require (car method))
13240       (unless (fboundp func)
13241         ;; This backend doesn't implement this function.
13242         (error "No such function: %s" func)))
13243     func))
13244
13245 ;;; Interface functions to the backends.
13246
13247 (defun gnus-open-server (method)
13248   "Open a connection to METHOD."
13249   (let ((elem (assoc method gnus-opened-servers)))
13250     ;; If this method was previously denied, we just return nil.
13251     (if (eq (nth 1 elem) 'denied)
13252         (progn
13253           (gnus-message 1 "Denied server")
13254           nil)
13255       ;; Open the server.
13256       (let ((result
13257              (funcall (gnus-get-function method 'open-server)
13258                       (nth 1 method) (nthcdr 2 method))))
13259         ;; If this hasn't been opened before, we add it to the list.
13260         (unless elem 
13261           (setq elem (list method nil)
13262                 gnus-opened-servers (cons elem gnus-opened-servers)))
13263         ;; Set the status of this server.
13264         (setcar (cdr elem) (if result 'ok 'denied))
13265         ;; Return the result from the "open" call.
13266         result))))
13267
13268 (defun gnus-close-server (method)
13269   "Close the connection to METHOD."
13270   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
13271
13272 (defun gnus-request-list (method)
13273   "Request the active file from METHOD."
13274   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
13275
13276 (defun gnus-request-list-newsgroups (method)
13277   "Request the newsgroups file from METHOD."
13278   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
13279
13280 (defun gnus-request-newgroups (date method)
13281   "Request all new groups since DATE from METHOD."
13282   (funcall (gnus-get-function method 'request-newgroups) 
13283            date (nth 1 method)))
13284
13285 (defun gnus-server-opened (method)
13286   "Check whether a connection to METHOD has been opened."
13287   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
13288
13289 (defun gnus-status-message (method)
13290   "Return the status message from METHOD.
13291 If METHOD is a string, it is interpreted as a group name.   The method
13292 this group uses will be queried."
13293   (let ((method (if (stringp method) (gnus-find-method-for-group method)
13294                   method)))
13295     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
13296
13297 (defun gnus-request-group (group &optional dont-check)
13298   "Request GROUP.  If DONT-CHECK, no information is required."
13299   (let ((method (gnus-find-method-for-group group)))
13300     (funcall (gnus-get-function method 'request-group) 
13301              (gnus-group-real-name group) (nth 1 method) dont-check)))
13302
13303 (defun gnus-request-asynchronous (group &optional articles)
13304   "Request that GROUP behave asynchronously.
13305 ARTICLES is the `data' of the group."
13306   (let ((method (gnus-find-method-for-group group)))
13307     (funcall (gnus-get-function method 'request-asynchronous) 
13308              (gnus-group-real-name group) (nth 1 method) articles)))
13309
13310 (defun gnus-list-active-group (group)
13311   "Request active information on GROUP."
13312   (let ((method (gnus-find-method-for-group group))
13313         (func 'list-active-group))
13314     (when (gnus-check-backend-function func group)
13315       (funcall (gnus-get-function method func) 
13316                (gnus-group-real-name group) (nth 1 method)))))
13317
13318 (defun gnus-request-group-description (group)
13319   "Request a description of GROUP."
13320   (let ((method (gnus-find-method-for-group group))
13321         (func 'request-group-description))
13322     (when (gnus-check-backend-function func group)
13323       (funcall (gnus-get-function method func) 
13324                (gnus-group-real-name group) (nth 1 method)))))
13325
13326 (defun gnus-close-group (group)
13327   "Request the GROUP be closed."
13328   (let ((method (gnus-find-method-for-group group)))
13329     (funcall (gnus-get-function method 'close-group) 
13330              (gnus-group-real-name group) (nth 1 method))))
13331
13332 (defun gnus-retrieve-headers (articles group &optional fetch-old)
13333   "Request headers for ARTICLES in GROUP.
13334 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
13335   (let ((method (gnus-find-method-for-group group)))
13336     (if (and gnus-use-cache (numberp (car articles)))
13337         (gnus-cache-retrieve-headers articles group)
13338       (funcall (gnus-get-function method 'retrieve-headers) 
13339                articles (gnus-group-real-name group) (nth 1 method)
13340                fetch-old))))
13341
13342 (defun gnus-retrieve-groups (groups method)
13343   "Request active information on GROUPS from METHOD."
13344   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
13345
13346 (defun gnus-request-type (group &optional article)
13347   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
13348   (let ((method (gnus-find-method-for-group group)))
13349     (if (not (gnus-check-backend-function 'request-type method))
13350         'unknown
13351       (funcall (gnus-get-function method 'request-type)
13352                (gnus-group-real-name group) article))))
13353
13354 (defun gnus-request-article (article group &optional buffer)
13355   "Request the ARTICLE in GROUP.
13356 ARTICLE can either be an article number or an article Message-ID.
13357 If BUFFER, insert the article in that group."
13358   (let ((method (gnus-find-method-for-group group)))
13359     (funcall (gnus-get-function method 'request-article) 
13360              article (gnus-group-real-name group) (nth 1 method) buffer)))
13361
13362 (defun gnus-request-head (article group)
13363   "Request the head of ARTICLE in GROUP."
13364   (let ((method (gnus-find-method-for-group group)))
13365     (funcall (gnus-get-function method 'request-head) 
13366              article (gnus-group-real-name group) (nth 1 method))))
13367
13368 (defun gnus-request-body (article group)
13369   "Request the body of ARTICLE in GROUP."
13370   (let ((method (gnus-find-method-for-group group)))
13371     (funcall (gnus-get-function method 'request-body) 
13372              article (gnus-group-real-name group) (nth 1 method))))
13373
13374 (defun gnus-request-post (method)
13375   "Post the current buffer using METHOD."
13376   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
13377
13378 (defun gnus-request-scan (group method)
13379   "Request a SCAN being performed in GROUP from METHOD.
13380 If GROUP is nil, all groups on METHOD are scanned."
13381   (let ((method (if group (gnus-find-method-for-group group) method)))
13382     (funcall (gnus-get-function method 'request-scan) 
13383              (and group (gnus-group-real-name group)) (nth 1 method))))
13384
13385 (defun gnus-request-update-info (info method)
13386   "Request that METHOD update INFO."
13387   (when (gnus-check-backend-function 'request-update-info method)
13388     (funcall (gnus-get-function method 'request-update-info) 
13389              (gnus-group-real-name (gnus-info-group info)) 
13390              info (nth 1 method))))
13391
13392 (defun gnus-request-expire-articles (articles group &optional force)
13393   (let ((method (gnus-find-method-for-group group)))
13394     (funcall (gnus-get-function method 'request-expire-articles) 
13395              articles (gnus-group-real-name group) (nth 1 method)
13396              force)))
13397
13398 (defun gnus-request-move-article 
13399   (article group server accept-function &optional last)
13400   (let ((method (gnus-find-method-for-group group)))
13401     (funcall (gnus-get-function method 'request-move-article) 
13402              article (gnus-group-real-name group) 
13403              (nth 1 method) accept-function last)))
13404
13405 (defun gnus-request-accept-article (group &optional last)
13406   (let ((func (if (symbolp group) group
13407                 (car (gnus-find-method-for-group group)))))
13408     (funcall (intern (format "%s-request-accept-article" func))
13409              (if (stringp group) (gnus-group-real-name group) group)
13410              last)))
13411
13412 (defun gnus-request-replace-article (article group buffer)
13413   (let ((func (car (gnus-find-method-for-group group))))
13414     (funcall (intern (format "%s-request-replace-article" func))
13415              article (gnus-group-real-name group) buffer)))
13416
13417 (defun gnus-request-create-group (group)
13418   (let ((method (gnus-find-method-for-group group)))
13419     (funcall (gnus-get-function method 'request-create-group) 
13420              (gnus-group-real-name group) (nth 1 method))))
13421
13422 (defun gnus-request-delete-group (group &optional force)
13423   (let ((method (gnus-find-method-for-group group)))
13424     (funcall (gnus-get-function method 'request-delete-group) 
13425              (gnus-group-real-name group) force (nth 1 method))))
13426
13427 (defun gnus-request-rename-group (group new-name)
13428   (let ((method (gnus-find-method-for-group group)))
13429     (funcall (gnus-get-function method 'request-rename-group) 
13430              (gnus-group-real-name group) 
13431              (gnus-group-real-name new-name) (nth 1 method))))
13432
13433 (defun gnus-post-method (group force-group-method)
13434   "Return the posting method based on GROUP and FORCE."
13435   (let ((group-method (if (stringp group)
13436                           (gnus-find-method-for-group group)
13437                         group)))
13438     (cond 
13439      ;; If the group-method is nil (which shouldn't happen) we use 
13440      ;; the default method.
13441      ((null group-method)
13442       gnus-select-method)
13443      ;; We want this group's method.
13444      (force-group-method group-method)
13445      ;; Override normal method.
13446      ((and gnus-post-method
13447            (or (gnus-method-option-p group-method 'post)
13448                (gnus-method-option-p group-method 'post-mail)))
13449       gnus-post-method)
13450      ;; Perhaps this is a mail group?
13451      ((and (not (gnus-member-of-valid 'post group))
13452            (not (gnus-method-option-p group-method 'post-mail)))
13453       group-method)
13454      ;; Use the normal select method.
13455      (t gnus-select-method))))
13456
13457 (defun gnus-member-of-valid (symbol group)
13458   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
13459   (memq symbol (assoc
13460                 (symbol-name (car (gnus-find-method-for-group group)))
13461                 gnus-valid-select-methods)))
13462
13463 (defun gnus-method-option-p (method option)
13464   "Return non-nil if select METHOD has OPTION as a parameter."
13465   (memq option (assoc (format "%s" (car method))
13466                       gnus-valid-select-methods)))
13467
13468 (defmacro gnus-server-equal (ss1 ss2)
13469   "Say whether two servers are equal."
13470   `(let ((s1 ,ss1)
13471          (s2 ,ss2))
13472      (or (equal s1 s2)
13473          (and (= (length s1) (length s2))
13474               (progn
13475                 (while (and s1 (member (car s1) s2))
13476                   (setq s1 (cdr s1)))
13477                 (null s1))))))
13478
13479 (defun gnus-server-extend-method (group method)
13480   ;; This function "extends" a virtual server.  If the server is
13481   ;; "hello", and the select method is ("hello" (my-var "something")) 
13482   ;; in the group "alt.alt", this will result in a new virtual server
13483   ;; called "helly+alt.alt".
13484   (let ((entry
13485          (gnus-copy-sequence 
13486           (if (equal (car method) "native") gnus-select-method
13487             (cdr (assoc (car method) gnus-server-alist))))))
13488     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
13489     (nconc entry (cdr method))))
13490
13491 (defun gnus-find-method-for-group (group &optional info)
13492   "Find the select method that GROUP uses."
13493   (or gnus-override-method
13494       (and (not group)
13495            gnus-select-method)
13496       (let ((info (or info (gnus-get-info group)))
13497             method)
13498         (if (or (not info)
13499                 (not (setq method (gnus-info-method info))))
13500             (setq method gnus-select-method)
13501           (setq method
13502                 (cond ((stringp method)
13503                        (gnus-server-to-method method))
13504                       ((stringp (car method))
13505                        (gnus-server-extend-method group method))
13506                       (t
13507                        method))))
13508         (gnus-server-add-address method))))
13509
13510 (defun gnus-check-backend-function (func group)
13511   "Check whether GROUP supports function FUNC."
13512   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
13513                   group)))
13514     (fboundp (intern (format "%s-%s" method func)))))
13515
13516 (defun gnus-methods-using (feature)
13517   "Find all methods that have FEATURE."
13518   (let ((valids gnus-valid-select-methods)
13519         outs)
13520     (while valids
13521       (if (memq feature (car valids)) 
13522           (setq outs (cons (car valids) outs)))
13523       (setq valids (cdr valids)))
13524     outs))
13525
13526 ;;; 
13527 ;;; Active & Newsrc File Handling
13528 ;;;
13529
13530 ;; Newsrc related functions.
13531 ;; Gnus internal format of gnus-newsrc-alist:
13532 ;; (("alt.general" 3 (1 . 1))
13533 ;;  ("alt.misc"    3 ((1 . 10) (12 . 15)))
13534 ;;  ("alt.test"    7 (1 . 99) (45 57 93)) ...)
13535 ;; The first item is the group name; the second is the subscription
13536 ;; level; the third is either a range of a list of ranges of read
13537 ;; articles, the optional fourth element is a list of marked articles,
13538 ;; the optional fifth element is the select method.
13539 ;;
13540 ;; Gnus internal format of gnus-newsrc-hashtb:
13541 ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...)
13542 ;; This is the entry for "alt.misc". The first element is the number
13543 ;; of unread articles in "alt.misc". The cdr of this entry is the
13544 ;; element *before* "alt.misc" in gnus-newsrc-alist, which makes is
13545 ;; trivial to remove or add new elements into gnus-newsrc-alist
13546 ;; without scanning the entire list.  So, to get the actual information
13547 ;; of "alt.misc", you'd say something like 
13548 ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb))
13549 ;;
13550 ;; Gnus internal format of gnus-active-hashtb:
13551 ;; ((1 . 1))
13552 ;;  (5 . 10))
13553 ;;  (67 . 99)) ...)
13554 ;; The only element in each entry in this hash table is a range of
13555 ;; (possibly) available articles. (Articles in this range may have
13556 ;; been expired or canceled.)
13557 ;;
13558 ;; Gnus internal format of gnus-killed-list and gnus-zombie-list:
13559 ;; ("alt.misc" "alt.test" "alt.general" ...)
13560
13561 (defun gnus-setup-news (&optional rawfile level)
13562   "Setup news information.
13563 If RAWFILE is non-nil, the .newsrc file will also be read.
13564 If LEVEL is non-nil, the news will be set up at level LEVEL."
13565   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
13566     ;; Clear some variables to re-initialize news information.
13567     (if init (setq gnus-newsrc-alist nil 
13568                    gnus-active-hashtb nil))
13569
13570     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
13571     (if init (gnus-read-newsrc-file rawfile))
13572
13573     ;; If we don't read the complete active file, we fill in the
13574     ;; hashtb here. 
13575     (if (or (null gnus-read-active-file)
13576             (eq gnus-read-active-file 'some))
13577         (gnus-update-active-hashtb-from-killed))
13578
13579     ;; Read the active file and create `gnus-active-hashtb'.
13580     ;; If `gnus-read-active-file' is nil, then we just create an empty
13581     ;; hash table.  The partial filling out of the hash table will be
13582     ;; done in `gnus-get-unread-articles'.
13583     (and gnus-read-active-file 
13584          (not level)
13585          (gnus-read-active-file))
13586
13587     (or gnus-active-hashtb
13588         (setq gnus-active-hashtb (make-vector 4095 0)))
13589
13590     ;; Initialize the cache.
13591     (when gnus-use-cache
13592       (gnus-cache-open))
13593
13594     ;; Possibly eval the dribble file.
13595     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
13596
13597     (gnus-update-format-specifications)
13598
13599     ;; Find new newsgroups and treat them.
13600     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
13601              (gnus-check-server gnus-select-method))
13602         (gnus-find-new-newsgroups))
13603
13604     ;; Find the number of unread articles in each non-dead group.
13605     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
13606       (gnus-get-unread-articles (or level (1+ gnus-level-subscribed))))
13607
13608     (if (and init gnus-check-bogus-newsgroups 
13609              gnus-read-active-file (not level)
13610              (gnus-server-opened gnus-select-method))
13611         (gnus-check-bogus-newsgroups))))
13612
13613 (defun gnus-find-new-newsgroups ()
13614   "Search for new newsgroups and add them.
13615 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
13616 The `-n' option line from .newsrc is respected."
13617   (interactive)
13618   (or (gnus-check-first-time-used)
13619       (if (or (consp gnus-check-new-newsgroups)
13620               (eq gnus-check-new-newsgroups 'ask-server))
13621           (gnus-ask-server-for-new-groups)
13622         (let ((groups 0)
13623               group new-newsgroups)
13624           (gnus-message 5 "Looking for new newsgroups...")
13625           (or gnus-have-read-active-file (gnus-read-active-file))
13626           (setq gnus-newsrc-last-checked-date (current-time-string))
13627           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
13628           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
13629           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
13630           (mapatoms
13631            (lambda (sym)
13632              (if (or (null (setq group (symbol-name sym)))
13633                      (not (boundp sym))
13634                      (null (symbol-value sym))
13635                      (gnus-gethash group gnus-killed-hashtb)
13636                      (gnus-gethash group gnus-newsrc-hashtb))
13637                  ()
13638                (let ((do-sub (gnus-matches-options-n group)))
13639                  (cond 
13640                   ((eq do-sub 'subscribe)
13641                    (setq groups (1+ groups))
13642                    (gnus-sethash group group gnus-killed-hashtb)
13643                    (funcall gnus-subscribe-options-newsgroup-method group))
13644                   ((eq do-sub 'ignore)
13645                    nil)
13646                   (t
13647                    (setq groups (1+ groups))
13648                    (gnus-sethash group group gnus-killed-hashtb)
13649                    (if gnus-subscribe-hierarchical-interactive
13650                        (setq new-newsgroups (cons group new-newsgroups))
13651                      (funcall gnus-subscribe-newsgroup-method group)))))))
13652            gnus-active-hashtb)
13653           (if new-newsgroups 
13654               (gnus-subscribe-hierarchical-interactive new-newsgroups))
13655           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
13656           (if (> groups 0)
13657               (gnus-message 6 "%d new newsgroup%s arrived." 
13658                             groups (if (> groups 1) "s have" " has"))
13659             (gnus-message 6 "No new newsgroups."))))))
13660
13661 (defun gnus-matches-options-n (group)
13662   ;; Returns `subscribe' if the group is to be uncoditionally
13663   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
13664   ;; no match for the group.
13665
13666   ;; First we check the two user variables.
13667   (cond
13668    ((and gnus-options-subscribe
13669          (string-match gnus-options-subscribe group))
13670     'subscribe)
13671    ((and gnus-auto-subscribed-groups 
13672          (string-match gnus-auto-subscribed-groups group))
13673     'subscribe)
13674    ((and gnus-options-not-subscribe
13675          (string-match gnus-options-not-subscribe group))
13676     'ignore)
13677    ;; Then we go through the list that was retrieved from the .newsrc
13678    ;; file.  This list has elements on the form 
13679    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
13680    ;; is in the reverse order of the options line) is returned.
13681    (t
13682     (let ((regs gnus-newsrc-options-n))
13683       (while (and regs
13684                   (not (string-match (car (car regs)) group)))
13685         (setq regs (cdr regs)))
13686       (and regs (cdr (car regs)))))))
13687
13688 (defun gnus-ask-server-for-new-groups ()
13689   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
13690          (methods (cons gnus-select-method 
13691                         (append
13692                          (and (consp gnus-check-new-newsgroups)
13693                               gnus-check-new-newsgroups)
13694                          gnus-secondary-select-methods)))
13695          (groups 0)
13696          (new-date (current-time-string))
13697          (hashtb (gnus-make-hashtable 100))
13698          group new-newsgroups got-new method)
13699     ;; Go through both primary and secondary select methods and
13700     ;; request new newsgroups.  
13701     (while methods
13702       (setq method (gnus-server-get-method nil (car methods)))
13703       (and (gnus-check-server method)
13704            (gnus-request-newgroups date method)
13705            (save-excursion
13706              (setq got-new t)
13707              (set-buffer nntp-server-buffer)
13708              ;; Enter all the new groups in a hashtable.
13709              (gnus-active-to-gnus-format method hashtb 'ignore)))
13710       (setq methods (cdr methods)))
13711     (and got-new (setq gnus-newsrc-last-checked-date new-date))
13712     ;; Now all new groups from all select methods are in `hashtb'.
13713     (mapatoms
13714      (lambda (group-sym)
13715        (setq group (symbol-name group-sym))
13716        (if (or (null group)
13717                (null (symbol-value group-sym))
13718                (gnus-gethash group gnus-newsrc-hashtb)
13719                (member group gnus-zombie-list)
13720                (member group gnus-killed-list))
13721            ;; The group is already known.
13722            ()
13723          (and (symbol-value group-sym)
13724               (gnus-set-active group (symbol-value group-sym)))
13725          (let ((do-sub (gnus-matches-options-n group)))
13726            (cond ((eq do-sub 'subscribe)
13727                   (setq groups (1+ groups))
13728                   (gnus-sethash group group gnus-killed-hashtb)
13729                   (funcall 
13730                    gnus-subscribe-options-newsgroup-method group))
13731                  ((eq do-sub 'ignore)
13732                   nil)
13733                  (t
13734                   (setq groups (1+ groups))
13735                   (gnus-sethash group group gnus-killed-hashtb)
13736                   (if gnus-subscribe-hierarchical-interactive
13737                       (setq new-newsgroups (cons group new-newsgroups))
13738                     (funcall gnus-subscribe-newsgroup-method group)))))))
13739      hashtb)
13740     (if new-newsgroups 
13741         (gnus-subscribe-hierarchical-interactive new-newsgroups))
13742     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
13743     (if (> groups 0)
13744         (gnus-message 6 "%d new newsgroup%s arrived." 
13745                       groups (if (> groups 1) "s have" " has")))
13746     got-new))
13747
13748 (defun gnus-check-first-time-used ()
13749   (if (or (> (length gnus-newsrc-alist) 1)
13750           (file-exists-p gnus-startup-file)
13751           (file-exists-p (concat gnus-startup-file ".el"))
13752           (file-exists-p (concat gnus-startup-file ".eld")))
13753       nil
13754     (gnus-message 6 "First time user; subscribing you to default groups")
13755     (or gnus-have-read-active-file (gnus-read-active-file))
13756     (setq gnus-newsrc-last-checked-date (current-time-string))
13757     (let ((groups gnus-default-subscribed-newsgroups)
13758           group)
13759       (if (eq groups t)
13760           nil
13761         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
13762         (mapatoms
13763          (lambda (sym)
13764            (if (null (setq group (symbol-name sym)))
13765                ()
13766              (let ((do-sub (gnus-matches-options-n group)))
13767                (cond 
13768                 ((eq do-sub 'subscribe)
13769                  (gnus-sethash group group gnus-killed-hashtb)
13770                  (funcall gnus-subscribe-options-newsgroup-method group))
13771                 ((eq do-sub 'ignore)
13772                  nil)
13773                 (t
13774                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
13775          gnus-active-hashtb)
13776         (while groups
13777           (if (gnus-active (car groups))
13778               (gnus-group-change-level 
13779                (car groups) gnus-level-default-subscribed gnus-level-killed))
13780           (setq groups (cdr groups)))
13781         (gnus-group-make-help-group)
13782         (and gnus-novice-user
13783              (gnus-message 7 "`A k' to list killed groups"))))))
13784
13785 (defun gnus-subscribe-group (group previous &optional method)
13786   (gnus-group-change-level 
13787    (if method
13788        (list t group gnus-level-default-subscribed nil nil method)
13789      group) 
13790    gnus-level-default-subscribed gnus-level-killed previous t))
13791
13792 ;; `gnus-group-change-level' is the fundamental function for changing
13793 ;; subscription levels of newsgroups.  This might mean just changing
13794 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
13795 ;; again, which subscribes/unsubscribes a group, which is equally
13796 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
13797 ;; from 8-9 to 1-7 means that you remove the group from the list of
13798 ;; killed (or zombie) groups and add them to the (kinda) subscribed
13799 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
13800 ;; which is trivial.
13801 ;; ENTRY can either be a string (newsgroup name) or a list (if
13802 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
13803 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
13804 ;; entries. 
13805 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
13806 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
13807 ;; after. 
13808 (defun gnus-group-change-level (entry level &optional oldlevel
13809                                       previous fromkilled)
13810   (let (group info active num)
13811     ;; Glean what info we can from the arguments
13812     (if (consp entry)
13813         (if fromkilled (setq group (nth 1 entry))
13814           (setq group (car (nth 2 entry))))
13815       (setq group entry))
13816     (if (and (stringp entry)
13817              oldlevel 
13818              (< oldlevel gnus-level-zombie))
13819         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
13820     (if (and (not oldlevel)
13821              (consp entry))
13822         (setq oldlevel (car (cdr (nth 2 entry)))))
13823     (if (stringp previous)
13824         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
13825
13826     (if (and (>= oldlevel gnus-level-zombie)
13827              (gnus-gethash group gnus-newsrc-hashtb))
13828         ;; We are trying to subscribe a group that is already
13829         ;; subscribed. 
13830         ()                              ; Do nothing. 
13831
13832       (or (gnus-ephemeral-group-p group)
13833           (gnus-dribble-enter
13834            (format "(gnus-group-change-level %S %S %S %S %S)" 
13835                    group level oldlevel (car (nth 2 previous)) fromkilled)))
13836     
13837       ;; Then we remove the newgroup from any old structures, if needed.
13838       ;; If the group was killed, we remove it from the killed or zombie
13839       ;; list.  If not, and it is in fact going to be killed, we remove
13840       ;; it from the newsrc hash table and assoc.
13841       (cond ((>= oldlevel gnus-level-zombie)
13842              (if (= oldlevel gnus-level-zombie)
13843                  (setq gnus-zombie-list (delete group gnus-zombie-list))
13844                (setq gnus-killed-list (delete group gnus-killed-list))))
13845             (t
13846              (if (and (>= level gnus-level-zombie)
13847                       entry)
13848                  (progn
13849                    (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
13850                    (if (nth 3 entry)
13851                        (setcdr (gnus-gethash (car (nth 3 entry))
13852                                              gnus-newsrc-hashtb)
13853                                (cdr entry)))
13854                    (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
13855
13856       ;; Finally we enter (if needed) the list where it is supposed to
13857       ;; go, and change the subscription level.  If it is to be killed,
13858       ;; we enter it into the killed or zombie list.
13859       (cond ((>= level gnus-level-zombie)
13860              ;; Remove from the hash table.
13861              (gnus-sethash group nil gnus-newsrc-hashtb)
13862              ;; We do not enter foreign groups into the list of dead
13863              ;; groups.  
13864              (unless (gnus-group-foreign-p group)
13865                (if (= level gnus-level-zombie)
13866                    (setq gnus-zombie-list (cons group gnus-zombie-list))
13867                  (setq gnus-killed-list (cons group gnus-killed-list)))))
13868             (t
13869              ;; If the list is to be entered into the newsrc assoc, and
13870              ;; it was killed, we have to create an entry in the newsrc
13871              ;; hashtb format and fix the pointers in the newsrc assoc.
13872              (if (>= oldlevel gnus-level-zombie)
13873                  (progn
13874                    (if (listp entry)
13875                        (progn
13876                          (setq info (cdr entry))
13877                          (setq num (car entry)))
13878                      (setq active (gnus-active group))
13879                      (setq num 
13880                            (if active (- (1+ (cdr active)) (car active)) t))
13881                      ;; Check whether the group is foreign.  If so, the
13882                      ;; foreign select method has to be entered into the
13883                      ;; info. 
13884                      (let ((method (gnus-group-method-name group)))
13885                        (if (eq method gnus-select-method)
13886                            (setq info (list group level nil))
13887                          (setq info (list group level nil nil method)))))
13888                    (or previous 
13889                        (setq previous 
13890                              (let ((p gnus-newsrc-alist))
13891                                (while (cdr (cdr p))
13892                                  (setq p (cdr p)))
13893                                p)))
13894                    (setq entry (cons info (cdr (cdr previous))))
13895                    (if (cdr previous)
13896                        (progn
13897                          (setcdr (cdr previous) entry)
13898                          (gnus-sethash group (cons num (cdr previous)) 
13899                                        gnus-newsrc-hashtb))
13900                      (setcdr previous entry)
13901                      (gnus-sethash group (cons num previous)
13902                                    gnus-newsrc-hashtb))
13903                    (if (cdr entry)
13904                        (setcdr (gnus-gethash (car (car (cdr entry)))
13905                                              gnus-newsrc-hashtb)
13906                                entry)))
13907                ;; It was alive, and it is going to stay alive, so we
13908                ;; just change the level and don't change any pointers or
13909                ;; hash table entries.
13910                (setcar (cdr (car (cdr (cdr entry)))) level)))))))
13911
13912 (defun gnus-kill-newsgroup (newsgroup)
13913   "Obsolete function.  Kills a newsgroup."
13914   (gnus-group-change-level
13915    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
13916
13917 (defun gnus-check-bogus-newsgroups (&optional confirm)
13918   "Remove bogus newsgroups.
13919 If CONFIRM is non-nil, the user has to confirm the deletion of every
13920 newsgroup." 
13921   (let ((newsrc (cdr gnus-newsrc-alist))
13922         bogus group entry info)
13923     (gnus-message 5 "Checking bogus newsgroups...")
13924     (unless gnus-have-read-active-file 
13925       (gnus-read-active-file))
13926     (when (member gnus-select-method gnus-have-read-active-file)
13927       ;; Find all bogus newsgroup that are subscribed.
13928       (while newsrc
13929         (setq info (pop newsrc)
13930               group (gnus-info-group info))
13931         (unless (or (gnus-active group) ; Active
13932                     (gnus-info-method info) ; Foreign
13933                     (and confirm
13934                          (not (gnus-y-or-n-p
13935                                (format "Remove bogus newsgroup: %s " group)))))
13936           ;; Found a bogus newsgroup.
13937           (push group bogus)))
13938       ;; Remove all bogus subscribed groups by first killing them, and
13939       ;; then removing them from the list of killed groups.
13940       (while bogus
13941         (when (setq entry (gnus-gethash (setq group (pop bogus))
13942                                         gnus-newsrc-hashtb))
13943           (gnus-group-change-level entry gnus-level-killed)
13944           (setq gnus-killed-list (delete group gnus-killed-list))))
13945       ;; Then we remove all bogus groups from the list of killed and
13946       ;; zombie groups.  They are are removed without confirmation.
13947       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
13948             killed)
13949         (while dead-lists
13950           (setq killed (symbol-value (car dead-lists)))
13951           (while killed
13952             (unless (gnus-active (setq group (pop killed)))
13953               ;; The group is bogus.
13954               ;; !!!Slow as hell.
13955               (set (car dead-lists)
13956                    (delete group (symbol-value (car dead-lists))))))
13957           (setq dead-lists (cdr dead-lists))))
13958       (gnus-message 5 "Checking bogus newsgroups...done"))))
13959
13960 (defun gnus-check-duplicate-killed-groups ()
13961   "Remove duplicates from the list of killed groups."
13962   (interactive)
13963   (let ((killed gnus-killed-list))
13964     (while killed
13965       (gnus-message 9 "%d" (length killed))
13966       (setcdr killed (delete (car killed) (cdr killed)))
13967       (setq killed (cdr killed)))))
13968
13969 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
13970 ;; and compute how many unread articles there are in each group.
13971 (defun gnus-get-unread-articles (&optional level) 
13972   (let* ((newsrc (cdr gnus-newsrc-alist))
13973          (level (or level (1+ gnus-level-subscribed)))
13974          (foreign-level
13975           (min 
13976            (cond ((and gnus-activate-foreign-newsgroups 
13977                        (not (numberp gnus-activate-foreign-newsgroups)))
13978                   (1+ gnus-level-subscribed))
13979                  ((numberp gnus-activate-foreign-newsgroups)
13980                   gnus-activate-foreign-newsgroups)
13981                  (t 0))
13982            level))
13983          (update
13984           (fboundp (intern (format "%s-request-update-info"
13985                                    (car gnus-select-method)))))
13986          info group active virtuals method fmethod)
13987     (gnus-message 5 "Checking new news...")
13988
13989     (while newsrc
13990       (setq info (car newsrc)
13991             group (gnus-info-group info)
13992             active (gnus-active group))
13993
13994       ;; Check newsgroups.  If the user doesn't want to check them, or
13995       ;; they can't be checked (for instance, if the news server can't
13996       ;; be reached) we just set the number of unread articles in this
13997       ;; newsgroup to t.  This means that Gnus thinks that there are
13998       ;; unread articles, but it has no idea how many.
13999       (if (and (setq method (gnus-info-method info))
14000                (not (gnus-server-equal
14001                      gnus-select-method
14002                      (prog1
14003                          (setq fmethod (gnus-server-get-method nil method))
14004                        ;; We do this here because it would be awkward
14005                        ;; to do it anywhere else.  Hell, it's pretty
14006                        ;; awkward here as well, but at least it's
14007                        ;; reasonably efficient. 
14008                        (and (<= (gnus-info-level info) foreign-level)
14009                             (gnus-request-update-info info method)))))
14010                (not (gnus-secondary-method-p method)))
14011           ;; These groups are foreign.  Check the level.
14012           (if (<= (gnus-info-level info) foreign-level)
14013               (setq active (gnus-activate-group (gnus-info-group info) 'scan)))
14014
14015         ;; These groups are native or secondary. 
14016         (if (<= (gnus-info-level info) level)
14017             (progn
14018               (if (and update (not method))
14019                   (progn
14020                     ;; Allow updating of native groups as well, even
14021                     ;; though that's pretty unlikely.
14022                     (gnus-request-update-info info gnus-select-method)
14023                     (setq active (gnus-activate-group 
14024                                   (gnus-info-group info) 'scan)))
14025                 (or gnus-read-active-file
14026                     (setq active (gnus-activate-group 
14027                                   (gnus-info-group info) 'scan)))))))
14028       
14029       (if active
14030           (gnus-get-unread-articles-in-group info active)
14031         ;; The group couldn't be reached, so we nix out the number of
14032         ;; unread articles and stuff.
14033         (gnus-set-active group nil)
14034         (setcar (gnus-gethash group gnus-newsrc-hashtb) t))
14035       
14036       (setq newsrc (cdr newsrc)))
14037
14038     (gnus-message 5 "Checking new news...done")))
14039
14040 ;; Create a hash table out of the newsrc alist.  The `car's of the
14041 ;; alist elements are used as keys.
14042 (defun gnus-make-hashtable-from-newsrc-alist ()
14043   (let ((alist gnus-newsrc-alist)
14044         (ohashtb gnus-newsrc-hashtb)
14045         prev)
14046     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
14047     (setq alist 
14048           (setq prev (setq gnus-newsrc-alist 
14049                            (if (equal (car (car gnus-newsrc-alist))
14050                                       "dummy.group")
14051                                gnus-newsrc-alist
14052                              (cons (list "dummy.group" 0 nil) alist)))))
14053     (while alist
14054       (gnus-sethash 
14055        (car (car alist)) 
14056        (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb))) 
14057              prev)
14058        gnus-newsrc-hashtb)
14059       (setq prev alist
14060             alist (cdr alist)))))
14061
14062 (defun gnus-make-hashtable-from-killed ()
14063   "Create a hash table from the killed and zombie lists."
14064   (let ((lists '(gnus-killed-list gnus-zombie-list))
14065         list)
14066     (setq gnus-killed-hashtb 
14067           (gnus-make-hashtable 
14068            (+ (length gnus-killed-list) (length gnus-zombie-list))))
14069     (while lists
14070       (setq list (symbol-value (car lists)))
14071       (setq lists (cdr lists))
14072       (while list
14073         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
14074         (setq list (cdr list))))))
14075
14076 (defun gnus-get-unread-articles-in-group (info active)
14077   (let* ((range (gnus-info-read info))
14078          (num 0)
14079          (marked (gnus-info-marks info)))
14080     ;; If a cache is present, we may have to alter the active info.
14081     (and gnus-use-cache
14082          (gnus-cache-possibly-alter-active (gnus-info-group info) active))
14083     ;; Modify the list of read articles according to what articles 
14084     ;; are available; then tally the unread articles and add the
14085     ;; number to the group hash table entry.
14086     (cond 
14087      ((zerop (cdr active))
14088       (setq num 0))
14089      ((not range)
14090       (setq num (- (1+ (cdr active)) (car active))))
14091      ((not (listp (cdr range)))
14092       ;; Fix a single (num . num) range according to the
14093       ;; active hash table.
14094       ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
14095       (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
14096       (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
14097       ;; Compute number of unread articles.
14098       (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
14099      (t
14100       ;; The read list is a list of ranges.  Fix them according to
14101       ;; the active hash table.
14102       ;; First peel off any elements that are below the lower
14103       ;; active limit. 
14104       (while (and (cdr range) 
14105                   (>= (car active) 
14106                       (or (and (atom (car (cdr range))) (car (cdr range)))
14107                           (car (car (cdr range))))))
14108         (if (numberp (car range))
14109             (setcar range 
14110                     (cons (car range) 
14111                           (or (and (numberp (car (cdr range)))
14112                                    (car (cdr range))) 
14113                               (cdr (car (cdr range))))))
14114           (setcdr (car range) 
14115                   (or (and (numberp (nth 1 range)) (nth 1 range))
14116                       (cdr (car (cdr range))))))
14117         (setcdr range (cdr (cdr range))))
14118       ;; Adjust the first element to be the same as the lower limit. 
14119       (if (and (not (atom (car range))) 
14120                (< (cdr (car range)) (car active)))
14121           (setcdr (car range) (1- (car active))))
14122       ;; Then we want to peel off any elements that are higher
14123       ;; than the upper active limit.  
14124       (let ((srange range))
14125         ;; Go past all legal elements.
14126         (while (and (cdr srange) 
14127                     (<= (or (and (atom (car (cdr srange)))
14128                                  (car (cdr srange)))
14129                             (car (car (cdr srange)))) (cdr active)))
14130           (setq srange (cdr srange)))
14131         (if (cdr srange)
14132             ;; Nuke all remaining illegal elements.
14133             (setcdr srange nil))
14134
14135         ;; Adjust the final element.
14136         (if (and (not (atom (car srange)))
14137                  (> (cdr (car srange)) (cdr active)))
14138             (setcdr (car srange) (cdr active))))
14139       ;; Compute the number of unread articles.
14140       (while range
14141         (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
14142                                     (cdr (car range))))
14143                             (or (and (atom (car range)) (car range))
14144                                 (car (car range))))))
14145         (setq range (cdr range)))
14146       (setq num (max 0 (- (cdr active) num)))))
14147     ;; Set the number of unread articles.
14148     (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)
14149     num))
14150
14151 (defun gnus-activate-group (group &optional scan)
14152   ;; Check whether a group has been activated or not.
14153   ;; If SCAN, request a scan of that group as well.
14154   (let ((method (gnus-find-method-for-group group))
14155         active)
14156     (and (gnus-check-server method)
14157          ;; We escape all bugs and quit here to make it possible to
14158          ;; continue if a group is so out-there that it reports bugs
14159          ;; and stuff.
14160          (progn
14161            (and scan
14162                 (gnus-check-backend-function 'request-scan (car method))
14163                 (gnus-request-scan group method))
14164            t)
14165          (condition-case ()
14166              (gnus-request-group group)
14167         ;   (error nil)
14168            (quit nil))
14169          (save-excursion
14170            (set-buffer nntp-server-buffer)
14171            (goto-char (point-min))
14172            ;; Parse the result we got from `gnus-request-group'.
14173            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
14174                 (progn
14175                   (goto-char (match-beginning 1))
14176                   (gnus-set-active 
14177                    group (setq active (cons (read (current-buffer))
14178                                             (read (current-buffer)))))
14179                   ;; Return the new active info.
14180                   active))))))
14181
14182 (defun gnus-update-read-articles (group unread)
14183   "Update the list of read and ticked articles in GROUP using the
14184 UNREAD and TICKED lists.
14185 Note: UNSELECTED has to be sorted over `<'.
14186 Returns whether the updating was successful."
14187   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
14188          (entry (gnus-gethash group gnus-newsrc-hashtb))
14189          (info (nth 2 entry))
14190          (marked (gnus-info-marks info))
14191          (prev 1)
14192          (unread (sort (copy-sequence unread) '<))
14193          read)
14194     (if (or (not info) (not active))
14195         ;; There is no info on this group if it was, in fact,
14196         ;; killed.  Gnus stores no information on killed groups, so
14197         ;; there's nothing to be done. 
14198         ;; One could store the information somewhere temporarily,
14199         ;; perhaps...  Hmmm... 
14200         ()
14201       ;; Remove any negative articles numbers.
14202       (while (and unread (< (car unread) 0))
14203         (setq unread (cdr unread)))
14204       ;; Remove any expired article numbers
14205       (while (and unread (< (car unread) (car active)))
14206         (setq unread (cdr unread)))
14207       ;; Compute the ranges of read articles by looking at the list of
14208       ;; unread articles.  
14209       (while unread
14210         (if (/= (car unread) prev)
14211             (setq read (cons (if (= prev (1- (car unread))) prev
14212                                (cons prev (1- (car unread)))) read)))
14213         (setq prev (1+ (car unread)))
14214         (setq unread (cdr unread)))
14215       (when (<= prev (cdr active))
14216         (setq read (cons (cons prev (cdr active)) read)))
14217       ;; Enter this list into the group info.
14218       (gnus-info-set-read 
14219        info (if (> (length read) 1) (nreverse read) read))
14220       ;; Set the number of unread articles in gnus-newsrc-hashtb.
14221       (gnus-get-unread-articles-in-group info (gnus-active group))
14222       t)))
14223
14224 (defun gnus-make-articles-unread (group articles)
14225   "Mark ARTICLES in GROUP as unread."
14226   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
14227                           (gnus-gethash (gnus-group-real-name group)
14228                                         gnus-newsrc-hashtb))))
14229          (ranges (gnus-info-read info))
14230          news article)
14231     (while articles
14232       (when (gnus-member-of-range 
14233              (setq article (pop articles)) ranges)
14234         (setq news (cons article news))))
14235     (when news
14236       (gnus-info-set-read 
14237        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
14238       (gnus-group-update-group group t))))
14239
14240 ;; Enter all dead groups into the hashtb.
14241 (defun gnus-update-active-hashtb-from-killed ()
14242   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
14243         (lists (list gnus-killed-list gnus-zombie-list))
14244         killed)
14245     (while lists
14246       (setq killed (car lists))
14247       (while killed
14248         (gnus-sethash (car killed) nil hashtb)
14249         (setq killed (cdr killed)))
14250       (setq lists (cdr lists)))))
14251
14252 ;; Get the active file(s) from the backend(s).
14253 (defun gnus-read-active-file ()
14254   (gnus-group-set-mode-line)
14255   (let ((methods (if (gnus-check-server gnus-select-method)
14256                      ;; The native server is available.
14257                      (cons gnus-select-method gnus-secondary-select-methods)
14258                    ;; The native server is down, so we just do the
14259                    ;; secondary ones.   
14260                    gnus-secondary-select-methods))
14261         list-type)
14262     (setq gnus-have-read-active-file nil)
14263     (save-excursion
14264       (set-buffer nntp-server-buffer)
14265       (while methods
14266         (let* ((method (gnus-server-get-method nil (car methods)))
14267                (where (nth 1 method))
14268                (mesg (format "Reading active file%s via %s..."
14269                              (if (and where (not (zerop (length where))))
14270                                  (concat " from " where) "")
14271                              (car method))))
14272           (gnus-message 5 mesg)
14273           (if (not (gnus-check-server method))
14274               ()
14275             ;; Request that the backend scan its incoming messages.
14276             (and (gnus-check-backend-function 'request-scan (car method))
14277                  (gnus-request-scan nil method))
14278             (cond 
14279              ((and (eq gnus-read-active-file 'some)
14280                    (gnus-check-backend-function 'retrieve-groups (car method)))
14281               (let ((newsrc (cdr gnus-newsrc-alist))
14282                     (gmethod (gnus-server-get-method nil method))
14283                     groups)
14284                 (while newsrc
14285                   (and (gnus-server-equal 
14286                         (gnus-find-method-for-group 
14287                          (car (car newsrc)) (car newsrc))
14288                         gmethod)
14289                        (setq groups (cons (gnus-group-real-name 
14290                                            (car (car newsrc))) groups)))
14291                   (setq newsrc (cdr newsrc)))
14292                 (gnus-check-server method)
14293                 (setq list-type (gnus-retrieve-groups groups method))
14294                 (cond 
14295                  ((not list-type)
14296                   (gnus-message 
14297                    1 "Cannot read partial active file from %s server." 
14298                    (car method))
14299                   (ding)
14300                   (sit-for 2))
14301                  ((eq list-type 'active)
14302                   (gnus-active-to-gnus-format method gnus-active-hashtb))
14303                  (t
14304                   (gnus-groups-to-gnus-format method gnus-active-hashtb)))))
14305              (t
14306               (if (not (gnus-request-list method))
14307                   (progn
14308                     (gnus-message 1 "Cannot read active file from %s server." 
14309                                   (car method))
14310                     (ding))
14311                 (gnus-active-to-gnus-format method)
14312                 ;; We mark this active file as read.
14313                 (setq gnus-have-read-active-file
14314                       (cons method gnus-have-read-active-file))
14315                 (gnus-message 5 "%sdone" mesg))))))
14316         (setq methods (cdr methods))))))
14317
14318 ;; Read an active file and place the results in `gnus-active-hashtb'.
14319 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
14320   (unless method
14321     (setq method gnus-select-method))
14322   (let ((cur (current-buffer))
14323         (hashtb (or hashtb 
14324                     (if (and gnus-active-hashtb 
14325                              (not (equal method gnus-select-method)))
14326                         gnus-active-hashtb
14327                       (setq gnus-active-hashtb
14328                             (if (equal method gnus-select-method)
14329                                 (gnus-make-hashtable 
14330                                  (count-lines (point-min) (point-max)))
14331                               (gnus-make-hashtable 4096))))))
14332         (flag-hashtb (gnus-make-hashtable 60)))
14333     ;; Delete unnecessary lines.
14334     (goto-char (point-min))
14335     (while (search-forward "\nto." nil t)
14336       (delete-region (1+ (match-beginning 0)) 
14337                      (progn (forward-line 1) (point))))
14338     (or (string= gnus-ignored-newsgroups "")
14339         (progn
14340           (goto-char (point-min))
14341           (delete-matching-lines gnus-ignored-newsgroups)))
14342     ;; Make the group names readable as a lisp expression even if they
14343     ;; contain special characters.
14344     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
14345     (goto-char (point-max))
14346     (while (re-search-backward "[][';?()#]" nil t)
14347       (insert ?\\))
14348     ;; If these are groups from a foreign select method, we insert the
14349     ;; group prefix in front of the group names. 
14350     (and method (not (gnus-server-equal
14351                       (gnus-server-get-method nil method)
14352                       (gnus-server-get-method nil gnus-select-method)))
14353          (let ((prefix (gnus-group-prefixed-name "" method)))
14354            (goto-char (point-min))
14355            (while (and (not (eobp))
14356                        (progn (insert prefix)
14357                               (zerop (forward-line 1)))))))
14358     ;; Store the active file in a hash table.
14359     (goto-char (point-min))
14360     (if (string-match "%[oO]" gnus-group-line-format)
14361         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
14362         ;; If we want information on moderated groups, we use this
14363         ;; loop...   
14364         (let* ((mod-hashtb (make-vector 7 0))
14365                (m (intern "m" mod-hashtb))
14366                group max min)
14367           (while (not (eobp))
14368             (condition-case nil
14369                 (progn
14370                   (narrow-to-region (point) (gnus-point-at-eol))
14371                   (setq group (let ((obarray hashtb)) (read cur)))
14372                   (if (and (numberp (setq max (read cur)))
14373                            (numberp (setq min (read cur)))
14374                            (progn 
14375                              (skip-chars-forward " \t")
14376                              (not
14377                               (or (= (following-char) ?=)
14378                                   (= (following-char) ?x)
14379                                   (= (following-char) ?j)))))
14380                       (set group (cons min max))
14381                     (set group nil))
14382                   ;; Enter moderated groups into a list.
14383                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
14384                       (setq gnus-moderated-list 
14385                             (cons (symbol-name group) gnus-moderated-list))))
14386               (error 
14387                (and group
14388                     (symbolp group)
14389                     (set group nil))))
14390             (widen)
14391             (forward-line 1)))
14392       ;; And if we do not care about moderation, we use this loop,
14393       ;; which is faster.
14394       (let (group max min)
14395         (while (not (eobp))
14396           (condition-case ()
14397               (progn
14398                 (narrow-to-region (point) (gnus-point-at-eol))
14399                 ;; group gets set to a symbol interned in the hash table
14400                 ;; (what a hack!!) - jwz
14401                 (setq group (let ((obarray hashtb)) (read cur)))
14402                 (if (and (numberp (setq max (read cur)))
14403                          (numberp (setq min (read cur)))
14404                          (progn 
14405                            (skip-chars-forward " \t")
14406                            (not
14407                             (or (= (following-char) ?=)
14408                                 (= (following-char) ?x)
14409                                 (= (following-char) ?j)))))
14410                     (set group (cons min max))
14411                   (set group nil)))
14412             (error 
14413              (progn 
14414                (and group
14415                     (symbolp group)
14416                     (set group nil))
14417                (or ignore-errors
14418                    (gnus-message 3 "Warning - illegal active: %s"
14419                                  (buffer-substring 
14420                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
14421           (widen)
14422           (forward-line 1))))))
14423
14424 (defun gnus-groups-to-gnus-format (method &optional hashtb)
14425   ;; Parse a "groups" active file.
14426   (let ((cur (current-buffer))
14427         (hashtb (or hashtb 
14428                     (if (and method gnus-active-hashtb)
14429                         gnus-active-hashtb
14430                       (setq gnus-active-hashtb
14431                             (gnus-make-hashtable 
14432                              (count-lines (point-min) (point-max)))))))
14433         (prefix (and method 
14434                      (not (gnus-server-equal
14435                            (gnus-server-get-method nil method)
14436                            (gnus-server-get-method nil gnus-select-method)))
14437                      (gnus-group-prefixed-name "" method))))
14438
14439     (goto-char (point-min))
14440     ;; We split this into to separate loops, one with the prefix
14441     ;; and one without to speed the reading up somewhat.
14442     (if prefix
14443         (let (min max opoint group)
14444           (while (not (eobp))
14445             (condition-case ()
14446                 (progn
14447                   (read cur) (read cur)
14448                   (setq min (read cur)
14449                         max (read cur)
14450                         opoint (point))
14451                   (skip-chars-forward " \t")
14452                   (insert prefix)
14453                   (goto-char opoint)
14454                   (set (let ((obarray hashtb)) (read cur)) 
14455                        (cons min max)))
14456               (error (and group (symbolp group) (set group nil))))
14457             (forward-line 1)))
14458       (let (min max group)
14459         (while (not (eobp))
14460           (condition-case ()
14461               (if (= (following-char) ?2)
14462                   (progn
14463                     (read cur) (read cur)
14464                     (setq min (read cur)
14465                           max (read cur))
14466                     (set (setq group (let ((obarray hashtb)) (read cur)))
14467                          (cons min max))))
14468             (error (and group (symbolp group) (set group nil))))
14469           (forward-line 1))))))
14470
14471 (defun gnus-read-newsrc-file (&optional force)
14472   "Read startup file.
14473 If FORCE is non-nil, the .newsrc file is read."
14474   ;; Reset variables that might be defined in the .newsrc.eld file.
14475   (let ((variables gnus-variable-list))
14476     (while variables
14477       (set (car variables) nil)
14478       (setq variables (cdr variables))))
14479   (let* ((newsrc-file gnus-current-startup-file)
14480          (quick-file (concat newsrc-file ".el")))
14481     (save-excursion
14482       ;; We always load the .newsrc.eld file.  If always contains
14483       ;; much information that can not be gotten from the .newsrc
14484       ;; file (ticked articles, killed groups, foreign methods, etc.)
14485       (gnus-read-newsrc-el-file quick-file)
14486  
14487       (if (or force
14488               (and (file-newer-than-file-p newsrc-file quick-file)
14489                    (file-newer-than-file-p newsrc-file 
14490                                            (concat quick-file "d")))
14491               (not gnus-newsrc-alist))
14492           ;; We read the .newsrc file.  Note that if there if a
14493           ;; .newsrc.eld file exists, it has already been read, and
14494           ;; the `gnus-newsrc-hashtb' has been created.  While reading
14495           ;; the .newsrc file, Gnus will only use the information it
14496           ;; can find there for changing the data already read -
14497           ;; ie. reading the .newsrc file will not trash the data
14498           ;; already read (except for read articles).
14499           (save-excursion
14500             (gnus-message 5 "Reading %s..." newsrc-file)
14501             (set-buffer (find-file-noselect newsrc-file))
14502             (buffer-disable-undo (current-buffer))
14503             (gnus-newsrc-to-gnus-format)
14504             (kill-buffer (current-buffer))
14505             (gnus-message 5 "Reading %s...done" newsrc-file)))
14506
14507       ;; Read any slave files.
14508       (or gnus-slave
14509           (gnus-master-read-slave-newsrc)))))
14510
14511 (defun gnus-read-newsrc-el-file (file)
14512   (let ((ding-file (concat file "d")))
14513     ;; We always, always read the .eld file.
14514     (gnus-message 5 "Reading %s..." ding-file)
14515     (let (gnus-newsrc-assoc)
14516       (condition-case nil
14517           (load ding-file t t t)
14518         (error
14519          (gnus-message 1 "Error in %s" ding-file)
14520          (ding)))
14521       (when gnus-newsrc-assoc 
14522         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
14523     (gnus-make-hashtable-from-newsrc-alist)
14524     (when (file-newer-than-file-p file ding-file)
14525       ;; Old format quick file
14526       (gnus-message 5 "Reading %s..." file)
14527       ;; The .el file is newer than the .eld file, so we read that one
14528       ;; as well. 
14529       (gnus-read-old-newsrc-el-file file))))
14530
14531 ;; Parse the old-style quick startup file
14532 (defun gnus-read-old-newsrc-el-file (file)
14533   (let (newsrc killed marked group m)
14534     (prog1
14535         (let ((gnus-killed-assoc nil)
14536               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
14537           (prog1
14538               (condition-case nil
14539                   (load file t t t)
14540                 (error nil))
14541             (setq newsrc gnus-newsrc-assoc
14542                   killed gnus-killed-assoc
14543                   marked gnus-marked-assoc)))
14544       (setq gnus-newsrc-alist nil)
14545       (while newsrc
14546         (setq group (car newsrc))
14547         (let ((info (gnus-get-info (car group))))
14548           (if info
14549               (progn
14550                 (gnus-info-set-read info (cdr (cdr group)))
14551                 (gnus-info-set-level
14552                  info (if (nth 1 group) gnus-level-default-subscribed 
14553                         gnus-level-default-unsubscribed))
14554                 (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
14555             (setq gnus-newsrc-alist
14556                   (cons 
14557                    (setq info
14558                          (list (car group)
14559                                (if (nth 1 group) gnus-level-default-subscribed
14560                                  gnus-level-default-unsubscribed) 
14561                                (cdr (cdr group))))
14562                    gnus-newsrc-alist)))
14563           (if (setq m (assoc (car group) marked))
14564               (gnus-info-set-marks 
14565                info (cons (list (cons 'tick (gnus-compress-sequence
14566                                              (sort (cdr m) '<) t)))
14567                           nil))))
14568         (setq newsrc (cdr newsrc)))
14569       (setq newsrc killed)
14570       (while newsrc
14571         (setcar newsrc (car (car newsrc)))
14572         (setq newsrc (cdr newsrc)))
14573       (setq gnus-killed-list killed))
14574     ;; The .el file version of this variable does not begin with
14575     ;; "options", while the .eld version does, so we just add it if it
14576     ;; isn't there.
14577     (and
14578      gnus-newsrc-options 
14579      (progn
14580        (and (not (string-match "^ *options" gnus-newsrc-options))
14581             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
14582        (and (not (string-match "\n$" gnus-newsrc-options))
14583             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
14584        ;; Finally, if we read some options lines, we parse them.
14585        (or (string= gnus-newsrc-options "")
14586            (gnus-newsrc-parse-options gnus-newsrc-options))))
14587
14588     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
14589     (gnus-make-hashtable-from-newsrc-alist)))
14590       
14591 (defun gnus-make-newsrc-file (file)
14592   "Make server dependent file name by catenating FILE and server host name."
14593   (let* ((file (expand-file-name file nil))
14594          (real-file (concat file "-" (nth 1 gnus-select-method))))
14595     (if (or (file-exists-p real-file)
14596             (file-exists-p (concat real-file ".el"))
14597             (file-exists-p (concat real-file ".eld")))
14598         real-file file)))
14599
14600 (defun gnus-newsrc-to-gnus-format ()
14601   (setq gnus-newsrc-options "")
14602   (setq gnus-newsrc-options-n nil)
14603
14604   (or gnus-active-hashtb
14605       (setq gnus-active-hashtb (make-vector 4095 0)))
14606   (let ((buf (current-buffer))
14607         (already-read (> (length gnus-newsrc-alist) 1))
14608         group subscribed options-symbol newsrc Options-symbol
14609         symbol reads num1)
14610     (goto-char (point-min))
14611     ;; We intern the symbol `options' in the active hashtb so that we
14612     ;; can `eq' against it later.
14613     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
14614     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
14615   
14616     (while (not (eobp))
14617       ;; We first read the first word on the line by narrowing and
14618       ;; then reading into `gnus-active-hashtb'.  Most groups will
14619       ;; already exist in that hashtb, so this will save some string
14620       ;; space.
14621       (narrow-to-region
14622        (point)
14623        (progn (skip-chars-forward "^ \t!:\n") (point)))
14624       (goto-char (point-min))
14625       (setq symbol 
14626             (and (/= (point-min) (point-max))
14627                  (let ((obarray gnus-active-hashtb)) (read buf))))
14628       (widen)
14629       ;; Now, the symbol we have read is either `options' or a group
14630       ;; name.  If it is an options line, we just add it to a string. 
14631       (cond 
14632        ((or (eq symbol options-symbol)
14633             (eq symbol Options-symbol))
14634         (setq gnus-newsrc-options
14635               ;; This concatting is quite inefficient, but since our
14636               ;; thorough studies show that approx 99.37% of all
14637               ;; .newsrc files only contain a single options line, we
14638               ;; don't give a damn, frankly, my dear.
14639               (concat gnus-newsrc-options
14640                       (buffer-substring 
14641                        (gnus-point-at-bol)
14642                        ;; Options may continue on the next line.
14643                        (or (and (re-search-forward "^[^ \t]" nil 'move)
14644                                 (progn (beginning-of-line) (point)))
14645                            (point)))))
14646         (forward-line -1))
14647        (symbol
14648         (or (boundp symbol) (set symbol nil))
14649         ;; It was a group name.
14650         (setq subscribed (= (following-char) ?:)
14651               group (symbol-name symbol)
14652               reads nil)
14653         (if (eolp)
14654             ;; If the line ends here, this is clearly a buggy line, so
14655             ;; we put point a the beginning of line and let the cond
14656             ;; below do the error handling.
14657             (beginning-of-line)
14658           ;; We skip to the beginning of the ranges.
14659           (skip-chars-forward "!: \t"))
14660         ;; We are now at the beginning of the list of read articles.
14661         ;; We read them range by range.
14662         (while
14663             (cond 
14664              ((looking-at "[0-9]+")
14665               ;; We narrow and read a number instead of buffer-substring/
14666               ;; string-to-int because it's faster.  narrow/widen is
14667               ;; faster than save-restriction/narrow, and save-restriction
14668               ;; produces a garbage object.
14669               (setq num1 (progn
14670                            (narrow-to-region (match-beginning 0) (match-end 0))
14671                            (read buf)))
14672               (widen)
14673               ;; If the next character is a dash, then this is a range.
14674               (if (= (following-char) ?-)
14675                   (progn
14676                     ;; We read the upper bound of the range.
14677                     (forward-char 1)
14678                     (if (not (looking-at "[0-9]+"))
14679                         ;; This is a buggy line, by we pretend that
14680                         ;; it's kinda OK.  Perhaps the user should be
14681                         ;; dinged? 
14682                         (setq reads (cons num1 reads))
14683                       (setq reads 
14684                             (cons 
14685                              (cons num1
14686                                    (progn
14687                                      (narrow-to-region (match-beginning 0) 
14688                                                        (match-end 0))
14689                                      (read buf)))
14690                              reads))
14691                       (widen)))
14692                 ;; It was just a simple number, so we add it to the
14693                 ;; list of ranges.
14694                 (setq reads (cons num1 reads)))
14695               ;; If the next char in ?\n, then we have reached the end
14696               ;; of the line and return nil.
14697               (/= (following-char) ?\n))
14698              ((= (following-char) ?\n)
14699               ;; End of line, so we end.
14700               nil)
14701              (t
14702               ;; Not numbers and not eol, so this might be a buggy
14703               ;; line... 
14704               (or (eobp)                
14705                   ;; If it was eob instead of ?\n, we allow it.
14706                   (progn
14707                     ;; The line was buggy.
14708                     (setq group nil)
14709                     (gnus-message 3 "Mangled line: %s" 
14710                                   (buffer-substring (gnus-point-at-bol) 
14711                                                     (gnus-point-at-eol)))
14712                     (ding)
14713                     (sit-for 1)))
14714               nil))
14715           ;; Skip past ", ".  Spaces are illegal in these ranges, but
14716           ;; we allow them, because it's a common mistake to put a
14717           ;; space after the comma.
14718           (skip-chars-forward ", "))
14719
14720         ;; We have already read .newsrc.eld, so we gently update the
14721         ;; data in the hash table with the information we have just
14722         ;; read. 
14723         (when group
14724           (let ((info (gnus-get-info group))
14725                 level)
14726             (if info
14727                 ;; There is an entry for this file in the alist.
14728                 (progn
14729                   (gnus-info-set-read info (nreverse reads))
14730                   ;; We update the level very gently.  In fact, we
14731                   ;; only change it if there's been a status change
14732                   ;; from subscribed to unsubscribed, or vice versa.
14733                   (setq level (gnus-info-level info))
14734                   (cond ((and (<= level gnus-level-subscribed)
14735                               (not subscribed))
14736                          (setq level (if reads
14737                                          gnus-level-default-unsubscribed 
14738                                        (1+ gnus-level-default-unsubscribed))))
14739                         ((and (> level gnus-level-subscribed) subscribed)
14740                          (setq level gnus-level-default-subscribed)))
14741                   (gnus-info-set-level info level))
14742               ;; This is a new group.
14743               (setq info (list group 
14744                                (if subscribed
14745                                    gnus-level-default-subscribed 
14746                                  (if reads
14747                                      (1+ gnus-level-subscribed)
14748                                    gnus-level-default-unsubscribed))
14749                                (nreverse reads))))
14750             (setq newsrc (cons info newsrc))))))
14751       (forward-line 1))
14752     
14753     (setq newsrc (nreverse newsrc))
14754
14755     (if (not already-read)
14756         ()
14757       ;; We now have two newsrc lists - `newsrc', which is what we
14758       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
14759       ;; what we've read from .newsrc.eld.  We have to merge these
14760       ;; lists.  We do this by "attaching" any (foreign) groups in the
14761       ;; gnus-newsrc-alist to the (native) group that precedes them. 
14762       (let ((rc (cdr gnus-newsrc-alist))
14763             (prev gnus-newsrc-alist)
14764             entry mentry)
14765         (while rc
14766           (or (null (nth 4 (car rc)))   ; It's a native group.
14767               (assoc (car (car rc)) newsrc) ; It's already in the alist.
14768               (if (setq entry (assoc (car (car prev)) newsrc))
14769                   (setcdr (setq mentry (memq entry newsrc))
14770                           (cons (car rc) (cdr mentry)))
14771                 (setq newsrc (cons (car rc) newsrc))))
14772           (setq prev rc
14773                 rc (cdr rc)))))
14774
14775     (setq gnus-newsrc-alist newsrc)
14776     ;; We make the newsrc hashtb.
14777     (gnus-make-hashtable-from-newsrc-alist)
14778
14779     ;; Finally, if we read some options lines, we parse them.
14780     (or (string= gnus-newsrc-options "")
14781         (gnus-newsrc-parse-options gnus-newsrc-options))))
14782
14783 ;; Parse options lines to find "options -n !all rec.all" and stuff.
14784 ;; The return value will be a list on the form
14785 ;; ((regexp1 . ignore)
14786 ;;  (regexp2 . subscribe)...)
14787 ;; When handling new newsgroups, groups that match a `ignore' regexp
14788 ;; will be ignored, and groups that match a `subscribe' regexp will be
14789 ;; subscribed.  A line like
14790 ;; options -n !all rec.all
14791 ;; will lead to a list that looks like
14792 ;; (("^rec\\..+" . subscribe) 
14793 ;;  ("^.+" . ignore))
14794 ;; So all "rec.*" groups will be subscribed, while all the other
14795 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
14796 ;; different from "options -n rec.all !all". 
14797 (defun gnus-newsrc-parse-options (options)
14798   (let (out eol)
14799     (save-excursion
14800       (gnus-set-work-buffer)
14801       (insert (regexp-quote options))
14802       ;; First we treat all continuation lines.
14803       (goto-char (point-min))
14804       (while (re-search-forward "\n[ \t]+" nil t)
14805         (replace-match " " t t))
14806       ;; Then we transform all "all"s into ".+"s.
14807       (goto-char (point-min))
14808       (while (re-search-forward "\\ball\\b" nil t)
14809         (replace-match ".+" t t))
14810       (goto-char (point-min))
14811       ;; We remove all other options than the "-n" ones.
14812       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
14813         (replace-match " ")
14814         (forward-char -1))
14815       (goto-char (point-min))
14816
14817       ;; We are only interested in "options -n" lines - we
14818       ;; ignore the other option lines.
14819       (while (re-search-forward "[ \t]-n" nil t)
14820         (setq eol 
14821               (or (save-excursion
14822                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
14823                          (- (point) 2)))
14824                   (gnus-point-at-eol)))
14825         ;; Search for all "words"...
14826         (while (re-search-forward "[^ \t,\n]+" eol t)
14827           (if (= (char-after (match-beginning 0)) ?!)
14828               ;; If the word begins with a bang (!), this is a "not"
14829               ;; spec.  We put this spec (minus the bang) and the
14830               ;; symbol `ignore' into the list.
14831               (setq out (cons (cons (concat 
14832                                      "^" (buffer-substring 
14833                                           (1+ (match-beginning 0))
14834                                           (match-end 0)))
14835                                     'ignore) out))
14836             ;; There was no bang, so this is a "yes" spec.
14837             (setq out (cons (cons (concat "^" (match-string 0))
14838                                   'subscribe) out)))))
14839     
14840       (setq gnus-newsrc-options-n out))))
14841
14842 (defun gnus-save-newsrc-file (&optional force)
14843   "Save .newsrc file."
14844   ;; Note: We cannot save .newsrc file if all newsgroups are removed
14845   ;; from the variable gnus-newsrc-alist.
14846   (when (and (or gnus-newsrc-alist gnus-killed-list)
14847              gnus-current-startup-file)
14848     (save-excursion
14849       (if (and (or gnus-use-dribble-file gnus-slave)
14850                (not force)
14851                (or (not gnus-dribble-buffer)
14852                    (not (buffer-name gnus-dribble-buffer))
14853                    (zerop (save-excursion
14854                             (set-buffer gnus-dribble-buffer)
14855                             (buffer-size)))))
14856           (gnus-message 4 "(No changes need to be saved)")
14857         (run-hooks 'gnus-save-newsrc-hook)
14858         (if gnus-slave
14859             (gnus-slave-save-newsrc)
14860           ;; Save .newsrc.
14861           (when gnus-save-newsrc-file
14862             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
14863             (gnus-gnus-to-newsrc-format)
14864             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
14865           ;; Save .newsrc.eld.
14866           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
14867           (make-local-variable 'version-control)
14868           (setq version-control 'never)
14869           (setq buffer-file-name 
14870                 (concat gnus-current-startup-file ".eld"))
14871           (gnus-add-current-to-buffer-list)
14872           (buffer-disable-undo (current-buffer))
14873           (erase-buffer)
14874           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
14875           (gnus-gnus-to-quick-newsrc-format)
14876           (run-hooks 'gnus-save-quick-newsrc-hook)
14877           (save-buffer)
14878           (kill-buffer (current-buffer))
14879           (gnus-message 
14880            5 "Saving %s.eld...done" gnus-current-startup-file))
14881         (gnus-dribble-delete-file)))))
14882
14883 (defun gnus-gnus-to-quick-newsrc-format ()
14884   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
14885   (insert ";; Gnus startup file.\n")
14886   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
14887   (insert ";; to read .newsrc.\n")
14888   (insert "(setq gnus-newsrc-file-version "
14889           (prin1-to-string gnus-version) ")\n")
14890   (let ((variables 
14891          (if gnus-save-killed-list gnus-variable-list
14892            ;; Remove the `gnus-killed-list' from the list of variables
14893            ;; to be saved, if required.
14894            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
14895         ;; Peel off the "dummy" group.
14896         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
14897         variable)
14898     ;; Insert the variables into the file.
14899     (while variables
14900       (when (and (boundp (setq variable (pop variables)))
14901                  (symbol-value variable))
14902         (insert "(setq " (symbol-name variable) " '"
14903                 (prin1-to-string (symbol-value variable)) ")\n")))))
14904
14905 (defun gnus-gnus-to-newsrc-format ()
14906   ;; Generate and save the .newsrc file.
14907   (let ((newsrc (cdr gnus-newsrc-alist))
14908         info ranges range)
14909     (save-excursion
14910       (set-buffer (create-file-buffer gnus-current-startup-file))
14911       (setq buffer-file-name gnus-current-startup-file)
14912       (buffer-disable-undo (current-buffer))
14913       (erase-buffer)
14914       ;; Write options.
14915       (if gnus-newsrc-options (insert gnus-newsrc-options))
14916       ;; Write subscribed and unsubscribed.
14917       (while newsrc
14918         (setq info (car newsrc))
14919         (if (not (gnus-info-method info))
14920             ;; Don't write foreign groups to .newsrc.
14921             (progn
14922               (insert (gnus-info-group info)
14923                       (if (> (gnus-info-level info) gnus-level-subscribed)
14924                           "!" ":"))
14925               (if (setq ranges (gnus-info-read info))
14926                   (progn
14927                     (insert " ")
14928                     (if (not (listp (cdr ranges)))
14929                         (if (= (car ranges) (cdr ranges))
14930                             (insert (int-to-string (car ranges)))
14931                           (insert (int-to-string (car ranges)) "-" 
14932                                   (int-to-string (cdr ranges))))
14933                       (while ranges
14934                         (setq range (car ranges)
14935                               ranges (cdr ranges))
14936                         (if (or (atom range) (= (car range) (cdr range)))
14937                             (insert (int-to-string 
14938                                      (or (and (atom range) range) 
14939                                          (car range))))
14940                           (insert (int-to-string (car range)) "-"
14941                                   (int-to-string (cdr range))))
14942                         (if ranges (insert ","))))))
14943               (insert "\n")))
14944         (setq newsrc (cdr newsrc)))
14945       (make-local-variable 'version-control)
14946       (setq version-control 'never)
14947       ;; It has been reported that sometime the modtime on the .newsrc
14948       ;; file seems to be off.  We really do want to overwrite it, so
14949       ;; we clear the modtime here before saving.  It's a bit odd,
14950       ;; though... 
14951       ;; sometimes the modtime clear isn't sufficient.  most brute force:
14952       ;; delete the silly thing entirely first.  but this fails to provide
14953       ;; such niceties as .newsrc~ creation.
14954       (if gnus-modtime-botch
14955           (delete-file gnus-startup-file)
14956         (clear-visited-file-modtime))
14957       (run-hooks 'gnus-save-standard-newsrc-hook)
14958       (save-buffer)
14959       (kill-buffer (current-buffer)))))
14960
14961
14962 ;;; Slave functions.
14963
14964 (defun gnus-slave-save-newsrc ()
14965   (save-excursion
14966     (set-buffer gnus-dribble-buffer)
14967     (let ((slave-name 
14968            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
14969       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
14970
14971 (defun gnus-master-read-slave-newsrc ()
14972   (let ((slave-files 
14973          (directory-files 
14974           (file-name-directory gnus-current-startup-file)
14975           t (concat 
14976              "^" (regexp-quote
14977                   (concat
14978                    (file-name-nondirectory gnus-current-startup-file)
14979                    "-slave-")))
14980           t))
14981         file)
14982     (if (not slave-files)
14983         ()                              ; There are no slave files to read.
14984       (gnus-message 7 "Reading slave newsrcs...")
14985       (save-excursion
14986         (set-buffer (get-buffer-create " *gnus slave*"))
14987         (buffer-disable-undo (current-buffer))
14988         (setq slave-files 
14989               (sort (mapcar (lambda (file) 
14990                               (list (nth 5 (file-attributes file)) file))
14991                             slave-files)
14992                     (lambda (f1 f2)
14993                       (or (< (car (car f1)) (car (car f2)))
14994                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
14995         (while slave-files
14996           (erase-buffer)
14997           (setq file (nth 1 (car slave-files)))
14998           (insert-file-contents file)
14999           (if (condition-case ()
15000                   (progn
15001                     (eval-buffer (current-buffer))
15002                     t)
15003                 (error 
15004                  (message "Possible error in %s" file)
15005                  (ding)
15006                  (sit-for 2)
15007                  nil))
15008               (or gnus-slave ; Slaves shouldn't delete these files.
15009                   (condition-case ()
15010                       (delete-file file)
15011                     (error nil))))
15012           (setq slave-files (cdr slave-files))))
15013       (gnus-message 7 "Reading slave newsrcs...done"))))
15014
15015
15016 ;;; Group description.
15017
15018 (defun gnus-read-all-descriptions-files ()
15019   (let ((methods (cons gnus-select-method gnus-secondary-select-methods)))
15020     (while methods
15021       (gnus-read-descriptions-file (car methods))
15022       (setq methods (cdr methods)))
15023     t))
15024
15025 (defun gnus-read-descriptions-file (&optional method)
15026   (let ((method (or method gnus-select-method)))
15027     ;; We create the hashtable whether we manage to read the desc file
15028     ;; to avoid trying to re-read after a failed read.
15029     (or gnus-description-hashtb
15030         (setq gnus-description-hashtb 
15031               (gnus-make-hashtable (length gnus-active-hashtb))))
15032     ;; Mark this method's desc file as read.
15033     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
15034                   gnus-description-hashtb)
15035
15036     (gnus-message 5 "Reading descriptions file via %s..." (car method))
15037     (cond 
15038      ((not (gnus-check-server method))
15039       (gnus-message 1 "Couldn't open server")
15040       nil)
15041      ((not (gnus-request-list-newsgroups method))
15042       (gnus-message 1 "Couldn't read newsgroups descriptions")
15043       nil)
15044      (t
15045       (let (group)
15046         (save-excursion
15047           (save-restriction
15048             (set-buffer nntp-server-buffer)
15049             (goto-char (point-min))
15050             (if (or (search-forward "\n.\n" nil t)
15051                     (goto-char (point-max)))
15052                 (progn
15053                   (beginning-of-line)
15054                   (narrow-to-region (point-min) (point))))
15055             (goto-char (point-min))
15056             (while (not (eobp))
15057               ;; If we get an error, we set group to 0, which is not a
15058               ;; symbol... 
15059               (setq group 
15060                     (condition-case ()
15061                         (let ((obarray gnus-description-hashtb))
15062                           ;; Group is set to a symbol interned in this
15063                           ;; hash table.
15064                           (read nntp-server-buffer))
15065                       (error 0)))
15066               (skip-chars-forward " \t")
15067               ;; ...  which leads to this line being effectively ignored.
15068               (and (symbolp group)
15069                    (set group (buffer-substring 
15070                                (point) (progn (end-of-line) (point)))))
15071               (forward-line 1))))
15072         (gnus-message 5 "Reading descriptions file...done")
15073         t)))))
15074
15075 (defun gnus-group-get-description (group)
15076   "Get the description of a group by sending XGTITLE to the server."
15077   (when (gnus-request-group-description group)
15078     (save-excursion
15079       (set-buffer nntp-server-buffer)
15080       (goto-char (point-min))
15081       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
15082         (match-string 1)))))
15083
15084 ;;;
15085 ;;; Buffering of read articles.
15086 ;;;
15087
15088 (defvar gnus-backlog-buffer " *Gnus Backlog*")
15089 (defvar gnus-backlog-articles nil)
15090 (defvar gnus-backlog-hashtb nil)
15091
15092 (defun gnus-backlog-buffer ()
15093   "Return the backlog buffer."
15094   (or (get-buffer gnus-backlog-buffer)
15095       (save-excursion
15096         (set-buffer (get-buffer-create gnus-backlog-buffer))
15097         (buffer-disable-undo (current-buffer))
15098         (setq buffer-read-only t)
15099         (gnus-add-current-to-buffer-list)
15100         (get-buffer gnus-backlog-buffer))))
15101
15102 (defun gnus-backlog-setup ()
15103   "Initialize backlog variables."
15104   (unless gnus-backlog-hashtb
15105     (setq gnus-backlog-hashtb (make-vector 1023 0))))
15106
15107 (defun gnus-backlog-shutdown ()
15108   "Clear all backlog variables and buffers."
15109   (when (get-buffer gnus-backlog-buffer)
15110     (kill-buffer gnus-backlog-buffer))
15111   (setq gnus-backlog-hashtb nil
15112         gnus-backlog-articles nil))
15113
15114 (defun gnus-backlog-enter-article (group number buffer)
15115   (gnus-backlog-setup)
15116   (let ((ident (intern (concat group ":" (int-to-string number))
15117                        gnus-backlog-hashtb))
15118         b)
15119     (if (memq ident gnus-backlog-articles)
15120         () ; It's already kept.
15121       ;; Remove the oldest article, if necessary.
15122       (and (numberp gnus-keep-backlog)
15123            (>= (length gnus-backlog-articles) gnus-keep-backlog)
15124            (gnus-backlog-remove-oldest-article))
15125       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
15126       ;; Insert the new article.
15127       (save-excursion
15128         (set-buffer (gnus-backlog-buffer))
15129         (let (buffer-read-only)
15130           (goto-char (point-max))
15131           (or (bolp) (insert "\n"))
15132           (setq b (point))
15133           (insert-buffer-substring buffer)
15134           ;; Tag the beginning of the article with the ident.
15135           (put-text-property b (1+ b) 'gnus-backlog ident))))))
15136
15137 (defun gnus-backlog-remove-oldest-article ()
15138   (save-excursion
15139     (set-buffer (gnus-backlog-buffer))
15140     (goto-char (point-min))
15141     (if (zerop (buffer-size))
15142         () ; The buffer is empty.
15143       (let ((ident (get-text-property (point) 'gnus-backlog))
15144             buffer-read-only)
15145         ;; Remove the ident from the list of articles.
15146         (when ident
15147           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
15148         ;; Delete the article itself.
15149         (delete-region 
15150          (point) (next-single-property-change
15151                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
15152
15153 (defun gnus-backlog-request-article (group number buffer)
15154   (gnus-backlog-setup)
15155   (let ((ident (intern (concat group ":" (int-to-string number))
15156                        gnus-backlog-hashtb))
15157         beg end)
15158     (when (memq ident gnus-backlog-articles)
15159       ;; It was in the backlog.
15160       (save-excursion
15161         (set-buffer (gnus-backlog-buffer))
15162         (if (not (setq beg (text-property-any 
15163                             (point-min) (point-max) 'gnus-backlog
15164                             ident)))
15165             ;; It wasn't in the backlog after all.
15166             (progn
15167               (setq gnus-backlog-articles (delq ident gnus-backlog-articles))
15168               nil)
15169           ;; Find the end (i. e., the beginning of the next article).
15170           (setq end
15171                 (next-single-property-change 
15172                  (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
15173       (let ((buffer-read-only nil))
15174         (erase-buffer)
15175         (insert-buffer-substring gnus-backlog-buffer beg end)
15176         t))))
15177
15178 ;; Allow redefinition of Gnus functions.
15179
15180 (gnus-ems-redefine)
15181
15182 (provide 'gnus)
15183
15184 ;;; gnus.el ends here