*** empty log message ***
[gnus] / lisp / gnus.el
1 ;;; (ding) Gnus --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Commentary:
25
26 ;; Although (ding) Gnus looks suspiciously like GNUS, it isn't quite
27 ;; the same beast. Most internal structures have been changed. If you
28 ;; have written packages that depend on any of the hash tables,
29 ;; `gnus-newsrc-assoc', `gnus-killed-assoc', marked lists, the .newsrc
30 ;; buffer, or internal knowledge of the `nntp-header-' macros, or
31 ;; dependence on the buffers having a certain format, your code will
32 ;; fail.
33
34 ;;; Code:
35
36 (require 'mail-utils)
37 (require 'timezone)
38 (require 'rnews)
39 (require 'rmail)
40
41 (require 'nnheader)
42
43 ;; Customization variables
44
45 (defvar gnus-select-method 
46   (list 'nntp (or (getenv "NNTPSERVER") 
47                   (if (and gnus-default-nntp-server
48                            (not (string= gnus-default-nntp-server "")))
49                       gnus-default-nntp-server)
50                   (system-name))
51         "nntp")
52   "Default method for selecting a newsgroup.
53 This variable should be a list, where the first element is how the
54 news is to be fetched, the second is the address.  An optional third
55 element can be included to specify a port number if nntp is used.
56
57 For instance, if you want to get your news via NNTP from
58 \"flab.flab.edu\" on port 23, you could say:
59
60 (setq gnus-select-method '(nntp \"flab.flab.edu\" 23))
61
62 If you want to use your local spool, say:
63
64 (setq gnus-select-method (list 'nnspool (system-name)))
65
66 If you use this variable, you must set `gnus-nntp-server' to nil.")
67
68 ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
69 (defvar gnus-post-method nil
70   "Preferred method for posting USENET news.
71 If this variable is nil, Gnus will use the current method to decide
72 which method to use when posting.  If it is non-nil, it will override
73 the current method. This method will not be used in mail groups and
74 the like, only in \"real\" newsgroups.
75
76 The value must be a valid method as discussed in the documentation of
77 `gnus-select-method'.")
78
79 (defvar gnus-refer-article-method nil
80   "Preferred method for fetching an article by Message-ID.
81 If you are reading news from the local spool (with nnspool), fetching
82 articles by Message-ID is painfully slow. By setting this method to an
83 nntp method, you might get acceptable results.
84
85 The value of this variable must be a valid select method as discussed
86 in the documentation of `gnus-select-method'")
87
88 (defvar gnus-secondary-select-methods nil
89   "A list of secondary methods that will be used for reading news.
90 This is a list where each element is a complete select methdod (see
91 `gnus-select-method').  
92
93 If, for instance, you want to read your mail with the nnml backend,
94 you could set this variable:
95
96 (setq gnus-secondary-select-methods '((nnml ""))")
97
98 (defvar gnus-secondary-servers nil
99   "List of NNTP servers that the user can choose between interactively.
100 To make Gnus query you for a server, you have to give `gnus' a
101 non-numeric prefix - `C-u M-x gnus', in short.")
102
103 (defvar gnus-nntp-server nil
104   "The name of the host running the NNTP server.
105 This variable is semi-obsolete. Use the `gnus-select-method'
106 variable instead.")
107
108 (defvar gnus-nntp-service "nntp"
109   "NNTP service name (\"nntp\" or 119).
110 This is an obsolete variable, which is scarcely used. If you use an
111 nntp server for your newsgroup and want to change the port number
112 used to 899, you would say something along these lines:
113
114  (setq gnus-select-method '(nntp \"my.nntp.server\" 899))")
115
116 (defvar gnus-startup-file "~/.newsrc"
117   "Your `.newsrc' file.
118 `.newsrc-SERVER' will be used instead if that exists.")
119
120 (defvar gnus-signature-file "~/.signature"
121   "Your signature file.
122 If the variable is a string that doesn't correspond to a file, the
123 string itself is inserted.")
124
125 (defvar gnus-signature-function nil
126   "A function that should return a signature file name.
127 The function will be called with the name of the newsgroup being
128 posted to.
129 If the function returns a string that doesn't correspond to a file, the
130 string itself is inserted.
131 If the function returns nil, the `gnus-signature-file' variable will
132 be used instead.")
133
134 (defvar gnus-init-file "~/.gnus"
135   "Your Gnus elisp startup file.
136 If a file with the .el or .elc suffixes exist, it will be read
137 instead.") 
138
139 (defvar gnus-group-faq-directory "/ftp@rtfm.mit.edu:/pub/usenet-by-group/"
140   "Directory where the group FAQs are stored.
141 This will most commonly be on a remote machine, and the file will be
142 fetched by ange-ftp.")
143
144 (defvar gnus-default-subscribed-newsgroups nil
145   "This variable lists what newsgroups should be susbcribed the first time Gnus is used.
146 It should be a list of strings.
147 If it is `t', Gnus will not do anything special the first time it is
148 started; it'll just use the normal newsgroups subscription methods.")
149
150 (defvar gnus-post-prepare-function nil
151   "Function that is run after a post buffer has been prepared.
152 It is called with the name of the newsgroup that is posted to. It
153 might be used, for instance, for inserting signatures based on the
154 newsgroup name. (In that case, `gnus-signature-file' and
155 `mail-signature' should both be set to nil).")
156
157 (defvar gnus-use-cross-reference t
158   "Non-nil means that cross referenced articles will be marked as read.
159 If nil, ignore cross references.  If t, mark articles as read in
160 subscribed newsgroups. If neither t nor nil, mark as read in all
161 newsgroups.") 
162
163 (defvar gnus-use-dribble-file t
164   "Non-nil means that Gnus will use a dribble file to store user updates.
165 If Emacs should crash without saving the .newsrc files, complete
166 information can be restored from the dribble file.")
167
168 (defvar gnus-use-followup-to 'use
169   "Specifies what to do with Followup-To header.
170 If nil, ignore the header. If it is t, use its value, but ignore 
171 `poster'. If it is neither nil nor t, which is the default, always use
172 the value.") 
173
174 (defvar gnus-followup-to-function nil
175   "A variable that contains a function that returns a followup address.
176 The function will be called in the buffer of the article that is being
177 followed up. The buffer will be narrowed to the headers of the
178 article. To pick header headers, one might use `mail-fetch-field'.  The
179 function will be called with the name of the current newsgroup as the
180 argument.
181
182 Here's an example `gnus-followup-to-function':
183
184 (setq gnus-followup-to-function
185       (lambda (group)
186         (cond ((string= group \"mail.list\")
187                (or (mail-fetch-field \"sender\") 
188                    (mail-fetch-field \"from\")))
189               (t
190                (or (mail-fetch-field \"reply-to\") 
191                    (mail-fetch-field \"from\"))))))")
192
193 (defvar gnus-reply-to-function nil
194   "A variable that contains a function that returns a reply address.
195 See the `gnus-followup-to-function' variable for an explanation of how
196 this variable is used.")
197
198 (defvar gnus-large-newsgroup 200
199   "The number of articles which indicates a large newsgroup.
200 If the number of articles in a newsgroup is greater than this value,
201 confirmation is required for selecting the newsgroup.")
202
203 (defvar gnus-author-copy (getenv "AUTHORCOPY")
204   "Save outgoing articles in this file.
205 Initialized from the AUTHORCOPY environment variable.
206
207 If this variable begins with the character \"|\", outgoing articles
208 will be piped to the named program. It is possible to save an article
209 in an MH folder as follows:
210
211 \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")
212
213 If the first character is not a pipe, articles are saved using the
214 function specified by the `gnus-author-copy-saver' variable.")
215
216 (defvar gnus-mail-self-blind nil
217   "Non-nil means insert a BCC header in all outgoing articles.
218 This will result in having a copy of the article mailed to yourself.
219 The BCC header is inserted when the post buffer is initialized, so you
220 can remove or alter the BCC header to override the default.")
221
222 (defvar gnus-author-copy-saver (function rmail-output)
223   "A function called to save outgoing articles.
224 This function will be called with the same of the file to store the
225 article in. The default function is `rmail-output' which saves in Unix
226 mailbox format.")
227
228 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
229   "Non-nil means that the default name of a file to save articles in is the group name.
230 If it's nil, the directory form of the group name is used instead.")
231
232 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
233   "Name of the directory articles will be saved in (default \"~/News\").
234 Initialized from the SAVEDIR environment variable.")
235
236 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
237   "Name of the directory where kill files will be stored (default \"~/News\").
238 Initialized from the SAVEDIR environment variable.")
239
240 (defvar gnus-score-expiry-days 7
241   "*Number of days before unused score file entries are expired.")
242
243 (defvar gnus-default-article-saver (function gnus-summary-save-in-rmail)
244   "A function to save articles in your favorite format.
245 The function must be interactively callable (in other words, it must
246 be an Emacs command).
247
248 Gnus provides the following functions:
249
250 * gnus-summary-save-in-rmail (Rmail format)
251 * gnus-summary-save-in-mail (Unix mail format)
252 * gnus-summary-save-in-folder (MH folder)
253 * gnus-summary-save-in-file (article format).")
254
255 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
256   "A function generating a file name to save articles in Rmail format.
257 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
258
259 (defvar gnus-mail-save-name (function gnus-plain-save-name)
260   "A function generating a file name to save articles in Unix mail format.
261 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
262
263 (defvar gnus-folder-save-name (function gnus-folder-save-name)
264   "A function generating a file name to save articles in MH folder.
265 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
266
267 (defvar gnus-file-save-name (function gnus-numeric-save-name)
268   "A function generating a file name to save articles in article format.
269 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
270
271 (defvar gnus-kill-file-name "KILL"
272   "Suffix of the kill files.")
273
274 (defvar gnus-score-file-suffix "SCORE"
275   "Suffix of the score files.")
276
277 (defvar gnus-fetch-old-headers nil
278   "Non-nil means that Gnus will try to build threads by grabbing old headers.
279 If an unread article in the group refers to an older, already read (or
280 just marked as read) article, the old article will not normally be
281 displayed in the Summary buffer.  If this variable is non-nil, Gnus
282 will attempt to grab the headers to the old articles, and thereby
283 build complete threads.  If it has the value `some', only enough
284 headers to connect otherwise loose threads will be displayed.
285
286 The server has to support XOVER for any of this to work.")
287
288 (defvar gnus-visual t
289   "*If non-nil, will do various highlighting.
290 If nil, no mouse highlights (or any other highlights) will be
291 performed.  This might speed up Gnus some when generating large group
292 and summary buffers.")
293
294 (defvar gnus-novice-user t
295   "*Non-nil means that you are a usenet novice.
296 If non-nil, verbose messages may be displayed and confirmations may be
297 required.")
298
299 (defvar gnus-expert-user nil
300   "*Non-nil means that you will never be asked for confirmation about anything.
301 And that means *anything*.")
302
303 (defvar gnus-keep-same-level nil
304   "Non-nil means that the next newsgroup after the current will be on the same level.
305 When you type, for instance, `n' after reading the last article in the
306 current newsgroup, you will go to the next newsgroup. If this variable
307 is nil, the next newsgroup will be the next from the group
308 buffer. 
309 If this variable is non-nil, Gnus will either put you in the
310 next newsgroup with the same level, or, if no such newsgroup is
311 available, the next newsgroup with the lowest possible level higher
312 than the current level.
313 If this variable is `best', Gnus will make the next newsgroup the one
314 with the best level.")
315
316 (defvar gnus-summary-make-false-root 'adopt
317   "nil means that Gnus won't gather loose threads.
318 If the root of a thread has expired or been read in a previous
319 session, the information necessary to build a complete thread has been
320 lost. Instead of having many small sub-threads from this original thread
321 scattered all over the summary buffer, Gnus can gather them. 
322
323 If non-nil, Gnus will try to gather all loose sub-threads from an
324 original thread into one large thread.
325
326 If this variable is non-nil, it should be one of `none', `adopt',
327 `dummy' or `empty'.
328
329 If this variable is `none', Gnus will not make a false root, but just
330 present the sub-threads after another.
331 If this variable is `dummy', Gnus will create a dummy root that will
332 have all the sub-threads as children.
333 If this variable is `adopt', Gnus will make one of the \"children\"
334 the parent and mark all the step-children as such.
335 If this variable is `empty', the \"children\" are printed with empty
336 subject fields.  (Or rather, they will be printed with a string
337 given by the `gnus-summary-same-subject' variable.)")
338
339 (defvar gnus-summary-gather-subject-limit nil
340   "*Maximum length of subject comparisons when gathering loose threads.
341 Use nil to compare full subjects.  Setting this variable to a low
342 number will help gather threads that have been corrupted by
343 newsreaders chopping off subject lines, but it might also mean that
344 unrelated articles that have subject that happen to begin with the
345 same few characters will be incorrectly gathered.")
346
347 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
348 (defvar gnus-summary-same-subject ""
349   "String indicating that the current article has the same subject as the previous.
350 This variable will only be used if the value of
351 `gnus-summary-make-false-root' is `empty'.")
352
353 (defvar gnus-summary-goto-unread nil
354   "If non-nil, marking commands will go to the next unread article.")
355
356 (defvar gnus-check-new-newsgroups t
357   "Non-nil means that Gnus will add new newsgroups at startup.
358 If this variable is `ask-server', Gnus will ask the server for new
359 groups since the last time it checked. This means that the killed list
360 is no longer necessary, so you could set `gnus-save-killed-list' to
361 nil. 
362
363 A variant is to have this variable be a list of select methods. Gnus
364 will then use the `ask-server' method on all these select methods to
365 query for new groups from all those servers.
366
367 Eg.
368   (setq gnus-check-new-newsgroups 
369         '((nntp \"some.server\") (nntp \"other.server\")))
370
371 If this variable is nil, then you have to tell Gnus explicitly to
372 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
373
374 (defvar gnus-check-bogus-newsgroups nil
375   "Non-nil means that Gnus will check and remove bogus newsgroup at startup.
376 If this variable is nil, then you have to tell Gnus explicitly to
377 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
378
379 (defvar gnus-read-active-file t
380   "Non-nil means that Gnus will read the entire active file at startup.
381 If this variable is nil, Gnus will only read parts of the active file.")
382
383 (defvar gnus-activate-foreign-newsgroups nil
384   "If nil, Gnus will not check foreign newsgroups at startup.
385 If it is non-nil, it should be a number between one and nine. Foreign
386 newsgroups that have a level lower or equal to this number will be
387 activated on startup. For instance, if you want to active all
388 subscribed newsgroups, but not the rest, you'd set this variable to 5.
389
390 If you subscribe to lots of newsgroups from different servers, startup
391 might take a while. By setting this variable to nil, you'll save time,
392 but you won't be told how many unread articles there are in the
393 groups.")
394
395 (defvar gnus-save-newsrc-file t
396   "Non-nil means that Gnus will save the `.newsrc' file.
397 Gnus always saves its own startup file, which is called
398 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
399 be readily understood by other newsreaders.  If you don't plan on
400 using other newsreaders, set this variable to nil to save some time on
401 exit.")
402
403 (defvar gnus-save-killed-list t
404   "If non-nil, save the list of killed groups to the startup file.
405 This will save both time (when starting and quitting) and space (both
406 memory and disk), but it will also mean that Gnus has no record of
407 which groups are new and which are old, so the automatic new
408 newsgroups subscription methods become meaningless. You should always
409 set `gnus-check-new-newsgroups' to `ask-server' or nil if you set this
410 variable to nil.")
411
412 (defvar gnus-interactive-catchup t
413   "If non-nil, require your confirmation when catching up a group.")
414
415 (defvar gnus-interactive-post t
416   "If non-nil, group name will be asked for when posting.")
417
418 (defvar gnus-interactive-exit t
419   "If non-nil, require your confirmation when exiting Gnus.")
420
421 (defvar gnus-kill-killed nil
422   "If non-nil, Gnus will apply kill files to already killed articles.
423 If it is nil, Gnus will never apply kill files to articles that have
424 already been through the scoring process, which might very well save lots
425 of time.")
426
427 (defvar gnus-extract-address-components 'gnus-extract-address-components
428   "Function for extracting address components from a From header.
429 Two pre-defined function exist: `gnus-extract-address-components',
430 which is the default, quite fast, and too simplistic solution, and
431 `mail-extract-address-components', which works much better, but is
432 slower.")
433
434 (defvar gnus-score-interactive-default-score 1000
435   "Scoring commands will raise/lower the score with this number as the default.")
436
437 (defvar gnus-global-score-files nil
438   "List of global score files and directories.
439 Set this variable if you want to use people's score files.  One entry
440 for each score file or each score file directory.  Gnus will decide
441 by itself what score files are applicable to which group.
442
443 Say you want to use the single score file
444 \"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
445 score files in the \"/ftp.some-where:/pub/score\" directory.
446
447  (setq gnus-global-score-files
448        '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
449          \"/ftp.some-where:/pub/score\"))")
450
451 (defvar gnus-summary-default-score 0
452   "Default article score level.
453 If this variable is nil, scoring will be disabled.")
454
455 (defvar gnus-user-login-name nil
456   "The login name of the user.
457 Got from the function `user-login-name' if undefined.")
458
459 (defvar gnus-user-full-name nil
460   "The full name of the user.
461 Got from the NAME environment variable if undefined.")
462
463 (defvar gnus-show-mime nil
464   "*If non-ni, do mime processing of articles.
465 The articles will simply be fed to the function given by
466 `gnus-show-mime-method'.")
467
468 (defvar gnus-show-mime-method (function metamail-buffer)
469   "Function to process a MIME message.
470 The function is called from the article buffer.")
471
472 (defvar gnus-show-threads t
473   "*If non-nil, display threads in summary mode.")
474
475 (defvar gnus-thread-hide-subtree nil
476   "If non-nil, hide all threads initially.
477 If threads are hidden, you have to run the command
478 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
479 to expose hidden threads.")
480
481 (defvar gnus-thread-hide-killed t
482   "If non-nil, hide killed threads automatically.")
483
484 (defvar gnus-thread-ignore-subject nil
485   "If non-nil, ignore subjects and do all threading based on the Reference header.
486 If nil, which is the default, articles that have different subjects
487 from their parents will start separate threads.")
488
489 (defvar gnus-thread-indent-level 4
490   "Number that says how much each sub-thread should be indented.")
491
492 ;; jwz: nuke newsgroups whose name is all digits - that means that
493 ;; some loser has let articles get into the root of the news spool,
494 ;; which is toxic. Lines beginning with whitespace also tend to be
495 ;; toxic.
496 (defvar gnus-ignored-newsgroups
497   (purecopy (mapconcat 'identity
498                        '("^to\\."       ; not "real" groups
499                          "^[0-9. \t]+ " ; all digits in name
500                          "[][\"#'()     ;\\]"   ; bogus characters
501                          )
502                        "\\|"))
503   "A regexp to match uninteresting newsgroups in the active file.
504 Any lines in the active file matching this regular expression are
505 removed from the newsgroup list before anything else is done to it,
506 thus making them effectively non-existant.")
507
508 (defvar gnus-ignored-headers
509   "^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:"
510   "All headers that match this regexp will be hidden.
511 Also see `gnus-visible-headers'.")
512
513 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:"
514   "All headers that do not match this regexp will be hidden.
515 Also see `gnus-ignored-headers'.")
516
517 (defvar gnus-sorted-header-list
518   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" 
519     "^Cc:" "^Date:" "^Organization:")
520   "This variable is a list of regular expressions.
521 If it is non-nil, headers that match the regular expressions will
522 be placed first in the article buffer in the sequence specified by
523 this list.")
524
525 (defvar gnus-required-headers
526   '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)
527   "Headers to be generated or prompted for when posting an article.
528 RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID
529 and Path headers.  Organization, Lines and X-Newsreader are optional.
530 If you want Gnus not to insert some header, remove it from this
531 list.") 
532
533 (defvar gnus-show-all-headers nil
534   "*If non-nil, don't hide any headers.")
535
536 (defvar gnus-save-all-headers t
537   "*If non-nil, don't remove any headers before saving.")
538
539 (defvar gnus-inhibit-startup-message nil
540   "If non-nil, the startup message will not be displayed.")
541
542 (defvar gnus-auto-extend-newsgroup t
543   "If non-nil, extend newsgroup forward and backward when requested.")
544
545 (defvar gnus-auto-select-first t
546   "If non-nil, select the first unread article when entering a group.
547 If you want to prevent automatic selection of the first unread article
548 in some newsgroups, set the variable to nil in
549 `gnus-select-group-hook'.") 
550
551 (defvar gnus-auto-select-next t
552   "If non-nil, offer to go to the next group from the end of the previous.
553 If the value is t and the next newsgroup is empty, Gnus will exit
554 summary mode and go back to group mode.  If the value is neither nil
555 nor t, Gnus will select the following unread newsgroup.  In
556 particular, if the value is the symbol `quietly', the next unread
557 newsgroup will be selected without any confirmations.")
558
559 (defvar gnus-auto-select-same nil
560   "If non-nil, select the next article with the same subject.")
561
562 (defvar gnus-auto-center-summary t
563   "*If non-nil, always center the current summary buffer.")
564
565 (defvar gnus-auto-mail-to-author nil
566   "*If non-nil, mail the authors of articles a copy of your follow-ups.
567 If this variable is `ask', the user will be prompted for whether to
568 mail a copy.  The string given by `gnus-mail-courtesy-message' will be
569 inserted at the beginning of the mail copy.
570
571 Mail is sent using the function specified by the
572 `gnus-mail-send-method' variable.")
573
574 ;; Added by Ethan Bradford <ethanb@ptolemy.astro.washington.edu>.
575 (defvar gnus-mail-courtesy-message
576   "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
577   "This is inserted at the start of a mailed copy of a posted message.
578 If this variable is nil, no such courtesy message will be added.")
579
580 (defvar gnus-break-pages t
581   "*If non-nil, do page breaking on articles.
582 The page delimiter is specified by the `gnus-page-delimiter'
583 variable.")
584
585 (defvar gnus-page-delimiter "^\^L"
586   "Regexp describing what to use as article page delimiters.
587 The default value is \"^\^L\", which is a form linefeed at the
588 beginning of a line.")
589
590 (defvar gnus-use-full-window t
591   "*If non-nil, use the entire Emacs screen.")
592
593 (defvar gnus-window-configuration
594   '((summary (0 1 0))
595     (newsgroups (1 0 0))
596     (article (0 3 10)))
597   "Specify window configurations for each action.
598 The format of the variable is either a list of (ACTION (G S A)), where
599 G, S, and A are the relative height of group, summary, and article
600 windows, respectively, or a list of (ACTION FUNCTION), where FUNCTION
601 is a function that will be called with ACTION as an argument. ACTION
602 can be `summary', `newsgroups', or `article'.")
603
604 (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail)
605   "Function to compose a reply.
606 Two pre-made functions are `gnus-mail-reply-using-mail' (sendmail) and
607 `gnus-mail-reply-using-mhe' (MH-E).")
608
609 (defvar gnus-mail-forward-method (function gnus-mail-forward-using-mail)
610   "Function to forward the current message to another user.
611 Two pre-made functions are `gnus-mail-forward-using-mail' (sendmail)
612 and `gnus-mail-forward-using-mhe' (MH-E).") 
613
614 (defvar gnus-mail-other-window-method 'gnus-mail-other-window-using-mail
615   "Function to compose mail in the other window.
616 Two pre-made functions are `gnus-mail-other-window-using-mail'
617 (sendmail) and `gnus-mail-other-window-using-mhe' (MH-E).")
618
619 (defvar gnus-mail-send-method send-mail-function
620   "Function to mail a message which is also being posted as an article.
621 The message must have To or Cc header.  The default is copied from
622 the variable `send-mail-function'.")
623
624 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
625   "Function called with a group name when new group is detected.
626 A few pre-made functions are supplied: `gnus-subscribe-randomly'
627 inserts new groups at the beginning of the list of groups;
628 `gnus-subscribe-alphabetically' inserts new groups in strict
629 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
630 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
631 for your decision.")
632
633 ;; Suggested by a bug report by Hallvard B Furuseth
634 ;; <h.b.furuseth@usit.uio.no>. 
635 (defvar gnus-subscribe-options-newsgroup-method
636   (function gnus-subscribe-alphabetically)
637   "This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
638 If, for instance, you want to subscribe to all newsgroups in the
639 \"no\" and \"alt\" hierarchies, you'd put the following in your
640 .newsrc file:
641
642 options -n no.all alt.all
643
644 Gnus will the subscribe all new newsgroups in these hierarchies with
645 the subscription method in this variable.")
646
647 (defvar gnus-subscribe-hierarchical-interactive nil
648   "If non-nil, Gnus will offer to subscribe hierarchically.
649 When a new hierarchy appears, Gnus will ask the user:
650
651 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
652
653 If the user pressed `d', Gnus will descend the hierarchy, `y' will
654 subscribe to all newsgroups in the hierarchy and `s' will skip this
655 hierarchy in its entirety.")
656
657 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
658   "Function used for sorting the group buffer.
659 This function will be called with group info entries as the arguments
660 for the groups to be sorted.  Pre-made functions include
661 `gnus-sort-by-alphabet', `gnus-sort-by-unread' and
662 `gnus-sort-by-level'")
663
664 ;; Mark variables suggested by Thomas Michanek
665 ;; <Thomas.Michanek@telelogic.se>. 
666 (defvar gnus-unread-mark ? 
667   "Mark used for unread articles.")
668 (defvar gnus-ticked-mark ?!
669   "Mark used for ticked articles.")
670 (defvar gnus-dormant-mark ??
671   "Mark used for dormant articles.")
672 (defvar gnus-dread-mark ?D
673   "Mark used for read articles.")
674 (defvar gnus-read-mark ?d
675   "Mark used for read articles.")
676 (defvar gnus-expirable-mark ?E
677   "Mark used for expirable articles.")
678 (defvar gnus-killed-mark ?K
679   "Mark used for killed articles.")
680 (defvar gnus-kill-file-mark ?X
681   "Mark used for articles killed by kill files.")
682 (defvar gnus-low-score-mark ?Y
683   "Mark used for articles with a low score.")
684 (defvar gnus-catchup-mark ?C
685   "Mark used for articles that are caught up.")
686 (defvar gnus-replied-mark ?R
687   "Mark used for articles that have been replied to.")
688 (defvar gnus-process-mark ?# 
689   "Process mark.")
690 (defvar gnus-ancient-mark ?A
691   "Mark used for ancient articles.")
692 (defvar gnus-canceled-mark ?G
693   "Mark used for cancelled articles.")
694 (defvar gnus-score-over-mark ?+
695   "Score mark used for articles with high scores.")
696 (defvar gnus-score-below-mark ?-
697   "Score mark used for articles with low scores.")
698
699 (defvar gnus-view-pseudo-asynchronously nil
700   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
701
702 (defvar gnus-view-pseudos nil
703   "If `automatic', pseudo-articles will be viewed automatically.
704 If `not-confirm', pseudos will be viewed automatically, and the user
705 will not be asked to confirm the command.")
706
707 (defvar gnus-group-line-format "%M%S%5y: %(%g%)\n"
708   "Format of groups lines.
709 It works along the same lines as a normal formatting string,
710 with some simple extensions.
711
712 %M    Only marked articles (character, \"*\" or \" \")
713 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
714 %L    Level of subscribedness (integer, 1-9)
715 %N    Number of unread articles (integer)
716 %I    Number of dormant articles (integer)
717 %i    Number of ticked and dormant (integer)
718 %T    Number of ticked articles (integer)
719 %R    Number of read articles (integer)
720 %t    Total number of articles (integer)
721 %y    Number of unread, unticked articles (integer)
722 %G    Group name (string)
723 %g    Qualified group name (string)
724 %D    Group description (string)
725 %s    Select method (string)
726 %o    Moderated group (char, \"m\")
727 %O    Moderated group (string, \"(m)\" or \"\")
728 %n    Select from where (string)
729 %z    A string that look like `<%s:%n>' if a foreign select method is used
730 %u    User defined specifier. The next character in the format string should
731       be a letter.  Gnus will call the function gnus-user-format-function-X,
732       where X is the letter following %u. The function will be passed the
733       current header as argument. The function should return a string, which
734       will be inserted into the buffer just like information from any other
735       group specifier.
736
737 Text between %( and %) will be highlighted with `gnus-mouse-face' when
738 the mouse point move inside the area.  There can only be one such area.
739
740 Note that this format specification is not always respected. For
741 reasons of efficiency, when listing killed groups, this specification
742 is ignored altogether. If the spec is changed considerably, your
743 output may end up looking strange when listing both alive and killed
744 groups.
745
746 If you use %o or %O, reading the active file will be slower and quite
747 a bit of extra memory will be used. %D will also worsen performance.
748 Also note that if you change the format specification to include any
749 of these specs, you must probably re-start Gnus to see them go into
750 effect.") 
751
752 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
753   "The format specification of the lines in the summary buffer.
754
755 It works along the same lines as a normal formatting string,
756 with some simple extensions.
757
758 %N   Article number, left padded with spaces (string)
759 %S   Subject (string)
760 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
761 %n   Name of the poster (string)
762 %A   Address of the poster (string)
763 %L   Number of lines in the article (integer)
764 %c   Number of characters in the article (integer)
765 %D   Date of the article (string)
766 %I   Indentation based on thread level (a string of spaces)
767 %T   A string with two possible values: 80 spaces if the article
768      is on thread level two or larger and 0 spaces on level one
769 %U   Status of this article (character, \"D\", \"K\", \"-\" or \" \") 
770 %[   Opening bracket (character, \"[\" or \"<\")
771 %]   Closing bracket (character, \"]\" or \">\")
772 %>   Spaces of length thread-level (string)
773 %<   Spaces of length (- 20 thread-level) (string)
774 %i   Article score (number)
775 %z   Article zcore (character)
776 %u   User defined specifier. The next character in the format string should
777      be a letter.  Gnus will call the function gnus-user-format-function-X,
778      where X is the letter following %u. The function will be passed the
779      current header as argument. The function should return a string, which
780      will be inserted into the summary just like information from any other
781      summary specifier.
782
783 Text between %( and %) will be highlighted with `gnus-mouse-face'
784 when the mouse point is placed inside the area.  There can only be one
785 such area.
786
787 The %U (status), %R (replied) and %z (zcore) specs have to be handled
788 with care. For reasons of efficiency, Gnus will compute what column
789 these characters will end up in, and \"hard-code\" that. This means that
790 it is illegal to have these specs after a variable-length spec. Well,
791 you might not be arrested, but your summary buffer will look strange,
792 which is bad enough.
793
794 The smart choice is to have these specs as for to the left as
795 possible. 
796
797 This restriction may disappear in later versions of Gnus.")
798
799 (defvar gnus-summary-dummy-line-format "*   :                          : %S\n"
800   "The format specification for the dummy roots in the summary buffer.
801 It works along the same lines as a normal formatting string,
802 with some simple extensions.
803
804 %S  The subject")
805
806 (defvar gnus-summary-mode-line-format "(ding) %G/%A %Z"
807   "The format specification for the summary mode line.")
808
809 (defvar gnus-article-mode-line-format "(ding) %G/%A %S"
810   "The format specification for the article mode line.")
811
812 (defvar gnus-group-mode-line-format "(ding) List of groups   {%M:%S}  "
813   "The format specification for the group mode line.")
814
815 (defvar gnus-valid-select-methods
816   '(("nntp" post address prompt-address)
817     ("nnspool" post) ("nnvirtual" none virtual prompt-address) 
818     ("nnmbox" mail respool) ("nnml" mail respool)
819     ("nnmh" mail respool) ("nndir" none prompt-address) ("nndigest" none)
820     ("nndoc" none prompt-address) ("nnbabyl" mail respool)
821     ("nnkiboze" none virtual) ("nnfolder" mail respool))
822   "An alist of valid select methods.
823 The first element of each list lists should be a string with the name
824 of the select method. The other elements may be be the category of
825 this method (ie. `post', `mail', `none' or whatever) or other
826 properties that this method has (like being respoolable).
827 If you implement a new select method, all you should have to change is
828 this variable. I think.")
829
830 (defvar gnus-updated-mode-lines '(group article summary)
831   "List of buffers that should update their mode lines.
832 The list may contain the symbols `group', `article' and `summary'. If
833 the corresponding symbol is present, Gnus will keep that mode line
834 updated with information that may be pertinent. 
835 If this variable is nil, screen refresh may be quicker.")
836
837 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
838 (defvar gnus-mode-non-string-length 21
839   "Max length of mode-line non-string contents buffer contents.")
840
841 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
842 (defvar gnus-mouse-face 'highlight
843   "Face used for mouse highlighting in Gnus.
844 No mouse highlights will be done if `gnus-visual' is nil.")
845
846 (defvar gnus-summary-mark-below nil
847   "Mark all articles with a score below this variable as read.
848 This variable is local to each summary buffer and usually set by the
849 score file.")  
850
851 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
852   "List of functions used for sorting threads in the summary buffer.
853 By default, threads are sorted by article number.
854
855 Each function takes two threads and return non-nil if the first thread
856 should be sorted before the other.  If you use more than one function,
857 the primary sort function should be the last.
858
859 Ready-mady functions include `gnus-thread-sort-by-number',
860 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
861 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
862 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').
863
864 The latter two only work on threads that have been scored prior to
865 entering the newsgroup.")
866
867 (defvar gnus-thread-score-function '+
868   "Function used for calculating the total score of a thread.
869
870 The function is called with the scores of the article and each
871 subthread and should then return the score of the thread.
872
873 Some functions you can use are `+', `max', or `min'.")
874
875 (defvar gnus-score-find-score-files-function 'gnus-score-find-bnews
876   "Function used to find SCORE files.
877 The function will be called with the group name as the argument, and
878 should return a list of score files to apply to that group.  The score
879 files do not actually have to exist.
880
881 Predefined values are:
882
883 gnus-score-find-single: Only apply the group's own SCORE file.
884 gnus-score-find-hierarchical: Also apply SCORE files from parent groups.
885 gnus-score-find-bnews: Apply SCORE files whose names matches.
886
887 See the documentation to these functions for more information.")
888
889 (defvar gnus-options-subscribe nil
890   "All new groups matching this regexp will be subscribed unconditionally.
891 Note that this variable deals only with new newsgroups.  This variable
892 does not affect old newsgroups.")
893
894 (defvar gnus-options-not-subscribe nil
895   "All new groups matching this regexp will be ignored.
896 Note that this variable deals only with new newsgroups.  This variable
897 does not affect old (already subscribed) newsgroups.")
898
899 (defvar gnus-auto-expirable-newsgroups nil
900   "Groups in which to automatically mark read articles as expirable.
901 If non-nil, this should be a regexp that should match all groups in
902 which to perform auto-expiry. This only makes sense for mail groups.")
903
904
905 ;; Hooks.
906
907 (defvar gnus-group-mode-hook nil
908   "A hook for Gnus group mode.")
909
910 (defvar gnus-summary-mode-hook nil
911   "A hook for Gnus summary mode.")
912
913 (defvar gnus-article-mode-hook nil
914   "A hook for Gnus article mode.")
915
916 (defvar gnus-kill-file-mode-hook nil
917   "A hook for Gnus kill file mode.")
918
919 (defvar gnus-open-server-hook nil
920   "A hook called just before opening connection to the news server.")
921
922 (defvar gnus-startup-hook nil
923   "A hook called at startup.
924 This hook is called after Gnus is connected to the NNTP server.")
925
926 (defvar gnus-get-new-news-hook nil
927   "A hook run just before Gnus checks for new news.")
928
929 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
930   "A function that is called to generate the group buffer.
931 The function is called with three arguments: The first is a number;
932 all group with a level less or equal to that number should be listed,
933 if the second is non-nil, empty groups should also be displayed. If
934 the third is non-nil, it is a number. No groups with a level lower
935 than this number should be displayed.
936
937 The only current function implemented is `gnus-group-prepare-flat'.")
938
939 (defvar gnus-group-prepare-hook nil
940   "A hook called after the group buffer has been generated.
941 If you want to modify the group buffer, you can use this hook.")
942
943 (defvar gnus-summary-prepare-hook nil
944   "A hook called after the summary buffer has been generated.
945 If you want to modify the summary buffer, you can use this hook.")
946
947 (defvar gnus-article-prepare-hook nil
948   "A hook called after an article has been prepared in the article buffer.
949 If you want to run a special decoding program like nkf, use this hook.")
950
951 (defvar gnus-article-display-hook nil
952   "A hook called after the article is displayed in the article buffer.
953 The hook is designed to change the contents of the article
954 buffer. Typical functions that this hook may contain are
955 `gnus-article-hide-headers' (hide selected headers),
956 `gnus-article-hide-signature' (hide signature) and
957 `gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
958 (add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
959 (add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
960
961 (defvar gnus-select-group-hook nil
962   "A hook called when a newsgroup is selected.
963
964 If you'd like to simplify subjects like the
965 `gnus-summary-next-same-subject' command does, you can use the
966 following hook:
967
968  (setq gnus-select-group-hook
969       (list
970         (lambda ()
971           (mapcar (lambda (header)
972                      (header-set-subject
973                       header
974                       (gnus-simplify-subject
975                        (header-subject header) 're-only)))
976                   gnus-newsgroup-headers))))")
977
978 (defvar gnus-select-article-hook
979   '(gnus-summary-show-thread)
980   "A hook called when an article is selected.
981 The default hook shows conversation thread subtrees of the selected
982 article automatically using `gnus-summary-show-thread'.")
983
984 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
985   "A hook called to apply kill files to a group.
986 This hook is intended to apply a kill file to the selected newsgroup.
987 The function `gnus-apply-kill-file' is called by default.
988
989 Since a general kill file is too heavy to use only for a few
990 newsgroups, I recommend you to use a lighter hook function. For
991 example, if you'd like to apply a kill file to articles which contains
992 a string `rmgroup' in subject in newsgroup `control', you can use the
993 following hook:
994
995 \(setq gnus-apply-kill-hook
996       (list
997         (lambda ()
998           (cond ((string-match \"control\" gnus-newsgroup-name)
999                  (gnus-kill \"Subject\" \"rmgroup\")
1000                  (gnus-expunge \"X\"))))))")
1001
1002 (defvar gnus-visual-mark-article-hook 
1003   (list 'gnus-visual-highlight-selected-summary)
1004   "Hook run after selecting an article in the summary buffer.
1005 It is meant to be used for highlighting the article in some way.  It
1006 is not run if `gnus-visual' is nil.")
1007
1008 (defvar gnus-prepare-article-hook (list 'gnus-inews-insert-signature)
1009   "A hook called after preparing body, but before preparing header headers.
1010 The default hook (`gnus-inews-insert-signature') inserts a signature
1011 file specified by the variable `gnus-signature-file'.")
1012
1013 (defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc)
1014   "A hook called before finally posting an article.
1015 The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves
1016 the article to a file).")
1017
1018 (defvar gnus-inews-article-header-hook nil
1019   "A hook called after inserting the headers in an article to be posted.
1020 The hook is called from the *post-news* buffer, narrowed to the
1021 headers.")
1022
1023 (defvar gnus-exit-group-hook nil
1024   "A hook called when exiting (not quitting) summary mode.")
1025
1026 (defvar gnus-suspend-gnus-hook nil
1027   "A hook called when suspending (not exiting) Gnus.")
1028
1029 (defvar gnus-exit-gnus-hook nil
1030   "A hook called when exiting Gnus.")
1031
1032 (defvar gnus-save-newsrc-hook nil
1033   "A hook called when saving the newsrc file.")
1034
1035 (defvar gnus-visual-summary-update-hook 
1036   (list 'gnus-visual-summary-highlight-line)
1037   "A hook called when a summary line is changed.
1038 The hook will not be called if `gnus-visual' is nil.
1039
1040 The default function `gnus-visual-summary-highlight-line' will
1041 highlight the line according to the `gnus-visual-summary-highlight'
1042 variable.")
1043
1044 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1045   "A hook called when an article is selected for the first time.
1046 The hook is intended to mark an article as read (or unread)
1047 automatically when it is selected.")
1048
1049 ;; Site dependent variables. These variables should be defined in
1050 ;; paths.el.
1051
1052 (defvar gnus-default-nntp-server nil
1053   "Specify a default NNTP server.
1054 This variable should be defined in paths.el, and should never be set
1055 by the user.
1056 If you want to change servers, you should use `gnus-select-method'.
1057 See the documentation to that variable.")
1058
1059 (defconst gnus-backup-default-subscribed-newsgroups 
1060   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
1061   "Default default new newsgroups the first time Gnus is run.
1062 Should be set in paths.el, and shouldn't be touched by the user.")
1063
1064 (defvar gnus-local-domain nil
1065   "Local domain name without a host name.
1066 The DOMAINNAME environment variable is used instead if it is defined.
1067 If the `system-name' function returns the full Internet name, there is
1068 no need to set this variable.")
1069
1070 (defvar gnus-local-organization nil
1071   "String with a description of what organization (if any) the user belongs to.
1072 The ORGANIZATION environment variable is used instead if it is defined.
1073 If this variable contains a function, this function will be called
1074 with the current newsgroup name as the argument. The function should
1075 return a string.
1076 In any case, if the string (either in the variable, in the environment
1077 variable, or returned by the function) is a file name, the contents of
1078 this file will be used as the organization.")
1079
1080 (defvar gnus-use-generic-from nil
1081   "If nil, the full host name will be the system name prepended to the domain name.
1082 If this is a string, the full host name will be this string.
1083 If this is non-nil, non-string, the domain name will be used as the
1084 full host name.")
1085
1086 (defvar gnus-use-generic-path nil
1087   "If nil, use the NNTP server name in the Path header.
1088 If stringp, use this; if non-nil, use no host name (user name only).")
1089
1090 \f
1091 ;; Internal variables
1092
1093 ;; Avoid highlighting in kill files.
1094 (defvar gnus-summary-inhibit-highlight nil)
1095 (defvar gnus-newsgroup-selected-overlay nil)
1096
1097 (defvar gnus-article-mode-map nil)
1098 (defvar caesar-translate-table nil)
1099 (defvar gnus-dribble-buffer nil)
1100 (defvar gnus-headers-retrieved-by nil)
1101 (defvar gnus-article-reply nil)
1102 (defvar gnus-override-method nil)
1103 (defvar gnus-article-check-size nil)
1104 (defvar gnus-score-file-list nil)
1105 (defvar gnus-internal-global-score-files nil)
1106 (defvar gnus-current-score-file nil)
1107
1108 (defvar gnus-score-alist nil
1109   "Alist containing score information.
1110 The keys can be symbols or strings.  The following symbols are defined. 
1111
1112 touched: If this alist has been modified.
1113 mark:    Automatically mark articles below this.
1114 expunge: Automatically expunge articles below this.
1115 files:   List of other SCORE files to load when loading this one.
1116 eval:    Sexp to be evaluated when the score file is loaded.
1117
1118 String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) 
1119 where HEADER is the header being scored, MATCH is the string we are
1120 looking for, TYPE is a flag indicating whether it should use regexp or
1121 substring matching, SCORE is the score to add and DATE is the date
1122 of the last succesful match.")
1123
1124 (defvar gnus-score-cache nil)
1125 (defvar gnus-scores-articles nil)
1126 (defvar gnus-header-index nil)
1127 (defvar gnus-score-index nil)
1128
1129 (defvar gnus-newsgroup-dependencies nil)
1130 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1131 (defvar gnus-default-subscribe-level 2)
1132 (defvar gnus-default-unsubscribe-level 6)
1133 (defvar gnus-default-kill-level 9)
1134
1135 (defconst gnus-group-line-format-alist
1136   (list (list ?M 'marked ?c)
1137         (list ?S 'subscribed ?c)
1138         (list ?L 'level ?d)
1139         (list ?N 'number ?s)
1140         (list ?I 'number-of-dormant ?d)
1141         (list ?T 'number-of-ticked ?d)
1142         (list ?R 'number-of-read ?s)
1143         (list ?t 'number-total ?d)
1144         (list ?y 'number-of-unread-unticked ?s)
1145         (list ?i 'number-of-ticked-and-dormant ?d)
1146         (list ?g 'group ?s)
1147         (list ?G 'qualified-group ?s)
1148         (list ?D 'newsgroup-description ?s)
1149         (list ?o 'moderated ?c)
1150         (list ?O 'moderated-string ?s)
1151         (list ?s 'news-server ?s)
1152         (list ?n 'news-method ?s)
1153         (list ?z 'news-method-string ?s)
1154         (list ?u 'user-defined ?s)))
1155
1156 (defconst gnus-summary-line-format-alist 
1157   (list (list ?N 'number ?s)
1158         (list ?S 'subject ?s)
1159         (list ?s 'subject-or-nil ?s)
1160         (list ?n 'name ?s)
1161         (list ?A 'address ?s)
1162         (list ?F 'from ?s)
1163         (list ?x (macroexpand '(header-xref header)) ?s)
1164         (list ?D (macroexpand '(header-date header)) ?s)
1165         (list ?M (macroexpand '(header-id header)) ?s)
1166         (list ?r (macroexpand '(header-references header)) ?s)
1167         (list ?c (macroexpand '(header-chars header)) ?d)
1168         (list ?L 'lines ?d)
1169         (list ?I 'indentation ?s)
1170         (list ?T '(if (< level 1) "" (make-string (frame-width) ? )) ?s)
1171         (list ?R 'replied ?c)
1172         (list ?\[ 'opening-bracket ?c)
1173         (list ?\] 'closing-bracket ?c)
1174         (list ?\> '(make-string level ? ) ?s)
1175         (list ?\< '(make-string (max 0 (- 20 level)) ? ) ?s)
1176         (list ?i 'score ?s)
1177         (list ?z 'score-char ?c)
1178         (list ?U 'unread ?c)
1179         (list ?u 'user-defined ?s))
1180   "An alist of format specifications that can appear in summary lines,
1181 and what variables they correspond with, along with the type of the
1182 variable (string, integer, character, etc).")
1183
1184 (defconst gnus-summary-dummy-line-format-alist
1185   (list (list ?S 'subject ?s)
1186         (list ?N 'number ?d)))
1187
1188 (defconst gnus-summary-mode-line-format-alist 
1189   (list (list ?G 'group-name ?s)
1190         (list ?A 'article-number ?d)
1191         (list ?Z 'unread-and-unselected ?s)
1192         (list ?V 'gnus-version ?s)
1193         (list ?U 'unread ?d)
1194         (list ?S 'subject ?s)
1195         (list ?u 'unselected ?d)))
1196
1197 (defconst gnus-group-mode-line-format-alist 
1198   (list (list ?S 'news-server ?s)
1199         (list ?M 'news-method ?s)))
1200
1201 (defvar gnus-have-read-active-file nil)
1202
1203 (defconst gnus-maintainer "Lars Magne Ingebrigtsen <larsi@ifi.uio.no>"
1204   "The mail address of the Gnus maintainer.")
1205
1206 (defconst gnus-version "(ding) Gnus v0.40"
1207   "Version number for this version of Gnus.")
1208
1209 (defvar gnus-info-nodes
1210   '((gnus-group-mode            "(gnus)The Group Buffer")
1211     (gnus-summary-mode          "(gnus)The Summary Buffer")
1212     (gnus-article-mode          "(gnus)The Article Buffer"))
1213   "Assoc list of major modes and related Info nodes.")
1214
1215 (defvar gnus-documentation-group-file "~/dgnus/lisp/doc.txt"
1216   "The location of the (ding) Gnus documentation group.")
1217
1218 (defvar gnus-group-buffer "*Group*")
1219 (defvar gnus-summary-buffer "*Summary*")
1220 (defvar gnus-article-buffer "*Article*")
1221
1222 (defvar gnus-buffer-list nil
1223   "Gnus buffers that should be killed on exit.")
1224
1225 (defvar gnus-variable-list
1226   '(gnus-newsrc-options 
1227     gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
1228     gnus-newsrc-last-checked-date
1229     gnus-newsrc-assoc gnus-killed-list gnus-zombie-list)
1230   "Gnus variables saved in the quick startup file.")
1231
1232 (defvar gnus-overload-functions
1233   '((news-inews gnus-inews-news "rnewspost")
1234     (caesar-region gnus-caesar-region "rnews"))
1235   "Functions overloaded by gnus.
1236 It is a list of `(original overload &optional file)'.")
1237
1238 (defvar gnus-newsrc-options nil
1239   "Options line in the .newsrc file.")
1240
1241 (defvar gnus-newsrc-options-n-yes nil
1242   "Regexp representing groups to be subscribed to unconditionally.")
1243
1244 (defvar gnus-newsrc-options-n-no nil
1245   "Regexp representing group to be ignored unconditionally.")
1246
1247 (defvar gnus-newsrc-last-checked-date nil
1248   "Date Gnus last asked server for new newsgroups.")
1249
1250 (defvar gnus-newsrc-assoc nil
1251   "Assoc list of read articles.
1252 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1253
1254 (defvar gnus-newsrc-hashtb nil
1255   "Hashtable of gnus-newsrc-assoc.")
1256
1257 (defvar gnus-killed-list nil
1258   "List of killed newsgroups.")
1259
1260 (defvar gnus-killed-hashtb nil
1261   "Hash table equivalent of gnus-killed-list.")
1262
1263 (defvar gnus-zombie-list nil
1264   "List of almost dead newsgroups.")
1265
1266 (defvar gnus-description-hashtb nil
1267   "Descriptions of newsgroups.")
1268
1269 (defvar gnus-list-of-killed-groups nil
1270   "List of newsgroups that have recently been killed by the user.")
1271
1272 (defvar gnus-active-hashtb nil
1273   "Hashtable of active articles.")
1274
1275 (defvar gnus-moderated-list nil
1276   "List of moderated newsgroups.")
1277
1278 (defvar gnus-current-startup-file nil
1279   "Startup file for the current host.")
1280
1281 (defvar gnus-last-search-regexp nil
1282   "Default regexp for article search command.")
1283
1284 (defvar gnus-last-shell-command nil
1285   "Default shell command on article.")
1286
1287 (defvar gnus-current-select-method nil
1288   "The current method for selecting a newsgroup.")
1289
1290 (defvar gnus-have-all-newsgroups nil)
1291
1292 (defvar gnus-article-internal-prepare-hook nil)
1293
1294 (defvar gnus-newsgroup-name nil)
1295 (defvar gnus-newsgroup-begin nil)
1296 (defvar gnus-newsgroup-end nil)
1297 (defvar gnus-newsgroup-last-rmail nil)
1298 (defvar gnus-newsgroup-last-mail nil)
1299 (defvar gnus-newsgroup-last-folder nil)
1300 (defvar gnus-newsgroup-last-file nil)
1301 (defvar gnus-newsgroup-auto-expire nil)
1302
1303 (defvar gnus-newsgroup-unreads nil
1304   "List of unread articles in the current newsgroup.")
1305
1306 (defvar gnus-newsgroup-unselected nil
1307   "List of unselected unread articles in the current newsgroup.")
1308
1309 (defvar gnus-newsgroup-marked nil
1310   "List of ticked articles in the current newsgroup (a subset of unread art).")
1311
1312 (defvar gnus-newsgroup-killed nil
1313   "List of ranges of articles that have been through the scoring process.")
1314
1315 (defvar gnus-newsgroup-kill-headers nil)
1316
1317 (defvar gnus-newsgroup-replied nil
1318   "List of articles that have been replied to in the current newsgroup.")
1319
1320 (defvar gnus-newsgroup-expirable nil
1321   "List of articles in the current newsgroup that can be expired.")
1322
1323 (defvar gnus-newsgroup-processable nil
1324   "List of articles in the current newsgroup that can be processed.")
1325
1326 (defvar gnus-newsgroup-bookmarks nil
1327   "List of articles in the current newsgroup that have bookmarks.")
1328
1329 (defvar gnus-newsgroup-dormant nil
1330   "List of dormant articles in the current newsgroup.")
1331
1332 (defvar gnus-newsgroup-scored nil
1333   "List of scored articles in the current newsgroup.")
1334
1335 (defvar gnus-newsgroup-headers nil
1336   "List of article headers in the current newsgroup.")
1337 (defvar gnus-newsgroup-headers-hashtb-by-number nil)
1338
1339 (defvar gnus-newsgroup-ancient nil
1340   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1341
1342 (defvar gnus-current-article nil)
1343 (defvar gnus-article-current nil)
1344 (defvar gnus-current-headers nil)
1345 (defvar gnus-have-all-headers nil)
1346 (defvar gnus-last-article nil)
1347 (defvar gnus-newsgroup-history nil)
1348 (defvar gnus-current-kill-article nil)
1349
1350 ;; Save window configuration.
1351 (defvar gnus-winconf-kill-file nil)
1352 (defvar gnus-winconf-edit-group nil)
1353 (defvar gnus-winconf-edit-score nil)
1354
1355 ;; Format specs
1356 (defvar gnus-summary-line-format-spec nil)
1357 (defvar gnus-summary-dummy-line-format-spec nil)
1358 (defvar gnus-group-line-format-spec nil)
1359 (defvar gnus-summary-mode-line-format-spec nil)
1360 (defvar gnus-article-mode-line-format-spec nil)
1361 (defvar gnus-group-mode-line-format-spec nil)
1362 (defvar gnus-summary-mark-positions nil)
1363
1364 (defvar gnus-summary-expunge-below nil)
1365 (defvar gnus-reffed-article-number nil)
1366
1367 (defvar rmail-default-file (expand-file-name "~/XMBOX"))
1368 (defvar rmail-default-rmail-file (expand-file-name "~/XNEWS"))
1369
1370 (defconst gnus-summary-local-variables 
1371   '(gnus-newsgroup-name 
1372     gnus-newsgroup-begin gnus-newsgroup-end 
1373     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail 
1374     gnus-newsgroup-last-folder gnus-newsgroup-last-file 
1375     gnus-newsgroup-auto-expire gnus-newsgroup-unreads 
1376     gnus-newsgroup-unselected gnus-newsgroup-marked
1377     gnus-newsgroup-replied gnus-newsgroup-expirable
1378     gnus-newsgroup-processable gnus-newsgroup-killed
1379     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1380     gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number
1381     gnus-current-article gnus-current-headers gnus-have-all-headers
1382     gnus-last-article gnus-article-internal-prepare-hook
1383     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1384     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1385     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below 
1386     (gnus-summary-mark-below . gnus-summary-default-score)
1387     gnus-newsgroup-history gnus-newsgroup-ancient)
1388   "Variables that are buffer-local to the summary buffers.")
1389
1390 ;;; End of variables.
1391
1392 ;; Define some autoload functions Gnus might use.
1393 (eval-and-compile
1394   (autoload 'metamail-buffer "metamail")
1395   (autoload 'Info-goto-node "info")
1396   
1397   (autoload 'timezone-make-date-arpa-standard "timezone")
1398   (autoload 'timezone-fix-time "timezone")
1399   (autoload 'timezone-make-sortable-date "timezone")
1400   (autoload 'timezone-make-time-string "timezone")
1401   
1402   (autoload 'rmail-output "rmailout")
1403   (autoload 'mail-position-on-field "sendmail")
1404   (autoload 'mail-setup "sendmail")
1405   (autoload 'news-mail-other-window "rnewspost")
1406
1407   (autoload 'gnus-mail-reply-using-mhe "gnus-mh")
1408   (autoload 'gnus-mail-forward-using-mhe "gnus-mh")
1409   (autoload 'gnus-mail-other-window-using-mhe "gnus-mh")
1410   (autoload 'gnus-summary-save-in-folder "gnus-mh")
1411   (autoload 'gnus-Folder-save-name "gnus-mh")
1412   (autoload 'gnus-folder-save-name "gnus-mh")
1413   
1414   (autoload 'gnus-group-make-menu-bar "gnus-visual")
1415   (autoload 'gnus-summary-make-menu-bar "gnus-visual")
1416   (autoload 'gnus-article-make-menu-bar "gnus-visual")
1417   (autoload 'gnus-visual-highlight-selected-summary "gnus-visual")
1418   (autoload 'gnus-visual-summary-highlight-line "gnus-visual")
1419
1420   (autoload 'gnus-uu-mark-by-regexp "gnus-uu")
1421   (autoload 'gnus-uu-mark-region "gnus-uu")
1422   (autoload 'gnus-uu-mark-thread "gnus-uu")
1423   (autoload 'gnus-uu-mark-sparse "gnus-uu")
1424   (autoload 'gnus-uu-mark-series "gnus-uu")
1425   (autoload 'gnus-uu-mark-all "gnus-uu")
1426   (autoload 'gnus-uu-post-news "gnus-uu")
1427   (autoload 'gnus-uu-digest-and-forward "gnus-uu")
1428
1429   (autoload 'gnus-uu-decode-uu "gnus-uu")
1430   (autoload 'gnus-uu-decode-uu-and-save "gnus-uu")
1431   (autoload 'gnus-uu-decode-unshar "gnus-uu")
1432   (autoload 'gnus-uu-decode-unshar-and-save "gnus-uu")
1433   (autoload 'gnus-uu-decode-save "gnus-uu")
1434   (autoload 'gnus-uu-decode-binhex "gnus-uu")
1435   (autoload 'gnus-uu-decode-uu-view "gnus-uu")
1436   (autoload 'gnus-uu-decode-uu-and-save-view "gnus-uu")
1437   (autoload 'gnus-uu-decode-unshar-view "gnus-uu")
1438   (autoload 'gnus-uu-decode-unshar-and-save-view "gnus-uu")
1439   (autoload 'gnus-uu-decode-save-view "gnus-uu")
1440   (autoload 'gnus-uu-decode-binhex-view "gnus-uu")
1441
1442   (autoload 'pp "pp")
1443   (autoload 'pp-to-string "pp")
1444   (autoload 'mail-extract-address-components "mail-extr")
1445   )
1446
1447 (put 'gnus-group-mode 'mode-class 'special)
1448 (put 'gnus-summary-mode 'mode-class 'special)
1449 (put 'gnus-article-mode 'mode-class 'special)
1450
1451 \f
1452
1453 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1454 (defun gnus-summary-position-cursor () nil)
1455 (defun gnus-group-position-cursor () nil)
1456 (fset 'gnus-summary-position-cursor 'gnus-goto-colon)
1457 (fset 'gnus-group-position-cursor 'gnus-goto-colon)
1458
1459 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
1460   "Pop to BUFFER, evaluate FORMS, and then returns to original window."
1461   (` (let ((GnusStartBufferWindow (selected-window)))
1462        (unwind-protect
1463            (progn
1464              (pop-to-buffer (, buffer))
1465              (,@ forms))
1466          (select-window GnusStartBufferWindow)))))
1467
1468 (defun gnus-make-hashtable (&optional hashsize)
1469   "Make a hash table (default and minimum size is 255).
1470 Optional argument HASHSIZE specifies the table size."
1471   (make-vector (if hashsize 
1472                    (max (gnus-create-hash-size hashsize) 255)
1473                  255) 0))
1474
1475 (defmacro gnus-gethash (string hashtable)
1476   "Get hash value of STRING in HASHTABLE."
1477   ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
1478   ;;(` (abbrev-expansion (, string) (, hashtable)))
1479   (` (symbol-value (intern-soft (, string) (, hashtable)))))
1480
1481 (defmacro gnus-sethash (string value hashtable)
1482   "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
1483   ;; We cannot use define-abbrev since it only accepts string as value.
1484                                         ;  (set (intern string hashtable) value))
1485   (` (set (intern (, string) (, hashtable)) (, value))))
1486
1487 (defsubst gnus-buffer-substring (beg end)
1488   (buffer-substring (match-beginning beg) (match-end end)))
1489
1490 (defsubst gnus-simplify-subject-re (subject)
1491   "Remove \"Re:\" from subject lines."
1492   (let ((case-fold-search t))
1493     (if (string-match "^re: *" subject)
1494         (substring subject (match-end 0))
1495       subject)))
1496
1497 (defsubst gnus-goto-char (point)
1498   (and point (goto-char point)))
1499
1500 \f
1501 ;;;
1502 ;;; Gnus Utility Functions
1503 ;;;
1504
1505 (defun gnus-extract-address-components (from)
1506   (let (name address)
1507     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
1508         (setq address (substring from (match-beginning 0) (match-end 0))))
1509     (and address
1510          (string-match (concat "<" (regexp-quote address) ">") from)
1511          (setq name (substring from 0 (1- (match-beginning 0)))))
1512     (or name
1513         (and (string-match "(.+)" from)
1514              (setq name (substring from (1+ (match-beginning 0)) 
1515                                    (1- (match-end 0))))))
1516     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1517     (list (or name from) (or address from))))
1518
1519 (defun gnus-fetch-field (field)
1520   "Return the value of the header FIELD of current article."
1521   (save-excursion
1522     (save-restriction
1523       (gnus-narrow-to-headers)
1524       (mail-fetch-field field))))
1525
1526 (defun gnus-goto-colon ()
1527   (beginning-of-line)
1528   (search-forward ":" (save-excursion (end-of-line) (point)) t))
1529
1530 (defun gnus-narrow-to-headers ()
1531   (widen)
1532   (save-excursion
1533     (goto-char 1)
1534     (if (search-forward "\n\n")
1535         (narrow-to-region 1 (1- (point))))))
1536
1537 ;; Get a number that is suitable for hashing; bigger than MIN
1538 (defun gnus-create-hash-size (min)
1539   (let ((i 1))
1540     (while (< i min)
1541       (setq i (* 2 i)))
1542     (1- i)))
1543
1544 (defun gnus-update-format-specifications ()
1545   (setq gnus-summary-line-format-spec 
1546         (gnus-parse-format
1547          gnus-summary-line-format gnus-summary-line-format-alist))
1548   (gnus-update-summary-mark-positions)
1549   (setq gnus-summary-dummy-line-format-spec 
1550         (gnus-parse-format gnus-summary-dummy-line-format 
1551                            gnus-summary-dummy-line-format-alist))
1552   (setq gnus-group-line-format-spec
1553         (gnus-parse-format 
1554          gnus-group-line-format 
1555          gnus-group-line-format-alist))
1556   (if (and (string-match "%D" gnus-group-line-format)
1557            (not gnus-description-hashtb)
1558            gnus-read-active-file)
1559       (gnus-read-descriptions-file))
1560   (setq gnus-summary-mode-line-format-spec 
1561         (gnus-parse-format gnus-summary-mode-line-format 
1562                            gnus-summary-mode-line-format-alist))
1563   (setq gnus-article-mode-line-format-spec 
1564         (gnus-parse-format gnus-article-mode-line-format 
1565                            gnus-summary-mode-line-format-alist))
1566   (setq gnus-group-mode-line-format-spec 
1567         (gnus-parse-format gnus-group-mode-line-format 
1568                            gnus-group-mode-line-format-alist)))
1569
1570 (defun gnus-update-summary-mark-positions ()
1571   (save-excursion
1572     (let ((gnus-replied-mark 129)
1573           (gnus-score-below-mark 130)
1574           (gnus-score-over-mark 130)
1575           pos)
1576       (set-buffer (get-buffer-create " *gnus work*"))
1577       (buffer-disable-undo (current-buffer))
1578       (erase-buffer)
1579       (gnus-summary-insert-line 
1580        nil [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
1581       (goto-char (point-min))
1582       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
1583                                          (- (point) 2)))))
1584       (goto-char (point-min))
1585       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
1586                                           (- (point) 2))) pos))
1587       (goto-char (point-min))
1588       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
1589                                         (- (point) 2))) pos))
1590       (setq gnus-summary-mark-positions pos)
1591       (kill-buffer (current-buffer)))))
1592
1593 (defun gnus-format-max-width (var length)
1594   (let (result)
1595     (if (> (length (setq result (eval var))) length)
1596         (format "%s" (substring result 0 length))
1597       (format "%s" result))))
1598
1599 (defun gnus-set-mouse-face (string)
1600   ;; Set mouse face property on STRING.
1601   (put-text-property 0 (length string) 'mouse-face gnus-mouse-face string)
1602   string)
1603
1604 (defun gnus-parse-format (format spec-alist)
1605   ;; This function parses the FORMAT string with the help of the
1606   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1607   ;; string.  If the FORMAT string contains the specifiers %( and %)
1608   ;; the text between them will have the mouse-face text property.
1609   (if (string-match "\\`\\(.*\\)%(\\(.*\\)%)\\(.*\n?\\)\\'" format)
1610       (if (and gnus-visual gnus-mouse-face)
1611           (let ((pre (substring format (match-beginning 1) (match-end 1)))
1612                 (button (substring format (match-beginning 2) (match-end 2)))
1613                 (post (substring format (match-beginning 3) (match-end 3))))
1614             (list 'concat
1615                   (gnus-parse-simple-format pre spec-alist)
1616                   (list 'gnus-set-mouse-face
1617                         (gnus-parse-simple-format button spec-alist))
1618                   (gnus-parse-simple-format post spec-alist)))
1619         (gnus-parse-simple-format
1620          (concat (substring format (match-beginning 1) (match-end 1))
1621                  (substring format (match-beginning 2) (match-end 2))
1622                  (substring format (match-beginning 3) (match-end 3)))
1623          spec-alist))
1624     (gnus-parse-simple-format format spec-alist)))
1625
1626 (defun gnus-parse-simple-format (format spec-alist)
1627   ;; This function parses the FORMAT string with the help of the
1628   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1629   ;; string. The list will consist of the symbol `format', a format
1630   ;; specification string, and a list of forms depending on the
1631   ;; SPEC-ALIST.
1632   (let ((max-width 0)
1633         spec flist fstring b newspec max-width elem beg)
1634     (save-excursion
1635       (set-buffer (get-buffer-create " *gnus work*"))
1636       (buffer-disable-undo (current-buffer))
1637       (gnus-add-current-to-buffer-list)
1638       (erase-buffer)
1639       (insert format)
1640       (goto-char 1)
1641       (while (re-search-forward "%[-0-9]*\\(,[0-9]*\\)*\\(.\\)\\(.\\)?" nil t)
1642         (setq spec (string-to-char (buffer-substring (match-beginning 2)
1643                                                      (match-end 2))))
1644         ;; First check if there are any specs that look anything like
1645         ;; "%12,12A", ie. with a "max width specification". These have
1646         ;; to be treated specially.
1647         (if (setq beg (match-beginning 1))
1648             (setq max-width 
1649                   (string-to-int 
1650                    (buffer-substring (1+ (match-beginning 1)) (match-end 1))))
1651           (setq max-width 0)
1652           (setq beg (match-beginning 2)))
1653         ;; Find the specification from `spec-alist'.
1654         (if (not (setq elem (cdr (assq spec spec-alist))))
1655             (setq elem '("*" ?s)))
1656         ;; Treat user defined format specifiers specially
1657         (and (eq (car elem) 'user-defined)
1658              (setq elem
1659                    (list 
1660                     (list (intern (concat "gnus-user-format-function-"
1661                                           (buffer-substring
1662                                            (match-beginning 3)
1663                                            (match-end 3))))
1664                           'header)
1665                     ?s))
1666              (delete-region (match-beginning 3) (match-end 3)))
1667         (if (not (zerop max-width))
1668             (let ((el (car elem)))
1669               (cond ((= (car (cdr elem)) ?c) 
1670                      (setq el (list 'char-to-string el)))
1671                     ((= (car (cdr elem)) ?d)
1672                      (numberp el) (setq el (list 'int-to-string el))))
1673               (setq flist (cons (list 'gnus-format-max-width 
1674                                       el max-width) 
1675                                 flist))
1676               (setq newspec ?s))
1677           (setq flist (cons (car elem) flist))
1678           (setq newspec (car (cdr elem))))
1679         ;; Remove the old specification (and possibly a ",12" string).
1680         (delete-region beg (match-end 2))
1681         ;; Insert the new specification.
1682         (goto-char beg)
1683         (insert newspec))
1684       (setq fstring (buffer-substring 1 (point-max))))
1685     (cons 'format (cons fstring (nreverse flist)))))
1686
1687 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
1688 (defun gnus-read-init-file ()
1689   (and gnus-init-file
1690        (or (file-exists-p gnus-init-file)
1691            (file-exists-p (concat gnus-init-file ".el"))
1692            (file-exists-p (concat gnus-init-file ".elc")))
1693        (load gnus-init-file nil t)))
1694
1695 ;; Article file names when saving.
1696
1697 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
1698   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1699 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
1700 Otherwise, it is like ~/News/news/group/num."
1701   (let ((default
1702           (expand-file-name
1703            (concat (if gnus-use-long-file-name
1704                        (gnus-capitalize-newsgroup newsgroup)
1705                      (gnus-newsgroup-directory-form newsgroup))
1706                    "/" (int-to-string (header-number headers)))
1707            (or gnus-article-save-directory "~/News"))))
1708     (if (and last-file
1709              (string-equal (file-name-directory default)
1710                            (file-name-directory last-file))
1711              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
1712         default
1713       (or last-file default))))
1714
1715 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
1716   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1717 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
1718 Otherwise, it is like ~/News/news/group/num."
1719   (let ((default
1720           (expand-file-name
1721            (concat (if gnus-use-long-file-name
1722                        newsgroup
1723                      (gnus-newsgroup-directory-form newsgroup))
1724                    "/" (int-to-string (header-number headers)))
1725            (or gnus-article-save-directory "~/News"))))
1726     (if (and last-file
1727              (string-equal (file-name-directory default)
1728                            (file-name-directory last-file))
1729              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
1730         default
1731       (or last-file default))))
1732
1733 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
1734   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1735 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
1736 Otherwise, it is like ~/News/news/group/news."
1737   (or last-file
1738       (expand-file-name
1739        (if gnus-use-long-file-name
1740            (gnus-capitalize-newsgroup newsgroup)
1741          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
1742        (or gnus-article-save-directory "~/News"))))
1743
1744 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
1745   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1746 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
1747 Otherwise, it is like ~/News/news/group/news."
1748   (or last-file
1749       (expand-file-name
1750        (if gnus-use-long-file-name
1751            newsgroup
1752          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
1753        (or gnus-article-save-directory "~/News"))))
1754
1755 ;; For subscribing new newsgroup
1756
1757 (defun gnus-subscribe-hierarchical-interactive (groups)
1758   (let ((groups (sort groups 'string<))
1759         prefixes prefix start rest ans group starts)
1760     (while groups
1761       (setq prefixes (list "^"))
1762       (while (and groups prefixes)
1763         (while (not (string-match (car prefixes) (car groups)))
1764           (setq prefixes (cdr prefixes)))
1765         (setq prefix (car prefixes))
1766         (setq start (1- (length prefix)))
1767         (if (and (string-match "[^\\.]\\." (car groups) start)
1768                  (cdr groups)
1769                  (setq prefix 
1770                        (concat "^" (substring (car groups) 0 (match-end 0))))
1771                  (string-match prefix (car (cdr groups))))
1772             (progn
1773               (setq prefixes (cons prefix prefixes))
1774               (message "Descend hierarchy %s? ([y]nsq): " 
1775                        (substring prefix 1 (1- (length prefix))))
1776               (setq ans (read-char))
1777               (cond ((= ans ?n)
1778                      (while (and groups 
1779                                  (string-match prefix 
1780                                                (setq group (car groups))))
1781                        (setq gnus-killed-list 
1782                              (cons group gnus-killed-list))
1783                        (gnus-sethash group group gnus-killed-hashtb)
1784                        (setq groups (cdr groups)))
1785                      (setq starts (cdr starts)))
1786                     ((= ans ?s)
1787                      (while (and groups 
1788                                  (string-match prefix 
1789                                                (setq group (car groups))))
1790                        (gnus-sethash group group gnus-killed-hashtb)
1791                        (gnus-subscribe-alphabetically (car groups))
1792                        (setq groups (cdr groups)))
1793                      (setq starts (cdr starts)))
1794                     ((= ans ?q)
1795                      (while groups
1796                        (setq group (car groups))
1797                        (setq gnus-killed-list (cons group gnus-killed-list))
1798                        (gnus-sethash group group gnus-killed-hashtb)
1799                        (setq groups (cdr groups))))
1800                     (t nil)))
1801           (message "Subscribe %s? ([n]yq)" (car groups))
1802           (setq ans (read-char))
1803           (setq group (car groups))
1804           (cond ((= ans ?y)
1805                  (gnus-subscribe-alphabetically (car groups))
1806                  (gnus-sethash group group gnus-killed-hashtb))
1807                 ((= ans ?q)
1808                  (while groups
1809                    (setq group (car groups))
1810                    (setq gnus-killed-list (cons group gnus-killed-list))
1811                    (gnus-sethash group group gnus-killed-hashtb)
1812                    (setq groups (cdr groups))))
1813                 (t 
1814                  (setq gnus-killed-list (cons group gnus-killed-list))
1815                  (gnus-sethash group group gnus-killed-hashtb)))
1816           (setq groups (cdr groups)))))))
1817
1818 (defun gnus-subscribe-randomly (newsgroup)
1819   "Subscribe new NEWSGROUP by making it the first newsgroup."
1820   (gnus-subscribe-newsgroup newsgroup))
1821
1822 (defun gnus-subscribe-alphabetically (newgroup)
1823   "Subscribe new NEWSGROUP and insert it in alphabetical order."
1824   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
1825   (let ((groups (cdr gnus-newsrc-assoc))
1826         before)
1827     (while (and (not before) groups)
1828       (if (string< newgroup (car (car groups)))
1829           (setq before (car (car groups)))
1830         (setq groups (cdr groups))))
1831     (gnus-subscribe-newsgroup newgroup before)))
1832
1833 (defun gnus-subscribe-hierarchically (newgroup)
1834   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
1835   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
1836   (save-excursion
1837     (set-buffer (find-file-noselect gnus-current-startup-file))
1838     (let ((groupkey newgroup)
1839           before)
1840       (while (and (not before) groupkey)
1841         (goto-char (point-min))
1842         (let ((groupkey-re
1843                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
1844           (while (and (re-search-forward groupkey-re nil t)
1845                       (progn
1846                         (setq before (buffer-substring
1847                                       (match-beginning 1) (match-end 1)))
1848                         (string< before newgroup)))))
1849         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
1850         (setq groupkey
1851               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
1852                   (substring groupkey (match-beginning 1) (match-end 1)))))
1853       (gnus-subscribe-newsgroup newgroup before))))
1854
1855 (defun gnus-subscribe-interactively (newsgroup)
1856   "Subscribe new NEWSGROUP interactively.
1857 It is inserted in hierarchical newsgroup order if subscribed. If not,
1858 it is killed."
1859   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
1860       (gnus-subscribe-hierarchically newsgroup)
1861     (setq gnus-killed-list (cons newsgroup gnus-killed-list))))
1862
1863 (defun gnus-subscribe-zombies (newsgroup)
1864   "Make new NEWSGROUP a zombie group."
1865   (setq gnus-zombie-list (cons newsgroup gnus-zombie-list)))
1866
1867 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
1868   "Subscribe new NEWSGROUP.
1869 If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
1870 the first newsgroup."
1871   ;; We subscribe the group by changing its level to 3.
1872   (gnus-group-change-level 
1873    newsgroup 3 9 (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
1874   (message "Subscribe newsgroup: %s" newsgroup))
1875
1876 ;; For directories
1877
1878 (defun gnus-newsgroup-directory-form (newsgroup)
1879   "Make hierarchical directory name from NEWSGROUP name."
1880   (let ((newsgroup (substring newsgroup 0)) ;Copy string.
1881         (len (length newsgroup))
1882         (idx 0))
1883     ;; Replace all occurrences of `.' with `/'.
1884     (while (< idx len)
1885       (if (= (aref newsgroup idx) ?.)
1886           (aset newsgroup idx ?/))
1887       (setq idx (1+ idx)))
1888     newsgroup
1889     ))
1890
1891 (defun gnus-make-directory (dir)
1892   "Make DIRECTORY recursively."
1893   (let* ((dir (expand-file-name dir default-directory))
1894          dirs)
1895     (if (string-match "/$" dir)
1896         (setq dir (substring dir 0 (match-beginning 0))))
1897     (while (not (file-exists-p dir))
1898       (setq dirs (cons dir dirs))
1899       (string-match "/[^/]+$" dir)
1900       (setq dir (substring dir 0 (match-beginning 0))))
1901     (while dirs
1902       (make-directory (car dirs))
1903       (setq dirs (cdr dirs)))))
1904
1905 (defun gnus-capitalize-newsgroup (newsgroup)
1906   "Capitalize NEWSGROUP name."
1907   (and (not (zerop (length newsgroup)))
1908        (concat (char-to-string (upcase (aref newsgroup 0)))
1909                (substring newsgroup 1))))
1910
1911 ;; Var
1912
1913 (defun gnus-simplify-subject (subject &optional re-only)
1914   "Remove `Re:' and words in parentheses.
1915 If optional argument RE-ONLY is non-nil, strip `Re:' only."
1916   (let ((case-fold-search t))           ;Ignore case.
1917     ;; Remove `Re:' and `Re^N:'.
1918     (if (string-match "^re:[ \t]*" subject)
1919         (setq subject (substring subject (match-end 0))))
1920     ;; Remove words in parentheses from end.
1921     (or re-only
1922         (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
1923           (setq subject (substring subject 0 (match-beginning 0)))))
1924     ;; Return subject string.
1925     subject
1926     ))
1927
1928 (defun gnus-add-current-to-buffer-list ()
1929   (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))
1930
1931 ;; Functions accessing headers.
1932 ;; Functions are more convenient than macros in some cases.
1933
1934 (defun gnus-header-number (header)
1935   "Return article number in HEADER."
1936   (header-number header))
1937
1938 (defun gnus-header-subject (header)
1939   "Return subject string in HEADER."
1940   (header-subject header))
1941
1942 (defun gnus-header-from (header)
1943   "Return author string in HEADER."
1944   (header-from header))
1945
1946 (defun gnus-header-xref (header)
1947   "Return xref string in HEADER."
1948   (header-xref header))
1949
1950 (defun gnus-header-lines (header)
1951   "Return lines in HEADER."
1952   (header-lines header))
1953
1954 (defun gnus-header-date (header)
1955   "Return date in HEADER."
1956   (header-date header))
1957
1958 (defun gnus-header-id (header)
1959   "Return Id in HEADER."
1960   (header-id header))
1961
1962 (defun gnus-header-references (header)
1963   "Return references in HEADER."
1964   (header-references header))
1965
1966 (defun gnus-clear-system ()
1967   "Clear all variables and buffers."
1968   ;; Clear Gnus variables.
1969   (let ((variables gnus-variable-list))
1970     (while variables
1971       (set (car variables) nil)
1972       (setq variables (cdr variables))))
1973   ;; Clear other internal variables.
1974   (setq gnus-list-of-killed-groups nil
1975         gnus-have-read-active-file nil
1976         gnus-newsrc-assoc nil
1977         gnus-newsrc-hashtb nil
1978         gnus-killed-list nil
1979         gnus-zombie-list nil
1980         gnus-killed-hashtb nil
1981         gnus-active-hashtb nil
1982         gnus-moderated-list nil
1983         gnus-description-hashtb nil
1984         gnus-newsgroup-headers nil
1985         gnus-score-cache nil
1986         gnus-newsgroup-headers-hashtb-by-number nil
1987         gnus-newsgroup-name nil
1988         gnus-internal-global-score-files nil
1989         gnus-current-select-method nil)
1990   ;; Kill the startup file.
1991   (and gnus-current-startup-file
1992        (get-file-buffer gnus-current-startup-file)
1993        (kill-buffer (get-file-buffer gnus-current-startup-file)))
1994   (gnus-dribble-clear)
1995   ;; Kill global KILL file buffer.
1996   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
1997       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
1998   ;; Kill Gnus buffers.
1999   (while gnus-buffer-list
2000     (if (and (get-buffer (car gnus-buffer-list))
2001              (buffer-name (get-buffer (car gnus-buffer-list))))
2002         (kill-buffer (car gnus-buffer-list)))
2003     (setq gnus-buffer-list (cdr gnus-buffer-list))))
2004
2005 (defun gnus-configure-windows (action &optional force)
2006   "Configure Gnus windows according to the next ACTION.
2007 The ACTION is either a symbol, such as `summary', or a
2008 configuration list such as `(1 1 2)'.  If ACTION is not a list,
2009 configuration list is got from the variable gnus-window-configuration.
2010 If FORCE is non-nil, the updating will be done whether it is necessary
2011 or not."
2012   (let* ((windows
2013           (if (listp action) action 
2014             (if (listp gnus-window-configuration)
2015                 (car (cdr (assq action gnus-window-configuration)))
2016               gnus-window-configuration)))
2017          (grpwin (get-buffer-window gnus-group-buffer))
2018          (subwin (get-buffer-window gnus-summary-buffer))
2019          (artwin (get-buffer-window gnus-article-buffer))
2020          (winsum nil)
2021          (height nil)
2022          (grpheight 0)
2023          (subheight 0)
2024          (artheight 0)
2025
2026          ;; Make split-window-vertically leave focus in upper window.
2027          (split-window-keep-point t))
2028     (if (and (symbolp windows) (fboundp windows))
2029         (funcall windows action)
2030       (if (and (not force)
2031                (or (null windows)               ;No configuration is specified.
2032                    (and (eq (null grpwin)
2033                             (zerop (nth 0 windows)))
2034                         (eq (null subwin)
2035                             (zerop (nth 1 windows)))
2036                         (eq (null artwin)
2037                             (zerop (nth 2 windows))))))
2038           ;; No need to change window configuration.
2039           nil
2040         (select-window (or grpwin subwin artwin (selected-window)))
2041         ;; First of all, compute the height of each window.
2042         (cond (gnus-use-full-window
2043                ;; Take up the entire screen.
2044                (delete-other-windows)
2045                (setq height (window-height (selected-window))))
2046               (t
2047                (setq height (+ (if grpwin (window-height grpwin) 0)
2048                                (if subwin (window-height subwin) 0)
2049                                (if artwin (window-height artwin) 0)))))
2050         ;; The group buffer exits always. So, use it to extend the
2051         ;; group window so as to get enough window space.
2052         (switch-to-buffer gnus-group-buffer 'norecord)
2053         (and (get-buffer gnus-summary-buffer)
2054              (delete-windows-on gnus-summary-buffer))
2055         (and (get-buffer gnus-article-buffer)
2056              (delete-windows-on gnus-article-buffer))
2057         ;; Compute expected window height.
2058         (setq winsum (apply (function +) windows))
2059         (if (not (zerop (nth 0 windows)))
2060             (setq grpheight (max window-min-height
2061                                  (/ (* height (nth 0 windows)) winsum))))
2062         (if (not (zerop (nth 1 windows)))
2063             (setq subheight (max window-min-height
2064                                  (/ (* height (nth 1 windows)) winsum))))
2065         (if (not (zerop (nth 2 windows)))
2066             (setq artheight (max window-min-height
2067                                  (/ (* height (nth 2 windows)) winsum))))
2068         (setq height (+ grpheight subheight artheight))
2069         (enlarge-window (max 0 (- height (window-height (selected-window)))))
2070         ;; Then split the window.
2071         (and (not (zerop artheight))
2072              (or (not (zerop grpheight))
2073                  (not (zerop subheight)))
2074              (split-window-vertically (+ grpheight subheight)))
2075         (and (not (zerop grpheight))
2076              (not (zerop subheight))
2077              (split-window-vertically grpheight))
2078         ;; Then select buffers in each window.
2079         (or (zerop grpheight)
2080             (progn
2081               (switch-to-buffer gnus-group-buffer 'norecord)
2082               (other-window 1)))
2083         (or (zerop subheight)
2084             (progn
2085               (switch-to-buffer gnus-summary-buffer 'norecord)
2086               (other-window 1)))
2087         (or (zerop artheight)
2088             (progn
2089               ;; If article buffer does not exist, it will be created
2090               ;; and initialized.
2091               (gnus-article-setup-buffer)
2092               (switch-to-buffer gnus-article-buffer 'norecord)
2093               (setq buffer-read-only t) ; !!! Why!?! 
2094               (bury-buffer gnus-summary-buffer)
2095               (bury-buffer gnus-group-buffer)))
2096         (or (zerop subheight)
2097             (progn
2098               (pop-to-buffer gnus-summary-buffer)
2099               ;; It seems that some code in this function will set
2100               ;; buffer-read-only to nil. I have absolutely no idea
2101               ;; why. 
2102               (setq buffer-read-only t))))))) ; !!! Why!?! 
2103
2104 (defun gnus-window-configuration-split (action)
2105   (switch-to-buffer gnus-group-buffer t)
2106   (delete-other-windows)
2107   (split-window-horizontally)
2108   (cond ((or (eq action 'newsgoups) (eq action 'summary))
2109          (if (and (get-buffer gnus-summary-buffer)
2110                   (buffer-name gnus-summary-buffer))
2111              (switch-to-buffer-other-window gnus-summary-buffer)))
2112         ((eq action 'article)
2113          (switch-to-buffer gnus-summary-buffer t)
2114          (other-window 1)
2115          (gnus-article-setup-buffer)
2116          (switch-to-buffer gnus-article-buffer t))))
2117
2118 (defun gnus-version ()
2119   "Version numbers of this version of Gnus."
2120   (interactive)
2121   (let ((methods gnus-valid-select-methods)
2122         (mess gnus-version)
2123         meth)
2124     ;; Go through all the legal select methods and add their version
2125     ;; numbers to the total version string. Only the backends that are
2126     ;; currently in use will have their message numbers taken into
2127     ;; consideration. 
2128     (while methods
2129       (setq meth (intern (concat (car (car methods)) "-version")))
2130       (and (boundp meth)
2131            (stringp (symbol-value meth))
2132            (setq mess (concat mess "; " (symbol-value meth))))
2133       (setq methods (cdr methods)))
2134     (message mess)))
2135
2136 (defun gnus-info-find-node ()
2137   "Find Info documentation of Gnus."
2138   (interactive)
2139   ;; Enlarge info window if needed.
2140   (cond ((eq major-mode 'gnus-group-mode)
2141          (gnus-configure-windows '(1 0 0)) ;Take all windows.
2142          (pop-to-buffer gnus-group-buffer))
2143         ((eq major-mode 'gnus-summary-mode)
2144          (gnus-configure-windows '(0 1 0)) ;Take all windows.
2145          (pop-to-buffer gnus-summary-buffer)))
2146   (Info-goto-node (car (cdr (assq major-mode gnus-info-nodes)))))
2147
2148 (defun gnus-bug ()
2149   "Send a bug report to the Gnus maintainers."
2150   (interactive)
2151   (pop-to-buffer "*Gnus Bug*")
2152   (erase-buffer)
2153   (mail-setup gnus-maintainer "[Gnus Bug Report] " nil nil nil nil)
2154   (goto-char (point-min))
2155   (search-forward mail-header-separator)
2156   (forward-line 1)
2157   (insert (format "%s\n%s\n\n" (gnus-version) (emacs-version)))
2158   (gnus-debug)
2159   (mail-mode)
2160   (message ""))
2161
2162 (defun gnus-debug ()
2163   "Attemps to go through the Gnus source file and report what variables have been changed.
2164 The source file has to be in the Emacs load path."
2165   (interactive)
2166   (let ((dirs load-path)
2167         file expr olist)
2168     (while dirs
2169       (if (file-exists-p (setq file (concat (car dirs) "/gnus.el")))
2170           (save-excursion
2171             (setq dirs nil)
2172             (set-buffer (get-buffer-create "*gnus bug info*"))
2173             (buffer-disable-undo (current-buffer))
2174             (erase-buffer)
2175             (insert-file-contents file)
2176             (goto-char (point-min))
2177             (or (search-forward "\n;; Internal variables" nil t)
2178                 (error "Malformed sources"))
2179             (narrow-to-region (point-min) (point))
2180             (goto-char (point-min))
2181             (while (setq expr (condition-case () 
2182                                   (read (current-buffer)) (error nil)))
2183               (and (eq (car expr) 'defvar)
2184                    (stringp (nth 3 expr))
2185                    (not (equal (eval (nth 2 expr))
2186                                (and (boundp (nth 1 expr))
2187                                     (symbol-value (nth 1 expr)))))
2188                    (setq olist (cons (nth 1 expr) olist))))
2189             (kill-buffer (current-buffer)))
2190         (setq dirs (cdr dirs))))
2191     (while olist
2192       (insert "(setq " (symbol-name (car olist)) " '" 
2193               (prin1-to-string (symbol-value (car olist))) ")\n")
2194       (setq olist (cdr olist)))
2195     (insert "\n\n")))
2196
2197 (defun gnus-overload-functions (&optional overloads)
2198   "Overload functions specified by optional argument OVERLOADS.
2199 If nothing is specified, use the variable gnus-overload-functions."
2200   (let ((defs nil)
2201         (overloads (or overloads gnus-overload-functions)))
2202     (while overloads
2203       (setq defs (car overloads))
2204       (setq overloads (cdr overloads))
2205       ;; Load file before overloading function if necessary.  Make
2206       ;; sure we cannot use `require' always.
2207       (and (not (fboundp (car defs)))
2208            (car (cdr (cdr defs)))
2209            (load (car (cdr (cdr defs))) nil 'nomessage))
2210       (fset (car defs) (car (cdr defs))))))
2211
2212 (defun gnus-replace-chars-in-string (string from to)
2213   "Replace characters in STRING from FROM to TO."
2214   (let ((string (substring string 0))   ;Copy string.
2215         (len (length string))
2216         (idx 0))
2217     ;; Replace all occurrences of FROM with TO.
2218     (while (< idx len)
2219       (if (= (aref string idx) from)
2220           (aset string idx to))
2221       (setq idx (1+ idx)))
2222     string))
2223
2224 (defun gnus-days-between (date1 date2)
2225   ;; Return the number of days between date1 and date2.
2226   (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) )
2227                     (timezone-parse-date date1)))
2228         (d2 (mapcar (lambda (s) (and s (string-to-int s)) )
2229                     (timezone-parse-date date2))))
2230     (- (timezone-absolute-from-gregorian 
2231         (nth 1 d1) (nth 2 d1) (car d1))
2232        (timezone-absolute-from-gregorian 
2233         (nth 1 d2) (nth 2 d2) (car d2)))))
2234
2235 (defun gnus-day-number (date)
2236   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
2237                      (timezone-parse-date date))))
2238     (timezone-absolute-from-gregorian 
2239      (nth 1 dat) (nth 2 dat) (car dat))))
2240
2241 (defun gnus-file-newer-than (file date)
2242   (let ((fdate (nth 5 (file-attributes file))))
2243     (or (> (car fdate) (car date))
2244         (and (= (car fdate) (car date))
2245              (> (nth 1 fdate) (nth 1 date))))))
2246
2247 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
2248 ;; the echo area.
2249 (defun gnus-y-or-n-p (prompt)
2250   (prog1
2251       (y-or-n-p prompt)
2252     (message "")))
2253
2254 (defun gnus-yes-or-no-p (prompt)
2255   (prog1
2256       (yes-or-no-p prompt)
2257     (message "")))
2258
2259 ;; Return a string of length POS+1 representing NUMber in BASE. The
2260 ;; resulting string will be left padded with zeds.
2261 (defun gnus-number-base-x (num pos base)
2262   (if (< pos 0)
2263       ""
2264     (concat 
2265      (char-to-string
2266       (aref "zyxwvutsrqponmlkjihgfedcba9876543210" (/ num (expt base pos))))
2267      (gnus-number-base-x 
2268       (% num (expt base pos)) (1- pos) base))))
2269
2270 ;; List and range functions
2271
2272 (defun gnus-last-element (list)
2273   "Return last element of LIST."
2274   (while (cdr list)
2275     (setq list (cdr list)))
2276   (car list))
2277
2278 (defun gnus-copy-sequence (list)
2279   "Do a complete, total copy of a list."
2280   (mapcar (lambda (elem) (if (consp elem) 
2281                              (if (consp (cdr elem))
2282                                  (gnus-copy-sequence elem)
2283                                (cons (car elem) (cdr elem)))
2284                            elem))
2285           list))
2286
2287 (defun gnus-set-difference (list1 list2)
2288   "Return a list of elements of LIST1 that do not appear in LIST2."
2289   (let ((list1 (copy-sequence list1)))
2290     (while list2
2291       (setq list1 (delq (car list2) list1))
2292       (setq list2 (cdr list2)))
2293     list1))
2294
2295 (defun gnus-sorted-complement (list1 list2)
2296   "Return a list of elements of LIST1 that do not appear in LIST2.
2297 Both lists have to be sorted over <."
2298   (let (out)
2299     (while (and list1 list2)
2300       (cond ((= (car list1) (car list2))
2301              (setq list1 (cdr list1)
2302                    list2 (cdr list2)))
2303             ((< (car list1) (car list2))
2304              (setq out (cons (car list1) out))
2305              (setq list1 (cdr list1)))
2306             (t
2307              (setq out (cons (car list2) out))
2308              (setq list2 (cdr list2)))))
2309     (append (or list1 list2) out)))
2310
2311 (defun gnus-intersection (list1 list2)      
2312   (let ((result nil))
2313     (while list2
2314       (if (memq (car list2) list1)
2315           (setq result (cons (car list2) result)))
2316       (setq list2 (cdr list2)))
2317     result))
2318
2319 (defun gnus-sorted-intersection (list1 list2)
2320   ;; LIST1 and LIST2 have to be sorted over <.
2321   (let (out)
2322     (while (and list1 list2)
2323       (cond ((= (car list1) (car list2))
2324              (setq out (cons (car list1) out)
2325                    list1 (cdr list1)
2326                    list2 (cdr list2)))
2327             ((< (car list1) (car list2))
2328              (setq list1 (cdr list1)))
2329             (t
2330              (setq list2 (cdr list2)))))
2331     out))
2332
2333 (defun gnus-set-sorted-intersection (list1 list2)
2334   ;; LIST1 and LIST2 have to be sorted over <.
2335   ;; This function modifies LIST1.
2336   (let* ((top (cons nil list1))
2337          (prev top))
2338   (while (and list1 list2)
2339     (cond ((= (car list1) (car list2))
2340            (setq prev list1
2341                  list1 (cdr list1)
2342                  list2 (cdr list2)))
2343           ((< (car list1) (car list2))
2344            (setcdr prev (cdr list1))
2345            (setq list1 (cdr list1)))
2346           (t
2347            (setcdr prev (cdr list1))
2348            (setq list2 (cdr list2)))))
2349   (cdr top)))
2350
2351 (defun gnus-compress-sequence (numbers &optional always-list)
2352   "Convert list of numbers to a list of ranges or a single range.
2353 If ALWAYS-LIST is non-nil, this function will always release a list of
2354 ranges."
2355   (let* ((first (car numbers))
2356          (last (car numbers))
2357          result)
2358     (if (null numbers)
2359         nil
2360       (while numbers
2361         (cond ((= last (car numbers)) nil) ;Omit duplicated number
2362               ((= (1+ last) (car numbers)) ;Still in sequence
2363                (setq last (car numbers)))
2364               (t                                ;End of one sequence
2365                (setq result (cons (cons first last) result))
2366                (setq first (car numbers))
2367                (setq last  (car numbers))))
2368         (setq numbers (cdr numbers)))
2369       (if (and (not always-list) (null result))
2370           (cons first last)
2371         (nreverse (cons (cons first last) result))))))
2372
2373 (defun gnus-uncompress-sequence (ranges)
2374   "Expand a list of ranges into a list of numbers.
2375 RANGES is either a single range on the form `(num . num)' or a list of
2376 these ranges."
2377   (let (first last result)
2378     (if (null ranges)
2379         nil
2380       (if (atom (car ranges))
2381           (progn
2382             (setq first (car ranges))
2383             (setq last (cdr ranges))
2384             (while (<= first last)
2385               (setq result (cons first result))
2386               (setq first (1+ first))))
2387         (while ranges
2388           (setq first (car (car ranges)))
2389           (setq last  (cdr (car ranges)))
2390           (while (<= first last)
2391             (setq result (cons first result))
2392             (setq first (1+ first)))
2393           (setq ranges (cdr ranges))))
2394       (nreverse result))))
2395
2396 (defun gnus-add-to-range (ranges list)
2397   "Return a list of ranges that has all articles from both RANGES and LIST.
2398 Note: LIST has to be sorted over `<'."
2399   (let* ((ranges (if (and ranges (atom (car ranges))) (list ranges) ranges))
2400          (inrange ranges)
2401          did-one
2402          range nranges first last)
2403     (if (not list)
2404         ranges
2405       (if (not ranges)
2406           (gnus-compress-sequence list t)
2407         (and ranges 
2408              (> (car (car ranges)) 1)
2409              (progn
2410                (setq did-one t)
2411                (setq inrange (setq ranges (cons (cons 1 1) ranges)))))
2412         (while (and ranges list)
2413           (setq range (car ranges))
2414           (while (and list (>= (car list) (car range))
2415                       (<= (car list) (cdr range)))
2416             (setq list (cdr list)))
2417           (while (and list (= (1- (car list)) (cdr range)))
2418             (setcdr range (car list))
2419             (setq list (cdr list)))
2420           (if (and list (and (> (car list) (cdr range)) 
2421                              (cdr ranges)
2422                              (< (car list) (car (car (cdr ranges))))))
2423               (setcdr ranges (cons (cons (car list) (car list)) (cdr ranges))))
2424           (setq ranges (cdr ranges)))
2425         (if (and list (not ranges))
2426             (setq inrange (nconc inrange (gnus-compress-sequence list t))))
2427         (if did-one
2428             (if (eq (cdr (car inrange)) 1)
2429                 (setq inrange (cdr inrange))
2430               (setcar (car inrange) 2)))
2431         (setq ranges inrange)
2432         (while ranges
2433           (if (and (cdr ranges) (>= (1+ (cdr (car ranges)))
2434                                     (car (car (cdr ranges)))))
2435               (progn
2436                 (setcdr (car ranges) (cdr (car (cdr ranges))))
2437                 (setcdr ranges (cdr (cdr ranges))))
2438             (setq ranges (cdr ranges))))
2439         (if (not (cdr inrange))
2440             (car inrange)
2441           inrange)))))
2442
2443 (defun gnus-remove-from-range (ranges list)
2444   "Return a list of ranges that has all articles from LIST removed from RANGES.
2445 Note: LIST has to be sorted over `<'."
2446   ;; !!! This function shouldn't look like this, but I've got a headache.
2447   (gnus-compress-sequence 
2448    (gnus-sorted-complement
2449     (gnus-uncompress-sequence ranges) list)))
2450
2451 (defun gnus-member-of-range (number ranges)
2452   (if (not (listp (car ranges)))
2453       (and (>= number (car ranges)) 
2454            (<= number (cdr ranges)))
2455     (let ((not-stop t))
2456       (while (and ranges (>= number (car (car ranges))) not-stop)
2457         (if (and (>= number (car (car ranges)))
2458                  (<= number (cdr (car ranges))))
2459             (setq not-stop nil))
2460         (setq ranges (cdr ranges)))
2461       (not not-stop))))
2462
2463 \f
2464 ;;;
2465 ;;; Gnus group mode
2466 ;;;
2467
2468 (defvar gnus-group-mode-map nil)
2469 (defvar gnus-group-make-map nil)
2470 (defvar gnus-group-list-map nil)
2471
2472 (if gnus-group-mode-map
2473     nil
2474   (setq gnus-group-mode-map (make-keymap))
2475   (suppress-keymap gnus-group-mode-map)
2476   (define-key gnus-group-mode-map " " 'gnus-group-read-group)
2477   (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
2478   (define-key gnus-group-mode-map "\r" 'gnus-group-select-group)
2479   (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
2480   (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
2481   (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
2482   (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
2483   (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
2484   (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
2485   (define-key gnus-group-mode-map "\M-n" 'gnus-group-next-unread-group-same-level)
2486   (define-key gnus-group-mode-map "\M-p" 'gnus-group-prev-unread-group-same-level)
2487   (define-key gnus-group-mode-map "," 'gnus-group-best-unread-group)
2488   (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
2489   (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
2490   (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current)
2491   (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all)
2492   (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
2493   (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
2494   (define-key gnus-group-mode-map "m" 'gnus-group-mail)
2495   (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
2496   (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group)
2497   (define-key gnus-group-mode-map "R" 'gnus-group-restart)
2498   (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file)
2499   (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server)
2500   (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
2501   (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups)
2502   (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group)
2503   (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups)
2504   (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos)
2505   (define-key gnus-group-mode-map "\C-c\M-C-a" 'gnus-group-description-apropos)
2506   (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
2507   (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
2508   (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
2509   (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
2510   (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
2511   (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
2512   (define-key gnus-group-mode-map "\M-z" 'gnus-group-kill-all-zombies)
2513   (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
2514   (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed)
2515   (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles)
2516   (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups)
2517   (define-key gnus-group-mode-map "V" 'gnus-version)
2518   (define-key gnus-group-mode-map "S" 'gnus-group-set-current-level)
2519   (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc)
2520   (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
2521   (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble)
2522   (define-key gnus-group-mode-map "q" 'gnus-group-exit)
2523   (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
2524   (define-key gnus-group-mode-map "\M-f" 'gnus-group-fetch-faq)
2525   (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
2526   (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
2527   (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group)
2528   (define-key gnus-group-mode-map [mouse-2] 'gnus-mouse-pick-group)
2529
2530   (define-prefix-command 'gnus-group-make-map)
2531   (define-key gnus-group-mode-map "M" 'gnus-group-make-map)
2532   (define-key gnus-group-make-map "d" 'gnus-group-make-directory-group)
2533   (define-key gnus-group-make-map "h" 'gnus-group-make-help-group)
2534   (define-key gnus-group-make-map "k" 'gnus-group-make-kiboze-group)
2535   (define-key gnus-group-make-map "m" 'gnus-group-make-group)
2536   (define-key gnus-group-make-map "e" 'gnus-group-edit-group)
2537
2538   (define-prefix-command 'gnus-group-list-map)
2539   (define-key gnus-group-mode-map "G" 'gnus-group-list-map)
2540   (define-key gnus-group-list-map "k" 'gnus-group-list-killed)
2541   (define-key gnus-group-list-map "z" 'gnus-group-list-zombies)
2542   (define-key gnus-group-list-map "s" 'gnus-group-list-groups)
2543   (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups)
2544   (define-key gnus-group-list-map "a" 'gnus-group-apropos)
2545   (define-key gnus-group-list-map "d" 'gnus-group-description-apropos)
2546   (define-key gnus-group-list-map "m" 'gnus-group-list-matching)
2547   (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching)
2548   )
2549
2550 (defun gnus-group-mode ()
2551   "Major mode for reading news.
2552 All normal editing commands are switched off.
2553 The following commands are available:
2554
2555 \\{gnus-group-mode-map}"
2556   (interactive)
2557   (if gnus-visual (gnus-group-make-menu-bar))
2558   (kill-all-local-variables)
2559   (setq mode-line-modified "-- ")
2560   (make-local-variable 'mode-line-format)
2561   (setq mode-line-format (copy-sequence mode-line-format))
2562   (and (equal (nth 3 mode-line-format) "   ")
2563        (setcar (nthcdr 3 mode-line-format) ""))
2564   (setq major-mode 'gnus-group-mode)
2565   (setq mode-name "Group")
2566   (gnus-group-set-mode-line)
2567   (setq mode-line-process nil)
2568   (use-local-map gnus-group-mode-map)
2569   (buffer-disable-undo (current-buffer))
2570   (setq truncate-lines t)
2571   (setq buffer-read-only t)
2572   (run-hooks 'gnus-group-mode-hook))
2573
2574 (defun gnus-mouse-pick-group (e)
2575   (interactive "e")
2576   (mouse-set-point e)
2577   (gnus-group-read-group nil))
2578
2579 ;;;###autoload
2580 (defun gnus-no-server (&optional arg)
2581   "Read network news.
2582 If ARG is a positive number, Gnus will use that as the
2583 startup level. If ARG is nil, Gnus will be started at level 2. 
2584 If ARG is non-nil and not a positive number, Gnus will
2585 prompt the user for the name of an NNTP server to use.
2586 As opposed to `gnus', this command will not connect to the local server."
2587   (interactive "P")
2588   (gnus (or arg 2) t))
2589
2590 (defalias '\(ding\) 'gnus)
2591
2592 ;;;###autoload
2593 (defun gnus (&optional arg dont-connect)
2594   "Read network news.
2595 If ARG is non-nil and a positive number, Gnus will use that as the
2596 startup level. If ARG is non-nil and not a positive number, Gnus will
2597 prompt the user for the name of an NNTP server to use."
2598   (interactive "P")
2599   (if (get-buffer gnus-group-buffer)
2600       (progn
2601         (switch-to-buffer gnus-group-buffer)
2602         (gnus-group-get-new-news))
2603     (gnus-clear-system)
2604     (gnus-read-init-file)
2605     (let ((level (and arg (numberp arg) (> arg 0) arg)))
2606       (unwind-protect
2607           (progn
2608             (switch-to-buffer (get-buffer-create gnus-group-buffer))
2609             (gnus-add-current-to-buffer-list)
2610             (gnus-group-mode)
2611             (or dont-connect (gnus-start-news-server (and arg (not level)))))
2612         (if (and (not dont-connect) 
2613                  (not (gnus-server-opened gnus-select-method)))
2614             (gnus-group-quit)
2615           (run-hooks 'gnus-startup-hook)
2616           ;; NNTP server is successfully open. 
2617           (gnus-update-format-specifications)
2618           (let ((buffer-read-only nil))
2619             (erase-buffer)
2620             (if (not gnus-inhibit-startup-message)
2621                 (progn
2622                   (gnus-group-startup-message)
2623                   (sit-for 0))))
2624           (gnus-setup-news nil level)
2625           (and gnus-use-dribble-file (gnus-dribble-open))
2626           (or t (not gnus-novice-user)
2627               gnus-expert-user
2628               (gnus-group-describe-briefly)) ;Show brief help message.
2629           (gnus-group-list-groups (or level 5)))))))
2630
2631 (defun gnus-group-startup-message (&optional x y)
2632   "Insert startup message in current buffer."
2633   ;; Insert the message.
2634   (erase-buffer)
2635   (insert
2636    (format "
2637     %s
2638            A newsreader 
2639       for GNU Emacs
2640
2641         Based on GNUS 
2642              written by 
2643      Masanobu UMEDA
2644
2645     Lars Magne 
2646          Ingebrigtsen 
2647       larsi@ifi.uio.no
2648
2649            gnus-version))
2650   ;; And then hack it.
2651   ;; 18 is the longest line.
2652   (indent-rigidly (point-min) (point-max) 
2653                   (/ (max (- (window-width) (or x 28)) 0) 2))
2654   (goto-char (point-min))
2655   ;; +4 is fuzzy factor.
2656   (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)))
2657
2658 (defun gnus-group-setup-buffer ()
2659   (or (get-buffer gnus-group-buffer)
2660       (progn
2661         (switch-to-buffer (get-buffer-create gnus-group-buffer))
2662         (gnus-add-current-to-buffer-list)
2663         (gnus-group-mode))))
2664
2665 (defun gnus-group-list-groups (level &optional unread)
2666   "List newsgroups with level LEVEL or lower that have unread alticles.
2667 Default is 5, which lists all subscribed groups.
2668 If argument UNREAD is non-nil, groups with no unread articles are also listed."
2669   (interactive "P")
2670   (setq level (or level 5))
2671   (gnus-group-setup-buffer)     ;May call from out of group buffer
2672   (let ((case-fold-search nil)
2673         (group (gnus-group-group-name)))
2674     (funcall gnus-group-prepare-function level unread nil)
2675     (if (zerop (buffer-size))
2676         ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
2677         (message "No news is horrible news")
2678       (goto-char (point-min))
2679       (if (not group)
2680           ;; Go to the first group with unread articles.
2681           (gnus-group-search-forward nil nil nil t)
2682         ;; Find the right group to put point on. If the current group
2683         ;; has disapeared in the new listing, try to find the next
2684         ;; one. If no next one can be found, just leave point at the
2685         ;; first newsgroup in the buffer.
2686         (if (not (gnus-goto-char
2687                   (text-property-any (point-min) (point-max) 
2688                                      'gnus-group (intern group))))
2689             (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
2690               (while (and newsrc
2691                           (not (gnus-goto-char 
2692                                 (text-property-any 
2693                                  (point-min) (point-max) 'gnus-group 
2694                                  (intern group)))))
2695                 (setq newsrc (cdr newsrc))))))
2696       ;; Adjust cursor point.
2697       (gnus-group-position-cursor))))
2698
2699 (defun gnus-group-prepare-flat (level &optional all lowest regexp) 
2700   "List all newsgroups with unread articles of level LEVEL or lower.
2701 If ALL is non-nil, list groups that have no unread articles.
2702 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
2703 If REGEXP, only list groups matching REGEXP."
2704   (set-buffer gnus-group-buffer)
2705   (let ((buffer-read-only nil)
2706         (newsrc (cdr gnus-newsrc-assoc))
2707         (lowest (or lowest 1))
2708         info clevel unread group)
2709     (erase-buffer)
2710     (if (< lowest 8)
2711         ;; List living groups.
2712         (while newsrc
2713           (setq info (car newsrc)
2714                 group (car info)
2715                 newsrc (cdr newsrc)
2716                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
2717           (and unread ; This group might be bogus
2718                (or (not regexp)
2719                    (string-match regexp group))
2720                (<= (setq clevel (car (cdr info))) level) 
2721                (>= clevel lowest)
2722                (or all            ; We list all groups?
2723                    (eq unread t)  ; We list unactivated groups
2724                    (> unread 0)   ; We list groups with unread articles
2725                    (cdr (assq 'tick (nth 3 info)))) ; And groups with tickeds
2726                (gnus-group-insert-group-line 
2727                 nil group (car (cdr info)) (nth 3 info) unread (nth 4 info)))))
2728
2729     ;; List dead groups.
2730     (and (>= level 8) (<= lowest 8)
2731          (gnus-group-prepare-flat-list-dead 
2732           (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 8 ?Z
2733           regexp))
2734     (and (>= level 9) (<= lowest 9)
2735          (gnus-group-prepare-flat-list-dead 
2736           (setq gnus-killed-list (sort gnus-killed-list 'string<)) 9 ?K
2737           regexp))
2738
2739     (gnus-group-set-mode-line)
2740     (setq gnus-have-all-newsgroups all)
2741     (run-hooks 'gnus-group-prepare-hook)))
2742
2743 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
2744   ;; List zombies and killed lists somehwat faster, which was
2745   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
2746   ;; this by ignoring the group format specification altogether.
2747   (let (group beg)
2748     (while groups
2749       (setq group (car groups)
2750             groups (cdr groups))
2751       (if (or (not regexp)
2752               (string-match regexp group))
2753           (progn
2754             (setq beg (point))
2755             (insert (format " %c    *: %s\n" mark group))
2756             (add-text-properties 
2757              beg (1+ beg) 
2758              (list 'gnus-group (intern group)
2759                    'gnus-unread t
2760                    'gnus-level level)))))))
2761
2762 (defun gnus-group-real-name (group)
2763   "Find the real name of a foreign newsgroup."
2764   (if (string-match "^[^:]+:" group)
2765       (substring group (match-end 0))
2766     group))
2767
2768 (defun gnus-group-prefixed-name (group method)
2769   "Return the whole name from GROUP and METHOD."
2770   (concat (format "%s" (car method))
2771           (if (assoc (format "%s" (car method)) (gnus-methods-using 'address))
2772               (concat "+" (nth 1 method)))
2773           ":" group))
2774
2775 (defun gnus-group-real-prefix (group)
2776   "Return the prefix of the current group name."
2777   (if (string-match "^[^:]+:" group)
2778       (substring group 0 (match-end 0))
2779     ""))
2780
2781 (defun gnus-group-method-name (group)
2782   "Return the method used for selecting GROUP."
2783   (let ((prefix (gnus-group-real-prefix group)))
2784     (if (equal prefix "")
2785         gnus-select-method
2786       (if (string-match "^[^\\+]+\\+" prefix)
2787           (list (intern (substring prefix 0 (1- (match-end 0))))
2788                 (substring prefix (match-end 0) (1- (length prefix))))
2789         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
2790
2791 (defun gnus-group-foreign-p (group)
2792   "Return nil if GROUP is native, non-nil if it is foreign."
2793   (string-match ":" group))
2794
2795 (defun gnus-group-set-info (info)
2796   (let ((entry (gnus-gethash (car info) gnus-newsrc-hashtb)))
2797     (if entry
2798         ()
2799       (save-excursion
2800         (set-buffer gnus-group-buffer)
2801         (if (nth 4 info)
2802             (gnus-group-make-group 
2803              (gnus-group-real-name (car info))
2804              (prin1-to-string (car (nth 4 info)))
2805              (nth 1 (nth 4 info)))
2806           (gnus-group-make-group
2807            (car info)
2808            (prin1-to-string (car gnus-select-method))
2809            (nth 1 gnus-select-method)))
2810         (message "Note: New group created")
2811         (setq entry 
2812               (gnus-gethash (gnus-group-prefixed-name 
2813                              (gnus-group-real-name (car info))
2814                              (or (nth 4 info) gnus-select-method))
2815                             gnus-newsrc-hashtb))))
2816     (if entry
2817         (progn
2818           (setcar (nthcdr 2 entry) info)
2819           (if (and (not (eq (car entry) t)) 
2820                    (gnus-gethash (car info) gnus-active-hashtb))
2821               (let ((marked (nth 3 info)))
2822                 (setcar entry 
2823                         (max 0 (- (length (gnus-list-of-unread-articles 
2824                                            (car info)))
2825                                   (length (cdr (assq 'tick marked)))
2826                                   (length (cdr (assq 'dormant marked)))))))))
2827       (error "No such group: %s" (car info)))))
2828
2829 (defun gnus-group-update-group-line ()
2830   "This function updates the current line in the newsgroup buffer and
2831 moves the point to the colon."
2832   (let* ((buffer-read-only nil)
2833          (group (gnus-group-group-name))
2834          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
2835     (if entry
2836         (gnus-dribble-enter 
2837          (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
2838                  ")")))
2839     (beginning-of-line)
2840     (delete-region (point) (save-excursion (forward-line 1) (point)))
2841     (gnus-group-insert-group-line-info group)
2842     (forward-line -1)
2843     (gnus-group-position-cursor)))
2844
2845 (defun gnus-group-insert-group-line-info (group)
2846   (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) 
2847         active info)
2848     (if entry
2849         (progn
2850           (setq info (nth 2 entry))
2851           (gnus-group-insert-group-line 
2852            nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
2853       (setq active (gnus-gethash group gnus-active-hashtb))
2854       (gnus-group-insert-group-line 
2855        nil group (if (member group gnus-zombie-list) 8 9)
2856        nil (- (1+ (cdr active)) (car active)) nil))))
2857
2858 (defun gnus-group-insert-group-line (gformat group level marked number method)
2859   (let* ((gformat (or gformat gnus-group-line-format-spec))
2860          (active (gnus-gethash group gnus-active-hashtb))
2861          (number-total (if active (1+ (- (cdr active) (car active))) 0))
2862          (number-of-dormant (length (cdr (assq 'dormant marked))))
2863          (number-of-ticked (length (cdr (assq 'tick marked))))
2864          (number-of-ticked-and-dormant
2865           (+ number-of-ticked number-of-dormant))
2866          (number-of-unread-unticked 
2867           (if (numberp number) (int-to-string (max 0 number))
2868             "*"))
2869          (number-of-read
2870           (if (numberp number)
2871               (max 0 (- number-total number))
2872             "*"))
2873          (subscribed (cond ((< level 6) ? )
2874                            ((< level 8) ?U)
2875                            ((= level 8) ?Z)
2876                            (t ?K)))
2877          (qualified-group (gnus-group-real-name group))
2878          (newsgroup-description 
2879           (if gnus-description-hashtb
2880               (or (gnus-gethash group gnus-description-hashtb) "")
2881             ""))
2882          (moderated (if (member group gnus-moderated-list) ?m ? ))
2883          (moderated-string (if (eq moderated ?m) "(m)" ""))
2884          (news-server (or (car (cdr method)) ""))
2885          (news-method (or (car method) ""))
2886          (news-method-string 
2887           (if method (format "(%s:%s)" (car method) (car (cdr method))) ""))
2888          (marked (if (and 
2889                       (numberp number) 
2890                       (zerop number)
2891                       (> number-of-ticked 0))
2892                      ?* ? ))
2893          (number (if (eq number t) "*" (+ number number-of-dormant 
2894                                           number-of-ticked)))
2895          (buffer-read-only nil)
2896          b)
2897     (beginning-of-line)
2898     (setq b (point))
2899     ;; Insert the text.
2900     (insert (eval gformat))
2901
2902     (add-text-properties 
2903      b (1+ b) (list 'gnus-group (intern group)
2904                     'gnus-unread (if (numberp number)
2905                                      (string-to-int number-of-unread-unticked)
2906                                    t)
2907                     'gnus-marked marked
2908                     'gnus-level level))))
2909
2910 (defun gnus-group-update-group (group &optional visible-only)
2911   "Update newsgroup info of GROUP.
2912 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already."
2913   (save-excursion
2914     (set-buffer gnus-group-buffer)
2915     (let ((buffer-read-only nil)
2916           visible)
2917       (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
2918         (if entry
2919             (gnus-dribble-enter 
2920              (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
2921                      ")"))))
2922       ;; Buffer may be narrowed.
2923       (save-restriction
2924         (widen)
2925         ;; Search a line to modify.  If the buffer is large, the search
2926         ;; takes long time.  In most cases, current point is on the line
2927         ;; we are looking for.  So, first of all, check current line. 
2928         (if (or (progn
2929                   (beginning-of-line)
2930                   (eq (get-text-property (point) 'gnus-group)
2931                       (intern group)))
2932                 (progn
2933                   (gnus-goto-char 
2934                    (text-property-any 
2935                     (point-min) (point-max) 'gnus-group (intern group)))))
2936             ;; GROUP is listed in current buffer. So, delete old line.
2937             (progn
2938               (setq visible t)
2939               (beginning-of-line)
2940               (delete-region (point) (progn (forward-line 1) (point))))
2941           ;; No such line in the buffer, find out where it's supposed to
2942           ;; go, and insert it there (or at the end of the buffer).
2943           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
2944           (or visible-only
2945               (let ((entry (cdr (gnus-gethash group gnus-newsrc-hashtb))))
2946                 (while (and entry
2947                             (not
2948                              (gnus-goto-char
2949                               (text-property-any
2950                                (point-min) (point-max) 
2951                                'gnus-group (intern (car (car entry)))))))
2952                   (setq entry (cdr entry)))
2953                 (or entry (goto-char (point-max)))))))
2954       (if (or visible (not visible-only))
2955           (gnus-group-insert-group-line-info group))
2956       (gnus-group-set-mode-line))))
2957
2958 (defun gnus-group-set-mode-line ()
2959   (if (memq 'group gnus-updated-mode-lines)
2960       (let* ((gformat (or gnus-group-mode-line-format-spec
2961                           (setq gnus-group-mode-line-format-spec
2962                                 (gnus-parse-format 
2963                                  gnus-group-mode-line-format 
2964                                  gnus-group-mode-line-format-alist))))
2965              (news-server (car (cdr gnus-select-method)))
2966              (news-method (car gnus-select-method))
2967              (mode-string (eval gformat))
2968              (max-len 60))
2969         (if (> (length mode-string) max-len) 
2970             (setq mode-string (substring mode-string 0 (- max-len 4))))
2971         (setq mode-line-buffer-identification mode-string)
2972         (set-buffer-modified-p t))))
2973
2974 (defun gnus-group-group-name ()
2975   "Get the name of the newsgroup on the current line."
2976   (let ((group (get-text-property 
2977                 (save-excursion (beginning-of-line) (point)) 'gnus-group)))
2978     (and group (symbol-name group))))
2979
2980 (defun gnus-group-group-level ()
2981   "Get the level of the newsgroup on the current line."
2982   (get-text-property (save-excursion (beginning-of-line) (point)) 'gnus-level))
2983
2984 (defun gnus-group-search-forward (&optional backward all level first-too)
2985   "Find the next newsgroup with unread articles.
2986 If BACKWARD is non-nil, find the previous newsgroup instead.
2987 If ALL is non-nil, just find any newsgroup.
2988 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
2989 group exists.
2990 If FIRST-TOO, the current line is also eligeble as a target."
2991   (let ((way (if backward -1 1))
2992         (low 10)
2993         (beg (point))
2994         pos found)
2995     (or first-too (forward-line way))
2996     (while (and 
2997             (not (eobp))
2998             (not (setq 
2999                   found 
3000                   (and (or all
3001                            (and
3002                             (let ((unread 
3003                                    (get-text-property (point) 'gnus-unread)))
3004                               (or (eq unread t) (and unread (> unread 0))))
3005                             (< (get-text-property (point) 'gnus-level) 6)))
3006                        (or (not level)
3007                            (let ((lev (get-text-property (point) 'gnus-level)))
3008                              (if (<= lev level)
3009                                  t
3010                                (if (< lev low)
3011                                    (progn
3012                                      (setq low lev)
3013                                      (setq pos (point))))
3014                                nil))))))
3015             (zerop (forward-line way))))
3016     (if found 
3017         (progn (gnus-group-position-cursor) t)
3018       (if pos (goto-char pos) (goto-char beg))
3019       nil)))
3020
3021 ;; Gnus group mode commands
3022
3023 (defun gnus-group-read-group (all &optional no-article group)
3024   "Read news in this newsgroup.
3025 If argument ALL is non-nil, already read articles become readable.
3026 If optional argument NO-ARTICLE is non-nil, no article body is displayed."
3027   (interactive "P")
3028   (let ((group (or group (gnus-group-group-name)))
3029         number active marked entry)
3030     (or group (error "No group on current line"))
3031     (setq marked 
3032           (nth 3 (nth 2 (setq entry (gnus-gethash group gnus-newsrc-hashtb)))))
3033     ;; This group might be a dead group. In that case we have to get
3034     ;; the number of unread articles from `gnus-active-hashtb'.
3035     (if entry
3036         (setq number (car entry))
3037       (if (setq active (gnus-gethash group gnus-active-hashtb))
3038           (setq number (- (1+ (cdr active)) (car active)))))
3039     (gnus-summary-read-group 
3040      group (or all (and (numberp number) 
3041                         (zerop (+ number (length (cdr (assq 'tick marked)))
3042                                   (length (cdr (assq 'dormant marked)))))))
3043      no-article)))
3044
3045 (defun gnus-group-select-group (all)
3046   "Select this newsgroup.
3047 No article is selected automatically.
3048 If argument ALL is non-nil, already read articles become readable."
3049   (interactive "P")
3050   (gnus-group-read-group all t))
3051
3052 (defun gnus-group-jump-to-group (group)
3053   "Jump to newsgroup GROUP."
3054   (interactive
3055    (list 
3056     (completing-read "Group: " gnus-active-hashtb nil t)))
3057   (let (b)
3058     ;; Either go to the line in the group buffer...
3059     (or (and (setq b (text-property-any (point-min) (point-max) 
3060                                         'gnus-group (intern group)))
3061              (goto-char b))
3062         ;; ... or insert the line.
3063         (progn (gnus-group-update-group group)
3064                (goto-char (text-property-any (point-min) (point-max) 
3065                                              'gnus-group (intern group))))))
3066   ;; Adjust cursor point.
3067   (gnus-group-position-cursor))
3068
3069 (defun gnus-group-next-group (n)
3070   "Go to next N'th newsgroup.
3071 If N is negative, search backward instead.
3072 Returns the difference between N and the number of skips actually
3073 done."
3074   (interactive "p")
3075   (gnus-group-next-unread-group n t))
3076
3077 (defun gnus-group-next-unread-group (n &optional all level)
3078   "Go to next N'th unread newsgroup.
3079 If N is negative, search backward instead.
3080 If ALL is non-nil, choose any newsgroup, unread or not.
3081 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
3082 such group can be found, the next group with a level higher than
3083 LEVEL.
3084 Returns the difference between N and the number of skips actually
3085 made."
3086   (interactive "p")
3087   (let ((backward (< n 0))
3088         (n (abs n)))
3089     (while (and (> n 0)
3090                 (gnus-group-search-forward backward all level))
3091       (setq n (1- n)))
3092     (if (/= 0 n) (message "No more%s newsgroups%s" (if all "" " unread")
3093                           (if level " on this level or higher" "")))
3094     n))
3095
3096 (defun gnus-group-prev-group (n)
3097   "Go to previous N'th newsgroup.
3098 Returns the difference between N and the number of skips actually
3099 done."
3100   (interactive "p")
3101   (gnus-group-next-unread-group (- n) t))
3102
3103 (defun gnus-group-prev-unread-group (n)
3104   "Go to previous N'th unread newsgroup.
3105 Returns the difference between N and the number of skips actually
3106 done."  
3107   (interactive "p")
3108   (gnus-group-next-unread-group (- n)))
3109
3110 (defun gnus-group-next-unread-group-same-level (n)
3111   "Go to next N'th unread newsgroup on the same level.
3112 If N is negative, search backward instead.
3113 Returns the difference between N and the number of skips actually
3114 done."
3115   (interactive "p")
3116   (gnus-group-next-unread-group n t (gnus-group-group-level))
3117   (gnus-group-position-cursor))
3118
3119 (defun gnus-group-prev-unread-group-same-level (n)
3120   "Go to next N'th unread newsgroup on the same level.
3121 Returns the difference between N and the number of skips actually
3122 done."
3123   (interactive "p")
3124   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
3125   (gnus-group-position-cursor))
3126
3127 (defun gnus-group-best-unread-group ()
3128   "Go to the group with the highest level."
3129   (interactive)
3130   (goto-char (point-min))
3131   (let ((best 10)
3132         unread best-point)
3133     (while (setq unread (get-text-property (point) 'gnus-unread))
3134       (if (and (numberp unread) (> unread 0))
3135           (progn
3136             (or best-point (setq best-point (point)))
3137             (if (< (get-text-property (point) 'gnus-level) best)
3138                 (progn 
3139                   (setq best (get-text-property (point) 'gnus-level))
3140                   (setq best-point (point))))))
3141       (forward-line 1))
3142     (if best-point (goto-char best-point))
3143     (gnus-summary-position-cursor)
3144     (and best-point (gnus-group-group-name))))
3145
3146 (defun gnus-group-make-group (name method address)
3147   "Add a new newsgroup.
3148 The user will be prompted for a NAME, for a select METHOD, and an
3149 ADDRESS."
3150   (interactive
3151    (cons 
3152     (read-string "Group name: ")
3153     (let ((method
3154            (completing-read 
3155             "Method: " gnus-valid-select-methods nil t)))
3156       (list method
3157             (if (memq 'prompt-address
3158                       (assoc method gnus-valid-select-methods))
3159                 (read-string "Address: ")
3160               "")))))
3161   (let ((nname (gnus-group-prefixed-name name (list (intern method) address)))
3162         info)
3163     (gnus-group-change-level 
3164      (setq info (list t nname 3 nil nil (list (intern method) address)))
3165      3 9 (gnus-gethash (or (gnus-group-group-name) "dummy.group")
3166                        gnus-newsrc-hashtb) t)
3167     (gnus-sethash nname '(0 . 0) gnus-active-hashtb)
3168     (gnus-dribble-enter 
3169      (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))
3170     (gnus-group-insert-group-line-info nname)))
3171
3172 (defun gnus-group-edit-group ()
3173   (interactive)
3174   (let ((group (gnus-group-group-name))
3175         info)
3176     (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
3177       (error "No group on current line"))
3178     (setq gnus-winconf-edit-group (current-window-configuration))
3179     (pop-to-buffer (get-buffer-create gnus-group-edit-buffer))
3180     (gnus-add-current-to-buffer-list)
3181     (emacs-lisp-mode)
3182     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
3183     (use-local-map (copy-keymap emacs-lisp-mode-map))
3184     (local-set-key "\C-c\C-c" 'gnus-group-edit-group-done)
3185     (erase-buffer)
3186     (insert ";; Type `C-c C-c' after you have edited the newsgroup entry.\n\n")
3187     (insert (pp-to-string (list 'gnus-group-set-info (list 'quote info))))))
3188
3189 (defun gnus-group-edit-group-done ()
3190   (interactive)
3191   (set-buffer (get-buffer-create gnus-group-edit-buffer))
3192   (eval-current-buffer)
3193   (kill-buffer (current-buffer))
3194   (and gnus-winconf-edit-group
3195        (set-window-configuration gnus-winconf-edit-group))
3196   (setq gnus-winconf-edit-group nil)
3197   (set-buffer gnus-group-buffer)
3198   (gnus-group-update-group (gnus-group-group-name))
3199   (gnus-group-position-cursor))
3200
3201 (defun gnus-group-make-help-group ()
3202   "Create the (ding) Gnus documentation group."
3203   (interactive)
3204   (and (gnus-gethash (gnus-group-prefixed-name "gnus-help" '(nndoc ""))
3205                      gnus-newsrc-hashtb)
3206        (error "Documentation group already exists"))
3207   (let ((path load-path))
3208     (while (and path
3209                 (not (file-exists-p (concat (file-name-as-directory (car path))
3210                                             "doc.txt"))))
3211       (setq path (cdr path)))
3212     (or path (error "Couldn't find doc group"))
3213     (gnus-group-make-group 
3214      "gnus-help" "nndoc" 
3215      (concat (file-name-as-directory (car path)) "doc.txt"))
3216     (gnus-group-position-cursor)))
3217
3218 (defun gnus-group-make-directory-group (dir)
3219   "Create an nndir group.
3220 The user will be prompted for a directory. The contents of this
3221 directory will be used as a newsgroup. The directory should contain
3222 mail messages or news articles in files that have numeric names."
3223   (interactive
3224    (list (read-file-name "Create group from directory: ")))
3225   (or (file-exists-p dir) (error "No such directory"))
3226   (or (file-directory-p dir) (error "Not a directory"))
3227   (gnus-group-make-group dir "nndir" dir)
3228   (gnus-group-position-cursor))
3229
3230 (defun gnus-group-make-kiboze-group (group address scores)
3231   "Create an nnkiboze group.
3232 The user will be prompted for a name, a regexp to match groups, and
3233 score file entries for articles to include in the group."
3234   (interactive
3235    (list
3236     (read-string "nnkiboze group name: ")
3237     (read-string "Source groups (regexp): ")
3238     (let ((headers (mapcar (lambda (group) (list group))
3239                            '("subject" "from" "number" "date" "message-id"
3240                              "references" "chars" "lines" "xref")))
3241           scores header regexp regexps)
3242       (while (not (equal "" (setq header (completing-read 
3243                                           "Match on header: " headers nil t))))
3244         (setq regexps nil)
3245         (while (not (equal "" (setq regexp (read-string 
3246                                             (format "Match on %s (string): "
3247                                                     header)))))
3248           (setq regexps (cons (list regexp nil 1000 nil) regexps)))
3249         (setq scores (cons (cons header regexps) scores)))
3250       (car scores))))
3251   (gnus-group-make-group group "nnkiboze" address)
3252   (save-excursion
3253     (set-buffer (get-buffer-create " *gnus work*"))
3254     (buffer-disable-undo (current-buffer))
3255     (let (emacs-lisp-mode-hook)
3256       (pp (list 'setq 'gnus-score-alist 
3257                 (list 'quote (list scores)))
3258           (current-buffer)))
3259     (write-region (point-min) (point-max) 
3260                   (concat (or gnus-kill-files-directory "~/News")
3261                           "nnkiboze:" group "." gnus-score-file-suffix))
3262     (kill-buffer (current-buffer)))
3263   (gnus-group-position-cursor))
3264
3265 ;; Group sorting commands
3266 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
3267
3268 (defun gnus-group-sort-groups ()
3269   "Sort the group buffer using `gnus-group-sort-function'."
3270   (interactive)
3271   (setq gnus-newsrc-assoc 
3272         (sort (cdr gnus-newsrc-assoc) gnus-group-sort-function))
3273   (gnus-make-hashtable-from-newsrc-alist)
3274   (gnus-get-unread-articles 6)
3275   (gnus-group-list-groups 5))
3276
3277 (defun gnus-group-sort-by-alphabet (info1 info2)
3278   (string< (car info1) (car info2)))
3279
3280 (defun gnus-group-sort-by-unread (info1 info2)
3281   (let ((n1 (car (gnus-gethash (car info1) gnus-newsrc-hashtb)))
3282         (n2 (car (gnus-gethash (car info2) gnus-newsrc-hashtb))))
3283     (< (or (and (numberp n1) n1) 0)
3284        (or (and (numberp n2) n2) 0))))
3285
3286 (defun gnus-group-sort-by-level (info1 info2)
3287   (< (nth 1 info1) (nth 1 info2)))
3288
3289 ;; Group catching up.
3290
3291 (defun gnus-group-catchup-current (n &optional all)
3292   "Mark all articles not marked as unread in current newsgroup as read.
3293 If prefix argument N is numeric, the ARG next newsgroups will be
3294 caught up. If ALL is non-nil, marked articles will also be marked as
3295 read. Cross references (Xref: header) of articles are ignored.
3296 The difference between N and actual number of newsgroups that were
3297 caught up is returned."
3298   (interactive "p")
3299   (if (or (not gnus-interactive-catchup) ;Without confirmation?
3300           gnus-expert-user
3301           (gnus-y-or-n-p
3302            (if all
3303                "Do you really want to mark all articles as read? "
3304              "Mark all unread articles as read? ")))
3305       (progn
3306         (while 
3307             (and (> n 0)
3308                  (progn
3309                    (setq n (1- n))
3310                    (gnus-group-catchup (gnus-group-group-name) all)
3311                    (gnus-group-update-group-line)
3312                    t)
3313                  (zerop (gnus-group-next-unread-group 1))))))
3314   n)
3315
3316 (defun gnus-group-catchup-current-all (n)
3317   "Mark all articles in current newsgroup as read.
3318 Cross references (Xref: header) of articles are ignored."
3319   (interactive "p")
3320   (gnus-group-catchup-current n 'all))
3321
3322 (defun gnus-group-catchup (group &optional all)
3323   "Mark all articles in GROUP as read.
3324 If ALL is non-nil, all articles are marked as read.
3325 The return value is the number of articles that were marked as read,
3326 or nil if no action could be taken."
3327   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
3328          (num (car entry))
3329          (marked (nth 3 (nth 2 entry)))
3330          ticked)
3331     (if (not (numberp (car entry)))
3332         (message "Can't catch up; non-active group")
3333       ;; Do the updating only if the newsgroup isn't killed
3334       (if entry
3335           (progn
3336             (setq ticked (if all nil (cdr (assq 'tick marked))))
3337             (gnus-update-read-articles group ticked nil ticked)
3338             (if (and all marked)
3339                 (setcar (nthcdr 3 (nth 2 entry)) 
3340                         (delq (assq 'dormant marked) marked))))))
3341     num))
3342
3343 (defun gnus-group-expire-articles (newsgroup)
3344   "Expire all expirable articles in the current newsgroup."
3345   (interactive (list (gnus-group-group-name)))
3346   (if (not newsgroup) (error "No current newsgroup"))
3347   (let ((expirable 
3348          (assq 'expire (nth 3 (nth 2 (gnus-gethash newsgroup 
3349                                                    gnus-newsrc-hashtb))))))
3350  (and expirable 
3351       (gnus-check-backend-function 'request-expire-articles newsgroup)
3352       (setcdr expirable
3353               (gnus-request-expire-articles (cdr expirable) newsgroup)))))
3354
3355 (defun gnus-group-expire-all-groups ()
3356   "Expire all expirable articles in all newsgroups."
3357   (interactive)
3358   (message "Expiring...")
3359   (let ((newsrc (cdr gnus-newsrc-assoc)))
3360     (while newsrc
3361       (gnus-group-expire-articles (car (car newsrc)))
3362       (setq newsrc (cdr newsrc))))
3363   (message "Expiring...done"))
3364
3365 (defun gnus-group-set-current-level (n)
3366   "Set the level of the current group to the numeric prefix."
3367   (interactive "P")
3368   (setq n (or n (string-to-int 
3369                  (completing-read 
3370                   "Level: " 
3371                   (mapcar (lambda (n) (list (char-to-string n))) "123456789")
3372                   nil t))))
3373   (let ((group (gnus-group-group-name)))
3374     (if (not group) (error "No newsgroup on current line.")
3375     (if (and (numberp n) (>= n 1) (<= n 9))
3376         (progn
3377           (message "Changed level of %s from %d to %d" 
3378                    group (gnus-group-group-level) n)
3379           (gnus-group-change-level group n (gnus-group-group-level))
3380           (gnus-group-update-group-line))
3381       (error "Illegal level: %s" n))))
3382   (forward-line 1)
3383   (gnus-group-position-cursor))
3384
3385 (defun gnus-group-unsubscribe-current-group (arg)
3386   "Toggle subscribe from/to unsubscribe current group."
3387   (interactive "P")
3388   (let ((group (gnus-group-group-name)))
3389     (or group (error "No newsgroup on current line"))
3390     (or arg (setq arg (if (<= (gnus-group-group-level) 5) 6 3)))
3391     (gnus-group-unsubscribe-group group arg)
3392     (gnus-group-next-group 1)))
3393
3394 (defun gnus-group-unsubscribe-group (group &optional level)
3395   "Toggle subscribe from/to unsubscribe GROUP.
3396 New newsgroup is added to .newsrc automatically."
3397   (interactive
3398    (list (completing-read "Group: " gnus-active-hashtb nil 
3399                           gnus-have-read-active-file)))
3400   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
3401     (cond (newsrc
3402            ;; Toggle subscription flag.
3403            (gnus-group-change-level 
3404             newsrc (if level level (if (< (nth 1 (nth 2 newsrc)) 6) 6 4)))
3405            (gnus-group-update-group group))
3406           ((and (stringp group)
3407                 (gnus-gethash group gnus-active-hashtb))
3408            ;; Add new newsgroup.
3409            (gnus-group-change-level 
3410             group 
3411             (if level level 3) 
3412             (or (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
3413                 (and (member group gnus-zombie-list) 8)
3414                 9)
3415             (or (and (gnus-group-group-name)
3416                      (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))
3417                 (gnus-gethash (car (car gnus-newsrc-assoc)) 
3418                               gnus-newsrc-hashtb)))
3419            (gnus-group-update-group group))
3420           (t (error "No such newsgroup: %s" group)))
3421     (gnus-group-position-cursor)))
3422
3423 (defun gnus-group-transpose-groups (arg)
3424   "Exchange current newsgroup and previous newsgroup.
3425 With argument ARG, takes previous newsgroup and moves it past ARG newsgroup."
3426   (interactive "p")
3427   ;; BUG: last newsgroup and the last but one cannot be transposed
3428   ;; since gnus-group-search-forward does not move forward beyond the
3429   ;; last.  If we instead use forward-line, no problem, but I don't
3430   ;; want to use it for later extension.
3431   (while (> arg 0)
3432     (gnus-group-search-forward t t)
3433     (gnus-group-kill-group 1)
3434     (gnus-group-search-forward nil t)
3435     (gnus-group-yank-group)
3436     (gnus-group-search-forward nil t)
3437     (setq arg (1- arg))))
3438
3439 (defun gnus-group-kill-all-zombies ()
3440   "Kill all zombie newsgroups."
3441   (interactive)
3442   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
3443   (setq gnus-zombie-list nil)
3444   (funcall gnus-group-prepare-function 5 nil nil)
3445   (goto-char (point-min))
3446   (gnus-group-position-cursor))
3447
3448 (defun gnus-group-kill-region (begin end)
3449   "Kill newsgroups in current region (excluding current point).
3450 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
3451   (interactive "r")
3452   (let ((lines
3453          ;; Exclude a line where current point is on.
3454          (1-
3455           ;; Count lines.
3456           (save-excursion
3457             (count-lines
3458              (progn
3459                (goto-char begin)
3460                (beginning-of-line)
3461                (point))
3462              (progn
3463                (goto-char end)
3464                (end-of-line)
3465                (point)))))))
3466     (goto-char begin)
3467     (beginning-of-line)                 ;Important when LINES < 1
3468     (gnus-group-kill-group lines)))
3469
3470 (defun gnus-group-kill-group (n)
3471   "The the next N groups.
3472 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
3473 However, only groups that were alive can be yanked; already killed 
3474 groups or zombie groups can't be yanked.
3475 The return value is the name of the (last) newsgroup that was killed."
3476   (interactive "p")
3477   (let ((buffer-read-only nil)
3478         group entry level)
3479     (while (>= (setq n  (1- n)) 0)
3480       (setq group (gnus-group-group-name))
3481       (or group
3482           (signal 'end-of-buffer nil))
3483       (setq level (gnus-group-group-level))
3484       (beginning-of-line)
3485       (delete-region (point) (progn (forward-line 1) (point)))
3486       (if (setq entry (gnus-gethash group gnus-newsrc-hashtb))
3487           (setq gnus-list-of-killed-groups 
3488                 (cons (cons (car entry) (nth 2 entry)) 
3489                       gnus-list-of-killed-groups)))
3490       (gnus-group-change-level (if entry entry group) 9 (if entry nil level)))
3491     (if (eobp)
3492         (forward-line -1))
3493     (gnus-group-position-cursor)
3494     group))
3495
3496 (defun gnus-group-yank-group (&optional arg)
3497   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
3498 inserting it before the current newsgroup.  The numeric ARG specifies
3499 how many newsgroups are to be yanked.  The name of the (last)
3500 newsgroup yanked is returned."
3501   (interactive "p")
3502   (if (not arg) (setq arg 1))
3503   (let (info group prev)
3504     (while (>= (setq arg (1- arg)) 0)
3505       (if (not (setq info (car gnus-list-of-killed-groups)))
3506           (error "No more newsgroups to yank"))
3507       (setq group (nth 2 info))
3508       ;; Find which newsgroup to insert this one before - search
3509       ;; backward until something suitable is found. If there are no
3510       ;; other newsgroups in this buffer, just make this newsgroup the
3511       ;; first newsgroup.
3512       (while (and (not (setq prev (gnus-group-group-name)))
3513                   (zerop (forward-line -1))))
3514       (if (not prev)
3515           (setq prev (car (car gnus-newsrc-assoc))))
3516       (gnus-group-change-level 
3517        info (nth 2 info) 9 
3518        (gnus-gethash prev gnus-newsrc-hashtb)
3519        t)
3520       (gnus-group-insert-group-line-info (nth 1 info))
3521       (setq gnus-list-of-killed-groups 
3522             (cdr gnus-list-of-killed-groups)))
3523     (forward-line -1)
3524     (gnus-group-position-cursor)
3525     group))
3526       
3527 (defun gnus-group-list-all-groups (arg)
3528   "List all newsgroups with level ARG or lower.
3529 Default is 7, which lists all subscribed and most unsubscribed groups."
3530   (interactive "P")
3531   (setq arg (or arg 7))
3532   (gnus-group-list-groups arg t))
3533
3534 (defun gnus-group-list-killed ()
3535   "List all killed newsgroups in the group buffer."
3536   (interactive)
3537   (if (not gnus-killed-list)
3538       (message "No killed groups")
3539     (funcall gnus-group-prepare-function 9 t 9)
3540     (goto-char (point-min)))
3541   (gnus-group-position-cursor))
3542
3543 (defun gnus-group-list-zombies ()
3544   "List all zombie newsgroups in the group buffer."
3545   (interactive)
3546   (if (not gnus-zombie-list)
3547       (message "No zombie groups")
3548     (funcall gnus-group-prepare-function 8 t 8)
3549     (goto-char (point-min)))
3550   (gnus-group-position-cursor))
3551
3552 (defun gnus-group-get-new-news (&optional arg)
3553   "Get newly arrived articles.
3554 If ARG is non-nil, it should be a number between one and nine to
3555 specify which levels you are interested in re-scanning."
3556   (interactive "P")
3557   (run-hooks 'gnus-get-new-news-hook)
3558   (if (and gnus-read-active-file (not arg))
3559       (progn
3560         (gnus-read-active-file)
3561         (gnus-get-unread-articles (or arg 6)))
3562     (let ((gnus-read-active-file nil))
3563       (gnus-get-unread-articles (or arg 6))))
3564   (gnus-group-list-groups 5 gnus-have-all-newsgroups))
3565
3566 (defun gnus-group-get-new-news-this-group (n)
3567   "Check for newly arrived news in the current group (and the N-1 next groups).
3568 The difference between N and the number of newsgroup checked is returned.
3569 If N is negative, this group and the N-1 previous groups will be checked."
3570   (interactive "p")
3571   (let ((way (if (< n 0) -1 1))
3572         (n (abs n))
3573         (w-p (window-start))
3574         group)
3575     (while (and (> n 0)
3576                 (progn
3577                   (or (gnus-get-new-news-in-group
3578                        (setq group (gnus-group-group-name)))
3579                       (progn 
3580                         (ding) 
3581                         (message "%s error: %s" 
3582                                  group (gnus-status-message group))))
3583                   t)
3584                 (zerop (gnus-group-next-group way)))
3585       (setq n (1- n)))
3586     (if (/= 0 n) (message "No more newsgroups"))
3587     ;; !!! I don't know why the buffer scrolls forward when updating
3588     ;; the first line in the group buffer, but it does. So we set the
3589     ;; window start forcibly.
3590     (set-window-start (get-buffer-window (current-buffer)) w-p)
3591     n))
3592
3593 (defun gnus-get-new-news-in-group (group)
3594   (and group 
3595        (gnus-activate-newsgroup group)
3596        (progn
3597          (gnus-get-unread-articles-in-group 
3598           (nth 2 (gnus-gethash group gnus-newsrc-hashtb))
3599           (gnus-gethash group gnus-active-hashtb))
3600          (gnus-group-update-group-line)
3601          t)))
3602
3603 (defun gnus-group-fetch-faq (group)
3604   "Fetch the FAQ for the current group."
3605   (interactive (list (gnus-group-group-name)))
3606   (or group (error "No group name given"))
3607   (let ((file (concat gnus-group-faq-directory group))) 
3608     (if (not (file-exists-p file))
3609         (error "No such file: %s" file)
3610       (find-file file))))
3611   
3612 (defun gnus-group-describe-group (force &optional group)
3613   "Display a description of the current newsgroup."
3614   (interactive "P")
3615   (and force (setq gnus-description-hashtb nil))
3616   (let ((group (or group (gnus-group-group-name)))
3617         desc)
3618     (or group (message "No group name given"))
3619     (and (or gnus-description-hashtb
3620              (setq desc (gnus-group-get-description group))
3621              (gnus-read-descriptions-file))
3622          (message
3623           (or desc (gnus-gethash group gnus-description-hashtb)
3624               "No description available")))))
3625
3626 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
3627 (defun gnus-group-describe-all-groups (force)
3628   "Pop up a buffer with descriptons of all newsgroups."
3629   (interactive "P")
3630   (and force (setq gnus-description-hashtb nil))
3631   (if (not (or gnus-description-hashtb
3632                (gnus-read-descriptions-file)))
3633       (error "Couldn't request descriptions file"))
3634   (let ((buffer-read-only nil)
3635         b)
3636     (erase-buffer)
3637     (mapatoms
3638      (lambda (group)
3639        (setq b (point))
3640        (insert (format "      *: %-20s %s\n" (symbol-name group)
3641                        (symbol-value group)))
3642        (add-text-properties 
3643         b (1+ b) (list 'gnus-group group
3644                        'gnus-unread t 'gnus-marked nil 'gnus-level 6)))
3645      gnus-description-hashtb)
3646     (goto-char (point-min))
3647     (gnus-group-position-cursor)))
3648
3649 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
3650 (defun gnus-group-apropos (regexp &optional search-description)
3651   "List all newsgroups that have names that match a regexp."
3652   (interactive "sGnus apropos (regexp): ")
3653   (let ((prev "")
3654         (obuf (current-buffer))
3655         groups des prev)
3656     ;; Go through all newsgroups that are known to Gnus.
3657     (mapatoms 
3658      (lambda (group)
3659        (and (string-match regexp (symbol-name group))
3660             (setq groups (cons (symbol-name group) groups))))
3661      gnus-active-hashtb)
3662     ;; Go through all descriptions that are known to Gnus. 
3663     (if search-description
3664         (mapatoms 
3665          (lambda (group)
3666            (and (string-match regexp (symbol-value group))
3667                 (gnus-gethash (symbol-name group) gnus-active-hashtb)
3668                 (setq groups (cons (symbol-name group) groups))))
3669          gnus-description-hashtb))
3670     (if (not groups)
3671         (message "No groups matched \"%s\"." regexp)
3672       ;; Print out all the groups.
3673       (save-excursion
3674         (pop-to-buffer (get-buffer-create "*Gnus Help*"))
3675         (buffer-disable-undo (current-buffer))
3676         (erase-buffer)
3677         (setq groups (sort groups 'string<))
3678         (while groups
3679           ;; Groups may be entered twice into the list of groups.
3680           (if (not (string= (car groups) prev))
3681               (progn
3682                 (insert (setq prev (car groups)) "\n")
3683                 (if (and gnus-description-hashtb
3684                          (setq des (gnus-gethash (car groups) 
3685                                                  gnus-description-hashtb)))
3686                     (insert "  " des "\n"))))
3687           (setq groups (cdr groups)))
3688         (goto-char 1)))
3689     (pop-to-buffer obuf)))
3690
3691 (defun gnus-group-description-apropos (regexp)
3692   "List all newsgroups that have names or desccriptions that match a regexp."
3693   (interactive "sGnus description apropos (regexp): ")
3694   (if (not (or gnus-description-hashtb
3695                (gnus-read-descriptions-file)))
3696       (error "Couldn't request descriptions file"))
3697   (gnus-group-apropos regexp t))
3698
3699 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
3700 (defun gnus-group-list-matching (level regexp &optional all lowest) 
3701   "List all groups with unread articles that match REGEXP.
3702 If the prefix LEVEL is non-nil, it should be a number that says which
3703 level to cut off listing groups. 
3704 If ALL, also list groups with no unread articles.
3705 If LOWEST, don't list groups with level lower than LOWEST."
3706   (interactive "P\nsList newsgroups matching: ")
3707   (gnus-group-prepare-flat (or level 5) all (or lowest 1) regexp)
3708   (goto-char (point-min))
3709   (gnus-group-position-cursor))
3710
3711 (defun gnus-group-list-all-matching (level regexp &optional lowest) 
3712   "List all groups that match REGEXP.
3713 If the prefix LEVEL is non-nil, it should be a number that says which
3714 level to cut off listing groups. 
3715 If LOWEST, don't list groups with level lower than LOWEST."
3716   (interactive "P\nsList newsgroups matching: ")
3717   (gnus-group-list-matching (or level 9) regexp t lowest))
3718
3719 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
3720 (defun gnus-group-save-newsrc ()
3721   "Save the Gnus startup files."
3722   (interactive)
3723   (gnus-save-newsrc-file))
3724
3725 (defun gnus-group-restart (&optional arg)
3726   "Force Gnus to read the .newsrc file."
3727   (interactive "P")
3728   (gnus-save-newsrc-file)
3729   (gnus-setup-news 'force)
3730   (gnus-group-list-groups (or arg 5) gnus-have-all-newsgroups))
3731
3732 (defun gnus-group-read-init-file ()
3733   "Read the Gnus elisp init file."
3734   (interactive)
3735   (gnus-read-init-file))
3736
3737 (defun gnus-group-check-bogus-groups ()
3738   "Check bogus newsgroups."
3739   (interactive)
3740   (gnus-check-bogus-newsgroups (not gnus-expert-user))  ;Require confirmation.
3741   (gnus-group-list-groups 5 gnus-have-all-newsgroups))
3742
3743 (defun gnus-group-mail ()
3744   "Start composing a mail."
3745   (interactive)
3746   (mail))
3747
3748 (defun gnus-group-edit-global-kill (article &optional group)
3749   "Edit the global kill file.
3750 If GROUP, edit that local kill file instead."
3751   (interactive "P")
3752   (setq gnus-current-kill-article article)
3753   (gnus-kill-file-edit-file group)
3754   (message
3755    (substitute-command-keys
3756     "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)")))
3757
3758 (defun gnus-group-edit-local-kill (article group)
3759   "Edit a local kill file."
3760   (interactive (list nil (gnus-group-group-name)))
3761   (gnus-group-edit-global-kill article group))
3762
3763 (defun gnus-group-force-update ()
3764   "Update `.newsrc' file."
3765   (interactive)
3766   (gnus-save-newsrc-file))
3767
3768 (defun gnus-group-suspend ()
3769   "Suspend the current Gnus session.
3770 In fact, cleanup buffers except for group mode buffer.
3771 The hook gnus-suspend-gnus-hook is called before actually suspending."
3772   (interactive)
3773   (run-hooks 'gnus-suspend-gnus-hook)
3774   ;; Kill Gnus buffers except for group mode buffer.
3775   (let ((group-buf (get-buffer gnus-group-buffer)))
3776     (while gnus-buffer-list
3777       (and (not (eq (get-buffer (car gnus-buffer-list)) group-buf))
3778            (not (eq (get-buffer (car gnus-buffer-list)) gnus-dribble-buffer))
3779            (get-buffer (car gnus-buffer-list))
3780            (buffer-name (get-buffer (car gnus-buffer-list)))
3781            (kill-buffer (car gnus-buffer-list)))
3782       (setq gnus-buffer-list (cdr gnus-buffer-list)))
3783     (setq gnus-buffer-list (list group-buf))
3784     (bury-buffer group-buf)
3785     (delete-windows-on group-buf t)))
3786
3787 (defun gnus-group-clear-dribble ()
3788   "Clear all information from the dribble buffer."
3789   (interactive)
3790   (gnus-dribble-clear))
3791
3792 (defun gnus-group-exit ()
3793   "Quit reading news after updating .newsrc.eld and .newsrc.
3794 The hook `gnus-exit-gnus-hook' is called before actually exiting."
3795   (interactive)
3796   (if (or noninteractive                ;For gnus-batch-kill
3797           (zerop (buffer-size))         ;No news is good news.
3798           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
3799           (not gnus-interactive-exit)   ;Without confirmation
3800           gnus-expert-user
3801           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
3802       (progn
3803         (run-hooks 'gnus-exit-gnus-hook)
3804         (gnus-save-newsrc-file)
3805         (gnus-close-backends)
3806         (gnus-clear-system))))
3807
3808 (defun gnus-close-backends ()
3809   (let ((methods gnus-valid-select-methods)
3810         func)
3811     (while methods
3812       (if (fboundp (setq func (intern (concat (car (car methods))
3813                                               "-request-close"))))
3814           (funcall func))
3815       (setq methods (cdr methods)))))
3816
3817 (defun gnus-group-quit ()
3818   "Quit reading news without updating .newsrc.eld or .newsrc.
3819 The hook `gnus-exit-gnus-hook' is called before actually exiting."
3820   (interactive)
3821   (if (or noninteractive                ;For gnus-batch-kill
3822           (zerop (buffer-size))
3823           (not (gnus-server-opened gnus-select-method))
3824           gnus-expert-user
3825           (not gnus-current-startup-file)
3826           (gnus-yes-or-no-p
3827            (format "Quit reading news without saving %s? "
3828                    (file-name-nondirectory gnus-current-startup-file))))
3829       (progn
3830         (run-hooks 'gnus-exit-gnus-hook)
3831         (gnus-dribble-save)
3832         (gnus-close-backends)
3833         (gnus-clear-system))))
3834
3835 (defun gnus-group-describe-briefly ()
3836   "Give a one line description of the group mode commands."
3837   (interactive)
3838   (message
3839    (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")))
3840
3841 (defun gnus-group-browse-foreign-server (method)
3842   "Browse a foreign news server.
3843 If called interactively, this function will ask for a select method
3844  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). 
3845 If not, METHOD should be a list where the first element is the method
3846 and the second element is the address."
3847   (interactive
3848    (list (list (intern (completing-read 
3849                         "Select method: "
3850                         gnus-valid-select-methods nil t "nntp"))
3851                ;; Suggested by mapjph@bath.ac.uk.
3852                (completing-read 
3853                 "Server name: " 
3854                 (mapcar (lambda (server) (list server))
3855                         gnus-secondary-servers)))))
3856   (gnus-browse-foreign-server method))
3857
3858 \f
3859 ;;;
3860 ;;; Browse Server Mode
3861 ;;;
3862
3863 (defvar gnus-browse-server-mode-hook nil)
3864 (defvar gnus-browse-server-mode-map nil)
3865
3866 (if gnus-browse-server-mode-map
3867     nil
3868   (setq gnus-browse-server-mode-map (make-keymap))
3869   (suppress-keymap gnus-browse-server-mode-map)
3870   (define-key gnus-browse-server-mode-map " " 'gnus-browse-read-group)
3871   (define-key gnus-browse-server-mode-map "=" 'gnus-browse-read-group)
3872   (define-key gnus-browse-server-mode-map "n" 'gnus-browse-next-group)
3873   (define-key gnus-browse-server-mode-map "p" 'gnus-browse-prev-group)
3874   (define-key gnus-browse-server-mode-map "\177" 'gnus-browse-prev-group)
3875   (define-key gnus-browse-server-mode-map "N" 'gnus-browse-next-group)
3876   (define-key gnus-browse-server-mode-map "P" 'gnus-browse-prev-group)
3877   (define-key gnus-browse-server-mode-map "\M-n" 'gnus-browse-next-group)
3878   (define-key gnus-browse-server-mode-map "\M-p" 'gnus-browse-prev-group)
3879   (define-key gnus-browse-server-mode-map "\r" 'gnus-browse-read-group)
3880   (define-key gnus-browse-server-mode-map "u" 'gnus-browse-unsubscribe-current-group)
3881   (define-key gnus-browse-server-mode-map "q" 'gnus-browse-exit)
3882   (define-key gnus-browse-server-mode-map "Q" 'gnus-browse-exit)
3883   (define-key gnus-browse-server-mode-map "\C-c\C-c" 'gnus-browse-exit)
3884   (define-key gnus-browse-server-mode-map "?" 'gnus-browse-describe-briefly)
3885   (define-key gnus-browse-server-mode-map "\C-c\C-i" 'gnus-info-find-node)
3886   )
3887
3888 (defvar gnus-browse-current-method nil)
3889
3890 (defun gnus-browse-foreign-server (method)
3891   (setq gnus-browse-current-method method)
3892   (let ((gnus-select-method method)
3893         groups group)
3894     (message "Connecting to %s..." (nth 1 method))
3895     (if (not (gnus-request-list method))
3896         (error "Unable to contact server: " (gnus-status-message method)))
3897     (set-buffer (get-buffer-create "*Gnus Browse Server*"))
3898     (gnus-add-current-to-buffer-list)
3899     (buffer-disable-undo (current-buffer))
3900     (let ((buffer-read-only nil))
3901       (erase-buffer))
3902     (gnus-browse-server-mode)
3903     (setq mode-line-buffer-identification
3904           (format
3905            "(ding) Browse Server {%s:%s}" (car method) (car (cdr method))))
3906     (save-excursion
3907       (set-buffer nntp-server-buffer)
3908       (let ((cur (current-buffer)))
3909         (goto-char 1)
3910         (delete-matching-lines gnus-ignored-newsgroups)
3911         (while (re-search-forward 
3912                 "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
3913           (goto-char (match-end 1))
3914           (setq groups (cons (cons (buffer-substring (match-beginning 1)
3915                                                      (match-end 1))
3916                                    (- (read cur) (read cur)))
3917                              groups)))))
3918     (setq groups (sort groups 
3919                        (lambda (l1 l2)
3920                          (string< (car l1) (car l2)))))
3921     (let ((buffer-read-only nil))
3922       (while groups
3923         (setq group (car groups))
3924         (insert 
3925          (format "K%7d: %s\n" (cdr group) (car group)))
3926         (setq groups (cdr groups))))
3927     (switch-to-buffer (current-buffer))
3928     (goto-char 1)
3929     (gnus-group-position-cursor)))
3930
3931 (defun gnus-browse-server-mode ()
3932   "Major mode for browsing a foreign server."
3933   (interactive)
3934   (kill-all-local-variables)
3935   (setq mode-line-modified "-- ")
3936   (make-local-variable 'mode-line-format)
3937   (setq mode-line-format (copy-sequence mode-line-format))
3938   (and (equal (nth 3 mode-line-format) "   ")
3939        (setcar (nthcdr 3 mode-line-format) ""))
3940   (setq major-mode 'gnus-browse-server-mode)
3941   (setq mode-name "Browse Server")
3942   (setq mode-line-process nil)
3943   (use-local-map gnus-browse-server-mode-map)
3944   (buffer-disable-undo (current-buffer))
3945   (setq truncate-lines t)
3946   (setq buffer-read-only t)
3947   (run-hooks 'gnus-browse-server-mode-hook))
3948
3949 (defun gnus-browse-read-group ()
3950   "Not implemented, and will probably never be."
3951   (interactive)
3952   (error "You can't read while browsing"))
3953
3954 (defun gnus-browse-next-group (n)
3955   "Go to the next group."
3956   (interactive "p")
3957   (prog1
3958       (forward-line n)
3959     (gnus-group-position-cursor)))
3960
3961 (defun gnus-browse-prev-group (n)
3962   "Go to the next group."
3963   (interactive "p")
3964   (gnus-browse-next-group (- n)))
3965
3966 (defun gnus-browse-unsubscribe-current-group (arg)
3967   "(Un)subscribe to the next ARG groups."
3968   (interactive "p")
3969   (and (eobp)
3970        (error "No group at current line."))
3971   (let ((ward (if (< arg 0) -1 1))
3972         (arg (abs arg)))
3973     (while (and (> arg 0)
3974                 (not (eobp))
3975                 (gnus-browse-unsubscribe-group)
3976                 (zerop (gnus-browse-next-group ward)))
3977       (setq arg (1- arg)))
3978     (gnus-group-position-cursor)
3979     (if (/= 0 arg) (message "No more newsgroups"))
3980     arg))
3981   
3982 (defun gnus-browse-unsubscribe-group ()
3983   (let ((sub nil)
3984         (buffer-read-only nil)
3985         group)
3986     (save-excursion
3987       (beginning-of-line)
3988       (if (= (following-char) ?K) (setq sub t))
3989       (re-search-forward ": \\(.*\\)$" nil t)
3990       (setq group (gnus-group-prefixed-name 
3991                    (buffer-substring (match-beginning 1) (match-end 1))
3992                    gnus-browse-current-method))
3993       (beginning-of-line)
3994       (delete-char 1)
3995       (if sub
3996           (progn
3997             (gnus-group-change-level 
3998              (list t group 3 nil nil gnus-browse-current-method) 3 9 
3999              (gnus-gethash (car (nth 1 gnus-newsrc-assoc)) gnus-newsrc-hashtb)
4000              t)
4001             (insert ? ))
4002         (gnus-group-change-level group 9 3)
4003         (insert ?K)))
4004     t))
4005
4006 (defun gnus-browse-exit ()
4007   "Quit browsing and return to the group buffer."
4008   (interactive)
4009   (if (eq major-mode 'gnus-browse-server-mode)
4010       (kill-buffer (current-buffer)))
4011   (switch-to-buffer gnus-group-buffer)
4012   (gnus-group-list-groups 5))
4013
4014 (defun gnus-browse-describe-briefly ()
4015   "Give a one line description of the group mode commands."
4016   (interactive)
4017   (message
4018    (substitute-command-keys "\\<gnus-browse-server-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")))
4019       
4020 \f
4021 ;;;
4022 ;;; Gnus summary mode
4023 ;;;
4024
4025 (defvar gnus-summary-mode-map nil)
4026 (defvar gnus-summary-mark-map nil)
4027 (defvar gnus-summary-mscore-map nil)
4028 (defvar gnus-summary-send-map nil)
4029 (defvar gnus-summary-extract-map nil)
4030 (defvar gnus-summary-extract-view-map nil)
4031 (defvar gnus-summary-article-map nil)
4032 (defvar gnus-summary-thread-map nil)
4033 (defvar gnus-summary-goto-map nil)
4034 (defvar gnus-summary-exit-map nil)
4035 (defvar gnus-summary-various-map nil)
4036 (defvar gnus-summary-interest-map nil)
4037 (defvar gnus-summary-process-map nil)
4038 (defvar gnus-summary-score-map nil)
4039 (defvar gnus-summary-sort-map nil)
4040 (defvar gnus-summary-mgroup-map nil)
4041 (defvar gnus-summary-vkill-map nil)
4042 (defvar gnus-summary-increase-map nil)
4043 (defvar gnus-summary-inc-subject-map nil)
4044 (defvar gnus-summary-inc-author-map nil)
4045 (defvar gnus-summary-inc-id-map nil)
4046 (defvar gnus-summary-inc-xref-map nil)
4047 (defvar gnus-summary-inc-thread-map nil)
4048 (defvar gnus-summary-inc-fol-map nil)
4049 (defvar gnus-summary-lower-map nil)
4050 (defvar gnus-summary-low-subject-map nil)
4051 (defvar gnus-summary-low-author-map nil)
4052 (defvar gnus-summary-low-id-map nil)
4053 (defvar gnus-summary-low-xref-map nil)
4054 (defvar gnus-summary-low-thread-map nil)
4055 (defvar gnus-summary-low-fol-map nil)
4056
4057 (if gnus-summary-mode-map
4058     nil
4059   (setq gnus-summary-mode-map (make-keymap))
4060   (suppress-keymap gnus-summary-mode-map)
4061
4062   ;; Non-orthogonal keys
4063
4064   (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
4065   (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
4066   (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
4067   (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
4068   (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
4069   (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
4070   (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
4071   (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject)
4072   (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject)
4073   (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject)
4074   (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject)
4075   (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
4076   (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article)
4077   (define-key gnus-summary-mode-map "\M-s" 'gnus-summary-search-article-forward)
4078   (define-key gnus-summary-mode-map "\M-r" 'gnus-summary-search-article-backward)
4079   (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
4080   (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
4081   (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
4082   (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
4083   (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article)
4084   (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward)
4085   (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward)
4086   (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward)
4087   (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
4088   (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
4089   (define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable)
4090   (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward)
4091   (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward)
4092   (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
4093   (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
4094   (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread)
4095   (define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread)
4096   (define-key gnus-summary-mode-map "e" 'gnus-summary-edit-article)
4097   (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable)
4098   (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable)
4099   (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads)
4100   (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread)
4101   (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread)
4102   (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread)
4103   (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread)
4104   (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread)
4105   (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread)
4106   (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
4107   (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
4108   (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
4109   (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant)
4110   (define-key gnus-summary-mode-map "\C-c\M-\C-s" 'gnus-summary-show-all-expunged)
4111   (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
4112   (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
4113   (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
4114   (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
4115   (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score)
4116   (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
4117   (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
4118   (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group)
4119   (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
4120   (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
4121   (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime)
4122   (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
4123   (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
4124   (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
4125   (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
4126   (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
4127   (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
4128   (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
4129   (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail)
4130   (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
4131   (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill)
4132   (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill)
4133   (define-key gnus-summary-mode-map "V" 'gnus-version)
4134   (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group)
4135   (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
4136   (define-key gnus-summary-mode-map "Q" 'gnus-summary-quit)
4137   (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
4138   (define-key gnus-summary-mode-map [mouse-2] 'gnus-mouse-pick-article)
4139   (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
4140   (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
4141   (define-key gnus-summary-mode-map "x" 'gnus-summary-delete-marked-as-read)
4142 ; (define-key gnus-summary-mode-map "X" 'gnus-summary-remove-lines-marked-with)
4143   (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
4144   (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
4145   (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
4146 ;  (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
4147   (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
4148   (define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu)
4149
4150
4151   ;; Sort of orthogonal keymap
4152   (define-prefix-command 'gnus-summary-mark-map)
4153   (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map)
4154   (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward)
4155   (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward)
4156   (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward)
4157   (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward)
4158   (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward)
4159   (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward)
4160   (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable)
4161   (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable)
4162   (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant)
4163   (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark)
4164   (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark)
4165   (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable)
4166   (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable)
4167   (define-key gnus-summary-mark-map "\M-r" 'gnus-summary-remove-lines-marked-as-read)
4168   (define-key gnus-summary-mark-map "\M-\C-r" 'gnus-summary-remove-lines-marked-with)
4169   (define-key gnus-summary-mark-map "D" 'gnus-summary-show-all-dormant)
4170   (define-key gnus-summary-mark-map "\M-D" 'gnus-summary-hide-all-dormant)
4171   (define-key gnus-summary-mark-map "S" 'gnus-summary-show-all-expunged)
4172   (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup)
4173   (define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here)
4174   (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all)
4175
4176   (define-prefix-command 'gnus-summary-mscore-map)
4177   (define-key gnus-summary-mark-map "s" 'gnus-summary-mscore-map)
4178   (define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above)
4179   (define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above)
4180   (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above)
4181   (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below)
4182
4183   (define-prefix-command 'gnus-summary-process-map)
4184   (define-key gnus-summary-mark-map "p" 'gnus-summary-process-map)
4185   (define-key gnus-summary-process-map "p" 'gnus-summary-mark-as-processable)
4186   (define-key gnus-summary-process-map "u" 'gnus-summary-unmark-as-processable)
4187   (define-key gnus-summary-process-map "U" 'gnus-summary-unmark-all-processable)
4188   (define-key gnus-summary-process-map "s" 'gnus-uu-mark-series)
4189   (define-key gnus-summary-process-map "r" 'gnus-uu-mark-region)
4190   (define-key gnus-summary-process-map "R" 'gnus-uu-mark-by-regexp)
4191   (define-key gnus-summary-process-map "t" 'gnus-uu-mark-thread)
4192   (define-key gnus-summary-process-map "a" 'gnus-uu-mark-all)
4193   (define-key gnus-summary-process-map "S" 'gnus-uu-mark-sparse)
4194   
4195
4196   (define-prefix-command 'gnus-summary-send-map)
4197   (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
4198   (define-key gnus-summary-send-map "p" 'gnus-summary-post-news)
4199   (define-key gnus-summary-send-map "f" 'gnus-summary-followup)
4200   (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original)
4201   (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply)
4202   (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original)
4203   (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article)
4204   (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article)
4205   (define-key gnus-summary-send-map "r" 'gnus-summary-reply)
4206   (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
4207   (define-key gnus-summary-send-map "\C-f" 'gnus-summary-mail-forward)
4208   (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
4209   (define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
4210   (define-key gnus-summary-send-map "\M-f" 'gnus-uu-digest-and-forward)
4211
4212   
4213   (define-prefix-command 'gnus-summary-goto-map)
4214   (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map)
4215   (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article)
4216   (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article)
4217   (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article)
4218   (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article)
4219   (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject)
4220   (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject)
4221   (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject)
4222   (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject)
4223   (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article)
4224   (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article)
4225   (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject)
4226   (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article)
4227   (define-key gnus-summary-goto-map "p" 'gnus-summary-pop-article)
4228
4229
4230   (define-prefix-command 'gnus-summary-thread-map)
4231   (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map)
4232   (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread)
4233   (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread)
4234   (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread)
4235   (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads)
4236   (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread)
4237   (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads)
4238   (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread)
4239   (define-key gnus-summary-thread-map "H" 'gnus-summary-hide-all-threads)
4240   (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread)
4241   (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread)
4242   (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread)
4243   (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread)
4244   (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread)
4245
4246   
4247   (define-prefix-command 'gnus-summary-exit-map)
4248   (define-key gnus-summary-mode-map "\M-e" 'gnus-summary-exit-map)
4249   (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit)
4250   (define-key gnus-summary-exit-map "\C-c" 'gnus-summary-catchup-all-and-exit)
4251   (define-key gnus-summary-exit-map "q" 'gnus-summary-exit)
4252   (define-key gnus-summary-exit-map "e" 'gnus-summary-exit)
4253   (define-key gnus-summary-exit-map "Q" 'gnus-summary-quit)
4254   (define-key gnus-summary-exit-map "E" 'gnus-summary-quit)
4255
4256
4257   (define-prefix-command 'gnus-summary-article-map)
4258   (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map)
4259   (define-key gnus-summary-article-map " " 'gnus-summary-next-page)
4260   (define-key gnus-summary-article-map "n" 'gnus-summary-next-page)
4261   (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page)
4262   (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page)
4263   (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up)
4264   (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article)
4265   (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article)
4266   (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article)
4267   (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article)
4268   (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article)
4269   (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article)
4270   (define-key gnus-summary-article-map "w" 'gnus-summary-stop-page-breaking)
4271   (define-key gnus-summary-article-map "c" 'gnus-summary-caesar-message)
4272   (define-key gnus-summary-article-map "g" 'gnus-summary-show-article)
4273   (define-key gnus-summary-article-map "t" 'gnus-summary-toggle-header)
4274   (define-key gnus-summary-article-map "hh" 'gnus-article-hide-headers)
4275   (define-key gnus-summary-article-map "hs" 'gnus-article-hide-signature)
4276   (define-key gnus-summary-article-map "hc" 'gnus-article-hide-citation)
4277   (define-key gnus-summary-article-map "ho" 'gnus-article-treat-overstrike)
4278   (define-key gnus-summary-article-map "hw" 'gnus-article-word-wrap)
4279   (define-key gnus-summary-article-map "hd" 'gnus-article-remove-cr)
4280   (define-key gnus-summary-article-map "hq" 'gnus-article-de-quoted-unreadable)
4281   (define-key gnus-summary-article-map "m" 'gnus-summary-toggle-mime)
4282   (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article)
4283
4284
4285   (define-prefix-command 'gnus-summary-extract-map)
4286   (define-key gnus-summary-mode-map "X" 'gnus-summary-extract-map)
4287 ;  (define-key gnus-summary-extract-map "x" 'gnus-summary-extract-any)
4288 ;  (define-key gnus-summary-extract-map "m" 'gnus-summary-extract-mime)
4289   (define-key gnus-summary-extract-map "u" 'gnus-uu-decode-uu)
4290   (define-key gnus-summary-extract-map "U" 'gnus-uu-decode-uu-and-save)
4291   (define-key gnus-summary-extract-map "s" 'gnus-uu-decode-unshar)
4292   (define-key gnus-summary-extract-map "S" 'gnus-uu-decode-unshar-and-save)
4293   (define-key gnus-summary-extract-map "o" 'gnus-uu-decode-save)
4294   (define-key gnus-summary-extract-map "O" 'gnus-uu-decode-save)
4295   (define-key gnus-summary-extract-map "b" 'gnus-uu-decode-binhex)
4296   (define-key gnus-summary-extract-map "B" 'gnus-uu-decode-binhex)
4297
4298   (define-prefix-command 'gnus-summary-extract-view-map)
4299   (define-key gnus-summary-extract-map "v" 'gnus-summary-extract-view-map)
4300   (define-key gnus-summary-extract-view-map "u" 'gnus-uu-decode-uu-view)
4301   (define-key gnus-summary-extract-view-map "U" 'gnus-uu-decode-uu-and-save-view)
4302   (define-key gnus-summary-extract-view-map "s" 'gnus-uu-decode-unshar-view)
4303   (define-key gnus-summary-extract-view-map "S" 'gnus-uu-decode-unshar-and-save-view)
4304   (define-key gnus-summary-extract-view-map "o" 'gnus-uu-decode-save-view)
4305   (define-key gnus-summary-extract-view-map "O" 'gnus-uu-decode-save-view)
4306   (define-key gnus-summary-extract-view-map "b" 'gnus-uu-decode-binhex-view)
4307   (define-key gnus-summary-extract-view-map "B" 'gnus-uu-decode-binhex-view)
4308   
4309   
4310   (define-prefix-command 'gnus-summary-various-map)
4311   (define-key gnus-summary-mode-map "V" 'gnus-summary-various-map)
4312   (define-key gnus-summary-various-map "u" 'gnus-summary-universal-argument)
4313   (define-key gnus-summary-various-map "\C-s" 'gnus-summary-search-article-forward)
4314   (define-key gnus-summary-various-map "\C-r" 'gnus-summary-search-article-backward)
4315   (define-key gnus-summary-various-map "r" 'gnus-summary-refer-article)
4316   (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command)
4317   (define-key gnus-summary-various-map "T" 'gnus-summary-toggle-truncation)
4318   (define-key gnus-summary-various-map "e" 'gnus-summary-expand-window)
4319   (define-key gnus-summary-various-map "S" 'gnus-summary-reselect-current-group)
4320   (define-key gnus-summary-various-map "g" 'gnus-summary-rescan-group)
4321   (define-key gnus-summary-various-map "o" 'gnus-summary-save-article)
4322   (define-key gnus-summary-various-map "\C-o" 'gnus-summary-save-article-mail)
4323   (define-key gnus-summary-various-map "|" 'gnus-summary-pipe-output)
4324   (define-key gnus-summary-various-map "V" 'gnus-version)
4325   (define-key gnus-summary-various-map "f" 'gnus-summary-fetch-faq)
4326   (define-key gnus-summary-various-map "d" 'gnus-summary-describe-group)
4327   (define-key gnus-summary-various-map "?" 'gnus-summary-describe-briefly)
4328   (define-key gnus-summary-various-map "i" 'gnus-info-find-node)
4329   (define-key gnus-summary-various-map "D" 'gnus-summary-enter-digest-group)
4330
4331   (define-prefix-command 'gnus-summary-score-map)
4332   (define-key gnus-summary-various-map "S" 'gnus-summary-score-map)
4333   (define-key gnus-summary-score-map "s" 'gnus-summary-set-score)
4334   (define-key gnus-summary-score-map "c" 'gnus-score-change-score-file)
4335   (define-key gnus-summary-score-map "m" 'gnus-score-set-mark-below)
4336   (define-key gnus-summary-score-map "E" 'gnus-score-set-expunge-below)
4337   (define-key gnus-summary-score-map "e" 'gnus-score-edit-file)
4338
4339   (define-prefix-command 'gnus-summary-sort-map)
4340   (define-key gnus-summary-various-map "s" 'gnus-summary-sort-map)
4341   (define-key gnus-summary-sort-map "n" 'gnus-summary-sort-by-number)
4342   (define-key gnus-summary-sort-map "a" 'gnus-summary-sort-by-author)
4343   (define-key gnus-summary-sort-map "s" 'gnus-summary-sort-by-subject)
4344   (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date)
4345   (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score)
4346
4347   (define-prefix-command 'gnus-summary-mgroup-map)
4348   (define-key gnus-summary-various-map "m" 'gnus-summary-mgroup-map)
4349   (define-key gnus-summary-mgroup-map "e" 'gnus-summary-expire-articles)
4350   (define-key gnus-summary-mgroup-map "\177" 'gnus-summary-delete-article)
4351   (define-key gnus-summary-mgroup-map "m" 'gnus-summary-move-article)
4352   (define-key gnus-summary-mgroup-map "r" 'gnus-summary-respool-article)
4353   (define-key gnus-summary-mgroup-map "w" 'gnus-summary-edit-article)
4354   (define-key gnus-summary-mgroup-map "c" 'gnus-summary-copy-article)
4355
4356   (define-prefix-command 'gnus-summary-vkill-map)
4357   (define-key gnus-summary-various-map "k" 'gnus-summary-vkill-map)
4358   (define-key gnus-summary-vkill-map "k" 'gnus-summary-kill-same-subject-and-select)
4359   (define-key gnus-summary-vkill-map "K" 'gnus-summary-kill-same-subject)
4360   (define-key gnus-summary-vkill-map "\M-k" 'gnus-summary-edit-local-kill)
4361   (define-key gnus-summary-vkill-map "\M-K" 'gnus-summary-edit-global-kill)
4362
4363
4364   (define-prefix-command 'gnus-summary-increase-map)
4365   (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-map)
4366   (define-key gnus-summary-increase-map "i" 'gnus-summary-raise-same-subject-and-select)
4367   (define-key gnus-summary-increase-map "I" 'gnus-summary-raise-same-subject)
4368   (define-key gnus-summary-increase-map "\C-i" 'gnus-summary-raise-score)
4369
4370   (define-prefix-command 'gnus-summary-inc-subject-map)
4371   (define-key gnus-summary-increase-map "s" 'gnus-summary-inc-subject-map)
4372   (define-key gnus-summary-increase-map "S" 'gnus-summary-temporarily-raise-by-subject)
4373   (define-key gnus-summary-inc-subject-map "s" 'gnus-summary-temporarily-raise-by-subject)
4374   (define-key gnus-summary-inc-subject-map "S" 'gnus-summary-raise-by-subject)
4375   (define-key gnus-summary-inc-subject-map "t" 'gnus-summary-temporarily-raise-by-subject)
4376   (define-key gnus-summary-inc-subject-map "p" 'gnus-summary-raise-by-subject)
4377
4378   (define-prefix-command 'gnus-summary-inc-author-map)
4379   (define-key gnus-summary-increase-map "a" 'gnus-summary-inc-author-map)
4380   (define-key gnus-summary-increase-map "A" 'gnus-summary-temporarily-raise-by-author)
4381   (define-key gnus-summary-inc-author-map "a" 'gnus-summary-temporarily-raise-by-author)
4382   (define-key gnus-summary-inc-author-map "A" 'gnus-summary-raise-by-author)
4383   (define-key gnus-summary-inc-author-map "t" 'gnus-summary-temporarily-raise-by-author)
4384   (define-key gnus-summary-inc-author-map "p" 'gnus-summary-raise-by-author)
4385
4386   (define-prefix-command 'gnus-summary-inc-id-map)
4387   (define-key gnus-summary-increase-map "i" 'gnus-summary-inc-id-map)
4388   (define-key gnus-summary-increase-map "I" 'gnus-summary-temporarily-raise-by-id)
4389   (define-key gnus-summary-inc-id-map "i" 'gnus-summary-temporarily-raise-by-id)
4390   (define-key gnus-summary-inc-id-map "I" 'gnus-summary-raise-by-id)
4391   (define-key gnus-summary-inc-id-map "t" 'gnus-summary-temporarily-raise-by-id)
4392   (define-key gnus-summary-inc-id-map "p" 'gnus-summary-raise-by-id)
4393
4394   (define-prefix-command 'gnus-summary-inc-thread-map)
4395   (define-key gnus-summary-increase-map "t" 'gnus-summary-inc-thread-map)
4396   (define-key gnus-summary-increase-map "T" 'gnus-summary-temporarily-raise-by-thread)
4397   (define-key gnus-summary-inc-thread-map "t" 'gnus-summary-temporarily-raise-by-thread)
4398   (define-key gnus-summary-inc-thread-map "T" 'gnus-summary-raise-by-thread)
4399   (define-key gnus-summary-inc-thread-map "t" 'gnus-summary-temporarily-raise-by-thread)
4400   (define-key gnus-summary-inc-thread-map "p" 'gnus-summary-raise-by-thread)
4401
4402   (define-prefix-command 'gnus-summary-inc-xref-map)
4403   (define-key gnus-summary-increase-map "x" 'gnus-summary-inc-xref-map)
4404   (define-key gnus-summary-increase-map "X" 'gnus-summary-temporarily-raise-by-xref)
4405   (define-key gnus-summary-inc-xref-map "x" 'gnus-summary-temporarily-raise-by-xref)
4406   (define-key gnus-summary-inc-xref-map "X" 'gnus-summary-raise-by-xref)
4407   (define-key gnus-summary-inc-xref-map "t" 'gnus-summary-temporarily-raise-by-xref)
4408   (define-key gnus-summary-inc-xref-map "p" 'gnus-summary-raise-by-xref)
4409
4410   (define-prefix-command 'gnus-summary-inc-fol-map)
4411   (define-key gnus-summary-increase-map "f" 'gnus-summary-inc-fol-map)
4412   (define-key gnus-summary-increase-map "F" 'gnus-summary-raise-followups-to-author)
4413   (define-key gnus-summary-inc-fol-map "f" 'gnus-summary-raise-followups-to-author)
4414   (define-key gnus-summary-inc-fol-map "F" 'gnus-summary-raise-followups-to-author)
4415   (define-key gnus-summary-inc-fol-map "t" 'gnus-summary-raise-followups-to-author)
4416   (define-key gnus-summary-inc-fol-map "p" 'gnus-summary-raise-followups-to-author)
4417
4418   (define-prefix-command 'gnus-summary-lower-map)
4419   (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-map)
4420   (define-key gnus-summary-lower-map "l" 'gnus-summary-lower-same-subject-and-select)
4421   (define-key gnus-summary-lower-map "L" 'gnus-summary-lower-same-subject)
4422   (define-key gnus-summary-lower-map "\C-l" 'gnus-summary-lower-score)
4423
4424   (define-prefix-command 'gnus-summary-low-subject-map)
4425   (define-key gnus-summary-lower-map "s" 'gnus-summary-low-subject-map)
4426   (define-key gnus-summary-lower-map "S" 'gnus-summary-temporarily-lower-by-subject)
4427   (define-key gnus-summary-low-subject-map "s" 'gnus-summary-temporarily-lower-by-subject)
4428   (define-key gnus-summary-low-subject-map "S" 'gnus-summary-lower-by-subject)
4429   (define-key gnus-summary-low-subject-map "t" 'gnus-summary-temporarily-lower-by-subject)
4430   (define-key gnus-summary-low-subject-map "p" 'gnus-summary-lower-by-subject)
4431
4432   (define-prefix-command 'gnus-summary-low-author-map)
4433   (define-key gnus-summary-lower-map "a" 'gnus-summary-low-author-map)
4434   (define-key gnus-summary-lower-map "A" 'gnus-summary-temporarily-lower-by-author)
4435   (define-key gnus-summary-low-author-map "a" 'gnus-summary-temporarily-lower-by-author)
4436   (define-key gnus-summary-low-author-map "A" 'gnus-summary-lower-by-author)
4437   (define-key gnus-summary-low-author-map "t" 'gnus-summary-temporarily-lower-by-author)
4438   (define-key gnus-summary-low-author-map "p" 'gnus-summary-lower-by-author)
4439
4440   (define-prefix-command 'gnus-summary-low-id-map)
4441   (define-key gnus-summary-lower-map "i" 'gnus-summary-low-id-map)
4442   (define-key gnus-summary-lower-map "I" 'gnus-summary-temporarily-lower-by-id)
4443   (define-key gnus-summary-low-id-map "i" 'gnus-summary-temporarily-lower-by-id)
4444   (define-key gnus-summary-low-id-map "I" 'gnus-summary-lower-by-id)
4445   (define-key gnus-summary-low-id-map "t" 'gnus-summary-temporarily-lower-by-id)
4446   (define-key gnus-summary-low-id-map "p" 'gnus-summary-lower-by-id)
4447
4448   (define-prefix-command 'gnus-summary-low-thread-map)
4449   (define-key gnus-summary-lower-map "t" 'gnus-summary-low-thread-map)
4450   (define-key gnus-summary-lower-map "T" 'gnus-summary-temporarily-lower-by-thread)
4451   (define-key gnus-summary-low-thread-map "t" 'gnus-summary-temporarily-lower-by-thread)
4452   (define-key gnus-summary-low-thread-map "T" 'gnus-summary-lower-by-thread)
4453   (define-key gnus-summary-low-thread-map "t" 'gnus-summary-temporarily-lower-by-thread)
4454   (define-key gnus-summary-low-thread-map "p" 'gnus-summary-lower-by-thread)
4455
4456   (define-prefix-command 'gnus-summary-low-xref-map)
4457   (define-key gnus-summary-lower-map "x" 'gnus-summary-low-xref-map)
4458   (define-key gnus-summary-lower-map "X" 'gnus-summary-temporarily-lower-by-xref)
4459   (define-key gnus-summary-low-xref-map "x" 'gnus-summary-temporarily-lower-by-xref)
4460   (define-key gnus-summary-low-xref-map "X" 'gnus-summary-lower-by-xref)
4461   (define-key gnus-summary-low-xref-map "t" 'gnus-summary-temporarily-lower-by-xref)
4462   (define-key gnus-summary-low-xref-map "p" 'gnus-summary-lower-by-xref)
4463
4464   (define-prefix-command 'gnus-summary-low-fol-map)
4465   (define-key gnus-summary-lower-map "f" 'gnus-summary-low-fol-map)
4466   (define-key gnus-summary-lower-map "F" 'gnus-summary-lower-followups-to-author)
4467   (define-key gnus-summary-low-fol-map "f" 'gnus-summary-lower-followups-to-author)
4468   (define-key gnus-summary-low-fol-map "F" 'gnus-summary-lower-followups-to-author)
4469   (define-key gnus-summary-low-fol-map "t" 'gnus-summary-lower-followups-to-author)
4470   (define-key gnus-summary-low-fol-map "p" 'gnus-summary-lower-followups-to-author)
4471   )
4472
4473
4474 \f
4475
4476 (defun gnus-summary-mode ()
4477   "Major mode for reading articles.
4478 All normal editing commands are switched off.
4479 The following commands are available:
4480
4481 \\{gnus-summary-mode-map}"
4482   (interactive)
4483   (if gnus-visual (gnus-summary-make-menu-bar))
4484   (kill-all-local-variables)
4485   (let ((locals gnus-summary-local-variables))
4486     (while locals
4487       (if (consp (car locals))
4488           (progn
4489             (make-local-variable (car (car locals)))
4490             (set (car (car locals)) (eval (cdr (car locals)))))
4491         (make-local-variable (car locals))
4492         (set (car locals) nil))
4493       (setq locals (cdr locals))))
4494   (gnus-update-format-specifications)
4495   (setq mode-line-modified "-- ")
4496   (make-local-variable 'mode-line-format)
4497   (setq mode-line-format (copy-sequence mode-line-format))
4498   (and (equal (nth 3 mode-line-format) "   ")
4499        (setcar (nthcdr 3 mode-line-format) ""))
4500   (setq major-mode 'gnus-summary-mode)
4501   (setq mode-name "Summary")
4502   (make-local-variable 'minor-mode-alist)
4503   (gnus-set-mode-line 'summary)
4504   (use-local-map gnus-summary-mode-map)
4505   (buffer-disable-undo (current-buffer))
4506   (setq buffer-read-only t)             ;Disable modification
4507   (setq truncate-lines t)
4508   (setq selective-display t)
4509   (setq selective-display-ellipses t)   ;Display `...'
4510   (run-hooks 'gnus-summary-mode-hook))
4511
4512 (defun gnus-summary-clear-local-variables ()
4513   (let ((locals gnus-summary-local-variables))
4514     (while locals
4515       (if (consp (car locals))
4516           (set (car (car locals)) nil)
4517         (set (car locals) nil))
4518       (setq locals (cdr locals)))))
4519
4520 (defun gnus-mouse-pick-article (e)
4521   (interactive "e")
4522   (mouse-set-point e)
4523   (gnus-summary-next-page nil t))
4524
4525 (defun gnus-summary-setup-buffer (group)
4526   "Initialize summary buffer."
4527   (let ((buffer (concat "*Summary " group "*")))
4528     ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
4529     (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
4530     (gnus-add-current-to-buffer-list)
4531     (gnus-summary-mode)))
4532
4533 (defun gnus-set-global-variables ()
4534   ;; Set the global equivalents of the summary buffer-local variables
4535   ;; to the latest values they had. These reflect the summary buffer
4536   ;; that was in action when the last article was fetched.
4537   (if (eq major-mode 'gnus-summary-mode) 
4538       (progn
4539         (setq gnus-summary-buffer (current-buffer))
4540         (let ((name gnus-newsgroup-name)
4541               (marked gnus-newsgroup-marked)
4542               (unread gnus-newsgroup-unreads)
4543               (headers gnus-current-headers))
4544           (save-excursion
4545             (set-buffer gnus-group-buffer)
4546             (setq gnus-newsgroup-name name)
4547             (setq gnus-newsgroup-marked marked)
4548             (setq gnus-newsgroup-unreads unread)
4549             (setq gnus-current-headers headers))))))
4550
4551 (defun gnus-summary-insert-dummy-line (sformat subject number)
4552   (if (not sformat) 
4553       (setq sformat gnus-summary-dummy-line-format-spec))
4554   (let (b)
4555     (beginning-of-line)
4556     (setq b (point))
4557     (insert (eval sformat))
4558     (add-text-properties
4559      b (1+ b)
4560      (list 'gnus-subject (gnus-simplify-subject-re subject)
4561            'gnus-number number
4562            'gnus-mark ?Z
4563            'gnus-thread 0))))
4564
4565 (defun gnus-summary-insert-line 
4566   (sformat header level current unread replied expirable subject-or-nil
4567            &optional dummy score)
4568   (or sformat (setq sformat gnus-summary-line-format-spec))
4569   (let* ((indentation 
4570           (make-string (* level gnus-thread-indent-level) ? ))
4571          (lines (or (header-lines header) 0))
4572          (score (or score gnus-summary-default-score 0))
4573          (score-char (if (or (null gnus-summary-default-score)
4574                              (= score gnus-summary-default-score)) ? 
4575                        (if (< score gnus-summary-default-score) 
4576                            gnus-score-below-mark gnus-score-over-mark)))
4577          (replied (if replied gnus-replied-mark ? ))
4578          (from (header-from header))
4579          (name-address (funcall gnus-extract-address-components from))
4580          (address (car (cdr name-address)))
4581          (name (or (car name-address) (car (cdr name-address))))
4582          (number (header-number header))
4583          (subject (header-subject header))
4584          (buffer-read-only nil)
4585          (opening-bracket (if dummy ?\< ?\[))
4586          (closing-bracket (if dummy ?\> ?\]))
4587          b)
4588     ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
4589     (if (not (numberp lines)) (setq lines 0))
4590     (beginning-of-line)
4591     (setq b (point))
4592     (insert (eval sformat))
4593     (add-text-properties
4594      b (1+ b)
4595      (list 'gnus-subject (gnus-simplify-subject-re subject)
4596            'gnus-number number
4597            'gnus-mark (or unread gnus-unread-mark ? )
4598            'gnus-thread level))))
4599
4600 (defun gnus-summary-update-line (&optional dont-update)
4601   ;; Update summary line after change.
4602   (or (not gnus-summary-default-score)
4603       gnus-summary-inhibit-highlight
4604       (let ((gnus-summary-inhibit-highlight t))
4605         (progn
4606           (or dont-update
4607               (if (and gnus-summary-mark-below
4608                        (< (gnus-summary-article-score) gnus-summary-mark-below))
4609                   (and (not (memq (gnus-summary-article-mark)
4610                                   gnus-newsgroup-unreads))
4611                        (gnus-summary-mark-article nil gnus-low-score-mark))
4612                 (and (eq (gnus-summary-article-mark) gnus-low-score-mark)
4613                      (gnus-summary-mark-article nil gnus-unread-mark))))
4614           (and gnus-visual
4615                (run-hooks 'gnus-visual-summary-update-hook))))))
4616
4617 (defun gnus-summary-update-lines ()
4618   ;; Rehighlight summary buffer according to `gnus-summary-highlight'.
4619   (and (save-excursion
4620          (set-buffer gnus-summary-buffer)
4621          (goto-char (point-min))
4622          (while (not (eobp))
4623            (gnus-summary-update-line)
4624            (forward-line 1)))))
4625
4626 (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer)
4627   "Start reading news in newsgroup GROUP.
4628 If SHOW-ALL is non-nil, already read articles are also listed.
4629 If NO-ARTICLE is non-nil, no article is selected initially."
4630   (message "Retrieving newsgroup: %s..." group)
4631   (gnus-summary-setup-buffer group)
4632   (if (gnus-select-newsgroup group show-all)
4633       (progn
4634         ;; You can change the subjects in this hook.
4635         (run-hooks 'gnus-select-group-hook)
4636         ;; Do Score Processing.
4637         (gnus-score-headers)
4638         ;; Update the format specifiers.
4639         (gnus-update-format-specifications)
4640         (gnus-summary-prepare)
4641         (if (and (zerop (buffer-size))
4642                  gnus-newsgroup-dormant)
4643             (gnus-summary-show-all-dormant))
4644         (gnus-set-global-variables)
4645         ;; Function `gnus-apply-kill-file' must be called in this hook.
4646         (run-hooks 'gnus-apply-kill-hook)
4647         (if (zerop (buffer-size))
4648             (progn
4649               ;; This newsgroup is empty.
4650               (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
4651               (message "No unread news"))
4652           (save-excursion
4653             (if kill-buffer
4654                 (let ((gnus-summary-buffer kill-buffer))
4655                   (gnus-configure-windows 'newsgroups t))))
4656           ;; Hide conversation thread subtrees.  We cannot do this in
4657           ;; gnus-summary-prepare-hook since kill processing may not
4658           ;; work with hidden articles.
4659           (and gnus-show-threads
4660                gnus-thread-hide-subtree
4661                (gnus-summary-hide-all-threads))
4662           ;; Show first unread article if requested.
4663           (goto-char (point-min))
4664           (if (and (not no-article)
4665                    gnus-auto-select-first
4666                    (gnus-summary-first-unread-article))
4667               (gnus-configure-windows 'article)
4668             (gnus-configure-windows 'summary))
4669           (pop-to-buffer gnus-summary-buffer)
4670           (gnus-set-mode-line 'summary)
4671           (gnus-summary-position-cursor)
4672           (if (and kill-buffer
4673                    (get-buffer kill-buffer)
4674                    (buffer-name (get-buffer kill-buffer)))
4675               (kill-buffer kill-buffer))))
4676     ;; Cannot select newsgroup GROUP.
4677     (message "Couldn't select newsgroup")
4678     (and (eq major-mode 'gnus-summary-mode)
4679          (kill-buffer (current-buffer)))
4680     (switch-to-buffer gnus-group-buffer)))
4681
4682 (defun gnus-summary-prepare ()
4683   "Prepare summary list of current newsgroup in summary buffer."
4684   (let ((buffer-read-only nil))
4685     (erase-buffer)
4686     (gnus-summary-prepare-threads 
4687      (if gnus-show-threads
4688          (gnus-gather-threads 
4689           (gnus-sort-threads 
4690            (if gnus-summary-expunge-below
4691                (gnus-make-threads-and-expunge)
4692              (gnus-make-threads))))
4693        gnus-newsgroup-headers)
4694      0 nil nil t)
4695     ;; Erase header retrieval message.
4696     (gnus-summary-update-lines)
4697     (message "")
4698     ;; Call hooks for modifying summary buffer.
4699     ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
4700     (goto-char (point-min))
4701     (run-hooks 'gnus-summary-prepare-hook)))
4702
4703 (defun gnus-gather-threads (threads)
4704   "Gather threads that have lost their roots."
4705   (if (not gnus-summary-make-false-root)
4706       threads 
4707     (let ((hashtb (gnus-make-hashtable 1023))
4708           (prev threads)
4709           (result threads)
4710           thread subject hthread unre-subject whole-subject)
4711       (while threads
4712         (setq subject (header-subject (car (car threads)))
4713               whole-subject subject)
4714         (and gnus-summary-gather-subject-limit
4715              (> (length subject) gnus-summary-gather-subject-limit)
4716              (setq subject
4717                    (substring subject 0 gnus-summary-gather-subject-limit)))
4718         (if (setq hthread 
4719                   (gnus-gethash 
4720                    (setq unre-subject (gnus-simplify-subject-re subject))
4721                    hashtb))
4722             (progn
4723               (or (stringp (car (car hthread)))
4724                   (setcar hthread (list whole-subject (car hthread))))
4725               (setcdr (car hthread) (nconc (cdr (car hthread)) 
4726                                            (list (car threads))))
4727               (setcdr prev (cdr threads))
4728               (setq threads prev))
4729           (gnus-sethash unre-subject threads hashtb))
4730         (setq prev threads)
4731         (setq threads (cdr threads)))
4732       result)))
4733
4734 (defun gnus-make-threads ()
4735   ;; This function takes the dependencies already made by 
4736   ;; `gnus-get-newsgroup-headers' and builds the trees. First we go
4737   ;; through the dependecies in the hash table and finds all the
4738   ;; roots. Roots do not refer back to any valid articles.
4739   (let (roots)
4740     (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
4741          (gnus-build-old-threads))
4742     (mapatoms
4743      (lambda (refs)
4744        (if (not (car (symbol-value refs)))
4745            (setq roots (append (cdr (symbol-value refs)) roots))
4746          ;; Ok, these refer back to valid articles, but if
4747          ;; `gnus-thread-ignore-subject' is nil, we have to check that
4748          ;; the root has the same subject as its children. The children
4749          ;; that do not are made into roots and removed from the list
4750          ;; of children. 
4751          (or gnus-thread-ignore-subject
4752              (let* ((prev (symbol-value refs))
4753                     (subject (gnus-simplify-subject-re 
4754                               (header-subject (car prev))))
4755                     (headers (cdr prev)))
4756                (while headers
4757                  (if (not (string= subject
4758                                    (gnus-simplify-subject-re 
4759                                     (header-subject (car headers)))))
4760                      (progn
4761                        (setq roots (cons (car headers) roots))
4762                        (setcdr prev (cdr headers)))
4763                    (setq prev headers))
4764                  (setq headers (cdr headers)))))))
4765      gnus-newsgroup-dependencies)
4766     
4767     (mapcar 'gnus-trim-thread
4768             (apply 'append
4769                    (mapcar 'gnus-cut-thread
4770                            (mapcar 'gnus-make-sub-thread roots))))))
4771   
4772 (defun gnus-make-threads-and-expunge ()
4773   ;; This function takes the dependencies already made by 
4774   ;; `gnus-get-newsgroup-headers' and builds the trees. First we go
4775   ;; through the dependecies in the hash table and finds all the
4776   ;; roots. Roots do not refer back to any valid articles.
4777   (let (roots)
4778     (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
4779          (gnus-build-old-threads))
4780     (mapatoms
4781      (lambda (refs)
4782        (if (not (car (symbol-value refs)))
4783            (if (and gnus-summary-expunge-below
4784                     (not gnus-fetch-old-headers))
4785                (let ((headers (cdr (symbol-value refs))))
4786                  (while headers
4787                   (if (not (< (or (cdr (assq (header-number (car headers))
4788                                              gnus-newsgroup-scored))
4789                                   gnus-summary-default-score 0)
4790                               gnus-summary-expunge-below))
4791                       (setq roots (cons (car headers) roots))
4792                     (setq gnus-newsgroup-unreads
4793                           (delq (header-number (car headers))
4794                                 gnus-newsgroup-unreads)))
4795                   (setq headers (cdr headers))))
4796              (setq roots (append (cdr (symbol-value refs)) roots)))
4797          ;; Ok, these refer back to valid articles, but if
4798          ;; `gnus-thread-ignore-subject' is nil, we have to check that
4799          ;; the root has the same subject as its children. The children
4800          ;; that do not are made into roots and removed from the list
4801          ;; of children. 
4802          (or gnus-thread-ignore-subject
4803              (let* ((prev (symbol-value refs))
4804                     (subject (gnus-simplify-subject-re 
4805                               (header-subject (car prev))))
4806                     (headers (cdr prev)))
4807                (while headers
4808                  (if (not (string= subject
4809                                    (gnus-simplify-subject-re 
4810                                     (header-subject (car headers)))))
4811                      (progn
4812                        (setq roots (cons (car headers) roots))
4813                        (setcdr prev (cdr headers)))
4814                    (setq prev headers))
4815                  (setq headers (cdr headers)))))
4816          (and gnus-summary-expunge-below
4817               (not gnus-fetch-old-headers)
4818               (let* ((prev (symbol-value refs))
4819                      (headers (cdr prev))
4820                      id)
4821                 (while headers
4822                   (if (not (< (or (cdr (assq (header-number (car headers))
4823                                              gnus-newsgroup-scored))
4824                                   gnus-summary-default-score 0)
4825                               gnus-summary-expunge-below))
4826                       (setq prev (cdr prev))
4827                     (setq gnus-newsgroup-unreads 
4828                           (delq (header-number (car headers))
4829                                 gnus-newsgroup-unreads))
4830                     (setcdr prev (cdr headers))
4831                     (setq id (gnus-gethash (header-id (car headers))
4832                                            gnus-newsgroup-dependencies))
4833                     (let ((h (cdr id)))
4834                       (while h
4835                         (if (not (< (or (cdr (assq (header-number (car h))
4836                                                    gnus-newsgroup-scored))
4837                                         gnus-summary-default-score 0)
4838                                     gnus-summary-expunge-below))
4839                             (setq roots (cons (car h) roots)))
4840                         (setq h (cdr h)))))
4841                   (setq headers (cdr headers)))))))
4842      gnus-newsgroup-dependencies)
4843     
4844     (mapcar 'gnus-trim-thread
4845             (apply 'append
4846                    (mapcar 'gnus-cut-thread
4847                            (mapcar 'gnus-make-sub-thread roots))))))
4848   
4849 (defun gnus-cut-thread (thread)
4850   ;; Remove leaf dormant or ancient articles from THREAD.
4851   (let ((head (car thread))
4852         (tail (apply 'append (mapcar 'gnus-cut-thread (cdr thread)))))
4853     (if (and (null tail)
4854              (let ((number (header-number head)))
4855                (or (memq number gnus-newsgroup-ancient)
4856                    (memq number gnus-newsgroup-dormant)
4857                    (and gnus-summary-expunge-below
4858                         (eq gnus-fetch-old-headers 'some)
4859                         (< (or (cdr (assq number gnus-newsgroup-scored))
4860                                gnus-summary-default-score 0)
4861                            gnus-summary-expunge-below)
4862                         (progn
4863                           (setq gnus-newsgroup-unreads
4864                                 (delq number gnus-newsgroup-unreads))
4865                           t)))))
4866         nil
4867       (list (cons head tail)))))
4868
4869 (defun gnus-trim-thread (thread)
4870   ;; Remove root ancient articles with only one child from THREAD.
4871   (if (and (eq gnus-fetch-old-headers 'some)
4872            (memq (header-number (car thread)) gnus-newsgroup-ancient)
4873            (= (length thread) 2))
4874       (gnus-trim-thread (nth 1 thread))
4875     thread))
4876
4877 (defun gnus-make-sub-thread (root)
4878   ;; This function makes a sub-tree for a node in the tree.
4879   (let ((children (reverse (cdr (gnus-gethash (downcase (header-id root))
4880                                               gnus-newsgroup-dependencies)))))
4881     (cons root (mapcar 'gnus-make-sub-thread children))))
4882
4883 (defun gnus-build-old-threads ()
4884   ;; Look at all the articles that refer back to old articles, and
4885   ;; fetch the headers for the articles that aren't there. This will
4886   ;; build complete threads - if the roots haven't been expired by the
4887   ;; server, that is.
4888   (let (id heads)
4889     (mapatoms
4890      (lambda (refs)
4891        (if (not (car (symbol-value refs)))
4892            (progn
4893              (setq heads (cdr (symbol-value refs)))
4894              (while heads
4895                (if (not (memq (header-number (car heads))
4896                               gnus-newsgroup-dormant))
4897                    (progn
4898                      (setq id (symbol-name refs))
4899                      (while (and (setq id (gnus-build-get-header id))
4900                                  (not (car (gnus-gethash 
4901                                             id gnus-newsgroup-dependencies)))))
4902                      (setq heads nil))
4903                  (setq heads (cdr heads)))))))
4904      gnus-newsgroup-dependencies)))
4905
4906 (defun gnus-build-get-header (id)
4907   ;; Look through the buffer of NOV lines and find the header to
4908   ;; ID. Enter this line into the dependencies hash table, and return
4909   ;; the id of the parent article (if any).
4910   (let ((deps gnus-newsgroup-dependencies)
4911         found header)
4912     (prog1
4913         (save-excursion
4914           (set-buffer nntp-server-buffer)
4915           (goto-char (point-min))
4916           (while (and (not found) (search-forward id nil t))
4917             (beginning-of-line)
4918             (setq found (looking-at (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
4919                                             (regexp-quote id))))
4920             (or found (beginning-of-line 2)))
4921           (if found
4922               (let (ref)
4923                 (beginning-of-line)
4924                 (and
4925                  (setq header (gnus-nov-parse-line 
4926                                (read (current-buffer)) deps))
4927                  (setq ref (header-references header))
4928                  (string-match "\\(<[^>]+>\\) *$" ref)
4929                  (substring ref (match-beginning 1) (match-end 1))))))
4930       (and header
4931            (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers)
4932                  gnus-newsgroup-ancient (cons (header-number header)
4933                                               gnus-newsgroup-ancient))))))
4934
4935 (defun gnus-sort-threads (threads)
4936   ;; Sort threads as specified in `gnus-thread-sort-functions'.
4937   (let ((fun gnus-thread-sort-functions))
4938     (while fun
4939       (setq threads (sort threads (car fun))
4940             fun (cdr fun))))
4941   threads)
4942
4943 (defun gnus-thread-header (thread)
4944   ;; Return header of first article in THREAD.
4945   (if (consp thread)
4946       (if (stringp (car thread))
4947           (car (car (cdr thread)))
4948         (car thread))
4949     thread))
4950
4951 (defun gnus-thread-sort-by-number (h1 h2)
4952   "Sort threads by root article number."
4953   (let ((h1 (gnus-thread-header h1))
4954         (h2 (gnus-thread-header h2)))
4955     (< (header-number h1) (header-number h2))))
4956
4957 (defun gnus-thread-sort-by-author (h1 h2)
4958   "Sort threads by root author."
4959   (let ((h1 (gnus-thread-header h1))
4960         (h2 (gnus-thread-header h2)))
4961     (string-lessp
4962      (let ((extract (funcall 
4963                      gnus-extract-address-components (header-from h1))))
4964        (or (car extract) (cdr extract)))
4965      (let ((extract (funcall
4966                      gnus-extract-address-components (header-from h2))))
4967        (or (car extract) (cdr extract))))))
4968
4969 (defun gnus-thread-sort-by-subject (h1 h2)
4970   "Sort threads by root subject."
4971   (let ((h1 (gnus-thread-header h1))
4972         (h2 (gnus-thread-header h2)))
4973     (string-lessp
4974      (downcase (gnus-simplify-subject (header-subject h1)))
4975      (downcase (gnus-simplify-subject (header-subject h2))))))
4976
4977 (defun gnus-thread-sort-by-date (h1 h2)
4978   "Sort threads by root article date."
4979   (let ((h1 (gnus-thread-header h1))
4980         (h2 (gnus-thread-header h2)))
4981     (string-lessp
4982      (gnus-sortable-date (header-date h1))
4983      (gnus-sortable-date (header-date h2)))))
4984
4985 (defun gnus-thread-sort-by-score (h1 h2)
4986   "Sort threads by root article score.
4987 Unscored articles will be counted as havin a score of zero."
4988   (let ((h1 (gnus-thread-header h1))
4989         (h2 (gnus-thread-header h2)))
4990     (let ((s1 (assq (header-number h1) gnus-newsgroup-scored))
4991           (s2 (assq (header-number h2) gnus-newsgroup-scored)))
4992       (> (or (cdr s1) gnus-summary-default-score 0)
4993          (or (cdr s2) gnus-summary-default-score 0)))))
4994
4995 (defun gnus-thread-sort-by-total-score (h1 h2)
4996   "Sort threads by the sum of all scores in the thread.
4997 Unscored articles will be counted as havin a score of zero."
4998   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
4999
5000 (defun gnus-thread-total-score (thread)
5001   ;;  This function find the total score of  THREAD.
5002   (if (consp thread)
5003       (if (stringp (car thread))
5004           (apply gnus-thread-score-function 0
5005                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
5006         (gnus-thread-total-score-1 thread))
5007     (gnus-thread-total-score-1 (list thread))))
5008
5009 (defun gnus-thread-total-score-1 (root)
5010   ;; This function find the total score of the thread below ROOT.
5011   (setq root (car root))
5012   (apply gnus-thread-score-function
5013          (or (cdr (assq (header-number root) gnus-newsgroup-scored))
5014              gnus-summary-default-score 0)
5015          (mapcar 'gnus-thread-total-score
5016                  (cdr (gnus-gethash (downcase (header-id root))
5017                                     gnus-newsgroup-dependencies)))))
5018
5019 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
5020 (defvar gnus-tmp-prev-subject "")
5021
5022 ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>.
5023 (defun gnus-summary-prepare-threads 
5024   (threads level &optional not-child no-subject cull)
5025   "Prepare summary buffer from THREADS and indentation LEVEL.  
5026 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'  
5027 or a straight list of headers."
5028   (let (thread header number subject clevel)
5029     (while threads
5030       (setq thread (car threads)
5031             threads (cdr threads))
5032       ;; If `thread' is a cons, hierarchical threads are used.  If not,
5033       ;; `thread' is the header.
5034       (if (consp thread)
5035           (setq header (car thread))
5036         (setq header thread)
5037         (and cull
5038              (or (memq (setq number (header-number header))
5039                        gnus-newsgroup-dormant)
5040                  (and gnus-summary-expunge-below
5041                       (< (or (cdr (assq number gnus-newsgroup-scored))
5042                              gnus-summary-default-score 0)
5043                          gnus-summary-expunge-below)))
5044              (progn
5045                (setq header nil)
5046                (setq gnus-newsgroup-unreads 
5047                      (delq number gnus-newsgroup-unreads)))))
5048       (cond 
5049        ((stringp header)
5050         ;; The header is a dummy root.
5051         (cond ((eq gnus-summary-make-false-root 'adopt)
5052                ;; We let the first article adopt the rest.
5053                (gnus-summary-prepare-threads (list (car (cdr thread))) 0)
5054                (setq thread (cdr (cdr thread)))
5055                (while thread
5056                  (gnus-summary-prepare-threads (list (car thread)) 1 t)
5057                  (setq thread (cdr thread))))
5058               ((eq gnus-summary-make-false-root 'dummy)
5059                ;; We output a dummy root.
5060                (gnus-summary-insert-dummy-line 
5061                 nil header (header-number (car (car (cdr thread)))))
5062                (setq clevel 1))
5063               ((eq gnus-summary-make-false-root 'empty)
5064                ;; We print the articles with empty subject fields. 
5065                (gnus-summary-prepare-threads (list (car (cdr thread))) 0)
5066                (setq thread (cdr (cdr thread)))
5067                (while thread
5068                  (gnus-summary-prepare-threads (list (car thread)) 0 nil t)
5069                  (setq thread (cdr thread))))
5070               (t
5071                ;; We do not make a root for the gathered
5072                ;; sub-threads at all.  
5073                (setq clevel 0)))
5074         ;; Print the sub-threads.
5075         (and (consp thread) (cdr thread)
5076              (gnus-summary-prepare-threads (cdr thread) clevel)))
5077        ;; The header is a real article.
5078        (header
5079         (setq number (header-number header)
5080               subject (header-subject header))
5081         (gnus-summary-insert-line
5082          nil header level nil 
5083          (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
5084                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
5085                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
5086                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
5087                (t gnus-ancient-mark))
5088          (memq number gnus-newsgroup-replied)
5089          (memq number gnus-newsgroup-expirable)
5090          (if no-subject gnus-summary-same-subject
5091            (if (or (zerop level)
5092                    (and gnus-thread-ignore-subject
5093                         (not (string= 
5094                               (gnus-simplify-subject-re gnus-tmp-prev-subject)
5095                               (gnus-simplify-subject-re subject)))))
5096                subject
5097              gnus-summary-same-subject))
5098          not-child
5099          (cdr (assq number gnus-newsgroup-scored)))
5100         (setq gnus-tmp-prev-subject subject)
5101         ;; Recursively print subthreads.
5102         (and (consp thread) (cdr thread)
5103              (gnus-summary-prepare-threads (cdr thread) (1+ level))))))))
5104
5105 (defun gnus-select-newsgroup (group &optional read-all)
5106   "Select newsgroup GROUP.
5107 If READ-ALL is non-nil, all articles in the group are selected."
5108   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
5109          (info (nth 2 entry))
5110          articles header-marks)
5111     (and (eq (car entry) t)
5112          (or (gnus-activate-newsgroup (car info))
5113              (progn
5114                (kill-buffer (current-buffer))
5115                (error "Couldn't request group %s: %s" 
5116                       group (gnus-status-message group)))))
5117     (setq gnus-current-select-method (or (nth 4 info) gnus-select-method))
5118     (gnus-check-news-server (nth 4 info))
5119     (or (gnus-request-group group t)
5120         (progn
5121           (kill-buffer (current-buffer))
5122           (error "Couldn't request group %s: %s" 
5123                  group (gnus-status-message group))))
5124
5125     (setq gnus-newsgroup-name group)
5126     (setq gnus-newsgroup-unselected nil)
5127     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
5128
5129     (and info
5130          (let (marked)
5131            (gnus-adjust-marked-articles info)
5132            (setq gnus-newsgroup-marked 
5133                  (cdr (assq 'tick (setq marked (nth 3 info)))))
5134            (setq gnus-newsgroup-replied (cdr (assq 'reply marked)))
5135            (setq gnus-newsgroup-expirable (cdr (assq 'expire marked)))
5136            (setq gnus-newsgroup-killed (cdr (assq 'killed marked)))
5137            (setq gnus-newsgroup-bookmarks (cdr (assq 'bookmark marked)))
5138            (setq gnus-newsgroup-dormant (cdr (assq 'dormant marked)))
5139            (setq gnus-newsgroup-scored (cdr (assq 'score marked)))
5140            (setq gnus-newsgroup-processable nil)))
5141
5142     (if (not (setq articles (gnus-articles-to-read group read-all)))
5143         nil
5144       ;; Init the dependencies hash table.
5145       (setq gnus-newsgroup-dependencies 
5146             (gnus-make-hashtable (length gnus-newsgroup-unreads)))
5147       ;; Retrieve the headers and read them in.
5148       (setq gnus-newsgroup-headers 
5149             (if (eq 'nov (setq gnus-headers-retrieved-by
5150                                (gnus-retrieve-headers 
5151                                 (if gnus-fetch-old-headers 
5152                                     (cons 1 articles) articles) 
5153                                 gnus-newsgroup-name)))
5154                 (progn
5155                   (gnus-get-newsgroup-headers-xover articles))
5156               (gnus-get-newsgroup-headers)))
5157       ;; If we were to fetch old headers, but the backend didn't
5158       ;; support XOVER, then it is possible we fetched one article
5159       ;; that we shouldn't have. If that's the case, we pop it off the
5160       ;; list of headers.
5161       (and (not (eq gnus-headers-retrieved-by 'nov))
5162            gnus-fetch-old-headers
5163            gnus-newsgroup-headers
5164            (/= (header-number (car gnus-newsgroup-headers)) (car articles))
5165            (setq gnus-newsgroup-headers (cdr gnus-newsgroup-headers)))
5166       ;; Remove cancelled articles from the list of unread articles.
5167       (setq gnus-newsgroup-unreads
5168             (gnus-set-sorted-intersection 
5169              gnus-newsgroup-unreads
5170              (mapcar (lambda (headers) (header-number headers))
5171                      gnus-newsgroup-headers)))
5172       ;; Check whether auto-expire is to be done in this group.
5173       (setq gnus-newsgroup-auto-expire
5174             (and (stringp gnus-auto-expirable-newsgroups)
5175                  (string-match gnus-auto-expirable-newsgroups 
5176                                (gnus-group-real-name group))))
5177       ;; First and last article in this newsgroup.
5178       (and gnus-newsgroup-headers
5179            (setq gnus-newsgroup-begin 
5180                  (header-number (car gnus-newsgroup-headers)))
5181            (setq gnus-newsgroup-end
5182                  (header-number (gnus-last-element gnus-newsgroup-headers))))
5183       (setq gnus-reffed-article-number -1)
5184       ;; GROUP is successfully selected.
5185       (or gnus-newsgroup-headers t))))
5186
5187 (defun gnus-articles-to-read (group read-all)
5188   ;; Find out what articles the user wants to read.
5189   (let* ((articles
5190           ;; Select all articles if `read-all' is non-nil, or if all the
5191           ;; unread articles are dormant articles.
5192           (if (or read-all
5193                   (= (length gnus-newsgroup-unreads) 
5194                      (length gnus-newsgroup-dormant)))
5195               (gnus-uncompress-sequence 
5196                (gnus-gethash group gnus-active-hashtb))
5197             gnus-newsgroup-unreads))
5198          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
5199          (scored (length scored-list))
5200          (number (length articles))
5201          (marked (+ (length gnus-newsgroup-marked)
5202                     (length gnus-newsgroup-dormant)))
5203          (select
5204           (condition-case ()
5205               (cond ((and (or (<= scored marked)
5206                               (= scored number))
5207                           (numberp gnus-large-newsgroup)
5208                           (> number gnus-large-newsgroup))
5209                      (let ((input
5210                             (read-string
5211                              (format
5212                               "How many articles from %s (default %d): "
5213                               gnus-newsgroup-name number))))
5214                        (if (string-equal input "")
5215                            number input)))
5216                     ((and (> scored marked) (< scored number))
5217                      (let ((input
5218                             (read-string
5219                              (format 
5220                               "%s %s (%d scored, %d total): "
5221                               "How many articles from"
5222                               group scored number))))
5223                        (if (string-equal input "")
5224                            number input)))
5225                     (t number))
5226             (quit 0)))
5227          total-articles)
5228     (setq select (if (numberp select) select (string-to-number select)))
5229     (if (zerop select)
5230         ()
5231       (if (and (not (zerop scored)) (<= (abs select) scored))
5232           (progn
5233             (setq articles (sort scored-list '<))
5234             (setq number (length articles)))
5235         (setq articles (copy-sequence articles)))
5236
5237       (setq total-articles articles)
5238       
5239       (if (< (abs select) number)
5240           (if (< select 0) 
5241               ;; Select the N oldest articles.
5242               (setcdr (nthcdr (1- (abs select)) articles) nil)
5243             ;; Select the N most recent articles.
5244             (setq articles (nthcdr (- number select) articles))))
5245       (setq gnus-newsgroup-unselected
5246             (gnus-sorted-intersection
5247              gnus-newsgroup-unselected 
5248              (gnus-sorted-complement articles total-articles)))
5249       articles)))
5250
5251 (defun gnus-killed-articles (killed articles)
5252   (let (out)
5253     (while articles
5254       (if (inline (gnus-member-of-range (car articles) killed))
5255           (setq out (cons (car articles) out)))
5256       (setq articles (cdr articles)))
5257     out))
5258
5259 (defun gnus-adjust-marked-articles (info &optional active)
5260   "Remove all marked articles that are no longer legal."
5261   (let ((marked-lists (nth 3 info))
5262         (active (or active (gnus-gethash (car info) gnus-active-hashtb)))
5263         marked m prev)
5264     ;; There are four types of marked articles - ticked, replied,
5265     ;; expirable and dormant.  
5266     (while marked-lists
5267       (setq m (cdr (setq prev (car marked-lists))))
5268       (cond ((or (eq 'tick (car prev)) (eq 'dormant (car prev)))
5269              ;; Make sure that all ticked articles are a subset of the
5270              ;; unread/unselected articles.
5271              (while m
5272                (if (or (memq (car m) gnus-newsgroup-unreads)
5273                        (memq (car m) gnus-newsgroup-unselected))
5274                    (setq prev m)
5275                  (setcdr prev (cdr m)))
5276                (setq m (cdr m))))
5277             ((eq 'score (car prev))
5278              ;; Scored articles should be a subset of
5279              ;; unread/unselected articles. 
5280              (while m
5281                (if (or (memq (car (car m)) gnus-newsgroup-unreads)
5282                        (memq (car (car m)) gnus-newsgroup-unreads))
5283                    (setq prev m)
5284                  (setcdr prev (cdr m)))
5285                (setq m (cdr m))))
5286             ((eq 'bookmark (car prev))
5287              ;; Bookmarks should be a subset of active articles.
5288              (while m
5289                (if (< (car (car m)) (car active))
5290                    (setcdr prev (cdr m))
5291                  (setq prev m))
5292                (setq m (cdr m))))
5293             ((eq 'killed (car prev))
5294              ;; Articles that have been through the kill process are
5295              ;; to be a subset of active articles.
5296              (while (and m (< (cdr (car m)) (car active)))
5297                (setcdr prev (cdr m))
5298                (setq m (cdr m)))
5299              (if (and m (< (car (car m)) (car active))) 
5300                  (setcar (car m) (car active))))
5301             ((or (eq 'reply (car marked)) (eq 'expire (car marked)))
5302              ;; The replied and expirable articles have to be articles
5303              ;; that are active. 
5304              (while m
5305                (if (< (car m) (car active))
5306                    (setcdr prev (cdr m))
5307                  (setq prev m))
5308                (setq m (cdr m)))))
5309       (setq marked-lists (cdr marked-lists)))
5310     ;; Remove all lists that are empty.
5311     (setq marked-lists (nth 3 info))
5312     (if marked-lists
5313         (progn
5314           (while (= 1 (length (car marked-lists)))
5315             (setq marked-lists (cdr marked-lists)))
5316           (setq m (cdr (setq prev marked-lists)))
5317           (while m
5318             (if (= 1 (length (car m)))
5319                 (setcdr prev (cdr m))
5320               (setq prev m))
5321             (setq m (cdr m)))
5322           (setcar (nthcdr 3 info) marked-lists)))
5323     ;; Finally, if there are no marked lists at all left, and if there
5324     ;; are no elements after the lists in the info list, we just chop
5325     ;; the info list off before the marked lists.
5326     (if (and (null marked-lists) (not (nthcdr 4 info)))
5327         (setcdr (nthcdr 2 info) nil)))
5328   info)
5329
5330 (defun gnus-set-marked-articles 
5331   (info ticked replied expirable killed dormant bookmark score) 
5332   "Enter the various lists of marked articles into the newsgroup info list."
5333   (let (newmarked)
5334     (and ticked (setq newmarked (cons (cons 'tick ticked) nil)))
5335     (and replied (setq newmarked (cons (cons 'reply replied) newmarked)))
5336     (and expirable (setq newmarked (cons (cons 'expire expirable) 
5337                                          newmarked)))
5338     (and killed (setq newmarked (cons (cons 'killed killed) newmarked)))
5339     (and dormant (setq newmarked (cons (cons 'dormant dormant) newmarked)))
5340     (and bookmark (setq newmarked (cons (cons 'bookmark bookmark) 
5341                                         newmarked)))
5342     (and score (setq newmarked (cons (cons 'score score) newmarked)))
5343     (if (nthcdr 3 info)
5344         (if newmarked
5345             (setcar (nthcdr 3 info) newmarked)
5346           (if (not (nthcdr 4 info))
5347               (setcdr (nthcdr 2 info) nil)
5348             (setcar (nthcdr 3 info) nil)))
5349       (if newmarked
5350           (setcdr (nthcdr 2 info) (cons newmarked nil))))))
5351
5352 (defun gnus-add-marked-articles (group type articles &optional info force)
5353   ;; Add ARTICLES of TYPE to the info of GROUP.
5354   ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
5355   ;; add, but replace this marked articles of TYPE with ARTICLES.
5356   (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
5357         marked m)
5358     (or (not info)
5359         (and (not (setq marked (nthcdr 3 info)))
5360              (setcdr (nthcdr 2 info) (list (list (cons type articles)))))
5361         (and (not (setq m (assq type (car marked))))
5362              (setcar marked (cons (cons type articles) (car marked))))
5363         (if force
5364             (setcdr m articles)
5365           (nconc m articles)))))
5366          
5367 (defun gnus-set-mode-line (where)
5368   "This function sets the mode line of the article or summary buffers.
5369 If WHERE is `summary', the summary mode line format will be used."
5370   (if (memq where gnus-updated-mode-lines)
5371       (let (mode-string)
5372         (save-excursion
5373           (set-buffer gnus-summary-buffer)
5374           (let* ((mformat (if (eq where 'article) 
5375                               gnus-article-mode-line-format-spec
5376                             gnus-summary-mode-line-format-spec))
5377                  (group-name gnus-newsgroup-name)
5378                  (article-number (or gnus-current-article 0))
5379                  (unread (- (length gnus-newsgroup-unreads)
5380                             (length gnus-newsgroup-dormant)))
5381                  (unread-and-unticked 
5382                   (- unread (length gnus-newsgroup-marked)))
5383                  (unselected (length gnus-newsgroup-unselected))
5384                  (unread-and-unselected
5385                   (cond ((and (zerop unread-and-unticked)
5386                               (zerop unselected)) "")
5387                         ((zerop unselected) 
5388                          (format "{%d more}" unread-and-unticked))
5389                         (t (format "{%d(+%d) more}"
5390                                    unread-and-unticked unselected))))
5391                  (subject
5392                   (if gnus-current-headers
5393                       (header-subject gnus-current-headers) ""))
5394                  (max-len (- (frame-width) gnus-mode-non-string-length)))
5395             (setq mode-string (eval mformat))
5396             (if (> (length mode-string) max-len) 
5397                 (setq mode-string 
5398                       (concat (substring mode-string 0 (- max-len 3)) "...")))
5399             (setq mode-string (format (format "%%-%ds" max-len 5)
5400                                       mode-string))))
5401         (setq mode-line-buffer-identification mode-string)
5402         (set-buffer-modified-p t))))
5403
5404 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
5405   "Go through the HEADERS list and add all Xrefs to a hash table.
5406 The resulting hash table is returned, or nil if no Xrefs were found."
5407   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
5408          (prefix (if (and 
5409                       (gnus-group-foreign-p from-newsgroup)
5410                       (not (memq 'virtual 
5411                                  (assoc (symbol-name (car from-method))
5412                                         gnus-valid-select-methods))))
5413                      (gnus-group-real-prefix from-newsgroup)))
5414          (xref-hashtb (make-vector 63 0))
5415          start group entry number xrefs header)
5416     (while headers
5417       (setq header (car headers))
5418       (if (and (setq xrefs (header-xref header))
5419                (not (memq (header-number header) unreads)))
5420           (progn
5421             (setq start 0)
5422             (while (string-match "\\([^ ]+\\):\\([0-9]+\\)" xrefs start)
5423               (setq start (match-end 0))
5424               (setq group (concat prefix (substring xrefs (match-beginning 1) 
5425                                                     (match-end 1))))
5426               (setq number 
5427                     (string-to-int (substring xrefs (match-beginning 2) 
5428                                               (match-end 2))))
5429               (if (setq entry (gnus-gethash group xref-hashtb))
5430                   (setcdr entry (cons number (cdr entry)))
5431                 (gnus-sethash group (cons number nil) xref-hashtb)))))
5432       (setq headers (cdr headers)))
5433     (if start xref-hashtb nil)))
5434
5435 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable)
5436   "Look through all the headers and mark the Xrefs as read."
5437   (let ((virtual (memq 'virtual 
5438                        (assoc (symbol-name (car (gnus-find-method-for-group 
5439                                                  from-newsgroup)))
5440                               gnus-valid-select-methods)))
5441         name entry read info xref-hashtb idlist active num range exps method)
5442     (save-excursion
5443       (set-buffer gnus-group-buffer)
5444       (if (setq xref-hashtb 
5445                 (gnus-create-xref-hashtb from-newsgroup headers unreads))
5446           (mapatoms 
5447            (lambda (group)
5448              (if (string= from-newsgroup (setq name (symbol-name group)))
5449                  ()
5450                (setq idlist (symbol-value group))
5451                ;; Dead groups are not updated.
5452                (if (and (setq entry (gnus-gethash name gnus-newsrc-hashtb)
5453                               info (nth 2 entry))
5454                         ;; Only do the xrefs if the group has the same
5455                         ;; select method as the group we have just read.
5456                         (or (gnus-methods-equal-p 
5457                              (nth 4 info)
5458                              (gnus-find-method-for-group from-newsgroup))
5459                             virtual
5460                             (equal (nth 4 info) 
5461                                    (setq method (gnus-find-method-for-group 
5462                                                  from-newsgroup)))
5463                             (and (equal (car (nth 4 info)) (car method))
5464                                  (equal (nth 1 (nth 4 info)) (nth 1 method))))
5465                         gnus-use-cross-reference
5466                         (or (not (eq gnus-use-cross-reference t))
5467                             virtual
5468                             ;; Only do cross-references on subscribed
5469                             ;; groups, if that is what is wanted.  
5470                             (<= (nth 1 info) 5)))
5471                    (progn
5472                      (setq num 0)
5473                      ;; Set the new list of read articles in this group.
5474                      (setq active (gnus-gethash name gnus-active-hashtb))
5475                      ;; First peel off all illegal article numbers.
5476                      (if active
5477                          (let ((ids idlist)
5478                                (ticked (cdr (assq 'tick (nth 3 info))))
5479                                (dormant (cdr (assq 'dormant (nth 3 info))))
5480                                id)
5481                            (setq exps nil)
5482                            (while ids
5483                              (setq id (car ids))
5484                              (if (or (> id (cdr active))
5485                                      (< id (car active))
5486                                      (memq id ticked)
5487                                      (memq id dormant))
5488                                  (setq idlist (delq id idlist)))
5489                              (and (memq id expirable)
5490                                   (setq exps (cons id exps)))
5491                              (setq ids (cdr ids)))))
5492                      ;; Update expirable articles.
5493                      (gnus-add-marked-articles nil 'expirable exps info)
5494                      (and (null (nth 2 info))
5495                           (> (car active) 1)
5496                           (setcar (nthcdr 2 info) (cons 1 (1- (car active)))))
5497                      (setcar (nthcdr 2 info)
5498                              (setq range
5499                                    (gnus-add-to-range 
5500                                     (nth 2 info) 
5501                                     (setq idlist (sort idlist '<)))))
5502                      ;; Then we have to re-compute how many unread
5503                      ;; articles there are in this group.
5504                      (if active
5505                          (progn
5506                            (if (atom (car range))
5507                                (if (not range)
5508                                    (setq num (- (1+ (cdr active)) 
5509                                                 (car active)))
5510                                  (setq num (- (cdr active) (- (1+ (cdr range)) 
5511                                                               (car range)))))
5512                              (while range
5513                                (setq num (+ num (- (1+ (cdr (car range))) 
5514                                                    (car (car range)))))
5515                                (setq range (cdr range)))
5516                              (setq num (- (cdr active) num)))
5517                            ;; Update the number of unread articles.
5518                            (setcar 
5519                             entry 
5520                             (max 0 (- num 
5521                                       (length (cdr (assq 'tick (nth 3 info))))
5522                                       (length 
5523                                        (cdr (assq 'dormant (nth 3 info)))))))
5524                            ;; Update the group buffer.
5525                            (gnus-group-update-group name t)))))))
5526            xref-hashtb)))))
5527
5528 (defun gnus-methods-equal-p (m1 m2)
5529   (let ((m1 (or m1 gnus-select-method))
5530         (m2 (or m2 gnus-select-method)))
5531     (or (equal m1 m2)
5532         (and (eq (car m1) (car m2))
5533              (or (not (memq 'address (assoc (symbol-name (car m1))
5534                                             gnus-valid-select-methods)))
5535                  (equal (nth 1 m1) (nth 1 m2)))))))
5536
5537 (defsubst gnus-header-value ()
5538   (buffer-substring (match-end 0) (save-excursion (end-of-line) (point))))
5539
5540 (defun gnus-get-newsgroup-headers ()
5541   (setq gnus-article-internal-prepare-hook nil)
5542   (let ((cur nntp-server-buffer)
5543         (dependencies gnus-newsgroup-dependencies)
5544         (none-id 0)
5545         headers char article id dep end)
5546     (save-excursion
5547       (set-buffer nntp-server-buffer)
5548       (goto-char 1)
5549       ;; Search to the beginning of the next header. Error messages
5550       ;; do not begin with 2 or 3.
5551       (while (re-search-forward "^[23][0-9]+ " nil t)
5552         (let ((header (make-vector 9 nil))
5553               (c (following-char))
5554               (case-fold-search t)
5555               (p (point))
5556               from subject in-reply-to references ref)
5557           (setq id nil
5558                 ref nil
5559                 references nil
5560                 subject nil
5561                 from nil)
5562           (header-set-number header (setq article (read cur)))
5563           ;; This implementation of this function, with nine
5564           ;; search-forwards instead of the one re-search-forward and
5565           ;; a case (which basically was the old function) is actually
5566           ;; about twice as fast, even though it looks messier. You
5567           ;; can't have everything, I guess. Speed and elegance
5568           ;; doesn't always come hand in hand.
5569           (save-restriction
5570             (narrow-to-region (point) (save-excursion 
5571                                         (search-forward "\n.\n" nil t)))
5572             (if (search-forward "\nfrom: " nil t)
5573                 (header-set-from header (gnus-header-value))
5574               (header-set-from header "(nobody)"))
5575             (goto-char p)
5576             (if (search-forward "\nsubject: " nil t)
5577                 (header-set-subject header (gnus-header-value))
5578               (header-set-subject header "(none)"))
5579             (goto-char p)
5580             (and (search-forward "\nxref: " nil t)
5581                  (header-set-xref header (gnus-header-value)))
5582             (goto-char p)
5583             (and (search-forward "\nlines: " nil t)
5584                  (header-set-lines header (read cur)))
5585             (goto-char p)
5586             (and (search-forward "\ndate: " nil t)
5587                  (header-set-date header (gnus-header-value)))
5588             (goto-char p)
5589             (if (search-forward "\nmessage-id: " nil t)
5590                 (header-set-id header (setq id (gnus-header-value)))
5591               ;; If there was no message-id, we just fake one to make
5592               ;; subsequent routines simpler.
5593               (header-set-id 
5594                header 
5595                (setq id (concat "none+" (int-to-string 
5596                                          (setq none-id (1+ none-id)))))))
5597             (goto-char p)
5598             (if (search-forward "\nreferences: " nil t)
5599                 (progn
5600                   (header-set-references header (gnus-header-value))
5601                   (setq end (match-end 0))
5602                   (save-excursion
5603                     (setq ref 
5604                           (downcase
5605                            (buffer-substring
5606                             (progn 
5607                               (end-of-line)
5608                               (search-backward ">" end t)
5609                               (1+ (point)))
5610                             (progn
5611                               (search-backward "<" end t)
5612                               (point)))))))
5613               ;; Get the references from the in-reply-to header if there
5614               ;; ware no references and the in-reply-to header looks
5615               ;; promising. 
5616               (if (and (search-forward "\nin-reply-to: " nil t)
5617                        (setq in-reply-to (gnus-header-value))
5618                        (string-match "<[^>]+>" in-reply-to))
5619                   (progn
5620                     (header-set-references 
5621                      header 
5622                      (setq ref (substring in-reply-to (match-beginning 0)
5623                                           (match-end 0))))
5624                     (setq ref (downcase ref)))
5625                 (setq ref "none")))
5626             ;; We do some threading while we read the headers. The
5627             ;; message-id and the last reference are both entered into
5628             ;; the same hash table. Some tippy-toeing around has to be
5629             ;; done in case an article has arrived before the article
5630             ;; which it refers to.
5631             (if (boundp (setq dep (intern (downcase id) dependencies)))
5632                 (if (car (symbol-value dep))
5633                     ;; An article with this Message-ID has already
5634                     ;; been seen, so we ignore this one, except we add
5635                     ;; any additional Xrefs (in case the two articles
5636                     ;; came from different servers.
5637                     (progn
5638                       (header-set-xref 
5639                        (car (symbol-value dep))
5640                        (concat (or (header-xref (car (symbol-value dep))) "")
5641                                (or (header-xref header) "")))
5642                       (setq header nil))
5643                   (setcar (symbol-value dep) header))
5644               (set dep (list header)))
5645             (if header
5646                 (progn
5647                   (if (boundp (setq dep (intern ref dependencies)))
5648                       (setcdr (symbol-value dep) 
5649                               (cons header (cdr (symbol-value dep))))
5650                     (set dep (list nil header)))
5651                   (setq headers (cons header headers))))
5652             (goto-char (point-max))))))
5653     (nreverse headers)))
5654
5655 ;; The following macros and functions were written by Felix Lee
5656 ;; <flee@cse.psu.edu>. 
5657
5658 ;; This is almost 4x faster than (string-to-int (buffer-substring ... ))
5659 ;; primarily because of garbage collection.  -jwz
5660 (defmacro gnus-read-integer (&optional point move-p)
5661   (` ((, (if move-p 'progn 'save-excursion))
5662       (,@ (if point (list (list 'goto-char point))))
5663       (if (and (<= (following-char) ?9)
5664                (>= (following-char) ?0))
5665           (read (current-buffer))
5666         0))))
5667
5668 (defmacro gnus-nov-skip-field ()
5669   '(search-forward "\t" eol 'end))
5670
5671 (defmacro gnus-nov-field ()
5672   '(buffer-substring
5673     (point)
5674     (progn (gnus-nov-skip-field) (1- (point)))))
5675
5676 ;; Goes through the xover lines and returns a list of vectors
5677 (defun gnus-get-newsgroup-headers-xover (sequence)
5678   "Parse the news overview data in the server buffer, and return a
5679 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
5680   ;; Get the Xref when the users reads the articles since most/some
5681   ;; NNTP servers do not include Xrefs when using XOVER.
5682   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
5683   (let ((cur nntp-server-buffer)
5684         (dependencies gnus-newsgroup-dependencies)
5685         (none 0)
5686         number headers header)
5687     (save-excursion
5688       (set-buffer nntp-server-buffer)
5689       (goto-char (point-min))
5690       (while (and sequence (not (eobp)))
5691         (setq number (read cur))
5692         (while (and sequence (< (car sequence) number))
5693           (setq sequence (cdr sequence)))
5694         (and sequence 
5695              (eq number (car sequence))
5696              (progn
5697                (setq sequence (cdr sequence))
5698                (if (setq header 
5699                          (inline (gnus-nov-parse-line number dependencies)))
5700                    (setq headers (cons header headers)))))
5701         (forward-line 1))
5702       (setq headers (nreverse headers)))
5703     headers))
5704
5705 (defun gnus-nov-parse-line (number dependencies)
5706   "Point has to be after the number on the beginning of the line."
5707   (let ((none 0)
5708         header eol ref id dep)
5709     (save-excursion
5710       (end-of-line)
5711       (setq eol (point)))
5712     (forward-char)
5713     ;; overview: [num subject from date id refs chars lines misc]
5714     (setq header
5715           (vector 
5716            number                       ; number
5717            (gnus-nov-field)             ; subject
5718            (gnus-nov-field)             ; from
5719            (gnus-nov-field)             ; date
5720            (setq id (gnus-nov-field))   ; id
5721            (progn
5722              (save-excursion
5723                (let ((beg (point)))
5724                  (search-forward "\t" eol)
5725                  (if (search-backward ">" beg t)
5726                      (setq ref 
5727                            (downcase 
5728                             (buffer-substring 
5729                              (1+ (point))
5730                              (progn
5731                                (search-backward "<" beg t)
5732                                (point)))))
5733                    (setq ref nil))))
5734              (gnus-nov-field))          ; refs
5735            (read (current-buffer))      ; chars
5736            (read (current-buffer))      ; lines
5737            (if (/= (following-char) ?\t)
5738                nil
5739              (forward-char 1)
5740              (gnus-nov-field))          ; misc
5741            ))
5742     ;; We build the thread tree.
5743     (if (boundp 
5744          (setq dep 
5745                (intern 
5746                 (downcase 
5747                  (or id (concat "none+"
5748                                 (int-to-string 
5749                                  (setq none (1+ none))))))
5750                 dependencies)))
5751         (if (car (symbol-value dep))
5752             ;; An article with this Message-ID has already been seen,
5753             ;; so we ignore this one, except we add any additional
5754             ;; Xrefs (in case the two articles came from different
5755             ;; servers.
5756             (progn
5757               (header-set-xref 
5758                (car (symbol-value dep))
5759                (concat (or (header-xref (car (symbol-value dep))) "")
5760                        (or (header-xref header) "")))
5761               (setq header nil))
5762           (setcar (symbol-value dep) header))
5763       (set dep (list header)))
5764     (if header
5765         (progn
5766           (if (boundp (setq dep (intern (or ref "none") 
5767                                         dependencies)))
5768               (setcdr (symbol-value dep) 
5769                       (cons header (cdr (symbol-value dep))))
5770             (set dep (list nil header)))))
5771     header))
5772
5773 (defun gnus-article-get-xrefs ()
5774   "Fill in the Xref value in `gnus-current-headers', if necessary.
5775 This is meant to be called in `gnus-article-internal-prepare-hook'."
5776   (or (not gnus-use-cross-reference)
5777       (header-xref gnus-current-headers)
5778       (let ((case-fold-search t)
5779             xref)
5780         (save-restriction
5781           (gnus-narrow-to-headers)
5782           (goto-char (point-min))
5783           (if (or (and (eq (downcase (following-char)) ?x)
5784                        (looking-at "Xref:"))
5785                   (search-forward "\nXref:" nil t))
5786               (progn
5787                 (goto-char (1+ (match-end 0)))
5788                 (setq xref (buffer-substring (point) 
5789                                              (progn (end-of-line) (point))))
5790                 (save-excursion
5791                   (set-buffer gnus-summary-buffer)
5792                   (header-set-xref gnus-current-headers xref))))))))
5793
5794 (defalias 'gnus-find-header-by-number 'gnus-get-header-by-number)
5795 (make-obsolete 'gnus-find-header-by-number 'gnus-get-header-by-number)
5796
5797 ;; Return a header specified by a NUMBER.
5798 (defun gnus-get-header-by-number (number)
5799   (save-excursion
5800     (set-buffer gnus-summary-buffer)
5801     (or gnus-newsgroup-headers-hashtb-by-number
5802         (gnus-make-headers-hashtable-by-number))
5803     (gnus-gethash (int-to-string number)
5804                   gnus-newsgroup-headers-hashtb-by-number)))
5805
5806 (defun gnus-make-headers-hashtable-by-number ()
5807   "Make hashtable for the variable gnus-newsgroup-headers by number."
5808   (save-excursion
5809     (set-buffer gnus-summary-buffer)
5810     (let ((headers gnus-newsgroup-headers)
5811           header)
5812       (setq gnus-newsgroup-headers-hashtb-by-number
5813             (gnus-make-hashtable (length headers)))
5814       (while headers
5815         (setq header (car headers))
5816         (gnus-sethash (int-to-string (header-number header))
5817                       header gnus-newsgroup-headers-hashtb-by-number)
5818         (setq headers (cdr headers))))))
5819
5820 (defun gnus-more-header-backward ()
5821   "Find new header backward."
5822   (let ((first (car (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
5823         (artnum gnus-newsgroup-begin)
5824         (header nil))
5825     (while (and (not header)
5826                 (> artnum first))
5827       (setq artnum (1- artnum))
5828       (setq header (gnus-read-header artnum)))
5829     header))
5830
5831 (defun gnus-more-header-forward (&optional backward)
5832   "Find new header forward.
5833 If BACKWARD, find new header backward instead."
5834   (if backward
5835       (gnus-more-header-backward)
5836     (let ((last (cdr (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
5837           (artnum gnus-newsgroup-end)
5838           (header nil))
5839       (while (and (not header)
5840                   (< artnum last))
5841         (setq artnum (1+ artnum))
5842         (setq header (gnus-read-header artnum)))
5843       header)))
5844
5845 (defun gnus-extend-newsgroup (header &optional backward)
5846   "Extend newsgroup selection with HEADER.
5847 Optional argument BACKWARD means extend toward backward."
5848   (if header
5849       (let ((artnum (header-number header)))
5850         (setq gnus-newsgroup-headers
5851               (if backward
5852                   (cons header gnus-newsgroup-headers)
5853                 (nconc gnus-newsgroup-headers (list header))))
5854         (setq gnus-newsgroup-unselected
5855               (delq artnum gnus-newsgroup-unselected))
5856         (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
5857         (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum)))))
5858
5859 (defun gnus-summary-work-articles (n)
5860   "Return a list of articles to be worked upon. The prefix argument,
5861 the list of process marked articles, and the current article will be
5862 taken into consideration."
5863   (let (articles)
5864     (if (and n (numberp n))
5865         (let ((backward (< n 0))
5866               (n (abs n)))
5867           (save-excursion
5868             (while (and (> n 0)
5869                         (setq articles (cons (gnus-summary-article-number) 
5870                                              articles))
5871                         (gnus-summary-search-forward nil nil backward))
5872               (setq n (1- n))))
5873           (sort articles (function <)))
5874       (or (reverse gnus-newsgroup-processable)
5875           (list (gnus-summary-article-number))))))
5876
5877 (defun gnus-summary-search-group (&optional backward use-level)
5878   "Search for next unread newsgroup.
5879 If optional argument BACKWARD is non-nil, search backward instead."
5880   (save-excursion
5881     (set-buffer gnus-group-buffer)
5882     (save-excursion
5883       ;; We don't want to alter current point of group mode buffer.
5884       (if (gnus-group-search-forward 
5885            backward nil
5886            (if use-level (gnus-group-group-level) nil))
5887           (gnus-group-group-name)))))
5888
5889 (defun gnus-summary-best-group ()
5890   "Find the name of the best unread group."
5891   (save-excursion
5892     (set-buffer gnus-group-buffer)
5893     (save-excursion
5894       (gnus-group-best-unread-group))))
5895
5896 (defun gnus-summary-search-subject (&optional backward unread subject)
5897   "Search for article forward.
5898 If BACKWARD is non-nil, search backward.
5899 If UNREAD is non-nil, only unread articles are selected.
5900 If SUBJECT is non-nil, the article which has the same subject will be
5901 searched for." 
5902   (let ((func (if backward 'previous-single-property-change
5903                 'next-single-property-change))
5904         (beg (point))
5905         (did t)
5906         pos)
5907     (beginning-of-line)
5908     (forward-char (if backward (if (bobp) 0 -1) (if (eobp) 0 1)))
5909     (while (and (setq pos (funcall func (point) 'gnus-number))
5910                 (goto-char (if backward (1- pos) pos))
5911                 (setq did
5912                       (not (and (or (not unread)
5913                                     (eq (get-text-property (point) 'gnus-mark) 
5914                                         gnus-unread-mark))
5915                                 (or (not subject)
5916                                     (equal (gnus-simplify-subject-re 
5917                                             subject)
5918                                            (gnus-simplify-subject-re
5919                                             (get-text-property 
5920                                              (point) 
5921                                              'gnus-subject)))))))
5922                 (if backward (if (bobp) nil (forward-char -1) t)
5923                   (if (eobp) nil (forward-char 1) t))))
5924     (if did
5925         (progn (goto-char beg) nil)
5926       (prog1
5927           (get-text-property (point) 'gnus-number)
5928         (gnus-summary-position-cursor)))))
5929
5930 (defun gnus-summary-search-forward (&optional unread subject backward)
5931   "Search for article forward.
5932 If UNREAD is non-nil, only unread articles are selected.
5933 If SUBJECT is non-nil, the article which has the same subject will be
5934 searched for. 
5935 If BACKWARD is non-nil, the search will be performed backwards instead."
5936   (gnus-summary-search-subject backward unread subject))
5937
5938 (defun gnus-summary-search-backward (&optional unread subject)
5939   "Search for article backward.
5940 If 1st optional argument UNREAD is non-nil, only unread article is selected.
5941 If 2nd optional argument SUBJECT is non-nil, the article which has
5942 the same subject will be searched for."
5943   (gnus-summary-search-forward unread subject t))
5944
5945 (defun gnus-summary-article-number (&optional number-or-nil)
5946   "The article number of the article on the current line.
5947 If there isn's an article number here, then we return the current
5948 article number."
5949   (let ((number (get-text-property (save-excursion (beginning-of-line) (point))
5950                                    'gnus-number)))
5951     (if number-or-nil number (or number gnus-current-article))))
5952
5953 (defun gnus-summary-thread-level ()
5954   "The thread level of the article on the current line."
5955   (or (get-text-property (save-excursion (beginning-of-line) (point))
5956                          'gnus-thread)
5957       0))
5958
5959 (defun gnus-summary-pseudo-article ()
5960   "The thread level of the article on the current line."
5961   (get-text-property (save-excursion (beginning-of-line) (point)) 
5962                      'gnus-pseudo))
5963
5964 (defun gnus-summary-article-mark ()
5965   "The mark on the current line."
5966   (get-text-property (save-excursion (beginning-of-line) (point))
5967                      'gnus-mark))
5968
5969 (defun gnus-summary-subject-string ()
5970   "Return current subject string or nil if nothing."
5971   (get-text-property (save-excursion (beginning-of-line) (point))
5972                      'gnus-subject))
5973
5974 (defalias 'gnus-summary-score 'gnus-summary-article-score)
5975 (make-obsolete 'gnus-summary-score 'gnus-summary-article-score)
5976 (defun gnus-summary-article-score ()
5977   "Return current article score."
5978   (or (cdr (assq (gnus-summary-article-number) gnus-newsgroup-scored))
5979       gnus-summary-default-score 0))
5980
5981 (defun gnus-summary-recenter ()
5982   "Center point in the summary window.
5983 If `gnus-auto-center-summary' is nil, or the article buffer isn't
5984 displayed, no centering will be performed." 
5985   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
5986   ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
5987   (let ((top (cond ((< (window-height) 4) 0)
5988                    ((< (window-height) 6) 1)
5989                    (t 2))))
5990     (and 
5991      ;; The user has to want it,
5992      gnus-auto-center-summary 
5993      ;; the article buffer must be displayed,
5994      (get-buffer-window gnus-article-buffer)
5995      ;; there must be lines left to scroll forward,
5996      (zerop (save-excursion (forward-line (- (window-height) 1 top))))
5997      ;; so we recenter.
5998      (set-window-start 
5999       (get-buffer-window (current-buffer)) 
6000       (save-excursion (forward-line (- top)) (point))))))
6001
6002 (defun gnus-summary-jump-to-group (newsgroup)
6003   "Move point to NEWSGROUP in group mode buffer."
6004   ;; Keep update point of group mode buffer if visible.
6005   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
6006       (save-window-excursion
6007         ;; Take care of tree window mode.
6008         (if (get-buffer-window gnus-group-buffer)
6009             (pop-to-buffer gnus-group-buffer))
6010         (gnus-group-jump-to-group newsgroup))
6011     (save-excursion
6012       ;; Take care of tree window mode.
6013       (if (get-buffer-window gnus-group-buffer)
6014           (pop-to-buffer gnus-group-buffer)
6015         (set-buffer gnus-group-buffer))
6016       (gnus-group-jump-to-group newsgroup))))
6017
6018 ;; This function returns a list of article numbers based on the
6019 ;; difference between the ranges of read articles in this group and
6020 ;; the range of active articles.
6021 (defun gnus-list-of-unread-articles (group)
6022   (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
6023          (active (gnus-gethash group gnus-active-hashtb))
6024          (last (cdr active))
6025          unread first nlast unread)
6026     ;; If none are read, then all are unread. 
6027     (if (not read)
6028           (setq first (car active))
6029       ;; If the range of read articles is a single range, then the
6030       ;; first unread article is the article after the last read
6031       ;; article. Sounds logical, doesn't it?
6032       (if (atom (car read))
6033           (setq first (1+ (cdr read)))
6034         ;; `read' is a list of ranges.
6035         (while read
6036           (if first 
6037               (while (< first nlast)
6038                 (setq unread (cons first unread))
6039                 (setq first (1+ first))))
6040           (setq first (1+ (cdr (car read))))
6041           (setq nlast (car (car (cdr read))))
6042           (setq read (cdr read)))))
6043     ;; And add the last unread articles.
6044     (while (<= first last)
6045       (setq unread (cons first unread))
6046       (setq first (1+ first)))
6047     ;; Return the list of unread articles.
6048     (nreverse unread)))
6049
6050
6051 ;; Various summary commands
6052
6053 (defun gnus-summary-universal-argument ()
6054   "Perform any operation on all articles marked with the process mark."
6055   (interactive)
6056   (gnus-set-global-variables)
6057   (let ((articles (reverse gnus-newsgroup-processable))
6058         key func)
6059     (or articles (error "No articles marked"))
6060     (or (setq func (key-binding (read-key-sequence "C-c C-u")))
6061         (error "Undefined key"))
6062     (while articles
6063       (gnus-summary-goto-subject (car articles))
6064       (command-execute func)
6065       (gnus-summary-remove-process-mark (car articles))
6066       (setq articles (cdr articles)))))
6067
6068 (defun gnus-summary-toggle-truncation (arg)
6069   "Toggle truncation of summary lines.
6070 With arg, turn line truncation on iff arg is positive."
6071   (interactive "P")
6072   (setq truncate-lines
6073         (if (null arg) (not truncate-lines)
6074           (> (prefix-numeric-value arg) 0)))
6075   (redraw-display))
6076
6077 (defun gnus-summary-reselect-current-group (show-all)
6078   "Once exit and then reselect the current newsgroup.
6079 Prefix argument SHOW-ALL means to select all articles."
6080   (interactive "P")
6081   (gnus-set-global-variables)
6082   (let ((current-subject (gnus-summary-article-number)))
6083     (gnus-summary-exit t)
6084     ;; We have to adjust the point of group mode buffer because the
6085     ;; current point was moved to the next unread newsgroup by
6086     ;; exiting.
6087     (gnus-summary-jump-to-group gnus-newsgroup-name)
6088     (gnus-group-read-group show-all t)
6089     (gnus-summary-goto-subject current-subject)))
6090
6091 (defun gnus-summary-rescan-group (all)
6092   "Exit the newsgroup, ask for new articles, and select the newsgroup."
6093   (interactive "P")
6094   (gnus-set-global-variables)
6095   ;; Fix by Ilja Weis <kult@uni-paderborn.de>.
6096   (let ((group gnus-newsgroup-name))
6097     (gnus-summary-exit t)
6098     (gnus-summary-jump-to-group group)
6099     (save-excursion
6100       (set-buffer gnus-group-buffer)
6101       (gnus-group-get-new-news-this-group 1))
6102     (gnus-summary-jump-to-group group)
6103     (gnus-group-read-group all)))
6104
6105 (defun gnus-summary-exit (&optional temporary)
6106   "Exit reading current newsgroup, and then return to group selection mode.
6107 gnus-exit-group-hook is called with no arguments if that value is non-nil."
6108   (interactive)
6109   (gnus-set-global-variables)
6110   (gnus-kill-save-kill-buffer)
6111   (let* ((group gnus-newsgroup-name)
6112          (quit-buffer (cdr (assoc 'quit-buffer (gnus-find-method-for-group
6113                                                 gnus-newsgroup-name))))
6114          (mode major-mode)
6115          (method (car (gnus-find-method-for-group group)))
6116          (buf (current-buffer)))
6117     (if gnus-newsgroup-kill-headers
6118         (setq gnus-newsgroup-killed
6119               (gnus-compress-sequence
6120                (nconc
6121                 (gnus-set-sorted-intersection
6122                  (gnus-uncompress-sequence gnus-newsgroup-killed)
6123                  (setq gnus-newsgroup-unselected
6124                        (sort gnus-newsgroup-unselected '<)))
6125                 (setq gnus-newsgroup-unreads
6126                       (sort gnus-newsgroup-unreads '<))))))
6127     (or (listp (cdr gnus-newsgroup-killed))
6128         (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
6129     (let ((updated nil)
6130           (headers gnus-newsgroup-headers))
6131       (gnus-close-group group)
6132       (run-hooks 'gnus-exit-group-hook)
6133       (gnus-score-save)
6134       (gnus-update-read-articles 
6135        group gnus-newsgroup-unreads gnus-newsgroup-unselected 
6136        gnus-newsgroup-marked
6137        t gnus-newsgroup-replied gnus-newsgroup-expirable
6138        gnus-newsgroup-killed gnus-newsgroup-dormant
6139        gnus-newsgroup-bookmarks gnus-newsgroup-scored)
6140       (and gnus-use-cross-reference
6141            (gnus-mark-xrefs-as-read 
6142             group headers gnus-newsgroup-unreads gnus-newsgroup-expirable))
6143       ;; Do not switch windows but change the buffer to work.
6144       (set-buffer gnus-group-buffer)
6145       (or (eq 'nndigest method)
6146           (gnus-group-update-group group)))
6147     ;; Make sure where I was, and go to next newsgroup.
6148     (if (eq method 'nndigest)
6149         ()
6150       (gnus-group-jump-to-group group)
6151       (gnus-group-next-unread-group 1))
6152     (if temporary
6153         ;; If exiting temporary, caller should adjust group mode
6154         ;; buffer point by itself.
6155         nil                             ;Nothing to do.
6156       ;; We set all buffer-local variables to nil. It is unclear why
6157       ;; this is needed, but if we don't, buffer-local variables are
6158       ;; not garbage-collected, it seems. This would the lead to en
6159       ;; ever-growing Emacs.
6160       (set-buffer buf)
6161       (gnus-summary-clear-local-variables)
6162       ;; We clear the global counterparts of the buffer-local
6163       ;; variables as well, just to be on the safe side.
6164       (set-buffer gnus-group-buffer)
6165       (gnus-summary-clear-local-variables)
6166       (gnus-configure-windows 'newsgroups t)
6167       ;; Return to group mode buffer. 
6168       (and (get-buffer buf) 
6169            (eq mode 'gnus-summary-mode)
6170            (kill-buffer buf))
6171       (if (get-buffer gnus-article-buffer)
6172           (bury-buffer gnus-article-buffer))
6173       (setq gnus-current-select-method gnus-select-method)
6174       (pop-to-buffer gnus-group-buffer)
6175       (if (and quit-buffer (buffer-name quit-buffer))
6176           (progn
6177             (switch-to-buffer quit-buffer)
6178             (gnus-set-global-variables)
6179             (gnus-configure-windows 'summary))))))
6180
6181 (defun gnus-summary-quit (&optional no-questions)
6182   "Quit reading current newsgroup without updating read article info."
6183   (interactive)
6184   (let* ((group gnus-newsgroup-name)
6185          (quit-buffer (cdr (assoc 'quit-buffer 
6186                                   (gnus-find-method-for-group group)))))
6187     (if (or no-questions
6188             gnus-expert-user
6189             (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
6190         (progn
6191           (gnus-close-group group)
6192           (gnus-summary-clear-local-variables)
6193           (set-buffer gnus-group-buffer)
6194           (gnus-summary-clear-local-variables)
6195           ;; Return to group selection mode.
6196           (gnus-configure-windows 'newsgroups)
6197           (if (get-buffer gnus-summary-buffer)
6198               (kill-buffer gnus-summary-buffer))
6199           (if (get-buffer gnus-article-buffer)
6200               (bury-buffer gnus-article-buffer))
6201           (pop-to-buffer gnus-group-buffer)
6202           (gnus-group-jump-to-group group)
6203           (gnus-group-next-group 1)
6204           (if (and quit-buffer (buffer-name quit-buffer))
6205               (progn
6206                 (switch-to-buffer quit-buffer)
6207                 (gnus-configure-windows 'summary)))))))
6208
6209 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
6210 (defun gnus-summary-fetch-faq (group)
6211   "Fetch the FAQ for the current group."
6212   (interactive (list gnus-newsgroup-name))
6213   (gnus-configure-windows 'article)
6214   (pop-to-buffer gnus-article-buffer)
6215   (find-file (concat gnus-group-faq-directory group)))
6216
6217 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6218 (defun gnus-summary-describe-group (force)
6219   "Describe the current newsgroup."
6220   (interactive "P")
6221   (gnus-group-describe-group force gnus-newsgroup-name))
6222
6223 (defun gnus-summary-describe-briefly ()
6224   "Describe summary mode commands briefly."
6225   (interactive)
6226   (message
6227     (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")))
6228
6229 ;; Walking around group mode buffer from summary mode.
6230
6231 (defun gnus-summary-next-group (&optional no-article group backward)
6232   "Exit current newsgroup and then select next unread newsgroup.
6233 If prefix argument NO-ARTICLE is non-nil, no article is selected initially.
6234 If BACKWARD, go to previous group instead."
6235   (interactive "P")
6236   (gnus-set-global-variables)
6237   (let ((ingroup gnus-newsgroup-name)
6238         (sumbuf (current-buffer))
6239         num)
6240     (gnus-summary-exit t)               ;Update all information.
6241     (if (and group
6242              (or (and (numberp (setq num (car (gnus-gethash
6243                                                group gnus-newsrc-hashtb))))
6244                       (< num 1))
6245                  (null num)))
6246         (progn
6247           (gnus-group-jump-to-group group)
6248           (setq group nil))
6249       (gnus-group-jump-to-group ingroup))
6250     (let ((group (or group (gnus-summary-search-group backward)))
6251           (buf gnus-summary-buffer))
6252       (if (null group)
6253           (gnus-summary-quit t)
6254         (message "Selecting %s..." group)
6255         ;; We are now in group mode buffer.
6256         ;; Make sure group mode buffer point is on GROUP.
6257         (gnus-group-jump-to-group group)
6258         (unwind-protect
6259             (gnus-summary-read-group group nil no-article buf)
6260           (and (string= gnus-newsgroup-name ingroup)
6261                (progn
6262                  (set-buffer sumbuf)
6263                  (gnus-summary-quit t))))))))
6264
6265 (defun gnus-summary-prev-group (no-article)
6266   "Exit current newsgroup and then select previous unread newsgroup.
6267 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
6268   (interactive "P")
6269   (gnus-summary-next-group no-article nil t))
6270
6271 ;; Walking around summary lines.
6272
6273 (defun gnus-summary-first-subject (unread)
6274   "Go to the first unread subject.
6275 If UNREAD is non-nil, go to the first unread article.
6276 Returns nil if there are no unread articles."
6277   (interactive "P")
6278   (let ((begin (point)))
6279     (if unread
6280         (if (not (gnus-goto-char 
6281                   (text-property-any (point-min) (point-max)
6282                                      'gnus-mark gnus-unread-mark)))
6283             (progn
6284               ;; If there is no unread articles, stay where you are.
6285               (goto-char begin)
6286               (message "No more unread articles")
6287               nil)
6288           t)
6289       (goto-char (point-min)))))
6290
6291 (defun gnus-summary-next-subject (n &optional unread)
6292   "Go to next N'th summary line.
6293 If N is negative, go to the previous N'th subject line.
6294 If UNREAD is non-nil, only unread articles are selected.
6295 The difference between N and the actual number of steps taken is
6296 returned."
6297   (interactive "p")
6298   (let ((backward (< n 0))
6299         (n (abs n)))
6300   (while (and (> n 0)
6301               (gnus-summary-search-forward unread nil backward))
6302     (setq n (1- n)))
6303   (gnus-summary-recenter)
6304   (if (/= 0 n) (message "No more%s articles" (if unread " unread" "")))
6305   (gnus-summary-position-cursor)
6306   n))
6307
6308 (defun gnus-summary-next-unread-subject (n)
6309   "Go to next N'th unread summary line."
6310   (interactive "p")
6311   (gnus-summary-next-subject n t))
6312
6313 (defun gnus-summary-prev-subject (n &optional unread)
6314   "Go to previous N'th summary line.
6315 If optional argument UNREAD is non-nil, only unread article is selected."
6316   (interactive "p")
6317   (gnus-summary-next-subject (- n) unread))
6318
6319 (defun gnus-summary-prev-unread-subject (n)
6320   "Go to previous N'th unread summary line."
6321   (interactive "p")
6322   (gnus-summary-next-subject (- n) t))
6323
6324 (defun gnus-summary-goto-subject (article)
6325   "Go the subject line of ARTICLE."
6326   (interactive
6327    (list
6328     (string-to-int
6329      (completing-read "Article number: "
6330                       (mapcar
6331                        (lambda (headers)
6332                          (list
6333                           (int-to-string (header-number headers))))
6334                        gnus-newsgroup-headers)
6335                       nil 'require-match))))
6336   (or article (error "No article number"))
6337   (if (or (eq article (gnus-summary-article-number t))
6338           (gnus-goto-char
6339            (text-property-any
6340             (point-min) (point-max) 'gnus-number article)))
6341       article))
6342
6343 ;; Walking around summary lines with displaying articles.
6344
6345 (defun gnus-summary-expand-window ()
6346   "Expand summary window to show headers full window."
6347   (interactive)
6348   (gnus-set-global-variables)
6349   (gnus-configure-windows 'summary)
6350   (pop-to-buffer gnus-summary-buffer))
6351
6352 (defun gnus-summary-display-article (article &optional all-header)
6353   "Display ARTICLE in article buffer."
6354   (gnus-set-global-variables)
6355   (if (null article)
6356       nil
6357     (gnus-article-prepare article all-header)
6358     (if (= (gnus-summary-article-mark) ?Z) 
6359         (progn
6360           (forward-line 1)
6361           (gnus-summary-position-cursor)))
6362     (run-hooks 'gnus-select-article-hook)
6363     (gnus-summary-recenter)
6364 ;    (set-window-point (get-buffer-window (current-buffer)) (point-max))
6365 ;    (sit-for 0)
6366     (gnus-summary-goto-subject article)
6367     ;; Successfully display article.
6368     (gnus-summary-update-line)
6369     t))
6370
6371 (defun gnus-summary-select-article (&optional all-headers force pseudo)
6372   "Select the current article.
6373 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
6374 non-nil, the article will be re-fetched even if it already present in
6375 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
6376 be displayed."
6377   (and (not pseudo) (gnus-summary-pseudo-article)
6378        (error "This is a pseudo-article."))
6379   (let ((article (gnus-summary-article-number))
6380         (all-headers (not (not all-headers)))) ;Must be T or NIL.
6381     (if (or (null gnus-current-article)
6382             (null gnus-article-current)
6383             (/= article (cdr gnus-article-current))
6384             (not (equal (car gnus-article-current) gnus-newsgroup-name))
6385             force)
6386         ;; The requested article is different from the current article.
6387         (progn
6388           (gnus-summary-display-article article all-headers)
6389           article)
6390       (if all-headers (gnus-article-show-all-headers))
6391       (gnus-configure-windows 'article)
6392       (pop-to-buffer gnus-summary-buffer)
6393       nil)))
6394
6395 (defun gnus-summary-set-current-mark (&optional current-mark)
6396   "Obsolete function."
6397   nil)
6398
6399 (defun gnus-summary-next-article (unread &optional subject backward)
6400   "Select the next article.
6401 If UNREAD, only unread articles are selected.
6402 If SUBJECT, only articles with SUBJECT are selected.
6403 If BACKWARD, the previous article is selected instead of the next."
6404   (interactive "P")
6405   (let ((opoint (point))
6406         (method (car (gnus-find-method-for-group gnus-newsgroup-name)))
6407         header)
6408     (cond
6409      ;; Is there such an article?
6410      ((gnus-summary-display-article 
6411        (gnus-summary-search-forward unread subject backward))
6412       (gnus-summary-position-cursor))
6413      ;; If not, we try the first unread, if that is wanted.
6414      ((and subject
6415            gnus-auto-select-same
6416            (gnus-summary-first-unread-article))
6417       (message "Wrapped"))
6418      ;; Try to get next/previous article not displayed in this group.
6419      ((and gnus-auto-extend-newsgroup
6420            (not unread) (not subject)
6421            (setq header (gnus-more-header-forward backward)))
6422       (gnus-extend-newsgroup header backward)
6423       (let ((buffer-read-only nil))
6424         (goto-char (if backward (point-min) (point-max)))
6425         (gnus-summary-prepare-threads (list header) 0))
6426       (gnus-summary-goto-article (if backward gnus-newsgroup-begin
6427                                    gnus-newsgroup-end)))
6428      ;; Go to next/previous group.
6429      (t
6430       (gnus-summary-jump-to-group gnus-newsgroup-name)
6431       (let ((cmd (aref (this-command-keys) 0))
6432             (group 
6433              (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group)
6434                (gnus-summary-search-group backward gnus-keep-same-level))))
6435         ;; Keep just the event type of CMD.
6436         (and (listp cmd) (setq cmd (car cmd)))
6437         ;; Select next unread newsgroup automagically.
6438         (cond 
6439          ((not gnus-auto-select-next)
6440           (message "No more%s articles" (if unread " unread" "")))
6441          ((eq gnus-auto-select-next 'quietly)
6442           ;; Select quietly.
6443           (if (eq method 'nndigest)
6444               (gnus-summary-exit)
6445             (message "No more%s articles (%s)..."
6446                      (if unread " unread" "") 
6447                      (if group (concat "selecting " group)
6448                        "exiting"))
6449             (gnus-summary-next-group nil group backward)))
6450          (t
6451           (let ((keystrokes '(?\C-n ?\C-p))
6452                 key)
6453             (while (or (null key) (memq key keystrokes))
6454               (message 
6455                "No more%s articles%s" (if unread " unread" "")
6456                (if (and group (not (eq method 'nndigest)))
6457                    (format " (Type %s for %s [%s])"
6458                            (single-key-description cmd) group
6459                            (car (gnus-gethash group gnus-newsrc-hashtb)))
6460                  (format " (Type %s to exit %s)"
6461                          (single-key-description cmd)
6462                          gnus-newsgroup-name)))
6463               ;; Confirm auto selection.
6464               (let* ((event (read-event)))
6465                 (setq key (if (listp event) (car event) event))
6466                 (if (member key keystrokes)
6467                     (let ((obuf (current-buffer)))
6468                       (switch-to-buffer gnus-group-buffer)
6469                       (gnus-group-jump-to-group group)
6470                       (execute-kbd-macro (char-to-string key))
6471                       (setq group (gnus-group-group-name))
6472                       (switch-to-buffer obuf)))))
6473             (if (eq key cmd)
6474                 (if (or (not group) (eq method 'nndigest))
6475                     (gnus-summary-exit)
6476                   (gnus-summary-next-group nil group backward))
6477               (setq unread-command-events (list key)))))))))))
6478
6479 (defun gnus-summary-next-unread-article ()
6480   "Select unread article after current one."
6481   (interactive)
6482   (gnus-summary-next-article t (and gnus-auto-select-same
6483                                     (gnus-summary-subject-string))))
6484
6485 (defun gnus-summary-prev-article (unread &optional subject)
6486   "Select the article after the current one.
6487 If UNREAD is non-nil, only unread articles are selected."
6488   (interactive "P")
6489   (gnus-summary-next-article unread subject t))
6490
6491 (defun gnus-summary-prev-unread-article ()
6492   "Select unred article before current one."
6493   (interactive)
6494   (gnus-summary-prev-article t (and gnus-auto-select-same
6495                                     (gnus-summary-subject-string))))
6496
6497 (defun gnus-summary-next-page (lines &optional circular)
6498   "Show next page of selected article.
6499 If end of article, select next article.
6500 Argument LINES specifies lines to be scrolled up.
6501 If CIRCULAR is non-nil, go to the start of the article instead of 
6502 instead of selecting the next article when reaching the end of the
6503 current article." 
6504   (interactive "P")
6505   (setq gnus-summary-buffer (current-buffer))
6506   (let ((article (gnus-summary-article-number))
6507         (endp nil))
6508     (if (or (null gnus-current-article)
6509             (null gnus-article-current)
6510             (/= article (cdr gnus-article-current))
6511             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
6512         ;; Selected subject is different from current article's.
6513         (gnus-summary-display-article article)
6514       (gnus-configure-windows 'article)
6515       (pop-to-buffer gnus-summary-buffer)
6516       (gnus-eval-in-buffer-window
6517        gnus-article-buffer
6518        (setq endp (gnus-article-next-page lines)))
6519       (if endp
6520           (cond (circular
6521                  (gnus-summary-beginning-of-article))
6522                 (lines
6523                  (message "End of message"))
6524                 ((null lines)
6525                  (gnus-summary-next-unread-article))))))
6526   (gnus-summary-position-cursor))
6527
6528 (defun gnus-summary-prev-page (lines)
6529   "Show previous page of selected article.
6530 Argument LINES specifies lines to be scrolled down."
6531   (interactive "P")
6532   (let ((article (gnus-summary-article-number)))
6533     (if (or (null gnus-current-article)
6534             (null gnus-article-current)
6535             (/= article (cdr gnus-article-current))
6536             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
6537         ;; Selected subject is different from current article's.
6538         (gnus-summary-display-article article)
6539       (gnus-configure-windows 'article)
6540       (pop-to-buffer gnus-summary-buffer)
6541       (gnus-eval-in-buffer-window gnus-article-buffer
6542         (gnus-article-prev-page lines))))
6543   (gnus-summary-position-cursor))
6544
6545 (defun gnus-summary-scroll-up (lines)
6546   "Scroll up (or down) one line current article.
6547 Argument LINES specifies lines to be scrolled up (or down if negative)."
6548   (interactive "p")
6549   (or (gnus-summary-select-article nil nil 'pseudo)
6550       (gnus-eval-in-buffer-window 
6551        gnus-article-buffer
6552        (cond ((> lines 0)
6553               (if (gnus-article-next-page lines)
6554                   (message "End of message")))
6555              ((< lines 0)
6556               (gnus-article-prev-page (- lines))))))
6557   (gnus-summary-position-cursor))
6558
6559 (defun gnus-summary-next-same-subject ()
6560   "Select next article which has the same subject as current one."
6561   (interactive)
6562   (gnus-summary-next-article nil (gnus-summary-subject-string)))
6563
6564 (defun gnus-summary-prev-same-subject ()
6565   "Select previous article which has the same subject as current one."
6566   (interactive)
6567   (gnus-summary-prev-article nil (gnus-summary-subject-string)))
6568
6569 (defun gnus-summary-next-unread-same-subject ()
6570   "Select next unread article which has the same subject as current one."
6571   (interactive)
6572   (gnus-summary-next-article t (gnus-summary-subject-string)))
6573
6574 (defun gnus-summary-prev-unread-same-subject ()
6575   "Select previous unread article which has the same subject as current one."
6576   (interactive)
6577   (gnus-summary-prev-article t (gnus-summary-subject-string)))
6578
6579 (defun gnus-summary-first-unread-article ()
6580   "Select the first unread article. 
6581 Return nil if there are no unread articles."
6582   (interactive)
6583   (prog1
6584       (if (gnus-summary-first-subject t)
6585           (gnus-summary-display-article (gnus-summary-article-number)))
6586     (gnus-summary-position-cursor)))
6587
6588 (defun gnus-summary-best-unread-article ()
6589   "Select the unread article with the highest score."
6590   (interactive)
6591   (gnus-set-global-variables)
6592   (let ((scored gnus-newsgroup-scored)
6593         (best -1000000)
6594         article art)
6595     (while scored
6596       (or (> best (cdr (car scored)))
6597           (and (memq (setq art (car (car scored))) gnus-newsgroup-unreads)
6598                (not (memq art gnus-newsgroup-marked))
6599                (not (memq art gnus-newsgroup-dormant))
6600                (if (= best (cdr (car scored)))
6601                    (setq article (min art article))
6602                  (setq article art)
6603                  (setq best (cdr (car scored))))))
6604       (setq scored (cdr scored)))
6605     (if article 
6606         (gnus-summary-goto-article article)
6607       (gnus-summary-first-unread-article))
6608     (gnus-summary-position-cursor)))
6609
6610 (defun gnus-summary-goto-article (article &optional all-headers)
6611   "Fetch ARTICLE and display it if it exists.
6612 If ALL-HEADERS is non-nil, no header lines are hidden."
6613   (interactive
6614    (list
6615     (string-to-int
6616      (completing-read 
6617       "Article number: "
6618       (mapcar (lambda (headers) (list (int-to-string (header-number headers))))
6619               gnus-newsgroup-headers) 
6620       nil 'require-match))))
6621   (if (gnus-summary-goto-subject article)
6622       (gnus-summary-display-article article all-headers))
6623   (gnus-summary-position-cursor))
6624
6625 (defun gnus-summary-goto-last-article ()
6626   "Go to the last article."
6627   (interactive)
6628   (if gnus-last-article
6629       (gnus-summary-goto-article gnus-last-article))
6630   (gnus-summary-position-cursor))
6631
6632 (defun gnus-summary-pop-article (number)
6633   "Pop one article off the history and go to the previous.
6634 NUMBER articles will be popped off."
6635   (interactive "p")
6636   (let (to)
6637     (setq gnus-newsgroup-history
6638           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
6639     (if to
6640         (gnus-summary-goto-article (car to))
6641       (error "Article history empty")))
6642   (gnus-summary-position-cursor))
6643
6644 ;; Summary article oriented commands
6645
6646 (defun gnus-summary-refer-parent-article (n)
6647   "Refer parent article N times.
6648 The difference between N and the number of articles fetched is returned."
6649   (interactive "p")
6650   (gnus-set-global-variables)
6651   (while 
6652       (and 
6653        (> n 0)
6654        (let ((ref (header-references (gnus-get-header-by-number
6655                                       (gnus-summary-article-number)))))
6656          (if (and ref (not (equal ref ""))
6657                   (string-match "<[^<>]*>[ \t]*$" ref))
6658              (gnus-summary-refer-article 
6659               (substring ref (match-beginning 0) (match-end 0))))))
6660     (setq n (1- n)))
6661   (or (zerop n) (message "No references in article or expired article."))
6662   (gnus-summary-position-cursor)
6663   n)
6664     
6665 (defun gnus-summary-refer-article (message-id)
6666   "Refer article specified by MESSAGE-ID.
6667 NOTE: This command only works with newsgroup that use NNTP."
6668   (interactive "sMessage-ID: ")
6669   (if (or (not (stringp message-id))
6670           (zerop (length message-id)))
6671       ()
6672     ;; Construct the correct Message-ID if necessary.
6673     ;; Suggested by tale@pawl.rpi.edu.
6674     (or (string-match "^<" message-id)
6675         (setq message-id (concat "<" message-id)))
6676     (or (string-match ">$" message-id)
6677         (setq message-id (concat message-id ">")))
6678     (let ((header (car (gnus-gethash (downcase message-id)
6679                                      gnus-newsgroup-dependencies))))
6680       (if header
6681           (gnus-summary-goto-article (header-number header))
6682         (let ((gnus-override-method gnus-refer-article-method))
6683           (if (gnus-article-prepare 
6684                message-id nil (gnus-read-header message-id))
6685               (progn
6686                 (gnus-summary-insert-line 
6687                  nil gnus-current-headers 0 nil gnus-read-mark nil nil 
6688                  (header-subject gnus-current-headers))
6689                 (forward-line -1)
6690                 (gnus-summary-position-cursor)
6691                 (gnus-summary-update-line)
6692                 message-id)
6693             (message "No such references")
6694             nil))))))
6695
6696 (defun gnus-summary-enter-digest-group ()
6697   "Enter a digest group based on the current article."
6698   (interactive)
6699   (gnus-summary-select-article)
6700   (let ((name (format "%s/%d" 
6701                       (gnus-group-prefixed-name 
6702                        gnus-newsgroup-name (list 'nndigest "")) 
6703                       gnus-current-article))
6704         (buf (current-buffer)))
6705     (set-buffer gnus-group-buffer)
6706     (gnus-sethash 
6707      name 
6708      (list t nil (list name 3 nil nil 
6709                        (list 'nndigest gnus-article-buffer
6710                              (cons 'quit-buffer buf))))
6711      gnus-newsrc-hashtb)
6712     (gnus-group-read-group t nil name)))
6713   
6714 (defun gnus-summary-isearch-article ()
6715   "Do incremental search forward on current article."
6716   (interactive)
6717   (gnus-summary-select-article)
6718   (gnus-eval-in-buffer-window gnus-article-buffer
6719                               (isearch-forward)))
6720
6721 (defun gnus-summary-search-article-forward (regexp)
6722   "Search for an article containing REGEXP forward.
6723 gnus-select-article-hook is not called during the search."
6724   (interactive
6725    (list (read-string
6726           (concat "Search forward (regexp): "
6727                   (if gnus-last-search-regexp
6728                       (concat "(default " gnus-last-search-regexp ") "))))))
6729   (if (string-equal regexp "")
6730       (setq regexp (or gnus-last-search-regexp ""))
6731     (setq gnus-last-search-regexp regexp))
6732   (if (gnus-summary-search-article regexp nil)
6733       (gnus-eval-in-buffer-window 
6734        gnus-article-buffer
6735        (recenter 0))
6736     (error "Search failed: \"%s\"" regexp)))
6737
6738 (defun gnus-summary-search-article-backward (regexp)
6739   "Search for an article containing REGEXP backward.
6740 gnus-select-article-hook is not called during the search."
6741   (interactive
6742    (list (read-string
6743           (concat "Search backward (regexp): "
6744                   (if gnus-last-search-regexp
6745                       (concat "(default " gnus-last-search-regexp ") "))))))
6746   (if (string-equal regexp "")
6747       (setq regexp (or gnus-last-search-regexp ""))
6748     (setq gnus-last-search-regexp regexp))
6749   (if (gnus-summary-search-article regexp t)
6750       (gnus-eval-in-buffer-window
6751        gnus-article-buffer
6752        (recenter 0))
6753     (error "Search failed: \"%s\"" regexp)))
6754
6755 (defun gnus-summary-search-article (regexp &optional backward)
6756   "Search for an article containing REGEXP.
6757 Optional argument BACKWARD means do search for backward.
6758 gnus-select-article-hook is not called during the search."
6759   (let ((gnus-select-article-hook nil)  ;Disable hook.
6760         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
6761         (re-search
6762          (if backward
6763              (function re-search-backward) (function re-search-forward)))
6764         (found nil)
6765         (last nil))
6766     ;; Hidden thread subtrees must be searched for ,too.
6767     (gnus-summary-show-all-threads)
6768     (if (eobp) (forward-line -1))
6769     ;; First of all, search current article.
6770     ;; We don't want to read article again from NNTP server nor reset
6771     ;; current point.
6772     (gnus-summary-select-article)
6773     (message "Searching article: %d..." gnus-current-article)
6774     (setq last gnus-current-article)
6775     (gnus-eval-in-buffer-window gnus-article-buffer
6776       (save-restriction
6777         (widen)
6778         ;; Begin search from current point.
6779         (setq found (funcall re-search regexp nil t))))
6780     ;; Then search next articles.
6781     (while (and (not found)
6782                 (gnus-summary-display-article 
6783                  (gnus-summary-search-subject backward nil nil)))
6784       (message "Searching article: %d..." gnus-current-article)
6785       (gnus-eval-in-buffer-window gnus-article-buffer
6786         (save-restriction
6787           (widen)
6788           (goto-char (if backward (point-max) (point-min)))
6789           (setq found (funcall re-search regexp nil t)))))
6790     (message "")
6791     ;; Adjust article pointer.
6792     (or (eq last gnus-current-article)
6793         (setq gnus-last-article last))
6794     ;; Return T if found such article.
6795     found))
6796
6797 (defun gnus-summary-execute-command (field regexp command &optional backward)
6798   "If FIELD of article header matches REGEXP, execute a COMMAND string.
6799 If FIELD is an empty string (or nil), entire article body is searched for.
6800 If optional (prefix) argument BACKWARD is non-nil, do backward instead."
6801   (interactive
6802    (list (let ((completion-ignore-case t))
6803            (completing-read "Field name: "
6804                             '(("Number")("Subject")("From")
6805                               ("Lines")("Date")("Message-ID")
6806                               ("Xref")("References"))
6807                             nil 'require-match))
6808          (read-string "Regexp: ")
6809          (read-key-sequence "Command: ")
6810          current-prefix-arg))
6811   ;; Hidden thread subtrees must be searched for ,too.
6812   (gnus-summary-show-all-threads)
6813   ;; We don't want to change current point nor window configuration.
6814   (save-excursion
6815     (save-window-excursion
6816       (message "Executing %s..." (key-description command))
6817       ;; We'd like to execute COMMAND interactively so as to give arguments.
6818       (gnus-execute field regexp
6819                     (` (lambda ()
6820                          (call-interactively '(, (key-binding command)))))
6821                     backward)
6822       (message "Executing %s... done" (key-description command)))))
6823
6824 (defun gnus-summary-beginning-of-article ()
6825   "Scroll the article back to the beginning."
6826   (interactive)
6827   (gnus-summary-select-article)
6828   (gnus-eval-in-buffer-window
6829    gnus-article-buffer
6830    (widen)
6831    (goto-char (point-min))
6832    (and gnus-break-pages (gnus-narrow-to-page))))
6833
6834 (defun gnus-summary-end-of-article ()
6835   "Scroll to the end of the article."
6836   (interactive)
6837   (gnus-summary-select-article)
6838   (gnus-eval-in-buffer-window 
6839    gnus-article-buffer
6840    (widen)
6841    (goto-char (point-max))
6842    (and gnus-break-pages (gnus-narrow-to-page))))
6843
6844 (defun gnus-summary-show-article ()
6845   "Force re-fetching of the current article."
6846   (interactive)
6847   (gnus-summary-select-article gnus-have-all-headers t t))
6848
6849 (defun gnus-summary-toggle-header (arg)
6850   "Show the headers if they are hidden, or hide them if they are shown.
6851 If ARG is a positive number, show the entire header.
6852 If ARG is a negative number, hide the unwanted header lines."
6853   (interactive "P")
6854   (gnus-set-global-variables)
6855   (save-excursion
6856     (set-buffer gnus-article-buffer)
6857     (let ((buffer-read-only nil))
6858       (if (numberp arg) 
6859           (if (> arg 0) (remove-text-properties 1 (point-max) '(invisible t))
6860             (if (< arg 0) (run-hooks 'gnus-article-display-hook)))
6861         (if (text-property-any 1 (point-max) 'invisible t)
6862             (remove-text-properties 1 (point-max) '(invisible t))
6863           (let ((gnus-have-all-headers nil))
6864             (run-hooks 'gnus-article-display-hook)))))))
6865
6866 (defun gnus-summary-show-all-headers ()
6867   "Make all header lines visible."
6868   (interactive)
6869   (gnus-article-show-all-headers))
6870
6871 (defun gnus-summary-toggle-mime (arg)
6872   "Toggle MIME processing.
6873 If ARG is a positive number, turn MIME processing on."
6874   (interactive "P")
6875   (setq gnus-show-mime
6876         (if (null arg) (not gnus-show-mime)
6877           (> (prefix-numeric-value arg) 0)))
6878   (gnus-summary-select-article t 'force))
6879
6880 (defun gnus-summary-caesar-message (rotnum)
6881   "Caesar rotates all letters of current message by 13/47 places.
6882 With prefix arg, specifies the number of places to rotate each letter forward.
6883 Caesar rotates Japanese letters by 47 places in any case."
6884   (interactive "P")
6885   (gnus-summary-select-article)
6886   (let ((mail-header-separator "")) ; !!! Is this necessary?
6887     (gnus-overload-functions)
6888     (gnus-eval-in-buffer-window 
6889      gnus-article-buffer
6890      (save-restriction
6891        (widen)
6892        ;; We don't want to jump to the beginning of the message.
6893        ;; `save-excursion' does not do its job.
6894        (move-to-window-line 0)
6895        (let ((last (point)))
6896          (news-caesar-buffer-body rotnum)
6897          (goto-char last)
6898          (recenter 0))))))
6899
6900 (defun gnus-summary-stop-page-breaking ()
6901   "Stop page breaking in the current article."
6902   (interactive)
6903   (gnus-summary-select-article)
6904   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
6905
6906 ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
6907
6908 (defun gnus-summary-move-article (n &optional to-newsgroup select-method)
6909   "Move the current article to a different newsgroup.
6910 If N is a positive number, move the N next articles.
6911 If N is a negative number, move the N previous articles.
6912 If N is nil and any articles have been marked with the process mark,
6913 move those articles instead.
6914 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
6915 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
6916 re-spool using this method.
6917 For this function to work, both the current newsgroup and the
6918 newsgroup that you want to move to have to support the `request-move'
6919 and `request-accept' functions. (Ie. mail newsgroups at present.)"
6920   (interactive "P")
6921   (gnus-set-global-variables)
6922   (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)
6923       (error "The current newsgroup does not support article moving"))
6924   (let ((articles (gnus-summary-work-articles n))
6925         art-group)
6926     (if (and (not to-newsgroup) (not select-method))
6927         (setq to-newsgroup
6928               (completing-read 
6929                (format "Where do you want to move %s? "
6930                        (if (> (length articles) 1)
6931                            (format "these %d articles" (length articles))
6932                          "this article"))
6933                gnus-active-hashtb nil t 
6934                (gnus-group-real-prefix gnus-newsgroup-name))))
6935     (or (gnus-check-backend-function 'request-accept-article 
6936                                      (or select-method to-newsgroup))
6937         (error "%s does not support article moving" to-newsgroup))
6938     (message "Moving to %s: %s..." (or select-method to-newsgroup) articles)
6939     (while articles
6940       (if (setq art-group
6941                 (gnus-request-move-article 
6942                  (car articles)                   ; Article to move
6943                  gnus-newsgroup-name              ; From newsgrouo
6944                  (nth 1 (gnus-find-method-for-group 
6945                          gnus-newsgroup-name))    ; Server
6946                  (list 'gnus-request-accept-article 
6947                        (if select-method
6948                            (quote select-method)
6949                          to-newsgroup)
6950                        (not (cdr articles)))     ; Accept form
6951                  (not (cdr articles))))          ; Only save nov last time
6952           (let* ((buffer-read-only nil)
6953                  (entry 
6954                   (or
6955                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
6956                    (gnus-gethash 
6957                     (gnus-group-prefixed-name 
6958                      (car art-group) 
6959                      (if select-method (list select-method "")
6960                        (gnus-find-method-for-group to-newsgroup)))
6961                     gnus-newsrc-hashtb)))
6962                  (info (nth 2 entry))
6963                  (article (car articles))
6964                  (marked (nth 3 info)))
6965             (gnus-summary-goto-subject article)
6966             (delete-region (progn (beginning-of-line) (point))
6967                            (progn (forward-line 1) (point)))
6968             (if (not (memq article gnus-newsgroup-unreads))
6969                 (setcar (cdr (cdr info))
6970                         (gnus-add-to-range (nth 2 info) 
6971                                            (list (cdr art-group)))))
6972             ;; !!! Here one should copy all the marks over to the new
6973             ;; newsgroup, but I couldn't be bothered. nth on that!
6974             )
6975         (message "Couldn't move article %s" (car articles)))
6976       (gnus-summary-remove-process-mark (car articles))
6977       (setq articles (cdr articles)))))
6978
6979 (defun gnus-summary-respool-article (n &optional respool-method)
6980   "Respool the current article.
6981 The article will be squeezed through the mail spooling process again,
6982 which means that it will be put in some mail newsgroup or other
6983 depending on `nnmail-split-methods'.
6984 If N is a positive number, respool the N next articles.
6985 If N is a negative number, respool the N previous articles.
6986 If N is nil and any articles have been marked with the process mark,
6987 respool those articles instead.
6988 For this function to work, both the current newsgroup and the
6989 newsgroup that you want to move to have to support the `request-move'
6990 and `request-accept' functions. (Ie. mail newsgroups at present.)"
6991   (interactive "P")
6992   (gnus-set-global-variables)
6993   (or respool-method
6994       (setq respool-method
6995             (completing-read
6996              "What method do you want to use when respooling? "
6997              (gnus-methods-using 'respool) nil t)))
6998   (gnus-summary-move-article n nil (intern respool-method)))
6999
7000 ;; Suggested by gregj@unidata.com (Gregory J. Grubbs).
7001 (defun gnus-summary-copy-article (n &optional to-newsgroup select-method)
7002   "Move the current article to a different newsgroup.
7003 If N is a positive number, move the N next articles.
7004 If N is a negative number, move the N previous articles.
7005 If N is nil and any articles have been marked with the process mark,
7006 move those articles instead.
7007 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
7008 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
7009 re-spool using this method.
7010 For this function to work, the newsgroup that you want to move to have
7011 to support the `request-move' and `request-accept'
7012 functions. (Ie. mail newsgroups at present.)"
7013   (interactive "P")
7014   (gnus-set-global-variables)
7015   (let ((articles (gnus-summary-work-articles n))
7016         (copy-buf (get-buffer-create "*copy work*"))
7017         art-group)
7018     (buffer-disable-undo copy-buf)
7019     (if (and (not to-newsgroup) (not select-method))
7020         (setq to-newsgroup
7021               (completing-read 
7022                (format "Where do you want to copy %s? "
7023                        (if (> (length articles) 1)
7024                            (format "these %d articles" (length articles))
7025                          "this article"))
7026                gnus-active-hashtb nil t 
7027                (gnus-group-real-prefix gnus-newsgroup-name))))
7028     (or (gnus-check-backend-function 'request-accept-article 
7029                                      (or select-method to-newsgroup))
7030         (error "%s does not support article copying" to-newsgroup))
7031     (message "Moving to %s: %s..." (or select-method to-newsgroup) articles)
7032     (while articles
7033       (if (setq art-group
7034                 (save-excursion
7035                   (set-buffer copy-buf)
7036                   (gnus-request-article-this-buffer
7037                    (car articles) gnus-newsgroup-name)
7038                   (gnus-request-accept-article
7039                    (if select-method (quote select-method) to-newsgroup)
7040                    (not (cdr articles)))))
7041           (let* ((entry 
7042                   (or
7043                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
7044                    (gnus-gethash 
7045                     (gnus-group-prefixed-name 
7046                      (car art-group) 
7047                      (if select-method (list select-method "")
7048                        (gnus-find-method-for-group to-newsgroup)))
7049                     gnus-newsrc-hashtb)))
7050                  (info (nth 2 entry))
7051                  (article (car articles))
7052                  (marked (nth 3 info)))
7053             (if (not (memq article gnus-newsgroup-unreads))
7054                 (setcar (cdr (cdr info))
7055                         (gnus-add-to-range (nth 2 info) 
7056                                            (list (cdr art-group)))))
7057             ;; !!! Here one should copy all the marks over to the new
7058             ;; newsgroup, but I couldn't be bothered. nth on that!
7059             )
7060         (message "Couldn't copy article %s" (car articles)))
7061       (gnus-summary-remove-process-mark (car articles))
7062       (setq articles (cdr articles)))
7063     (kill-buffer copy-buf)))
7064       
7065
7066 ;; Summary score commands.
7067
7068 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
7069
7070 (defun gnus-summary-raise-score (n)
7071   "Raise the score of the current article by N."
7072   (interactive "p")
7073   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
7074
7075 (defun gnus-summary-lower-score (n)
7076   "Lower the score of the current article by N."
7077   (interactive "p")
7078   (gnus-summary-raise-score (- n)))
7079
7080 (defun gnus-summary-set-score (n)
7081   "Set the score of the current article to N."
7082   (interactive "p")
7083   ;; Skip dummy header line.
7084   (save-excursion
7085     (if (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7086     (let ((buffer-read-only nil))
7087       ;; Set score.
7088       (gnus-summary-update-mark
7089        (if (= n (or gnus-summary-default-score 0)) ? 
7090          (if (< n (or gnus-summary-default-score 0)) 
7091              gnus-score-below-mark gnus-score-over-mark)) 'score))
7092     (let* ((article (gnus-summary-article-number))
7093            (score (assq article gnus-newsgroup-scored)))
7094       (if score (setcdr score n)
7095         (setq gnus-newsgroup-scored 
7096               (cons (cons article n) gnus-newsgroup-scored))))
7097     (gnus-summary-update-line)))
7098
7099 (defmacro gnus-raise (field expression level)
7100   (` (gnus-kill (, field) (, expression)
7101                 (function (gnus-summary-raise-score (, level))) t)))
7102
7103 (defmacro gnus-lower (field expression level)
7104   (` (gnus-kill (, field) (, expression)
7105                 (function (gnus-summary-raise-score (- (, level)))) t)))
7106
7107 ;; Summary marking commands.
7108
7109 (defun gnus-summary-raise-same-subject-and-select (score)
7110   "Raise articles which has the same subject with SCORE and select the next."
7111   (interactive "p")
7112   (let ((subject (gnus-summary-subject-string)))
7113     (gnus-summary-raise-score score)
7114     (while (gnus-summary-search-subject nil nil subject)
7115       (gnus-summary-raise-score score))
7116     (gnus-summary-next-article t)))
7117
7118 (defun gnus-summary-raise-same-subject (score)
7119   "Raise articles which has the same subject with SCORE."
7120   (interactive "p")
7121   (let ((subject (gnus-summary-subject-string)))
7122     (gnus-summary-raise-score score)
7123     (while (gnus-summary-search-subject nil nil subject)
7124       (gnus-summary-raise-score score))
7125     (gnus-summary-next-subject 1 t)))
7126
7127 (defun gnus-summary-raise-thread (score)
7128   "Raise articles under current thread with SCORE."
7129   (interactive "p")
7130   (let (e)
7131     (save-excursion
7132       (let ((level (gnus-summary-thread-level)))
7133         (gnus-summary-raise-score score)
7134         (while (and (zerop (gnus-summary-next-subject 1))
7135                     (> (gnus-summary-thread-level) level))
7136           (gnus-summary-raise-score score))
7137         (setq e (point))))
7138     (or (zerop (gnus-summary-next-subject 1 t))
7139         (goto-char e)))
7140   (gnus-summary-position-cursor)
7141   (gnus-set-mode-line 'summary))
7142
7143 (defun gnus-summary-lower-same-subject-and-select (score)
7144   "Raise articles which has the same subject with SCORE and select the next."
7145   (interactive "p")
7146   (gnus-summary-raise-same-subject-and-select (- score)))
7147
7148 (defun gnus-summary-lower-same-subject (score)
7149   "Raise articles which has the same subject with SCORE."
7150   (interactive "p")
7151   (gnus-summary-raise-same-subject (- score)))
7152
7153 (defun gnus-summary-lower-thread (score)
7154   "Raise articles under current thread with SCORE."
7155   (interactive "p")
7156   (gnus-summary-raise-thread (- score)))
7157
7158 (defun gnus-summary-kill-same-subject-and-select (unmark)
7159   "Mark articles which has the same subject as read, and then select the next.
7160 If UNMARK is positive, remove any kind of mark.
7161 If UNMARK is negative, tick articles."
7162   (interactive "P")
7163   (if unmark
7164       (setq unmark (prefix-numeric-value unmark)))
7165   (let ((count
7166          (gnus-summary-mark-same-subject
7167           (gnus-summary-subject-string) unmark)))
7168     ;; Select next unread article. If auto-select-same mode, should
7169     ;; select the first unread article.
7170     (gnus-summary-next-article t (and gnus-auto-select-same
7171                                       (gnus-summary-subject-string)))
7172     (message "%d articles are marked as %s"
7173              count (if unmark "unread" "read"))))
7174
7175 (defun gnus-summary-kill-same-subject (unmark)
7176   "Mark articles which has the same subject as read. 
7177 If UNMARK is positive, remove any kind of mark.
7178 If UNMARK is negative, tick articles."
7179   (interactive "P")
7180   (if unmark
7181       (setq unmark (prefix-numeric-value unmark)))
7182   (let ((count
7183          (gnus-summary-mark-same-subject
7184           (gnus-summary-subject-string) unmark)))
7185     ;; If marked as read, go to next unread subject.
7186     (if (null unmark)
7187         ;; Go to next unread subject.
7188         (gnus-summary-next-subject 1 t))
7189     (message "%d articles are marked as %s"
7190              count (if unmark "unread" "read"))))
7191
7192 (defun gnus-summary-mark-same-subject (subject &optional unmark)
7193   "Mark articles with same SUBJECT as read, and return marked number.
7194 If optional argument UNMARK is positive, remove any kinds of marks.
7195 If optional argument UNMARK is negative, mark articles as unread instead."
7196   (let ((count 1))
7197     (save-excursion
7198       (cond ((null unmark)
7199              (gnus-summary-mark-as-read nil gnus-killed-mark))
7200             ((> unmark 0)
7201              (gnus-summary-tick-article nil t))
7202             (t
7203              (gnus-summary-tick-article)))
7204       (while (and subject
7205                   (gnus-summary-search-forward nil subject))
7206         (cond ((null unmark)
7207                (gnus-summary-mark-as-read nil gnus-killed-mark))
7208               ((> unmark 0)
7209                (gnus-summary-tick-article nil t))
7210               (t
7211                (gnus-summary-tick-article)))
7212         (setq count (1+ count))))
7213     ;; Hide killed thread subtrees.  Does not work properly always.
7214     ;;(and (null unmark)
7215     ;;     gnus-thread-hide-killed
7216     ;;     (gnus-summary-hide-thread))
7217     ;; Return number of articles marked as read.
7218     count))
7219
7220 (defun gnus-summary-mark-as-processable (n &optional unmark)
7221   "Set the process mark on the next N articles.
7222 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
7223 the process mark instead.  The difference between N and the actual
7224 number of articles marked is returned."
7225   (interactive "p")
7226   (let ((backward (< n 0))
7227         (n (abs n)))
7228   (while (and 
7229           (> n 0)
7230           (if unmark
7231               (gnus-summary-remove-process-mark (gnus-summary-article-number))
7232             (gnus-summary-set-process-mark (gnus-summary-article-number)))
7233           (zerop (gnus-summary-next-subject (if backward -1 1))))
7234     (setq n (1- n)))
7235   (if (/= 0 n) (message "No more articles"))
7236   n))
7237
7238 (defun gnus-summary-unmark-as-processable (n)
7239   "Remove the process mark from the next N articles.
7240 If N is negative, mark backward instead.  The difference between N and
7241 the actual number of articles marked is returned."
7242   (interactive "p")
7243   (gnus-summary-mark-as-processable n t))
7244
7245 (defun gnus-summary-unmark-all-processable ()
7246   "Remove the process mark from all articles."
7247   (interactive)
7248   (save-excursion
7249     (while gnus-newsgroup-processable
7250       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
7251   (gnus-summary-position-cursor))
7252
7253 (defun gnus-summary-mark-as-expirable (n)
7254   "Mark N articles forward as expirable.
7255 If N is negative, mark backward instead. The difference between N and
7256 the actual number of articles marked is returned."
7257   (interactive "p")
7258   (gnus-summary-mark-forward n gnus-expirable-mark))
7259
7260 (defun gnus-summary-expire-articles ()
7261   "Expire all articles that are marked as expirable in the current group."
7262   (interactive)
7263   (if (and gnus-newsgroup-expirable
7264            (gnus-check-backend-function 
7265             'request-expire-articles gnus-newsgroup-name))
7266       (let ((expirable gnus-newsgroup-expirable))
7267         ;; The list of articles that weren't expired is returned.
7268         (setq gnus-newsgroup-expirable 
7269               (gnus-request-expire-articles gnus-newsgroup-expirable
7270                                             gnus-newsgroup-name))
7271         ;; We go through the old list of expirable, and mark all
7272         ;; really expired articles as non-existant.
7273         (while expirable
7274           (or (memq (car expirable) gnus-newsgroup-expirable)
7275               (gnus-summary-mark-as-read (car expirable) "%"))
7276           (setq expirable (cdr expirable))))))
7277
7278 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
7279 (defun gnus-summary-delete-article (n)
7280   "Delete the N next (mail) articles.
7281 This command actually deletes articles. This is not a marking
7282 command. The article will disappear forever from you life, never to
7283 return. 
7284 If N is negative, delete backwards.
7285 If N is nil and articles have been marked with the process mark,
7286 delete these instead."
7287   (interactive "P")
7288   (or (gnus-check-backend-function 'request-expire-articles 
7289                                    gnus-newsgroup-name)
7290       (error "The current newsgroup does not support article deletion."))
7291   ;; Compute the list of articles to delete.
7292   (let (articles)
7293     (if (and n (numberp n))
7294         (let ((backward (< n 0))
7295               (n (abs n)))
7296           (save-excursion
7297             (while (and (> n 0)
7298                         (setq articles (cons (gnus-summary-article-number) 
7299                                              articles))
7300                         (gnus-summary-search-forward nil nil backward))
7301               (setq n (1- n))))
7302           (setq articles (sort articles (function <))))
7303       (setq articles (or (setq gnus-newsgroup-processable
7304                                (sort gnus-newsgroup-processable (function <)))
7305                          (list (gnus-summary-article-number)))))
7306     (if (and gnus-novice-user
7307              (not (gnus-y-or-n-p 
7308                    (format "Do you really want to delete %s forever? "
7309                            (if (> (length articles) 1) "these articles"
7310                              "this article")))))
7311         ()
7312       ;; Delete the articles.
7313       (setq gnus-newsgroup-expirable 
7314             (gnus-request-expire-articles 
7315              articles gnus-newsgroup-name 'force))
7316       (while articles
7317         (gnus-summary-mark-as-read (car articles) gnus-canceled-mark)
7318         (setq articles (cdr articles))))))
7319
7320 (defun gnus-summary-edit-article ()
7321   "Enter into a buffer and edit the current article.
7322 This will have permanent effect only in mail groups."
7323   (interactive)
7324   (or (gnus-check-backend-function 
7325        'request-replace-article gnus-newsgroup-name)
7326       (error "The current newsgroup does not support article editing."))
7327   (gnus-summary-select-article t)
7328   (other-window 1)
7329   (message "C-c C-c to end edits")
7330   (setq buffer-read-only nil)
7331   (text-mode)
7332   (use-local-map (copy-keymap (current-local-map)))
7333   (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
7334   (goto-char 1)
7335   (search-forward "\n\n" nil t))
7336
7337 (defun gnus-summary-edit-article-done ()
7338   "Make edits to the current article permanent."
7339   (interactive)
7340   (if (not (gnus-request-replace-article 
7341             (cdr gnus-article-current) (car gnus-article-current) 
7342             (current-buffer)))
7343       (error "Couldn't replace article.")
7344     (gnus-article-mode)
7345     (use-local-map gnus-article-mode-map)
7346     (setq buffer-read-only t)
7347     (pop-to-buffer gnus-summary-buffer)))
7348
7349 (defun gnus-summary-mark-article-as-replied (article)
7350   "Mark ARTICLE replied and update the summary line."
7351   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
7352   (let ((buffer-read-only nil))
7353     (if (gnus-summary-goto-subject article)
7354         (progn
7355           (gnus-summary-update-mark gnus-replied-mark 'replied)
7356           t))))
7357
7358 (defun gnus-summary-set-bookmark (article)
7359   "Set a bookmark in current article."
7360   (interactive (list (gnus-summary-article-number)))
7361   (if (or (not (get-buffer gnus-article-buffer))
7362           (not gnus-current-article)
7363           (not gnus-article-current)
7364           (not (equal gnus-newsgroup-name (car gnus-article-current))))
7365       (error "No current article selected"))
7366   ;; Remove old bookmark, if one exists.
7367   (let ((old (assq article gnus-newsgroup-bookmarks)))
7368     (if old (setq gnus-newsgroup-bookmarks 
7369                   (delq old gnus-newsgroup-bookmarks))))
7370   ;; Set the new bookmark, which is on the form 
7371   ;; (article-number . line-number-in-body).
7372   (setq gnus-newsgroup-bookmarks 
7373         (cons 
7374          (cons article 
7375                (save-excursion
7376                  (set-buffer gnus-article-buffer)
7377                  (count-lines
7378                   (min (point)
7379                        (save-excursion
7380                          (goto-char 1)
7381                          (search-forward "\n\n" nil t)
7382                          (point)))
7383                   (point))))
7384          gnus-newsgroup-bookmarks))
7385   (message "A bookmark has been added to the current article."))
7386
7387 (defun gnus-summary-remove-bookmark (article)
7388   "Remove the bookmark from the current article."
7389   (interactive (list (gnus-summary-article-number)))
7390   ;; Remove old bookmark, if one exists.
7391   (let ((old (assq article gnus-newsgroup-bookmarks)))
7392     (if old 
7393         (progn
7394           (setq gnus-newsgroup-bookmarks 
7395                 (delq old gnus-newsgroup-bookmarks))
7396           (message "Removed bookmark."))
7397       (message "No bookmark in current article."))))
7398
7399 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
7400 (defun gnus-summary-mark-as-dormant (n)
7401   "Mark N articles forward as dormant.
7402 If N is negative, mark backward instead.  The difference between N and
7403 the actual number of articles marked is returned."
7404   (interactive "p")
7405   (gnus-summary-mark-forward n gnus-dormant-mark))
7406
7407 (defun gnus-summary-set-process-mark (article)
7408   "Set the process mark on ARTICLE and update the summary line."
7409   (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable))
7410   (let ((buffer-read-only nil))
7411     (if (gnus-summary-goto-subject article)
7412         (progn
7413           (if (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7414           (gnus-summary-update-mark gnus-process-mark 'replied)
7415           t))))
7416
7417 (defun gnus-summary-remove-process-mark (article)
7418   "Remove the process mark from ARTICLE and update the summary line."
7419   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
7420   (let ((buffer-read-only nil))
7421     (if (gnus-summary-goto-subject article)
7422         (progn
7423           (and (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7424           (gnus-summary-update-mark ?  'replied)
7425           (if (memq article gnus-newsgroup-replied) 
7426               (gnus-summary-update-mark gnus-replied-mark 'replied))
7427           t))))
7428
7429 (defun gnus-summary-mark-forward (n &optional mark)
7430   "Mark N articles as read forwards.
7431 If N is negative, mark backwards instead.
7432 Mark with MARK. If MARK is ? , ?! or ??, articles will be
7433 marked as unread. 
7434 The difference between N and the actual number of articles marked is
7435 returned."
7436   (interactive "p")
7437   (gnus-set-global-variables)
7438   (let ((backward (< n 0))
7439         (n (abs n))
7440         (mark (or mark gnus-dread-mark)))
7441   (while (and (> n 0)
7442               (gnus-summary-mark-article nil mark)
7443               (zerop (gnus-summary-next-subject 
7444                       (if backward -1 1) gnus-summary-goto-unread)))
7445     (setq n (1- n)))
7446   (if (/= 0 n) (message "No more %sarticles" (if mark "" "unread ")))
7447   (gnus-set-mode-line 'summary)
7448   n))
7449
7450 (defun gnus-summary-mark-article (&optional article mark)
7451   "Mark ARTICLE with MARK.
7452 MARK can be any character.
7453 Five MARK strings are reserved: ?  (unread), 
7454 ?! (ticked), ?? (dormant), ?D (read), ?E (expirable).
7455 If MARK is nil, then the default character ?D is used.
7456 If ARTICLE is nil, then the article on the current line will be
7457 marked." 
7458   ;; If no mark is given, then we check auto-expiring.
7459   (and (or (not mark)
7460            (and (numberp mark) (or (= mark gnus-killed-mark)
7461                                    (= mark gnus-dread-mark)
7462                                    (= mark gnus-catchup-mark)
7463                                    (= mark gnus-low-score-mark)
7464                                    (= mark gnus-read-mark))))
7465        gnus-newsgroup-auto-expire 
7466        (setq mark gnus-expirable-mark))
7467   (let* ((buffer-read-only nil)
7468          (mark (or (and (stringp mark) (aref mark 0)) mark gnus-dread-mark))
7469          (article (or article (gnus-summary-article-number))))
7470     (if (or (= mark gnus-unread-mark) 
7471             (= mark gnus-ticked-mark) 
7472             (= mark gnus-dormant-mark))
7473         (gnus-mark-article-as-unread article mark)
7474       (gnus-mark-article-as-read article mark))
7475     (if (gnus-summary-goto-subject article)
7476         (progn
7477           (gnus-summary-show-thread)
7478           (beginning-of-line)
7479           (if (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7480           ;; Fix the mark.
7481           (gnus-summary-update-mark mark 'unread)
7482           t))))
7483
7484 (defun gnus-summary-update-mark (mark type)
7485   (beginning-of-line)
7486   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
7487         plist)
7488     (if (not forward)
7489         ()
7490       (forward-char forward)
7491       (setq plist (text-properties-at (point)))
7492       (delete-char 1)
7493       (and (memq 'gnus-mark plist) (setcar (cdr (memq 'gnus-mark plist)) mark))
7494       (insert mark)
7495       (and plist (add-text-properties (1- (point)) (point) plist))
7496       (gnus-summary-update-line (eq mark gnus-unread-mark)))))
7497   
7498 (defun gnus-mark-article-as-read (article &optional mark)
7499   "Enter ARTICLE in the pertinent lists and remove it from others."
7500   ;; Make the article expirable.
7501   (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-dread-mark)))
7502     (if (= mark gnus-expirable-mark)
7503         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
7504       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
7505     ;; Remove from unread and marked lists.
7506     (setq gnus-newsgroup-unreads
7507           (delq article gnus-newsgroup-unreads))
7508     (setq gnus-newsgroup-marked
7509           (delq article gnus-newsgroup-marked))
7510     (setq gnus-newsgroup-dormant
7511           (delq article gnus-newsgroup-dormant))))
7512
7513 (defun gnus-mark-article-as-unread (article &optional mark)
7514   "Enter ARTICLE in the pertinent lists and remove it from others."
7515   (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-ticked-mark)))
7516     ;; Add to unread list.
7517     (or (memq article gnus-newsgroup-unreads)
7518         (setq gnus-newsgroup-unreads
7519               (cons article gnus-newsgroup-unreads)))
7520     ;; If CLEAR-MARK is non-nil, the article must be removed from marked
7521     ;; list.  Otherwise, it must be added to the list.
7522     (setq gnus-newsgroup-marked
7523           (delq article gnus-newsgroup-marked))
7524     (setq gnus-newsgroup-dormant
7525           (delq article gnus-newsgroup-dormant))
7526     (setq gnus-newsgroup-expirable 
7527           (delq article gnus-newsgroup-expirable))
7528     (if (= mark gnus-ticked-mark)
7529         (setq gnus-newsgroup-marked 
7530               (cons article gnus-newsgroup-marked)))
7531     (if (= mark gnus-dormant-mark)
7532         (setq gnus-newsgroup-dormant 
7533               (cons article gnus-newsgroup-dormant)))))
7534
7535 (defalias 'gnus-summary-mark-as-unread-forward 
7536   'gnus-summary-tick-article-forward)
7537 (make-obsolete 'gnus-summary-mark-as-unread-forward 
7538                'gnus-summary-tick-article-forward)
7539 (defun gnus-summary-tick-article-forward (n)
7540   "Tick N articles forwards.
7541 If N is negative, tick backwards instead.
7542 The difference between N and the number of articles ticked is returned."
7543   (interactive "p")
7544   (gnus-summary-mark-forward n gnus-ticked-mark))
7545
7546 (defalias 'gnus-summary-mark-as-unread-backward 
7547   'gnus-summary-tick-article-backward)
7548 (make-obsolete 'gnus-summary-mark-as-unread-backward 
7549                'gnus-summary-tick-article-backward)
7550 (defun gnus-summary-tick-article-backward (n)
7551   "Tick N articles backwards.
7552 The difference between N and the number of articles ticked is returned."
7553   (interactive "p")
7554   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
7555
7556 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
7557 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
7558 (defun gnus-summary-tick-article (&optional article clear-mark)
7559   "Mark current article as unread.
7560 Optional 1st argument ARTICLE specifies article number to be marked as unread.
7561 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
7562   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
7563                                        gnus-ticked-mark)))
7564
7565 (defun gnus-summary-mark-as-read-forward (n)
7566   "Mark N articles as read forwards.
7567 If N is negative, mark backwards instead.
7568 The difference between N and the actual number of articles marked is
7569 returned."
7570   (interactive "p")
7571   (gnus-summary-mark-forward n))
7572
7573 (defun gnus-summary-mark-as-read-backward (n)
7574   "Mark the N articles as read backwards.
7575 The difference between N and the actual number of articles marked is
7576 returned."
7577   (interactive "p")
7578   (gnus-summary-mark-forward (- n)))
7579
7580 (defun gnus-summary-mark-as-read (&optional article mark)
7581   "Mark current article as read.
7582 ARTICLE specifies the article to be marked as read.
7583 MARK specifies a string to be inserted at the beginning of the line.
7584 Any kind of string (length 1) except for a space and `-' is ok."
7585   (gnus-summary-mark-article article mark))
7586
7587 (defun gnus-summary-clear-mark-forward (n)
7588   "Clear marks from N articles forward.
7589 If N is negative, clear backward instead.
7590 The difference between N and the number of marks cleared is returned."
7591   (interactive "p")
7592   (gnus-summary-mark-forward n gnus-unread-mark))
7593
7594 (defun gnus-summary-clear-mark-backward (n)
7595   "Clear marks from N articles backward.
7596 The difference between N and the number of marks cleared is returned."
7597   (interactive "p")
7598   (gnus-summary-mark-forward (- n) gnus-unread-mark))
7599
7600 (defun gnus-summary-mark-unread-as-read ()
7601   "Intended to be used by `gnus-summary-mark-article-hook'."
7602   (or (memq gnus-current-article gnus-newsgroup-marked)
7603       (memq gnus-current-article gnus-newsgroup-dormant)
7604       (memq gnus-current-article gnus-newsgroup-expirable)
7605       (gnus-summary-mark-as-read gnus-current-article gnus-read-mark)))
7606
7607 ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
7608 (defalias 'gnus-summary-delete-marked-as-read 
7609   'gnus-summary-remove-lines-marked-as-read)
7610 (make-obsolete 'gnus-summary-delete-marked-as-read 
7611                'gnus-summary-remove-lines-marked-as-read)
7612 (defun gnus-summary-remove-lines-marked-as-read ()
7613   "Remove lines that are marked as read."
7614   (interactive)
7615   (gnus-summary-remove-lines-marked-with 
7616    (concat (mapconcat
7617             (lambda (char) (char-to-string (symbol-value char)))
7618             '(gnus-dread-mark gnus-read-mark
7619               gnus-killed-mark gnus-kill-file-mark
7620               gnus-low-score-mark gnus-expirable-mark)
7621             ""))))
7622
7623 (defalias 'gnus-summary-delete-marked-with 
7624   'gnus-summary-remove-lines-marked-with)
7625 (make-obsolete 'gnus-summary-delete-marked-with 
7626                'gnus-summary-remove-lines-marked-with)
7627 ;; Rewrite by Daniel Quinlan <quinlan@best.com>.
7628 (defun gnus-summary-remove-lines-marked-with (marks)
7629   "Remove lines that are marked with MARKS (e.g. \"DK\")."
7630   (interactive "sMarks: ")
7631   ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
7632   (save-excursion
7633     (set-buffer gnus-summary-buffer)
7634     (let ((buffer-read-only nil)
7635           (marks (concat "^[" marks "]")))
7636       (goto-char (point-min))
7637       (while (search-forward-regexp marks (point-max) t)
7638         (delete-region (progn (beginning-of-line) (point))
7639                        (progn (forward-line 1) (point)))))
7640     (or (zerop (buffer-size))
7641         (if (eobp)
7642             (gnus-summary-prev-subject 1)
7643           (gnus-summary-position-cursor)))))
7644
7645 (defun gnus-summary-expunge-below (score)
7646   "Remove articles with score less than SCORE."
7647   (interactive "P")
7648   (setq score (if score
7649                   (prefix-numeric-value score)
7650                 (or gnus-summary-default-score 0)))
7651   (save-excursion
7652     (set-buffer gnus-summary-buffer)
7653     (goto-char (point-min))
7654     (let ((buffer-read-only nil)
7655           beg)
7656       (while (not (eobp))
7657         (if (< (gnus-summary-article-score) score)
7658             (progn
7659               (setq beg (point))
7660               (forward-line 1)
7661               (delete-region beg (point)))
7662           (forward-line 1)))
7663       ;; Adjust point.
7664       (or (zerop (buffer-size))
7665           (if (eobp)
7666               (gnus-summary-prev-subject 1)
7667             (gnus-summary-position-cursor))))))
7668
7669 (defun gnus-summary-mark-below (score mark)
7670   "Mark articles with score less than SCORE with MARK."
7671   (interactive "P\ncMark: ")
7672   (setq score (if score
7673                   (prefix-numeric-value score)
7674                 (or gnus-summary-default-score 0)))
7675   (save-excursion
7676     (set-buffer gnus-summary-buffer)
7677     (goto-char (point-min))
7678     (while (not (eobp))
7679       (and (< (gnus-summary-article-score) score)
7680            (gnus-summary-mark-article nil mark))
7681       (forward-line 1))))
7682
7683 (defun gnus-summary-kill-below (score)
7684   "Mark articles with score below SCORE as read."
7685   (interactive "P")
7686   (gnus-summary-mark-below score gnus-killed-mark))
7687
7688 (defun gnus-summary-clear-above (score)
7689   "Clear all marks from articles with score above SCORE."
7690   (interactive "P")
7691   (gnus-summary-mark-above score gnus-unread-mark))
7692
7693 (defun gnus-summary-tick-above (score)
7694   "Tick all articles with score above SCORE."
7695   (interactive "P")
7696   (gnus-summary-mark-above score gnus-ticked-mark))
7697
7698 (defun gnus-summary-mark-above (score mark)
7699   "Mark articles with score over SCORE with MARK."
7700   (interactive "P\ncMark: ")
7701   (setq score (if score
7702                   (prefix-numeric-value score)
7703                 (or gnus-summary-default-score 0)))
7704   (save-excursion
7705     (set-buffer gnus-summary-buffer)
7706     (goto-char (point-min))
7707     (while (not (eobp))
7708       (if (> (gnus-summary-article-score) score)
7709           (progn
7710             (gnus-summary-mark-article nil mark)
7711             (forward-line 1))
7712         (forward-line 1)))))
7713
7714 ;; Suggested by Daniel Quinlan <quinlan@best.com>.  
7715 (defun gnus-summary-show-all-expunged ()
7716   "Display all the hidden articles that were expunged for low scores."
7717   (interactive)
7718   (let ((buffer-read-only nil))
7719     (let ((scored gnus-newsgroup-scored)
7720           headers h)
7721       (while scored
7722         (or (gnus-summary-goto-subject (car (car scored)))
7723             (and (setq h (gnus-get-header-by-number (car (car scored))))
7724                  (< (cdr (car scored)) gnus-summary-expunge-below)
7725                  (setq headers (cons h headers))))
7726         (setq scored (cdr scored)))
7727       (or headers (error "No expunged articles hidden."))
7728       (goto-char (point-min))
7729       (save-excursion 
7730         (gnus-summary-prepare-threads (nreverse headers) 0)))
7731     (goto-char (point-min))
7732     (gnus-summary-position-cursor)))
7733
7734 (defun gnus-summary-show-all-dormant ()
7735   "Display all the hidden articles that are marked as dormant."
7736   (interactive)
7737   (let ((buffer-read-only nil))
7738     (goto-char (point-min))
7739     (let ((dormant gnus-newsgroup-dormant)
7740           headers h)
7741       (while dormant
7742         (or (gnus-summary-goto-subject (car dormant))
7743             (and (setq h (gnus-get-header-by-number (car dormant)))
7744                  (setq headers (cons h headers))))
7745         (setq dormant (cdr dormant)))
7746       (or headers (error "No dormant articles hidden."))
7747       (save-excursion (gnus-summary-prepare-threads (nreverse headers) 0)))
7748     (goto-char (point-min))
7749     (gnus-summary-position-cursor)))
7750
7751 (defun gnus-summary-hide-all-dormant ()
7752   "Hide all dormant articles."
7753   (interactive)
7754   (gnus-summary-remove-lines-marked-with (char-to-string gnus-dormant-mark))
7755   (gnus-summary-position-cursor))
7756
7757 (defun gnus-summary-catchup (all &optional quietly to-here)
7758   "Mark all articles not marked as unread in this newsgroup as read.
7759 If prefix argument ALL is non-nil, all articles are marked as read.
7760 If QUIETLY is non-nil, no questions will be asked.
7761 If TO-HERE is non-nil, it should be a point in the buffer. All
7762 articles before this point will be marked as read.
7763 The number of articles marked as read is returned."
7764   (interactive "P")
7765   (prog1
7766       (if (or quietly
7767               (not gnus-interactive-catchup) ;Without confirmation?
7768               gnus-expert-user
7769               (gnus-y-or-n-p
7770                (if all
7771                    "Mark absolutely all articles as read? "
7772                  "Mark all unread articles as read? ")))
7773           (let ((unreads (length gnus-newsgroup-unreads)))
7774             (if (gnus-summary-first-subject (not all))
7775                 (while (and (gnus-summary-mark-as-read nil gnus-catchup-mark)
7776                             (if to-here (< (point) to-here) t)
7777                             (gnus-summary-search-subject nil (not all)))))
7778             (- unreads (length gnus-newsgroup-unreads))))
7779     (setq gnus-newsgroup-unreads gnus-newsgroup-marked)
7780     (gnus-summary-position-cursor)))
7781
7782 (defun gnus-summary-catchup-to-here (&optional all)
7783   "Mark all unticked articles before the current one as read.
7784 If ALL is non-nil, also mark ticked and dormant articles as read."
7785   (interactive)
7786   (beginning-of-line)
7787   (gnus-summary-catchup all t (point))
7788   (gnus-summary-position-cursor))
7789
7790 (defun gnus-summary-catchup-all (&optional quietly)
7791   "Mark all articles in this newsgroup as read."
7792   (interactive)
7793   (gnus-summary-catchup t quietly))
7794
7795 (defun gnus-summary-catchup-and-exit (all &optional quietly)
7796   "Mark all articles not marked as unread in this newsgroup as read, then exit.
7797 If prefix argument ALL is non-nil, all articles are marked as read."
7798   (interactive "P")
7799   (gnus-summary-catchup all quietly)
7800   ;; Select next newsgroup or exit.
7801   (if (eq gnus-auto-select-next 'quietly)
7802       (gnus-summary-next-group nil)
7803     (gnus-summary-exit)))
7804
7805 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
7806   "Mark all articles in this newsgroup as read, and then exit."
7807   (interactive)
7808   (gnus-summary-catchup-and-exit t quietly))
7809
7810 ;; Thread-based commands.
7811
7812 (defun gnus-summary-toggle-threads (arg)
7813   "Toggle showing conversation threads.
7814 If ARG is positive number, turn showing conversation threads on."
7815   (interactive "P")
7816   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
7817     (setq gnus-show-threads
7818           (if (null arg) (not gnus-show-threads)
7819             (> (prefix-numeric-value arg) 0)))
7820     (gnus-summary-prepare)
7821     (gnus-summary-goto-subject current)
7822     (gnus-summary-position-cursor)))
7823
7824 (defun gnus-summary-show-all-threads ()
7825   "Show all threads."
7826   (interactive)
7827   (save-excursion
7828     (let ((buffer-read-only nil))
7829       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
7830   (gnus-summary-position-cursor))
7831
7832 (defun gnus-summary-show-thread ()
7833   "Show thread subtrees.
7834 Returns nil if no thread was there to be shown."
7835   (interactive)
7836   (prog1
7837       (save-excursion
7838         (let ((buffer-read-only nil)
7839               (beg (progn (beginning-of-line) (point)))
7840               (end (save-excursion (end-of-line) (point))))
7841           (prog1
7842               ;; Any hidden lines here?
7843               (search-forward "\r" end t)
7844             (subst-char-in-region beg end ?\^M ?\n t))))
7845     (gnus-summary-position-cursor)))
7846
7847 (defun gnus-summary-hide-all-threads ()
7848   "Hide all thread subtrees."
7849   (interactive)
7850   (save-excursion
7851     (goto-char (point-min))
7852     (gnus-summary-hide-thread)
7853     (while (and (not (eobp)) (zerop (forward-line 1)))
7854       (gnus-summary-hide-thread)))
7855   (gnus-summary-position-cursor))
7856
7857 (defun gnus-summary-hide-thread ()
7858   "Hide thread subtrees.
7859 Returns nil if no threads were there to be hidden."
7860   (interactive)
7861   (let ((buffer-read-only nil)
7862         (start (point))
7863         (level (gnus-summary-thread-level))
7864         (end (point)))
7865     ;; Go forward until either the buffer ends or the subthread
7866     ;; ends. 
7867     (if (eobp)
7868         ()
7869       (while (and (zerop (forward-line 1))
7870                   (> (gnus-summary-thread-level) level))
7871         (setq end (point)))
7872       (prog1
7873           (save-excursion
7874             (goto-char end)
7875             (search-backward "\n" start t))
7876         (subst-char-in-region start end ?\n ?\^M t)
7877         (forward-line -1)))))
7878
7879 (defun gnus-summary-go-to-next-thread (&optional previous)
7880   "Go to the same level (or less) next thread.
7881 If PREVIOUS is non-nil, go to previous thread instead.
7882 Return the article number moved to, or nil if moving was impossible."
7883   (let ((level (gnus-summary-thread-level))
7884         (article (gnus-summary-article-number)))
7885     (if previous 
7886         (while (and (zerop (gnus-summary-prev-subject 1))
7887                     (> (gnus-summary-thread-level) level)))
7888       (while (and (zerop (gnus-summary-next-subject 1))
7889                   (> (gnus-summary-thread-level) level))))
7890     (let ((oart (gnus-summary-article-number)))
7891       (and (/= oart article) oart))))
7892
7893 (defun gnus-summary-next-thread (n)
7894   "Go to the same level next N'th thread.
7895 If N is negative, search backward instead.
7896 Returns the difference between N and the number of skips actually
7897 done."
7898   (interactive "p")
7899   (let ((backward (< n 0))
7900         (n (abs n)))
7901   (while (and (> n 0)
7902               (gnus-summary-go-to-next-thread backward))
7903     (setq n (1- n)))
7904   (gnus-summary-position-cursor)
7905   (if (/= 0 n) (message "No more threads"))
7906   n))
7907
7908 (defun gnus-summary-prev-thread (n)
7909   "Go to the same level previous N'th thread.
7910 Returns the difference between N and the number of skips actually
7911 done."
7912   (interactive "p")
7913   (gnus-summary-next-thread (- n)))
7914
7915 (defun gnus-summary-go-down-thread (&optional same)
7916   "Go down one level in the current thread.
7917 If SAME is non-nil, also move to articles of the same level."
7918   (let ((level (gnus-summary-thread-level))
7919         (start (point)))
7920     (if (and (zerop (forward-line 1))
7921              (> (gnus-summary-thread-level) level))
7922         t
7923       (goto-char start)
7924       nil)))
7925
7926 (defun gnus-summary-go-up-thread ()
7927   "Go up one level in the current thread."
7928   (let ((level (gnus-summary-thread-level))
7929         (start (point)))
7930     (while (and (zerop (forward-line -1))
7931                 (>= (gnus-summary-thread-level) level)))
7932     (if (>= (gnus-summary-thread-level) level)
7933         (progn
7934           (goto-char start)
7935           nil)
7936       t)))
7937
7938 (defun gnus-summary-down-thread (n)
7939   "Go down thread N steps.
7940 If N is negative, go up instead.
7941 Returns the difference between N and how many steps down that were
7942 taken."
7943   (interactive "p")
7944   (let ((up (< n 0))
7945         (n (abs n)))
7946   (while (and (> n 0)
7947               (if up (gnus-summary-go-up-thread)
7948                 (gnus-summary-go-down-thread)))
7949     (setq n (1- n)))
7950   (gnus-summary-position-cursor)
7951   (if (/= 0 n) (message "Can't go further"))
7952   n))
7953
7954 (defun gnus-summary-up-thread (n)
7955   "Go up thread N steps.
7956 If N is negative, go up instead.
7957 Returns the difference between N and how many steps down that were
7958 taken."
7959   (interactive "p")
7960   (gnus-summary-down-thread (- n)))
7961
7962 (defun gnus-summary-kill-thread (unmark)
7963   "Mark articles under current thread as read.
7964 If the prefix argument is positive, remove any kinds of marks.
7965 If the prefix argument is negative, tick articles instead."
7966   (interactive "P")
7967   (if unmark
7968       (setq unmark (prefix-numeric-value unmark)))
7969   (let ((killing t)
7970         (level (gnus-summary-thread-level)))
7971     (save-excursion
7972       (while killing
7973         ;; Mark the article...
7974         (cond ((null unmark) (gnus-summary-mark-as-read nil gnus-killed-mark))
7975               ((> unmark 0) (gnus-summary-tick-article nil t))
7976               (t (gnus-summary-tick-article)))
7977         ;; ...and go forward until either the buffer ends or the subtree
7978         ;; ends. 
7979         (if (not (and (zerop (forward-line 1))
7980                       (> (gnus-summary-thread-level) level)))
7981             (setq killing nil))))
7982     ;; Hide killed subtrees.
7983     (and (null unmark)
7984          gnus-thread-hide-killed
7985          (gnus-summary-hide-thread))
7986     ;; If marked as read, go to next unread subject.
7987     (if (null unmark)
7988         ;; Go to next unread subject.
7989         (gnus-summary-next-subject 1 t)))
7990   (gnus-set-mode-line 'summary))
7991
7992 ;; Summary sorting commands
7993
7994 (defun gnus-summary-sort-by-number (reverse)
7995   "Sort summary buffer by article number.
7996 Argument REVERSE means reverse order."
7997   (interactive "P")
7998   (gnus-summary-sort 'gnus-summary-article-number reverse))
7999
8000 (defun gnus-summary-sort-by-author (reverse)
8001   "Sort summary buffer by author name alphabetically.
8002 If case-fold-search is non-nil, case of letters is ignored.
8003 Argument REVERSE means reverse order."
8004   (interactive "P")
8005   (gnus-summary-sort
8006    (lambda ()
8007      (let ((extract (funcall
8008                      gnus-extract-address-components
8009                      (header-from (gnus-get-header-by-number
8010                                    (gnus-summary-article-number))))))
8011        (or (car extract) (cdr extract))))
8012    reverse))
8013
8014 (defun gnus-summary-sort-by-subject (reverse)
8015   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
8016 If case-fold-search is non-nil, case of letters is ignored.
8017 Argument REVERSE means reverse order."
8018   (interactive "P")
8019   (gnus-summary-sort
8020    (lambda ()
8021      (downcase (gnus-simplify-subject (gnus-summary-subject-string))))
8022    reverse))
8023
8024 (defun gnus-summary-sort-by-date (reverse)
8025   "Sort summary buffer by date.
8026 Argument REVERSE means reverse order."
8027   (interactive "P")
8028   (gnus-summary-sort
8029    (lambda ()
8030      (gnus-sortable-date
8031       (header-date (gnus-get-header-by-number (gnus-summary-article-number)))))
8032    reverse))
8033
8034 (defun gnus-summary-sort-by-score (reverse)
8035   "Sort summary buffer by score.
8036 Argument REVERSE means reverse order."
8037   (interactive "P")
8038   (gnus-summary-sort 'gnus-summary-article-score (not reverse)))
8039
8040 (defun gnus-summary-sort (predicate reverse)
8041   ;; Sort summary buffer by PREDICATE.  REVERSE means reverse order. 
8042   (let (buffer-read-only)
8043     (goto-char (point-min))
8044     (sort-subr reverse 'forward-line 'end-of-line predicate)))
8045
8046 (defun gnus-sortable-date (date)
8047   "Make sortable string by string-lessp from DATE.
8048 Timezone package is used."
8049   (let* ((date   (timezone-fix-time date nil nil)) ;[Y M D H M S]
8050          (year   (aref date 0))
8051          (month  (aref date 1))
8052          (day    (aref date 2)))
8053     (timezone-make-sortable-date 
8054      year month day 
8055      (timezone-make-time-string
8056       (aref date 3) (aref date 4) (aref date 5)))))
8057
8058
8059 ;; Summary saving commands.
8060
8061 (defun gnus-summary-save-article (n)
8062   "Save the current article using the default saver function.
8063 If N is a positive number, save the N next articles.
8064 If N is a negative number, save the N previous articles.
8065 If N is nil and any articles have been marked with the process mark,
8066 save those articles instead.
8067 The variable `gnus-default-article-saver' specifies the saver function."
8068   (interactive "P")
8069   (let (articles process)
8070     (if (and n (numberp n))
8071         (let ((backward (< n 0))
8072               (n (abs n)))
8073           (save-excursion
8074             (while (and (> n 0)
8075                         (setq articles (cons (gnus-summary-article-number) 
8076                                              articles))
8077                         (gnus-summary-search-forward nil nil backward))
8078               (setq n (1- n))))
8079           (setq articles (sort articles (function <))))
8080       (if gnus-newsgroup-processable
8081           (progn
8082             (setq articles (setq gnus-newsgroup-processable
8083                                  (nreverse gnus-newsgroup-processable)))
8084             (setq process t))
8085         (setq articles (list (gnus-summary-article-number)))))
8086     (while articles
8087       (let ((header (gnus-gethash (int-to-string (car articles))
8088                                   gnus-newsgroup-headers-hashtb-by-number)))
8089         (if (vectorp header)
8090             (progn
8091               (gnus-summary-display-article (car articles) t)
8092               (if (not gnus-save-all-headers)
8093                   (gnus-article-hide-headers t))
8094               (if gnus-default-article-saver
8095                   (funcall gnus-default-article-saver)
8096                 (error "No default saver is defined.")))
8097           (if (assq 'name header)
8098               (gnus-copy-file (cdr (assq 'name header)))
8099             (message "Article %d is unsaveable" (car articles)))))
8100       (if process
8101           (gnus-summary-remove-process-mark (car articles)))
8102       (setq articles (cdr articles)))
8103     (if process (setq gnus-newsgroup-processable 
8104                       (nreverse gnus-newsgroup-processable)))
8105     (gnus-summary-position-cursor)
8106     n))
8107
8108 (defun gnus-summary-pipe-output (arg)
8109   "Pipe the current article to a subprocess.
8110 If N is a positive number, pipe the N next articles.
8111 If N is a negative number, pipe the N previous articles.
8112 If N is nil and any articles have been marked with the process mark,
8113 pipe those articles instead."
8114   (interactive "P")
8115   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
8116     (gnus-summary-save-article arg)))
8117
8118 (defun gnus-summary-save-article-mail (arg)
8119   "Append the current article to an mail file.
8120 If N is a positive number, save the N next articles.
8121 If N is a negative number, save the N previous articles.
8122 If N is nil and any articles have been marked with the process mark,
8123 save those articles instead."
8124   (interactive "P")
8125   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
8126     (gnus-summary-save-article arg)))
8127
8128 (defun gnus-summary-save-in-rmail (&optional filename)
8129   "Append this article to Rmail file.
8130 Optional argument FILENAME specifies file name.
8131 Directory to save to is default to `gnus-article-save-directory' which
8132 is initialized from the SAVEDIR environment variable."
8133   (interactive)
8134   (let ((default-name
8135           (funcall gnus-rmail-save-name gnus-newsgroup-name
8136                    gnus-current-headers gnus-newsgroup-last-rmail)))
8137     (or filename
8138         (setq filename
8139               (read-file-name
8140                (concat "Save article in rmail file: (default "
8141                        (file-name-nondirectory default-name) ") ")
8142                (file-name-directory default-name)
8143                default-name)))
8144     (gnus-make-directory (file-name-directory filename))
8145     (gnus-eval-in-buffer-window 
8146      gnus-article-buffer
8147      (save-excursion
8148        (save-restriction
8149          (widen)
8150          (gnus-output-to-rmail filename))))
8151     ;; Remember the directory name to save articles.
8152     (setq gnus-newsgroup-last-rmail filename)))
8153
8154 (defun gnus-summary-save-in-mail (&optional filename)
8155   "Append this article to Unix mail file.
8156 Optional argument FILENAME specifies file name.
8157 Directory to save to is default to `gnus-article-save-directory' which
8158 is initialized from the SAVEDIR environment variable."
8159   (interactive)
8160   (let ((default-name
8161           (funcall gnus-mail-save-name gnus-newsgroup-name
8162                    gnus-current-headers gnus-newsgroup-last-mail)))
8163     (or filename
8164         (setq filename
8165               (read-file-name
8166                (concat "Save article in Unix mail file: (default "
8167                        (file-name-nondirectory default-name) ") ")
8168                (file-name-directory default-name)
8169                default-name)))
8170     (setq filename
8171           (expand-file-name filename
8172                             (and default-name
8173                                  (file-name-directory default-name))))
8174     (gnus-make-directory (file-name-directory filename))
8175     (gnus-eval-in-buffer-window 
8176      gnus-article-buffer
8177      (save-excursion
8178        (save-restriction
8179          (widen)
8180          (if (and (file-readable-p filename) (rmail-file-p filename))
8181              (gnus-output-to-rmail filename)
8182            (rmail-output filename 1 t t)))))
8183     ;; Remember the directory name to save articles.
8184     (setq gnus-newsgroup-last-mail filename)))
8185
8186 (defun gnus-summary-save-in-file (&optional filename)
8187   "Append this article to file.
8188 Optional argument FILENAME specifies file name.
8189 Directory to save to is default to `gnus-article-save-directory' which
8190 is initialized from the SAVEDIR environment variable."
8191   (interactive)
8192   (let ((default-name
8193           (funcall gnus-file-save-name gnus-newsgroup-name
8194                    gnus-current-headers gnus-newsgroup-last-file)))
8195     (or filename
8196         (setq filename
8197               (read-file-name
8198                (concat "Save article in file: (default "
8199                        (file-name-nondirectory default-name) ") ")
8200                (file-name-directory default-name)
8201                default-name)))
8202     (gnus-make-directory (file-name-directory filename))
8203     (gnus-eval-in-buffer-window 
8204      gnus-article-buffer
8205      (save-excursion
8206        (save-restriction
8207          (widen)
8208          (gnus-output-to-file filename))))
8209     ;; Remember the directory name to save articles.
8210     (setq gnus-newsgroup-last-file filename)))
8211
8212 (defun gnus-summary-save-in-pipe (&optional command)
8213   "Pipe this article to subprocess."
8214   (interactive)
8215   (let ((command (read-string "Shell command on article: "
8216                               gnus-last-shell-command)))
8217     (if (string-equal command "")
8218         (setq command gnus-last-shell-command))
8219     (gnus-eval-in-buffer-window 
8220      gnus-article-buffer
8221      (save-restriction
8222        (widen)
8223        (shell-command-on-region (point-min) (point-max) command nil)))
8224     (setq gnus-last-shell-command command)))
8225
8226 ;; Summary extract commands
8227
8228 (defun gnus-summary-insert-pseudos (pslist)
8229   (let ((buffer-read-only nil)
8230         (article (gnus-summary-article-number))
8231         b)
8232     (or (gnus-summary-goto-subject article)
8233         (error (format "No such article: %d" article)))
8234     (gnus-summary-position-cursor)
8235     (if gnus-view-pseudos
8236         (while pslist
8237           (and (assq 'execute (car pslist))
8238                (gnus-execute-command (cdr (assq 'execute (car pslist)))
8239                                      (eq gnus-view-pseudos 'not-confirm)))
8240           (setq pslist (cdr pslist)))
8241       (save-excursion
8242         (while pslist
8243           (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist)))
8244                                          (gnus-summary-article-number)))
8245           (forward-line 1)
8246           (setq b (point))
8247           (insert "          " (file-name-nondirectory 
8248                                 (cdr (assq 'name (car pslist))))
8249                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
8250           (add-text-properties 
8251            b (1+ b) (list 'gnus-subject (cdr (assq 'name (car pslist)))
8252                           'gnus-number gnus-reffed-article-number
8253                           'gnus-mark gnus-unread-mark
8254                           'gnus-pseudo (car pslist)
8255                           'gnus-thread 0))
8256           (gnus-sethash (int-to-string gnus-reffed-article-number)
8257                         (car pslist) gnus-newsgroup-headers-hashtb-by-number)
8258           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
8259           (setq pslist (cdr pslist)))))))
8260
8261 (defun gnus-request-pseudo-article (props)
8262   (cond ((assq 'execute props)
8263          (gnus-execute-command (cdr (assq 'execute props)))))
8264   (let ((gnus-current-article (gnus-summary-article-number)))
8265     (run-hooks 'gnus-mark-article-hook)))
8266
8267 (defun gnus-execute-command (command &optional automatic)
8268   (save-excursion
8269     (gnus-article-setup-buffer)
8270     (set-buffer gnus-article-buffer)
8271     (let ((command (if automatic command (read-string "Command: " command)))
8272           (buffer-read-only nil))
8273       (erase-buffer)
8274       (insert "$ " command "\n\n")
8275       (if gnus-view-pseudo-asynchronously
8276           (start-process "gnus-execute" nil "sh" "-c" command)
8277         (call-process "sh" nil t nil "-c" command)))))
8278
8279 (defun gnus-copy-file (file &optional to)
8280   "Copy FILE to TO."
8281   (interactive
8282    (list (read-file-name "Copy file: " default-directory)
8283          (read-file-name "Copy file to: " default-directory)))
8284   (or to (setq to (read-file-name "Copy file to: " default-directory)))
8285   (and (file-directory-p to) 
8286        (setq to (concat (file-name-as-directory to)
8287                         (file-name-nondirectory file))))
8288   (copy-file file to))
8289
8290 ;; Summary score file commands
8291
8292 ;; Much modification of the kill (ahem, score) code and lots of the
8293 ;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
8294
8295 (defun gnus-summary-header (header)
8296   ;; Return HEADER for current articles, or error.
8297   (let ((article (gnus-summary-article-number)))
8298     (if article
8299         (aref (gnus-get-header-by-number article)
8300               (nth 1 (assoc header gnus-header-index)))
8301       (error "No article on current line"))))
8302
8303 (defun gnus-summary-score-entry (header match type score date &optional prompt)
8304   "Enter score file entry.
8305 HEADER is the header being scored.
8306 MATCH is the string we are looking for.
8307 TYPE is a flag indicating if it is a regexp or substring.
8308 SCORE is the score to add.
8309 DATE is the expire date."
8310   (interactive
8311    (list (completing-read "Header: "
8312                           gnus-header-index
8313                           (lambda (x) (fboundp (nth 2 x)))
8314                           t)
8315          (read-string "Match: ")
8316          (y-or-n-p "Use regexp match? ")
8317          (prefix-numeric-value current-prefix-arg)
8318          (if (y-or-n-p "Expire kill? ")
8319              (current-time-string)
8320            nil)))
8321   (and prompt (setq match (read-string "Match: " match)))
8322   (let ((score (gnus-score-default score)))
8323     (gnus-summary-score-effect header match type score)
8324     (and (= score gnus-score-interactive-default-score)
8325          (setq score nil))
8326     (let ((new (cond (type
8327                   (list match score (and date (gnus-day-number date)) type))
8328                  (date
8329                   (list match score (gnus-day-number date)))
8330                  (score
8331                   (list match score))
8332                  (t
8333                   (list match))))
8334           (old (gnus-score-get header)))
8335       (gnus-score-set
8336        header
8337        (if old (cons new old) (list new))))
8338     (gnus-score-set 'touched '(t))))
8339
8340 (defun gnus-summary-score-effect (header match type score)
8341   "Simulate the effect of a score file entry.
8342 HEADER is the header being scored.
8343 MATCH is the string we are looking for.
8344 TYPE is a flag indicating if it is a regexp or substring.
8345 SCORE is the score to add."
8346   (interactive (list (completing-read "Header: "
8347                                       gnus-header-index
8348                                       (lambda (x) (fboundp (nth 2 x)))
8349                                       t)
8350                      (read-string "Match: ")
8351                      (y-or-n-p "Use regexp match? ")
8352                      (prefix-numeric-value current-prefix-arg)))
8353   (save-excursion
8354     (or (and (stringp match) (> (length match) 0))
8355       (error "No match"))
8356     (goto-char (point-min))
8357     (let ((regexp (if type
8358                       match
8359                     (concat "\\`.*" (regexp-quote match) ".*\\'"))))
8360       (while (not (eobp))
8361         (let ((content (gnus-summary-header header))
8362               (case-fold-search t))
8363           (and content
8364                (if (string-match regexp content)
8365                    (gnus-summary-raise-score score))))
8366         (beginning-of-line 2)))))
8367
8368 (defun gnus-summary-score-crossposting (score date)
8369    ;; Enter score file entry for current crossposting.
8370    ;; SCORE is the score to add.
8371    ;; DATE is the expire date.
8372    (let ((xref (gnus-summary-header "xref"))
8373          (start 0)
8374          group)
8375      (or xref (error "This article is not crossposted"))
8376      (while (string-match " \\([^ \t]+\\):" xref start)
8377        (setq start (match-end 0))
8378        (if (not (string= 
8379                  (setq group 
8380                        (substring xref (match-beginning 1) (match-end 1)))
8381                  gnus-newsgroup-name))
8382            (gnus-summary-score-entry
8383             "xref" (concat " " group ":") nil score date t)))))
8384
8385 (defun gnus-summary-temporarily-lower-by-subject (level)
8386   "Temporarily lower score by LEVEL for current subject.
8387 See `gnus-score-expiry-days'."
8388   (interactive "P")
8389   (gnus-summary-score-entry
8390    "subject" (gnus-simplify-subject-re (gnus-summary-header "subject"))
8391    nil (- (gnus-score-default level))
8392    (current-time-string) t))
8393
8394 (defun gnus-summary-temporarily-lower-by-author (level)
8395   "Temporarily lower score by LEVEL for current author.
8396 See `gnus-score-expiry-days'."
8397   (interactive "P")
8398   (gnus-summary-score-entry
8399    "from" (gnus-summary-header "from") nil (- (gnus-score-default level)) 
8400    (current-time-string) t))
8401
8402 (defun gnus-summary-temporarily-lower-by-id (level)
8403   "Temporarily lower score by LEVEL for current message-id.
8404 See `gnus-score-expiry-days'."
8405   (interactive "P")
8406   (gnus-summary-score-entry
8407    "message-id" (gnus-summary-header "message-id") 
8408    nil (- (gnus-score-default level)) 
8409    (current-time-string)))
8410
8411 (defun gnus-summary-temporarily-lower-by-xref (level)
8412   "Temporarily lower score by LEVEL for current xref.
8413 See `gnus-score-expiry-days'."
8414   (interactive "P")
8415   (gnus-summary-score-crossposting 
8416    (- (gnus-score-default level)) (current-time-string)))
8417
8418 (defun gnus-summary-temporarily-lower-by-thread (level)
8419   "Temporarily lower score by LEVEL for current thread.
8420 See `gnus-score-expiry-days'."
8421   (interactive "P")
8422   (gnus-summary-score-entry
8423    "references" (gnus-summary-header "message-id")
8424    nil (- (gnus-score-default level)) (current-time-string)))
8425
8426 (defun gnus-summary-lower-by-subject (level)
8427   "Lower score by LEVEL for current subject."
8428   (interactive "P")
8429   (gnus-summary-score-entry
8430    "subject" (gnus-simplify-subject-re (gnus-summary-header "subject"))
8431    nil (- (gnus-score-default level)) 
8432    nil t))
8433
8434 (defun gnus-summary-lower-by-author (level)
8435   "Lower score by LEVEL for current author."
8436   (interactive "P")
8437   (gnus-summary-score-entry
8438    "from" (gnus-summary-header "from") nil 
8439    (- (gnus-score-default level)) nil t))
8440
8441 (defun gnus-summary-lower-by-id (level)
8442   "Lower score by LEVEL for current message-id."
8443   (interactive "P")
8444   (gnus-summary-score-entry
8445    "message-id" (gnus-summary-header "message-id") nil 
8446    (- (gnus-score-default level)) nil))
8447
8448 (defun gnus-summary-lower-by-xref (level)
8449   "Lower score by LEVEL for current xref."
8450   (interactive "P")
8451   (gnus-summary-score-crossposting (- (gnus-score-default level)) nil))
8452
8453 (defun gnus-summary-lower-followups-to-author (level)
8454   "Lower score by LEVEL for all followups to the current author."
8455   (interactive "P")
8456   (gnus-summary-raise-followups-to-author
8457    (- (gnus-score-default level))))
8458
8459 (defun gnus-summary-temporarily-raise-by-subject (level)
8460   "Temporarily raise score by LEVEL for current subject.
8461 See `gnus-score-expiry-days'."
8462   (interactive "P")
8463   (gnus-summary-score-entry
8464    "subject" (gnus-simplify-subject-re (gnus-summary-header "subject"))
8465    nil level (current-time-string) t))
8466
8467 (defun gnus-summary-temporarily-raise-by-author (level)
8468   "Temporarily raise score by LEVEL for current author.
8469 See `gnus-score-expiry-days'."
8470   (interactive "P")
8471   (gnus-summary-score-entry
8472    "from" (gnus-summary-header "from") nil level (current-time-string) t))
8473
8474 (defun gnus-summary-temporarily-raise-by-id (level)
8475   "Temporarily raise score by LEVEL for current message-id.
8476 See `gnus-score-expiry-days'."
8477   (interactive "P")
8478   (gnus-summary-score-entry
8479    "message-id" (gnus-summary-header "message-id") 
8480    nil level (current-time-string)))
8481
8482 (defun gnus-summary-temporarily-raise-by-xref (level)
8483   "Temporarily raise score by LEVEL for current xref.
8484 See `gnus-score-expiry-days'."
8485   (interactive "P")
8486   (gnus-summary-score-crossposting level (current-time-string)))
8487
8488 (defun gnus-summary-temporarily-raise-by-thread (level)
8489   "Temporarily raise score by LEVEL for current thread.
8490 See `gnus-score-expiry-days'."
8491   (interactive "P")
8492   (gnus-summary-score-entry
8493    "references" (gnus-summary-header "message-id")
8494    nil level (current-time-string)))
8495
8496 (defun gnus-summary-raise-by-subject (level)
8497   "Raise score by LEVEL for current subject."
8498   (interactive "P")
8499   (gnus-summary-score-entry
8500    "subject" (gnus-simplify-subject-re (gnus-summary-header "subject"))
8501    nil level nil t))
8502
8503 (defun gnus-summary-raise-by-author (level)
8504   "Raise score by LEVEL for current author."
8505   (interactive "P")
8506   (gnus-summary-score-entry
8507    "from" (gnus-summary-header "from") nil level nil t))
8508
8509 (defun gnus-summary-raise-by-id (level)
8510   "Raise score by LEVEL for current message-id."
8511   (interactive "P")
8512   (gnus-summary-score-entry
8513    "message-id" (gnus-summary-header "message-id") nil level nil))
8514
8515 (defun gnus-summary-raise-by-xref (level)
8516   "Raise score by LEVEL for current xref."
8517   (interactive "P")
8518   (gnus-summary-score-crossposting level nil))
8519
8520 (defun gnus-summary-raise-followups-to-author (level)
8521   "Raise score by LEVEL for all followups to the current author."
8522   (interactive "P")
8523   (let ((article (gnus-summary-article-number)))
8524     (if article (setq gnus-current-headers (gnus-get-header-by-number article))
8525       (error "No article on current line")))
8526   (gnus-kill-file-raise-followups-to-author
8527    (gnus-score-default level)))
8528
8529 ;; Summary kill commands.
8530
8531 (defun gnus-summary-edit-global-kill (article)
8532   "Edit the global score file."
8533   (interactive (list (gnus-summary-article-number)))
8534   (gnus-group-edit-global-kill article))
8535
8536 (defun gnus-summary-edit-local-kill ()
8537   "Edit a local score file applied to the current newsgroup."
8538   (interactive)
8539   (setq gnus-current-headers 
8540         (gnus-gethash 
8541          (int-to-string (gnus-summary-article-number))
8542          gnus-newsgroup-headers-hashtb-by-number))
8543   (gnus-set-global-variables)
8544   (gnus-group-edit-local-kill 
8545    (gnus-summary-article-number) gnus-newsgroup-name))
8546
8547 \f
8548 ;;;
8549 ;;; Gnus article mode
8550 ;;;
8551
8552 (if gnus-article-mode-map
8553     nil
8554   (setq gnus-article-mode-map (make-keymap))
8555   (suppress-keymap gnus-article-mode-map)
8556   (define-key gnus-article-mode-map " " 'gnus-article-next-page)
8557   (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
8558   (define-key gnus-article-mode-map "\C-c^" 'gnus-article-refer-article)
8559   (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
8560   (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
8561   (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail)
8562   (define-key gnus-article-mode-map "\C-c\C-M" 'gnus-article-mail-with-original)
8563   (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
8564   
8565   ;; Duplicate almost all summary keystrokes in the article mode map.
8566   (let ((commands 
8567          (list "#" "\M-#" "\C-c\M-#" "\r" "n" "p"
8568                "N" "P" "\M-\C-n" "\M-\C-p" "." "\M-s" "\M-r"
8569                "<" ">" "l" "j" "^" "\M-^" "-" "u" "U" "d" "D"
8570                "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" "c" "x" "X" 
8571                "\M-\C-x" "\M-\177" "b" "B" "$" "w" "\C-c\C-r"
8572                "t" "\M-t" "a" "f" "F" "C" "S" "r" "R" "\C-c\C-f"
8573                "m" "o" "\C-o" "|" "\M-m" "\M-\C-m" "\M-k" "m" "M"
8574                "V" "\C-c\C-d" "q" "Q")))
8575     (while commands
8576       (define-key gnus-article-mode-map (car commands) 
8577         'gnus-article-summary-command)
8578       (setq commands (cdr commands)))))
8579
8580
8581 (defun gnus-article-mode ()
8582   "Major mode for reading an article.
8583 All normal editing commands are switched off.
8584 The following commands are available:
8585
8586 \\<gnus-article-mode-map>
8587 \\[gnus-article-next-page]\t Scroll the article one page forwards
8588 \\[gnus-article-prev-page]\t Scroll the article one page backwards
8589 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
8590 \\[gnus-article-show-summary]\t Display the summary buffer
8591 \\[gnus-article-mail]\t Send a reply to the address near point
8592 \\[gnus-article-mail-with-original]\t Send a reply to the address near point; include the original article
8593 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
8594 \\[gnus-info-find-node]\t Go to the Gnus info node"
8595   (interactive)
8596   (if gnus-visual (gnus-article-make-menu-bar))
8597   (kill-all-local-variables)
8598   (setq mode-line-modified "-- ")
8599   (make-local-variable 'mode-line-format)
8600   (setq mode-line-format (copy-sequence mode-line-format))
8601   (and (equal (nth 3 mode-line-format) "   ")
8602        (setcar (nthcdr 3 mode-line-format) ""))
8603   (setq mode-name "Article")
8604   (setq major-mode 'gnus-article-mode)
8605   (make-local-variable 'minor-mode-alist)
8606   (or (assq 'gnus-show-mime minor-mode-alist)
8607       (setq minor-mode-alist
8608             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
8609   (use-local-map gnus-article-mode-map)
8610   (make-local-variable 'page-delimiter)
8611   (setq page-delimiter gnus-page-delimiter)
8612   (buffer-disable-undo (current-buffer))
8613   (setq buffer-read-only t)             ;Disable modification
8614   (run-hooks 'gnus-article-mode-hook))
8615
8616 (defun gnus-article-setup-buffer ()
8617   "Initialize article mode buffer."
8618   (or (get-buffer gnus-article-buffer)
8619       (save-excursion
8620         (set-buffer (get-buffer-create gnus-article-buffer))
8621         (gnus-add-current-to-buffer-list)
8622         (gnus-article-mode))))
8623
8624 (defun gnus-request-article-this-buffer (article &optional group)
8625   "Get an article and insert it into this buffer."
8626   (setq group (or group gnus-newsgroup-name))
8627   ;; Using `gnus-request-article' directly will insert the article into
8628   ;; `nntp-server-buffer' - so we'll save some time by not having to
8629   ;; copy it from the server buffer into the article buffer.
8630
8631   ;; We only request an article by message-id when we do not have the
8632   ;; headers for it, so we'll have to get those.
8633   (and (stringp article) 
8634        (let ((gnus-override-method gnus-refer-article-method))
8635          (gnus-read-header article)))
8636
8637   ;; If the article number is negative, that means that this article
8638   ;; doesn't belong in this newsgroup (possibly), so we find its
8639   ;; message-id and request it by id instead of number.
8640   (if (and (numberp article) (< article 0))
8641       (save-excursion
8642         (set-buffer gnus-summary-buffer)
8643         (let ((header (gnus-gethash (int-to-string article)
8644                                     gnus-newsgroup-headers-hashtb-by-number)))
8645           (if (vectorp header)
8646               ;; It's a real article.
8647               (setq article (header-id header))
8648             ;; It is an extracted pseudo-article.
8649             (setq article nil)
8650             (gnus-request-pseudo-article header)))))
8651   ;; Get the article and into the article buffer.
8652   (if article
8653       (progn
8654        (erase-buffer)
8655        (let ((gnus-override-method 
8656               (and (stringp article) gnus-refer-article-method)))
8657          (and (gnus-request-article article group (current-buffer))
8658               'article)))
8659     'pseudo))
8660
8661 (defun gnus-read-header (id)
8662   "Read the headers of article ID and enter them into the Gnus system."
8663   (or gnus-newsgroup-headers-hashtb-by-number
8664       (gnus-make-headers-hashtable-by-number))
8665   (let (header)
8666     (if (not (setq header 
8667                    (car (if (let ((gnus-nov-is-evil t))
8668                               (gnus-retrieve-headers 
8669                                (list id) gnus-newsgroup-name))
8670                             (gnus-get-newsgroup-headers)))))
8671         nil
8672       (if (stringp id)
8673           (header-set-number header gnus-reffed-article-number))
8674       (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers))
8675       (gnus-sethash (int-to-string (header-number header)) header
8676                     gnus-newsgroup-headers-hashtb-by-number)
8677       (if (stringp id)
8678           (setq gnus-reffed-article-number (1- gnus-reffed-article-number)))
8679       (setq gnus-current-headers header)
8680       header)))
8681
8682 (defun gnus-article-prepare (article &optional all-headers header)
8683   "Prepare ARTICLE in article mode buffer.
8684 ARTICLE should either be an article number or a Message-ID.
8685 If ARTICLE is an id, HEADER should be the article headers.
8686 If ALL-HEADERS is non-nil, no headers are hidden."
8687   (save-excursion
8688     ;; Make sure we start in a summary buffer.
8689     (or (eq major-mode 'gnus-summary-mode)
8690         (set-buffer gnus-summary-buffer))
8691     (setq gnus-summary-buffer (current-buffer))
8692     ;; Make sure the connection to the server is alive.
8693     (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name))
8694         (progn
8695           (gnus-check-news-server 
8696            (gnus-find-method-for-group gnus-newsgroup-name))
8697           (gnus-request-group gnus-newsgroup-name t)))
8698     (or gnus-newsgroup-headers-hashtb-by-number
8699         (gnus-make-headers-hashtable-by-number))
8700     (let* ((article (if header (header-number header) article))
8701            (summary-buffer (current-buffer))
8702            (internal-hook gnus-article-internal-prepare-hook)
8703            (bookmark (cdr (assq article gnus-newsgroup-bookmarks)))
8704            (group gnus-newsgroup-name)
8705            result)
8706       (save-excursion
8707         (gnus-article-setup-buffer)
8708         (set-buffer gnus-article-buffer)
8709         (let ((buffer-read-only nil))
8710           (if (not (setq result (gnus-request-article-this-buffer 
8711                                  article group)))
8712               ;; There is no such article.
8713               (progn
8714                 (save-excursion
8715                   (set-buffer gnus-summary-buffer)
8716                   (setq gnus-current-article 0)
8717                   (and (numberp article) 
8718                        (gnus-summary-mark-as-read article gnus-canceled-mark))
8719                   (message "No such article (may be canceled)")
8720                   (ding))
8721                 (setq gnus-article-current nil)
8722                 nil)
8723             (if (not (eq result 'article))
8724                 (progn
8725                   (save-excursion
8726                     (set-buffer summary-buffer)
8727                     (setq gnus-last-article gnus-current-article
8728                           gnus-newsgroup-history (cons gnus-current-article
8729                                                        gnus-newsgroup-history)
8730                           gnus-current-article 0
8731                           gnus-current-headers nil
8732                           gnus-article-current nil)
8733                     (gnus-configure-windows 'article)
8734                     (gnus-set-global-variables))
8735                   (gnus-set-mode-line 'article))
8736               ;; The result from the `request' was an actual article -
8737               ;; or at least some text that is now displayed in the
8738               ;; article buffer.
8739               (if (and (numberp article)
8740                        (not (eq article gnus-current-article)))
8741                   ;; Seems like a new article has been selected.
8742                   ;; `gnus-current-article' must be an article number.
8743                   (save-excursion
8744                     (set-buffer summary-buffer)
8745                     (setq gnus-last-article gnus-current-article
8746                           gnus-newsgroup-history (cons gnus-current-article
8747                                                        gnus-newsgroup-history)
8748                           gnus-current-article article
8749                           gnus-current-headers 
8750                           (gnus-get-header-by-number gnus-current-article)
8751                           gnus-article-current 
8752                           (cons gnus-newsgroup-name gnus-current-article))
8753                     (run-hooks 'gnus-mark-article-hook)
8754                     (gnus-set-mode-line 'summary)
8755                     (and gnus-visual 
8756                          (run-hooks 'gnus-visual-mark-article-hook))
8757                     ;; Set the global newsgroup variables here.
8758                     ;; Suggested by Jim Sisolak
8759                     ;; <sisolak@trans4.neep.wisc.edu>.
8760                     (gnus-set-global-variables)))
8761               ;; gnus-have-all-headers must be either T or NIL.
8762               (setq gnus-have-all-headers
8763                     (not (not (or all-headers gnus-show-all-headers))))
8764               ;; Hooks for getting information from the article.
8765               ;; This hook must be called before being narrowed.
8766               (run-hooks 'internal-hook)
8767               (run-hooks 'gnus-article-prepare-hook)
8768               ;; Decode MIME message.
8769               (if (and gnus-show-mime
8770                        (gnus-fetch-field "Mime-Version"))
8771                   (funcall gnus-show-mime-method))
8772               ;; Perform the article display hooks.
8773               (let ((buffer-read-only nil))
8774                 (run-hooks 'gnus-article-display-hook))
8775               ;; Do page break.
8776               (goto-char (point-min))
8777               (and gnus-break-pages (gnus-narrow-to-page))
8778               (gnus-set-mode-line 'article)
8779               (gnus-configure-windows 'article)
8780               (goto-char 1)
8781               (set-window-start 
8782                (get-buffer-window gnus-article-buffer) (point-min))
8783               (if bookmark
8784                   (progn
8785                     (message "Moved to bookmark")
8786                     (search-forward "\n\n" nil t)
8787                     (forward-line bookmark)))
8788               t)))))))
8789
8790 (defun gnus-article-show-all-headers ()
8791   "Show all article headers in article mode buffer."
8792   (save-excursion 
8793     (setq gnus-have-all-headers t)
8794     (gnus-article-setup-buffer)
8795     (set-buffer gnus-article-buffer)
8796     (let ((buffer-read-only nil))
8797       (remove-text-properties 1 (point-max) '(invisible t)))))
8798
8799 (defun gnus-article-hide-headers-if-wanted ()
8800   "Hide unwanted headers if `gnus-have-all-headers' is nil.
8801 Provided for backwards compatability."
8802   (or gnus-have-all-headers
8803       (gnus-article-hide-headers)))
8804
8805 (defun gnus-article-hide-headers (&optional delete)
8806   "Hide unwanted headers and possibly sort them as well."
8807   (interactive "P")
8808   (save-excursion
8809     (set-buffer gnus-article-buffer)
8810     (save-restriction
8811       (let ((sorted gnus-sorted-header-list)
8812             (buffer-read-only nil)
8813             want want-list beg want-l)
8814         ;; First we narrow to just the headers.
8815         (widen)
8816         (goto-char 1)
8817         ;; Hide any "From " lines at the beginning of (mail) articles. 
8818         (while (looking-at rmail-unix-mail-delimiter)
8819           (forward-line 1))
8820         (if (/= (point) 1) 
8821             (add-text-properties 1 (point) '(invisible t)))
8822         ;; Then treat the rest of the header lines.
8823         (narrow-to-region 
8824          (point) 
8825          (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
8826         ;; Then we use the two regular expressions
8827         ;; `gnus-ignored-headers' and `gnus-visible-headers' to
8828         ;; select which header lines is to remain visible in the
8829         ;; article buffer.
8830         (goto-char 1)
8831         (while (re-search-forward "^[^ \t]*:" nil t)
8832           (beginning-of-line)
8833           ;; We add the headers we want to keep to a list and delete
8834           ;; them from the buffer.
8835           (if (or (and (stringp gnus-visible-headers)
8836                        (looking-at gnus-visible-headers))
8837                   (and (not (stringp gnus-visible-headers))
8838                        (stringp gnus-ignored-headers)
8839                        (not (looking-at gnus-ignored-headers))))
8840               (progn
8841                 (setq beg (point))
8842                 (forward-line 1)
8843                 ;; Be sure to get multi-line headers...
8844                 (re-search-forward "^[^ \t]*:" nil t)
8845                 (beginning-of-line)
8846                 (setq want-list 
8847                       (cons (buffer-substring beg (point)) want-list))
8848                 (delete-region beg (point))
8849                 (goto-char beg))
8850             (forward-line 1)))
8851         ;; Next we perform the sorting by looking at
8852         ;; `gnus-sorted-header-list'. 
8853         (goto-char 1)
8854         (while (and sorted want-list)
8855           (setq want-l want-list)
8856           (while (and want-l
8857                       (not (string-match (car sorted) (car want-l))))
8858             (setq want-l (cdr want-l)))
8859           (if want-l 
8860               (progn
8861                 (insert (car want-l))
8862                 (setq want-list (delq (car want-l) want-list))))
8863           (setq sorted (cdr sorted)))
8864         ;; Any headers that were not matched by the sorted list we
8865         ;; just tack on the end of the visible header list.
8866         (while want-list
8867           (insert (car want-list))
8868           (setq want-list (cdr want-list)))
8869         ;; And finally we make the unwanted headers invisible.
8870         (if delete
8871             (delete-region (point) (point-max))
8872           ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
8873           (add-text-properties (point) (point-max) '(invisible t)))))))
8874
8875 (defun gnus-article-hide-signature ()
8876   "Hides the signature in an article.
8877 It does this by hiding everyting after \"^-- *$\", which is what all
8878 signatures should be preceded by. Note that this may mean that parts
8879 of an article may disappear if the article has such a line in the
8880 middle of the text."
8881   (interactive)
8882   (save-excursion
8883     (set-buffer gnus-article-buffer)
8884     (let ((buffer-read-only nil))
8885       (goto-char (point-max))
8886       (if (re-search-backward "^-- *$" nil t)
8887           (progn
8888             (add-text-properties (point) (point-max) '(invisible t)))))))
8889
8890 (defun gnus-article-hide-citation ()
8891   "Hide all cited text.
8892 This function uses the famous, extremely intelligent \"shoot in foot\"
8893 algorithm - which is simply deleting all lines that start with
8894 \">\". Your mileage may vary. If you come up with anything better,
8895 please do mail it to me."
8896   (interactive)
8897   (save-excursion
8898     (set-buffer gnus-article-buffer)
8899     (let ((buffer-read-only nil))
8900       (goto-char 1)
8901       (search-forward "\n\n" nil t)
8902       (while (not (eobp))
8903         (if (looking-at ">")
8904             (add-text-properties 
8905              (point) (save-excursion (forward-line 1) (point))
8906              '(invisible t)))
8907         (forward-line 1)))))
8908
8909 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
8910 (defun gnus-article-treat-overstrike ()
8911   ;; Prepare article for overstrike commands.
8912   (interactive)
8913   (save-excursion
8914     (set-buffer gnus-article-buffer)
8915     (let ((buffer-read-only nil))
8916       (while (search-forward "\b" nil t)
8917         (let ((next (following-char))
8918               (previous (char-after (- (point) 2))))
8919           (cond ((eq next previous)
8920                  (delete-region (- (point) 2) (point))
8921                  (put-text-property (point) (1+ (point))
8922                                     'face 'bold))
8923                 ((eq next ?_)
8924                  (delete-region (1- (point)) (1+ (point)))
8925                  (put-text-property (1- (point)) (point)
8926                                     'face 'underline))
8927                 ((eq previous ?_)
8928                  (delete-region (- (point) 2) (point))
8929                  (put-text-property (point) (1+ (point))
8930                                     'face 'underline))))))))
8931
8932 (defun gnus-article-word-wrap ()
8933   "Format too long lines."
8934   (interactive)
8935   (save-excursion
8936     (set-buffer gnus-article-buffer)
8937     (let ((buffer-read-only nil))
8938       (goto-char 1)
8939       (search-forward "\n\n" nil t)
8940       (end-of-line 1)
8941       (let ((paragraph-start "^\\W"))
8942         (while (not (eobp))
8943           (and (>= (current-column) (window-width))
8944                (/= (preceding-char) ?:)
8945                (fill-paragraph nil))
8946           (end-of-line 2))))))
8947
8948 (defun gnus-article-remove-cr ()
8949   (interactive)
8950   (save-excursion
8951     (set-buffer gnus-article-buffer)
8952     (let ((buffer-read-only nil))
8953       (goto-char (point-min))
8954       (while (search-forward "\r" nil t)
8955         (replace-match "")))))
8956
8957 (defun gnus-article-de-quoted-unreadable ()
8958   (interactive)
8959   (save-excursion
8960     (save-restriction
8961       (set-buffer gnus-article-buffer)
8962       (let ((buffer-read-only nil))
8963         (widen)
8964         (goto-char (point-min))
8965         (while (re-search-forward "=[0-9A-F][0-9A-F]" nil t)
8966           (replace-match 
8967            (char-to-string 
8968             (+
8969              (* 16 (gnus-hex-char-to-integer 
8970                     (char-after (1+ (match-beginning 0)))))
8971              (gnus-hex-char-to-integer
8972               (char-after (1- (match-end 0))))))))))))
8973
8974 ;; Taken from hexl.el.
8975 (defun gnus-hex-char-to-integer (character)
8976   "Take a char and return its value as if it was a hex digit."
8977   (if (and (>= character ?0) (<= character ?9))
8978       (- character ?0)
8979     (let ((ch (logior character 32)))
8980       (if (and (>= ch ?a) (<= ch ?f))
8981           (- ch (- ?a 10))
8982         (error (format "Invalid hex digit `%c'." ch))))))
8983
8984 ;; Article savers.
8985
8986 (defun gnus-output-to-rmail (file-name)
8987   "Append the current article to an Rmail file named FILE-NAME."
8988   (require 'rmail)
8989   ;; Most of these codes are borrowed from rmailout.el.
8990   (setq file-name (expand-file-name file-name))
8991   (setq rmail-default-rmail-file file-name)
8992   (let ((artbuf (current-buffer))
8993         (tmpbuf (get-buffer-create " *Gnus-output*")))
8994     (save-excursion
8995       (or (get-file-buffer file-name)
8996           (file-exists-p file-name)
8997           (if (gnus-yes-or-no-p
8998                (concat "\"" file-name "\" does not exist, create it? "))
8999               (let ((file-buffer (create-file-buffer file-name)))
9000                 (save-excursion
9001                   (set-buffer file-buffer)
9002                   (rmail-insert-rmail-file-header)
9003                   (let ((require-final-newline nil))
9004                     (write-region (point-min) (point-max) file-name t 1)))
9005                 (kill-buffer file-buffer))
9006             (error "Output file does not exist")))
9007       (set-buffer tmpbuf)
9008       (buffer-disable-undo (current-buffer))
9009       (erase-buffer)
9010       (insert-buffer-substring artbuf)
9011       (gnus-convert-article-to-rmail)
9012       ;; Decide whether to append to a file or to an Emacs buffer.
9013       (let ((outbuf (get-file-buffer file-name)))
9014         (if (not outbuf)
9015             (append-to-file (point-min) (point-max) file-name)
9016           ;; File has been visited, in buffer OUTBUF.
9017           (set-buffer outbuf)
9018           (let ((buffer-read-only nil)
9019                 (msg (and (boundp 'rmail-current-message)
9020                           rmail-current-message)))
9021             ;; If MSG is non-nil, buffer is in RMAIL mode.
9022             (if msg
9023                 (progn (widen)
9024                        (narrow-to-region (point-max) (point-max))))
9025             (insert-buffer-substring tmpbuf)
9026             (if msg
9027                 (progn
9028                   (goto-char (point-min))
9029                   (widen)
9030                   (search-backward "\^_")
9031                   (narrow-to-region (point) (point-max))
9032                   (goto-char (1+ (point-min)))
9033                   (rmail-count-new-messages t)
9034                   (rmail-show-message msg)))))))
9035     (kill-buffer tmpbuf)))
9036
9037 (defun gnus-output-to-file (file-name)
9038   "Append the current article to a file named FILE-NAME."
9039   (setq file-name (expand-file-name file-name))
9040   (let ((artbuf (current-buffer))
9041         (tmpbuf (get-buffer-create " *Gnus-output*")))
9042     (save-excursion
9043       (set-buffer tmpbuf)
9044       (buffer-disable-undo (current-buffer))
9045       (erase-buffer)
9046       (insert-buffer-substring artbuf)
9047       ;; Append newline at end of the buffer as separator, and then
9048       ;; save it to file.
9049       (goto-char (point-max))
9050       (insert "\n")
9051       (append-to-file (point-min) (point-max) file-name))
9052     (kill-buffer tmpbuf)))
9053
9054 (defun gnus-convert-article-to-rmail ()
9055   "Convert article in current buffer to Rmail message format."
9056   (let ((buffer-read-only nil))
9057     ;; Convert article directly into Babyl format.
9058     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
9059     (goto-char (point-min))
9060     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
9061     (while (search-forward "\n\^_" nil t) ;single char
9062       (replace-match "\n^_"))           ;2 chars: "^" and "_"
9063     (goto-char (point-max))
9064     (insert "\^_")))
9065
9066 (defun gnus-narrow-to-page (&optional arg)
9067   "Make text outside current page invisible except for page delimiter.
9068 A numeric arg specifies to move forward or backward by that many pages,
9069 thus showing a page other than the one point was originally in."
9070   (interactive "P")
9071   (setq arg (if arg (prefix-numeric-value arg) 0))
9072   (save-excursion
9073     (forward-page -1)                   ;Beginning of current page.
9074     (widen)
9075     (if (> arg 0)
9076         (forward-page arg)
9077       (if (< arg 0)
9078           (forward-page (1- arg))))
9079     ;; Find the end of the page.
9080     (forward-page)
9081     ;; If we stopped due to end of buffer, stay there.
9082     ;; If we stopped after a page delimiter, put end of restriction
9083     ;; at the beginning of that line.
9084     ;; These are commented out.
9085     ;;    (if (save-excursion (beginning-of-line)
9086     ;;                  (looking-at page-delimiter))
9087     ;;  (beginning-of-line))
9088     (narrow-to-region (point)
9089                       (progn
9090                         ;; Find the top of the page.
9091                         (forward-page -1)
9092                         ;; If we found beginning of buffer, stay there.
9093                         ;; If extra text follows page delimiter on same line,
9094                         ;; include it.
9095                         ;; Otherwise, show text starting with following line.
9096                         (if (and (eolp) (not (bobp)))
9097                             (forward-line 1))
9098                         (point)))))
9099
9100 (defun gnus-gmt-to-local ()
9101   "Rewrite Date header described in GMT to local in current buffer.
9102 Intended to be used with gnus-article-prepare-hook."
9103   (save-excursion
9104     (save-restriction
9105       (widen)
9106       (goto-char (point-min))
9107       (narrow-to-region (point-min)
9108                         (progn (search-forward "\n\n" nil 'move) (point)))
9109       (goto-char (point-min))
9110       (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
9111           (let ((buffer-read-only nil)
9112                 (date (buffer-substring (match-beginning 1) (match-end 1))))
9113             (delete-region (match-beginning 1) (match-end 1))
9114             (insert
9115              (timezone-make-date-arpa-standard 
9116               date nil (current-time-zone))))))))
9117
9118
9119 ;; Article mode commands
9120
9121 (defun gnus-article-next-page (lines)
9122   "Show next page of current article.
9123 If end of article, return non-nil. Otherwise return nil.
9124 Argument LINES specifies lines to be scrolled up."
9125   (interactive "P")
9126   (move-to-window-line -1)
9127   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
9128   (if (save-excursion
9129         (end-of-line)
9130         (and (pos-visible-in-window-p)  ;Not continuation line.
9131              (eobp)))
9132       ;; Nothing in this page.
9133       (if (or (not gnus-break-pages)
9134               (save-excursion
9135                 (save-restriction
9136                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
9137           t                             ;Nothing more.
9138         (gnus-narrow-to-page 1)         ;Go to next page.
9139         nil)
9140     ;; More in this page.
9141     (condition-case ()
9142         (scroll-up lines)
9143       (end-of-buffer
9144        ;; Long lines may cause an end-of-buffer error.
9145        (goto-char (point-max))))
9146     nil))
9147
9148 (defun gnus-article-prev-page (lines)
9149   "Show previous page of current article.
9150 Argument LINES specifies lines to be scrolled down."
9151   (interactive "P")
9152   (move-to-window-line 0)
9153   (if (and gnus-break-pages
9154            (bobp)
9155            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
9156       (progn
9157         (gnus-narrow-to-page -1) ;Go to previous page.
9158         (goto-char (point-max))
9159         (recenter -1))
9160     (scroll-down lines)))
9161
9162 (defun gnus-article-refer-article ()
9163   "Read article specified by message-id around point."
9164   (interactive)
9165   (search-forward ">" nil t)    ;Move point to end of "<....>".
9166   (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
9167       (let ((message-id
9168              (buffer-substring (match-beginning 1) (match-end 1))))
9169         (set-buffer gnus-summary-buffer)
9170         (gnus-summary-refer-article message-id))
9171     (error "No references around point")))
9172
9173 (defun gnus-article-mail (yank)
9174   "Send a reply to the address near point.
9175 If YANK is non-nil, include the original article."
9176   (interactive "P")
9177   (let ((address 
9178          (buffer-substring
9179           (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
9180           (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
9181     (and address
9182          (progn
9183            (switch-to-buffer gnus-summary-buffer)
9184            (funcall gnus-mail-reply-method yank address)))))
9185
9186 (defun gnus-article-mail-with-original ()
9187   "Send a reply to the address near point and include the original article."
9188   (interactive)
9189   (gnus-article-mail 'yank))
9190
9191 (defun gnus-article-show-summary ()
9192   "Reconfigure windows to show summary buffer."
9193   (interactive)
9194   (gnus-configure-windows 'article)
9195   (pop-to-buffer gnus-summary-buffer)
9196   (gnus-summary-goto-subject gnus-current-article))
9197
9198 (defun gnus-article-describe-briefly ()
9199   "Describe article mode commands briefly."
9200   (interactive)
9201   (message
9202    (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")))
9203
9204 (defun gnus-article-summary-command ()
9205   "Execute the last keystroke in the summary buffer."
9206   (interactive)
9207   (message "                                                                              ")
9208   (let ((obuf (current-buffer))
9209         (owin (current-window-configuration)))
9210     (switch-to-buffer gnus-summary-buffer 'norecord)
9211     (execute-kbd-macro (this-command-keys))
9212     (set-buffer obuf)
9213     (let ((npoint (point)))
9214       (set-window-configuration owin)
9215       (set-window-start (get-buffer-window (current-buffer)) (point)))))
9216
9217 ;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
9218 ;; Modified by tower@prep Nov 86
9219 ;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
9220
9221 (defun gnus-caesar-region (&optional n)
9222   "Caesar rotation of region by N, default 13, for decrypting netnews.
9223 ROT47 will be performed for Japanese text in any case."
9224   (interactive (if current-prefix-arg   ; Was there a prefix arg?
9225                    (list (prefix-numeric-value current-prefix-arg))
9226                  (list nil)))
9227   (cond ((not (numberp n)) (setq n 13))
9228         (t (setq n (mod n 26))))        ;canonicalize N
9229   (if (not (zerop n))           ; no action needed for a rot of 0
9230       (progn
9231         (if (or (not (boundp 'caesar-translate-table))
9232                 (not caesar-translate-table)
9233                 (/= (aref caesar-translate-table ?a) (+ ?a n)))
9234             (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
9235               (message "Building caesar-translate-table...")
9236               (setq caesar-translate-table (make-vector 256 0))
9237               (while (< i 256)
9238                 (aset caesar-translate-table i i)
9239                 (setq i (1+ i)))
9240               (setq lower (concat lower lower) upper (upcase lower) i 0)
9241               (while (< i 26)
9242                 (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
9243                 (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
9244                 (setq i (1+ i)))
9245               ;; ROT47 for Japanese text.
9246               ;; Thanks to ichikawa@flab.fujitsu.junet.
9247               (setq i 161)
9248               (let ((t1 (logior ?O 128))
9249                     (t2 (logior ?! 128))
9250                     (t3 (logior ?~ 128)))
9251                 (while (< i 256)
9252                   (aset caesar-translate-table i
9253                         (let ((v (aref caesar-translate-table i)))
9254                           (if (<= v t1) (if (< v t2) v (+ v 47))
9255                             (if (<= v t3) (- v 47) v))))
9256                   (setq i (1+ i))))
9257               (message "Building caesar-translate-table... done")))
9258         (let ((from (region-beginning))
9259               (to (region-end))
9260               (i 0) str len)
9261           (setq str (buffer-substring from to))
9262           (setq len (length str))
9263           (while (< i len)
9264             (aset str i (aref caesar-translate-table (aref str i)))
9265             (setq i (1+ i)))
9266           (goto-char from)
9267           (delete-region from to)
9268           (insert str)))))
9269
9270 \f
9271 ;;;
9272 ;;; Gnus Kill File Mode
9273 ;;;
9274
9275 (defvar gnus-kill-file-mode-map nil)
9276
9277 (if gnus-kill-file-mode-map
9278     nil
9279   (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
9280   (define-key gnus-kill-file-mode-map 
9281     "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject)
9282   (define-key gnus-kill-file-mode-map
9283     "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author)
9284   (define-key gnus-kill-file-mode-map
9285     "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-thread)
9286   (define-key gnus-kill-file-mode-map 
9287     "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-xref)
9288   (define-key gnus-kill-file-mode-map
9289     "\C-c\C-a" 'gnus-kill-file-apply-buffer)
9290   (define-key gnus-kill-file-mode-map
9291     "\C-c\C-e" 'gnus-kill-file-apply-last-sexp)
9292   (define-key gnus-kill-file-mode-map 
9293     "\C-c\C-c" 'gnus-kill-file-exit))
9294
9295 (defun gnus-kill-file-mode ()
9296   "Major mode for editing kill files.
9297
9298 If you are using this mode - you probably shouldn't.  Kill files
9299 perform badly and paint with a pretty broad brush.  Score files, on
9300 the other hand, are vastly faster (40x speedup) and give you more
9301 control over what to do.
9302
9303 In addition to Emacs-Lisp Mode, the following commands are available:
9304
9305 \\{gnus-kill-file-mode-map}
9306
9307   A kill file contains Lisp expressions to be applied to a selected
9308 newsgroup.  The purpose is to mark articles as read on the basis of
9309 some set of regexps.  A global kill file is applied to every newsgroup,
9310 and a local kill file is applied to a specified newsgroup.  Since a
9311 global kill file is applied to every newsgroup, for better performance
9312 use a local one.
9313
9314   A kill file can contain any kind of Emacs Lisp expressions expected
9315 to be evaluated in the Summary buffer.  Writing Lisp programs for this
9316 purpose is not so easy because the internal working of Gnus must be
9317 well-known.  For this reason, Gnus provides a general function which
9318 does this easily for non-Lisp programmers.
9319
9320   The `gnus-kill' function executes commands available in Summary Mode
9321 by their key sequences. `gnus-kill' should be called with FIELD,
9322 REGEXP and optional COMMAND and ALL.  FIELD is a string representing
9323 the header field or an empty string.  If FIELD is an empty string, the
9324 entire article body is searched for.  REGEXP is a string which is
9325 compared with FIELD value. COMMAND is a string representing a valid
9326 key sequence in Summary mode or Lisp expression. COMMAND defaults to
9327 '(gnus-summary-mark-as-read nil \"X\").  Make sure that COMMAND is
9328 executed in the Summary buffer.  If the second optional argument ALL
9329 is non-nil, the COMMAND is applied to articles which are already
9330 marked as read or unread.  Articles which are marked are skipped over
9331 by default.
9332
9333   For example, if you want to mark articles of which subjects contain
9334 the string `AI' as read, a possible kill file may look like:
9335
9336         (gnus-kill \"Subject\" \"AI\")
9337
9338   If you want to mark articles with `D' instead of `X', you can use
9339 the following expression:
9340
9341         (gnus-kill \"Subject\" \"AI\" \"d\")
9342
9343 In this example it is assumed that the command
9344 `gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
9345
9346   It is possible to delete unnecessary headers which are marked with
9347 `X' in a kill file as follows:
9348
9349         (gnus-expunge \"X\")
9350
9351   If the Summary buffer is empty after applying kill files, Gnus will
9352 exit the selected newsgroup normally.  If headers which are marked
9353 with `D' are deleted in a kill file, it is impossible to read articles
9354 which are marked as read in the previous Gnus sessions.  Marks other
9355 than `D' should be used for articles which should really be deleted.
9356
9357 Entry to this mode calls emacs-lisp-mode-hook and
9358 gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
9359   (interactive)
9360   (kill-all-local-variables)
9361   (use-local-map gnus-kill-file-mode-map)
9362   (set-syntax-table emacs-lisp-mode-syntax-table)
9363   (setq major-mode 'gnus-kill-file-mode)
9364   (setq mode-name "Kill")
9365   (lisp-mode-variables nil)
9366   (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
9367
9368 (defun gnus-kill-file-edit-file (newsgroup)
9369   "Begin editing a kill file for NEWSGROUP.
9370 If NEWSGROUP is nil, the global kill file is selected."
9371   (interactive "sNewsgroup: ")
9372   (let ((file (gnus-newsgroup-kill-file newsgroup)))
9373     (gnus-make-directory (file-name-directory file))
9374     ;; Save current window configuration if this is first invocation.
9375     (or (and (get-file-buffer file)
9376              (get-buffer-window (get-file-buffer file)))
9377         (setq gnus-winconf-kill-file (current-window-configuration)))
9378     ;; Hack windows.
9379     (let ((buffer (find-file-noselect file)))
9380       (cond ((get-buffer-window buffer)
9381              (pop-to-buffer buffer))
9382             ((eq major-mode 'gnus-group-mode)
9383              (gnus-configure-windows '(1 0 0)) ;Take all windows.
9384              (pop-to-buffer gnus-group-buffer)
9385              ;; Fix by sachs@SLINKY.CS.NYU.EDU (Jay Sachs).
9386              (let ((gnus-summary-buffer buffer))
9387                (gnus-configure-windows '(1 1 0))) ;Split into two.
9388              (pop-to-buffer buffer))
9389             ((eq major-mode 'gnus-summary-mode)
9390              (gnus-configure-windows 'article)
9391              (pop-to-buffer gnus-article-buffer)
9392              (bury-buffer gnus-article-buffer)
9393              (switch-to-buffer buffer))
9394             (t                          ;No good rules.
9395              (find-file-other-window file))))
9396     (gnus-kill-file-mode)))
9397
9398 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
9399 (defun gnus-kill-set-kill-buffer ()
9400   (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))
9401          (buffer (find-file-noselect file)))
9402     (set-buffer buffer)
9403     (gnus-kill-file-mode)
9404     (bury-buffer buffer)))
9405
9406 (defun gnus-kill-save-kill-buffer ()
9407   (save-excursion
9408     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
9409       (if (get-file-buffer file)
9410           (progn
9411             (set-buffer (get-file-buffer file))
9412             (and (buffer-modified-p) (save-buffer))
9413             (kill-buffer (current-buffer)))))))
9414
9415 (defun gnus-kill-file-enter-kill (field regexp)
9416   ;; Enter kill file entry.
9417   ;; FIELD: String containing the name of the header field to kill.
9418   ;; REGEXP: The string to kill.
9419   (save-excursion
9420     (let (string)
9421       (gnus-kill-set-kill-buffer)
9422       (goto-char (point-max))
9423       (insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
9424       (gnus-kill-file-apply-string string))))
9425     
9426 (defun gnus-kill-file-kill-by-subject ()
9427   "Kill by subject."
9428   (interactive)
9429   (gnus-kill-file-enter-kill
9430    "Subject" 
9431    (regexp-quote 
9432     (gnus-simplify-subject (header-subject gnus-current-headers)))))
9433   
9434 (defun gnus-kill-file-kill-by-author ()
9435   "Kill by author."
9436   (interactive)
9437   (gnus-kill-file-enter-kill
9438    "From" (regexp-quote (header-from gnus-current-headers))))
9439  
9440 (defun gnus-kill-file-kill-by-thread ()
9441   "Kill by author."
9442   (interactive "p")
9443   (gnus-kill-file-enter-kill
9444    "References" (regexp-quote (header-id gnus-current-headers))))
9445  
9446 (defun gnus-kill-file-kill-by-xref ()
9447   "Kill by Xref."
9448   (interactive)
9449   (let ((xref (header-xref gnus-current-headers))
9450         (start 0)
9451         group)
9452     (if xref
9453         (while (string-match " \\([^ \t]+\\):" xref start)
9454           (setq start (match-end 0))
9455           (if (not (string= 
9456                     (setq group 
9457                           (substring xref (match-beginning 1) (match-end 1)))
9458                     gnus-newsgroup-name))
9459               (gnus-kill-file-enter-kill 
9460                "Xref" (concat " " (regexp-quote group) ":"))))
9461       (gnus-kill-file-enter-kill "Xref" ""))))
9462
9463 (defun gnus-kill-file-raise-followups-to-author (level)
9464   "Raise score for all followups to the current author."
9465   (interactive "p")
9466   (let ((name (header-from gnus-current-headers))
9467         string)
9468     (save-excursion
9469       (gnus-kill-set-kill-buffer)
9470       (goto-char (point-min))
9471       (setq name (read-string (concat "Add " level
9472                                       " to followup articles to: ")
9473                               (regexp-quote name)))
9474       (setq 
9475        string
9476        (format
9477         "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
9478         "From" name level))
9479       (insert string)
9480       (gnus-kill-file-apply-string string))
9481     (message "Added permanent score file entry for followups to %s." name)))
9482
9483 (defun gnus-kill-file-apply-buffer ()
9484   "Apply current buffer to current newsgroup."
9485   (interactive)
9486   (if (and gnus-current-kill-article
9487            (get-buffer gnus-summary-buffer))
9488       ;; Assume newsgroup is selected.
9489       (gnus-kill-file-apply-string (buffer-string))
9490     (ding) (message "No newsgroup is selected.")))
9491
9492 (defun gnus-kill-file-apply-string (string)
9493   "Apply STRING to current newsgroup."
9494   (interactive)
9495   (let ((string (concat "(progn \n" string "\n)")))
9496     (save-excursion
9497       (save-window-excursion
9498         (pop-to-buffer gnus-summary-buffer)
9499         (eval (car (read-from-string string)))))))
9500
9501 (defun gnus-kill-file-apply-last-sexp ()
9502   "Apply sexp before point in current buffer to current newsgroup."
9503   (interactive)
9504   (if (and gnus-current-kill-article
9505            (get-buffer gnus-summary-buffer))
9506       ;; Assume newsgroup is selected.
9507       (let ((string
9508              (buffer-substring
9509               (save-excursion (forward-sexp -1) (point)) (point))))
9510         (save-excursion
9511           (save-window-excursion
9512             (pop-to-buffer gnus-summary-buffer)
9513             (eval (car (read-from-string string))))))
9514     (ding) (message "No newsgroup is selected.")))
9515
9516 (defun gnus-kill-file-exit ()
9517   "Save a kill file, then return to the previous buffer."
9518   (interactive)
9519   (save-buffer)
9520   (let ((killbuf (current-buffer)))
9521     ;; We don't want to return to article buffer.
9522     (and (get-buffer gnus-article-buffer)
9523          (bury-buffer gnus-article-buffer))
9524     ;; Delete the KILL file windows.
9525     (delete-windows-on killbuf)
9526     ;; Restore last window configuration if available.
9527     (and gnus-winconf-kill-file
9528          (set-window-configuration gnus-winconf-kill-file))
9529     (setq gnus-winconf-kill-file nil)
9530     ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
9531     (kill-buffer killbuf)))
9532
9533 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
9534
9535 ;;;###autoload
9536 (defalias 'gnus-batch-kill 'gnus-batch-score)
9537 ;;;###autoload
9538 (defun gnus-batch-score ()
9539   "Run batched scoring.
9540 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
9541 Newsgroups is a list of strings in Bnews format.  If you want to score
9542 the comp hierarchy, you'd say \"comp.all\". If you would not like to
9543 score the alt hierarchy, you'd say \"!alt.all\"."
9544   (interactive)
9545   (let* ((yes-and-no
9546           (gnus-parse-n-options
9547            (apply (function concat)
9548                   (mapcar (lambda (g) (concat g " "))
9549                           command-line-args-left))))
9550          (gnus-expert-user t)
9551          (nnmail-spool-file nil)
9552          (gnus-use-dribble-file nil)
9553          (yes (car yes-and-no))
9554          (no (cdr yes-and-no))
9555          group subscribed newsrc entry
9556          ;; Disable verbose message.
9557          gnus-novice-user gnus-large-newsgroup)
9558     ;; Eat all arguments.
9559     (setq command-line-args-left nil)
9560     ;; Start Gnus.
9561     (gnus)
9562     ;; Apply kills to specified newsgroups in command line arguments.
9563     (setq newsrc (cdr gnus-newsrc-assoc))
9564     (while newsrc
9565       (setq group (car (car newsrc)))
9566       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
9567       (if (and (<= (nth 1 (car newsrc)) 5)
9568                (and (car entry)
9569                     (or (eq (car entry) t)
9570                         (not (zerop (car entry)))))
9571                (if yes (string-match yes group) t)
9572                (or (null no) (not (string-match no group))))
9573           (progn
9574             (gnus-summary-read-group group nil t)
9575             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
9576                  (gnus-summary-exit))))
9577       (setq newsrc (cdr newsrc)))
9578     ;; Exit Emacs.
9579     (switch-to-buffer gnus-group-buffer)
9580     (gnus-group-save-newsrc)))
9581
9582 ;; For kill files
9583
9584 (defun gnus-Newsgroup-kill-file (newsgroup)
9585   "Return the name of a kill file for NEWSGROUP.
9586 If NEWSGROUP is nil, return the global kill file instead."
9587   (cond ((or (null newsgroup)
9588              (string-equal newsgroup ""))
9589          ;; The global kill file is placed at top of the directory.
9590          (expand-file-name gnus-kill-file-name
9591                            (or gnus-kill-files-directory "~/News")))
9592         (gnus-use-long-file-name
9593          ;; Append ".KILL" to capitalized newsgroup name.
9594          (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
9595                                    "." gnus-kill-file-name)
9596                            (or gnus-kill-files-directory "~/News")))
9597         (t
9598          ;; Place "KILL" under the hierarchical directory.
9599          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
9600                                    "/" gnus-kill-file-name)
9601                            (or gnus-kill-files-directory "~/News")))))
9602
9603 (defun gnus-newsgroup-kill-file (newsgroup)
9604   "Return the name of a kill file name for NEWSGROUP.
9605 If NEWSGROUP is nil, return the global kill file name instead."
9606   (cond ((or (null newsgroup)
9607              (string-equal newsgroup ""))
9608          ;; The global KILL file is placed at top of the directory.
9609          (expand-file-name gnus-kill-file-name
9610                            (or gnus-kill-files-directory "~/News")))
9611         (gnus-use-long-file-name
9612          ;; Append ".KILL" to newsgroup name.
9613          (expand-file-name (concat newsgroup "." gnus-kill-file-name)
9614                            (or gnus-kill-files-directory "~/News")))
9615         (t
9616          ;; Place "KILL" under the hierarchical directory.
9617          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
9618                                    "/" gnus-kill-file-name)
9619                            (or gnus-kill-files-directory "~/News")))))
9620
9621 (defalias 'gnus-expunge 'gnus-summary-remove-lines-marked-with)
9622
9623 (defun gnus-apply-kill-file ()
9624   "Apply a kill file to the current newsgroup.
9625 Returns the number of articles marked as read."
9626   (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
9627                            (gnus-newsgroup-kill-file gnus-newsgroup-name)))
9628          (unreads (length gnus-newsgroup-unreads))
9629          (gnus-summary-inhibit-highlight t)
9630          (mark-below (or gnus-summary-mark-below gnus-summary-default-score 0))
9631          (expunge-below gnus-summary-expunge-below)
9632          form beg)
9633     (setq gnus-newsgroup-kill-headers nil)
9634     (or gnus-newsgroup-headers-hashtb-by-number
9635         (gnus-make-headers-hashtable-by-number))
9636     ;; If there are any previously scored articles, we remove these
9637     ;; from the `gnus-newsgroup-headers' list that the score functions
9638     ;; will see. This is probably pretty wasteful when it comes to
9639     ;; conses, but is, I think, faster than having to assq in every
9640     ;; single score funtion.
9641     (let ((files kill-files))
9642       (while files
9643         (if (file-exists-p (car files))
9644             (let ((headers gnus-newsgroup-headers))
9645               (if gnus-kill-killed
9646                   (setq gnus-newsgroup-kill-headers
9647                         (mapcar (lambda (header) (header-number header))
9648                                 headers))
9649                 (while headers
9650                   (or (gnus-member-of-range 
9651                        (header-number (car headers)) 
9652                        gnus-newsgroup-killed)
9653                       (setq gnus-newsgroup-kill-headers 
9654                             (cons (header-number (car headers))
9655                                   gnus-newsgroup-kill-headers)))
9656                   (setq headers (cdr headers))))
9657               (setq files nil))
9658           (setq files (cdr files)))))
9659     (if gnus-newsgroup-kill-headers
9660         (save-excursion
9661           (while kill-files
9662             (if (file-exists-p (car kill-files))
9663                 (progn
9664                   (message "Processing kill file %s..." (car kill-files))
9665                   (find-file (car kill-files))
9666                   (goto-char (point-min))
9667                   (while (progn
9668                            (setq beg (point))
9669                            (setq form (condition-case nil 
9670                                           (read (current-buffer)) 
9671                                         (error nil))))
9672                     (if (or (eq (car form) 'gnus-kill)
9673                             (eq (car form) 'gnus-raise)
9674                             (eq (car form) 'gnus-lower))
9675                         (progn
9676                           (delete-region beg (point))
9677                           (insert (or (eval form) "")))
9678                       (condition-case ()
9679                           (eval form)
9680                         (error nil))))
9681                   (and (buffer-modified-p) (save-buffer))
9682                   (message "Processing kill file %s...done" (car kill-files))))
9683             (setq kill-files (cdr kill-files)))))
9684     (if beg
9685         (let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
9686           (or (eq nunreads 0)
9687               (message "Marked %d articles as read" nunreads))
9688           nunreads)
9689       0)))
9690
9691 ;; Kill changes and new format by suggested by JWZ and Sudish Joseph
9692 ;; <joseph@cis.ohio-state.edu>.  
9693 (defun gnus-kill (field regexp &optional exe-command all)
9694   "If FIELD of an article matches REGEXP, execute COMMAND.
9695 Optional 1st argument COMMAND is default to
9696         (gnus-summary-mark-as-read nil \"X\").
9697 If optional 2nd argument ALL is non-nil, articles marked are also applied to.
9698 If FIELD is an empty string (or nil), entire article body is searched for.
9699 COMMAND must be a lisp expression or a string representing a key sequence."
9700   ;; We don't want to change current point nor window configuration.
9701   (save-excursion
9702     (save-window-excursion
9703       ;; Selected window must be summary buffer to execute keyboard
9704       ;; macros correctly. See command_loop_1.
9705       (switch-to-buffer gnus-summary-buffer 'norecord)
9706       (goto-char (point-min))           ;From the beginning.
9707       (let ((kill-list regexp)
9708             (date (current-time-string))
9709             (command (or exe-command '(gnus-summary-mark-as-read 
9710                                        nil gnus-kill-file-mark)))
9711             kill kdate prev)
9712         (if (listp kill-list)
9713             ;; It is a list.
9714             (if (not (consp (cdr kill-list)))
9715                 ;; It's on the form (regexp . date).
9716                 (if (zerop (gnus-execute field (car kill-list) 
9717                                          command nil (not all)))
9718                     (if (> (gnus-days-between date (cdr kill-list))
9719                            gnus-score-expiry-days)
9720                         (setq regexp nil))
9721                   (setcdr kill-list date))
9722               (while (setq kill (car kill-list))
9723                 (if (consp kill)
9724                     ;; It's a temporary kill.
9725                     (progn
9726                       (setq kdate (cdr kill))
9727                       (if (zerop (gnus-execute 
9728                                   field (car kill) command nil (not all)))
9729                           (if (> (gnus-days-between date kdate)
9730                                  gnus-score-expiry-days)
9731                               ;; Time limit has been exceeded, so we
9732                               ;; remove the match.
9733                               (if prev
9734                                   (setcdr prev (cdr kill-list))
9735                                 (setq regexp (cdr regexp))))
9736                         ;; Successful kill. Set the date to today.
9737                         (setcdr kill date)))
9738                   ;; It's a permanent kill.
9739                   (gnus-execute field kill command nil (not all)))
9740                 (setq prev kill-list)
9741                 (setq kill-list (cdr kill-list))))
9742           (gnus-execute field kill-list command nil (not all))))))
9743   (if (and (eq major-mode 'gnus-kill-file-mode) regexp)
9744       (gnus-pp-gnus-kill
9745        (nconc (list 'gnus-kill field 
9746                     (if (consp regexp) (list 'quote regexp) regexp))
9747               (if (or exe-command all) (list (list 'quote exe-command)))
9748               (if all (list t) nil)))))
9749
9750 (defun gnus-pp-gnus-kill (object)
9751   (if (or (not (consp (nth 2 object)))
9752           (not (consp (cdr (nth 2 object))))
9753           (and (eq 'quote (car (nth 2 object)))
9754                (not (consp (cdr (car (cdr (nth 2 object))))))))
9755       (concat "\n" (prin1-to-string object))
9756     (save-excursion
9757       (set-buffer (get-buffer-create "*Gnus PP*"))
9758       (buffer-disable-undo (current-buffer))
9759       (erase-buffer)
9760       (insert (format "\n(%S %S\n  '(" (nth 0 object) (nth 1 object)))
9761       (let ((klist (car (cdr (nth 2 object))))
9762             (first t))
9763         (while klist
9764           (insert (if first (progn (setq first nil) "")  "\n    ")
9765                   (prin1-to-string (car klist)))
9766           (setq klist (cdr klist))))
9767       (insert ")")
9768       (and (nth 3 object)
9769            (insert "\n  " 
9770                    (if (and (consp (nth 3 object))
9771                             (not (eq 'quote (car (nth 3 object))))) 
9772                        "'" "")
9773                    (prin1-to-string (nth 3 object))))
9774       (and (nth 4 object)
9775            (insert "\n  t"))
9776       (insert ")")
9777       (prog1
9778           (buffer-substring (point-min) (point-max))
9779         (kill-buffer (current-buffer))))))
9780
9781 (defun gnus-execute-1 (function regexp form header)
9782   (save-excursion
9783     (let (did-kill)
9784       (if (null header)
9785           nil                           ;Nothing to do.
9786         (if function
9787             ;; Compare with header field.
9788             (let (value)
9789               (and header
9790                    (progn
9791                      (setq value (funcall function header))
9792                      ;; Number (Lines:) or symbol must be converted to string.
9793                      (or (stringp value)
9794                          (setq value (prin1-to-string value)))
9795                      (setq did-kill (string-match regexp value)))
9796                    (if (stringp form)   ;Keyboard macro.
9797                        (execute-kbd-macro form)
9798                      (funcall form))))
9799           ;; Search article body.
9800           (let ((gnus-current-article nil) ;Save article pointer.
9801                 (gnus-last-article nil)
9802                 (gnus-break-pages nil)  ;No need to break pages.
9803                 (gnus-mark-article-hook nil)) ;Inhibit marking as read.
9804             (message "Searching for article: %d..." (header-number header))
9805             (gnus-article-setup-buffer)
9806             (gnus-article-prepare (header-number header) t)
9807             (if (save-excursion
9808                   (set-buffer gnus-article-buffer)
9809                   (goto-char (point-min))
9810                   (setq did-kill (re-search-forward regexp nil t)))
9811                 (if (stringp form)      ;Keyboard macro.
9812                     (execute-kbd-macro form)
9813                   (eval form))))))
9814       did-kill)))
9815
9816 (defun gnus-execute (field regexp form &optional backward ignore-marked)
9817   "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
9818 If FIELD is an empty string (or nil), entire article body is searched for.
9819 If optional 1st argument BACKWARD is non-nil, do backward instead.
9820 If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
9821 marked as read or ticked are ignored."
9822   (save-excursion
9823     (let ((killed-no 0)
9824           function header article)
9825       (if (or (null field) (string-equal field ""))
9826           (setq function nil)
9827         ;; Get access function of header filed.
9828         (setq function (intern-soft (concat "gnus-header-" (downcase field))))
9829         (if (and function (fboundp function))
9830             (setq function (symbol-function function))
9831           (error "Unknown header field: \"%s\"" field))
9832         ;; Make FORM funcallable.
9833         (if (and (listp form) (not (eq (car form) 'lambda)))
9834             (setq form (list 'lambda nil form))))
9835       ;; Starting from the current article.
9836       (while (or (and (not article)
9837                       (setq article (gnus-summary-article-number))
9838                       t)
9839                  (setq article 
9840                        (gnus-summary-search-subject 
9841                         backward (not ignore-marked))))
9842         (and (or (null gnus-newsgroup-kill-headers)
9843                  (memq article gnus-newsgroup-kill-headers))
9844              (gnus-execute-1 function regexp form 
9845                              (gnus-get-header-by-number article))
9846              (setq killed-no (1+ killed-no))))
9847       killed-no)))
9848
9849 \f
9850 ;;;
9851 ;;; Gnus Score Files
9852 ;;;
9853
9854 ;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
9855
9856 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
9857 (defun gnus-score-set-mark-below (score)
9858   "Automatically mark articles with score below SCORE as read."
9859   (interactive 
9860    (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
9861              (string-to-int (read-string "Mark below: ")))))
9862   (setq score (or score gnus-summary-default-score 0))
9863   (gnus-score-set 'mark (list score))
9864   (gnus-score-set 'touched '(t))
9865   (setq gnus-summary-mark-below score)
9866   (gnus-summary-update-lines))
9867
9868 (defun gnus-score-set-expunge-below (score)
9869   "Automatically expunge articles with score below SCORE."
9870   (interactive 
9871    (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
9872              (string-to-int (read-string "Mark below: ")))))
9873   (setq score (or score gnus-summary-default-score 0))
9874   (gnus-score-set 'expunge (list score))
9875   (gnus-score-set 'touched '(t)))
9876
9877 (defun gnus-score-default (level)
9878   (if level (prefix-numeric-value level) 
9879     gnus-score-interactive-default-score))
9880
9881 (defun gnus-score-set (symbol value &optional alist)
9882   ;; Set SYMBOL to VALUE in ALIST.
9883   (let* ((alist 
9884           (or alist 
9885               gnus-score-alist
9886               (progn
9887                 (gnus-score-load (gnus-score-file-name gnus-newsgroup-name))
9888                 gnus-score-alist)))
9889          (entry (assoc symbol alist)))
9890     (cond ((gnus-score-get 'read-only alist)
9891            ;; This is a read-only score file, so we do nothing.
9892            )
9893           (entry
9894            (setcdr entry value))
9895           ((null alist)
9896            (error "Empty alist"))
9897           (t
9898            (setcdr alist
9899                    (cons (cons symbol value) (cdr alist)))))))
9900
9901 (defun gnus-score-get (symbol &optional alist)
9902   ;; Get SYMBOL's definition in ALIST.
9903   (cdr (assoc symbol 
9904               (or alist 
9905                   gnus-score-alist
9906                   (progn
9907                     (gnus-score-load 
9908                      (gnus-score-file-name gnus-newsgroup-name))
9909                     gnus-score-alist)))))
9910
9911 (defun gnus-score-change-score-file (file)
9912   "Change current score alist."
9913   (interactive
9914    (list (completing-read "Score file: " gnus-score-cache)))
9915   (setq gnus-current-score-file file)
9916   (gnus-score-load-file file))
9917
9918 (defun gnus-score-edit-file (file)
9919   "Edit score file."
9920   (interactive (list gnus-current-score-file))
9921   (and (buffer-name gnus-summary-buffer) (gnus-score-save))
9922   (setq gnus-winconf-edit-score (current-window-configuration))
9923   (gnus-configure-windows 'article)
9924   (pop-to-buffer (find-file-noselect file))
9925   (message (substitute-command-keys 
9926             "\\<gnus-score-mode-map>\\[gnus-score-edit-done] to save edits"))
9927   (gnus-score-mode))
9928   
9929 (defun gnus-score-load-file (file)
9930   ;; Load score file FILE.  Returns a list a retrieved score-alists.
9931   (let ((cached (assoc file gnus-score-cache))
9932         (global (member file gnus-internal-global-score-files))
9933         lists)
9934     (if cached
9935         ;; The score file was already loaded.
9936         (setq gnus-score-alist (cdr cached))
9937       ;; We load the score file.
9938       (setq gnus-score-alist nil)
9939       (gnus-score-load-score-alist file)
9940       ;; We add '(touched) to the alist to signify that it hasn't been
9941       ;; touched (yet). 
9942       (if (not (assq 'touched gnus-score-alist))
9943           (setq gnus-score-alist 
9944                 (cons (list 'touched nil) gnus-score-alist)))
9945       ;; If it is a global score file, we make it read-only.
9946       (and global
9947            (not (assq 'read-only gnus-score-alist))
9948            (setq gnus-score-alist 
9949                  (cons (list 'read-only t) gnus-score-alist)))
9950       ;; Update cache.
9951       (setq gnus-score-cache
9952             (cons (cons file gnus-score-alist) gnus-score-cache)))
9953     ;; If there are actual scores in the alist, we add it to the
9954     ;; return value of this function.
9955     (if (memq t (mapcar (lambda (e) (stringp (car e))) gnus-score-alist))
9956         (setq lists (list gnus-score-alist)))
9957     ;; Treat the other possible atoms in the score alist.
9958     (let ((mark (car (gnus-score-get 'mark gnus-score-alist)))
9959           (expunge (car (gnus-score-get 'expunge gnus-score-alist)))
9960           (mark-and-expunge 
9961            (car (gnus-score-get 'mark-and-expunge gnus-score-alist)))
9962           (read-only (gnus-score-get 'read-only gnus-score-alist))
9963           (files (gnus-score-get 'files gnus-score-alist))
9964           (eval (gnus-score-get 'eval gnus-score-alist)))
9965       ;; We do not respect eval and files atoms from global score
9966       ;; files. 
9967       (and files (not global)
9968            (setq lists (apply 'append lists
9969                               (mapcar (lambda (file)
9970                                         (gnus-score-load-file file)) 
9971                                       files))))
9972       (and eval (not global) (eval eval))
9973       (setq gnus-summary-mark-below (or mark mark-and-expunge 
9974                                         gnus-summary-default-score))
9975       (setq gnus-summary-expunge-below (or expunge mark-and-expunge)))
9976     (setq gnus-current-score-file file)
9977     lists))
9978
9979 (defun gnus-score-load (file)
9980   ;; Load score FILE.
9981   (let ((cache (assoc file gnus-score-cache)))
9982     (if cache
9983         (setq gnus-score-alist (cdr cache))
9984       (setq gnus-score-alist nil)
9985       (gnus-score-load-score-alist file)
9986       (or gnus-score-alist
9987           (setq gnus-score-alist (copy-alist '((touched . nil)))))
9988       (setq gnus-score-cache
9989             (cons (cons file gnus-score-alist) gnus-score-cache)))))
9990
9991 (defun gnus-score-remove-from-cache (file)
9992   (setq gnus-score-cache (delq (assoc file gnus-score-cache)
9993                                gnus-score-cache)))
9994
9995 (defun gnus-score-load-score-alist (file)
9996   (let (alist)
9997     (if (file-readable-p file)
9998         (progn
9999           (save-excursion
10000             (set-buffer (get-buffer-create " *gnus work*"))
10001             (buffer-disable-undo (current-buffer))
10002             (erase-buffer)
10003             (insert-file-contents file)
10004             (goto-char (point-min))
10005             (setq alist
10006                   (condition-case ()
10007                       (read (current-buffer))
10008                     (error 
10009                      (progn
10010                        (message "Problem with score file %s" file)
10011                        (ding) 
10012                        nil)))))
10013           (if (eq (car alist) 'setq)
10014               (setq gnus-score-alist
10015                     (gnus-score-transform-old-to-new alist))
10016             (setq gnus-score-alist alist))))))
10017
10018 (defun gnus-score-transform-old-to-new (alist)
10019   (let* ((alist (nth 2 alist))
10020          out entry)
10021     (if (eq (car alist) 'quote)
10022         (setq alist (nth 1 alist)))
10023     (while alist
10024       (setq entry (car alist))
10025       (if (stringp (car entry))
10026           (let ((scor (cdr entry)))
10027             (setq out (cons entry out))
10028             (while scor
10029               (setcar scor
10030                       (list (car (car scor)) (nth 2 (car scor))
10031                             (and (nth 3 (car scor))
10032                                  (gnus-day-number (nth 3 (car scor))))
10033                             (if (nth 1 (car scor)) 'r 's)))
10034               (setq scor (cdr scor))))
10035         (setq out (cons (list (car entry) (cdr entry)) out)))
10036       (setq alist (cdr alist)))
10037     (cons (list 'touched t) (nreverse out))))
10038   
10039 (defun gnus-score-save ()
10040   ;; Save all SCORE information.
10041   (let (cache)
10042     (save-excursion
10043       (set-buffer gnus-summary-buffer)
10044       (setq cache gnus-score-cache
10045             gnus-score-cache nil))
10046     (save-excursion
10047       (setq gnus-score-alist nil)
10048       (set-buffer (get-buffer-create "*Score*"))
10049       (buffer-disable-undo (current-buffer))
10050       (let (entry score file)
10051         (while cache
10052           (setq entry (car cache)
10053                 cache (cdr cache)
10054                 file (car entry)
10055                 score (cdr entry))
10056           (if (or (not (eq (gnus-score-get 'touched score) '(t)))
10057                   (gnus-score-get 'read-only score)
10058                   (not (file-writable-p file)))
10059               ()
10060             (setq score (delq (assq 'touched score) score))
10061             (erase-buffer)
10062             (let (emacs-lisp-mode-hook)
10063               (pp score (current-buffer)))
10064             (make-directory (file-name-directory file) t)
10065             (write-region (point-min) (point-max) file nil 'silent))))
10066       (kill-buffer (current-buffer)))))
10067   
10068 (defun gnus-score-headers ()
10069   ;; Score `gnus-newsgroup-headers'.
10070   (let ((score-files (and (symbolp gnus-score-find-score-files-function)
10071                           (fboundp gnus-score-find-score-files-function)
10072                           (funcall gnus-score-find-score-files-function
10073                                    gnus-newsgroup-name)))
10074         scores)
10075     ;; Load the SCORE files.
10076     (while score-files
10077       (setq scores (nconc (gnus-score-load-file (car score-files)) scores))
10078       (setq score-files (cdr score-files)))
10079     (if (not (and gnus-summary-default-score
10080                   scores
10081                   (> (length gnus-newsgroup-headers)
10082                      (length gnus-newsgroup-scored))))
10083         ()
10084       (let* ((entries gnus-header-index)
10085              (now (gnus-day-number (current-time-string)))
10086              (expire (- now gnus-score-expiry-days))
10087              (headers gnus-newsgroup-headers)
10088              entry header)
10089         (message "Scoring...")
10090         ;; Create articles, an alist of the form `(HEADER . SCORE)'.
10091         (while headers
10092           (setq header (car headers)
10093                 headers (cdr headers))
10094           ;; WARNING: The assq makes the function O(N*S) while it could
10095           ;; be written as O(N+S), where N is (length gnus-newsgroup-headers)
10096           ;; and S is (length gnus-newsgroup-scored).
10097           (or (assq (header-number header) gnus-newsgroup-scored)
10098               (setq gnus-scores-articles       ;Total of 2 * N cons-cells used.
10099                     (cons (cons header (or gnus-summary-default-score 0))
10100                           gnus-scores-articles))))
10101   
10102         (save-excursion
10103           (set-buffer (get-buffer-create "*Headers*"))
10104           (buffer-disable-undo (current-buffer))
10105           ;; Run each header through the score process.
10106           (while entries
10107             (setq entry (car entries)
10108                   header (nth 0 entry)
10109                   entries (cdr entries))
10110             (setq gnus-score-index (nth 1 (assoc header gnus-header-index)))
10111             (if (< 0 (apply 'max (mapcar
10112                                   (lambda (score)
10113                                     (length (gnus-score-get header score)))
10114                                   scores)))
10115                 (funcall (nth 2 entry) scores header now expire)))
10116           ;; Remove the buffer.
10117           (kill-buffer (current-buffer)))
10118
10119         ;; Add articles to `gnus-newsgroup-scored'.
10120         (while gnus-scores-articles
10121           (or (= gnus-summary-default-score (cdr (car gnus-scores-articles)))
10122               (setq gnus-newsgroup-scored
10123                     (cons (cons (header-number 
10124                                  (car (car gnus-scores-articles)))
10125                                 (cdr (car gnus-scores-articles)))
10126                           gnus-newsgroup-scored)))
10127           (setq gnus-scores-articles (cdr gnus-scores-articles)))
10128
10129         (message "Scoring...done")))))
10130
10131 ;;(defun gnus-score-integer (scores header now expire)
10132 ;;  )
10133
10134 ;;(defun gnus-score-date (scores header now expire)
10135 ;;  )
10136
10137 (defun gnus-score-string (scores header now expire)
10138   ;; Score ARTICLES according to HEADER in SCORES.
10139   ;; Update matches entries to NOW and remove unmatched entried older
10140   ;; than EXPIRE.
10141   
10142   ;; Insert the unique article headers in the buffer.
10143   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
10144         ;; gnus-score-index is used as a free variable.
10145         alike last this art entries alist articles)
10146
10147     ;; Sorting the articles costs os O(N*log N) but will allow us to
10148     ;; only match with each unique header.  Thus the actual matching
10149     ;; will be O(M*U) where M is the number of strings to match with,
10150     ;; and U is the number of unique headers.  It is assumed (but
10151     ;; untested) this will be a net win because of the large constant
10152     ;; factor involved with string matching.
10153     (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
10154           articles gnus-scores-articles)
10155
10156     (erase-buffer)
10157     (while articles
10158       (setq art (car articles)
10159             this (aref (car art) gnus-score-index)
10160             articles (cdr articles))
10161       (if (equal last this)
10162           ;; O(N*H) cons-cells used here, where H is the number of
10163           ;; headers.
10164           (setq alike (cons art alike))
10165         (if last
10166             (progn
10167               ;; Insert the line, with a text property on the
10168               ;; terminating newline refering to the articles with
10169               ;; this line.
10170               (insert last ?\n)
10171               (put-text-property (1- (point)) (point) 'articles alike)))
10172         (setq alike (list art)
10173               last this)))
10174     (and last                           ; Bwadr, duplicate code.
10175          (progn
10176            (insert last ?\n)                    
10177            (put-text-property (1- (point)) (point) 'articles alike)))
10178   
10179     ;; Find matches.
10180     (while scores
10181       (setq alist (car scores)
10182             scores (cdr scores)
10183             entries (assoc header alist))
10184       (while (cdr entries)              ;First entry is the header index.
10185         (let* ((rest (cdr entries))             
10186                (kill (car rest))
10187                (match (nth 0 kill))
10188                (type (or (nth 3 kill) 's))
10189                (score (or (nth 1 kill) gnus-score-interactive-default-score))
10190                (date (nth 2 kill))
10191                (found nil)
10192                (case-fold-search t)
10193                arts art)
10194           (goto-char (point-min))
10195           (while (cond ((eq type 'r)
10196                         (re-search-forward match nil t))
10197                        ((eq type 's)
10198                         (search-forward match nil t)))
10199             (end-of-line 1)
10200             (setq found t
10201                   arts (get-text-property (point) 'articles))
10202             ;; Found a match, update scores.
10203             (while arts
10204               (setq art (car arts)
10205                     arts (cdr arts))
10206               (setcdr art (+ score (cdr art)))))
10207           ;; Update expire date
10208           (cond ((null date))           ;Permanent entry.
10209                 (found                  ;Match, update date.
10210                  (gnus-score-set 'touched '(t) alist)
10211                  (setcar (nthcdr 2 kill) now))
10212                 ((< date expire) ;Old entry, remove.
10213                  (gnus-score-set 'touched '(t) alist)
10214                  (setcdr entries (cdr rest))
10215                  (setq rest entries)))
10216           (setq entries rest))))))
10217
10218 (defun gnus-score-string< (a1 a2)
10219   ;; Compare headers in articles A2 and A2.
10220   ;; The header index used is the free variable `gnus-score-index'.
10221   (string-lessp (aref (car a1) gnus-score-index)
10222                 (aref (car a2) gnus-score-index)))
10223
10224 (defun gnus-score-build-cons (article)
10225   ;; Build a `gnus-newsgroup-scored' type cons from ARTICLE.
10226   (cons (header-number (car article)) (cdr article)))
10227
10228 (defconst gnus-header-index
10229   ;; Name to index alist.
10230   '(("number" 0 gnus-score-integer)
10231     ("subject" 1 gnus-score-string)
10232     ("from" 2 gnus-score-string)
10233     ("date" 3 gnus-score-date)
10234     ("message-id" 4 gnus-score-string) 
10235     ("references" 5 gnus-score-string) 
10236     ("chars" 6 gnus-score-integer) 
10237     ("lines" 7 gnus-score-integer) 
10238     ("xref" 8 gnus-score-string)))
10239
10240 (defun gnus-score-file-name (newsgroup)
10241   "Return the name of a score file for NEWSGROUP."
10242   (cond  ((or (null newsgroup)
10243               (string-equal newsgroup ""))
10244           ;; The global score file is placed at top of the directory.
10245           (expand-file-name gnus-score-file-suffix
10246                             (or gnus-kill-files-directory "~/News")))
10247          (gnus-use-long-file-name
10248           ;; Append ".SCORE" to newsgroup name.
10249           (expand-file-name (concat newsgroup "." gnus-score-file-suffix)
10250                             (or gnus-kill-files-directory "~/News")))
10251          (t
10252           ;; Place "SCORE" under the hierarchical directory.
10253           (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
10254                                     "/" gnus-score-file-suffix)
10255                             (or gnus-kill-files-directory "~/News")))))
10256
10257 (defun gnus-score-score-files (group)
10258   "Return a list of all possible score files."
10259   (and gnus-global-score-files 
10260        (or gnus-internal-global-score-files
10261            (gnus-score-search-global-directories gnus-global-score-files)))
10262   (setq gnus-kill-files-directory 
10263         (file-name-as-directory
10264          (or gnus-kill-files-directory "~/News/")))
10265   (if (not (file-readable-p gnus-kill-files-directory))
10266       (setq gnus-score-file-list nil)
10267     (if gnus-use-long-file-name
10268         (if (or (not gnus-score-file-list)
10269                 (gnus-file-newer-than gnus-kill-files-directory
10270                                       (car gnus-score-file-list)))
10271               (setq gnus-score-file-list 
10272                     (cons (nth 5 (file-attributes gnus-kill-files-directory))
10273                           (nreverse 
10274                            (directory-files 
10275                             gnus-kill-files-directory t
10276                             (concat gnus-score-file-suffix "$"))))))
10277       (let ((dir (expand-file-name
10278                   (concat gnus-kill-files-directory
10279                           (gnus-replace-chars-in-string group ?. ?/))))
10280             (mdir (length (expand-file-name gnus-kill-files-directory)))
10281             files)
10282         (if (file-exists-p (concat dir "/" gnus-score-file-suffix))
10283             (setq files (list (concat dir "/" gnus-score-file-suffix))))
10284         (while (>= (1+ (length dir)) mdir)
10285           (and (file-exists-p (concat dir "/all/" gnus-score-file-suffix))
10286                (setq files (cons (concat dir "/all/" gnus-score-file-suffix)
10287                                  files)))
10288           (string-match "/[^/]*$" dir)
10289           (setq dir (substring dir 0 (match-beginning 0))))
10290         (setq gnus-score-file-list 
10291               (cons nil (nreverse files)))))
10292     (cdr gnus-score-file-list)))
10293         
10294 (defun gnus-score-find-single (group)
10295   "Return list containing the score file for GROUP."
10296   (list (gnus-score-file-name group)))
10297
10298 (defun gnus-score-find-hierarchical (group)
10299   "Return list of score files for GROUP.
10300 This includes the score file for the group and all its parents."
10301   (let ((all (copy-sequence '(nil)))
10302         (start 0))
10303     (while (string-match "\\." group (1+ start))
10304       (setq start (match-beginning 0))
10305       (setq all (cons (substring group 0 start) all)))
10306     (setq all (cons group all))
10307     (mapcar 'gnus-score-file-name (nreverse all))))
10308
10309 (defun gnus-score-find-bnews (group)
10310   "Return a list of score files for GROUP.
10311 The score files are those files in the ~/News directory which matches
10312 GROUP using BNews sys file syntax."
10313   (let* ((sfiles (append (gnus-score-score-files group)
10314                          gnus-internal-global-score-files))
10315          (kill-dir (file-name-as-directory 
10316                     (expand-file-name gnus-kill-files-directory)))
10317          (klen (length kill-dir))
10318          ofiles not-match regexp)
10319     (save-excursion
10320       (set-buffer (get-buffer-create "*gnus score files*"))
10321       (buffer-disable-undo (current-buffer))
10322       ;; Go through all score file names and create regexp with them
10323       ;; as the source.  
10324       (while sfiles
10325         (erase-buffer)
10326         (insert (car sfiles))
10327         (goto-char 1)
10328         ;; First remove the suffix itself.
10329         (re-search-forward (concat "." gnus-score-file-suffix "$"))
10330         (replace-match "") 
10331         (goto-char 1)
10332         (if (looking-at (regexp-quote kill-dir))
10333             ;; If the file name was just "SCORE", `klen' is one character
10334             ;; too much.
10335             (delete-char (min (1- (point-max)) klen))
10336           (goto-char (point-max))
10337           (search-backward "/")
10338           (delete-region (1+ (point)) (point-min)))
10339         ;; Translate "all" to ".*".
10340         (while (search-forward "all" nil t)
10341           (replace-match ".*"))
10342         (goto-char 1)
10343         ;; Deal with "not."s.
10344         (if (looking-at "not.")
10345             (progn
10346               (setq not-match t)
10347               (setq regexp (buffer-substring 5 (point-max))))
10348           (setq regexp (buffer-substring 1 (point-max)))
10349           (setq not-match nil))
10350         ;; Finally - if this resulting regexp matches the group name,
10351         ;; we add this score file to the list of score files
10352         ;; applicable to this group.
10353         (if (or (and not-match
10354                      (not (string-match regexp group)))
10355                 (and (not not-match)
10356                      (string-match regexp group)))
10357             (setq ofiles (cons (car sfiles) ofiles)))
10358         (setq sfiles (cdr sfiles)))
10359       (kill-buffer (current-buffer))
10360       ;; Slight kludge here - the last score file returned should be
10361       ;; the local score file, whether it exists or not. This is so
10362       ;; that any score commands the user enters will go to the right
10363       ;; file, and not end up in some global score file.
10364       (let ((localscore
10365              (expand-file-name
10366               (if gnus-use-long-file-name
10367                   (concat gnus-kill-files-directory group "." 
10368                           gnus-score-file-suffix)
10369                 (concat gnus-kill-files-directory
10370                         (gnus-replace-chars-in-string group ?. ?/)
10371                         "/" gnus-score-file-suffix)))))
10372         (and (member localscore ofiles)
10373              (delete localscore ofiles))
10374         (setq ofiles (cons localscore ofiles)))
10375       (nreverse ofiles))))
10376
10377 (defun gnus-score-search-global-directories (files)
10378   "Scan all global score directories for score files."
10379   ;; Set the variable `gnus-internal-global-score-files' to all
10380   ;; available global score files.
10381   (interactive (list gnus-global-score-files))
10382   (let (out)
10383     (while files
10384       (if (string-match "/$" (car files))
10385           (setq out (nconc (directory-files 
10386                             (car files) t
10387                             (concat gnus-score-file-suffix "$"))))
10388         (setq out (cons (car files) out)))
10389       (setq files (cdr files)))
10390     (setq gnus-internal-global-score-files out)))
10391
10392 ;;;
10393 ;;; Score mode.
10394 ;;;
10395
10396 (defvar gnus-score-mode-map nil)
10397 (defvar gnus-score-mode-hook nil)
10398
10399 (if gnus-score-mode-map
10400     ()
10401   (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map))
10402   (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-done)
10403   (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date))
10404
10405 (defun gnus-score-mode ()
10406   "Mode for editing score files.
10407 This mode is an extended emacs-lisp mode.
10408
10409 \\{gnus-score-mode-map}"
10410   (interactive)
10411   (kill-all-local-variables)
10412   (use-local-map gnus-score-mode-map)
10413   (set-syntax-table emacs-lisp-mode-syntax-table)
10414   (setq major-mode 'gnus-score-mode)
10415   (setq mode-name "Score")
10416   (lisp-mode-variables nil)
10417   (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
10418
10419 (defun gnus-score-edit-insert-date ()
10420   "Insert date in numerical format."
10421   (interactive)
10422   (insert (int-to-string (gnus-day-number (current-time-string)))))
10423
10424 (defun gnus-score-edit-done ()
10425   "Save the score file and return to the summary buffer."
10426   (interactive)
10427   (let ((bufnam (buffer-file-name (current-buffer))))
10428     (save-buffer)
10429     (kill-buffer (current-buffer))
10430     (and gnus-winconf-edit-score
10431          (set-window-configuration gnus-winconf-edit-score))
10432     (gnus-score-remove-from-cache bufnam)
10433     (gnus-score-load-file bufnam)))
10434
10435 \f
10436 ;;;
10437 ;;; Gnus Posting Functions
10438 ;;;
10439
10440 (defvar gnus-organization-file "/usr/lib/news/organization"
10441   "*Local news organization file.")
10442
10443 (defvar gnus-post-news-buffer "*post-news*")
10444 (defvar gnus-winconf-post-news nil)
10445
10446 ;;; Post news commands of Gnus group mode and summary mode
10447
10448 (defun gnus-group-post-news ()
10449   "Post an article."
10450   (interactive)
10451   (gnus-set-global-variables)
10452   ;; Save window configuration.
10453   (setq gnus-winconf-post-news (current-window-configuration))
10454   ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
10455   (or gnus-newsgroup-name (setq gnus-newsgroup-name (gnus-group-group-name)))
10456   (unwind-protect
10457       (gnus-post-news 'post)
10458     (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
10459              (not (zerop (buffer-size))))
10460         ;; Restore last window configuration.
10461         (and gnus-winconf-post-news
10462              (set-window-configuration gnus-winconf-post-news))))
10463   ;; We don't want to return to summary buffer nor article buffer later.
10464   (setq gnus-winconf-post-news nil)
10465   (if (get-buffer gnus-summary-buffer)
10466       (bury-buffer gnus-summary-buffer))
10467   (if (get-buffer gnus-article-buffer)
10468       (bury-buffer gnus-article-buffer)))
10469
10470 (defun gnus-summary-post-news ()
10471   "Post an article."
10472   (interactive)
10473   (gnus-set-global-variables)
10474   ;; Save window configuration.
10475   (setq gnus-winconf-post-news (current-window-configuration))
10476   (unwind-protect
10477       (gnus-post-news 'post gnus-newsgroup-name)
10478     (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
10479              (not (zerop (buffer-size))))
10480         ;; Restore last window configuration.
10481         (and gnus-winconf-post-news
10482              (set-window-configuration gnus-winconf-post-news))))
10483   ;; We don't want to return to article buffer later.
10484   (if (get-buffer gnus-article-buffer)
10485       (bury-buffer gnus-article-buffer)))
10486
10487 (defun gnus-summary-followup (yank)
10488   "Compose a followup to an article.
10489 If prefix argument YANK is non-nil, original article is yanked automatically."
10490   (interactive "P")
10491   (gnus-set-global-variables)
10492   (save-window-excursion
10493     (gnus-summary-select-article t))
10494   (let ((headers gnus-current-headers)
10495         (gnus-newsgroup-name gnus-newsgroup-name))
10496     ;; Check Followup-To: poster.
10497     (set-buffer gnus-article-buffer)
10498     (if (and gnus-use-followup-to
10499              (string-equal "poster" (gnus-fetch-field "followup-to"))
10500              (or (not (eq gnus-use-followup-to t))
10501                  (not (gnus-y-or-n-p 
10502                        "Do you want to ignore `Followup-To: poster'? "))))
10503         ;; Mail to the poster.  Gnus is now RFC1036 compliant.
10504         (gnus-summary-reply yank)
10505       ;; Save window configuration.
10506       (setq gnus-winconf-post-news (current-window-configuration))
10507       (unwind-protect
10508           (gnus-post-news nil gnus-newsgroup-name
10509                           headers gnus-article-buffer yank)
10510         (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
10511                  (not (zerop (buffer-size))))
10512             ;; Restore last window configuration.
10513             (and gnus-winconf-post-news
10514                  (set-window-configuration gnus-winconf-post-news))))
10515       ;; We don't want to return to article buffer later.
10516       (bury-buffer gnus-article-buffer))))
10517
10518 (defun gnus-summary-followup-with-original ()
10519   "Compose a followup to an article and include the original article."
10520   (interactive)
10521   (gnus-summary-followup t))
10522
10523 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
10524 (defun gnus-summary-followup-and-reply (yank)
10525   "Compose a followup and do an auto mail to author."
10526   (interactive "P")
10527   (let ((gnus-auto-mail-to-author t))
10528     (gnus-summary-followup yank)))
10529
10530 (defun gnus-summary-followup-and-reply-with-original ()
10531   "Compose a followup, include the original, and do an auto mail to author."
10532   (interactive)
10533   (gnus-summary-followup-and-reply t))
10534
10535 (defun gnus-summary-cancel-article ()
10536   "Cancel an article you posted."
10537   (interactive)
10538   (gnus-set-global-variables)
10539   (gnus-summary-select-article t)
10540   (gnus-eval-in-buffer-window gnus-article-buffer
10541                               (gnus-cancel-news)))
10542
10543 (defun gnus-summary-supersede-article ()
10544   "Compose an article that will supersede a previous article.
10545 This is done simply by taking the old article and adding a Supersedes
10546 header line with the old Message-ID."
10547   (interactive)
10548   (gnus-set-global-variables)
10549   (if (not
10550        (string-equal
10551         (downcase (mail-strip-quoted-names 
10552                    (header-from gnus-current-headers)))
10553         (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
10554       (error "This article is not yours."))
10555   (gnus-summary-select-article t)
10556   (save-excursion
10557     (set-buffer gnus-article-buffer)
10558     (let ((buffer-read-only nil))
10559       (goto-char (point-min))
10560       (search-forward "\n\n" nil t)
10561       (if (not (re-search-backward "^Message-ID: " nil t))
10562           (error "No Message-ID in this article"))))
10563   (if (gnus-post-news 'post gnus-newsgroup-name)
10564       (progn
10565         (erase-buffer)
10566         (insert-buffer gnus-article-buffer)
10567         (goto-char (point-min))
10568         (search-forward "\n\n" nil t)
10569         (if (not (re-search-backward "^Message-ID: " nil t))
10570             (error "No Message-ID in this article")
10571           (replace-match "Supersedes: "))
10572         (search-forward "\n\n")
10573         (forward-line -1)
10574         (insert mail-header-separator))))
10575
10576 \f
10577 ;;;###autoload
10578 (fset 'sendnews 'gnus-post-news)
10579
10580 ;;;###autoload
10581 (fset 'postnews 'gnus-post-news)
10582
10583 (defun gnus-post-news (post &optional group header article-buffer yank)
10584   "Begin editing a new USENET news article to be posted.
10585 Type \\[describe-mode] in the buffer to get a list of commands."
10586   (interactive (list t))
10587   (if (or (not gnus-novice-user)
10588           gnus-expert-user
10589           (not (eq 'post 
10590                    (nth 1 (assoc 
10591                            (format "%s" (car (gnus-find-method-for-group 
10592                                               gnus-newsgroup-name)))
10593                            gnus-valid-select-methods))))
10594           (assq 'to-address (gnus-find-method-for-group gnus-newsgroup-name))
10595           (gnus-y-or-n-p "Are you sure you want to post to all of USENET? "))
10596       (let ((sumart (if (not post)
10597                         (save-excursion
10598                           (set-buffer gnus-summary-buffer)
10599                           (cons (current-buffer) gnus-current-article))))
10600             (from (and header (header-from header)))
10601             subject follow-to real-group)
10602         (and gnus-interactive-post
10603              (not gnus-expert-user)
10604              post (not group)
10605              (progn
10606                (setq group 
10607                      (completing-read "Group: " gnus-active-hashtb nil t))
10608                (setq subject (read-string "Subject: "))))
10609         (setq mail-reply-buffer article-buffer)
10610
10611         (setq real-group (gnus-group-real-name group))
10612         (setq gnus-post-news-buffer 
10613               (gnus-request-post-buffer 
10614                post real-group subject header article-buffer
10615                (nth 2 (gnus-gethash group gnus-newsrc-hashtb))
10616                (if (and (boundp 'gnus-followup-to-function)
10617                         gnus-followup-to-function)
10618                    (setq follow-to
10619                          (save-excursion
10620                            (set-buffer article-buffer)
10621                            (funcall gnus-followup-to-function group))))
10622                (eq gnus-use-followup-to t)))
10623         (if post
10624             (progn
10625               (gnus-configure-windows '(1 0 0))
10626               (switch-to-buffer gnus-post-news-buffer))
10627           (gnus-configure-windows '(0 1 0))
10628           (if (not yank)
10629               (progn
10630                 (switch-to-buffer article-buffer)
10631                 (pop-to-buffer gnus-post-news-buffer))
10632             (switch-to-buffer gnus-post-news-buffer)))
10633         (gnus-overload-functions)
10634         (make-local-variable 'gnus-article-reply)
10635         (make-local-variable 'gnus-article-check-size)
10636         (setq gnus-article-reply sumart)
10637         ;; Handle `gnus-auto-mail-to-author'.
10638         ;; Suggested by Daniel Quinlan <quinlan@best.com>.
10639         (let ((to (if (eq gnus-auto-mail-to-author 'ask)
10640                       (and (y-or-n-p "Also send mail to author? ") from)
10641                     (and gnus-auto-mail-to-author from))))
10642           (if to
10643               (progn
10644                 (if (mail-fetch-field "To")
10645                     (progn
10646                       (beginning-of-line)
10647                       (insert "Cc: " to "\n"))
10648                   (mail-position-on-field "To")
10649                   (insert to)))))
10650         ;; Handle author copy using BCC field.
10651         (if (and gnus-mail-self-blind
10652                  (not (mail-fetch-field "bcc")))
10653             (progn
10654               (mail-position-on-field "Bcc")
10655               (insert (if (stringp gnus-mail-self-blind)
10656                           gnus-mail-self-blind
10657                         (user-login-name)))))
10658         ;; Handle author copy using FCC field.
10659         (if gnus-author-copy
10660             (progn
10661               (mail-position-on-field "Fcc")
10662               (insert gnus-author-copy)))
10663         (goto-char (point-min))
10664         (if post 
10665             (cond ((not group)
10666                    (re-search-forward "^Newsgroup:" nil t)
10667                    (end-of-line))
10668                   ((not subject)
10669                    (re-search-forward "^Subject:" nil t)
10670                    (end-of-line))
10671                   (t
10672                    (search-forward (concat "\n" mail-header-separator "\n"))))
10673           (search-forward (concat "\n" mail-header-separator "\n"))
10674           (if yank 
10675               (save-excursion
10676                 (run-hooks 'news-reply-header-hook)
10677                 (mail-yank-original nil)))
10678           (if gnus-post-prepare-function
10679               (funcall gnus-post-prepare-function group)))))
10680   (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum)))
10681   (message "")
10682   t)
10683
10684 (defun gnus-inews-news (&optional use-group-method)
10685   "Send a news message.
10686 If given a prefix, and the group is a foreign group, this function
10687 will attempt to use the foreign server to post the article."
10688   (interactive "P")
10689   ;; Check whether the article is a good Net Citizen.
10690   (if (and gnus-article-check-size (not (gnus-inews-check-post)))
10691       ;; Aber nein!
10692       ()
10693     ;; Looks ok, so we do the nasty.
10694     (let* ((case-fold-search nil)
10695            (server-running (gnus-server-opened gnus-select-method))
10696            (reply gnus-article-reply))
10697       (save-excursion
10698         ;; Connect to default NNTP server if necessary.
10699         ;; Suggested by yuki@flab.fujitsu.junet.
10700         (gnus-start-news-server)        ;Use default server.
10701         ;; NNTP server must be opened before current buffer is modified.
10702         (widen)
10703         (goto-char (point-min))
10704         (run-hooks 'news-inews-hook)
10705         (save-restriction
10706           (narrow-to-region
10707            (point-min)
10708            (progn
10709              (goto-char (point-min))
10710              (search-forward (concat "\n" mail-header-separator "\n"))
10711              (point)))
10712
10713           ;; Correct newsgroups field: change sequence of spaces to comma and 
10714           ;; eliminate spaces around commas.  Eliminate imbedded line breaks.
10715           (goto-char (point-min))
10716           (if (search-forward-regexp "^Newsgroups: +" nil t)
10717               (save-restriction
10718                 (narrow-to-region
10719                  (point)
10720                  (if (re-search-forward "^[^ \t]" nil 'end)
10721                      (match-beginning 0)
10722                    (point-max)))
10723                 (goto-char (point-min))
10724                 (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
10725                 (goto-char (point-min))
10726                 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
10727
10728           ;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
10729           ;; Help save the the world!
10730           (or 
10731            gnus-expert-user
10732            (let ((newsgroups (mail-fetch-field "newsgroups"))
10733                  (followup-to (mail-fetch-field "followup-to"))
10734                  groups to)
10735              (if (and (string-match "," newsgroups) (not followup-to))
10736                  (progn
10737                    (while (string-match "," newsgroups)
10738                      (setq groups
10739                            (cons (list (substring newsgroups
10740                                                   0 (match-beginning 0)))
10741                                  groups))
10742                      (setq newsgroups (substring newsgroups (match-end 0))))
10743                    (setq groups (nreverse (cons (list newsgroups) groups)))
10744
10745                    (setq to
10746                          (completing-read "Followups to: (default all groups) "
10747                                           groups))
10748                    (if (> (length to) 0)
10749                        (progn
10750                          (goto-char (point-min))
10751                          (insert "Followup-To: " to "\n")))))))
10752
10753           ;; Cleanup Followup-To.
10754           (goto-char (point-min))
10755           (if (search-forward-regexp "^Followup-To: +" nil t)
10756               (save-restriction
10757                 (narrow-to-region
10758                  (point)
10759                  (if (re-search-forward "^[^ \t]" nil 'end)
10760                      (match-beginning 0)
10761                    (point-max)))
10762                 (goto-char (point-min))
10763                 (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
10764                 (goto-char (point-min))
10765                 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
10766
10767           ;; Mail the message too if To:, Bcc:. or Cc: exists.
10768           (if (or (mail-fetch-field "to" nil t)
10769                   (mail-fetch-field "bcc" nil t)
10770                   (mail-fetch-field "cc" nil t))
10771               (if gnus-mail-send-method
10772                   (save-excursion
10773                     (save-restriction
10774                       (widen)
10775                       (message "Sending via mail...")
10776                       
10777                       (if gnus-mail-courtesy-message
10778                           (progn
10779                             ;; Insert "courtesy" mail message.
10780                             (goto-char 1)
10781                             (re-search-forward mail-header-separator)
10782                             (forward-line 1)
10783                             (insert gnus-mail-courtesy-message)
10784                             (funcall gnus-mail-send-method)
10785                             (goto-char 1)
10786                             (search-forward gnus-mail-courtesy-message)
10787                             (replace-match ""))
10788                         (funcall gnus-mail-send-method))
10789
10790                       (message "Sending via mail... done")
10791                       
10792                       (goto-char 1)
10793                       (narrow-to-region
10794                        1 (re-search-forward mail-header-separator))
10795                       (goto-char 1)
10796                       (delete-matching-lines "BCC:.*")))
10797                 (ding)
10798                 (message "No mailer defined.  To: and/or Cc: fields ignored.")
10799                 (sit-for 1))))
10800
10801         ;; Send to NNTP server. 
10802         (message "Posting to USENET...")
10803         (if (gnus-inews-article use-group-method)
10804             (progn
10805               (message "Posting to USENET... done")
10806               (if (and reply
10807                        (get-buffer (car reply))
10808                        (buffer-name (car reply)))
10809                   (progn
10810                     (save-excursion
10811                       (set-buffer gnus-summary-buffer)
10812                       (gnus-summary-mark-article-as-replied 
10813                        (cdr reply))))))
10814           ;; We cannot signal an error.
10815           (ding) (message "Article rejected: %s" 
10816                           (gnus-status-message gnus-select-method)))
10817         (set-buffer-modified-p nil))
10818       ;; If NNTP server is opened by gnus-inews-news, close it by myself.
10819       (or server-running
10820           (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name)))
10821       (and (fboundp 'bury-buffer) (bury-buffer))
10822       ;; Restore last window configuration.
10823       (and gnus-winconf-post-news
10824            (set-window-configuration gnus-winconf-post-news))
10825       (setq gnus-winconf-post-news nil))))
10826
10827 (defun gnus-inews-check-post ()
10828   "Check whether the post looks ok."
10829   (and 
10830    ;; Check excessive size.
10831    (if (> (buffer-size) 60000)
10832        (gnus-y-or-n-p (format "The article is %d octets long. Really post? "
10833                               (buffer-size)))
10834      t)
10835    ;; Check for commands in Subject.
10836    (save-excursion
10837      (save-restriction
10838        (goto-char (point-min))
10839        (narrow-to-region (point) (search-forward mail-header-separator))
10840        (if (string-match "^cmsg " (mail-fetch-field "subject"))
10841            (gnus-y-or-n-p
10842             "The control code \"cmsg \" is in the subject. Really post? ")
10843          t)))
10844    ;; Check for control characters.
10845    (save-excursion
10846      (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
10847          (gnus-y-or-n-p 
10848           "The article contains control characters. Really post? ")
10849        t))
10850    ;; Check for multiple identical headers.
10851    (let (found)
10852      (save-excursion
10853        (save-restriction
10854          (goto-char (point-min))
10855          (narrow-to-region (point) (search-forward mail-header-separator))
10856          (goto-char (point-min))
10857          (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t))
10858            (save-excursion
10859              (or (re-search-forward 
10860                   (concat "^" (setq found
10861                                     (buffer-substring (match-beginning 0) 
10862                                                       (match-end 0))))
10863                   nil t)
10864                  (setq found nil))))
10865          (if found
10866              (gnus-y-or-n-p 
10867               (format "Multiple %s headers. Really post? " found))
10868            t))))
10869    ;; Check for version and sendsys.
10870    (save-excursion
10871      (save-restriction
10872        (goto-char (point-min))
10873        (narrow-to-region (point) (search-forward mail-header-separator))
10874        (if (re-search-backward "^Sendsys:\\|^Version:" nil t)
10875            (gnus-yes-or-no-p
10876             (format "The article contains a %s command. Really post? "
10877                     (buffer-substring (match-beginning 0) (match-end 0))))
10878          t)))
10879    (save-excursion
10880      (save-restriction
10881        (goto-char (point-min))
10882        (narrow-to-region (point) (search-forward mail-header-separator))
10883        (let* ((case-fold-search t)
10884               (from (mail-fetch-field "from")))
10885          (if (and from
10886                   (string-match "@" from)
10887                   (not (string-match "@[^\\.]*\\." from)))
10888              (gnus-yes-or-no-p
10889               (format "The domain looks strange: \"%s\". Really post? "
10890                       from))
10891            t))))
10892    ;; Use the (size . checksum) variable to see whether the
10893    ;; article is empty or has only quoted text.
10894    (if (and (= (buffer-size) (car gnus-article-check-size))
10895             (= (gnus-article-checksum) (cdr gnus-article-check-size)))
10896        (gnus-yes-or-no-p
10897         "It looks like there's no new text in your article. Really post? ")
10898      t)))
10899
10900 (defun gnus-article-checksum ()
10901   (let ((sum 0))
10902     (save-excursion
10903       (while (not (eobp))
10904         (setq sum (logxor sum (following-char)))
10905         (forward-char 1)))
10906     sum))
10907
10908 (defun gnus-cancel-news ()
10909   "Cancel an article you posted."
10910   (interactive)
10911   (if (gnus-yes-or-no-p "Do you really want to cancel this article? ")
10912       (let ((from nil)
10913             (newsgroups nil)
10914             (message-id nil)
10915             (distribution nil))
10916         (save-excursion
10917           ;; Get header info. from original article.
10918           (save-restriction
10919             (gnus-article-show-all-headers)
10920             (goto-char (point-min))
10921             (search-forward "\n\n" nil 'move)
10922             (narrow-to-region (point-min) (point))
10923             (setq from (mail-fetch-field "from"))
10924             (setq newsgroups (mail-fetch-field "newsgroups"))
10925             (setq message-id (mail-fetch-field "message-id"))
10926             (setq distribution (mail-fetch-field "distribution")))
10927           ;; Verify if the article is absolutely user's by comparing
10928           ;; user id with value of its From: field.
10929           (if (not
10930                (string-equal
10931                 (downcase (mail-strip-quoted-names from))
10932                 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
10933               (progn
10934                 (ding) (message "This article is not yours."))
10935             ;; Make control article.
10936             (set-buffer (get-buffer-create " *Gnus-canceling*"))
10937             (buffer-disable-undo (current-buffer))
10938             (erase-buffer)
10939             (insert "Newsgroups: " newsgroups "\n"
10940                     "Subject: cancel " message-id "\n"
10941                     "Control: cancel " message-id "\n"
10942                     mail-header-separator "\n"
10943                     "This is a cancel message from " from ".\n")
10944             ;; Send the control article to NNTP server.
10945             (message "Canceling your article...")
10946             (if (gnus-inews-article)
10947                 (message "Canceling your article... done")
10948               (ding) (message "Failed to cancel your article"))
10949             ;; Kill the article buffer.
10950             (kill-buffer (current-buffer)))))))
10951
10952 \f
10953 ;;; Lowlevel inews interface
10954
10955 (defun gnus-inews-article (&optional use-group-method)
10956   "Post an article in current buffer using NNTP protocol."
10957   (let ((artbuf (current-buffer))
10958         (tmpbuf (get-buffer-create " *Gnus-posting*")))
10959     (widen)
10960     (goto-char (point-max))
10961     ;; require a newline at the end for inews to append .signature to
10962     (or (= (preceding-char) ?\n)
10963         (insert ?\n))
10964     ;; Prepare article headers.  All message body such as signature
10965     ;; must be inserted before Lines: field is prepared.
10966     (save-restriction
10967       (goto-char (point-min))
10968       (narrow-to-region 
10969        (point-min) 
10970        (save-excursion
10971          (search-forward (concat "\n" mail-header-separator "\n")) 
10972          (forward-line -1) 
10973          (point)))
10974       (gnus-inews-insert-headers)
10975       (run-hooks gnus-inews-article-header-hook)
10976       (widen))
10977     (save-excursion
10978       (set-buffer tmpbuf)
10979       (buffer-disable-undo (current-buffer))
10980       (erase-buffer)
10981       (insert-buffer-substring artbuf)
10982       ;; Remove the header separator.
10983       (goto-char (point-min))
10984       (search-forward (concat "\n" mail-header-separator "\n"))
10985       (replace-match "\n\n")
10986       ;; This hook may insert a signature.
10987       (run-hooks 'gnus-prepare-article-hook)
10988       ;; Run final inews hooks.  This hook may do FCC.
10989       ;; The article must be saved before being posted because
10990       ;; `gnus-request-post' modifies the buffer.
10991       (run-hooks 'gnus-inews-article-hook)
10992       ;; Post an article to NNTP server.
10993       ;; Return NIL if post failed.
10994       (prog1
10995           (gnus-request-post 
10996            (if use-group-method
10997                (gnus-find-method-for-group gnus-newsgroup-name)
10998              gnus-select-method) use-group-method)
10999         (kill-buffer (current-buffer))))))
11000
11001 (defun gnus-inews-insert-headers ()
11002   "Prepare article headers.
11003 Headers already prepared in the buffer are not modified.
11004 Headers in `gnus-required-headers' will be generated."
11005   (let ((Date (gnus-inews-date))
11006         (Message-ID (gnus-inews-message-id))
11007         (Organization (gnus-inews-organization))
11008         (From (gnus-inews-user-name))
11009         (Path (gnus-inews-path))
11010         (Subject nil)
11011         (Newsgroups nil)
11012         (Distribution nil)
11013         (Lines (gnus-inews-lines))
11014         (X-Newsreader gnus-version)
11015         (headers gnus-required-headers)
11016         (case-fold-search t)
11017         header value)
11018     ;; First we remove any old Message-IDs. This might be slightly
11019     ;; fascist, but if the user really wants to generate Message-IDs
11020     ;; by herself, she should remove it from the `gnus-required-list'. 
11021     (goto-char (point-min))
11022     (and (memq 'Message-ID headers)
11023          (re-search-forward "^Message-ID:" nil t)
11024          (delete-region (progn (beginning-of-line) (point))
11025                         (progn (forward-line 1) (point))))
11026     ;; Remove NNTP-posting-host.
11027     (goto-char (point-min))
11028     (and (re-search-forward "nntp-posting-host^:" nil t)
11029          (delete-region (progn (beginning-of-line) (point))
11030                         (progn (forward-line 1) (point))))
11031     ;; Insert new Sender if the From is strange. 
11032     (let ((from (mail-fetch-field "from")))
11033       (if (and from (not (string= (downcase from) (downcase From))))
11034           (progn
11035             (goto-char (point-min))    
11036             (and (re-search-forward "^Sender:" nil t)
11037                  (delete-region (progn (beginning-of-line) (point))
11038                                 (progn (forward-line 1) (point))))
11039             (insert "Sender: " From "\n"))))
11040     ;; If there are References, and no "Re: ", then the thread has
11041     ;; changed name. See Son-of-1036.
11042     (if (and (mail-fetch-field "references")
11043              (get-buffer gnus-article-buffer))
11044         (let ((psubject (gnus-simplify-subject-re
11045                          (mail-fetch-field "subject")))
11046               subject)
11047           (save-excursion
11048             (set-buffer (get-buffer gnus-article-buffer))
11049             (save-restriction
11050               (gnus-narrow-to-headers)
11051               (if (setq subject (mail-fetch-field "subject"))
11052                   (progn
11053                     (and gnus-summary-gather-subject-limit
11054                          (> (length subject) gnus-summary-gather-subject-limit)
11055                          (setq subject
11056                                (substring subject 0
11057                                           gnus-summary-gather-subject-limit)))
11058                     (setq subject (gnus-simplify-subject-re subject))))))
11059           (or (and psubject subject (string= subject psubject))
11060               (progn
11061                 (string-match "@" Message-ID)
11062                 (setq Message-ID
11063                       (concat (substring Message-ID 0 (match-beginning 0))
11064                               "_-_" 
11065                               (substring Message-ID (match-beginning 0))))))))
11066     ;; Go through all the required headers and see if they are in the
11067     ;; articles already. If they are not, or are empty, they are
11068     ;; inserted automatically - except for Subject, Newsgroups and
11069     ;; Distribution. 
11070     (while headers
11071       (goto-char (point-min))
11072       (setq header (car headers))
11073       (if (or (not (re-search-forward 
11074                     (concat "^" (downcase (symbol-name header)) ":") nil t))
11075               (progn
11076                 (if (= (following-char) ? ) (forward-char 1) (insert " "))
11077                 (looking-at "[ \t]*$")))
11078           (progn
11079             (setq value (or (and (boundp header) (symbol-value header))
11080                             (read-from-minibuffer
11081                              (format "Empty header for %s; enter value: " 
11082                                      header))))
11083             (if (bolp)
11084                 (save-excursion
11085                   (goto-char (point-max))
11086                   (insert (symbol-name header) ": " value "\n"))
11087               (replace-match value))))
11088       (setq headers (cdr headers)))))
11089
11090 (defun gnus-inews-insert-signature ()
11091   "Insert a signature file.
11092 If `gnus-signature-function' is bound and returns a string, this
11093 string is used instead of the variable `gnus-signature-file'.
11094 In either case, if the string is a file name, this file is
11095 inserted. If the string is not a file name, the string itself is
11096 inserted. 
11097 If you never want any signature inserted, set both those variables to
11098 nil."
11099   (save-excursion
11100     (let ((signature 
11101            (or (and gnus-signature-function
11102                     (fboundp gnus-signature-function)
11103                     (funcall gnus-signature-function gnus-newsgroup-name))
11104                gnus-signature-file))
11105           b)
11106       (if (and signature
11107                (or (file-exists-p signature)
11108                    (string-match " " signature)
11109                    (not (string-match 
11110                          "^/[^/]+/" (expand-file-name signature)))))
11111           (progn
11112             (goto-char (point-max))
11113             ;; Delete any previous signatures.
11114             (if (and mail-signature (search-backward "\n-- \n" nil t))
11115                 (delete-region (1+ (point)) (point-max)))
11116             (insert "\n-- \n")
11117             (and (< 4 (setq b (count-lines 
11118                                (point)
11119                                (progn
11120                                  (if (file-exists-p signature)
11121                                      (insert-file-contents signature)
11122                                    (insert signature))
11123                                  (goto-char (point-max))
11124                                  (or (bolp) (insert "\n"))
11125                                  (point)))))
11126                  (not gnus-expert-user)
11127                  (not
11128                   (gnus-y-or-n-p
11129                    (format
11130                     "Your .sig is %d lines; it should be max 4. Really post? "
11131                     b)))
11132                  (if (file-exists-p signature)
11133                      (error (format "Edit %s." signature))
11134                    (error "Trim your signature."))))))))
11135
11136 (defun gnus-inews-do-fcc ()
11137   "Process FCC: fields in current article buffer.
11138 Unless the first character of the field is `|', the article is saved
11139 to the specified file using the function specified by the variable
11140 gnus-author-copy-saver.  The default function rmail-output saves in
11141 Unix mailbox format.
11142 If the first character is `|', the contents of the article is send to
11143 a program specified by the rest of the value."
11144   (let ((fcc-list nil)
11145         (fcc-file nil)
11146         (case-fold-search t))           ;Should ignore case.
11147     (save-excursion
11148       (save-restriction
11149         (goto-char (point-min))
11150         (search-forward "\n\n")
11151         (narrow-to-region (point-min) (point))
11152         (goto-char (point-min))
11153         (while (re-search-forward "^FCC:[ \t]*" nil t)
11154           (setq fcc-list
11155                 (cons (buffer-substring
11156                        (point)
11157                        (progn
11158                          (end-of-line)
11159                          (skip-chars-backward " \t")
11160                          (point)))
11161                       fcc-list))
11162           (delete-region (match-beginning 0)
11163                          (progn (forward-line 1) (point))))
11164         ;; Process FCC operations.
11165         (widen)
11166         (while fcc-list
11167           (setq fcc-file (car fcc-list))
11168           (setq fcc-list (cdr fcc-list))
11169           (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
11170                  (let ((program (substring fcc-file
11171                                            (match-beginning 1) (match-end 1))))
11172                    ;; Suggested by yuki@flab.fujitsu.junet.
11173                    ;; Send article to named program.
11174                    (call-process-region (point-min) (point-max) shell-file-name
11175                                         nil nil nil "-c" program)))
11176                 (t
11177                  ;; Suggested by hyoko@flab.fujitsu.junet.
11178                  ;; Save article in Unix mail format by default.
11179                  (if (and gnus-author-copy-saver
11180                           (not (eq gnus-author-copy-saver 'rmail-output)))
11181                      (funcall gnus-author-copy-saver fcc-file)
11182                    (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file))
11183                        (gnus-output-to-rmail fcc-file)
11184                      (rmail-output fcc-file 1 t t))))))))))
11185
11186 (defun gnus-inews-path ()
11187   "Return uucp path."
11188   (let ((login-name (gnus-inews-login-name)))
11189     (cond ((null gnus-use-generic-path)
11190            (concat (nth 1 gnus-select-method) "!" login-name))
11191           ((stringp gnus-use-generic-path)
11192            ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
11193            (concat gnus-use-generic-path "!" login-name))
11194           (t login-name))))
11195
11196 (defun gnus-inews-user-name ()
11197   "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
11198   (let ((full-name (gnus-inews-full-name)))
11199     (concat (if (or gnus-user-login-name gnus-use-generic-from
11200                     gnus-local-domain (getenv "DOMAINNAME"))
11201                 (concat (gnus-inews-login-name) "@"
11202                         (gnus-inews-domain-name gnus-use-generic-from))
11203               user-mail-address)
11204             ;; User's full name.
11205             (cond ((string-equal full-name "") "")
11206                   ((string-equal full-name "&") ;Unix hack.
11207                    (concat " (" (user-login-name) ")"))
11208                   (t
11209                    (concat " (" full-name ")"))))))
11210
11211 (defun gnus-inews-login-name ()
11212   "Return login name."
11213   (or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
11214
11215 (defun gnus-inews-full-name ()
11216   "Return full user name."
11217   (or gnus-user-full-name (getenv "NAME") (user-full-name)))
11218
11219 (defun gnus-inews-domain-name (&optional genericfrom)
11220   "Return user's domain name.
11221 If optional argument GENERICFROM is a string, use it as the domain
11222 name; if it is non-nil, strip off local host name from the domain name.
11223 If the function `system-name' returns full internet name and the
11224 domain is undefined, the domain name is got from it."
11225   (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
11226       (let* ((system-name (system-name))
11227              (domain 
11228               (or (if (stringp genericfrom) genericfrom)
11229                   (getenv "DOMAINNAME")
11230                   gnus-local-domain
11231                   ;; Function `system-name' may return full internet name.
11232                   ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
11233                   (if (string-match "\\." system-name)
11234                       (substring system-name (match-end 0)))
11235                   (read-string "Domain name (no host): ")))
11236              (host (or (if (string-match "\\." system-name)
11237                            (substring system-name 0 (match-beginning 0)))
11238                        system-name)))
11239         (if (string-equal "." (substring domain 0 1))
11240             (setq domain (substring domain 1)))
11241         ;; Support GENERICFROM as same as standard Bnews system.
11242         ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
11243         (cond ((null genericfrom)
11244                (concat host "." domain))
11245               ;;((stringp genericfrom) genericfrom)
11246               (t domain)))
11247     (if (string-match "\\." (system-name))
11248         (system-name)
11249       (substring user-mail-address 
11250                  (1+ (string-match "@" user-mail-address))))))
11251
11252 (defun gnus-inews-full-address ()
11253   (let ((domain (gnus-inews-domain-name))
11254         (system (system-name))
11255         (case-fold-search t))
11256     (if (string-match "\\." system) system
11257       (if (string-match (concat "^" (regexp-quote system)) domain) domain
11258         (concat system "." domain)))))
11259
11260 (defun gnus-inews-message-id ()
11261   "Generate unique Message-ID for user."
11262   ;; Message-ID should not contain a slash and should be terminated by
11263   ;; a number.  I don't know the reason why it is so.
11264   (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">"))
11265
11266 (defun gnus-inews-unique-id ()
11267   "Generate unique ID from user name and current time."
11268   (concat (downcase (gnus-inews-login-name))
11269           (mapconcat 
11270            (lambda (num) (gnus-number-base-x num 3 31))
11271            (current-time) "")))
11272
11273 (defun gnus-inews-date ()
11274   "Current time string."
11275   (timezone-make-date-arpa-standard 
11276    (current-time-string) (current-time-zone)))
11277
11278 (defun gnus-inews-organization ()
11279   "Return user's organization.
11280 The ORGANIZATION environment variable is used if defined.
11281 If not, the variable `gnus-local-organization' is used instead.
11282 If it is a function, the function will be called with the current
11283 newsgroup name as the argument.
11284 If this is a file name, the contents of this file will be used as the
11285 organization."
11286   (let* ((organization 
11287           (or (getenv "ORGANIZATION")
11288               (if gnus-local-organization
11289                   (if (and (symbolp gnus-local-organization)
11290                            (fboundp gnus-local-organization))
11291                       (funcall gnus-local-organization gnus-newsgroup-name)
11292                     gnus-local-organization))
11293               gnus-organization-file
11294               "~/.organization")))
11295     (and (stringp organization)
11296          (> (length organization) 0)
11297          (or (file-exists-p organization)
11298              (string-match " " organization)
11299              (not (string-match  "^/[^/]+/" (expand-file-name organization))))
11300          (save-excursion
11301            (set-buffer (get-buffer-create " *Gnus organization*"))
11302            (buffer-disable-undo (current-buffer))
11303            (erase-buffer)
11304            (if (file-exists-p organization)
11305                (insert-file-contents organization)
11306              (insert organization))
11307            (goto-char (point-min))
11308            (while (re-search-forward " *\n *" nil t)
11309              (replace-match " "))
11310            (buffer-substring (point-min) (point-max))))))
11311
11312 (defun gnus-inews-lines ()
11313   "Count the number of lines and return numeric string."
11314   (save-excursion
11315     (save-restriction
11316       (widen)
11317       (goto-char (point-min))
11318       (search-forward "\n\n" nil 'move)
11319       (int-to-string (count-lines (point) (point-max))))))
11320
11321 \f
11322 ;;;
11323 ;;; Gnus Mail Functions 
11324 ;;;
11325
11326 ;;; Mail reply commands of Gnus summary mode
11327
11328 (defun gnus-summary-reply (yank)
11329   "Reply mail to news author.
11330 If prefix argument YANK is non-nil, original article is yanked automatically.
11331 Customize the variable gnus-mail-reply-method to use another mailer."
11332   (interactive "P")
11333   ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
11334   ;; Stripping headers should be specified with mail-yank-ignored-headers.
11335   (gnus-summary-select-article t)
11336   (setq gnus-winconf-post-news (current-window-configuration))
11337   (let ((gnus-newsgroup-name gnus-newsgroup-name))
11338     (bury-buffer gnus-article-buffer)
11339     (funcall gnus-mail-reply-method yank)))
11340
11341 (defun gnus-summary-reply-with-original ()
11342   "Reply mail to news author with original article.
11343 Customize the variable gnus-mail-reply-method to use another mailer."
11344   (interactive)
11345   (gnus-summary-reply t))
11346
11347 (defun gnus-summary-mail-forward ()
11348   "Forward the current message to another user.
11349 Customize the variable gnus-mail-forward-method to use another mailer."
11350   (interactive)
11351   (gnus-summary-select-article t)
11352   (setq gnus-winconf-post-news (current-window-configuration))
11353   (set-buffer gnus-article-buffer)
11354   (let ((gnus-newsgroup-name gnus-newsgroup-name))
11355     (funcall gnus-mail-forward-method)))
11356
11357 (defun gnus-summary-mail-other-window ()
11358   "Compose mail in other window.
11359 Customize the variable `gnus-mail-other-window-method' to use another
11360 mailer."
11361   (interactive)
11362   (setq gnus-winconf-post-news (current-window-configuration))
11363   (let ((gnus-newsgroup-name gnus-newsgroup-name))
11364     (funcall gnus-mail-other-window-method)))
11365
11366 (defun gnus-mail-reply-using-mail (&optional yank to-address)
11367   (save-excursion
11368     (set-buffer gnus-summary-buffer)
11369     (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb)))
11370           (group (gnus-group-real-name gnus-newsgroup-name))
11371           (cur (cons (current-buffer) (cdr gnus-article-current)))
11372           from subject date to reply-to message-of
11373           references message-id sender follow-to cc)
11374       (set-buffer (get-buffer-create "*mail*"))
11375       (mail-mode)
11376       (make-local-variable 'gnus-article-reply)
11377       (setq gnus-article-reply cur)
11378       (use-local-map (copy-keymap mail-mode-map))
11379       (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
11380       (if (and (buffer-modified-p)
11381                (> (buffer-size) 0)
11382                (not (gnus-y-or-n-p 
11383                      "Unsent article being composed; erase it? ")))
11384           ()
11385         (erase-buffer)
11386         (save-excursion
11387           (set-buffer gnus-article-buffer)
11388           (let ((buffer-read-only nil))
11389             (goto-char (point-min))
11390             (narrow-to-region (point-min)
11391                               (progn (search-forward "\n\n") (point)))
11392             (add-text-properties (point-min) (point-max) '(invisible nil)))
11393           (if (and (boundp 'gnus-reply-to-function)
11394                    gnus-reply-to-function)
11395               (save-excursion
11396                 (save-restriction
11397                   (gnus-narrow-to-headers)
11398                   (setq follow-to (funcall gnus-reply-to-function group)))))
11399           (setq from (mail-fetch-field "from"))
11400           (setq date (mail-fetch-field "date"))
11401           (and from
11402                (let ((stop-pos 
11403                       (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
11404                  (setq message-of
11405                        (concat (if stop-pos (substring from 0 stop-pos) from)
11406                                "'s message of " date))))
11407           (setq sender (mail-fetch-field "sender"))
11408           (setq subject (or (mail-fetch-field "subject")
11409                             "Re: none"))
11410           (or (string-match "^[Rr][Ee]:" subject)
11411               (setq subject (concat "Re: " subject)))
11412           (setq cc (mail-fetch-field "cc"))
11413           (setq reply-to (mail-fetch-field "reply-to"))
11414           (setq references (mail-fetch-field "references"))
11415           (setq message-id (mail-fetch-field "message-id"))
11416           (widen))
11417         (setq news-reply-yank-from from)
11418         (setq news-reply-yank-message-id message-id)
11419         (mail-setup (or to-address follow-to reply-to from sender "") 
11420                     subject message-of nil gnus-article-buffer nil)
11421         ;; Fold long references line to follow RFC1036.
11422         (mail-position-on-field "References")
11423         (let ((begin (- (point) (length "References: ")))
11424               (fill-column 78)
11425               (fill-prefix "\t"))
11426           (if references (insert references))
11427           (if (and references message-id) (insert " "))
11428           (if message-id (insert message-id))
11429           ;; The region must end with a newline to fill the region
11430           ;; without inserting extra newline.
11431           (fill-region-as-paragraph begin (1+ (point))))
11432         (goto-char (point-min))
11433         (search-forward (concat "\n" mail-header-separator "\n"))
11434         (if yank
11435             (let ((last (point)))
11436               (run-hooks 'news-reply-header-hook)
11437               (mail-yank-original nil)
11438               (goto-char last))))
11439       (if (not yank)
11440           (let ((mail (current-buffer)))
11441             (gnus-configure-windows '(0 0 1))
11442             (switch-to-buffer-other-window mail))
11443         (gnus-configure-windows '(0 1 0))
11444         (switch-to-buffer (current-buffer))))))
11445
11446 (defun gnus-mail-yank-original ()
11447   (interactive)
11448   (run-hooks 'news-reply-header-hook)
11449   (mail-yank-original nil))
11450
11451 (defun gnus-mail-send-and-exit ()
11452   (interactive)
11453   (let ((cbuf (current-buffer)))
11454     (mail-send-and-exit nil)
11455     (if (get-buffer gnus-group-buffer)
11456         (progn
11457           (save-excursion
11458             (set-buffer cbuf)
11459             (let ((reply gnus-article-reply))
11460               (if (and reply
11461                        (get-buffer (car reply))
11462                        (buffer-name (car reply)))
11463                   (progn
11464                     (set-buffer (car reply))
11465                     (and (cdr reply)
11466                          (gnus-summary-mark-article-as-replied 
11467                           (cdr reply)))))))
11468           (and gnus-winconf-post-news
11469                (set-window-configuration gnus-winconf-post-news))
11470           (setq gnus-winconf-post-news nil)))))
11471
11472 (defun gnus-mail-forward-using-mail ()
11473   "Forward the current message to another user using mail."
11474   ;; This is almost a carbon copy of rmail-forward in rmail.el.
11475   (let ((forward-buffer (current-buffer))
11476         (subject
11477          (concat "[" gnus-newsgroup-name "] "
11478                  (or (gnus-fetch-field "Subject") "")))
11479         beg)
11480     ;; If only one window, use it for the mail buffer.
11481     ;; Otherwise, use another window for the mail buffer
11482     ;; so that the Rmail buffer remains visible
11483     ;; and sending the mail will get back to it.
11484     (if (if (one-window-p t)
11485             (mail nil nil subject)
11486           (mail-other-window nil nil subject))
11487         (save-excursion
11488           (use-local-map (copy-keymap emacs-lisp-mode-map))
11489           (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
11490           (setq beg (goto-char (point-max)))
11491           (insert "------- Start of forwarded message -------\n")
11492           (insert-buffer forward-buffer)
11493           (goto-char (point-max))
11494           (insert "------- End of forwarded message -------\n")
11495           ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>. 
11496           (goto-char beg)
11497           (while (setq beg (next-single-property-change (point) 'invisible))
11498             (goto-char beg)
11499             (delete-region beg (or (next-single-property-change 
11500                                     (point) 'invisible)
11501                                    (point-max))))
11502           ;; You have a chance to arrange the message.
11503           (run-hooks 'gnus-mail-forward-hook)))))
11504
11505 (defun gnus-mail-other-window-using-mail ()
11506   "Compose mail other window using mail."
11507   (mail-other-window nil nil nil nil nil nil (get-buffer gnus-article-buffer))
11508   (use-local-map (copy-keymap emacs-lisp-mode-map))
11509   (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit))
11510
11511 \f
11512 ;;;
11513 ;;; Dribble file
11514 ;;;
11515
11516 (defvar gnus-dribble-ignore nil)
11517
11518 (defun gnus-dribble-file-name ()
11519   (concat gnus-startup-file "-dribble"))
11520
11521 (defun gnus-dribble-open ()
11522   (save-excursion 
11523     (set-buffer 
11524      (setq gnus-dribble-buffer (find-file-noselect (gnus-dribble-file-name))))
11525     (buffer-disable-undo (current-buffer))
11526     (bury-buffer gnus-dribble-buffer)
11527     (auto-save-mode t)
11528     (goto-char (point-max))))
11529
11530 (defun gnus-dribble-enter (string)
11531   (if (and (not gnus-dribble-ignore)
11532            gnus-dribble-buffer
11533            (buffer-name gnus-dribble-buffer))
11534       (let ((obuf (current-buffer)))
11535         (set-buffer gnus-dribble-buffer)
11536         (insert string "\n")
11537         (set-window-point (get-buffer-window (current-buffer)) (point-max))
11538         (set-buffer obuf))))
11539
11540 (defun gnus-dribble-read-file ()
11541   (let ((dribble-file (gnus-dribble-file-name)))
11542     (save-excursion 
11543       (set-buffer (setq gnus-dribble-buffer 
11544                         (get-buffer-create 
11545                          (file-name-nondirectory dribble-file))))
11546       (gnus-add-current-to-buffer-list)
11547       (erase-buffer)
11548       (set-visited-file-name dribble-file)
11549       (buffer-disable-undo (current-buffer))
11550       (bury-buffer (current-buffer))
11551       (set-buffer-modified-p nil)
11552       (let ((auto (make-auto-save-file-name))
11553             (gnus-dribble-ignore t))
11554         (if (or (file-exists-p auto) (file-exists-p dribble-file))
11555             (progn
11556               (if (file-newer-than-file-p auto dribble-file)
11557                   (setq dribble-file auto))
11558               (insert-file-contents dribble-file)
11559               (if (not (zerop (buffer-size)))
11560                   (set-buffer-modified-p t))
11561               (if (gnus-y-or-n-p 
11562                    "Auto-save file exists. Do you want to read it? ")
11563                   (progn
11564                     (message "Reading %s..." dribble-file) 
11565                     (eval-current-buffer)
11566                     (message "Reading %s...done" dribble-file)))))))))
11567
11568 (defun gnus-dribble-delete-file ()
11569   (if (file-exists-p (gnus-dribble-file-name))
11570       (delete-file (gnus-dribble-file-name)))
11571   (if gnus-dribble-buffer
11572       (save-excursion
11573         (set-buffer gnus-dribble-buffer)
11574         (let ((auto (make-auto-save-file-name)))
11575           (if (file-exists-p auto)
11576               (delete-file auto))
11577           (erase-buffer)
11578           (set-buffer-modified-p nil)))))
11579
11580 (defun gnus-dribble-save ()
11581   (if (and gnus-dribble-buffer
11582            (buffer-name gnus-dribble-buffer))
11583       (save-excursion
11584         (set-buffer gnus-dribble-buffer)
11585         (save-buffer))))
11586
11587 (defun gnus-dribble-clear ()
11588   (save-excursion
11589     (if (and gnus-dribble-buffer
11590              (buffer-name (get-buffer gnus-dribble-buffer)))
11591         (progn
11592           (set-buffer gnus-dribble-buffer)
11593           (erase-buffer)
11594           (set-buffer-modified-p nil)
11595           (setq buffer-saved-size (buffer-size))))))
11596
11597 ;;;
11598 ;;; Server Communication
11599 ;;;
11600
11601 ;; All the Gnus backends have the same interface, and should return
11602 ;; data in a similar format. Below is an overview of what functions
11603 ;; these packages must supply and what results they should return.
11604 ;;
11605 ;; Variables:
11606 ;;
11607 ;; `nntp-server-buffer' - All data should be returned to Gnus in this
11608 ;; buffer. 
11609 ;;
11610 ;; Functions for the imaginary backend `choke':
11611 ;;
11612 ;; `choke-retrieve-headers ARTICLES &optional GROUP SERVER'
11613 ;; Should return all headers for all ARTICLES, or return NOV lines for
11614 ;; the same.
11615 ;;
11616 ;; `choke-request-group GROUP &optional SERVER DISCARD'
11617 ;; Switch to GROUP. If DISCARD is nil, active information on the group
11618 ;; must be returned.
11619 ;;
11620 ;; `choke-close-group GROUP &optional SERVER'
11621 ;; Close group. Most backends won't have to do anything with this
11622 ;; call, but it is an opportunity to clean up, if that is needed. It
11623 ;; is called when Gnus exits a group.
11624 ;;
11625 ;; `choke-request-article ARTICLE &optional GROUP SERVER'
11626 ;; Return ARTICLE, which is either an article number or
11627 ;; message-id. Note that not all backends can return articles based on
11628 ;; message-id. 
11629 ;;
11630 ;; `choke-request-list SERVER'
11631 ;; Return a list of all newsgroups on SERVER.
11632 ;;
11633 ;; `choke-request-list-newsgroups SERVER'
11634 ;; Return a list of descriptions of all newsgroups on SERVER.
11635 ;;
11636 ;; `choke-request-newgroups DATE &optional SERVER'
11637 ;; Return a list of all groups that have arrived after DATE on
11638 ;; SERVER. Note that the date doesn't have to be respected - Gnus will
11639 ;; always check whether the groups are old or not. Backends that do
11640 ;; not store date information may just return the entire list of
11641 ;; groups, although this might not be a good idea in general.
11642 ;;
11643 ;; `choke-request-post-buffer METHOD HEADER ARTICLE-BUFFER GROUP INFO'
11644 ;; Should return a buffer that is suitable for "posting". nnspool and
11645 ;; nntp return a `*post-buffer*', and nnmail return a `*mail*'
11646 ;; buffer. This function should fill out the appropriate headers. 
11647 ;;
11648 ;; `choke-request-post &optional SERVER'
11649 ;; Function that will be called from a buffer to be posted. 
11650 ;;
11651 ;; `choke-open-server SERVER &optional ARGUMENT'
11652 ;; Open a connection to SERVER.
11653 ;;
11654 ;; `choke-close-server &optional SERVER'
11655 ;; Close the connection to SERVER.
11656 ;;
11657 ;; `choke-server-opened &optional SERVER'
11658 ;; Whether the conenction to SERVER is opened or not.
11659 ;;
11660 ;; `choke-server-status &optional SERVER'
11661 ;; Should return a status string (not in the nntp buffer, but as the
11662 ;; result of the function).
11663 ;;
11664 ;; The following functions are optional and apply only to backends
11665 ;; that are able to control the contents of their groups totally
11666 ;; (ie. mail backends.)  Backends that aren't able to do that
11667 ;; shouldn't define these functions at all. Gnus will check for their
11668 ;; presence before attempting to call them.
11669 ;;
11670 ;; `choke-request-expire-articles ARTICLES &optional NEWSGROUP SERVER'
11671 ;; Should expire (according to some aging scheme) all ARTICLES. Most
11672 ;; backends will not be able to expire articles. Should return a list
11673 ;; of all articles that were not expired.
11674 ;;
11675 ;; `choke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM &optional LAST'
11676 ;; Should move ARTICLE from GROUP on SERVER by using ACCEPT-FORM.
11677 ;; Removes any information it has added to the article (extra headers,
11678 ;; whatever - make it as clean as possible), and then passes the
11679 ;; article on by evaling ACCEPT-FORM, which is normally a call to the
11680 ;; function described below. If the ACCEPT-FORM returns a non-nil
11681 ;; value, the article should then be deleted. If LAST is nil, that
11682 ;; means that there will be further calls to this function. This might
11683 ;; be taken as an advice not to save buffers/internal variables just
11684 ;; yet, but wait until the last call to speed things up.
11685 ;;
11686 ;; `choke-request-accept-article GROUP &optional LAST' 
11687 ;; The contents of the current buffer will be put into GROUP.  There
11688 ;; should, of course, be an article in the current buffer.  This
11689 ;; function is normally only called by the function described above,
11690 ;; and LAST works the same way as in that function.
11691 ;;
11692 ;; `choke-request-replace-article ARTICLE GROUP BUFFER'
11693 ;; Replace ARTICLE in GROUP with the contents of BUFFER.
11694 ;; This provides an easy interface for allowing editing of
11695 ;; articles. Note that even headers may be edited, so the backend has
11696 ;; to update any tables (nov buffers, etc) that it maintains after
11697 ;; replacing the article.
11698 ;;
11699 ;; All these functions must return nil if they couldn't service the
11700 ;; request. If the optional arguments are not supplied, some "current"
11701 ;; or "default" values should be used. In short, one should emulate an
11702 ;; NNTP server, in a way.
11703 ;;
11704 ;; If you want to write a new backend, you just have to supply the
11705 ;; functions listed above. In addition, you must enter the new backend
11706 ;; into the list of valid select methods:
11707 ;; (setq gnus-valid-select-methods 
11708 ;;       (cons '("choke" mail) gnus-valid-select-methods))
11709 ;; The first element in this list is the name of the backend. Other
11710 ;; elemnets may be `mail' (for mail groups),  `post' (for news
11711 ;; groups), `none' (neither), `respool' (for groups that can control
11712 ;; their contents). 
11713
11714 (defun gnus-start-news-server (&optional confirm)
11715   "Open a method for getting news.
11716 If CONFIRM is non-nil, the user will be asked for an NNTP server."
11717   (let (how where)
11718     (if gnus-current-select-method
11719         ;; Stream is already opened.
11720         nil
11721       ;; Open NNTP server.
11722       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
11723       (if confirm
11724           (progn
11725             ;; Read server name with completion.
11726             (setq gnus-nntp-server
11727                   (completing-read "NNTP server: "
11728                                    (mapcar (lambda (server) (list server))
11729                                            (cons (list gnus-nntp-server)
11730                                                  gnus-secondary-servers))
11731                                    nil nil gnus-nntp-server))))
11732
11733       (if (and gnus-nntp-server 
11734                (stringp gnus-nntp-server)
11735                (not (string= gnus-nntp-server "")))
11736           (setq gnus-select-method
11737                 (cond ((or (string= gnus-nntp-server "")
11738                            (string= gnus-nntp-server "::"))
11739                        (list 'nnspool (system-name)))
11740                       ((string-match ":" gnus-nntp-server)
11741                        (list 'nnmh gnus-nntp-server))
11742                       (t
11743                        (list 'nntp gnus-nntp-server)))))
11744
11745       (setq how (car gnus-select-method))
11746       (setq where (car (cdr gnus-select-method)))
11747       (cond ((eq how 'nnspool)
11748              (require 'nnspool)
11749              (message "Looking up local news spool..."))
11750             ((eq how 'nnmh)
11751              (require 'nnmh)
11752              (message "Looking up mh spool..."))
11753             (t
11754              (require 'nntp)))
11755       (setq gnus-current-select-method gnus-select-method)
11756       (run-hooks 'gnus-open-server-hook)
11757       (or 
11758        ;; gnus-open-server-hook might have opened it
11759        (gnus-server-opened gnus-select-method)  
11760        (gnus-open-server gnus-select-method)
11761        (error "%s" (gnus-nntp-message 
11762                     (format "Cannot open NNTP server on %s" 
11763                             where))))
11764       gnus-select-method)))
11765
11766 (defun gnus-check-news-server (method)
11767   "If the news server is down, start it up again."
11768   (let ((method (if method method gnus-select-method)))
11769     (if (gnus-server-opened method)
11770         ;; Stream is already opened.
11771         t
11772       ;; Open server.
11773       (message "Opening server %s on %s..." (car method) (nth 1 method))
11774       (run-hooks 'gnus-open-server-hook)
11775       (or (gnus-server-opened method)
11776           (gnus-open-server method))
11777       (message ""))))
11778
11779 (defun gnus-nntp-message (&optional message)
11780   "Check the status of the NNTP server.
11781 If the status of the server is clear and MESSAGE is non-nil, MESSAGE
11782 is returned insted of the status string."
11783   (let ((status (gnus-status-message (gnus-find-method-for-group 
11784                                       gnus-newsgroup-name)))
11785         (message (or message "")))
11786     (if (and (stringp status) (> (length status) 0))
11787         status message)))
11788
11789 (defun gnus-get-function (method function)
11790   (let ((func (intern (format "%s-%s" (car method) function))))
11791     (if (not (fboundp func)) 
11792         (progn
11793           (require (car method))
11794           (if (not (fboundp func)) 
11795               (error "No such function: %s" func))))
11796     func))
11797
11798 ;; Specifying port number suggested by Stephane Laveau <laveau@corse.inria.fr>.
11799 (defun gnus-open-server (method)
11800   (apply (gnus-get-function method 'open-server) (cdr method)))
11801
11802 (defun gnus-close-server (method)
11803   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
11804
11805 (defun gnus-request-list (method)
11806   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
11807
11808 (defun gnus-request-list-newsgroups (method)
11809   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
11810
11811 (defun gnus-request-newgroups (date method)
11812   (funcall (gnus-get-function method 'request-newgroups) 
11813            date (nth 1 method)))
11814
11815 (defun gnus-server-opened (method)
11816   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
11817
11818 (defun gnus-status-message (method)
11819   (let ((method (if (stringp method) (gnus-find-method-for-group method)
11820                   method)))
11821     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
11822
11823 (defun gnus-request-group (group &optional dont-check)
11824   (let ((method (gnus-find-method-for-group group)))
11825     (funcall (gnus-get-function method 'request-group) 
11826              (gnus-group-real-name group) (nth 1 method) dont-check)))
11827
11828 (defun gnus-request-group-description (group)
11829   (let ((method (gnus-find-method-for-group group))
11830         (func 'request-group-description))
11831     (and (gnus-check-backend-function func group)
11832          (funcall (gnus-get-function method func) 
11833                   (gnus-group-real-name group) (nth 1 method)))))
11834
11835 (defun gnus-close-group (group)
11836   (let ((method (gnus-find-method-for-group group)))
11837     (funcall (gnus-get-function method 'close-group) 
11838              (gnus-group-real-name group) (nth 1 method))))
11839
11840 (defun gnus-retrieve-headers (articles group)
11841   (let ((method (gnus-find-method-for-group group)))
11842     (funcall (gnus-get-function method 'retrieve-headers) 
11843              articles (gnus-group-real-name group) (nth 1 method))))
11844
11845 (defun gnus-request-article (article group buffer)
11846   (let ((method (gnus-find-method-for-group group)))
11847     (funcall (gnus-get-function method 'request-article) 
11848              article (gnus-group-real-name group) (nth 1 method) buffer)))
11849
11850 (defun gnus-request-head (article group)
11851   (let ((method (gnus-find-method-for-group group)))
11852     (funcall (gnus-get-function method 'request-head) 
11853              article (gnus-group-real-name group) (nth 1 method))))
11854
11855 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11856 (defun gnus-request-post-buffer (post group subject header artbuf
11857                                       info follow-to respect-poster)
11858    (let* ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
11859           (method
11860            (if (and gnus-post-method
11861                     ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11862                     (memq 'post (assoc
11863                                  (format "%s" (car (gnus-find-method-for-group
11864                                                     gnus-newsgroup-name)))
11865                                         gnus-valid-select-methods)))
11866                gnus-post-method
11867              (gnus-find-method-for-group gnus-newsgroup-name))))
11868      (let ((mail-self-blind nil)
11869            (mail-archive-file-name nil))
11870        (funcall (gnus-get-function method 'request-post-buffer) 
11871                 post group subject header artbuf info follow-to
11872                 respect-poster))))
11873
11874 (defun gnus-request-post (method &optional force)
11875   (and (not force) gnus-post-method
11876        (memq 'post (assoc (format "%s" (car method))
11877                           gnus-valid-select-methods))
11878        (setq method gnus-post-method))
11879   (funcall (gnus-get-function method 'request-post) 
11880            (nth 1 method)))
11881
11882 (defun gnus-request-expire-articles (articles group &optional force)
11883   (let ((method (gnus-find-method-for-group group)))
11884     (funcall (gnus-get-function method 'request-expire-articles) 
11885              articles (gnus-group-real-name group) (nth 1 method)
11886              force)))
11887
11888 (defun gnus-request-move-article 
11889   (article group server accept-function &optional last)
11890   (let ((method (gnus-find-method-for-group group)))
11891     (funcall (gnus-get-function method 'request-move-article) 
11892              article (gnus-group-real-name group) 
11893              (nth 1 method) accept-function last)))
11894
11895 (defun gnus-request-accept-article (group &optional last)
11896   (let ((func (if (symbolp group) group
11897                 (car (gnus-find-method-for-group group)))))
11898     (funcall (intern (format "%s-request-accept-article" func))
11899              (if (stringp group) (gnus-group-real-name group) group)
11900              last)))
11901
11902 (defun gnus-request-replace-article (article group buffer)
11903   (let ((func (car (gnus-find-method-for-group group))))
11904     (funcall (intern (format "%s-request-replace-article" func))
11905              article (gnus-group-real-name group) buffer)))
11906
11907 (defun gnus-find-method-for-group (group)
11908   (or gnus-override-method
11909       (and (not group)
11910            gnus-select-method)
11911       (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
11912         (if (or (not info)
11913                 (not (nth 4 info)))
11914             gnus-select-method
11915           (nth 4 info)))))
11916
11917 (defun gnus-check-backend-function (func group)
11918   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
11919                  group)))
11920     (fboundp (intern (format "%s-%s" method func)))))
11921
11922 (defun gnus-methods-using (method)
11923   (let ((valids gnus-valid-select-methods)
11924         outs)
11925     (while valids
11926       (if (memq method (car valids)) 
11927           (setq outs (cons (car valids) outs)))
11928       (setq valids (cdr valids)))
11929     outs))
11930
11931 ;;; 
11932 ;;; Active & Newsrc File Handling
11933 ;;;
11934
11935 ;; Newsrc related functions.
11936 ;; Gnus internal format of gnus-newsrc-assoc:
11937 ;; (("alt.general" 3 (1 . 1))
11938 ;;  ("alt.misc"    3 ((1 . 10) (12 . 15)))
11939 ;;  ("alt.test"    7 (1 . 99) (45 57 93)) ...)
11940 ;; The first item is the group name; the second is the subscription
11941 ;; level; the third is either a range of a list of ranges of read
11942 ;; articles, the optional fourth element is a list of marked articles,
11943 ;; the optional fifth element is the select method.
11944 ;;
11945 ;; Gnus internal format of gnus-newsrc-hashtb:
11946 ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...)
11947 ;; This is the entry for "alt.misc". The first element is the number
11948 ;; of unread articles in "alt.misc". The cdr of this entry is the
11949 ;; element *before* "alt.misc" in gnus-newsrc-assoc, which makes is
11950 ;; trivial to remove or add new elements into gnus-newsrc-assoc
11951 ;; without scanning the entire list. So, to get the actual information
11952 ;; of "alt.misc", you'd say something like 
11953 ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb))
11954 ;;
11955 ;; Gnus internal format of gnus-active-hashtb:
11956 ;; ((1 . 1))
11957 ;;  (5 . 10))
11958 ;;  (67 . 99)) ...)
11959 ;; The only element in each entry in this hash table is a range of
11960 ;; (possibly) available articles. (Articles in this range may have
11961 ;; been expired or cancelled.)
11962 ;;
11963 ;; Gnus internal format of gnus-killed-list and gnus-zombie-list:
11964 ;; ("alt.misc" "alt.test" "alt.general" ...)
11965
11966 (defun gnus-setup-news (&optional rawfile level)
11967   "Setup news information.
11968 If RAWFILE is non-nil, the .newsrc file will also be read.
11969 If LEVEL is non-nil, the news will be set up at level LEVEL."
11970   (let ((init (not (and gnus-newsrc-assoc gnus-active-hashtb (not rawfile)))))
11971     ;; Clear some variables to re-initialize news information.
11972     (if init (setq gnus-newsrc-assoc nil gnus-active-hashtb nil))
11973     ;; Read the active file and create `gnus-active-hashtb'.
11974     ;; If `gnus-read-active-file' is nil, then we just create an empty
11975     ;; hash table. The partial filling out of the hash table will be
11976     ;; done in `gnus-get-unread-articles'.
11977     (if (and gnus-read-active-file (not level))
11978         (gnus-read-active-file)
11979       (setq gnus-active-hashtb (make-vector 4095 0)))
11980
11981     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
11982     (if init (gnus-read-newsrc-file rawfile))
11983     ;; Find the number of unread articles in each non-dead group.
11984     (gnus-get-unread-articles (or level 6))
11985     ;; Find new newsgroups and treat them.
11986     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level))
11987         (gnus-find-new-newsgroups))
11988     (if (and init gnus-check-bogus-newsgroups 
11989              gnus-read-active-file (not level))
11990         (gnus-check-bogus-newsgroups))))
11991
11992 (defun gnus-find-new-newsgroups ()
11993   "Search for new newsgroups and add them.
11994 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
11995 The `-n' option line from .newsrc is respected."
11996   (interactive)
11997   (or (gnus-check-first-time-used)
11998       (if (or (consp gnus-check-new-newsgroups)
11999               (eq gnus-check-new-newsgroups 'ask-server))
12000           (gnus-ask-server-for-new-groups)
12001         (let ((groups 0)
12002               group new-newsgroups)
12003           (or gnus-have-read-active-file (gnus-read-active-file))
12004           (setq gnus-newsrc-last-checked-date (current-time-string))
12005           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
12006           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
12007           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
12008           (mapatoms
12009            (lambda (sym)
12010              (setq group (symbol-name sym))
12011              (if (or (gnus-gethash group gnus-killed-hashtb)
12012                      (gnus-gethash group gnus-newsrc-hashtb))
12013                  ()
12014                (if (and gnus-newsrc-options-n-yes
12015                         (string-match gnus-newsrc-options-n-yes group))
12016                    (progn
12017                      (setq groups (1+ groups))
12018                      (gnus-sethash group group gnus-killed-hashtb)
12019                      (funcall gnus-subscribe-options-newsgroup-method group))
12020                  (if (or (null gnus-newsrc-options-n-no)
12021                          (not (string-match gnus-newsrc-options-n-no group)))
12022                      ;; Add this group.
12023                      (progn
12024                        (setq groups (1+ groups))
12025                        (gnus-sethash group group gnus-killed-hashtb)
12026                        (if gnus-subscribe-hierarchical-interactive
12027                            (setq new-newsgroups (cons group new-newsgroups))
12028                          (funcall gnus-subscribe-newsgroup-method group)))))))
12029            gnus-active-hashtb)
12030           (if new-newsgroups 
12031               (gnus-subscribe-hierarchical-interactive new-newsgroups))
12032           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
12033           (if (> groups 0)
12034               (message "%d new newsgroup%s arrived." 
12035                        groups (if (> groups 1) "s have" " has")))))))
12036
12037 (defun gnus-ask-server-for-new-groups ()
12038   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
12039          (methods (cons gnus-select-method 
12040                         (append
12041                          (and (consp gnus-check-new-newsgroups)
12042                               gnus-check-new-newsgroups)
12043                          gnus-secondary-select-methods)))
12044          (groups 0)
12045          (new-date (current-time-string))
12046          hashtb group new-newsgroups got-new)
12047     ;; Go thorugh both primary and secondary select methods and
12048     ;; request new newsgroups.  
12049     (while methods
12050       (if (gnus-request-newgroups date (car methods))
12051           (save-excursion
12052             (setq got-new t)
12053             (or hashtb (setq hashtb (gnus-make-hashtable 
12054                                      (count-lines (point-min) (point-max)))))
12055             (set-buffer nntp-server-buffer)
12056             ;; Enter all the new groups in a hashtable.
12057             (gnus-active-to-gnus-format (car methods) hashtb)))
12058       (setq methods (cdr methods)))
12059     (and got-new (setq gnus-newsrc-last-checked-date new-date))
12060     ;; Now all new groups from all select methods are in `hashtb'.
12061     (mapatoms
12062      (lambda (group-sym)
12063        (setq group (symbol-name group-sym))
12064        (if (or (gnus-gethash group gnus-newsrc-hashtb)
12065                (member group gnus-zombie-list)
12066                (member group gnus-killed-list))
12067            ;; The group is already known.
12068            ()
12069          (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb)
12070          (if (and gnus-newsrc-options-n-yes
12071                   (string-match gnus-newsrc-options-n-yes group))
12072              (progn
12073                (setq groups (1+ groups))
12074                (funcall gnus-subscribe-options-newsgroup-method group))
12075            (if (or (null gnus-newsrc-options-n-no)
12076                    (not (string-match gnus-newsrc-options-n-no group)))
12077                ;; Add this group.
12078                (progn
12079                  (setq groups (1+ groups))
12080                  (if gnus-subscribe-hierarchical-interactive
12081                      (setq new-newsgroups (cons group new-newsgroups))
12082                    (funcall gnus-subscribe-newsgroup-method group)))))))
12083      hashtb)
12084     (if new-newsgroups 
12085         (gnus-subscribe-hierarchical-interactive new-newsgroups))
12086     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
12087     (if (> groups 0)
12088         (message "%d new newsgroup%s arrived." 
12089                  groups (if (> groups 1) "s have" " has")))
12090     got-new))
12091
12092 (defun gnus-check-first-time-used ()
12093   (if (or (> (length gnus-newsrc-assoc) 1)
12094           (file-exists-p gnus-startup-file)
12095           (file-exists-p (concat gnus-startup-file ".el"))
12096           (file-exists-p (concat gnus-startup-file ".eld")))
12097       nil
12098     (message "First time user; subscribing you to default groups")
12099     (or gnus-have-read-active-file (gnus-read-active-file))
12100     (setq gnus-newsrc-last-checked-date (current-time-string))
12101     (let ((groups gnus-default-subscribed-newsgroups)
12102           group)
12103       (if (eq groups t)
12104           nil
12105         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
12106         (mapatoms
12107          (lambda (sym)
12108            (setq group (symbol-name sym))
12109            (if (and gnus-newsrc-options-n-yes
12110                     (string-match gnus-newsrc-options-n-yes group))
12111                (funcall gnus-subscribe-options-newsgroup-method group)
12112              (and (or (null gnus-newsrc-options-n-no)
12113                       (not (string-match gnus-newsrc-options-n-no group)))
12114                   (setq gnus-killed-list (cons group gnus-killed-list)))))
12115          gnus-active-hashtb)
12116         (while groups
12117           (if (gnus-gethash (car groups) gnus-active-hashtb)
12118               (gnus-group-change-level (car groups) 3 9))
12119           (setq groups (cdr groups)))
12120         (gnus-group-make-help-group)
12121         (and gnus-novice-user
12122              (message (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-list-killed] to list killed groups")))))))
12123
12124 ;; `gnus-group-change-level' is the fundamental function for changing
12125 ;; subscription levels of newsgroups. This might mean just changing
12126 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
12127 ;; again, which subscribes/unsubscribes a group, which is equally
12128 ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and
12129 ;; from 8-9 to 1-7 means that you remove the group from the list of
12130 ;; killed (or zombie) groups and add them to the (kinda) subscribed
12131 ;; groups. And last but not least, moving from 8 to 9 and 9 to 8,
12132 ;; which is trivial.
12133 ;; ENTRY can either be a string (newsgroup name) or a list (if
12134 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
12135 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
12136 ;; entries. 
12137 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
12138 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
12139 ;; after. 
12140 (defun gnus-group-change-level (entry level &optional oldlevel
12141                                       previous fromkilled)
12142   (let ((pinfo entry)
12143         group info active num)
12144     ;; Glean what info we can from the arguments
12145     (if (consp entry)
12146         (if fromkilled (setq group (nth 1 entry))
12147           (setq group (car (nth 2 entry))))
12148       (setq group entry))
12149     (if (and (stringp entry)
12150              oldlevel 
12151              (< oldlevel 8))
12152         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
12153     (if (and (not oldlevel)
12154              (listp entry))
12155         (setq oldlevel (car (cdr (nth 2 entry)))))
12156     (if (stringp previous)
12157         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
12158
12159     (gnus-dribble-enter
12160      (format "(gnus-group-change-level %S %S %S %S %S)" 
12161              group level oldlevel (car (nth 2 previous)) fromkilled))
12162     
12163     ;; Then we remove the newgroup from any old structures, if needed.
12164     ;; If the group was killed, we remove it from the killed or zombie
12165     ;; list. If not, and it is in fact going to be killed, we remove
12166     ;; it from the newsrc hash table and assoc.
12167     (cond ((>= oldlevel 8)
12168            (if (= oldlevel 8)
12169                (setq gnus-zombie-list (delete group gnus-zombie-list))
12170              (setq gnus-killed-list (delete group gnus-killed-list))))
12171           (t
12172            (if (>= level 8)
12173                (progn
12174                  (gnus-sethash (car (nth 2 entry))
12175                                nil gnus-newsrc-hashtb)
12176                  (if (nth 3 entry)
12177                      (setcdr (gnus-gethash (car (nth 3 entry))
12178                                            gnus-newsrc-hashtb)
12179                              (cdr entry)))
12180                  (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
12181
12182     ;; Finally we enter (if needed) the list where it is supposed to
12183     ;; go, and change the subscription level. If it is to be killed,
12184     ;; we enter it into the killed or zombie list.
12185     (cond ((>= level 8)
12186            (if (= level 8)
12187                (setq gnus-zombie-list (cons group gnus-zombie-list))
12188              (setq gnus-killed-list (cons group gnus-killed-list))))
12189           (t
12190            ;; If the list is to be entered into the newsrc assoc, and
12191            ;; it was killed, we have to create an entry in the newsrc
12192            ;; hashtb format and fix the pointers in the newsrc assoc.
12193            (if (>= oldlevel 8)
12194                (progn
12195                  (if (listp entry)
12196                      (progn
12197                        (setq info (cdr entry))
12198                        (setq num (car entry)))
12199                    (setq active (or (gnus-gethash group gnus-active-hashtb)
12200                                     '(0 . 0)))
12201                    (setq num (- (1+ (cdr active)) (car active)))
12202                    ;; Check whether the group is foreign. If so, the
12203                    ;; foreign select method has to be entered into the
12204                    ;; info. 
12205                    (let ((method (gnus-group-method-name group)))
12206                      (if (eq method gnus-select-method)
12207                          (setq info (list group level nil))
12208                        (setq info (list group level nil nil method)))))
12209                  (setq entry (cons info (if previous (cdr (cdr previous))
12210                                           (cdr gnus-newsrc-assoc))))
12211                  (setcdr (if previous (cdr previous) gnus-newsrc-assoc)
12212                          entry)
12213                  (gnus-sethash group (cons num (if previous (cdr previous)
12214                                                  gnus-newsrc-assoc))
12215                                gnus-newsrc-hashtb)
12216                  (if (cdr entry)
12217                      (setcdr (gnus-gethash (car (car (cdr entry)))
12218                                            gnus-newsrc-hashtb)
12219                              entry)))
12220              ;; It was alive, and it is going to stay alive, so we
12221              ;; just change the level and don't change any pointers or
12222              ;; hash table entries.
12223              (setcar (cdr (car (cdr (cdr entry)))) level))))))
12224
12225 (defun gnus-kill-newsgroup (newsgroup)
12226   "Obsolete function. Kills a newsgroup."
12227   (gnus-group-change-level (gnus-gethash newsgroup gnus-newsrc-hashtb) 9))
12228
12229 (defun gnus-check-bogus-newsgroups (&optional confirm)
12230   "Remove bogus newsgroups.
12231 If CONFIRM is non-nil, the user has to confirm the deletion of every
12232 newsgroup." 
12233   (let ((newsrc (cdr gnus-newsrc-assoc))
12234         bogus group)
12235     (message "Checking bogus newsgroups...")
12236     (or gnus-have-read-active-file (gnus-read-active-file))
12237     ;; Find all bogus newsgroup that are subscribed.
12238     (while newsrc
12239       (setq group (car (car newsrc)))
12240       (if (or (gnus-gethash group gnus-active-hashtb)
12241               (nth 4 (car newsrc))
12242               (and confirm
12243                    (not (gnus-y-or-n-p
12244                          (format "Remove bogus newsgroup: %s " group)))))
12245           ;; Active newsgroup.
12246           ()
12247         ;; Found a bogus newsgroup.
12248         (setq bogus (cons group bogus)))
12249       (setq newsrc (cdr newsrc)))
12250     ;; Remove all bogus subscribed groups by first killing them, and
12251     ;; then removing them from the list of killed groups.
12252     (while bogus
12253       (gnus-group-change-level 
12254        (gnus-gethash (car bogus) gnus-newsrc-hashtb) 9)
12255       (setq gnus-killed-list (delete (car bogus) gnus-killed-list))
12256       (setq bogus (cdr bogus)))
12257     ;; Then we remove all bogus groups from the list of killed and
12258     ;; zombie groups. They are are removed without confirmation.
12259     (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
12260           killed)
12261       (while dead-lists
12262         (setq killed (symbol-value (car dead-lists)))
12263         (while killed
12264           (setq group (car killed))
12265           (or (gnus-gethash group gnus-active-hashtb)
12266               ;; The group is bogus.
12267               (set (car dead-lists)
12268                    (delete group (symbol-value (car dead-lists)))))
12269           (setq killed (cdr killed)))
12270         (setq dead-lists (cdr dead-lists))))
12271     (message "Checking bogus newsgroups... done")))
12272
12273 (defun gnus-check-duplicate-killed-groups ()
12274   "Remove duplicates from the list of killed groups."
12275   (interactive)
12276   (let ((killed gnus-killed-list))
12277     (while killed
12278       (message "%d" (length killed))
12279       (setcdr killed (delete (car killed) (cdr killed)))
12280       (setq killed (cdr killed)))))
12281
12282 ;; Go though `gnus-newsrc-assoc' and compare with `gnus-active-hashtb'
12283 ;; and compute how many unread articles there are in each group.
12284 (defun gnus-get-unread-articles (&optional level)
12285   (let ((newsrc (cdr gnus-newsrc-assoc))
12286         (level (or level 6))
12287         info group active virtuals)
12288     (message "Checking new news...")
12289     (while newsrc
12290       (setq info (car newsrc))
12291       (setq group (car info))
12292       (setq active (gnus-gethash group gnus-active-hashtb))
12293
12294       ;; Check newsgroups. If the user doesn't want to check them, or
12295       ;; they can't be checked (for instance, if the news server can't
12296       ;; be reached) we just set the number of unread articles in this
12297       ;; newsgroup to t. This means that Gnus thinks that there are
12298       ;; unread articles, but it has no idea how many.
12299       (if (nth 4 info)
12300           (if (or (and gnus-activate-foreign-newsgroups 
12301                        (not (numberp gnus-activate-foreign-newsgroups)))
12302                   (and (numberp gnus-activate-foreign-newsgroups)
12303                        (<= (nth 1 info) gnus-activate-foreign-newsgroups)
12304                        (<= (nth 1 info) level)))
12305               (if (eq (car (nth 4 info)) 'nnvirtual)
12306                   (setq virtuals (cons info virtuals))
12307                 (setq active (gnus-activate-newsgroup (car info)))))
12308         (if (and (not gnus-read-active-file)
12309                  (<= (nth 1 info) level))
12310             (progn
12311               (setq active (gnus-activate-newsgroup (car info))))))
12312       
12313       (or active (progn (gnus-sethash group nil gnus-active-hashtb)
12314                         (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
12315       (and active (gnus-get-unread-articles-in-group info active))
12316       (setq newsrc (cdr newsrc)))
12317
12318     ;; Activate the virtual groups. This has to be done after all the
12319     ;; other groups. 
12320     ;; !!! If one virtual group contains another virtual group, even
12321     ;; doing it this way might cause problems.
12322     (while virtuals
12323       (gnus-activate-newsgroup (car (car virtuals)))
12324       (setq virtuals (cdr virtuals)))
12325
12326     (message "Checking new news... done")))
12327
12328 ;; Create a hash table out of the newsrc alist. The `car's of the
12329 ;; alist elements are used as keys.
12330 (defun gnus-make-hashtable-from-newsrc-alist ()
12331   (let ((alist gnus-newsrc-assoc)
12332          prev)
12333     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
12334     (setq alist 
12335           (setq prev (setq gnus-newsrc-assoc 
12336                            (cons (list "dummy.group" 0 nil) alist))))
12337     (while alist
12338       (gnus-sethash (car (car alist)) (cons nil prev) gnus-newsrc-hashtb)
12339       (setq prev alist)
12340       (setq alist (cdr alist)))))
12341
12342 (defun gnus-make-hashtable-from-killed ()
12343   "Create a hash table from the killed and zombie lists."
12344   (let ((lists '(gnus-killed-list gnus-zombie-list))
12345         list)
12346     (setq gnus-killed-hashtb 
12347           (gnus-make-hashtable 
12348            (+ (length gnus-killed-list) (length gnus-zombie-list))))
12349     (while lists
12350       (setq list (symbol-value (car lists)))
12351       (setq lists (cdr lists))
12352       (while list
12353         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
12354         (setq list (cdr list))))))
12355
12356 (defun gnus-get-unread-articles-in-group (info active)
12357   (let* ((range (nth 2 info))
12358          (num 0)
12359          (marked (nth 3 info))
12360          srange lowest group highest)
12361     ;; Modify the list of read articles according to what articles 
12362     ;; are available; then tally the unread articles and add the
12363     ;; number to the group hash table entry.
12364     (cond ((zerop (cdr active))
12365            (setq num 0))
12366           ((not range)
12367            (setq num (- (1+ (cdr active)) (car active))))
12368           ((atom (car range))
12369            ;; Fix a single (num . num) range according to the
12370            ;; active hash table.
12371            (and (< (cdr range) (car active)) (setcdr range (car active)))
12372            (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
12373            ;; Compute number of unread articles.
12374            (setq num (max 0 (- (cdr active) 
12375                                (- (1+ (cdr range)) (car range))))))
12376           (t
12377            ;; The read list is a list of ranges. Fix them according to
12378            ;; the active hash table.
12379            (while (and (cdr range) (>= (car active) (car (car (cdr range)))))
12380              (setcdr (car range) (cdr (car (cdr range))))
12381              (setcdr range (cdr (cdr range))))
12382            (if (< (cdr (car range)) (car active)) 
12383                (setcdr (car range) (car active)))
12384            (let ((srange range))
12385              (while (and (cdr srange) 
12386                          (<= (car (car (cdr srange))) (cdr active)))
12387                (setq srange (cdr srange)))
12388              (if (cdr srange)
12389                  (progn
12390                    (setcdr srange nil)
12391                    (if (> (cdr (car srange)) (cdr active))
12392                        (setcdr (car srange) (cdr active)))))
12393              (if (and srange (> (cdr (car srange)) (cdr active)))
12394                  (setcdr (car srange) (cdr active))))
12395            ;; Compute the number of unread articles.
12396            (while range
12397              (setq num (+ num (- (1+ (cdr (car range))) 
12398                                  (car (car range)))))
12399              (setq range (cdr range)))
12400            (setq num (max 0 (- (cdr active) num)))))
12401     (and info
12402          (progn
12403            (and (assq 'tick marked)
12404                 (inline (gnus-remove-illegal-marked-articles
12405                          (assq 'tick marked) (nth 2 info))))
12406            (and (assq 'dormant marked)
12407                 (inline (gnus-remove-illegal-marked-articles
12408                          (assq 'dormant marked) (nth 2 info))))
12409            (setcar
12410             (gnus-gethash (car info) gnus-newsrc-hashtb) 
12411             (setq num (max 0 (- num (length (cdr (assq 'tick marked)))
12412                                 (length (cdr (assq 'dormant marked)))))))))
12413     num))
12414
12415 (defun gnus-remove-illegal-marked-articles (marked ranges)
12416   (let ((m (cdr marked)))
12417     ;; Make sure that all ticked articles are a subset of the unread
12418     ;; articles. 
12419     (while m
12420       (if (gnus-member-of-range (car m) ranges)
12421           (setcdr marked (cdr m))
12422         (setq marked m))
12423       (setq m (cdr m)))))
12424
12425 (defun gnus-activate-newsgroup (group)
12426   (let ((method (gnus-find-method-for-group group))
12427         active)
12428     (and (or (gnus-server-opened method) (gnus-open-server method))
12429          (gnus-request-group group)
12430          (save-excursion
12431            (set-buffer nntp-server-buffer)
12432            (goto-char 1)
12433            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
12434                 (progn
12435                   (goto-char (match-beginning 1))
12436                   (gnus-sethash 
12437                    group (setq active (cons (read (current-buffer))
12438                                             (read (current-buffer))))
12439                    gnus-active-hashtb))
12440                 active)))))
12441
12442 (defun gnus-update-read-articles 
12443   (group unread unselected ticked &optional domarks replied expirable killed
12444          dormant bookmark score)
12445   "Update the list of read and ticked articles in GROUP using the
12446 UNREAD and TICKED lists.
12447 Note: UNSELECTED has to be sorted over `<'.
12448 Returns whether the updating was successful."
12449   (let* ((active (gnus-gethash group gnus-active-hashtb))
12450          (entry (gnus-gethash group gnus-newsrc-hashtb))
12451          (number (car entry))
12452          (info (nth 2 entry))
12453          (marked (nth 3 info))
12454          (prev 1)
12455          (unread (sort (copy-sequence unread) (function <)))
12456          last read)
12457     (if (or (not info) (not active))
12458         ;; There is no info on this group if it was, in fact,
12459         ;; killed. Gnus stores no information on killed groups, so
12460         ;; there's nothing to be done. 
12461         ;; One could store the information somewhere temporarily,
12462         ;; perhaps... Hmmm... 
12463         ()
12464       ;; Remove any negative articles numbers.
12465       (while (and unread (< (car unread) 0))
12466         (setq unread (cdr unread)))
12467       (setq unread (sort (append unselected unread) '<))
12468       ;; Set the number of unread articles in gnus-newsrc-hashtb.
12469       (setcar entry (max 0 (- (length unread) (length ticked) 
12470                               (length dormant))))
12471       ;; Compute the ranges of read articles by looking at the list of
12472       ;; unread articles.  
12473       (while unread
12474         (if (/= (car unread) prev)
12475             (setq read (cons (cons prev (1- (car unread))) read)))
12476         (setq prev (1+ (car unread)))
12477         (setq unread (cdr unread)))
12478       (if (<= prev (cdr active))
12479           (setq read (cons (cons prev (cdr active)) read)))
12480       ;; Enter this list into the group info.
12481       (setcar (cdr (cdr info)) 
12482               (if (> (length read) 1) (nreverse read) (car read)))
12483       ;; Enter the list of ticked articles.
12484       (gnus-set-marked-articles 
12485        info ticked
12486        (if domarks replied (cdr (assq 'reply marked)))
12487        (if domarks expirable (cdr (assq 'expire marked)))
12488        (if domarks killed (cdr (assq 'killed marked)))
12489        (if domarks dormant (cdr (assq 'dormant marked)))
12490        (if domarks bookmark (cdr (assq 'bookmark marked)))
12491        (if domarks score (cdr (assq 'score marked))))
12492       t)))
12493
12494 (defun gnus-make-articles-unread (group articles)
12495   "Mark ARTICLES in GROUP as unread."
12496   (let ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
12497                          (gnus-gethash (gnus-group-real-name group)
12498                                        gnus-newsrc-hashtb)))))
12499     (setcar (nthcdr 2 info)
12500             (gnus-remove-from-range (nth 2 info) articles))
12501     (gnus-group-update-group group t)))
12502
12503 (defun gnus-read-active-file ()
12504   "Get active file from NNTP server."
12505   (gnus-group-set-mode-line)
12506   (let ((methods (cons gnus-select-method gnus-secondary-select-methods)))
12507     (setq gnus-have-read-active-file nil)
12508     (while methods
12509       (let* ((where (nth 1 (car methods)))
12510              (mesg (format "Reading active file%s via %s..."
12511                            (if (and where (not (zerop (length where))))
12512                                (concat " from " where) "")
12513                            (car (car methods)))))
12514         (message mesg)
12515         (if (gnus-request-list (car methods)) ; Get active 
12516             (save-excursion
12517               (set-buffer nntp-server-buffer)
12518               (gnus-active-to-gnus-format 
12519                (and gnus-have-read-active-file (car methods)))
12520               (setq gnus-have-read-active-file t)
12521               (message "%s...done" mesg))
12522           (message "Cannot read active file from %s server." 
12523                    (car (car methods)))
12524           (ding)))
12525       (setq methods (cdr methods)))))
12526
12527 ;; rewritten by jwz based on ideas from Rick Sladkey <jrs@world.std.com>
12528 ;; Further rewrites by lmi.
12529 (defun gnus-active-to-gnus-format (method &optional hashtb)
12530   "Convert active file format to internal format.
12531 Lines matching `gnus-ignored-newsgroups' are ignored."
12532   (let ((cur (current-buffer))
12533         (hashtb (or hashtb 
12534                     (if method
12535                         gnus-active-hashtb
12536                       (setq gnus-active-hashtb
12537                             (gnus-make-hashtable 
12538                              (count-lines (point-min) (point-max))))))))
12539     ;; Delete unnecessary lines.
12540     (goto-char (point-min))
12541     (delete-matching-lines gnus-ignored-newsgroups)
12542     (and method (not (eq method gnus-select-method))
12543          (let ((prefix (gnus-group-prefixed-name "" method)))
12544            (goto-char (point-min))
12545            (while (and (not (eobp))
12546                        (null (insert prefix))
12547                        (zerop (forward-line 1))))))
12548     (goto-char (point-min))
12549     ;; Store active file in hashtable.
12550     (save-restriction
12551       (if (or (re-search-forward "\n.\r?$" nil t)
12552               (goto-char (point-max)))
12553           (progn
12554             (beginning-of-line)
12555             (narrow-to-region (point-min) (point))))
12556       (goto-char (point-min))
12557       (if (string-match "%[oO]" gnus-group-line-format)
12558           ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
12559           ;; If we want information on moderated groups, we use this
12560           ;; loop...   
12561           (condition-case ()
12562               (let ((mod-hashtb (make-vector 7 0))
12563                     group max mod)
12564                 (while (not (eobp))
12565                   (setq group (let ((obarray hashtb))
12566                                 (read cur)))
12567                   (setq max (read cur))
12568                   (set group (cons (read cur) max))
12569                   ;; Enter moderated groups into a list.
12570                   (if (string= 
12571                        (symbol-name  (let ((obarray mod-hashtb)) (read cur)))
12572                        "m")
12573                       (setq gnus-moderated-list 
12574                             (cons (symbol-name group) gnus-moderated-list)))
12575                   (forward-line 1)))
12576             (error 
12577              (progn (ding) (message "Possible error in active file."))))
12578         ;; And if we do not care about moderation, we use this loop,
12579         ;; which is faster.
12580         (condition-case ()
12581             (let (group max)
12582               (while (not (eobp))
12583                 ;; group gets set to a symbol interned in the hash table
12584                 ;; (what a hack!!)
12585                 (setq group (let ((obarray hashtb)) (read cur)))
12586                 (setq max (read cur))
12587                 (set group (cons (read cur) max))
12588                 (forward-line 1)))
12589           (error 
12590            (progn (ding) (message "Possible error in active file."))))))))
12591
12592 (defun gnus-read-newsrc-file (&optional force)
12593   "Read startup file.
12594 If FORCE is non-nil, the .newsrc file is read."
12595   (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
12596   ;; Reset variables that might be defined in the .newsrc.eld file.
12597   (let ((variables gnus-variable-list))
12598     (while variables
12599       (set (car variables) nil)
12600       (setq variables (cdr variables))))
12601   (let* ((newsrc-file gnus-current-startup-file)
12602          (quick-file (concat newsrc-file ".el")))
12603     (save-excursion
12604       ;; We always load the .newsrc.eld file. If always contains
12605       ;; much information that can not be gotten from the .newsrc
12606       ;; file (ticked articles, killed groups, foreign methods, etc.)
12607       (gnus-read-newsrc-el-file quick-file)
12608  
12609       (if (or force
12610               (and (file-newer-than-file-p newsrc-file quick-file)
12611                    (file-newer-than-file-p newsrc-file 
12612                                            (concat quick-file "d")))
12613               (not gnus-newsrc-assoc))
12614           ;; We read the .newsrc file. Note that if there if a
12615           ;; .newsrc.eld file exists, it has already been read, and
12616           ;; the `gnus-newsrc-hashtb' has been created. While reading
12617           ;; the .newsrc file, Gnus will only use the information it
12618           ;; can find there for changing the data already read -
12619           ;; ie. reading the .newsrc file will not trash the data
12620           ;; already read (except for read articles).
12621           (save-excursion
12622             (message "Reading %s..." newsrc-file)
12623             (set-buffer (find-file-noselect newsrc-file))
12624             (buffer-disable-undo (current-buffer))
12625             (gnus-newsrc-to-gnus-format)
12626             (kill-buffer (current-buffer))
12627             (message "Reading %s... done" newsrc-file)))
12628       (and gnus-use-dribble-file (gnus-dribble-read-file)))))
12629
12630 (defun gnus-read-newsrc-el-file (file)
12631   (let ((ding-file (concat file "d")))
12632     ;; We always, always read the .eld file.
12633     (message "Reading %s..." ding-file)
12634     (condition-case nil
12635         (load ding-file t t t)
12636       (error nil))
12637     (gnus-make-hashtable-from-newsrc-alist)
12638     (if (not (file-newer-than-file-p file ding-file))
12639         ()
12640       ;; Old format quick file
12641       (message "Reading %s..." file)
12642       ;; The .el file is newer than the .eld file, so we read that one
12643       ;; as well. 
12644       (gnus-read-old-newsrc-el-file file))))
12645
12646 ;; Parse the old-style quick startup file
12647 (defun gnus-read-old-newsrc-el-file (file)
12648   (let (newsrc killed marked group g m len info)
12649     (prog1
12650         (let (gnus-killed-assoc gnus-marked-assoc gnus-newsrc-assoc)
12651           (prog1
12652               (condition-case nil
12653                   (load file t t t)
12654                 (error nil))
12655             (setq newsrc gnus-newsrc-assoc
12656                   killed gnus-killed-assoc
12657                   marked gnus-marked-assoc)))
12658       (setq gnus-newsrc-assoc nil)
12659       (while newsrc
12660         (setq group (car newsrc))
12661         (let ((info (nth 2 (gnus-gethash (car group) gnus-newsrc-hashtb))))
12662           (if info
12663               (progn
12664                 (setcar (nthcdr 2 info) (cdr (cdr group)))
12665                 (setcar (cdr info) (if (nth 1 group) 3 6))
12666                 (setq gnus-newsrc-assoc (cons info gnus-newsrc-assoc)))
12667             (setq gnus-newsrc-assoc
12668                   (cons 
12669                    (setq info
12670                          (list (car group)
12671                                (if (nth 1 group) 3 6) (cdr (cdr group))))
12672                    gnus-newsrc-assoc)))
12673           (if (setq m (assoc (car group) marked))
12674             (setcdr (cdr (cdr info)) (cons (list (cons 'tick (cdr m))) nil))))
12675         (setq newsrc (cdr newsrc)))
12676       (setq newsrc killed)
12677       (while newsrc
12678         (setcar newsrc (car (car newsrc)))
12679         (setq newsrc (cdr newsrc)))
12680       (setq gnus-killed-list killed))
12681     (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
12682     (gnus-make-hashtable-from-newsrc-alist)))
12683       
12684 (defun gnus-make-newsrc-file (file)
12685   "Make server dependent file name by catenating FILE and server host name."
12686   (let* ((file (expand-file-name file nil))
12687          (real-file (concat file "-" (nth 1 gnus-select-method))))
12688     (if (file-exists-p real-file)
12689         real-file file)))
12690
12691 ;; jwz: rewrote this function to be much more efficient, and not be subject
12692 ;; to regexp overflow errors when it encounters very long lines -- the old
12693 ;; behavior was to blow off the rest of the *file* when a line was encountered
12694 ;; that was too long to match!!  Now it uses only simple looking-at calls, and
12695 ;; doesn't create as many temporary strings.  It also now handles multiple
12696 ;; consecutive options lines (before it only handled the first.)
12697 ;; Tiny rewrite by lmi. 
12698 (defun gnus-newsrc-to-gnus-format ()
12699   "Parse current buffer as .newsrc file."
12700   ;; We have to re-initialize these variables (except for
12701   ;; gnus-killed-list) because the quick startup file may contain bogus
12702   ;; values.
12703   (setq gnus-newsrc-options nil)
12704   (setq gnus-newsrc-options-n-yes nil)
12705   (setq gnus-newsrc-options-n-no nil)
12706   (setq gnus-newsrc-assoc nil)
12707   (gnus-parse-options-lines)
12708   (gnus-parse-newsrc-body))
12709
12710 (defun gnus-parse-options-lines ()
12711   ;; newsrc.5 seems to indicate that the options line can come anywhere
12712   ;; in the file, and that there can be any number of them:
12713   ;;
12714   ;;       An  options  line  starts  with  the  word  options (left-
12715   ;;       justified).  Then there are the list of  options  just  as
12716   ;;       they would be on the readnews command line.  For instance:
12717   ;;
12718   ;;       options -n all !net.sf-lovers !mod.human-nets -r
12719   ;;       options -c -r
12720   ;;
12721   ;;       A string of lines beginning with a space or tab after  the
12722   ;;       initial  options  line  will  be  considered  continuation
12723   ;;       lines.
12724   ;;
12725   ;; For now, we only accept it at the beginning of the file.
12726
12727   (goto-char (point-min))
12728   (skip-chars-forward " \t\n")
12729   (setq gnus-newsrc-options nil)
12730   (while (looking-at "^options[ \t]*\\(.*\\)\n")
12731     ;; handle consecutive options lines
12732     (setq gnus-newsrc-options (concat gnus-newsrc-options
12733                                       (if gnus-newsrc-options "\n\t")
12734                                       (buffer-substring (match-beginning 1)
12735                                                         (match-end 1))))
12736     (forward-line 1)
12737     (while (looking-at "[ \t]+\\(.*\\)\n")
12738       ;; handle subsequent continuation lines of this options line
12739       (setq gnus-newsrc-options (concat gnus-newsrc-options "\n\t"
12740                                         (buffer-substring (match-beginning 1)
12741                                                           (match-end 1))))
12742       (forward-line 1)))
12743   ;; Gather all "-n" options lines.
12744   (let ((start 0)
12745         (result nil))
12746     (if gnus-newsrc-options
12747         (while (and (string-match "^[ \t]*-n\\([^\n]*\\)$"
12748                                   gnus-newsrc-options
12749                                   start)
12750                     (setq start (match-end 0)))
12751           (setq result (concat result
12752                                (and result " ")
12753                                (substring gnus-newsrc-options
12754                                           (match-beginning 1)
12755                                           (match-end 1))))))
12756     (let ((yes-and-no (and result (gnus-parse-n-options result))))
12757       (and (or gnus-options-subscribe (car yes-and-no))
12758            (setq gnus-newsrc-options-n-yes 
12759                  (concat (or gnus-options-subscribe "") 
12760                          (or (car yes-and-no) ""))))
12761       (and (or gnus-options-not-subscribe (cdr yes-and-no))
12762            (setq gnus-newsrc-options-n-no 
12763                  (concat (or gnus-options-not-subscribe "") 
12764                          (or (cdr yes-and-no) "")))))
12765     nil))
12766
12767 (defun gnus-parse-newsrc-body ()
12768   ;; Point has been positioned after the options lines.  We shouldn't
12769   ;; see any more in here.
12770
12771   (let ((subscribe nil)
12772         (read-list nil)
12773         (line (1+ (count-lines (point-min) (point))))
12774         newsgroup
12775         p p2)
12776     (save-restriction
12777       (skip-chars-forward " \t")
12778       (while (not (eobp))
12779         (cond
12780          ((= (following-char) ?\n)
12781           ;; skip blank lines
12782           nil)
12783          (t
12784           (setq p (point))
12785           (skip-chars-forward "^:!\n")
12786           (if (= (following-char) ?\n)
12787               (error "line %d is unparsable in %s" line (buffer-name)))
12788           (setq p2 (point))
12789           (skip-chars-backward " \t")
12790
12791           ;; #### note: we could avoid consing a string here by binding obarray
12792           ;; and reading the newsgroup directly into the gnus-newsrc-hashtb,
12793           ;; then setq'ing newsgroup to symbol-name of that, like we do in
12794           ;; gnus-active-to-gnus-format.
12795           (setq newsgroup (buffer-substring p (point)))
12796           (goto-char p2)
12797
12798           (setq subscribe (= (following-char) ?:))
12799           (setq read-list nil)
12800
12801           (forward-char 1)              ; after : or !
12802           (skip-chars-forward " \t")
12803           (while (not (= (following-char) ?\n))
12804             (skip-chars-forward " \t")
12805             (or
12806              (and (cond
12807                    ((looking-at "\\([0-9]+\\)-\\([0-9]+\\)") ; a range
12808                     (setq read-list
12809                           (cons
12810                            (cons
12811                             (progn
12812                               ;; faster that buffer-substring/string-to-int
12813                               (narrow-to-region (point-min) (match-end 1))
12814                               (read (current-buffer)))
12815                             (progn
12816                               (narrow-to-region (point-min) (match-end 2))
12817                               (forward-char) ; skip over "-"
12818                               (prog1
12819                                   (read (current-buffer))
12820                                 (widen))))
12821                            read-list))
12822                     t)
12823                    ((looking-at "[0-9]+")
12824                     ;; faster that buffer-substring/string-to-int
12825                     (narrow-to-region (point-min) (match-end 0))
12826                     (setq p (read (current-buffer)))
12827                     (widen)
12828                     (setq read-list (cons (cons p p) read-list))
12829                     t)
12830                    (t
12831                     ;; bogus chars in ranges
12832                     nil))
12833                   (progn
12834                     (goto-char (match-end 0))
12835                     (skip-chars-forward " \t")
12836                     (cond ((= (following-char) ?,)
12837                            (forward-char 1)
12838                            t)
12839                           ((= (following-char) ?\n)
12840                            t)
12841                           (t
12842                            ;; bogus char after range
12843                            nil))))
12844              ;; if we get here, the parse failed
12845              (progn
12846                (end-of-line)            ; give up on this line
12847                (ding)
12848                (message "Ignoring bogus line %d for %s in %s"
12849                         line newsgroup (buffer-name))
12850                (sleep-for 1))))
12851           ;; We have already read .newsrc.eld, so we gently update the
12852           ;; data in the hash table with the information we have just
12853           ;; read. 
12854           (let ((info (nth 2 (gnus-gethash newsgroup gnus-newsrc-hashtb))))
12855             (if info
12856                 (progn
12857                   (setcar (nthcdr 2 info) (nreverse read-list))
12858                   (setcar (cdr info) (if subscribe 3 (if read-list 6 7)))
12859                   (setq gnus-newsrc-assoc (cons info gnus-newsrc-assoc)))
12860               (setq gnus-newsrc-assoc
12861                     (cons (list newsgroup (if subscribe 3 (if read-list 6 7))
12862                                 (nreverse read-list))
12863                           gnus-newsrc-assoc))))))
12864         (setq line (1+ line))
12865         (forward-line 1))))
12866   (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
12867   (gnus-make-hashtable-from-newsrc-alist)
12868   nil)
12869
12870 (defun gnus-parse-n-options (options)
12871   "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
12872   (let ((yes nil)
12873         (no nil)
12874         (yes-or-no nil)                 ;`!' or not.
12875         (newsgroup nil))
12876     ;; Parse each newsgroup description such as "comp.all".  Commas
12877     ;; and white spaces can be a newsgroup separator.
12878     (while
12879         (string-match "^[ \t\n,]*\\(!?\\)\\([^- \t\n,][^ \t\n,]*\\)" options)
12880       (setq yes-or-no
12881             (substring options (match-beginning 1) (match-end 1)))
12882       (setq newsgroup
12883             (regexp-quote
12884              (substring options
12885                         (match-beginning 2) (match-end 2))))
12886       (setq options (substring options (match-end 2)))
12887       ;; Rewrite "all" to ".+" not ".*".  ".+" requires at least one
12888       ;; character.
12889       (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
12890         (setq newsgroup
12891               (concat (substring newsgroup 0 (match-end 1))
12892                       ".+"
12893                       (substring newsgroup (match-beginning 2)))))
12894       ;; It is yes or no.
12895       (cond ((string-equal yes-or-no "!")
12896              (setq no (cons newsgroup no)))
12897             ((string-equal newsgroup ".+")) ;Ignore `all'.
12898             (t
12899              (setq yes (cons newsgroup yes)))))
12900     ;; Make a cons of regexps from parsing result.
12901     ;; We have to append \(\.\|$\) to prevent matching substring of
12902     ;; newsgroup.  For example, "jp.net" should not match with
12903     ;; "jp.network".
12904     ;; Fixes for large regexp problems are from yonezu@nak.math.keio.ac.jp.
12905     (cons (if yes
12906               (concat "^\\("
12907                       (apply (function concat)
12908                              (mapcar
12909                               (lambda (newsgroup)
12910                                 (concat newsgroup "\\|"))
12911                               (cdr yes)))
12912                       (car yes) "\\)\\(\\.\\|$\\)"))
12913           (if no
12914               (concat "^\\("
12915                       (apply (function concat)
12916                              (mapcar
12917                               (lambda (newsgroup)
12918                                 (concat newsgroup "\\|"))
12919                               (cdr no)))
12920                       (car no) "\\)\\(\\.\\|$\\)")))))
12921
12922 (defun gnus-save-newsrc-file ()
12923   "Save .newsrc file."
12924   ;; Note: We cannot save .newsrc file if all newsgroups are removed
12925   ;; from the variable gnus-newsrc-assoc.
12926   (and (or gnus-newsrc-assoc gnus-killed-list)
12927        gnus-current-startup-file
12928        (save-excursion
12929          (if (or (not gnus-dribble-buffer)
12930                  (not (buffer-name gnus-dribble-buffer))
12931                  (zerop (save-excursion
12932                           (set-buffer gnus-dribble-buffer)
12933                           (buffer-size))))
12934              (message "(No changes need to be saved)")
12935            (if gnus-save-newsrc-file
12936                (let ((make-backup-files t)
12937                      (version-control nil)
12938                      (require-final-newline t)) ;Don't ask even if requested.
12939                  (message "Saving %s..." gnus-current-startup-file)
12940                  ;; Make backup file of master newsrc.
12941                  ;; You can stop or change version control of backup file.
12942                  ;; Suggested by jason@violet.berkeley.edu.
12943                  (run-hooks 'gnus-save-newsrc-hook)
12944                  (gnus-gnus-to-newsrc-format)
12945                  (message "Saving %s... done" gnus-current-startup-file)))
12946            ;; Quickly loadable .newsrc.
12947            (set-buffer (get-buffer-create " *Gnus-newsrc*"))
12948            (gnus-add-current-to-buffer-list)
12949            (buffer-disable-undo (current-buffer))
12950            (erase-buffer)
12951            (message "Saving %s.eld..." gnus-current-startup-file)
12952            (gnus-gnus-to-quick-newsrc-format)
12953            (let ((make-backup-files nil)
12954                  (version-control nil)
12955                  (require-final-newline t)) ;Don't ask even if requested.
12956              (write-region 1 (point-max) 
12957                            (concat gnus-current-startup-file ".eld") 
12958                            nil 'nomesg))
12959            (kill-buffer (current-buffer))
12960            (message "Saving %s.eld... done" gnus-current-startup-file)
12961            (gnus-dribble-delete-file)))))
12962
12963 (defun gnus-gnus-to-quick-newsrc-format ()
12964   "Insert Gnus variables such as gnus-newsrc-assoc in lisp format."
12965   (insert ";; (ding) Gnus startup file.\n")
12966   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
12967   (insert ";; to read .newsrc.\n")
12968   (let ((variables gnus-variable-list)
12969         (gnus-newsrc-assoc (cdr gnus-newsrc-assoc))
12970         variable)
12971     ;; insert lisp expressions.
12972     (while variables
12973       (setq variable (car variables))
12974       (and (boundp variable)
12975            (symbol-value variable)
12976            (or gnus-save-killed-list (not (eq variable 'gnus-killed-list)))
12977            (insert "(setq " (symbol-name variable) " '"
12978                    (prin1-to-string (symbol-value variable))
12979                    ")\n"))
12980       (setq variables (cdr variables)))))
12981
12982 (defun gnus-gnus-to-newsrc-format ()
12983   ;; Generate and save the .newsrc file.
12984   (let ((newsrc (cdr gnus-newsrc-assoc))
12985         info ranges range)
12986     (save-excursion
12987       (set-buffer (create-file-buffer gnus-startup-file))
12988       (buffer-disable-undo (current-buffer))
12989       (erase-buffer)
12990       ;; Write options.
12991       (if gnus-newsrc-options (insert "options " gnus-newsrc-options "\n"))
12992       ;; Write subscribed and unsubscribed.
12993       (while newsrc
12994         (setq info (car newsrc))
12995         (if (not (nth 4 info))          ;Don't write foreign groups to .newsrc.
12996             (progn
12997               (insert (car info) (if (>= (nth 1 info) 6) "!" ":"))
12998               (if (setq ranges (nth 2 info))
12999                   (progn
13000                     (insert " ")
13001                     (if (atom (car ranges))
13002                         (if (= (car ranges) (cdr ranges))
13003                             (insert (int-to-string (car ranges)))
13004                           (insert (int-to-string (car ranges)) "-" 
13005                                   (int-to-string (cdr ranges))))
13006                       (while ranges
13007                         (setq range (car ranges)
13008                               ranges (cdr ranges))
13009                         (if (= (car range) (cdr range))
13010                             (insert (int-to-string (car range)))
13011                           (insert (int-to-string (car range)) "-"
13012                                   (int-to-string (cdr range))))
13013                         (if ranges (insert ","))))))
13014               (insert "\n")))
13015         (setq newsrc (cdr newsrc)))
13016       (write-region 1 (point-max) gnus-current-startup-file nil 'nomesg)
13017       (kill-buffer (current-buffer)))))
13018
13019 (defun gnus-read-descriptions-file ()
13020   (message "Reading descriptions file...")
13021   (if (not (gnus-request-list-newsgroups gnus-select-method))
13022       (progn
13023         (message "Couldn't read newsgroups descriptions")
13024         nil)
13025     (let (group)
13026       (setq gnus-description-hashtb 
13027             (gnus-make-hashtable (length gnus-active-hashtb)))
13028       (save-excursion
13029         (save-restriction
13030           (set-buffer nntp-server-buffer)
13031           (goto-char (point-min))
13032           (delete-non-matching-lines "^[-\\._+A-Za-z0-9]+[ \t]")
13033           (goto-char (point-min))
13034           (if (or (search-forward "\n.\n" nil t)
13035                   (goto-char (point-max)))
13036               (progn
13037                 (beginning-of-line)
13038                 (narrow-to-region (point-min) (point))))
13039           (goto-char (point-min))
13040           (while (not (eobp))
13041             (setq group (let ((obarray gnus-description-hashtb))
13042                           (read (current-buffer))))
13043             (skip-chars-forward " \t")
13044             (set group (buffer-substring 
13045                         (point) (save-excursion (end-of-line) (point))))
13046             (forward-line 1))))
13047       (message "Reading descriptions file...done")
13048       t)))
13049
13050 (defun gnus-group-get-description (group)
13051   ;; Get the description of a group by sending XGTITLE to the server.
13052   (and (gnus-request-group-description group)
13053        (save-excursion
13054          (set-buffer nntp-server-buffer)
13055          (goto-char (point-min))
13056          (and (looking-at "[^ \t]+[ \t]+\\(.*\\)")
13057               (buffer-substring (match-beginning 1) (match-end 1))))))
13058
13059 (provide 'gnus)
13060
13061 ;;; gnus.el ends here