*** 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 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, and the optional
55 third element is the \"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-secondary-select-methods nil
80   "A list of secondary methods that will be used for reading news.")
81
82 (defvar gnus-default-nntp-server nil
83   "Specify a default NNTP server.
84 This variable should be defined in paths.el, and should never be set
85 by the user.
86 If you want to change servers, you should use `gnus-select-method'.
87 See the documentation to that variable.")
88
89 (defvar gnus-secondary-servers nil
90   "List of NNTP servers that the user can choose between interactively.
91 To make Gnus query you for a server, you have to give `gnus' a
92 non-numeric prefix - `C-u M-x gnus', in short.")
93
94 (defvar gnus-nntp-server nil
95   "*The name of the host running the NNTP server.
96 This variable is semi-obsolete. Use the `gnus-select-method'
97 variable instead.")
98
99 (defvar gnus-nntp-service "nntp"
100   "NNTP service name (\"nntp\" or 119).
101 This is an obsolete variable, which is scarcely used. If you use an
102 nntp server for your newsgroup and want to change the port number
103 used to 899, you would say something along these lines:
104
105 (setq gnus-select-method '(nntp \"my.nntp.server\" 899))")
106
107 (defvar gnus-startup-file "~/.newsrc"
108   "Your `.newsrc' file.  Use `.newsrc-SERVER' instead if it exists.")
109
110 (defvar gnus-signature-file "~/.signature"
111   "Your signature file.
112 If the variable is a string that doesn't correspond to a file, the
113 string itself is inserted.")
114
115 (defvar gnus-signature-function nil
116   "A function that should return a signature file name.
117 The function will be called with the name of the newsgroup being
118 posted to.
119 If the function returns a string that doesn't correspond to a file, the
120 string itself is inserted.
121 If the function returns nil, the `gnus-signature-file' variable will
122 be used instead.")
123
124 (defvar gnus-init-file "~/.gnus"
125   "Your Gnus elisp startup file.
126 If a file with the .el or .elc suffixes exist, they will be read
127 instead.") 
128
129 (defvar gnus-default-subscribed-newsgroups nil
130   "This variable lists what newsgroups should be susbcribed the first time Gnus is used.
131 It should be a list of strings.
132 If it is `t', Gnus will not do anything special the first time it is
133 started; it'll just use the normal newsgroups subscription methods.")
134
135 (defconst gnus-backup-default-subscribed-newsgroups 
136   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
137   "Default default new newsgroups the first time Gnus is run.")
138
139 (defvar gnus-post-prepare-function nil
140   "Function that is run after a post buffer has been prepared.
141 It is called with the name of the newsgroup that is posted to. It
142 might be use, for instance, for inserting signatures based on the
143 newsgroup name. (In that case, `gnus-signature-file' and
144 `mail-signature' should both be set to nil).")
145
146 (defvar gnus-use-cross-reference t
147   "Non-nil means that cross referenced articles will be marked as read.
148 If nil, ignore cross references.  If t, mark articles as read in
149 all newsgroups.")
150
151 (defvar gnus-use-followup-to 'use
152   "Specifies what to do with Followup-To header.
153 If nil, ignore the header. If it is t, use its value, but ignore 
154 `poster'. If it is neither nil nor t, always use the value.")
155
156 (defvar gnus-followup-to-function nil
157   "A variable that contains a function that returns a followup address.
158 The function will be called in the buffer of the article that is being
159 followed up. The buffer will be narrowed to the headers of the
160 article. To pick header headers, one might use `mail-fetch-field'.  The
161 function will be called with the name of the current newsgroup as the
162 argument.
163
164 Here's an example `gnus-followup-to-function':
165
166 (setq gnus-followup-to-function
167       (lambda (group)
168         (cond ((string= group \"mail.list\")
169                (or (mail-fetch-field \"sender\") 
170                    (mail-fetch-field \"from\")))
171               (t
172                (or (mail-fetch-field \"reply-to\") 
173                    (mail-fetch-field \"from\"))))))")
174
175 (defvar gnus-reply-to-function nil
176   "A variable that contains a function that returns a reply address.
177 See the `gnus-followup-to-function' variable for an explanation of how
178 this variable is used.")
179
180 (defvar gnus-large-newsgroup 200
181   "The number of articles which indicates a large newsgroup.
182 If the number of articles in a newsgroup is greater than the value,
183 confirmation is required for selecting the newsgroup.")
184
185 (defvar gnus-author-copy (getenv "AUTHORCOPY")
186   "Name of the file the article will be saved before it is posted using the FCC header.
187 Initialized from the AUTHORCOPY environment variable.
188
189 Articles are saved using a function specified by the the variable
190 `gnus-author-copy-saver' (`rmail-output' is default) if a file name is
191 given.  Instead, if the first character of the name is `|', the
192 contents of the article is piped out to the named program. It is
193 possible to save an article in an MH folder as follows:
194
195 \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")")
196
197 (defvar gnus-mail-self-blind nil
198   "Non-nil means insert BCC to self in messages to be sent.
199 This is done when the message is initialized,
200 so you can remove or alter the BCC header to override the default.")
201
202 (defvar gnus-author-copy-saver (function rmail-output)
203   "A function called with a file name to save an author copy to.
204 The default function is `rmail-output' which saves in Unix mailbox format.")
205
206 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
207   "Non-nil means that the default name of a file to save articles in is the newsgroup name.
208 If it's nil, the directory form of the newsgroup name is used instead.")
209
210 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
211   "Name of the directory articles will be saved in (default \"~/News\").
212 Initialized from the SAVEDIR environment variable.")
213
214 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
215   "Name of the directory where kill files will be stored (default \"~/News\").
216 Initialized from the SAVEDIR environment variable.")
217
218 (defvar gnus-kill-expiry-days 7
219   "*Number of days before unused kill file entries are expired.")
220
221 (defvar gnus-default-article-saver (function gnus-summary-save-in-rmail)
222   "A function to save articles in your favorite format.
223 The function must be interactively callable (in other words, it must
224 be an Emacs command).
225
226 Gnus provides the following functions:
227
228 * gnus-summary-save-in-rmail (Rmail format)
229 * gnus-summary-save-in-mail (Unix mail format)
230 * gnus-summary-save-in-folder (MH folder)
231 * gnus-summary-save-in-file (article format).")
232
233 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
234   "A function generating a file name to save articles in Rmail format.
235 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
236
237 (defvar gnus-mail-save-name (function gnus-plain-save-name)
238   "A function generating a file name to save articles in Unix mail format.
239 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
240
241 (defvar gnus-folder-save-name (function gnus-folder-save-name)
242   "A function generating a file name to save articles in MH folder.
243 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
244
245 (defvar gnus-file-save-name (function gnus-numeric-save-name)
246   "A function generating a file name to save articles in article format.
247 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
248
249 (defvar gnus-kill-file-name "KILL"
250   "Suffix of the kill files.")
251
252 (defvar gnus-fetch-old-headers nil
253   "Non-nil means that Gnus will try to build threads by grabbing old headers.
254 If an unread article in the group refers to an older, already read (or
255 just marked as read) article, the old article will not normally be
256 displayed in the Summary buffer. If this variable is non-nil, Gnus
257 will attempt to grab the headers to the old articles, and thereby
258 build complete threads. `gnus-nov-is-evil' has to be nil if this is
259 to work.  If it has the value `some', only enough headers to connect
260 otherwise loose threads will be displayed.")
261
262 (defvar gnus-visual t
263   "*If non-nil, will do various highlighting.
264 If nil, no mouse highlight (or any other) will be performed. This
265 might speed up Gnus some when generating large group and summary
266 buffers.")
267
268 (defvar gnus-novice-user t
269   "*Non-nil means that you are a usenet novice.
270 If non-nil, verbose messages may be displayed and confirmations may be
271 required.")
272
273 (defvar gnus-expert-user nil
274   "*Non-nil means that you will never be asked for confirmation about anything.
275 And that means *anything*.")
276
277 (defvar gnus-keep-same-level nil
278   "Non-nil means that the next newsgroup after the current will be on the same level.
279 When you type, for instance, `n' after reading the last article in the
280 current newsgroup, you will go to the next newsgroup. If this variable
281 is nil, the next newsgroup will be the next from the group
282 buffer. If this variable is non-nil, Gnus will either put you in the
283 next newsgroup with the same level, or, if no such newsgroup is
284 available, the next newsgroup with the lowest possible level higher
285 than the current level.")
286
287 (defvar gnus-summary-make-false-root 'adopt
288   "nil means that Gnus won't gather loose threads.
289 If the root of a thread has expired or been read in a previous
290 session, the information necessary to build a complete thread has been
291 lost. Instead of having many small sub-threads from this original thread
292 scattered all over the summary buffer, Gnus can gather them. 
293
294 If non-nil, Gnus will try to gather all loose sub-threads from an
295 original thread into one large thread.
296
297 If this variable is non-nil, it should be one of `none', `adopt',
298 `dummy' or `empty'.
299
300 If this variable is `none', Gnus will not make a false root, but just
301 present the sub-threads after another.
302 If this variable is `dummy', Gnus will create a dummy root that will
303 have all the sub-threads as children.
304 If this variable is `adopt', Gnus will make one of the \"children\"
305 the parent and mark all the step-children as such.
306 If this variable is `empty', the \"children\" are printed with empty
307 subject fields.")
308
309 (defvar gnus-summary-gather-subject-limit nil
310   "*Maximum length of subject to compare when gathering loose threads.
311 Use nil to compare the whole subject.")
312
313 (defvar gnus-check-new-newsgroups t
314   "Non-nil means that Gnus will add new newsgroups at startup.
315 If this variable is `ask-server', Gnus will ask the server for new
316 groups since the last time it checked. This means that the killed list
317 is no longer necessary, so you could set `gnus-save-killed-list' to
318 nil. 
319 If this variable is nil, then you have to tell Gnus explicitly to
320 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
321
322 (defvar gnus-check-bogus-newsgroups nil
323   "Non-nil means that Gnus will check and remove bogus newsgroup at startup.
324 If this variable is nil, then you have to tell Gnus explicitly to
325 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
326
327 (defvar gnus-read-active-file t
328   "Non-nil means that Gnus will read the entire active file at startup.
329 If this variable is nil, Gnus will only read parts of the active file.")
330
331 (defvar gnus-activate-foreign-newsgroups nil
332   "If nil, Gnus will not check foreign newsgroups at startup.
333 If it is non-nil, it should be a number between one and nine. Foreign
334 newsgroups that have a level lower or equal to this number will be
335 activated on startup. For instance, if you want to active all
336 subscribed newsgroups, but not the rest, you'd set this variable to 5.
337
338 If you subscribe to lots of newsgroups from different servers, startup
339 might take a while. By setting this variable to nil, you'll save time,
340 but you won't be told how many unread articles there are in the
341 newsgroups.")
342
343 (defvar gnus-save-newsrc-file t
344   "Non-nil means that Gnus will save a .newsrc file.
345 Gnus always saves its own startup file, which is called \".newsrc.el\".
346 The file called \".newsrc\" is in a format that can be readily
347 understood by other newsreaders. If you don't plan on using other
348 newsreaders, set this variable to nil to save some time on exit.")
349
350 (defvar gnus-save-killed-list t
351   "If non-nil, save the list of killed groups to the startup file.
352 This will save both time (when starting and quitting) and space (on
353 disk), but it will also mean that Gnus has no record of what
354 newsgroups are new or old, so the automatic new newsgroups
355 subscription methods become meaningless. You should always set
356 `gnus-check-new-newsgroups' to nil if you set this variable to nil.") 
357
358 (defvar gnus-interactive-catchup t
359   "Require your confirmation when catching up a newsgroup if non-nil.")
360
361 (defvar gnus-interactive-post t
362   "Group and subject will be asked for if non-nil.")
363
364 (defvar gnus-interactive-exit t
365   "Require your confirmation when exiting Gnus if non-nil.")
366
367 (defvar gnus-kill-killed nil
368   "If non-nil, Gnus will apply kill files to already killd articles.
369 If it is nil, Gnus will never apply kill files to articles that have
370 already been through the scoring process, which might very well save lots
371 of time.")
372
373 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
374 (defvar gnus-summary-same-subject ""
375   "String indicating that the current article has the same subject as the previous.")
376
377 (defvar gnus-score-interactive-default-score 1000
378   "Scoring commands will raise/lower with this number as the default.")
379
380 (defvar gnus-summary-default-score 0
381   "Default article score level.
382 If this variable is nil, score levels will not be used.")
383
384 (defvar gnus-user-login-name nil
385   "The login name of the user.
386 Got from the function `user-login-name' if undefined.")
387
388 (defvar gnus-user-full-name nil
389   "The full name of the user.
390 Got from the NAME environment variable if undefined.")
391
392 (defvar gnus-show-mime nil
393   "*Show MIME message if non-nil.")
394
395 (defvar gnus-show-threads t
396   "*Show conversation threads in summary mode if non-nil.")
397
398 (defvar gnus-thread-hide-subtree nil
399   "Non-nil means hide thread subtrees initially.
400 If non-nil, you have to run the command `gnus-summary-show-thread' by
401 hand or by using `gnus-select-article-hook' to show hidden threads.")
402
403 (defvar gnus-thread-hide-killed t
404   "Non-nil means hide killed thread subtrees automatically.")
405
406 (defvar gnus-thread-ignore-subject nil
407   "Don't take care of subject differences, but only references if non-nil.
408 If it is non-nil, some commands work with subjects do not work properly.")
409
410 (defvar gnus-thread-indent-level 4
411   "Indentation of thread subtrees.")
412
413 ;; jwz: nuke newsgroups whose name is all digits - that means that
414 ;; some loser has let articles get into the root of the news spool,
415 ;; which is toxic. Lines beginning with whitespace also tend to be
416 ;; toxic.
417 (defvar gnus-ignored-newsgroups
418   (purecopy (mapconcat 'identity
419                        '("^to\\."       ; not "real" groups
420                          "^[0-9. \t]+ " ; all digits in name
421                          "[][\"#'()     ;\\]"   ; bogus characters
422                          )
423                        "\\|"))
424   "A regexp to match uninteresting newsgroups in the active file.
425 Any lines in the active file matching this regular expression are
426 removed from the newsgroup list before anything else is done to it,
427 thus making them effectively non-existant.")
428
429 (defvar gnus-ignored-headers
430   "^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:"
431   "All headers that match this regexp will be hidden.
432 Also see `gnus-visible-headers'.")
433
434 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:"
435   "All headers that do not match this regexp will be hidden.
436 Also see `gnus-ignored-headers'.")
437
438 (defvar gnus-sorted-header-list
439   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" 
440     "^Date:" "^Organization:")
441   "This variable is a list of regular expressions.
442 If it is non-nil, headers that match the regular expressions will
443 be placed first in the article buffer in the sequence specified by
444 this list.")
445
446 (defvar gnus-required-headers
447   '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)
448   ;; changed by jwz because it's not so nice to do "Lines: 0" by default.
449   ;; and to remove Path, since it's incorrect for Gnus to try
450   ;; and generate that - it is the responsibility of inews or nntpd.
451   "All required headers for articles you post.
452 RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID
453 and Path headers.  Organization, Lines and X-Newsreader are optional.
454 If you want Gnus not to insert some header, remove it from this
455 variable.")
456
457 (defvar gnus-show-all-headers nil
458   "*Show all headers of an article if non-nil.")
459
460 (defvar gnus-save-all-headers t
461   "*Save all headers of an article if non-nil.")
462
463 (defvar gnus-inhibit-startup-message nil
464   "The startup message will not be displayed if this function is non-nil.")
465
466 (defvar gnus-auto-extend-newsgroup t
467   "Extend visible articles to forward and backward if non-nil.")
468
469 (defvar gnus-auto-select-first t
470   "Select the first unread article automagically if non-nil.
471 If you want to prevent automatic selection of the first unread article
472 in some newsgroups, set the variable to nil in `gnus-select-group-hook'
473 or `gnus-apply-kill-hook'.")
474
475 (defvar gnus-auto-select-next t
476   "Select the next newsgroup automagically if non-nil.
477 If the value is t and the next newsgroup is empty, Gnus will exit
478 summary mode and go back to group mode.  If the value is neither nil
479 nor t, Gnus will select the following unread newsgroup.  Especially, if
480 the value is the symbol `quietly', the next unread newsgroup will be
481 selected without any confirmations.")
482
483 (defvar gnus-auto-select-same nil
484   "Select the next article with the same subject automagically if non-nil.")
485
486 (defvar gnus-auto-center-summary t
487   "*Always center the current summary in Gnus summary window if non-nil.")
488
489 (defvar gnus-auto-mail-to-author nil
490   "Insert `To: author' of the article when following up if non-nil.
491 Mail is sent using the function specified by the variable
492 `gnus-mail-send-method'.")
493
494 (defvar gnus-break-pages t
495   "*Break an article into pages if non-nil.
496 Page delimiter is specified by the variable `gnus-page-delimiter'.")
497
498 (defvar gnus-page-delimiter "^\^L"
499   "Regexp describing line-beginnings that separate pages of news article.")
500
501 (defvar gnus-digest-show-summary t
502   "Show a summary of undigestified messages if non-nil.")
503
504 (defvar gnus-digest-separator "^Subject:[ \t]"
505   "Regexp that separates messages in a digest article.")
506
507 (defvar gnus-use-full-window t
508   "*Non-nil means to take up the entire screen of Emacs.")
509
510 (defvar gnus-window-configuration
511   '((summary (0 1 0))
512     (newsgroups (1 0 0))
513     (article (0 3 10)))
514   "Specify window configurations for each action.
515 The format of the variable is either a list of (ACTION (G S A)), where
516 G, S, and A are the relative height of group, summary, and article
517 windows, respectively, or a list of (ACTION FUNCTION), where FUNCTION
518 is a function that will be called with ACTION as an argument. ACTION
519 can be `summary', `newsgroups', or `article'.")
520
521 (defvar gnus-show-mime-method (function metamail-buffer)
522   "Function to process a MIME message.
523 The function is expected to process current buffer as a MIME message.")
524
525 (defvar gnus-mail-reply-method
526   (function gnus-mail-reply-using-mail)
527   "Function to compose reply mail.
528 The function `gnus-mail-reply-using-mail' uses usual sendmail mail
529 program.  The function `gnus-mail-reply-using-mhe' uses the MH-E mail
530 program.  You can use yet another program by customizing this variable.")
531
532 (defvar gnus-mail-forward-method
533   (function gnus-mail-forward-using-mail)
534   "Function to forward current message to another user.
535 The function `gnus-mail-reply-using-mail' uses usual sendmail mail
536 program.  You can use yet another program by customizing this variable.")
537
538 (defvar gnus-mail-other-window-method
539   (function gnus-mail-other-window-using-mail)
540   "Function to compose mail in other window.
541 The function `gnus-mail-other-window-using-mail' uses the usual sendmail
542 mail program.  The function `gnus-mail-other-window-using-mhe' uses the MH-E
543 mail program.  You can use yet another program by customizing this variable.")
544
545 (defvar gnus-mail-send-method send-mail-function
546   "Function to mail a message too which is being posted as an article.
547 The message must have To or Cc header.  The default is copied from
548 the variable `send-mail-function'.")
549
550 (defvar gnus-subscribe-newsgroup-method
551   (function gnus-subscribe-zombies)
552   "Function called with a newsgroup name when new newsgroup is found.
553 The function `gnus-subscribe-randomly' inserts a new newsgroup a the
554 beginning of newsgroups.  The function `gnus-subscribe-alphabetically'
555 inserts it in strict alphabetic order.  The function
556 `gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup
557 order.  The function `gnus-subscribe-interactively' asks for your decision.")
558
559 ;; Suggested by a bug report by Hallvard B Furuseth
560 ;; <h.b.furuseth@usit.uio.no>. 
561 (defvar gnus-subscribe-options-newsgroup-method
562   (function gnus-subscribe-alphabetically)
563   "This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
564 If, for instance, you want to subscribe to all newsgroups in the
565 \"no\" and \"alt\" hierarchies, you'd put the following in your
566 .newsrc file:
567
568 options -n no.all alt.all
569
570 Gnus will the subscribe all new newsgroups in these hierarchies with
571 the subscription method in this variable.")
572
573 ;; Mark variables suggested by Thomas Michanek
574 ;; <Thomas.Michanek@telelogic.se>. 
575 (defvar gnus-unread-mark ? 
576   "Mark used for unread articles.")
577 (defvar gnus-ticked-mark ?!
578   "Mark used for ticked articles.")
579 (defvar gnus-dormant-mark ??
580   "Mark used for dormant articles.")
581 (defvar gnus-read-mark ?D
582   "Mark used for read articles.")
583 (defvar gnus-expirable-mark ?E
584   "Mark used for expirable articles.")
585 (defvar gnus-killed-mark ?K
586   "Mark used for killed articles.")
587 (defvar gnus-kill-file-mark ?X
588   "Mark used for articles killed by kill files.")
589 (defvar gnus-low-score-mark ?Y
590   "Mark used for articles with a low score.")
591 (defvar gnus-catchup-mark ?C
592   "Mark used for articles that are caught up.")
593 (defvar gnus-replied-mark ?R
594   "Mark used for articles that have been replied to.")
595 (defvar gnus-process-mark ?#
596   "Mark used for marking articles as processable.")
597 (defvar gnus-ancient-mark ?A
598   "Mark used for ancient articles.")
599 (defvar gnus-canceled-mark ?%
600   "Mark used for cancelled articles.")
601
602 (defvar gnus-view-pseudo-asynchronously nil
603   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
604
605 (defvar gnus-group-mode-hook nil
606   "A hook for Gnus group mode.")
607
608 (defvar gnus-summary-mode-hook nil
609   "A hook for Gnus summary mode.")
610
611 (defvar gnus-article-mode-hook nil
612   "A hook for Gnus article mode.")
613
614 (defvar gnus-kill-file-mode-hook nil
615   "A hook for Gnus KILL File mode.")
616
617 (defvar gnus-open-server-hook nil
618   "A hook called just before opening connection to news server.")
619
620 (defvar gnus-startup-hook nil
621   "A hook called at startup time.
622 This hook is called after Gnus is connected to the NNTP server. So, it
623 is possible to change the behavior of Gnus according to the selected
624 NNTP server.")
625
626 (defvar gnus-group-prepare-hook nil
627   "A hook called after the newsgroup list is created in the group buffer.
628 If you want to modify the group buffer, you can use this hook.")
629
630 (defvar gnus-summary-prepare-hook nil
631   "A hook called after summary list is created in the summary buffer.
632 If you want to modify the summary buffer, you can use this hook.")
633
634 (defvar gnus-article-prepare-hook nil
635   "A hook called after an article is prepared in the article buffer.
636 If you want to run a special decoding program like nkf, use this hook.")
637
638 (defvar gnus-article-display-hook nil
639   "A hook called after the article is displayed in the article buffer.
640 The hook is designed to change the contents of the article
641 buffer. Typical functions that this hook may contain are
642 `gnus-article-hide-headers' (hide selected headers),
643 `gnus-article-hide-signature' (hide signature) and
644 `gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
645 (add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
646 (add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
647
648 (defvar gnus-select-group-hook nil
649   "A hook called when a newsgroup is selected.
650
651 If you'd like to simplify subjects like the
652 `gnus-summary-next-same-subject' command does, you can use the
653 following hook:
654
655  (setq gnus-select-group-hook
656       (list
657         (lambda ()
658           (mapcar (lambda (header)
659                      (header-set-subject
660                       header
661                       (gnus-simplify-subject
662                        (header-subject header) 're-only)))
663                   gnus-newsgroup-headers))))
664 ")
665
666 (defvar gnus-select-article-hook
667   '(gnus-summary-show-thread)
668   "A hook called when an article is selected.
669 The default hook shows conversation thread subtrees of the selected
670 article automatically using `gnus-summary-show-thread'.
671
672 If you'd like to run RMAIL on a digest article automagically, you can
673 use the following hook:
674
675 \(setq gnus-select-article-hook
676       (list
677         (lambda ()
678           (gnus-summary-show-thread)
679           (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
680                  (gnus-summary-rmail-digest))
681                 ((and (string-equal \"comp.text\" gnus-newsgroup-name)
682                       (string-match \"^TeXhax Digest\"
683                                     (header-subject gnus-current-headers)))
684                  (gnus-summary-rmail-digest)
685                  )))))")
686
687 (defvar gnus-select-digest-hook
688   (list
689    (lambda ()
690      ;; Reply-To: is required by `undigestify-rmail-message'.
691      (or (mail-position-on-field "Reply-to" t)
692          (progn
693            (mail-position-on-field "Reply-to")
694            (insert (gnus-fetch-field "From"))))))
695   "A hook called when reading digest messages using Rmail.
696 This hook can be used to modify incomplete digest articles as follows
697 \(this is the default):
698
699 \(setq gnus-select-digest-hook
700       (list
701         (lambda ()
702           ;; Reply-To: is required by `undigestify-rmail-message'.
703           (or (mail-position-on-field \"Reply-to\" t)
704               (progn
705                 (mail-position-on-field \"Reply-to\")
706                 (insert (gnus-fetch-field \"From\")))))))")
707
708 (defvar gnus-rmail-digest-hook nil
709   "A hook called when reading digest messages using Rmail.
710 This hook is intended to customize Rmail mode for reading digest articles.")
711
712 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
713   "A hook called when a newsgroup is selected and summary list is prepared.
714 This hook is intended to apply a kill file to the selected newsgroup.
715 The function `gnus-apply-kill-file' is called by default.
716
717 Since a general kill file is too heavy to use only for a few
718 newsgroups, I recommend you to use a lighter hook function. For
719 example, if you'd like to apply a kill file to articles which contains
720 a string `rmgroup' in subject in newsgroup `control', you can use the
721 following hook:
722
723 \(setq gnus-apply-kill-hook
724       (list
725         (lambda ()
726           (cond ((string-match \"control\" gnus-newsgroup-name)
727                  (gnus-kill \"Subject\" \"rmgroup\")
728                  (gnus-expunge \"X\"))))))")
729
730 (defvar gnus-visual-mark-article-hook 
731   (list 'gnus-visual-highlight-selected-summary)
732   "Hook run after selecting an article in the summary buffer.
733 It is meant to be used for highlighting the article in some way. It is
734 not run if `gnus-visual' is nil.")
735
736 (defvar gnus-prepare-article-hook (list (function gnus-inews-insert-signature))
737   "A hook called after preparing body, but before preparing header headers.
738 The default hook (`gnus-inews-insert-signature') inserts a signature
739 file specified by the variable `gnus-signature-file'.")
740
741 (defvar gnus-inews-article-hook (list (function gnus-inews-do-fcc))
742   "A hook called before finally posting an article.
743 The default hook (`gnus-inews-do-fcc') does FCC processing (save article
744 to a file).")
745
746 (defvar gnus-exit-group-hook nil
747   "A hook called when exiting (not quitting) summary mode.
748 If your machine is so slow that exiting from summary mode takes very
749 long time, set the variable `gnus-use-cross-reference' to nil. This
750 inhibits marking articles as read using cross-reference information.")
751
752 (defvar gnus-suspend-gnus-hook nil
753   "A hook called when suspending (not exiting) Gnus.")
754
755 (defvar gnus-exit-gnus-hook (list 'nntp-request-close)
756   "A hook called when exiting Gnus.")
757
758 (defvar gnus-save-newsrc-hook nil
759   "A hook called when saving the newsrc file.
760 This hook is called before saving the `.newsrc' file.")
761
762 (defvar gnus-auto-expirable-newsgroups nil
763   "All newsgroups that match this regexp will have all read articles automatically marked as expirable.")
764
765 (defvar gnus-subscribe-hierarchical-interactive nil
766   "If non-nil, Gnus will offer to subscribe hierarchically.
767 When a new hierarchy appears, Gnus will ask the user:
768
769 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
770
771 If the user pressed `d', Gnus will descend the hierarchy, `y' will
772 subscribe to all newsgroups in the hierarchy and `s' will skip this
773 hierarchy in its entirety.")
774
775 (defvar gnus-group-line-format "%M%S%5y: %(%g%)\n"
776   "Format of groups lines.
777 It works along the same lines as a normal formatting string,
778 with some simple extrensions.
779
780 %M    Only marked articles (character, \"*\" or \" \")
781 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
782 %L    Level of subscribedness (integer, 1-9)
783 %N    Number of unread articles (integer)
784 %I    Number of dormant articles (integer)
785 %i    Number of ticked and dormant (integer)
786 %T    Number of ticked articles (integer)
787 %R    Number of read articles (integer)
788 %t    Total number of articles (integer)
789 %y    Number of unread, unticked articles (integer)
790 %G    Group name (string)
791 %g    Qualified group name (string)
792 %D    Group description (string)
793 %s    Select method (string)
794 %o    Moderated group (char, \"m\")
795 %O    Moderated group (string, \"(m)\" or \"\")
796 %n    Select from where (string)
797 %z    A string that look like `<%s:%n>' if a foreign select method is used
798 %u    User defined specifier. The next character in the format string should
799       be a letter.  GNUS will call the function gnus-user-format-function-X,
800       where X is the letter following %u. The function will be passed the
801       current header as argument. The function should return a string, which
802       will be inserted into the summary just like information from any other
803       summary specifier.
804
805 Text between %( and %) will be highlighted with `gnus-mouse-face' when
806 the mouse point move inside the area.  There can only be one such area.
807
808 Note that this format specification is not always respected. For
809 reasons of efficiency, when listing killed groups, this specification
810 is ignored altogether. If the spec is changed considerably, your
811 output may end up looking strange when listing both alive and killed
812 groups.
813
814 If you use %o or %O, reading the active file will be slower and quite
815 a bit of extra memory will be used. %D will also worsen performance.
816 Also note that if you change the format specification to include any
817 of these specs, you must probably re-start Gnus to see them go into
818 effect.") 
819
820 (defvar gnus-summary-line-format "%U%R %I%(%[%4L: %-20,20n%]%) %s\n"
821   "The format specification of the lines in the summary buffer.
822 The first specification must always be \"%U%R\", at least in this
823 version of Gnus.
824
825 It works along the same lines as a normal formatting string,
826 with some simple extensions.
827
828 %N   Article number, left padded with spaces (integer)
829 %S   Subject (string)
830 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
831 %n   Name of the poster (string)
832 %A   Address of the poster (string)
833 %L   Number of lines in the article (integer)
834 %c   Number of characters in the article (integer)
835 %D   Date of the article (string)
836 %I   Indentation based on thread level (a string of spaces)
837 %T   A string with two possible values: 80 spaces if the article
838      is on thread level two or larger and 0 spaces on level one
839 %U   Status of this article (character, \"D\", \"K\", \"-\" or \" \") 
840 %[   Opening bracket (character, \"[\" or \"<\")
841 %]   Closing bracket (character, \"]\" or \">\")
842 %>   Spaces of length thread-level (string)
843 %<   Spaces of length (- 20 thread-level) (string)
844 %i   Article score (number)
845 %z   Article zcore (character)
846 %u   User defined specifier. The next character in the format string should
847      be a letter.  GNUS will call the function gnus-user-format-function-X,
848      where X is the letter following %u. The function will be passed the
849      current header as argument. The function should return a string, which
850      will be inserted into the summary just like information from any other
851      summary specifier.
852
853 Text between %( and %) will be highlighted with `gnus-mouse-face'
854 when the mouse point is placed inside the area.  There can only be one
855 such area.")
856
857 (defconst gnus-summary-dummy-line-format "*   :                          : %S\n"
858   "The format specification for the dummy roots in the summary buffer.
859 It works along the same lines as a normal formatting string,
860 with some simple extensions.
861
862 %S  The subject")
863
864 (defvar gnus-summary-mode-line-format "(ding) %G/%A %Z"
865   "The format specification for the summary mode line.")
866
867 (defvar gnus-article-mode-line-format "(ding) %G/%A %S"
868   "The format specification for the article mode line.")
869
870 (defconst gnus-group-mode-line-format "(ding) List of groups   {%M:%S}"
871   "The format specification for the group mode line.")
872
873
874 \f
875 ;; Site dependent variables. You have to define these variables in
876 ;;  site-init.el, default.el or your .emacs.
877
878 (defvar gnus-local-timezone nil
879   "Local time zone.
880 This value is used only if `current-time-zone' does not work in your Emacs.
881 It specifies the GMT offset, i.e. a decimal integer
882 of the form +-HHMM giving the hours and minutes ahead of (i.e. east of) GMT.
883 For example, +0900 should be used in Japan, since it is 9 hours ahead of GMT.
884
885 For backwards compatibility, it may also be a string like \"JST\",
886 but strings are obsolescent: you should use numeric offsets instead.")
887
888 (defvar gnus-local-domain nil
889   "Local domain name without a host name.
890 The DOMAINNAME environment variable is used instead if it is defined.
891 If the `system-name' function returns the full Internet name, there is
892 no need to set this variable.")
893
894 (defvar gnus-local-organization nil
895   "String with a description of what organization (if any) the user belongs to.
896 The ORGANIZATION environment variable is used instead if it is defined.
897 If this variable contains a function, this function will be called
898 with the current newsgroup name as the argument. The function should
899 return a string.
900 In any case, if the string (either in the variable, in the environment
901 variable, or returned by the function) is a file name, the contents of
902 this file will be used as the organization.")
903
904 (defvar gnus-use-generic-from nil
905   "If nil, the full host name will be the system name prepended to the domain name.
906 If this is a string, the full host name will be this string.
907 If this is non-nil, non-string, the domain name will be used as the
908 full host name.")
909
910 (defvar gnus-use-generic-path nil
911   "If nil, use the NNTP server name in the Path header.
912 If stringp, use this; if non-nil, use no host name (user name only).")
913
914 (defvar gnus-valid-select-methods
915   '(("nntp" post address) ("nnspool" post) ("nnvirtual" none) 
916     ("nnmbox" mail respool) ("nnml" mail respool)
917     ("nnmh" mail respool) ("nndir" none))
918   "A list of valid select methods.
919 Each element in this list should be a list. The first element of these
920 lists should be a string with the name of the select method. The
921 other elements may be be the category of this method (ie. `post',
922 `mail', `none' or whatever) or other properties that this method has
923  (like being respoolable). 
924 If you implement a new select method, all you should have to change is
925 this variable. I think.")
926
927 (defvar gnus-updated-mode-lines '(group article summary)
928   "This variable is a list of buffers that should keep their mode lines updated.
929 The list may contain the symbols `group', `article' and `summary'. If
930 the corresponding symbol is present, Gnus will keep that mode line
931 updated with information that may be pertinent. 
932 If this variable is nil, screen refresh may be quicker.")
933
934 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
935 (defvar gnus-mouse-face 'highlight
936   "Face used for mouse highlighting in Gnus.
937 No mouse highlights will be done if `gnus-visual' is nil.")
938
939 (defvar gnus-visual-summary-update-hook 
940   (list 'gnus-visual-summary-highlight-line)
941   "A hook called when a summary line is changed.
942 The hook will not be called if `gnus-visual' is nil.
943
944 Point will be at the beginning of the line, and the following free
945 variables can be used for convenience:
946
947 score:   (gnus-summary-article-score)
948 default: gnus-summary-default-score
949 below:   gnus-summary-mark-below
950
951 The default hook `gnus-visual-summary-highlight-line' will highlight the line
952 according to the `gnus-visual-summary-highlight' variable.")
953
954 (defvar gnus-summary-mark-below nil
955   "Score below which articles automatically become marked.
956 This variable is local to each summary buffer and usually set in the
957 score file.")  
958
959 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
960   "List of functions used for thread roots in the summary buffer.
961
962 Each function takes two threads and return non-nil if the first thread
963 should be sorted before the other.  If you use more than one function,
964 list the function you want to act as the primary sort key last.
965
966 Functions you can use are:
967 - gnus-thread-sort-by-number
968 - gnus-thread-sort-by-author
969 - gnus-thread-sort-by-subject
970 - gnus-thread-sort-by-date
971 - gnus-thread-sort-by-score
972 - gnus-thread-sort-by-total-score (see `gnus-thread-score-function').
973
974 The two later only works on articles that have already been scored prior
975 to entering the newsgroup.")
976
977 (defvar gnus-thread-score-function '+
978   "Function used for calculating the total score of a thread.
979
980 The function is called with the scores of the article and each
981 subthread and should then return the score of the thread.
982
983 Some functions you can use are `+', `max', or `min'.")
984
985 (defvar gnus-score-hierarchical t
986   "If non-nil, a SCORE file for a group also applies to subgroups.")
987
988 (defvar gnus-score-find-score-files-function nil
989   "If non-nil, it should be a function that returns a list of score files.
990 The function will be called with the name of the group that is to be
991 scored. This function does not have to make sure that the file names
992 returned actually exist.")
993
994 \f
995 ;; Internal variables
996
997 ;; Avoid highlighting in kill files.
998 (defvar gnus-summary-inhibit-highlight nil)
999
1000 (defvar caesar-translate-table nil)
1001
1002 (defvar gnus-dribble-buffer nil)
1003 (defvar gnus-headers-retrieved-by nil)
1004
1005 (defvar gnus-article-reply nil)
1006 (defvar gnus-article-check-size nil)
1007
1008 (defvar gnus-score-file-list nil)
1009 (defvar gnus-score-alist nil
1010   "Alist containing score information.
1011 The keys can be symbols or strings.  The following symbols are defined. 
1012
1013 touched: If this alist has been modified.
1014 mark:    Automatically mark articles below this.
1015 expunge: Automatically expunge articles below this.
1016 files:   List of other SCORE files to load when loading this one.
1017 eval:    Sexp to be evaluated when the score file is loaded.
1018
1019 String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) 
1020 where HEADER is the header being scored, MATCH is the string we are
1021 looking for, TYPE is a flag indicating whether it should use regexp or
1022 substring matching, SCORE is the score to add and DATE is the date
1023 of the last succesful match.")
1024
1025 (defvar gnus-score-cache nil)
1026 ;; Alist containing the content of all loaded SCORE files.
1027
1028 (defvar gnus-header-index nil)
1029 (defvar gnus-score-index nil)
1030
1031 (defvar gnus-newsgroup-dependencies nil)
1032
1033 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1034
1035 (defvar gnus-default-subscribe-level 2
1036   "Default subscription level.")
1037
1038 (defvar gnus-default-unsubscribe-level 6
1039   "Default unsubscription level.")
1040
1041 (defvar gnus-default-kill-level 9
1042   "Default kill level.")
1043
1044 (defconst gnus-group-line-format-alist
1045   (list (list ?M 'marked ?c)
1046         (list ?S 'subscribed ?c)
1047         (list ?L 'level ?d)
1048         (list ?N 'number ?s)
1049         (list ?I 'number-of-dormant ?d)
1050         (list ?T 'number-of-ticked ?d)
1051         (list ?R 'number-of-read ?s)
1052         (list ?t 'number-total ?d)
1053         (list ?y 'number-of-unread-unticked ?s)
1054         (list ?i 'number-of-ticked-and-dormant ?d)
1055         (list ?g 'group ?s)
1056         (list ?G 'qualified-group ?s)
1057         (list ?D 'newsgroup-description ?s)
1058         (list ?o 'moderated ?c)
1059         (list ?O 'moderated-string ?s)
1060         (list ?s 'news-server ?s)
1061         (list ?n 'news-method ?s)
1062         (list ?z 'news-method-string ?s)
1063         (list ?u 'user-defined ?s)))
1064
1065 (defconst gnus-summary-line-format-alist 
1066   (list (list ?N 'number ?d)
1067         (list ?S 'subject ?s)
1068         (list ?s 'subject-or-nil ?s)
1069         (list ?n 'name ?s)
1070         (list ?A 'address ?s)
1071         (list ?F 'from ?s)
1072         (list ?x (macroexpand '(header-xref header)) ?s)
1073         (list ?D (macroexpand '(header-date header)) ?s)
1074         (list ?M (macroexpand '(header-id header)) ?s)
1075         (list ?r (macroexpand '(header-references header)) ?s)
1076         (list ?c (macroexpand '(header-chars header)) ?d)
1077         (list ?L 'lines ?d)
1078         (list ?I 'indentation ?s)
1079         (list ?T '(if (< level 1) "" (make-string (frame-width) ? )) ?s)
1080         (list ?R 'replied ?c)
1081         (list ?\[ 'opening-bracket ?c)
1082         (list ?\] 'closing-bracket ?c)
1083         (list ?\> '(make-string level ? ) ?s)
1084         (list ?\< '(make-string (max 0 (- 20 level)) ? ) ?s)
1085         (list ?i 'score ?s)
1086         (list ?z 'score-char ?c)
1087         (list ?U 'unread ?c)
1088         (list ?u 'user-defined ?s))
1089   "An alist of format specifications that can appear in summary lines,
1090 and what variables they correspond with, along with the type of the
1091 variable (string, integer, character, etc).")
1092
1093 (defconst gnus-summary-dummy-line-format-alist
1094   (list (list ?S 'subject ?s)
1095         (list ?N 'number ?d)))
1096
1097 (defconst gnus-summary-mode-line-format-alist 
1098   (list (list ?G 'group-name ?s)
1099         (list ?A 'article-number ?d)
1100         (list ?Z 'unread-and-unselected ?s)
1101         (list ?V 'gnus-version ?s)
1102         (list ?U 'unread ?d)
1103         (list ?S 'subject ?s)
1104         (list ?u 'unselected ?d)))
1105
1106 (defconst gnus-group-mode-line-format-alist 
1107   (list (list ?S 'news-server ?s)
1108         (list ?M 'news-method ?s)))
1109
1110 (defvar gnus-have-read-active-file nil)
1111
1112 (defconst gnus-maintainer "Lars Magne Ingebrigtsen <larsi@ifi.uio.no>"
1113   "The mail address of the Gnus maintainer.")
1114
1115 (defconst gnus-version "(ding) Gnus v0.20"
1116   "Version number for this version of Gnus.")
1117
1118 (defvar gnus-info-nodes
1119   '((gnus-group-mode            "(gnus)Group Commands")
1120     (gnus-summary-mode          "(gnus)Summary Commands")
1121     (gnus-article-mode          "(gnus)Article Commands")
1122     (gnus-kill-file-mode        "(gnus)Kill File"))
1123   "Assoc list of major modes and related Info nodes.")
1124
1125 (defvar gnus-group-buffer "*Group*")
1126 (defvar gnus-summary-buffer "*Summary*")
1127 (defvar gnus-article-buffer "*Article*")
1128 (defvar gnus-digest-buffer "Gnus Digest")
1129 (defvar gnus-digest-summary-buffer "Gnus Digest-summary")
1130
1131 (defvar gnus-buffer-list nil
1132   "Gnus buffers that should be killed when exiting.")
1133
1134 (defvar gnus-variable-list
1135   '(gnus-newsrc-options 
1136     gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
1137     gnus-newsrc-last-checked-date
1138     gnus-newsrc-assoc gnus-killed-list gnus-zombie-list)
1139   "Gnus variables saved in the quick startup file.")
1140
1141 (defvar gnus-overload-functions
1142   '((news-inews gnus-inews-news "rnewspost")
1143     (caesar-region gnus-caesar-region "rnews"))
1144   "Functions overloaded by gnus.
1145 It is a list of `(original overload &optional file)'.")
1146
1147 (defvar gnus-newsrc-options nil
1148   "Options line in the .newsrc file.")
1149
1150 (defvar gnus-newsrc-options-n-yes nil
1151   "Regexp representing subscribed newsgroups.")
1152
1153 (defvar gnus-newsrc-options-n-no nil
1154   "Regexp representing unsubscribed newsgroups.")
1155
1156 (defvar gnus-newsrc-last-checked-date nil
1157   "Date Gnus last asked server for new newsgroups.")
1158
1159 (defvar gnus-newsrc-assoc nil
1160   "Assoc list of read articles.
1161 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1162
1163 (defvar gnus-newsrc-hashtb nil
1164   "Hashtable of gnus-newsrc-assoc.")
1165
1166 (defvar gnus-killed-list nil
1167   "List of killed newsgroups.")
1168
1169 (defvar gnus-killed-hashtb nil
1170   "Hash table equivalent of gnus-killed-list.")
1171
1172 (defvar gnus-zombie-list nil
1173   "List of almost dead newsgroups.")
1174
1175 (defvar gnus-description-hashtb nil
1176   "Descriptions of newsgroups.")
1177
1178 (defvar gnus-list-of-killed-groups nil
1179   "List of newsgroups that have recently been killed by the user.")
1180
1181 (defvar gnus-xref-hashtb nil
1182   "Hash table of cross-posted articles.")
1183
1184 (defvar gnus-active-hashtb nil
1185   "Hashtable of active articles.")
1186
1187 (defvar gnus-moderated-list nil
1188   "List of moderated newsgroups.")
1189
1190 (defvar gnus-current-startup-file nil
1191   "Startup file for the current host.")
1192
1193 (defvar gnus-last-search-regexp nil
1194   "Default regexp for article search command.")
1195
1196 (defvar gnus-last-shell-command nil
1197   "Default shell command on article.")
1198
1199 (defvar gnus-current-select-method nil
1200   "The current method for selecting a newsgroup.")
1201
1202 (defvar gnus-have-all-newsgroups nil)
1203
1204 (defvar gnus-article-internal-prepare-hook nil)
1205
1206 (defvar gnus-newsgroup-name nil)
1207 (defvar gnus-newsgroup-begin nil)
1208 (defvar gnus-newsgroup-end nil)
1209 (defvar gnus-newsgroup-last-rmail nil)
1210 (defvar gnus-newsgroup-last-mail nil)
1211 (defvar gnus-newsgroup-last-folder nil)
1212 (defvar gnus-newsgroup-last-file nil)
1213 (defvar gnus-newsgroup-auto-expire nil
1214   "If non-nil, all read articles will be marked as expirable.")
1215
1216 (defvar gnus-newsgroup-selected-overlay nil)
1217
1218 (defvar gnus-newsgroup-unreads nil
1219   "List of unread articles in the current newsgroup.")
1220
1221 (defvar gnus-newsgroup-unselected nil
1222   "List of unselected unread articles in the current newsgroup.")
1223
1224 (defvar gnus-newsgroup-marked nil
1225   "List of ticked articles in the current newsgroup (a subset of unread art).")
1226
1227 (defvar gnus-newsgroup-killed nil
1228   "List of ranges of articles that have been through the scoring process.")
1229
1230 (defvar gnus-newsgroup-kill-headers nil)
1231
1232 (defvar gnus-newsgroup-replied nil
1233   "List of articles that have been replied to in the current newsgroup.")
1234
1235 (defvar gnus-newsgroup-expirable nil
1236   "List of articles in the current newsgroup that can be expired.")
1237
1238 (defvar gnus-newsgroup-processable nil
1239   "List of articles in the current newsgroup that can be processed.")
1240
1241 (defvar gnus-newsgroup-bookmarks nil
1242   "List of articles in the current newsgroup that have bookmarks.")
1243
1244 (defvar gnus-newsgroup-dormant nil
1245   "List of dormant articles in the current newsgroup.")
1246
1247 (defvar gnus-newsgroup-scored nil
1248   "List of scored articles in the current newsgroup.")
1249
1250 (defvar gnus-newsgroup-headers nil
1251   "List of article headers in the current newsgroup.")
1252 (defvar gnus-newsgroup-headers-hashtb-by-number nil)
1253
1254 (defvar gnus-newsgroup-ancient nil
1255   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1256
1257 (defvar gnus-current-article nil)
1258 (defvar gnus-article-current nil)
1259 (defvar gnus-current-headers nil)
1260 (defvar gnus-have-all-headers nil "Must be either T or NIL.")
1261 (defvar gnus-last-article nil)
1262 (defvar gnus-current-kill-article nil)
1263 (defvar gnus-newsgroup-dormant-subjects nil)
1264 (defvar gnus-newsgroup-expunged-buffer nil)
1265
1266 ;; Save window configuration.
1267 (defvar gnus-winconf-kill-file nil)
1268
1269 (defconst gnus-group-mode-map nil)
1270 (defvar gnus-article-mode-map nil)
1271 (defvar gnus-kill-file-mode-map nil)
1272
1273 ;; Format specs
1274 (defvar gnus-summary-line-format-spec nil)
1275 (defvar gnus-summary-dummy-line-format-spec nil)
1276 (defvar gnus-group-line-format-spec nil)
1277 (defvar gnus-summary-mode-line-format-spec nil)
1278 (defvar gnus-article-mode-line-format-spec nil)
1279 (defvar gnus-group-mode-line-format-spec nil)
1280 (defvar gnus-summary-expunge-below nil)
1281 (defvar gnus-reffed-article-number nil)
1282
1283 (defvar rmail-default-file (expand-file-name "~/XMBOX"))
1284 (defvar rmail-default-rmail-file (expand-file-name "~/XNEWS"))
1285
1286 (defconst gnus-summary-local-variables 
1287   '(gnus-newsgroup-name 
1288     gnus-newsgroup-begin gnus-newsgroup-end 
1289     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail 
1290     gnus-newsgroup-last-folder gnus-newsgroup-last-file 
1291     gnus-newsgroup-auto-expire gnus-newsgroup-unreads 
1292     gnus-newsgroup-unselected gnus-newsgroup-marked
1293     gnus-newsgroup-replied gnus-newsgroup-expirable
1294     gnus-newsgroup-processable gnus-newsgroup-killed
1295     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1296     gnus-newsgroup-dormant-subjects gnus-newsgroup-expunged-buffer
1297     gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number
1298     gnus-current-article gnus-current-headers gnus-have-all-headers
1299     gnus-last-article gnus-article-internal-prepare-hook
1300     gnus-newsgroup-selected-overlay gnus-newsgroup-dependencies
1301     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1302     gnus-score-alist gnus-summary-expunge-below 
1303     gnus-summary-mark-below gnus-newsgroup-ancient)
1304   "Variables that are buffer-local to the summary buffers.")
1305
1306 (defvar gnus-mark-article-hook
1307   (list
1308    (lambda ()
1309      (or (memq gnus-current-article gnus-newsgroup-marked)
1310          (memq gnus-current-article gnus-newsgroup-dormant)
1311          (memq gnus-current-article gnus-newsgroup-expirable)
1312          (gnus-summary-mark-as-read gnus-current-article))))
1313   "A hook called when an article is selected at the first time.
1314 The hook is intended to mark an article as read (or unread)
1315 automatically when it is selected.
1316
1317 If you'd like to tick articles instead, use the following hook:
1318
1319 \(setq gnus-mark-article-hook
1320       (list
1321         (lambda ()
1322           (gnus-summary-tick-article gnus-current-article))))")
1323
1324 ;; Define some autoload functions Gnus may use.
1325 (eval-and-compile
1326   (autoload 'metamail-buffer "metamail")
1327   (autoload 'Info-goto-node "info")
1328   
1329   (autoload 'timezone-make-date-arpa-standard "timezone")
1330   (autoload 'timezone-fix-time "timezone")
1331   (autoload 'timezone-make-sortable-date "timezone")
1332   (autoload 'timezone-make-time-string "timezone")
1333   
1334   (autoload 'rmail-output "rmailout"
1335     "Append this message to Unix mail file named FILE-NAME." t)
1336   (autoload 'mail-position-on-field "sendmail")
1337   (autoload 'mail-setup "sendmail")
1338
1339   (autoload 'gnus-mail-reply-using-mhe "gnus-mh")
1340   (autoload 'gnus-mail-forward-using-mhe "gnus-mh")
1341   (autoload 'gnus-mail-other-window-using-mhe "gnus-mh")
1342   (autoload 'gnus-summary-save-in-folder "gnus-mh")
1343   (autoload 'gnus-Folder-save-name "gnus-mh")
1344   (autoload 'gnus-folder-save-name "gnus-mh")
1345   
1346   (autoload 'gnus-group-make-menu-bar "gnus-visual")
1347   (autoload 'gnus-summary-make-menu-bar "gnus-visual")
1348   (autoload 'gnus-article-make-menu-bar "gnus-visual")
1349   (autoload 'gnus-visual-highlight-selected-summary "gnus-visual")
1350   (autoload 'gnus-visual-summary-highlight-line "gnus-visual")
1351
1352   (autoload 'gnus-uu-decode-map "gnus-uu" nil nil 'keymap)
1353   (autoload 'gnus-uu-mark-by-regexp "gnus-uu")
1354   (autoload 'gnus-uu-mark-region "gnus-uu")
1355   (autoload 'gnus-uu-mark-thread "gnus-uu")
1356   (autoload 'gnus-uu-mark-sparse "gnus-uu")
1357   (autoload 'gnus-uu-post-news "gnus-uu")
1358   (autoload 'gnus-uu-digest-and-forward "gnus-uu")
1359   (autoload 'gnus-uu-decode-uu "gnus-uu")
1360   (autoload 'gnus-uu-decode-uu-and-save "gnus-uu")
1361   (autoload 'gnus-uu-decode-unshar "gnus-uu")
1362   (autoload 'gnus-uu-decode-unshar-and-save "gnus-uu")
1363   (autoload 'gnus-uu-decode-save "gnus-uu")
1364   (autoload 'gnus-uu-decode-save "gnus-uu")
1365   (autoload 'gnus-uu-decode-binhex "gnus-uu")
1366   (autoload 'gnus-uu-decode-binhex "gnus-uu")
1367
1368   (autoload 'pp "pp")
1369   )
1370
1371 (put 'gnus-group-mode 'mode-class 'special)
1372 (put 'gnus-summary-mode 'mode-class 'special)
1373 (put 'gnus-article-mode 'mode-class 'special)
1374
1375 \f
1376
1377 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1378 (defun gnus-summary-position-cursor () nil)
1379 (defun gnus-group-position-cursor () nil)
1380 (fset 'gnus-summary-position-cursor 'gnus-goto-colon)
1381 (fset 'gnus-group-position-cursor 'gnus-goto-colon)
1382
1383 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
1384   "Pop to BUFFER, evaluate FORMS, and then returns to original window."
1385   (` (let ((GnusStartBufferWindow (selected-window)))
1386        (unwind-protect
1387            (progn
1388              (pop-to-buffer (, buffer))
1389              (,@ forms))
1390          (select-window GnusStartBufferWindow)))))
1391
1392 (defun gnus-make-hashtable (&optional hashsize)
1393   "Make a hash table (default and minimum size is 255).
1394 Optional argument HASHSIZE specifies the table size."
1395   (make-vector (if hashsize 
1396                    (max (gnus-create-hash-size hashsize) 255)
1397                  255) 0))
1398
1399 (defmacro gnus-gethash (string hashtable)
1400   "Get hash value of STRING in HASHTABLE."
1401   ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
1402   ;;(` (abbrev-expansion (, string) (, hashtable)))
1403   (` (symbol-value (intern-soft (, string) (, hashtable)))))
1404
1405 (defmacro gnus-sethash (string value hashtable)
1406   "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
1407   ;; We cannot use define-abbrev since it only accepts string as value.
1408                                         ;  (set (intern string hashtable) value))
1409   (` (set (intern (, string) (, hashtable)) (, value))))
1410
1411 (defsubst gnus-buffer-substring (beg end)
1412   (buffer-substring (match-beginning beg) (match-end end)))
1413
1414 (defsubst gnus-simplify-subject-re (subject)
1415   "Remove \"Re:\" from subject lines."
1416   (let ((case-fold-search t))
1417     (if (string-match "^re: *" subject)
1418         (substring subject (match-end 0))
1419       subject)))
1420
1421 (defsubst gnus-goto-char (point)
1422   (and point (goto-char point)))
1423
1424 \f
1425 ;;;
1426 ;;; Gnus Utility Functions
1427 ;;;
1428
1429 (defun gnus-extract-address-components (from)
1430   (let (name address)
1431     (if (string-match "([^)]+)" from)
1432         (setq name (substring from (1+ (match-beginning 0)) 
1433                               (1- (match-end 0)))))
1434     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1435     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
1436         (setq address (substring from (match-beginning 0) (match-end 0))))
1437     (if (and (not name) address)
1438         (if (string-match (concat "<" (regexp-quote address) ">") from)
1439             (setq name (substring from 0 (1- (match-beginning 0))))))
1440     (list (or name from) (or address from))))
1441
1442 (defun gnus-fetch-field (field)
1443   "Return the value of the header FIELD of current article."
1444   (save-excursion
1445     (save-restriction
1446       (gnus-narrow-to-headers)
1447       (mail-fetch-field field))))
1448
1449 (defun gnus-goto-colon ()
1450   (beginning-of-line)
1451   (search-forward ":" (save-excursion (end-of-line) (point)) t))
1452
1453 (defun gnus-narrow-to-headers ()
1454   (widen)
1455   (save-excursion
1456     (goto-char 1)
1457     (if (search-forward "\n\n")
1458         (narrow-to-region 1 (1- (point))))))
1459
1460 ;; Get a number that is suitable for hashing; bigger than MIN
1461 (defun gnus-create-hash-size (min)
1462   (let ((i 1))
1463     (while (< i min)
1464       (setq i (* 2 i)))
1465     (1- i)))
1466
1467 (defun gnus-update-format-specifications ()
1468   (setq gnus-summary-line-format-spec 
1469         (gnus-parse-format gnus-summary-line-format 
1470                            gnus-summary-line-format-alist))
1471   (setq gnus-summary-dummy-line-format-spec 
1472         (gnus-parse-format gnus-summary-dummy-line-format 
1473                            gnus-summary-dummy-line-format-alist))
1474   (setq gnus-group-line-format-spec
1475         (gnus-parse-format 
1476          gnus-group-line-format 
1477          gnus-group-line-format-alist))
1478   (if (and (string-match "%D" gnus-group-line-format)
1479            (not gnus-description-hashtb))
1480       (gnus-read-descriptions-file))
1481   (setq gnus-summary-mode-line-format-spec 
1482         (gnus-parse-format gnus-summary-mode-line-format 
1483                            gnus-summary-mode-line-format-alist))
1484   (setq gnus-article-mode-line-format-spec 
1485         (gnus-parse-format gnus-article-mode-line-format 
1486                            gnus-summary-mode-line-format-alist))
1487   (setq gnus-group-mode-line-format-spec 
1488         (gnus-parse-format gnus-group-mode-line-format 
1489                            gnus-group-mode-line-format-alist)))
1490
1491 (defun gnus-format-max-width (var length)
1492   (let (result)
1493     (if (> (length (setq result (eval var))) length)
1494         (format "%s" (substring result 0 length))
1495       (format "%s" result))))
1496
1497 (defun gnus-set-mouse-face (string)
1498   ;; Set mouse face property on STRING.
1499   (put-text-property 0 (length string) 'mouse-face gnus-mouse-face string)
1500   string)
1501
1502 (defun gnus-parse-format (format spec-alist)
1503   ;; This function parses the FORMAT string with the help of the
1504   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1505   ;; string.  If the FORMAT string contains the specifiers %( and %)
1506   ;; the text between them will have the mouse-face text property.
1507   (if (string-match "\\`\\(.*\\)%(\\(.*\\)%)\\(.*\n?\\)\\'" format)
1508       (if (and gnus-visual gnus-mouse-face)
1509           (let ((pre (substring format (match-beginning 1) (match-end 1)))
1510                 (button (substring format (match-beginning 2) (match-end 2)))
1511                 (post (substring format (match-beginning 3) (match-end 3))))
1512             (list 'concat
1513                   (gnus-parse-simple-format pre spec-alist)
1514                   (list 'gnus-set-mouse-face
1515                         (gnus-parse-simple-format button spec-alist))
1516                   (gnus-parse-simple-format post spec-alist)))
1517         (gnus-parse-simple-format
1518          (concat (substring format (match-beginning 1) (match-end 1))
1519                  (substring format (match-beginning 2) (match-end 2))
1520                  (substring format (match-beginning 3) (match-end 3)))
1521          spec-alist))
1522     (gnus-parse-simple-format format spec-alist)))
1523
1524 (defun gnus-parse-simple-format (format spec-alist)
1525   ;; This function parses the FORMAT string with the help of the
1526   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
1527   ;; string. The list will consist of the symbol `format', a format
1528   ;; specification string, and a list of forms depending on the
1529   ;; SPEC-ALIST.
1530   (let ((max-width 0)
1531         spec flist fstring b newspec max-width elem beg)
1532     (save-excursion
1533       (set-buffer (get-buffer-create "*gnus work*"))
1534       (buffer-disable-undo (current-buffer))
1535       (gnus-add-current-to-buffer-list)
1536       (erase-buffer)
1537       (insert format)
1538       (goto-char 1)
1539       (while (re-search-forward "%[-0-9]*\\(,[0-9]*\\)*\\(.\\)\\(.\\)?" nil t)
1540         (setq spec (string-to-char (buffer-substring (match-beginning 2)
1541                                                      (match-end 2))))
1542         ;; First check if there are any specs that look anything like
1543         ;; "%12,12A", ie. with a "max width specification". These have
1544         ;; to be treated specially.
1545         (if (setq beg (match-beginning 1))
1546             (setq max-width 
1547                   (string-to-int 
1548                    (buffer-substring (1+ (match-beginning 1)) (match-end 1))))
1549           (setq max-width 0)
1550           (setq beg (match-beginning 2)))
1551         ;; Find the specification from `spec-alist'.
1552         (if (not (setq elem (cdr (assq spec spec-alist))))
1553             (setq elem '("*" ?s)))
1554         ;; Treat user defined format specifiers specially
1555         (and (eq (car elem) 'user-defined)
1556              (setq elem
1557                    (list 
1558                     (list (intern (concat "gnus-user-format-function-"
1559                                           (buffer-substring
1560                                            (match-beginning 3)
1561                                            (match-end 3))))
1562                           'header)
1563                     ?s))
1564              (delete-region (match-beginning 3) (match-end 3)))
1565         (if (not (zerop max-width))
1566             (progn
1567               (setq flist (cons (list 'gnus-format-max-width 
1568                                       (car elem) max-width) flist))
1569               (setq newspec ?s))
1570           (setq flist (cons (car elem) flist))
1571           (setq newspec (car (cdr elem))))
1572         ;; Remove the old specification (and possibly a ",12" string).
1573         (delete-region beg (match-end 2))
1574         ;; Insert the new specification.
1575         (goto-char beg)
1576         (insert newspec))
1577       (setq fstring (buffer-substring 1 (point-max)))
1578       (kill-buffer (current-buffer)))
1579     (cons 'format (cons fstring (nreverse flist)))))
1580
1581 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
1582 (defun gnus-read-init-file ()
1583   (and gnus-init-file
1584        (or (file-exists-p gnus-init-file)
1585            (file-exists-p (concat gnus-init-file ".el"))
1586            (file-exists-p (concat gnus-init-file ".elc")))
1587        (load gnus-init-file nil t)))
1588
1589 ;; Article file names when saving.
1590
1591 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
1592   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1593 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
1594 Otherwise, it is like ~/News/news/group/num."
1595   (let ((default
1596           (expand-file-name
1597            (concat (if gnus-use-long-file-name
1598                        (gnus-capitalize-newsgroup newsgroup)
1599                      (gnus-newsgroup-directory-form newsgroup))
1600                    "/" (int-to-string (header-number headers)))
1601            (or gnus-article-save-directory "~/News"))))
1602     (if (and last-file
1603              (string-equal (file-name-directory default)
1604                            (file-name-directory last-file))
1605              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
1606         default
1607       (or last-file default))))
1608
1609 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
1610   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1611 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
1612 Otherwise, it is like ~/News/news/group/num."
1613   (let ((default
1614           (expand-file-name
1615            (concat (if gnus-use-long-file-name
1616                        newsgroup
1617                      (gnus-newsgroup-directory-form newsgroup))
1618                    "/" (int-to-string (header-number headers)))
1619            (or gnus-article-save-directory "~/News"))))
1620     (if (and last-file
1621              (string-equal (file-name-directory default)
1622                            (file-name-directory last-file))
1623              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
1624         default
1625       (or last-file default))))
1626
1627 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
1628   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1629 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
1630 Otherwise, it is like ~/News/news/group/news."
1631   (or last-file
1632       (expand-file-name
1633        (if gnus-use-long-file-name
1634            (gnus-capitalize-newsgroup newsgroup)
1635          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
1636        (or gnus-article-save-directory "~/News"))))
1637
1638 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
1639   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
1640 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
1641 Otherwise, it is like ~/News/news/group/news."
1642   (or last-file
1643       (expand-file-name
1644        (if gnus-use-long-file-name
1645            newsgroup
1646          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
1647        (or gnus-article-save-directory "~/News"))))
1648
1649 ;; For subscribing new newsgroup
1650
1651 (defun gnus-subscribe-hierarchical-interactive (groups)
1652   (let ((groups (sort groups 'string<))
1653         prefixes prefix start rest ans group starts)
1654     (while groups
1655       (setq prefixes (list "^"))
1656       (while (and groups prefixes)
1657         (while (not (string-match (car prefixes) (car groups)))
1658           (setq prefixes (cdr prefixes)))
1659         (setq prefix (car prefixes))
1660         (setq start (1- (length prefix)))
1661         (if (and (string-match "[^\\.]\\." (car groups) start)
1662                  (cdr groups)
1663                  (setq prefix 
1664                        (concat "^" (substring (car groups) 0 (match-end 0))))
1665                  (string-match prefix (car (cdr groups))))
1666             (progn
1667               (setq prefixes (cons prefix prefixes))
1668               (message "Descend hierarchy %s? ([y]nsq): " 
1669                        (substring prefix 1 (1- (length prefix))))
1670               (setq ans (read-char))
1671               (cond ((= ans ?n)
1672                      (while (and groups 
1673                                  (string-match prefix 
1674                                                (setq group (car groups))))
1675                        (setq gnus-killed-list 
1676                              (cons group gnus-killed-list))
1677                        (gnus-sethash group group gnus-killed-hashtb)
1678                        (setq groups (cdr groups)))
1679                      (setq starts (cdr starts)))
1680                     ((= ans ?s)
1681                      (while (and groups 
1682                                  (string-match prefix 
1683                                                (setq group (car groups))))
1684                        (gnus-sethash group group gnus-killed-hashtb)
1685                        (gnus-subscribe-alphabetically (car groups))
1686                        (setq groups (cdr groups)))
1687                      (setq starts (cdr starts)))
1688                     ((= ans ?q)
1689                      (while groups
1690                        (setq group (car groups))
1691                        (setq gnus-killed-list (cons group gnus-killed-list))
1692                        (gnus-sethash group group gnus-killed-hashtb)
1693                        (setq groups (cdr groups))))
1694                     (t nil)))
1695           (message "Subscribe %s? ([n]yq)" (car groups))
1696           (setq ans (read-char))
1697           (setq group (car groups))
1698           (cond ((= ans ?y)
1699                  (gnus-subscribe-alphabetically (car groups))
1700                  (gnus-sethash group group gnus-killed-hashtb))
1701                 ((= ans ?q)
1702                  (while groups
1703                    (setq group (car groups))
1704                    (setq gnus-killed-list (cons group gnus-killed-list))
1705                    (gnus-sethash group group gnus-killed-hashtb)
1706                    (setq groups (cdr groups))))
1707                 (t 
1708                  (setq gnus-killed-list (cons group gnus-killed-list))
1709                  (gnus-sethash group group gnus-killed-hashtb)))
1710           (setq groups (cdr groups)))))))
1711
1712 (defun gnus-subscribe-randomly (newsgroup)
1713   "Subscribe new NEWSGROUP by making it the first newsgroup."
1714   (gnus-subscribe-newsgroup newsgroup))
1715
1716 (defun gnus-subscribe-alphabetically (newgroup)
1717   "Subscribe new NEWSGROUP and insert it in alphabetical order."
1718   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
1719   (let ((groups (cdr gnus-newsrc-assoc))
1720         before)
1721     (while (and (not before) groups)
1722       (if (string< newgroup (car (car groups)))
1723           (setq before (car (car groups)))
1724         (setq groups (cdr groups))))
1725     (gnus-subscribe-newsgroup newgroup before)))
1726
1727 (defun gnus-subscribe-hierarchically (newgroup)
1728   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
1729   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
1730   (save-excursion
1731     (set-buffer (find-file-noselect gnus-current-startup-file))
1732     (let ((groupkey newgroup)
1733           before)
1734       (while (and (not before) groupkey)
1735         (goto-char (point-min))
1736         (let ((groupkey-re
1737                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
1738           (while (and (re-search-forward groupkey-re nil t)
1739                       (progn
1740                         (setq before (buffer-substring
1741                                       (match-beginning 1) (match-end 1)))
1742                         (string< before newgroup)))))
1743         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
1744         (setq groupkey
1745               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
1746                   (substring groupkey (match-beginning 1) (match-end 1)))))
1747       (gnus-subscribe-newsgroup newgroup before))))
1748
1749 (defun gnus-subscribe-interactively (newsgroup)
1750   "Subscribe new NEWSGROUP interactively.
1751 It is inserted in hierarchical newsgroup order if subscribed. If not,
1752 it is killed."
1753   (if (y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
1754       (gnus-subscribe-hierarchically newsgroup)
1755     (setq gnus-killed-list (cons newsgroup gnus-killed-list))))
1756
1757 (defun gnus-subscribe-zombies (newsgroup)
1758   "Make new NEWSGROUP a zombie group."
1759   (setq gnus-zombie-list (cons newsgroup gnus-zombie-list)))
1760
1761 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
1762   "Subscribe new NEWSGROUP.
1763 If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
1764 the first newsgroup."
1765   ;; We subscribe the group by changing its level to 3.
1766   (gnus-group-change-level 
1767    newsgroup 3 9 
1768    (if next (gnus-gethash next gnus-newsrc-hashtb)
1769      (gnus-gethash (car (nth 1 gnus-newsrc-assoc)) gnus-newsrc-hashtb)))
1770   (message "Subscribe newsgroup: %s" newsgroup))
1771
1772 ;; For directories
1773
1774 (defun gnus-newsgroup-directory-form (newsgroup)
1775   "Make hierarchical directory name from NEWSGROUP name."
1776   (let ((newsgroup (substring newsgroup 0)) ;Copy string.
1777         (len (length newsgroup))
1778         (idx 0))
1779     ;; Replace all occurrences of `.' with `/'.
1780     (while (< idx len)
1781       (if (= (aref newsgroup idx) ?.)
1782           (aset newsgroup idx ?/))
1783       (setq idx (1+ idx)))
1784     newsgroup
1785     ))
1786
1787 (defun gnus-make-directory (dir)
1788   "Make DIRECTORY recursively."
1789   (let* ((dir (expand-file-name dir default-directory))
1790          dirs)
1791     (if (string-match "/$" dir)
1792         (setq dir (substring dir 0 (match-beginning 0))))
1793     (while (not (file-exists-p dir))
1794       (setq dirs (cons dir dirs))
1795       (string-match "/[^/]+$" dir)
1796       (setq dir (substring dir 0 (match-beginning 0))))
1797     (while dirs
1798       (make-directory (car dirs))
1799       (setq dirs (cdr dirs)))))
1800
1801 (defun gnus-capitalize-newsgroup (newsgroup)
1802   "Capitalize NEWSGROUP name."
1803   (and (not (zerop (length newsgroup)))
1804        (concat (char-to-string (upcase (aref newsgroup 0)))
1805                (substring newsgroup 1))))
1806
1807 ;; Var
1808
1809 (defun gnus-simplify-subject (subject &optional re-only)
1810   "Remove `Re:' and words in parentheses.
1811 If optional argument RE-ONLY is non-nil, strip `Re:' only."
1812   (let ((case-fold-search t))           ;Ignore case.
1813     ;; Remove `Re:' and `Re^N:'.
1814     (if (string-match "^re:[ \t]*" subject)
1815         (setq subject (substring subject (match-end 0))))
1816     ;; Remove words in parentheses from end.
1817     (or re-only
1818         (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
1819           (setq subject (substring subject 0 (match-beginning 0)))))
1820     ;; Return subject string.
1821     subject
1822     ))
1823
1824 (defun gnus-add-current-to-buffer-list ()
1825   (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))
1826
1827 ;; Functions accessing headers.
1828 ;; Functions are more convenient than macros in some case.
1829
1830 (defun gnus-header-number (header)
1831   "Return article number in HEADER."
1832   (header-number header))
1833
1834 (defun gnus-header-subject (header)
1835   "Return subject string in HEADER."
1836   (header-subject header))
1837
1838 (defun gnus-header-from (header)
1839   "Return author string in HEADER."
1840   (header-from header))
1841
1842 (defun gnus-header-xref (header)
1843   "Return xref string in HEADER."
1844   (header-xref header))
1845
1846 (defun gnus-header-lines (header)
1847   "Return lines in HEADER."
1848   (header-lines header))
1849
1850 (defun gnus-header-date (header)
1851   "Return date in HEADER."
1852   (header-date header))
1853
1854 (defun gnus-header-id (header)
1855   "Return Id in HEADER."
1856   (header-id header))
1857
1858 (defun gnus-header-references (header)
1859   "Return references in HEADER."
1860   (header-references header))
1861
1862 (defun gnus-clear-system ()
1863   "Clear all variables and buffers."
1864   ;; Clear Gnus variables.
1865   (let ((variables gnus-variable-list))
1866     (while variables
1867       (set (car variables) nil)
1868       (setq variables (cdr variables))))
1869   ;; Clear other internal variables.
1870   (setq gnus-list-of-killed-groups nil
1871         gnus-have-read-active-file nil
1872         gnus-newsrc-assoc nil
1873         gnus-newsrc-hashtb nil
1874         gnus-killed-list nil
1875         gnus-zombie-list nil
1876         gnus-killed-hashtb nil
1877         gnus-active-hashtb nil
1878         gnus-moderated-list nil
1879         gnus-description-hashtb nil
1880         gnus-newsgroup-headers nil
1881         gnus-newsgroup-headers-hashtb-by-number nil
1882         gnus-current-select-method nil)
1883   ;; Kill the startup file.
1884   (and gnus-current-startup-file
1885        (get-file-buffer gnus-current-startup-file)
1886        (kill-buffer (get-file-buffer gnus-current-startup-file)))
1887   (setq gnus-current-startup-file nil)
1888   (gnus-dribble-clear)
1889   ;; Kill global KILL file buffer.
1890   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
1891       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
1892   ;; Kill Gnus buffers.
1893   (while gnus-buffer-list
1894     (if (and (get-buffer (car gnus-buffer-list))
1895              (buffer-name (get-buffer (car gnus-buffer-list))))
1896         (kill-buffer (car gnus-buffer-list)))
1897     (setq gnus-buffer-list (cdr gnus-buffer-list))))
1898
1899 (defun gnus-configure-windows (action &optional force)
1900   "Configure Gnus windows according to the next ACTION.
1901 The ACTION is either a symbol, such as `summary', or a
1902 configuration list such as `(1 1 2)'.  If ACTION is not a list,
1903 configuration list is got from the variable gnus-window-configuration.
1904 If FORCE is non-nil, the updating will be done whether it is necessary
1905 or not."
1906   (let* ((windows
1907           (if (listp action) action 
1908             (if (listp gnus-window-configuration)
1909                 (car (cdr (assq action gnus-window-configuration)))
1910               gnus-window-configuration)))
1911          (grpwin (get-buffer-window gnus-group-buffer))
1912          (subwin (get-buffer-window gnus-summary-buffer))
1913          (artwin (get-buffer-window gnus-article-buffer))
1914          (winsum nil)
1915          (height nil)
1916          (grpheight 0)
1917          (subheight 0)
1918          (artheight 0)
1919
1920          ;; Make split-window-vertically leave focus in upper window.
1921          (split-window-keep-point t))
1922     (if (and (symbolp windows) (fboundp windows))
1923         (funcall windows action)
1924       (if (and (not force)
1925                (or (null windows)               ;No configuration is specified.
1926                    (and (eq (null grpwin)
1927                             (zerop (nth 0 windows)))
1928                         (eq (null subwin)
1929                             (zerop (nth 1 windows)))
1930                         (eq (null artwin)
1931                             (zerop (nth 2 windows))))))
1932           ;; No need to change window configuration.
1933           nil
1934         (select-window (or grpwin subwin artwin (selected-window)))
1935         ;; First of all, compute the height of each window.
1936         (cond (gnus-use-full-window
1937                ;; Take up the entire screen.
1938                (delete-other-windows)
1939                (setq height (window-height (selected-window))))
1940               (t
1941                (setq height (+ (if grpwin (window-height grpwin) 0)
1942                                (if subwin (window-height subwin) 0)
1943                                (if artwin (window-height artwin) 0)))))
1944         ;; The group buffer exits always. So, use it to extend the
1945         ;; group window so as to get enough window space.
1946         (switch-to-buffer gnus-group-buffer 'norecord)
1947         (and (get-buffer gnus-summary-buffer)
1948              (delete-windows-on gnus-summary-buffer))
1949         (and (get-buffer gnus-article-buffer)
1950              (delete-windows-on gnus-article-buffer))
1951         ;; Compute expected window height.
1952         (setq winsum (apply (function +) windows))
1953         (if (not (zerop (nth 0 windows)))
1954             (setq grpheight (max window-min-height
1955                                  (/ (* height (nth 0 windows)) winsum))))
1956         (if (not (zerop (nth 1 windows)))
1957             (setq subheight (max window-min-height
1958                                  (/ (* height (nth 1 windows)) winsum))))
1959         (if (not (zerop (nth 2 windows)))
1960             (setq artheight (max window-min-height
1961                                  (/ (* height (nth 2 windows)) winsum))))
1962         (setq height (+ grpheight subheight artheight))
1963         (enlarge-window (max 0 (- height (window-height (selected-window)))))
1964         ;; Then split the window.
1965         (and (not (zerop artheight))
1966              (or (not (zerop grpheight))
1967                  (not (zerop subheight)))
1968              (split-window-vertically (+ grpheight subheight)))
1969         (and (not (zerop grpheight))
1970              (not (zerop subheight))
1971              (split-window-vertically grpheight))
1972         ;; Then select buffers in each window.
1973         (or (zerop grpheight)
1974             (progn
1975               (switch-to-buffer gnus-group-buffer 'norecord)
1976               (other-window 1)))
1977         (or (zerop subheight)
1978             (progn
1979               (switch-to-buffer gnus-summary-buffer 'norecord)
1980               (other-window 1)))
1981         (or (zerop artheight)
1982             (progn
1983               ;; If article buffer does not exist, it will be created
1984               ;; and initialized.
1985               (gnus-article-setup-buffer)
1986               (switch-to-buffer gnus-article-buffer 'norecord)
1987               (bury-buffer gnus-summary-buffer)
1988               (bury-buffer gnus-group-buffer)))
1989         (or (zerop subheight)
1990             (pop-to-buffer gnus-summary-buffer))
1991         ))))
1992
1993 (defun gnus-window-configuration-split (action)
1994   (switch-to-buffer gnus-group-buffer t)
1995   (delete-other-windows)
1996   (split-window-horizontally)
1997   (cond ((or (eq action 'newsgroups) (eq action 'summary))
1998          (if (and (get-buffer gnus-summary-buffer)
1999                   (buffer-name gnus-summary-buffer))
2000              (switch-to-buffer-other-window gnus-summary-buffer)))
2001         ((eq action 'article)
2002          (switch-to-buffer gnus-summary-buffer t)
2003          (other-window 1)
2004          (gnus-article-setup-buffer)
2005          (switch-to-buffer gnus-article-buffer t))))
2006
2007 (defun gnus-version ()
2008   "Version numbers of this version of Gnus."
2009   (interactive)
2010   (let ((methods gnus-valid-select-methods)
2011         (mess gnus-version)
2012         meth)
2013     ;; Go through all the legal select methods and add their version
2014     ;; numbers to the total version string. Only the backends that are
2015     ;; currently in use will have their message numbers taken into
2016     ;; consideration. 
2017     (while methods
2018       (setq meth (intern (concat (car (car methods)) "-version")))
2019       (and (boundp meth)
2020            (stringp (symbol-value meth))
2021            (setq mess (concat mess "; " (symbol-value meth))))
2022       (setq methods (cdr methods)))
2023     (message mess)))
2024
2025 (defun gnus-info-find-node ()
2026   "Find Info documentation of Gnus."
2027   (interactive)
2028   ;; Enlarge info window if needed.
2029   (cond ((eq major-mode 'gnus-group-mode)
2030          (gnus-configure-windows '(1 0 0)) ;Take all windows.
2031          (pop-to-buffer gnus-group-buffer))
2032         ((eq major-mode 'gnus-summary-mode)
2033          (gnus-configure-windows '(0 1 0)) ;Take all windows.
2034          (pop-to-buffer gnus-summary-buffer)))
2035   (Info-goto-node (car (cdr (assq major-mode gnus-info-nodes)))))
2036
2037 (defun gnus-bug ()
2038   "Send a bug report to the Gnus maintainers."
2039   (interactive)
2040   (pop-to-buffer "*Gnus Bug*")
2041   (erase-buffer)
2042   (mail-setup gnus-maintainer "[Gnus Bug Report] " nil nil nil nil)
2043   (goto-char (point-min))
2044   (search-forward mail-header-separator)
2045   (forward-line 1)
2046   (insert (format "%s\n%s\n\n" (gnus-version) (emacs-version)))
2047   (gnus-debug)
2048   (mail-mode)
2049   (message ""))
2050
2051 (defun gnus-debug ()
2052   "Attemps to go through the Gnus source file and report what variables have been changed.
2053 The source file has to be in the Emacs load path."
2054   (interactive)
2055   (let ((dirs load-path)
2056         file expr olist)
2057     (while dirs
2058       (if (file-exists-p (setq file (concat (car dirs) "/gnus.el")))
2059           (save-excursion
2060             (setq dirs nil)
2061             (set-buffer (get-buffer-create "*gnus bug info*"))
2062             (buffer-disable-undo)
2063             (erase-buffer)
2064             (insert-file-contents file)
2065             (goto-char (point-min))
2066             (or (search-forward "\n;; Internal variables" nil t)
2067                 (error "Malformed sources"))
2068             (narrow-to-region (point-min) (point))
2069             (goto-char (point-min))
2070             (while (setq expr (condition-case () 
2071                                   (read (current-buffer)) (error nil)))
2072               (and (eq (car expr) 'defvar)
2073                    (stringp (nth 3 expr))
2074                    (not (equal (eval (nth 2 expr))
2075                                (symbol-value (nth 1 expr))))
2076                    (setq olist (cons (nth 1 expr) olist))))
2077             (kill-buffer (current-buffer)))
2078         (setq dirs (cdr dirs))))
2079     (while olist
2080       (insert (symbol-name (car olist)) ": " 
2081               (prin1-to-string (symbol-value (car olist))) "\n")
2082       (setq olist (cdr olist)))
2083     (insert "\n\n")))
2084
2085 (defun gnus-overload-functions (&optional overloads)
2086   "Overload functions specified by optional argument OVERLOADS.
2087 If nothing is specified, use the variable gnus-overload-functions."
2088   (let ((defs nil)
2089         (overloads (or overloads gnus-overload-functions)))
2090     (while overloads
2091       (setq defs (car overloads))
2092       (setq overloads (cdr overloads))
2093       ;; Load file before overloading function if necessary.  Make
2094       ;; sure we cannot use `require' always.
2095       (and (not (fboundp (car defs)))
2096            (car (cdr (cdr defs)))
2097            (load (car (cdr (cdr defs))) nil 'nomessage))
2098       (fset (car defs) (car (cdr defs)))
2099       )))
2100
2101 (defun gnus-replace-chars-in-string (string from to)
2102   "Replace characters in STRING from FROM to TO."
2103   (let ((string (substring string 0))   ;Copy string.
2104         (len (length string))
2105         (idx 0))
2106     ;; Replace all occurrences of FROM with TO.
2107     (while (< idx len)
2108       (if (= (aref string idx) from)
2109           (aset string idx to))
2110       (setq idx (1+ idx)))
2111     string))
2112
2113 (defun gnus-days-between (date1 date2)
2114   ;; Return the number of days between date1 and date2.
2115   (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) )
2116                     (timezone-parse-date date1)))
2117         (d2 (mapcar (lambda (s) (and s (string-to-int s)) )
2118                     (timezone-parse-date date2))))
2119     (- (timezone-absolute-from-gregorian 
2120         (nth 1 d1) (nth 2 d1) (car d1))
2121        (timezone-absolute-from-gregorian 
2122         (nth 1 d2) (nth 2 d2) (car d2)))))
2123
2124 (defun gnus-file-newer-than (file date)
2125   (let ((fdate (nth 5 (file-attributes file))))
2126     (or (> (car fdate) (car date))
2127         (and (= (car fdate) (car date))
2128              (> (nth 1 fdate) (nth 1 date))))))
2129
2130 ;; List and range functions
2131
2132 (defun gnus-last-element (list)
2133   "Return last element of LIST."
2134   (while (cdr list)
2135     (setq list (cdr list)))
2136   (car list))
2137
2138 (defun gnus-set-difference (list1 list2)
2139   "Return a list of elements of LIST1 that do not appear in LIST2."
2140   (let ((list1 (copy-sequence list1)))
2141     (while list2
2142       (setq list1 (delq (car list2) list1))
2143       (setq list2 (cdr list2)))
2144     list1
2145     ))
2146
2147 (defun gnus-intersection (list1 list2)      
2148   (let ((result nil))
2149     (while list2
2150       (if (memq (car list2) list1)
2151           (setq result (cons (car list2) result)))
2152       (setq list2 (cdr list2)))
2153     result
2154     ))
2155
2156 (defun gnus-compress-sequence (numbers &optional always-list)
2157   "Convert list of numbers to a list of ranges or a single range.
2158 If ALWAYS-LIST is non-nil, this function will always release a list of
2159 ranges."
2160   (let* ((first (car numbers))
2161          (last (car numbers))
2162          result)
2163     (if (null numbers)
2164         nil
2165       (while numbers
2166         (cond ((= last (car numbers)) nil) ;Omit duplicated number
2167               ((= (1+ last) (car numbers)) ;Still in sequence
2168                (setq last (car numbers)))
2169               (t                                ;End of one sequence
2170                (setq result (cons (cons first last) result))
2171                (setq first (car numbers))
2172                (setq last  (car numbers))))
2173         (setq numbers (cdr numbers)))
2174       (if (and (not always-list) (null result))
2175           (cons first last)
2176         (nreverse (cons (cons first last) result))))))
2177
2178 (defun gnus-uncompress-sequence (ranges)
2179   "Expand a list of ranges into a list of numbers.
2180 RANGES is either a single range on the form `(num . num)' or a list of
2181 these ranges."
2182   (let (first last result)
2183     (if (null ranges)
2184         nil
2185       (if (atom (car ranges))
2186           (progn
2187             (setq first (car ranges))
2188             (setq last (cdr ranges))
2189             (while (<= first last)
2190               (setq result (cons first result))
2191               (setq first (1+ first))))
2192         (while ranges
2193           (setq first (car (car ranges)))
2194           (setq last  (cdr (car ranges)))
2195           (while (<= first last)
2196             (setq result (cons first result))
2197             (setq first (1+ first)))
2198           (setq ranges (cdr ranges))))
2199       (nreverse result))))
2200
2201 (defun gnus-add-to-range (ranges list)
2202   "Return a list of ranges that has all articles from both RANGES and LIST.
2203 Note: LIST has to be sorted over `<'."
2204   (let* ((ranges (if (and ranges (atom (car ranges))) (list ranges) ranges))
2205          (inrange ranges)
2206          did-one
2207          range nranges first last)
2208     (if (not list)
2209         ranges
2210       (if (not ranges)
2211           (gnus-compress-sequence list t)
2212         (and ranges 
2213              (> (car (car ranges)) 1)
2214              (progn
2215                (setq did-one t)
2216                (setq inrange (setq ranges (cons (cons 1 1) ranges)))))
2217         (while (and ranges list)
2218           (setq range (car ranges))
2219           (while (and list (>= (car list) (car range))
2220                       (<= (car list) (cdr range)))
2221             (setq list (cdr list)))
2222           (while (and list (= (1- (car list)) (cdr range)))
2223             (setcdr range (car list))
2224             (setq list (cdr list)))
2225           (if (and list (and (> (car list) (cdr range)) 
2226                              (cdr ranges)
2227                              (< (car list) (car (car (cdr ranges))))))
2228               (setcdr ranges (cons (cons (car list) (car list)) (cdr ranges))))
2229           (setq ranges (cdr ranges)))
2230         (if (and list (not ranges))
2231             (setq inrange (nconc inrange (gnus-compress-sequence list t))))
2232         (if did-one
2233             (if (eq (cdr (car inrange)) 1)
2234                 (setq inrange (cdr inrange))
2235               (setcar (car inrange) 2)))
2236         (setq ranges inrange)
2237         (while ranges
2238           (if (and (cdr ranges) (>= (1+ (cdr (car ranges)))
2239                                     (car (car (cdr ranges)))))
2240               (progn
2241                 (setcdr (car ranges) (cdr (car (cdr ranges))))
2242                 (setcdr ranges (cdr (cdr ranges))))
2243             (setq ranges (cdr ranges))))
2244         (if (not (cdr inrange))
2245             (car inrange)
2246           inrange)))))
2247
2248 (defun gnus-remove-from-range (ranges list)
2249   "Return a list of ranges that has all articles from LIST removed from RANGES.
2250 Note: LIST has to be sorted over `<'."
2251   ;; !!! This function shouldn't look like this, but I've got a headache.
2252   (gnus-compress-sequence 
2253    (gnus-set-difference 
2254     (gnus-uncompress-sequence ranges) list)))
2255
2256 (defun gnus-member-of-range (number ranges)
2257   (let ((not-stop t))
2258     (while (and ranges not-stop)
2259       (if (and (>= number (car (car ranges)))
2260                (<= number (cdr (car ranges))))
2261           (setq not-stop nil))
2262       (setq ranges (cdr ranges)))
2263     (not not-stop)))
2264
2265 \f
2266 ;;;
2267 ;;; Gnus group mode
2268 ;;;
2269
2270 (if gnus-group-mode-map
2271     nil
2272   (setq gnus-group-mode-map (make-keymap))
2273   (suppress-keymap gnus-group-mode-map)
2274   (define-key gnus-group-mode-map " " 'gnus-group-read-group)
2275   (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
2276   (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
2277   (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
2278   (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
2279   (define-key gnus-group-mode-map [del] 'gnus-group-prev-unread-group)
2280   (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
2281   (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
2282   (define-key gnus-group-mode-map "\M-n" 'gnus-group-next-unread-group-same-level)
2283   (define-key gnus-group-mode-map "\M-p" 'gnus-group-prev-unread-group-same-level)
2284   (define-key gnus-group-mode-map "\r" 'gnus-group-select-group)
2285   (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
2286   (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
2287   (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current)
2288   (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all)
2289   (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
2290   (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
2291   (define-key gnus-group-mode-map "m" 'gnus-group-mail)
2292   (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
2293   (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group)
2294   (define-key gnus-group-mode-map "R" 'gnus-group-restart)
2295   (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file)
2296   (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server)
2297   (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
2298   (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups)
2299   (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group)
2300   (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups)
2301   (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos)
2302   (define-key gnus-group-mode-map "\C-c\M-C-a" 'gnus-group-description-apropos)
2303   (define-key gnus-group-mode-map "d" 'gnus-group-make-directory-group)
2304   (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
2305   (define-key gnus-group-mode-map "\M-a" 'gnus-group-add-group)
2306   (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group)
2307   (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
2308   (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
2309   (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
2310   (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
2311   (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
2312   (define-key gnus-group-mode-map "\M-z" 'gnus-group-kill-all-zombies)
2313   (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
2314   (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed)
2315   (define-key gnus-group-mode-map "\C-c\C-k" 'gnus-group-list-killed)
2316   (define-key gnus-group-mode-map "\C-c\C-z" 'gnus-group-list-zombies)
2317   (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles)
2318   (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups)
2319   (define-key gnus-group-mode-map "V" 'gnus-version)
2320   (define-key gnus-group-mode-map "S" 'gnus-group-set-current-level)
2321   (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc)
2322   (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
2323   (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble)
2324   (define-key gnus-group-mode-map "q" 'gnus-group-exit)
2325   (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
2326   (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
2327   (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
2328   (define-key gnus-group-mode-map [mouse-2] 'gnus-mouse-pick-group)
2329   (if gnus-visual (gnus-group-make-menu-bar)))
2330
2331 (defun gnus-group-mode ()
2332   "Major mode for reading news.
2333 All normal editing commands are switched off.
2334 The following commands are available:
2335
2336 \\<gnus-group-mode-map>
2337 \\[gnus-group-read-group]\t Choose the current group
2338 \\[gnus-group-select-group]\t Select the current group without selecting the first article
2339 \\[gnus-group-jump-to-group]\t Go to some group
2340 \\[gnus-group-next-unread-group]\t Go to the next unread group
2341 \\[gnus-group-prev-unread-group]\t Go to the previous unread group
2342 \\[gnus-group-next-group]\t Go to the next group
2343 \\[gnus-group-prev-group]\t Go to the previous group
2344 \\[gnus-group-next-unread-group-same-level]\t Go to the next unread group on the same level
2345 \\[gnus-group-prev-unread-group-same-level]\t Go to the previous unread group un the same level
2346 \\[gnus-group-unsubscribe-current-group]\t (Un)subscribe to the current group
2347 \\[gnus-group-unsubscribe-group]\t (Un)subscribe to some group
2348 \\[gnus-group-catchup-current]\t Mark all unread articles in the current group as read
2349 \\[gnus-group-catchup-current-all]\t Mark all alrticles in the current group as read
2350 \\[gnus-group-list-groups]\t List groups that have unread articles
2351 \\[gnus-group-list-all-groups]\t List all groups
2352 \\[gnus-group-mail]\t Compose a mail
2353 \\[gnus-group-get-new-news]\t Look for new news
2354 \\[gnus-group-get-new-news-this-group]\t Look for new news for the current group
2355 \\[gnus-group-restart]\t Restart Gnus
2356 \\[gnus-group-save-newsrc]\t Save the startup file(s)
2357 \\[gnus-group-browse-foreign-server]\t Browse a foreign (NNTP) server
2358 \\[gnus-group-check-bogus-groups]\t Check for and remove bogus newsgroups
2359 \\[gnus-find-new-newsgroups]\t Find new newsgroups
2360 \\[gnus-group-describe-group]\t Describe the current newsgroup
2361 \\[gnus-group-describe-all-groups]\t Describe all newsgroups
2362 \\[gnus-group-post-news]\t Post an article to some newsgroup
2363 \\[gnus-group-add-group]\t Add a newsgroup entry
2364 \\[gnus-group-edit-group]\t Edit a newsgroup entry
2365 \\[gnus-group-make-directory-group]\t Read a directory as a newsgroups
2366 \\[gnus-group-edit-local-kill]\t Edit a local kill file
2367 \\[gnus-group-edit-global-kill]\t Edit the global kill file
2368 \\[gnus-group-kill-group]\t Kill the current newsgroup
2369 \\[gnus-group-yank-group]\t Yank a previously killed newsgroup
2370 \\[gnus-group-kill-region]\t Kill all newsgroups between point and mark
2371 \\[gnus-group-kill-all-zombies]\t Kill all zombie newsgroups
2372 \\[gnus-group-transpose-groups]\t Transpose two newsgroups
2373 \\[gnus-group-list-killed]\t List all killed newsgroups
2374 \\[gnus-group-list-zombies]\t List all zombie newsgroups
2375 \\[gnus-group-expire-articles]\t Expire the expirable articles in the current newsgroup
2376 \\[gnus-group-expire-all-groups]\t Expire expirable articles in all newsgroups
2377 \\[gnus-version]\t Display the current Gnus version
2378 \\[gnus-group-set-current-level]\t Set the level of the current newsgroup
2379 \\[gnus-group-suspend]\t Suspend Gnus
2380 \\[gnus-group-clear-dribble]\t Clear the dribble buffer
2381 \\[gnus-group-exit]\t Stop reading news
2382 \\[gnus-group-quit]\t Stop reading news without saving the startup files
2383 \\[gnus-group-describe-briefly]\t Give a brief description of the current mode
2384 \\[gnus-info-find-node]\t Find the info pages for Gnus
2385 "
2386   (interactive)
2387   (kill-all-local-variables)
2388   (setq mode-line-modified "-- ")
2389   (make-local-variable 'mode-line-format)
2390   (setq mode-line-format (copy-sequence mode-line-format))
2391   (and (equal (nth 3 mode-line-format) "   ")
2392        (setcar (nthcdr 3 mode-line-format) ""))
2393   (setq major-mode 'gnus-group-mode)
2394   (setq mode-name "Group")
2395   (gnus-group-set-mode-line)
2396   (setq mode-line-process nil)
2397   (use-local-map gnus-group-mode-map)
2398   (buffer-disable-undo (current-buffer))
2399   (setq truncate-lines t)
2400   (setq buffer-read-only t)
2401   (run-hooks 'gnus-group-mode-hook))
2402
2403 (defun gnus-mouse-pick-group (e)
2404   (interactive "e")
2405   (mouse-set-point e)
2406   (gnus-group-read-group nil))
2407
2408 ;;;###autoload
2409 (defun gnus-no-server (&optional arg)
2410   "Read network news.
2411 If ARG is a positive number, Gnus will use that as the
2412 startup level. If ARG is nil, Gnus will be started at level 2. 
2413 If ARG is non-nil and not a positive number, Gnus will
2414 prompt the user for the name of an NNTP server to use.
2415 As opposed to `gnus', this command will not connect to the local server."
2416   (interactive "P")
2417   (gnus (or arg 2) t))
2418
2419 (defalias '\(ding\) 'gnus)
2420
2421 ;;;###autoload
2422 (defun gnus (&optional arg dont-connect)
2423   "Read network news.
2424 If ARG is non-nil and a positive number, Gnus will use that as the
2425 startup level. If ARG is non-nil and not a positive number, Gnus will
2426 prompt the user for the name of an NNTP server to use."
2427   (interactive "P")
2428   (if (get-buffer gnus-group-buffer)
2429       (progn
2430         (switch-to-buffer gnus-group-buffer)
2431         (gnus-group-get-new-news))
2432     (gnus-clear-system)
2433     (gnus-read-init-file)
2434     (let ((level (and arg (numberp arg) (> arg 0) arg)))
2435       (unwind-protect
2436           (progn
2437             (switch-to-buffer (get-buffer-create gnus-group-buffer))
2438             (gnus-add-current-to-buffer-list)
2439             (gnus-group-mode)
2440             (or dont-connect (gnus-start-news-server (and arg (not level)))))
2441         (if (and (not dont-connect) 
2442                  (not (gnus-server-opened gnus-select-method)))
2443             (gnus-group-quit)
2444           ;; NNTP server is successfully open. 
2445           (gnus-update-format-specifications)
2446           (let ((buffer-read-only nil))
2447             (erase-buffer)
2448             (if (not gnus-inhibit-startup-message)
2449                 (progn
2450                   (gnus-group-startup-message)
2451                   (sit-for 0))))
2452           (run-hooks 'gnus-startup-hook)
2453           (gnus-setup-news nil level)
2454           (gnus-dribble-open)
2455           (or (not gnus-novice-user)
2456               gnus-expert-user
2457               (gnus-group-describe-briefly)) ;Show brief help message.
2458           (gnus-group-list-groups (or level 5)))))))
2459
2460 (defun gnus-group-startup-message (&optional x y)
2461   "Insert startup message in current buffer."
2462   ;; Insert the message.
2463   (erase-buffer)
2464   (insert
2465    (format "
2466 %s
2467        A newsreader 
2468   for GNU Emacs
2469
2470     Based on GNUS 
2471          written by 
2472  Masanobu UMEDA
2473
2474 Lars Ingebrigtsen 
2475   larsi@ifi.uio.no
2476
2477            gnus-version))
2478   ;; And then hack it.
2479   ;; 18 is the longest line.
2480   (indent-rigidly (point-min) (point-max) 
2481                   (/ (max (- (window-width) (or x 22)) 0) 2))
2482   (goto-char (point-min))
2483   ;; +4 is fuzzy factor.
2484   (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)))
2485
2486 (defun gnus-group-list-groups (level &optional unread)
2487   "List newsgroups with level LEVEL or lower that have unread alticles.
2488 Default is 5, which lists all subscribed groups.
2489 If argument UNREAD is non-nil, groups with no unread articles are also listed."
2490   (interactive "P")
2491   (setq level (or level 5))
2492   (let ((case-fold-search nil)
2493         (group (gnus-group-group-name)))
2494     (set-buffer gnus-group-buffer)      ;May call from out of group buffer
2495     (gnus-group-prepare level unread)
2496     (if (zerop (buffer-size))
2497         ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
2498         (message "No news is horrible news")
2499       (goto-char (point-min))
2500       (if (not group)
2501           ;; Go to the first group with unread articles.
2502           (gnus-group-search-forward nil nil nil t)
2503         ;; Find the right group to put point on. If the current group
2504         ;; has disapeared in the new listing, try to find the next
2505         ;; one. If no next one can be found, just leave point at the
2506         ;; first newsgroup in the buffer.
2507         (if (not (gnus-goto-char
2508                   (text-property-any (point-min) (point-max) 
2509                                      'gnus-group (intern group))))
2510             (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
2511               (while (and newsrc
2512                           (not (gnus-goto-char 
2513                                 (text-property-any 
2514                                  (point-min) (point-max) 'gnus-group 
2515                                  (intern group)))))
2516                 (setq newsrc (cdr newsrc))))))
2517       ;; Adjust cursor point.
2518       (gnus-group-position-cursor))))
2519
2520 (defun gnus-group-prepare (level &optional all lowest) 
2521   "List all newsgroups with unread articles of level LEVEL or lower.
2522 If ALL is non-nil, list groups that have no unread articles.
2523 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
2524   (set-buffer (get-buffer-create gnus-group-buffer))
2525   (gnus-add-current-to-buffer-list)
2526   (let ((buffer-read-only nil)
2527         (newsrc (cdr gnus-newsrc-assoc))
2528         (zombie gnus-zombie-list)
2529         (killed gnus-killed-list)
2530         info clevel unread active group)
2531     (if (not lowest)
2532         (setq lowest 1))
2533     (erase-buffer)
2534     (if (< lowest 8)
2535         ;; List alive newsgroups.
2536         (while newsrc
2537           (setq info (car newsrc)
2538                 group (car info)
2539                 newsrc (cdr newsrc)
2540                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
2541           (if (and unread ; This group might be bogus
2542                    (or all (eq unread t) 
2543                        (and (> unread 0)
2544                             (> unread 
2545                                (length (cdr (assq 'dormant (nth 3 info)))))))
2546                    (and (<= (setq clevel (car (cdr info))) level))
2547                    (>= clevel lowest))
2548               (gnus-group-insert-group-line 
2549                nil group (car (cdr info)) (nth 3 info) unread
2550                (nth 4 info)))))
2551
2552     ;; List zombies and killed lists somehwat faster, which was
2553     ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
2554     ;; this by ignoring the group format specification altogether.
2555     (let ((lists (list 'gnus-zombie-list 'gnus-killed-list))
2556           mark beg lev)
2557       (while lists
2558         (if (or (and (eq (car lists) 'gnus-zombie-list)
2559                      (progn (setq mark ?Z)
2560                             (setq lev 8)
2561                             (and (>= level 8) (<= lowest 8))))
2562                 (and (eq (car lists) 'gnus-killed-list)
2563                      (progn (setq mark ?K)
2564                             (setq lev 9)
2565                             (and (>= level 9) (<= lowest 9)))))
2566             (progn
2567               (setq newsrc (set (car lists)
2568                                 (sort (symbol-value (car lists)) 
2569                                       (function string<))))
2570               (while newsrc
2571                 (setq group (car newsrc)
2572                       newsrc (cdr newsrc))
2573                 (setq beg (point))
2574                 (insert (format " %c    *: %s\n" mark group))
2575                 (add-text-properties 
2576                  beg (1+ beg) 
2577                  (list 'gnus-group (intern group)
2578                        'gnus-unread t
2579                        'gnus-level lev)))))
2580         (setq lists (cdr lists))))
2581
2582     (gnus-group-set-mode-line)
2583     (setq gnus-have-all-newsgroups all)
2584     (run-hooks 'gnus-group-prepare-hook)))
2585
2586 (defun gnus-group-real-name (group)
2587   "Find the real name of a foreign newsgroup."
2588   (if (string-match "^[^:]+:" group)
2589       (substring group (match-end 0))
2590     group))
2591
2592 (defun gnus-group-prefixed-name (group method)
2593   "Return the whole name from GROUP and METHOD."
2594   (concat (format "%s" (car method))
2595           (if (assoc (format "%s" (car method)) (gnus-methods-using 'address))
2596               (concat "+" (nth 1 method)))
2597           ":" group))
2598
2599 (defun gnus-group-real-prefix (group)
2600   "Return the prefix of the current group name."
2601   (if (string-match "^[^:]+:" group)
2602       (substring group 0 (match-end 0))
2603     ""))
2604
2605 (defun gnus-group-method-name (group)
2606   "Return the method used for selecting GROUP."
2607   (let ((prefix (gnus-group-real-prefix group)))
2608     (if (equal prefix "")
2609         gnus-select-method
2610       (if (string-match "^[^\\+]+\\+" prefix)
2611           (list (intern (substring prefix 0 (1- (match-end 0))))
2612                 (substring prefix (match-end 0) (1- (length prefix))))
2613         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
2614
2615 (defun gnus-group-foreign-p (group)
2616   "Return nil if GROUP is native, non-nil if it is foreign."
2617   (string-match ":" group))
2618
2619 (defun gnus-group-set-info (info)
2620   (let ((entry (gnus-gethash (car info) gnus-newsrc-hashtb)))
2621     (if entry
2622         (progn
2623           (setcar (nthcdr 2 entry) info)
2624           (if (and (not (eq (car entry) t)) 
2625                    (gnus-gethash (car info) gnus-active-hashtb))
2626               (setcar entry (length (gnus-list-of-unread-articles 
2627                                      (car info))))))
2628       (error "No such group: %s" (car info)))))
2629
2630 (defun gnus-group-update-group-line ()
2631   "This function updates the current line in the newsgroup buffer and
2632 moves the point to the colon."
2633   (let* ((buffer-read-only nil)
2634          (group (gnus-group-group-name))
2635          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
2636     (if entry
2637         (gnus-dribble-enter 
2638          (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
2639                  ")")))
2640     (beginning-of-line)
2641     (delete-region (point) (save-excursion (forward-line 1) (point)))
2642     (gnus-group-insert-group-line-info group)
2643     (forward-line -1)
2644     (gnus-group-position-cursor)))
2645
2646 (defun gnus-group-insert-group-line-info (group)
2647   (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) 
2648         active info)
2649     (if entry
2650         (progn
2651           (setq info (nth 2 entry))
2652           (gnus-group-insert-group-line 
2653            nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
2654       (setq active (gnus-gethash group gnus-active-hashtb))
2655       (gnus-group-insert-group-line 
2656        nil group (if (member group gnus-zombie-list) 8 9)
2657        nil (- (1+ (cdr active)) (car active)) nil))))
2658
2659 (defun gnus-group-insert-group-line (gformat group level marked number method)
2660   (let* ((gformat (or gformat gnus-group-line-format-spec))
2661          (active (gnus-gethash group gnus-active-hashtb))
2662          (number-total (if active (1+ (- (cdr active) (car active)))))
2663          (number-of-dormant (length (cdr (assq 'dormant marked))))
2664          (number-of-ticked (length (cdr (assq 'tick marked))))
2665          (number-of-ticked-and-dormant
2666           (+ number-of-ticked number-of-dormant))
2667          (number-of-unread-unticked 
2668           (if (numberp number) 
2669               (max 0 (- number number-of-ticked number-of-dormant))
2670             "*"))
2671          (number-of-read
2672           (if (numberp number)
2673               (max 0 (- number-total number))
2674             "*"))
2675          (subscribed (cond ((< level 6) ? )
2676                            ((< level 8) ?U)
2677                            ((= level 8) ?Z)
2678                            (t ?K)))
2679          (qualified-group (gnus-group-real-name group))
2680          (newsgroup-description 
2681           (if gnus-description-hashtb
2682               (or (gnus-gethash group gnus-description-hashtb) "")
2683             ""))
2684          (moderated (if (member group gnus-moderated-list) ?m ? ))
2685          (moderated-string (if (eq moderated ?m) "(m)" ""))
2686          (news-server (or (car (cdr method)) ""))
2687          (news-method (or (car method) ""))
2688          (news-method-string 
2689           (if method (format "(%s:%s)" (car method) (car (cdr method))) ""))
2690          (number (if (eq number t) "*" number))
2691          (marked (if (and 
2692                       (numberp number) 
2693                       (not (zerop number))
2694                       (>= (+ (length (cdr (assq 'tick marked)))
2695                              (length (cdr (assq 'dormant marked)))) number)
2696                       (> (length (cdr (assq 'tick marked))) 0))
2697                      ?* ? ))
2698          (buffer-read-only nil)
2699          b)
2700     (beginning-of-line)
2701     (setq b (point))
2702     ;; Insert the visible text.
2703     (insert-before-markers (eval gformat))
2704     (add-text-properties 
2705      b (1+ b) (list 'gnus-group (intern group)
2706                     'gnus-unread (if (numberp number-of-unread-unticked)
2707                                      number-of-unread-unticked t)
2708                     'gnus-marked marked
2709                     'gnus-level level))))
2710
2711 (defun gnus-group-update-group (group &optional visible-only)
2712   "Update newsgroup info of GROUP.
2713 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already."
2714   (save-excursion
2715     (set-buffer gnus-group-buffer)
2716     (let ((buffer-read-only nil)
2717           (visible nil))
2718       (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
2719         (if entry
2720             (gnus-dribble-enter 
2721              (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
2722                      ")"))))
2723       ;; Buffer may be narrowed.
2724       (save-restriction
2725         (widen)
2726         ;; Search a line to modify.  If the buffer is large, the search
2727         ;; takes long time.  In most cases, current point is on the line
2728         ;; we are looking for.  So, first of all, check current line. 
2729         (if (or (progn
2730                   (beginning-of-line)
2731                   (eq (get-text-property (point) 'gnus-group)
2732                       (intern group)))
2733                 (progn
2734                   (gnus-goto-char 
2735                    (text-property-any 
2736                     (point-min) (point-max) 'gnus-group (intern group)))))
2737             ;; GROUP is listed in current buffer. So, delete old line.
2738             (progn
2739               (setq visible t)
2740               (beginning-of-line)
2741               (delete-region (point) (progn (forward-line 1) (point))))
2742           ;; No such line in the buffer, find out where it's supposed to
2743           ;; go, and insert it there (or at the end of the buffer).
2744           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
2745           (or visible-only
2746               (let ((entry (cdr (gnus-gethash group gnus-newsrc-hashtb))))
2747                 (while (and entry
2748                             (not
2749                              (gnus-goto-char
2750                               (text-property-any
2751                                (point-min) (point-max) 
2752                                'gnus-group (intern (car (car entry)))))))
2753                   (setq entry (cdr entry)))
2754                 (or entry (goto-char (point-max))))))
2755         (if (or visible (not visible-only))
2756             (progn
2757               (gnus-group-insert-group-line-info group)
2758               (forward-line -1)         ; Move point back to the inserted line.
2759               ))))
2760     (gnus-group-set-mode-line)))
2761
2762 (defun gnus-group-set-mode-line ()
2763   (if (memq 'group gnus-updated-mode-lines)
2764       (let* ((gformat (or gnus-group-mode-line-format-spec
2765                           (setq gnus-group-mode-line-format-spec
2766                                 (gnus-parse-format 
2767                                  gnus-group-mode-line-format 
2768                                  gnus-group-mode-line-format-alist))))
2769              (news-server (car (cdr gnus-select-method)))
2770              (news-method (car gnus-select-method))
2771              (mode-string (eval gformat))
2772              (max-len 60))
2773         (if (> (length mode-string) max-len) 
2774             (setq mode-string (substring mode-string 0 (- max-len 4))))
2775         (setq mode-line-buffer-identification mode-string)
2776         (set-buffer-modified-p t))))
2777
2778 (defun gnus-group-group-name ()
2779   "Get the name of the newsgroup on the current line."
2780   (let ((group (get-text-property 
2781                 (save-excursion (beginning-of-line) (point)) 'gnus-group)))
2782     (and group (symbol-name group))))
2783
2784 (defun gnus-group-group-level ()
2785   "Get the level of the newsgroup on the current line."
2786   (get-text-property (save-excursion (beginning-of-line) (point)) 'gnus-level))
2787
2788 (defun gnus-group-search-forward (&optional backward all level first-too)
2789   "Find the next newsgroup with unread articles.
2790 If BACKWARD is non-nil, find the previous newsgroup instead.
2791 If ALL is non-nil, just find any newsgroup.
2792 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
2793 group exists.
2794 If FIRST-TOO, the current line is also eligeble as a target."
2795   (let ((way (if backward -1 1))
2796         (low 10)
2797         (beg (point))
2798         pos found)
2799     (or first-too (forward-line way))
2800     (while (and 
2801             (not (eobp))
2802             (not (setq 
2803                   found 
2804                   (and (or (not all)
2805                            (let ((unread 
2806                                   (get-text-property (point) 'gnus-unread)))
2807                              (or (eq unread t) (and unread (> unread 0)))))
2808                        (or (not level)
2809                            (let ((lev (get-text-property (point) 'gnus-level)))
2810                              (if (<= lev level)
2811                                  t
2812                                (if (< lev low)
2813                                    (progn
2814                                      (setq low lev)
2815                                      (setq pos (point))))
2816                                nil))))))
2817             (zerop (forward-line way))))
2818     (if found 
2819         (progn (gnus-group-position-cursor) t)
2820       (if pos (goto-char pos) (goto-char beg))
2821       nil)))
2822
2823 ;; Gnus group mode commands
2824
2825 (defun gnus-group-read-group (all &optional no-article)
2826   "Read news in this newsgroup.
2827 If argument ALL is non-nil, already read articles become readable.
2828 If optional argument NO-ARTICLE is non-nil, no article body is displayed."
2829   (interactive "P")
2830   (let ((group (gnus-group-group-name))
2831         number active)
2832     (if (not group)
2833         (error "No group on current line"))
2834     ;; This group might be a dead group. In that case we have to get
2835     ;; the number of unread articles from `gnus-active-hashtb'.
2836     (if (>= (gnus-group-group-level) 8)
2837         (setq number (- (1+ (cdr (setq active (gnus-gethash 
2838                                                group gnus-active-hashtb))))
2839                         (car active)))
2840       (setq number (car (gnus-gethash group gnus-newsrc-hashtb))))
2841     (gnus-summary-read-group 
2842      group (or all (and (numberp number) (zerop number))) no-article)))
2843
2844 (defun gnus-group-select-group (all)
2845   "Select this newsgroup.
2846 No article is selected automatically.
2847 If argument ALL is non-nil, already read articles become readable."
2848   (interactive "P")
2849   (gnus-group-read-group all t))
2850
2851 (defun gnus-group-jump-to-group (group)
2852   "Jump to newsgroup GROUP."
2853   (interactive
2854    (list 
2855     (completing-read "Group: " gnus-active-hashtb nil t)))
2856   (let (b)
2857     ;; Either go to the line in the group buffer...
2858     (or (and (setq b (text-property-any (point-min) (point-max) 
2859                                         'gnus-group (intern group)))
2860              (goto-char b))
2861         ;; ... or insert the line.
2862         (progn (gnus-group-update-group group)
2863                (goto-char (text-property-any (point-min) (point-max) 
2864                                              'gnus-group (intern group))))))
2865   ;; Adjust cursor point.
2866   (gnus-group-position-cursor))
2867
2868 (defun gnus-group-next-group (n)
2869   "Go to next N'th newsgroup.
2870 If N is negative, search backward instead.
2871 Returns the difference between N and the number of skips actually
2872 done."
2873   (interactive "p")
2874   (gnus-group-next-unread-group n t))
2875
2876 (defun gnus-group-next-unread-group (n &optional all level)
2877   "Go to next N'th unread newsgroup.
2878 If N is negative, search backward instead.
2879 If ALL is non-nil, choose any newsgroup, unread or not.
2880 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
2881 such group can be found, the next group with a level higher than
2882 LEVEL.
2883 Returns the difference between N and the number of skips actually
2884 done."
2885   (interactive "p")
2886   (let ((backward (< n 0))
2887         (n (abs n)))
2888     (while (and (> n 0)
2889                 (gnus-group-search-forward backward all level))
2890       (setq n (1- n)))
2891     (if (/= 0 n) (message "No more%s newsgroups%s" (if all "" " unread")
2892                           (if level " on this level or higher" "")))
2893     n))
2894
2895 (defun gnus-group-prev-group (n)
2896   "Go to previous N'th newsgroup.
2897 Returns the difference between N and the number of skips actually
2898 done."
2899   (interactive "p")
2900   (gnus-group-next-unread-group (- n) t))
2901
2902 (defun gnus-group-prev-unread-group (n)
2903   "Go to previous N'th unread newsgroup.
2904 Returns the difference between N and the number of skips actually
2905 done."  
2906   (interactive "p")
2907   (gnus-group-next-unread-group (- n)))
2908
2909 (defun gnus-group-next-unread-group-same-level (n)
2910   "Go to next N'th unread newsgroup on the same level.
2911 If N is negative, search backward instead.
2912 Returns the difference between N and the number of skips actually
2913 done."
2914   (interactive "p")
2915   (gnus-group-next-unread-group n t (gnus-group-group-level))
2916   (gnus-group-position-cursor))
2917
2918 (defun gnus-group-prev-unread-group-same-level (n)
2919   "Go to next N'th unread newsgroup on the same level.
2920 Returns the difference between N and the number of skips actually
2921 done."
2922   (interactive "p")
2923   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
2924   (gnus-group-position-cursor))
2925
2926 (defun gnus-group-add-group (&optional name how where)
2927   "Add a new newsgroup."
2928   (interactive)
2929   (let ((methods gnus-valid-select-methods)
2930         nname)
2931     (if (not name)
2932         (setq name (read-string "Group name: ")))
2933     (if (not how)
2934         (setq how (completing-read (format "%s method: " name) methods nil t)))
2935     (if (not where)
2936         (setq where (read-string 
2937                      (format "Get %s by method %s from: " name how))))
2938     (setq nname (gnus-group-prefixed-name name (list (intern how) where)))
2939     (gnus-group-change-level 
2940      (list t nname 3 nil nil (list (intern how) where))
2941      3 9 (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)
2942      t)
2943     (gnus-group-insert-group-line-info nname)))
2944
2945 (defun gnus-group-edit-group ()
2946   (interactive)
2947   (let ((group (gnus-group-group-name))
2948         info)
2949     (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
2950       (error "No group on current line"))
2951     (switch-to-buffer (get-buffer-create gnus-group-edit-buffer))
2952     (gnus-add-current-to-buffer-list)
2953     (emacs-lisp-mode)
2954     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2955     (use-local-map (copy-keymap emacs-lisp-mode-map))
2956     (local-set-key "\C-c\C-c" 'gnus-group-edit-group-done)
2957     (erase-buffer)
2958     (insert ";; Type `C-c C-c' after you have edited the newsgroup entry.\n\n")
2959     (insert (format "(gnus-group-set-info\n  '%S)\n" info))))
2960
2961 (defun gnus-group-edit-group-done ()
2962   (interactive)
2963   (set-buffer (get-buffer-create gnus-group-edit-buffer))
2964   (eval-current-buffer)
2965   (kill-buffer (current-buffer))
2966   (set-buffer gnus-group-buffer)
2967   (gnus-group-update-group (gnus-group-group-name))
2968   (gnus-group-position-cursor))
2969
2970 (defun gnus-group-make-directory-group (dir)
2971   "Create an nndir group.
2972 The user will be prompted for a directory. The contents of this
2973 directory will be used as a newsgroup. The directory should contain
2974 mail messages or news articles in files that have numeric names."
2975   (interactive
2976    (list (read-file-name "Create group from directory: ")))
2977   (or (file-exists-p dir) (error "No such directory"))
2978   (or (file-directory-p dir) (error "Not a directory"))
2979   (gnus-group-add-group dir "nndir" dir))
2980
2981 (defun gnus-group-catchup-current (n &optional all)
2982   "Mark all articles not marked as unread in current newsgroup as read.
2983 If prefix argument N is numeric, the ARG next newsgroups will be
2984 caught up. If ALL is non-nil, marked articles will also be marked as
2985 read. Cross references (Xref: header) of articles are ignored.
2986 The difference between N and actual number of newsgroups that were
2987 caught up is returned."
2988   (interactive "p")
2989   (if (or (not gnus-interactive-catchup) ;Without confirmation?
2990           gnus-expert-user
2991           (y-or-n-p
2992            (if all
2993                "Do you really want to mark all articles as read? "
2994              "Mark all unread articles as read? ")))
2995       (progn
2996         (while 
2997             (and (> n 0)
2998                  (progn
2999                    (setq n (1- n))
3000                    (gnus-group-catchup (gnus-group-group-name) all)
3001                    (gnus-group-update-group-line)
3002                    t)
3003                  (zerop (gnus-group-next-unread-group 1))))))
3004     n)
3005
3006 (defun gnus-group-catchup-current-all (n)
3007   "Mark all articles in current newsgroup as read.
3008 Cross references (Xref: header) of articles are ignored."
3009   (interactive "p")
3010   (gnus-group-catchup-current n 'all))
3011
3012 (defun gnus-group-catchup (group &optional all)
3013   "Mark all articles in GROUP as read.
3014 If ALL is non-nil, all articles are marked as read.
3015 The return value is the number of articles that were marked as read,
3016 or nil if no action could be taken."
3017   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
3018          (num (car entry))
3019          (marked (nth 3 (nth 2 entry)))
3020          ticked)
3021     ;; Do the updating only if the newsgroup isn't killed
3022     (if entry
3023         (progn
3024           (setq ticked (if all nil (cdr (assq 'tick marked))))
3025           (gnus-update-read-articles group ticked nil ticked)
3026           (if (and all marked)
3027               (setcar (nthcdr 3 (nth 2 entry)) 
3028                       (delq (assq 'dormant marked) marked)))))
3029     num))
3030
3031 (defun gnus-group-expire-articles (newsgroup)
3032   "Expire all expirable articles in the current newsgroup."
3033   (interactive (list (gnus-group-group-name)))
3034   (if (not newsgroup) (error "No current newsgroup"))
3035   (let ((expirable 
3036          (assq 'expire (nth 3 (nth 2 (gnus-gethash newsgroup 
3037                                                    gnus-newsrc-hashtb))))))
3038  (and expirable 
3039       (gnus-check-backend-function 'request-expire-articles newsgroup)
3040       (setcdr expirable
3041               (gnus-request-expire-articles (cdr expirable) newsgroup)))))
3042
3043 (defun gnus-group-expire-all-groups ()
3044   "Expire all expirable articles in all newsgroups."
3045   (interactive)
3046   (message "Expiring...")
3047   (let ((newsrc (cdr gnus-newsrc-assoc)))
3048     (while newsrc
3049       (gnus-group-expire-articles (car (car newsrc)))
3050       (setq newsrc (cdr newsrc))))
3051   (message "Expiring...done"))
3052
3053 (defun gnus-group-set-current-level (n)
3054   "Set the level of the current group to the numeric prefix."
3055   (interactive "P")
3056   (setq n (or n (string-to-int 
3057                  (completing-read 
3058                   "Level: " 
3059                   (mapcar (lambda (n) (list (char-to-string n))) "123456789")
3060                   nil t))))
3061   (let ((group (gnus-group-group-name)))
3062     (if (not group) (error "No newsgroup on current line.")
3063     (if (and (numberp n) (>= n 1) (<= n 9))
3064         (progn
3065           (gnus-group-change-level group n (gnus-group-group-level))
3066           (gnus-group-update-group-line))
3067       (error "Illegal level: %s" n)))))
3068
3069 (defun gnus-group-unsubscribe-current-group (arg)
3070   "Toggle subscribe from/to unsubscribe current group."
3071   (interactive "P")
3072   (let ((group (gnus-group-group-name)))
3073     (if group
3074         (progn
3075           (if (not arg) 
3076               (setq arg (if (<= (gnus-group-group-level) 5) 6 3)))
3077           (gnus-group-unsubscribe-group group arg)
3078 ;         (gnus-group-next-group 1)
3079           )
3080       (message "No newsgroup on current line"))))
3081
3082 (defun gnus-group-unsubscribe-group (group &optional level)
3083   "Toggle subscribe from/to unsubscribe GROUP.
3084 New newsgroup is added to .newsrc automatically."
3085   (interactive
3086    (list (completing-read "Group: " gnus-active-hashtb nil t)))
3087   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
3088     (cond (newsrc
3089            ;; Toggle subscription flag.
3090            (gnus-group-change-level 
3091             newsrc (if level level (if (< (nth 1 (nth 2 newsrc)) 6) 6 4)))
3092            (gnus-group-update-group group))
3093           ((and (stringp group)
3094                 (gnus-gethash group gnus-active-hashtb))
3095            ;; Add new newsgroup.
3096            (gnus-group-change-level 
3097             group 
3098             (if level level 3) 
3099             (if (member group gnus-zombie-list) 8 9)
3100             (or (and (gnus-group-group-name)
3101                      (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))
3102                 (gnus-gethash (car (car gnus-newsrc-assoc)) 
3103                               gnus-newsrc-hashtb)))
3104            (gnus-group-update-group group))
3105           (t (error "No such newsgroup: %s" group)))
3106     (gnus-group-position-cursor)))
3107
3108 (defun gnus-group-transpose-groups (arg)
3109   "Exchange current newsgroup and previous newsgroup.
3110 With argument ARG, takes previous newsgroup and moves it past ARG newsgroup."
3111   (interactive "p")
3112   ;; BUG: last newsgroup and the last but one cannot be transposed
3113   ;; since gnus-group-search-forward does not move forward beyond the
3114   ;; last.  If we instead use forward-line, no problem, but I don't
3115   ;; want to use it for later extension.
3116   (while (> arg 0)
3117     (gnus-group-search-forward t t)
3118     (gnus-group-kill-group 1)
3119     (gnus-group-search-forward nil t)
3120     (gnus-group-yank-group)
3121     (gnus-group-search-forward nil t)
3122     (setq arg (1- arg))
3123     ))
3124
3125 (defun gnus-group-kill-all-zombies ()
3126   "Kill all zombie newsgroups."
3127   (interactive)
3128   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
3129   (setq gnus-zombie-list nil)
3130   (gnus-group-prepare 5)
3131   (goto-char (point-min))
3132   (gnus-group-position-cursor))
3133
3134 (defun gnus-group-kill-region (begin end)
3135   "Kill newsgroups in current region (excluding current point).
3136 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
3137   (interactive "r")
3138   (let ((lines
3139          ;; Exclude a line where current point is on.
3140          (1-
3141           ;; Count lines.
3142           (save-excursion
3143             (count-lines
3144              (progn
3145                (goto-char begin)
3146                (beginning-of-line)
3147                (point))
3148              (progn
3149                (goto-char end)
3150                (end-of-line)
3151                (point)))))))
3152     (goto-char begin)
3153     (beginning-of-line)                 ;Important when LINES < 1
3154     (gnus-group-kill-group lines)))
3155
3156 (defun gnus-group-kill-group (n)
3157   "The the next N groups.
3158 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
3159 However, only groups that were alive can be yanked; already killed 
3160 groups or zombie groups can't be yanked.
3161 The return value is the name of the (last) newsgroup that was killed."
3162   (interactive "p")
3163   (let ((buffer-read-only nil)
3164         group entry level)
3165     (while (>= (setq n  (1- n)) 0)
3166       (setq group (gnus-group-group-name))
3167       (or group
3168           (signal 'end-of-buffer nil))
3169       (setq level (gnus-group-group-level))
3170       (beginning-of-line)
3171       (delete-region (point) (progn (forward-line 1) (point)))
3172       (if (setq entry (gnus-gethash group gnus-newsrc-hashtb))
3173           (setq gnus-list-of-killed-groups 
3174                 (cons (cons (car entry) (nth 2 entry)) 
3175                       gnus-list-of-killed-groups)))
3176       (gnus-group-change-level 
3177        (if entry entry group) 9
3178        (if entry nil level)))
3179     (if (eobp)
3180         (forward-line -1))
3181     (gnus-group-position-cursor)
3182     group))
3183
3184 (defun gnus-group-yank-group (&optional arg)
3185   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
3186 inserting it before the current newsgroup.  The numeric ARG specifies
3187 how many newsgroups are to be yanked.  The name of the (last)
3188 newsgroup yanked is returned."
3189   (interactive "p")
3190   (if (not arg) (setq arg 1))
3191   (let (info group prev)
3192     (while (>= (setq arg (1- arg)) 0)
3193       (if (not (setq info (car gnus-list-of-killed-groups)))
3194           (error "No more newsgroups to yank"))
3195       (setq group (nth 2 info))
3196       ;; Find which newsgroup to insert this one before - search
3197       ;; backward until something suitable is found. If there are no
3198       ;; other newsgroups in this buffer, just make this newsgroup the
3199       ;; first newsgroup.
3200       (while (and (not (setq prev (gnus-group-group-name)))
3201                   (zerop (forward-line -1))))
3202       (if (not prev)
3203           (setq prev (car (car gnus-newsrc-assoc))))
3204       (gnus-group-change-level 
3205        info (nth 2 info) 9 
3206        (gnus-gethash prev gnus-newsrc-hashtb)
3207        t)
3208       (gnus-group-insert-group-line-info (nth 1 info))
3209       (setq gnus-list-of-killed-groups 
3210             (cdr gnus-list-of-killed-groups)))
3211     (forward-line -1)
3212     (gnus-group-position-cursor)
3213     group))
3214       
3215 (defun gnus-group-list-all-groups (arg)
3216   "List all newsgroups with level ARG or lower.
3217 Default is 7, which lists all subscribed and most unsubscribed groups."
3218   (interactive "P")
3219   (setq arg (or arg 7))
3220   (gnus-group-list-groups arg t))
3221
3222 (defun gnus-group-list-killed ()
3223   "List all killed newsgroups in the group buffer."
3224   (interactive)
3225   (gnus-group-prepare 9 t 9)
3226   (goto-char (point-min))
3227   (gnus-group-position-cursor))
3228
3229 (defun gnus-group-list-zombies ()
3230   "List all zombie newsgroups in the group buffer."
3231   (interactive)
3232   (gnus-group-prepare 8 t 8)
3233   (goto-char (point-min))
3234   (gnus-group-position-cursor))
3235
3236 (defun gnus-group-get-new-news (&optional arg)
3237   "Get newly arrived articles.
3238 If ARG is non-nil, it should be a number between one and nine to
3239 specify which levels you are interested in re-scanning."
3240   (interactive "P")
3241   (if (and gnus-read-active-file (not arg))
3242       (progn
3243         (gnus-read-active-file)
3244         (gnus-get-unread-articles (or arg 6)))
3245     (let ((gnus-read-active-file nil))
3246       (gnus-get-unread-articles (or arg 6))))
3247   (gnus-group-list-groups 5 gnus-have-all-newsgroups))
3248
3249 (defun gnus-group-get-new-news-this-group (n)
3250   "Check for newly arrived news in the current group (and the N-1 next groups).
3251 The difference between N and the number of newsgroup checked is returned.
3252 If N is negative, this group and the N-1 previous groups will be checked."
3253   (interactive "p")
3254   (let ((way (if (< n 0) -1 1))
3255         (n (abs n))
3256         (w-p (window-start))
3257         group)
3258     (while (and (> n 0)
3259                 (gnus-get-new-news-in-group (gnus-group-group-name))
3260                 (zerop (gnus-group-next-group way)))
3261       (setq n (1- n)))
3262     (if (/= 0 n) (message "No more newsgroups"))
3263     ;; !!! I don't know why the buffer scrolls forward when updating
3264     ;; the first line in the group buffer, but it does. So we set the
3265     ;; window start forcibly.
3266     (set-window-start (get-buffer-window (current-buffer)) w-p)
3267     n))
3268
3269 (defun gnus-get-new-news-in-group (group)
3270   (if (and group (gnus-activate-newsgroup group))
3271       (progn
3272         (gnus-get-unread-articles-in-group 
3273          (nth 2 (gnus-gethash group gnus-newsrc-hashtb))
3274          (gnus-gethash group gnus-active-hashtb))
3275         (gnus-group-update-group-line)))
3276   t)
3277   
3278 (defun gnus-group-describe-group (&optional group)
3279   "Display a description of the current newsgroup."
3280   (interactive)
3281   (let ((group (or group (gnus-group-group-name))))
3282     (if (not group)
3283         (message "No group on current line")
3284       (and (or gnus-description-hashtb
3285                (gnus-read-descriptions-file))
3286            (message
3287             (or (gnus-gethash group gnus-description-hashtb)
3288                 "No description available"))))))
3289
3290 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
3291 (defun gnus-group-describe-all-groups ()
3292   "Pop up a buffer with descriptons of all newsgroups."
3293   (interactive)
3294   (if (not (or gnus-description-hashtb
3295                (gnus-read-descriptions-file)))
3296       (error "Couldn't request descriptions file"))
3297   (let ((buffer-read-only nil)
3298         b)
3299     (erase-buffer)
3300     (mapatoms
3301      (lambda (group)
3302        (insert (format "      *: %-20s %s" (symbol-name group)
3303                        (symbol-value group)))
3304        (setq b (point))
3305        (add-text-properties 
3306         b (1+ b) (list 'gnus-group (intern group)
3307                        'gnus-unread t 'gnus-marked nil 'gnus-level 6)))
3308      gnus-description-hashtb)
3309     (goto-char (point-min))
3310     (gnus-group-position-cursor)))
3311
3312 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
3313 (defun gnus-group-apropos (regexp &optional search-description)
3314   "List all newsgroups that have names that match a regexp."
3315   (interactive "sGnus apropos (regexp): ")
3316   (let ((prev "")
3317         (obuf (current-buffer))
3318         groups des prev)
3319     ;; Go through all newsgroups that are known to Gnus.
3320     (mapatoms 
3321      (lambda (group)
3322        (and (string-match regexp (symbol-name group))
3323             (setq groups (cons (symbol-name group) groups))))
3324      gnus-active-hashtb)
3325     ;; Go through all descriptions that are known to Gnus. 
3326     (if search-description
3327         (mapatoms 
3328          (lambda (group)
3329            (and (string-match regexp (symbol-value group))
3330                 (gnus-gethash (symbol-name group) gnus-active-hashtb)
3331                 (setq groups (cons (symbol-name group) groups))))
3332          gnus-description-hashtb))
3333     (if (not groups)
3334         (message "No groups matched \"%s\"." regexp)
3335       ;; Print out all the groups.
3336       (save-excursion
3337         (pop-to-buffer (get-buffer-create "*Gnus Help*"))
3338         (buffer-disable-undo (current-buffer))
3339         (erase-buffer)
3340         (setq groups (sort groups 'string<))
3341         (while groups
3342           ;; Groups may be entered twice into the list of groups.
3343           (if (not (string= (car groups) prev))
3344               (progn
3345                 (insert (setq prev (car groups)) "\n")
3346                 (if (and gnus-description-hashtb
3347                          (setq des (gnus-gethash (car groups) 
3348                                                  gnus-description-hashtb)))
3349                     (insert "  " des "\n"))))
3350           (setq groups (cdr groups)))
3351         (goto-char 1)))
3352     (pop-to-buffer obuf)))
3353
3354 (defun gnus-group-description-apropos (regexp)
3355   "List all newsgroups that have names or desccriptions that match a regexp."
3356   (interactive "sGnus description apropos (regexp): ")
3357   (if (not (or gnus-description-hashtb
3358                (gnus-read-descriptions-file)))
3359       (error "Couldn't request descriptions file"))
3360   (gnus-group-apropos regexp t))
3361
3362 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
3363 (defun gnus-group-list-matching (regexp) 
3364   "List all newsgroups with unread articles that match REGEXP."
3365   (interactive "sList newsgroups matching: ")
3366   (set-buffer gnus-group-buffer)
3367   (let ((buffer-read-only nil)
3368         (newsrc (cdr gnus-newsrc-assoc))
3369         (zombie gnus-zombie-list)
3370         (killed gnus-killed-list)
3371         info unread active group)
3372     (erase-buffer)
3373
3374     ;; List alive newsgroups.
3375     (while newsrc
3376       (setq info (car newsrc)
3377             group (car info)
3378             newsrc (cdr newsrc)
3379             unread (car (gnus-gethash group gnus-newsrc-hashtb)))
3380       (if (and unread ; This group might be bogus
3381                (string-match regexp group))
3382           (gnus-group-insert-group-line 
3383            nil group (car (cdr info)) (nth 3 info) unread
3384            (nth 4 info))))
3385
3386     ;; List zombies and killed lists.
3387     (let ((lists (list 'gnus-zombie-list 'gnus-killed-list))
3388           mark b)
3389       (while lists
3390         (if (eq (car lists) 'gnus-zombie-list)
3391             (setq mark ?Z)
3392           (setq mark ?K))
3393         (setq newsrc (set (car lists)
3394                           (sort (symbol-value (car lists)) 
3395                                 (function string<))))
3396         (while newsrc
3397           (setq group (car newsrc)
3398                 newsrc (cdr newsrc))
3399           (if (not (string-match regexp group))
3400               ()
3401             (setq b (point))
3402             (insert (format " %c    *: %s" mark group))
3403             (add-text-properties 
3404              b (1+ b) 
3405              (list 'gnus-group (intern group)
3406                    'gnus-unread t
3407                    'gnus-level (if (= mark ?Z) 8 9)))))
3408         (setq lists (cdr lists))))
3409
3410     (gnus-group-set-mode-line)
3411     (setq gnus-have-all-newsgroups t)
3412     (run-hooks 'gnus-group-prepare-hook))
3413   (goto-char (point-min))
3414   (gnus-group-position-cursor))
3415
3416 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
3417 (defun gnus-group-save-newsrc ()
3418   "Save the Gnus startup files."
3419   (interactive)
3420   (gnus-save-newsrc-file))
3421
3422 (defun gnus-group-restart (&optional arg)
3423   "Force Gnus to read the .newsrc file."
3424   (interactive "P")
3425   (gnus-save-newsrc-file)
3426   (gnus-setup-news 'force)
3427   (gnus-group-list-groups (or arg 5) gnus-have-all-newsgroups))
3428
3429 (defun gnus-group-read-init-file ()
3430   "Read the Gnus elisp init file."
3431   (interactive)
3432   (gnus-read-init-file))
3433
3434 (defun gnus-group-check-bogus-groups ()
3435   "Check bogus newsgroups."
3436   (interactive)
3437   (gnus-check-bogus-newsgroups (not gnus-expert-user))  ;Require confirmation.
3438   (gnus-group-list-groups 5 gnus-have-all-newsgroups))
3439
3440 (defun gnus-group-mail ()
3441   "Start composing a mail."
3442   (interactive)
3443   (mail))
3444
3445 (defun gnus-group-edit-global-kill ()
3446   "Edit a global kill file."
3447   (interactive)
3448   (setq gnus-current-kill-article nil)  ;No articles selected.
3449   (gnus-kill-file-edit-file nil)        ;Nil stands for global KILL file.
3450   (message
3451    (substitute-command-keys
3452     "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)")))
3453
3454 (defun gnus-group-edit-local-kill ()
3455   "Edit a local kill file."
3456   (interactive)
3457   (setq gnus-current-kill-article nil)  ;No articles selected.
3458   (gnus-kill-file-edit-file (gnus-group-group-name))
3459   (message
3460    (substitute-command-keys
3461     "Editing a local kill file (Type \\[gnus-kill-file-exit] to exit)")))
3462
3463 (defun gnus-group-force-update ()
3464   "Update `.newsrc' file."
3465   (interactive)
3466   (gnus-save-newsrc-file))
3467
3468 (defun gnus-group-suspend ()
3469   "Suspend the current Gnus session.
3470 In fact, cleanup buffers except for group mode buffer.
3471 The hook gnus-suspend-gnus-hook is called before actually suspending."
3472   (interactive)
3473   (run-hooks 'gnus-suspend-gnus-hook)
3474   ;; Kill Gnus buffers except for group mode buffer.
3475   (let ((group-buf (get-buffer gnus-group-buffer)))
3476     (while gnus-buffer-list
3477       (and (not (eq (car gnus-buffer-list) group-buf))
3478            (get-buffer (car gnus-buffer-list))
3479            (buffer-name (get-buffer (car gnus-buffer-list)))
3480            (kill-buffer (car gnus-buffer-list)))
3481       (setq gnus-buffer-list (cdr gnus-buffer-list)))
3482     (setq gnus-buffer-list (list group-buf))
3483     (bury-buffer group-buf)
3484     (delete-windows-on group-buf t)))
3485
3486 (defun gnus-group-clear-dribble ()
3487   "Clear all information from the dribble buffer."
3488   (interactive)
3489   (gnus-dribble-clear))
3490
3491 (defun gnus-group-exit ()
3492   "Quit reading news after updating .newsrc.eld and .newsrc.
3493 The hook `gnus-exit-gnus-hook' is called before actually exiting."
3494   (interactive)
3495   (if (or noninteractive                ;For gnus-batch-kill
3496           (zerop (buffer-size))         ;No news is good news.
3497           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
3498           (not gnus-interactive-exit)   ;Without confirmation
3499           gnus-expert-user
3500           (y-or-n-p "Are you sure you want to quit reading news? "))
3501       (progn
3502         (message "")                    ;Erase "Yes or No" question.
3503         (run-hooks 'gnus-exit-gnus-hook)
3504         (gnus-save-newsrc-file)
3505         (gnus-clear-system))))
3506
3507 (defun gnus-group-quit ()
3508   "Quit reading news without updating .newsrc.eld or .newsrc.
3509 The hook `gnus-exit-gnus-hook' is called before actually exiting."
3510   (interactive)
3511   (if (or noninteractive                ;For gnus-batch-kill
3512           (zerop (buffer-size))
3513           (not (gnus-server-opened gnus-select-method))
3514           gnus-expert-user
3515           (not gnus-current-startup-file)
3516           (yes-or-no-p
3517            (format "Quit reading news without saving %s? "
3518                    (file-name-nondirectory gnus-current-startup-file))))
3519       (progn
3520         (message "")                    ;Erase "Yes or No" question.
3521         (run-hooks 'gnus-exit-gnus-hook)
3522         (gnus-dribble-save)
3523         (gnus-clear-system))))
3524
3525 (defun gnus-group-describe-briefly ()
3526   "Give a one line description of the group mode commands."
3527   (interactive)
3528   (message
3529    (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")))
3530
3531 (defun gnus-group-browse-foreign-server (method)
3532   "Browse a foreign news server.
3533 If called interactively, this function will ask for a select method
3534  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). 
3535 If not, METHOD should be a list where the first element is the method
3536 and the second element is the address."
3537   (interactive
3538    (list (list (intern (completing-read 
3539                         "Select method: "
3540                         gnus-valid-select-methods nil t "nntp"))
3541                ;; Suggested by mapjph@bath.ac.uk.
3542                (completing-read 
3543                 "Server name: " 
3544                 (mapcar (lambda (server) (list server))
3545                         gnus-secondary-servers)))))
3546   (gnus-browse-foreign-server method))
3547
3548 \f
3549 ;;;
3550 ;;; Browse Server Mode
3551 ;;;
3552
3553 (defvar gnus-browse-server-mode-hook nil)
3554 (defvar gnus-browse-server-mode-map nil)
3555
3556 (if gnus-browse-server-mode-map
3557     nil
3558   (setq gnus-browse-server-mode-map (make-keymap))
3559   (suppress-keymap gnus-browse-server-mode-map)
3560   (define-key gnus-browse-server-mode-map " " 'gnus-browse-read-group)
3561   (define-key gnus-browse-server-mode-map "=" 'gnus-browse-read-group)
3562   (define-key gnus-browse-server-mode-map "n" 'gnus-browse-next-group)
3563   (define-key gnus-browse-server-mode-map "p" 'gnus-browse-prev-group)
3564   (define-key gnus-browse-server-mode-map [del] 'gnus-browse-prev-group)
3565   (define-key gnus-browse-server-mode-map "N" 'gnus-browse-next-group)
3566   (define-key gnus-browse-server-mode-map "P" 'gnus-group-prev-group)
3567   (define-key gnus-browse-server-mode-map "\M-n" 'gnus-browse-next-group)
3568   (define-key gnus-browse-server-mode-map "\M-p" 'gnus-browse-prev-group)
3569   (define-key gnus-browse-server-mode-map "\r" 'gnus-browse-read-group)
3570   (define-key gnus-browse-server-mode-map "u" 'gnus-browse-unsubscribe-current-group)
3571   (define-key gnus-browse-server-mode-map "q" 'gnus-browse-exit)
3572   (define-key gnus-browse-server-mode-map "Q" 'gnus-browse-exit)
3573   (define-key gnus-browse-server-mode-map "\C-c\C-c" 'gnus-browse-quit)
3574   (define-key gnus-browse-server-mode-map "?" 'gnus-browse-describe-briefly)
3575   (define-key gnus-browse-server-mode-map "\C-c\C-i" 'gnus-info-find-node)
3576   )
3577
3578 (defvar gnus-browse-current-method nil)
3579
3580 (defun gnus-browse-foreign-server (method)
3581   (setq gnus-browse-current-method method)
3582   (let ((gnus-select-method method)
3583         groups group)
3584     (message "Connecting to %s..." (nth 1 method))
3585     (if (not (gnus-request-list method))
3586         (error "Unable to contact server: " (gnus-status-message method)))
3587     (set-buffer (get-buffer-create "*Gnus Browse Server*"))
3588     (gnus-add-current-to-buffer-list)
3589     (buffer-disable-undo (current-buffer))
3590     (let ((buffer-read-only nil))
3591       (erase-buffer))
3592     (gnus-browse-server-mode)
3593     (setq mode-line-buffer-identification
3594           (format
3595            "(ding) Browse Server {%s:%s}" (car method) (car (cdr method))))
3596     (save-excursion
3597       (set-buffer nntp-server-buffer)
3598       (let ((cur (current-buffer)))
3599         (goto-char 1)
3600         (while (re-search-forward 
3601                 "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
3602           (goto-char (match-end 1))
3603           (setq groups (cons (cons (buffer-substring (match-beginning 1)
3604                                                      (match-end 1))
3605                                    (- (read cur) (read cur)))
3606                              groups)))))
3607     (setq groups (sort groups 
3608                        (lambda (l1 l2)
3609                          (string< (car l1) (car l2)))))
3610     (let ((buffer-read-only nil))
3611       (while groups
3612         (setq group (car groups))
3613         (insert 
3614          (format "K%7d: %s\n" (cdr group) (car group)))
3615         (setq groups (cdr groups))))
3616     (switch-to-buffer (current-buffer))
3617     (goto-char 1)
3618     (gnus-group-position-cursor)))
3619
3620 (defun gnus-browse-server-mode ()
3621   "Major mode for reading network news."
3622   (interactive)
3623   (kill-all-local-variables)
3624   (setq mode-line-modified "-- ")
3625   (make-local-variable 'mode-line-format)
3626   (setq mode-line-format (copy-sequence mode-line-format))
3627   (and (equal (nth 3 mode-line-format) "   ")
3628        (setcar (nthcdr 3 mode-line-format) ""))
3629   (setq major-mode 'gnus-browse-server-mode)
3630   (setq mode-name "Browse Server")
3631   (setq mode-line-process nil)
3632   (use-local-map gnus-browse-server-mode-map)
3633   (buffer-disable-undo (current-buffer))
3634   (setq truncate-lines t)
3635   (setq buffer-read-only t)
3636   (run-hooks 'gnus-browse-server-mode-hook))
3637
3638 (defun gnus-browse-read-group ()
3639   "Not implemented, and will probably never be."
3640   (interactive)
3641   (error "You can't read while browsing"))
3642
3643 (defun gnus-browse-next-group (n)
3644   "Go to the next group."
3645   (interactive "p")
3646   (prog1
3647       (forward-line n)
3648     (gnus-group-position-cursor)))
3649
3650 (defun gnus-browse-prev-group (n)
3651   "Go to the next group."
3652   (interactive "p")
3653   (gnus-browse-next-group (- n)))
3654
3655 (defun gnus-browse-unsubscribe-current-group (arg)
3656   "(Un)subscribe to the next ARG groups."
3657   (interactive "p")
3658   (and (eobp)
3659        (error "No group at current line."))
3660   (let ((ward (if (< arg 0) -1 1))
3661         (arg (abs arg)))
3662     (while (and (> arg 0)
3663                 (not (eobp))
3664                 (gnus-browse-unsubscribe-group)
3665                 (zerop (gnus-browse-next-group ward)))
3666       (setq arg (1- arg)))
3667     (gnus-group-position-cursor)
3668     (if (/= 0 arg) (message "No more newsgroups" ))
3669     arg))
3670   
3671 (defun gnus-browse-unsubscribe-group ()
3672   (let ((sub nil)
3673         (buffer-read-only nil)
3674         group)
3675     (save-excursion
3676       (beginning-of-line)
3677       (if (= (following-char) ?K) (setq sub t))
3678       (re-search-forward ": \\(.*\\)$" nil t)
3679       (setq group (gnus-group-prefixed-name 
3680                    (buffer-substring (match-beginning 1) (match-end 1))
3681                    gnus-browse-current-method))
3682       (beginning-of-line)
3683       (delete-char 1)
3684       (if sub
3685           (progn
3686             (gnus-group-change-level 
3687              (list t group 3 nil nil gnus-browse-current-method) 3 9 
3688              (gnus-gethash (car (nth 1 gnus-newsrc-assoc)) gnus-newsrc-hashtb)
3689              t)
3690             (insert ? ))
3691         (gnus-group-change-level group 9 3)
3692         (insert ?K)))
3693     t))
3694
3695 (defun gnus-browse-exit ()
3696   "Quit browsing and return to the group buffer."
3697   (interactive)
3698   (if (eq major-mode 'gnus-browse-server-mode)
3699       (kill-buffer (current-buffer)))
3700   (switch-to-buffer gnus-group-buffer)
3701   (gnus-group-list-groups 5))
3702
3703 (defun gnus-browse-describe-briefly ()
3704   "Give a one line description of the group mode commands."
3705   (interactive)
3706   (message
3707    (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")))
3708       
3709 \f
3710 ;;;
3711 ;;; Gnus summary mode
3712 ;;;
3713
3714 (defvar gnus-summary-mode-map nil)
3715 (defvar gnus-summary-mark-map nil)
3716 (defvar gnus-summary-send-map nil)
3717 (defvar gnus-summary-extract-map nil)
3718 (defvar gnus-summary-article-map nil)
3719 (defvar gnus-summary-thread-map nil)
3720 (defvar gnus-summary-goto-map nil)
3721 (defvar gnus-summary-exit-map nil)
3722 (defvar gnus-summary-various-map nil)
3723 (defvar gnus-summary-interest-map nil)
3724 (defvar gnus-summary-process-map nil)
3725 (defvar gnus-summary-sort-map nil)
3726 (defvar gnus-summary-mgroup-map nil)
3727 (defvar gnus-summary-vkill-map nil)
3728 (defvar gnus-summary-increase-map nil)
3729 (defvar gnus-summary-inc-subject-map nil)
3730 (defvar gnus-summary-inc-author-map nil)
3731 (defvar gnus-summary-inc-xref-map nil)
3732 (defvar gnus-summary-inc-thread-map nil)
3733 (defvar gnus-summary-inc-fol-map nil)
3734 (defvar gnus-summary-lower-map nil)
3735 (defvar gnus-summary-low-subject-map nil)
3736 (defvar gnus-summary-low-author-map nil)
3737 (defvar gnus-summary-low-xref-map nil)
3738 (defvar gnus-summary-low-thread-map nil)
3739 (defvar gnus-summary-low-fol-map nil)
3740
3741 (if gnus-summary-mode-map
3742     nil
3743   (setq gnus-summary-mode-map (make-keymap))
3744   (suppress-keymap gnus-summary-mode-map)
3745
3746   ;;Non-orthogonal keys
3747
3748   (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
3749   (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
3750   (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
3751   (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
3752   (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
3753   (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
3754   (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
3755   (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject)
3756   (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject)
3757   (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-summary-next-digest)
3758   (define-key gnus-summary-mode-map "\C-c\C-p" 'gnus-summary-prev-digest)
3759   (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject)
3760   (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject)
3761   (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
3762   (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article)
3763   (define-key gnus-summary-mode-map "\M-s" 'gnus-summary-search-article-forward)
3764   (define-key gnus-summary-mode-map "\M-r" 'gnus-summary-search-article-backward)
3765   (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
3766   (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
3767   (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
3768   (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
3769   (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article)
3770   (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward)
3771   (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward)
3772   (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward)
3773   (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
3774   (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
3775   (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward)
3776   (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward)
3777   (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
3778   (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
3779   (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread)
3780   (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable)
3781   (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable)
3782   (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads)
3783   (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread)
3784   (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread)
3785   (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread)
3786   (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread)
3787   (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread)
3788   (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread)
3789   (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
3790   (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
3791   (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
3792   (define-key gnus-summary-mode-map "\M-d" 'gnus-summary-remove-lines-marked-as-read)
3793   (define-key gnus-summary-mode-map "\C-c\M-\C-d" 'gnus-summary-remove-lines-marked-with)
3794   (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant)
3795   (define-key gnus-summary-mode-map "\C-c\M-\C-s" 'gnus-summary-show-all-expunged)
3796   (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
3797   (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
3798   (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
3799   (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
3800   (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score)
3801   (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
3802   (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
3803   (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group)
3804   (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
3805   (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
3806   (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime)
3807   (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-rmail-digest)
3808   (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
3809   (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
3810   (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
3811   (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
3812   (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
3813   (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
3814   (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
3815   (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail)
3816   (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
3817   (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill)
3818   (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill)
3819   (define-key gnus-summary-mode-map "V" 'gnus-version)
3820   (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group)
3821   (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
3822   (define-key gnus-summary-mode-map "Q" 'gnus-summary-quit)
3823   (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
3824   (define-key gnus-summary-mode-map [mouse-2] 'gnus-mouse-pick-article)
3825   (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
3826   (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
3827   (define-key gnus-summary-mode-map "x" 'gnus-summary-delete-marked-as-read)
3828   (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
3829   (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
3830   (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
3831 ;  (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
3832   (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
3833
3834
3835   ;; Orthogonal keymap
3836   (define-prefix-command 'gnus-summary-mark-map)
3837   (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map)
3838   (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward)
3839   (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward)
3840   (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward)
3841   (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward)
3842   (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward)
3843   (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward)
3844   (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable)
3845   (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable)
3846   (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant)
3847   (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark)
3848   (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark)
3849   (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable)
3850   (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable)
3851   (define-key gnus-summary-mark-map "\M-r" 'gnus-summary-remove-lines-marked-as-read)
3852   (define-key gnus-summary-mark-map "\M-\C-r" 'gnus-summary-remove-lines-marked-with)
3853   (define-key gnus-summary-mark-map "\C-d" 'gnus-summary-show-all-dormant)
3854   (define-key gnus-summary-mark-map "\C-s" 'gnus-summary-show-all-expunged)
3855   (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup)
3856   (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all)
3857   (define-key gnus-summary-mark-map "a" 'gnus-summary-clear-above)
3858   (define-key gnus-summary-mark-map "A" 'gnus-summary-tick-above)
3859
3860   (define-prefix-command 'gnus-summary-process-map)
3861   (define-key gnus-summary-mark-map "p" 'gnus-summary-process-map)
3862   (define-key gnus-summary-process-map "p" 'gnus-summary-mark-as-processable)
3863   (define-key gnus-summary-process-map "u" 'gnus-summary-unmark-as-processable)
3864   (define-key gnus-summary-process-map "U" 'gnus-summary-unmark-all-processable)
3865   (define-key gnus-summary-process-map "s" 'gnus-uu-mark-by-regexp)
3866   (define-key gnus-summary-process-map "r" 'gnus-uu-mark-region)
3867   (define-key gnus-summary-process-map "t" 'gnus-uu-mark-thread)
3868   (define-key gnus-summary-process-map "a" 'gnus-uu-mark-sparse)
3869   
3870
3871   (define-prefix-command 'gnus-summary-send-map)
3872   (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
3873   (define-key gnus-summary-send-map "p" 'gnus-summary-post-news)
3874   (define-key gnus-summary-send-map "f" 'gnus-summary-followup)
3875   (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original)
3876   (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article)
3877   (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article)
3878   (define-key gnus-summary-send-map "r" 'gnus-summary-reply)
3879   (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
3880   (define-key gnus-summary-send-map "\C-f" 'gnus-summary-mail-forward)
3881   (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
3882   (define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
3883   (define-key gnus-summary-send-map "\M-f" 'gnus-uu-digest-and-forward)
3884
3885   
3886   (define-prefix-command 'gnus-summary-goto-map)
3887   (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map)
3888   (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article)
3889   (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article)
3890   (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article)
3891   (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article)
3892   (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject)
3893   (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject)
3894   (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject)
3895   (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject)
3896   (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article)
3897   (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article)
3898   (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject)
3899   (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article)
3900
3901
3902   (define-prefix-command 'gnus-summary-thread-map)
3903   (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map)
3904   (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread)
3905   (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread)
3906   (define-key gnus-summary-thread-map "r" 'gnus-summary-raise-thread)
3907   (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads)
3908   (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread)
3909   (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread)
3910   (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread)
3911   (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread)
3912   (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread)
3913   (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread)
3914   (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread)
3915
3916   
3917   (define-prefix-command 'gnus-summary-exit-map)
3918   (define-key gnus-summary-mode-map "E" 'gnus-summary-exit-map)
3919   (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit)
3920   (define-key gnus-summary-exit-map "\C-c" 'gnus-summary-catchup-all-and-exit)
3921   (define-key gnus-summary-exit-map "q" 'gnus-summary-exit)
3922   (define-key gnus-summary-exit-map "e" 'gnus-summary-exit)
3923   (define-key gnus-summary-exit-map "Q" 'gnus-summary-quit)
3924   (define-key gnus-summary-exit-map "E" 'gnus-summary-quit)
3925
3926
3927   (define-prefix-command 'gnus-summary-article-map)
3928   (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map)
3929   (define-key gnus-summary-article-map " " 'gnus-summary-next-page)
3930   (define-key gnus-summary-article-map "n" 'gnus-summary-next-page)
3931   (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page)
3932   (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page)
3933   (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up)
3934   (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article)
3935   (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article)
3936   (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article)
3937   (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article)
3938   (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article)
3939   (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article)
3940   (define-key gnus-summary-article-map "w" 'gnus-summary-stop-page-breaking)
3941   (define-key gnus-summary-article-map "c" 'gnus-summary-caesar-message)
3942   (define-key gnus-summary-article-map "g" 'gnus-summary-show-article)
3943   (define-key gnus-summary-article-map "t" 'gnus-summary-toggle-header)
3944   (define-key gnus-summary-article-map "m" 'gnus-summary-toggle-mime)
3945   (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article)
3946
3947
3948   (define-prefix-command 'gnus-summary-extract-map)
3949   (define-key gnus-summary-mode-map "X" 'gnus-summary-extract-map)
3950 ;  (define-key gnus-summary-extract-map "x" 'gnus-summary-extract-any)
3951 ;  (define-key gnus-summary-extract-map "m" 'gnus-summary-extract-mime)
3952 ;  (define-key gnus-summary-extract-map "d" 'gnus-summary-extract-digest)
3953
3954   (define-key gnus-summary-extract-map "u" 'gnus-uu-decode-uu)
3955   (define-key gnus-summary-extract-map "U" 'gnus-uu-decode-uu-and-save)
3956   (define-key gnus-summary-extract-map "s" 'gnus-uu-decode-unshar)
3957   (define-key gnus-summary-extract-map "S" 'gnus-uu-decode-unshar-and-save)
3958   (define-key gnus-summary-extract-map "o" 'gnus-uu-decode-save)
3959   (define-key gnus-summary-extract-map "O" 'gnus-uu-decode-save)
3960   (define-key gnus-summary-extract-map "b" 'gnus-uu-decode-binhex)
3961   (define-key gnus-summary-extract-map "B" 'gnus-uu-decode-binhex)
3962
3963   
3964   (define-prefix-command 'gnus-summary-various-map)
3965   (define-key gnus-summary-mode-map "V" 'gnus-summary-various-map)
3966   (define-key gnus-summary-various-map "u" 'gnus-summary-universal-argument)
3967   (define-key gnus-summary-various-map "\M-s" 'gnus-summary-search-article-forward)
3968   (define-key gnus-summary-various-map "\M-r" 'gnus-summary-search-article-backward)
3969   (define-key gnus-summary-various-map "r" 'gnus-summary-refer-article)
3970   (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command)
3971   (define-key gnus-summary-various-map "\C-t" 'gnus-summary-toggle-truncation)
3972   (define-key gnus-summary-various-map "=" 'gnus-summary-expand-window)
3973   (define-key gnus-summary-various-map "\C-s" 'gnus-summary-reselect-current-group)
3974   (define-key gnus-summary-various-map "g" 'gnus-summary-rescan-group)
3975   (define-key gnus-summary-various-map "o" 'gnus-summary-save-article)
3976   (define-key gnus-summary-various-map "\C-o" 'gnus-summary-save-article-mail)
3977   (define-key gnus-summary-various-map "|" 'gnus-summary-pipe-output)
3978   (define-key gnus-summary-various-map "V" 'gnus-version)
3979   (define-key gnus-summary-various-map "d" 'gnus-summary-describe-group)
3980   (define-key gnus-summary-various-map "?" 'gnus-summary-describe-briefly)
3981   (define-key gnus-summary-various-map "i" 'gnus-info-find-node)
3982   (define-key gnus-summary-various-map "S" 'gnus-summary-set-score)
3983   (define-key gnus-summary-various-map "b" 'gnus-summary-set-mark-below)
3984
3985   (define-prefix-command 'gnus-summary-sort-map)
3986   (define-key gnus-summary-various-map "s" 'gnus-summary-sort-map)
3987   (define-key gnus-summary-sort-map "n" 'gnus-summary-sort-by-number)
3988   (define-key gnus-summary-sort-map "a" 'gnus-summary-sort-by-author)
3989   (define-key gnus-summary-sort-map "s" 'gnus-summary-sort-by-subject)
3990   (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date)
3991   (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score)
3992
3993   (define-prefix-command 'gnus-summary-mgroup-map)
3994   (define-key gnus-summary-various-map "m" 'gnus-summary-mgroup-map)
3995   (define-key gnus-summary-mgroup-map "e" 'gnus-summary-expire-articles)
3996   (define-key gnus-summary-mgroup-map "\177" 'gnus-summary-delete-article)
3997   (define-key gnus-summary-mgroup-map "m" 'gnus-summary-move-article)
3998   (define-key gnus-summary-mgroup-map "r" 'gnus-summary-respool-article)
3999
4000   (define-prefix-command 'gnus-summary-vkill-map)
4001   (define-key gnus-summary-various-map "k" 'gnus-summary-vkill-map)
4002   (define-key gnus-summary-vkill-map "k" 'gnus-summary-kill-same-subject-and-select)
4003   (define-key gnus-summary-vkill-map "K" 'gnus-summary-kill-same-subject)
4004   (define-key gnus-summary-vkill-map "\M-k" 'gnus-summary-edit-local-kill)
4005   (define-key gnus-summary-vkill-map "\M-K" 'gnus-summary-edit-global-kill)
4006   (define-key gnus-summary-vkill-map "x" 'gnus-kill-file-set-expunge-below)
4007   (define-key gnus-summary-vkill-map "m" 'gnus-kill-file-set-mark-below)
4008
4009
4010
4011   (define-prefix-command 'gnus-summary-increase-map)
4012   (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-map)
4013   (define-key gnus-summary-increase-map "i" 'gnus-summary-raise-same-subject-and-select)
4014   (define-key gnus-summary-increase-map "I" 'gnus-summary-raise-same-subject)
4015   (define-key gnus-summary-increase-map "\C-i" 'gnus-summary-raise-score)
4016
4017   (define-prefix-command 'gnus-summary-inc-subject-map)
4018   (define-key gnus-summary-increase-map "s" 'gnus-summary-inc-subject-map)
4019   (define-key gnus-summary-increase-map "S" 'gnus-summary-temporarily-raise-by-subject)
4020   (define-key gnus-summary-inc-subject-map "s" 'gnus-summary-temporarily-raise-by-subject)
4021   (define-key gnus-summary-inc-subject-map "S" 'gnus-summary-raise-by-subject)
4022   (define-key gnus-summary-inc-subject-map "t" 'gnus-summary-temporarily-raise-by-subject)
4023   (define-key gnus-summary-inc-subject-map "p" 'gnus-summary-raise-by-subject)
4024
4025   (define-prefix-command 'gnus-summary-inc-author-map)
4026   (define-key gnus-summary-increase-map "a" 'gnus-summary-inc-author-map)
4027   (define-key gnus-summary-increase-map "A" 'gnus-summary-temporarily-raise-by-author)
4028   (define-key gnus-summary-inc-author-map "a" 'gnus-summary-temporarily-raise-by-author)
4029   (define-key gnus-summary-inc-author-map "A" 'gnus-summary-raise-by-author)
4030   (define-key gnus-summary-inc-author-map "t" 'gnus-summary-temporarily-raise-by-author)
4031   (define-key gnus-summary-inc-author-map "p" 'gnus-summary-raise-by-author)
4032
4033   (define-prefix-command 'gnus-summary-inc-thread-map)
4034   (define-key gnus-summary-increase-map "t" 'gnus-summary-inc-thread-map)
4035   (define-key gnus-summary-increase-map "T" 'gnus-summary-temporarily-raise-by-thread)
4036   (define-key gnus-summary-inc-thread-map "t" 'gnus-summary-temporarily-raise-by-thread)
4037   (define-key gnus-summary-inc-thread-map "T" 'gnus-summary-raise-by-thread)
4038   (define-key gnus-summary-inc-thread-map "t" 'gnus-summary-temporarily-raise-by-thread)
4039   (define-key gnus-summary-inc-thread-map "p" 'gnus-summary-raise-by-thread)
4040
4041   (define-prefix-command 'gnus-summary-inc-xref-map)
4042   (define-key gnus-summary-increase-map "x" 'gnus-summary-inc-xref-map)
4043   (define-key gnus-summary-increase-map "X" 'gnus-summary-temporarily-raise-by-xref)
4044   (define-key gnus-summary-inc-xref-map "x" 'gnus-summary-temporarily-raise-by-xref)
4045   (define-key gnus-summary-inc-xref-map "X" 'gnus-summary-raise-by-xref)
4046   (define-key gnus-summary-inc-xref-map "t" 'gnus-summary-temporarily-raise-by-xref)
4047   (define-key gnus-summary-inc-xref-map "p" 'gnus-summary-raise-by-xref)
4048
4049   (define-prefix-command 'gnus-summary-inc-fol-map)
4050   (define-key gnus-summary-increase-map "f" 'gnus-summary-inc-fol-map)
4051   (define-key gnus-summary-increase-map "F" 'gnus-summary-temporarily-raise-followups-to-author)
4052   (define-key gnus-summary-inc-fol-map "f" 'gnus-summary-temporarily-raise-followups-to-author)
4053   (define-key gnus-summary-inc-fol-map "F" 'gnus-summary-raise-followups-to-author)
4054   (define-key gnus-summary-inc-fol-map "t" 'gnus-summary-temporarily-raise-followups-to-author)
4055   (define-key gnus-summary-inc-fol-map "p" 'gnus-summary-raise-followups-to-author)
4056
4057   (define-prefix-command 'gnus-summary-lower-map)
4058   (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-map)
4059   (define-key gnus-summary-lower-map "l" 'gnus-summary-lower-same-subject-and-select)
4060   (define-key gnus-summary-lower-map "L" 'gnus-summary-lower-same-subject)
4061   (define-key gnus-summary-lower-map "\C-l" 'gnus-summary-lower-score)
4062
4063   (define-prefix-command 'gnus-summary-low-subject-map)
4064   (define-key gnus-summary-lower-map "s" 'gnus-summary-low-subject-map)
4065   (define-key gnus-summary-lower-map "S" 'gnus-summary-temporarily-lower-by-subject)
4066   (define-key gnus-summary-low-subject-map "s" 'gnus-summary-temporarily-lower-by-subject)
4067   (define-key gnus-summary-low-subject-map "S" 'gnus-summary-lower-by-subject)
4068   (define-key gnus-summary-low-subject-map "t" 'gnus-summary-temporarily-lower-by-subject)
4069   (define-key gnus-summary-low-subject-map "p" 'gnus-summary-lower-by-subject)
4070
4071   (define-prefix-command 'gnus-summary-low-author-map)
4072   (define-key gnus-summary-lower-map "a" 'gnus-summary-low-author-map)
4073   (define-key gnus-summary-lower-map "A" 'gnus-summary-temporarily-lower-by-author)
4074   (define-key gnus-summary-low-author-map "a" 'gnus-summary-temporarily-lower-by-author)
4075   (define-key gnus-summary-low-author-map "A" 'gnus-summary-lower-by-author)
4076   (define-key gnus-summary-low-author-map "t" 'gnus-summary-temporarily-lower-by-author)
4077   (define-key gnus-summary-low-author-map "p" 'gnus-summary-lower-by-author)
4078
4079   (define-prefix-command 'gnus-summary-low-thread-map)
4080   (define-key gnus-summary-lower-map "t" 'gnus-summary-low-thread-map)
4081   (define-key gnus-summary-lower-map "T" 'gnus-summary-temporarily-lower-by-thread)
4082   (define-key gnus-summary-low-thread-map "t" 'gnus-summary-temporarily-lower-by-thread)
4083   (define-key gnus-summary-low-thread-map "T" 'gnus-summary-lower-by-thread)
4084   (define-key gnus-summary-low-thread-map "t" 'gnus-summary-temporarily-lower-by-thread)
4085   (define-key gnus-summary-low-thread-map "p" 'gnus-summary-lower-by-thread)
4086
4087   (define-prefix-command 'gnus-summary-low-xref-map)
4088   (define-key gnus-summary-lower-map "x" 'gnus-summary-low-xref-map)
4089   (define-key gnus-summary-lower-map "X" 'gnus-summary-temporarily-lower-by-xref)
4090   (define-key gnus-summary-low-xref-map "x" 'gnus-summary-temporarily-lower-by-xref)
4091   (define-key gnus-summary-low-xref-map "X" 'gnus-summary-lower-by-xref)
4092   (define-key gnus-summary-low-xref-map "t" 'gnus-summary-temporarily-lower-by-xref)
4093   (define-key gnus-summary-low-xref-map "p" 'gnus-summary-lower-by-xref)
4094
4095   (define-prefix-command 'gnus-summary-low-fol-map)
4096   (define-key gnus-summary-lower-map "f" 'gnus-summary-low-fol-map)
4097   (define-key gnus-summary-lower-map "F" 'gnus-summary-temporarily-lower-followups-to-author)
4098   (define-key gnus-summary-low-fol-map "f" 'gnus-summary-temporarily-lower-followups-to-author)
4099   (define-key gnus-summary-low-fol-map "F" 'gnus-summary-lower-followups-to-author)
4100   (define-key gnus-summary-low-fol-map "t" 'gnus-summary-temporarily-lower-followups-to-author)
4101   (define-key gnus-summary-low-fol-map "p" 'gnus-summary-lower-followups-to-author)
4102
4103   (if gnus-visual (gnus-summary-make-menu-bar)))
4104
4105
4106 \f
4107
4108 (defun gnus-summary-mode ()
4109   "Major mode for reading articles in this newsgroup.
4110 All normal editing commands are switched off.
4111 The following commands are available:
4112
4113 \\<gnus-summary-mode-map>
4114 \\[gnus-summary-next-page]\t Scroll the article buffer a page forwards
4115 \\[gnus-summary-prev-page]\t Scroll the article buffer a page backwards
4116 \\[gnus-summary-scroll-up]\t Scroll the article buffer one line forwards
4117 \\[gnus-summary-next-unread-article]\t Go to the next unread article
4118 \\[gnus-summary-prev-unread-article]\t Go to the previous unread article
4119 \\[gnus-summary-next-article]\t Go to the next article
4120 \\[gnus-summary-prev-article]\t Go to the previous article
4121 \\[gnus-summary-next-same-subject]\t Go to the next summary line with the same subject
4122 \\[gnus-summary-prev-same-subject]\t Go to the previous summary line with the same subject
4123 \\[gnus-summary-next-digest]\t Go to the next digest
4124 \\[gnus-summary-prev-digest]\t Go to the previous digest
4125 \\[gnus-summary-next-subject]\t Go to the next summary line
4126 \\[gnus-summary-prev-subject]\t Go to the previous summary line
4127 \\[gnus-summary-next-unread-subject]\t Go to the next unread summary line
4128 \\[gnus-summary-prev-unread-subject]\t Go to the previous unread summary line
4129 \\[gnus-summary-first-unread-article]\t Go to the first unread article
4130 \\[gnus-summary-best-unread-article]\t Go to the unread article with the highest score
4131 \\[gnus-summary-goto-subject]\t Go to some subject
4132 \\[gnus-summary-goto-last-article]\t Go to the previous article
4133
4134 \\[gnus-summary-beginning-of-article]\t Go to the beginning of the article
4135 \\[gnus-summary-end-of-article]\t Go to the end of the article
4136
4137 \\[gnus-summary-refer-parent-article]\t Get the parent of the current article from the server
4138 \\[gnus-summary-refer-article]\t Request some article by Message-ID from the server
4139
4140 \\[gnus-summary-isearch-article]\t Do an interactive search on the current article
4141 \\[gnus-summary-search-article-forward]\t Search all articles forward for a regular expression
4142 \\[gnus-summary-search-article-backward]\t Search all articles backward for a regular expression
4143
4144 \\[gnus-summary-tick-article-forward]\t Tick current article and move forward
4145 \\[gnus-summary-tick-article-backward]\t Tick current article and move backward
4146 \\[gnus-summary-mark-as-read-forward]\t Mark the current article as read and move forward
4147 \\[gnus-summary-mark-as-read-backward]\t Mark the current article as read and move backward
4148 \\[gnus-summary-clear-mark-forward]\t Clear tick and read marks and move forward
4149 \\[gnus-summary-clear-mark-backward]\t Clear tick and read marks and move backward
4150 \\[gnus-summary-mark-as-processable]\t Set the process mark on the current article
4151 \\[gnus-summary-unmark-as-processable]\t Remove the process mark from the current article
4152 \\[gnus-summary-unmark-all-processable]\t Remove the process mark from all articles
4153
4154 \\[gnus-summary-raise-same-subject-and-select]\t Raise all articles with the current subject and select the next article
4155 \\[gnus-summary-raise-same-subject]\t Raise all articles with the current subject
4156 \\[gnus-summary-lower-same-subject-and-select]\t Lower all articles with the current subject and select the next article
4157 \\[gnus-summary-lower-same-subject]\t Lower all articles with the current subject
4158
4159 \\[gnus-summary-toggle-threads]\t Toggle thread display
4160 \\[gnus-summary-show-thread]\t Show the current thread
4161 \\[gnus-summary-hide-thread]\t Hide the current thread
4162 \\[gnus-summary-next-thread]\t Go to the next thread
4163 \\[gnus-summary-prev-thread]\t Go to the previous thread
4164 \\[gnus-summary-up-thread]\t Go up the current thread
4165 \\[gnus-summary-down-thread]\t Descend the current thread
4166 \\[gnus-summary-raise-thread]\t Raise the current thread
4167 \\[gnus-summary-lower-thread]\t Lower the current thread
4168 \\[gnus-summary-mark-as-expirable]\t Mark the current artivles as expirable
4169 \\[gnus-summary-remove-lines-marked-as-read]\t Remove all articles that are marked as read
4170 \\[gnus-summary-remove-lines-marked-with]\t Remove all articles that have some mark
4171
4172 \\[gnus-summary-execute-command]\t Execute a command
4173 \\[gnus-summary-catchup-and-exit]\t Mark all unread articles as read and exit
4174 \\[gnus-summary-toggle-truncation]\t Toggle truncation of summary lines
4175 \\[gnus-summary-expand-window]\t Expand the summary window
4176 \\[gnus-summary-universal-argument]\t Run a command on all articles with the process mark
4177
4178 \\[gnus-summary-sort-by-number]\t Sort the summary buffer by article number
4179 \\[gnus-summary-sort-by-author]\t Sort the summary buffer by author
4180 \\[gnus-summary-sort-by-subject]\t Sort the summary buffer by subject
4181 \\[gnus-summary-sort-by-date]\t Sort the summary buffer by date
4182
4183 \\[gnus-summary-reselect-current-group]\t Exit and reselect the current group
4184 \\[gnus-summary-rescan-group]\t Exit, get new articles and reselect the group
4185 \\[gnus-summary-stop-page-breaking]\t Stop page breaking of the current article
4186 \\[gnus-summary-caesar-message]\t Caesar rotate (rot13) the current article
4187 \\[gnus-summary-show-article]\t Reselect the current article
4188 \\[gnus-summary-toggle-header]\t Toggle header display
4189 \\[gnus-summary-toggle-mime]\t Toggle whether to use MIME
4190 \\[gnus-summary-rmail-digest]\t Use rmail digest
4191 \\[gnus-summary-post-news]\t Post an article to the current group
4192 \\[gnus-summary-followup]\t Post a followup to the current article
4193 \\[gnus-summary-followup-with-original]\t Post a followup and include the original article
4194 \\[gnus-summary-cancel-article]\t Cancel the current article
4195 \\[gnus-summary-supersede-article]\t Supersede the current article
4196 \\[gnus-summary-reply]\t Mail a reply to the author of the current article
4197 \\[gnus-summary-reply-with-original]\t Mail a reply and include the current article
4198 \\[gnus-summary-mail-forward]\t Forward the current article
4199 \\[gnus-summary-mail-other-window]\t Mail in the other window
4200 \\[gnus-summary-save-article]\t Save the current article
4201 \\[gnus-summary-save-article-mail]\t Save the current article in rmail format
4202 \\[gnus-summary-pipe-output]\t Pipe the current article to a process
4203 \\[gnus-summary-move-article]\t Move the article to a different newsgroup
4204 \\[gnus-summary-respool-article]\t Respool the article
4205 \\[gnus-summary-edit-local-kill]\t Edit the local kill file
4206 \\[gnus-summary-edit-global-kill]\t Edit the global kill file
4207 \\[gnus-version]\t Display the current Gnus version
4208 \\[gnus-summary-exit]\t Exit the summary buffer 
4209 \\[gnus-summary-quit]\t Exit the summary buffer without saving any changes
4210 \\[gnus-summary-describe-group]\t Describe the current newsgroup
4211 \\[gnus-summary-describe-briefly]\t Give a brief key overview
4212 \\[gnus-info-find-node]\t Go to the Gnus info node
4213
4214 \\[gnus-kill-file-set-expunge-below]    Automatically expunge articles below LEVEL.
4215
4216 \\[gnus-kill-file-set-mark-below]       Automatically mark articles below LEVEL.
4217 \\[gnus-summary-temporarily-raise-by-subject]\t Temporarily raise score for articles with the current subject
4218 \\[gnus-summary-temporarily-raise-by-author]\t Temporarily raise score for articles from the current author
4219 \\[gnus-summary-temporarily-raise-by-xref]\t Temporarily raise score for articles with the current cross-posting
4220 \\[gnus-summary-raise-by-subject]\t Permanently raise score for articles with the current subject
4221 \\[gnus-summary-raise-by-author]\t Permanently raise score for articles from the current author
4222 \\[gnus-summary-raise-followups-to-author]\t Permanently raise score for followups to the current author
4223 \\[gnus-summary-raise-by-xref]\t Permanently raise score for articles with the current cross-posting
4224 \\[gnus-summary-temporarily-lower-by-subject]\t Temporarily lower score for articles with the current subject
4225 \\[gnus-summary-temporarily-lower-by-author]\t Temporarily lower score for articles from the current author
4226 \\[gnus-summary-temporarily-lower-by-xref]\t Temporarily lower score for articles with the current cross-posting
4227 \\[gnus-summary-lower-by-subject]\t Permanently lower score for articles with the current subject
4228 \\[gnus-summary-lower-by-author]\t Permanently lower score for articles from the current author
4229 \\[gnus-summary-lower-followups-to-author]\t Permanently lower score for followups to the current author
4230 \\[gnus-summary-lower-by-thread]\t Permanently lower score for articles in the current thread
4231 \\[gnus-summary-lower-by-xref]\t Permanently lower score for articles with the current cross-posting
4232 "
4233   (interactive)
4234   (kill-all-local-variables)
4235   (let ((locals gnus-summary-local-variables))
4236     (while locals
4237       (if (consp (car locals))
4238           (progn
4239             (make-local-variable (car (car locals)))
4240             (set (car (car locals)) (eval (cdr (car locals)))))
4241         (make-local-variable (car locals))
4242         (set (car locals) nil))
4243       (setq locals (cdr locals))))
4244   (gnus-update-format-specifications)
4245   (setq mode-line-modified "-- ")
4246   (make-local-variable 'mode-line-format)
4247   (setq mode-line-format (copy-sequence mode-line-format))
4248   (and (equal (nth 3 mode-line-format) "   ")
4249        (setcar (nthcdr 3 mode-line-format) ""))
4250   (setq major-mode 'gnus-summary-mode)
4251   (setq mode-name "Summary")
4252   (make-local-variable 'minor-mode-alist)
4253 ;  (or (assq 'gnus-show-threads minor-mode-alist)
4254 ;      (setq minor-mode-alist
4255 ;           (cons (list 'gnus-show-threads " Thread") minor-mode-alist)))
4256   (gnus-set-mode-line 'summary)
4257   (use-local-map gnus-summary-mode-map)
4258   (buffer-disable-undo (current-buffer))
4259   (setq buffer-read-only t)             ;Disable modification
4260   (setq truncate-lines t)
4261   (setq selective-display t)
4262   (setq selective-display-ellipses t)   ;Display `...'
4263   (run-hooks 'gnus-summary-mode-hook))
4264
4265 (defun gnus-mouse-pick-article (e)
4266   (interactive "e")
4267   (mouse-set-point e)
4268   (gnus-summary-next-page nil t))
4269
4270 (defun gnus-summary-setup-buffer (group)
4271   "Initialize summary buffer."
4272   (let ((buffer (concat "*Summary " group "*")))
4273     ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
4274     (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
4275     (gnus-add-current-to-buffer-list)
4276     (gnus-summary-mode)))
4277
4278 (defun gnus-set-global-variables ()
4279   ;; Set the global equivalents of the summary buffer-local variables
4280   ;; to the latest values they had. These reflect the summary buffer
4281   ;; that was in action when the last article was fetched.
4282   (let ((name gnus-newsgroup-name)
4283         (marked gnus-newsgroup-marked)
4284         (unread gnus-newsgroup-unreads)
4285         (headers gnus-current-headers))
4286     (save-excursion
4287       (set-buffer gnus-group-buffer)
4288       (setq gnus-newsgroup-name name)
4289       (setq gnus-newsgroup-marked marked)
4290       (setq gnus-newsgroup-unreads unread)
4291       (setq gnus-current-headers headers))))
4292
4293 (defun gnus-summary-insert-dummy-line (sformat subject number)
4294   (if (not sformat) 
4295       (setq sformat gnus-summary-dummy-line-format-spec))
4296   (let (b)
4297     (beginning-of-line)
4298     (setq b (point))
4299     (insert (eval sformat))
4300     (add-text-properties
4301      b (1+ b)
4302      (list 'gnus-subject (gnus-simplify-subject-re subject)
4303            'gnus-number number
4304            'gnus-mark ?Z
4305            'gnus-thread 0))))
4306
4307 (defun gnus-summary-insert-line 
4308   (sformat header level current unread replied expirable subject-or-nil
4309            &optional dummy score)
4310   (if (not sformat) 
4311       (setq sformat gnus-summary-line-format-spec))
4312   (let* ((indentation 
4313           (make-string (* level gnus-thread-indent-level) ? ))
4314          (lines (or (header-lines header) 0))
4315          (score (or score gnus-summary-default-score 0))
4316          (score-char (if (= score gnus-summary-default-score) ? 
4317                        (if (< score gnus-summary-default-score) ?- ?+)))
4318          (replied (if replied gnus-replied-mark ? ))
4319          (from (header-from header))
4320          (name-address (gnus-extract-address-components from))
4321          (address (car (cdr name-address)))
4322          (name (or (car name-address) (car (cdr name-address))))
4323          (number (header-number header))
4324          (subject (header-subject header))
4325          (buffer-read-only nil)
4326          (opening-bracket (if dummy ?\< ?\[))
4327          (closing-bracket (if dummy ?\> ?\]))
4328          b)
4329     ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
4330     (if (not (numberp lines)) (setq lines 0))
4331     (beginning-of-line)
4332     (setq b (point))
4333     (insert-before-markers (eval sformat))
4334     (add-text-properties
4335      b (1+ b)
4336      (list 'gnus-subject (gnus-simplify-subject-re subject)
4337            'gnus-number number
4338            'gnus-mark unread
4339            'gnus-thread level))))
4340
4341 (defun gnus-summary-update-line ()
4342   ;; Update summary line after change.
4343   (or (not gnus-summary-default-score)
4344       gnus-summary-inhibit-highlight
4345       (save-excursion
4346         (beginning-of-line 1)
4347         (let ((score (gnus-summary-article-score))
4348               (default gnus-summary-default-score)
4349               (below gnus-summary-mark-below))
4350           (save-excursion
4351             (if (< score below)
4352                 (if (eq (following-char) gnus-unread-mark)
4353                     (gnus-summary-mark-article nil gnus-low-score-mark))
4354               (if (eq (following-char) gnus-low-score-mark)
4355                   (gnus-summary-mark-article nil gnus-unread-mark))))
4356           (if  gnus-visual
4357               (run-hooks 'gnus-visual-summary-update-hook))))))
4358
4359 (defun gnus-summary-update-lines ()
4360   ;; Rehighlight summary buffer according to `gnus-summary-highlight'.
4361   (if (and gnus-visual gnus-visual-summary-update-hook)
4362       (save-excursion
4363         (set-buffer gnus-summary-buffer)
4364         (goto-char (point-min))
4365         (while (not (eobp))
4366           (gnus-summary-update-line)
4367           (forward-line 1)))))
4368
4369 (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer)
4370   "Start reading news in newsgroup GROUP.
4371 If SHOW-ALL is non-nil, already read articles are also listed.
4372 If NO-ARTICLE is non-nil, no article is selected initially."
4373   (message "Retrieving newsgroup: %s..." group)
4374   (gnus-summary-setup-buffer group)
4375   (if (gnus-select-newsgroup group show-all)
4376       (progn
4377         ;; You can change the subjects in this hook.
4378         (run-hooks 'gnus-select-group-hook)
4379         ;; Do Score Processing.
4380         (gnus-score-headers)
4381         ;; Update the format specifiers.
4382         (gnus-update-format-specifications)
4383         (gnus-summary-prepare)
4384         (if (and (zerop (buffer-size))
4385                  gnus-newsgroup-dormant)
4386             (gnus-summary-show-all-dormant))
4387         (gnus-set-global-variables)
4388         ;; Function `gnus-apply-kill-file' must be called in this hook.
4389         (run-hooks 'gnus-apply-kill-hook)
4390         (if (zerop (buffer-size))
4391             (progn
4392               ;; This newsgroup is empty.
4393               (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
4394               (message "No unread news"))
4395           ;; Hide conversation thread subtrees.  We cannot do this in
4396           ;; gnus-summary-prepare-hook since kill processing may not
4397           ;; work with hidden articles.
4398           (and gnus-show-threads
4399                gnus-thread-hide-subtree
4400                (gnus-summary-hide-all-threads))
4401           ;; Show first unread article if requested.
4402           (goto-char (point-min))
4403           (if (and (not no-article)
4404                    gnus-auto-select-first
4405                    (gnus-summary-first-unread-article))
4406               ;; Window is configured automatically.
4407               ;; Current buffer may be changed as a result of hook
4408               ;; evaluation, especially by gnus-summary-rmail-digest
4409               ;; command, so we should adjust cursor point carefully.
4410               (if (eq major-mode 'gnus-summary-mode)
4411                   (gnus-summary-position-cursor))
4412             (gnus-configure-windows 'summary)
4413             (pop-to-buffer gnus-summary-buffer)
4414             (gnus-set-mode-line 'summary)
4415             (gnus-summary-position-cursor))
4416           (if (and kill-buffer
4417                    (get-buffer kill-buffer)
4418                    (buffer-name (get-buffer kill-buffer)))
4419               (kill-buffer kill-buffer))))
4420     ;; Cannot select newsgroup GROUP.
4421     (message "Couldn't select newsgroup")
4422     (and (eq major-mode 'gnus-summary-mode)
4423          (kill-buffer (current-buffer)))
4424     (set-buffer gnus-group-buffer)
4425     (gnus-summary-position-cursor)))
4426
4427 (defun gnus-summary-prepare ()
4428   "Prepare summary list of current newsgroup in summary buffer."
4429   (let ((buffer-read-only nil))
4430     (erase-buffer)
4431     (gnus-summary-prepare-threads 
4432      (if gnus-show-threads
4433          (gnus-gather-threads (gnus-sort-threads (gnus-make-threads)))
4434        gnus-newsgroup-headers)
4435      0)
4436     (gnus-summary-remove-dormant-lines)
4437     ;; Erase header retrieval message.
4438     (message "")
4439     ;; Call hooks for modifying summary buffer.
4440     ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
4441     (goto-char (point-min))
4442     (run-hooks 'gnus-summary-prepare-hook)))
4443
4444 (defun gnus-summary-remove-dormant-lines ()
4445   (let ((int gnus-newsgroup-dormant)
4446         (buffer-read-only nil)
4447         beg cur-level)
4448     (while int
4449       (if (gnus-summary-goto-subject (car int))
4450           (progn
4451             (beginning-of-line)
4452             (setq cur-level (gnus-summary-thread-level))
4453             (setq beg (point))
4454             (re-search-forward "[\n\r]")
4455             (if (<= (gnus-summary-thread-level) cur-level)
4456                 ;; If the level of the next article is greater than the
4457                 ;; level of this article, then it has to be the child of this
4458                 ;; article, so we do not delete this article.
4459                 (progn
4460                   (setq gnus-newsgroup-dormant-subjects
4461                         (cons (cons (car int) (buffer-substring beg (point)))
4462                               gnus-newsgroup-dormant-subjects))
4463                   (delete-region beg (point))))))
4464       (setq int (cdr int)))))
4465
4466 (defun gnus-gather-threads (threads)
4467   "Gather threads that have lost their roots."
4468   (if (not gnus-summary-make-false-root)
4469       threads 
4470     (let ((hashtb (gnus-make-hashtable 1023))
4471           (prev threads)
4472           (result threads)
4473           thread subject hthread unre-subject)
4474       (while threads
4475         (setq subject (header-subject (car (car threads))))
4476         (and gnus-summary-gather-subject-limit
4477              (> (length subject) gnus-summary-gather-subject-limit)
4478              (setq subject
4479                    (substring subject 0 gnus-summary-gather-subject-limit)))
4480         (if (setq hthread 
4481                   (gnus-gethash 
4482                    (setq unre-subject (gnus-simplify-subject-re subject))
4483                    hashtb))
4484             (progn
4485               (or (stringp (car (car hthread)))
4486                   (setcar hthread (list subject (car hthread))))
4487               (setcdr (car hthread) (nconc (cdr (car hthread)) 
4488                                            (list (car threads))))
4489               (setcdr prev (cdr threads))
4490               (setq threads prev))
4491           (gnus-sethash unre-subject threads hashtb))
4492         (setq prev threads)
4493         (setq threads (cdr threads)))
4494       result)))
4495
4496 (defun gnus-make-threads ()
4497   ;; This function takes the dependencies already made by 
4498   ;; `gnus-get-newsgroup-headers' and builds the trees. First we go
4499   ;; through the dependecies in the hash table and finds all the
4500   ;; roots. Roots do not refer back to any valid articles.
4501   (let (roots)
4502     (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
4503          (gnus-build-old-threads))
4504     (mapatoms
4505      (lambda (refs)
4506        (if (not (car (symbol-value refs)))
4507            (setq roots (append (cdr (symbol-value refs)) roots))
4508          ;; Ok, these refer back to valid articles, but if
4509          ;; `gnus-thread-ignore-subject' is nil, we have to check that
4510          ;; the root has the same subject as its children. The children
4511          ;; that do not are made into roots and removed from the list
4512          ;; of children. 
4513          (or gnus-thread-ignore-subject
4514              (let* ((prev (symbol-value refs))
4515                     (subject (gnus-simplify-subject-re 
4516                               (header-subject (car prev))))
4517                     (headers (cdr prev)))
4518                (while headers
4519                  (if (not (string= subject
4520                                    (gnus-simplify-subject-re 
4521                                     (header-subject (car headers)))))
4522                      (progn
4523                        (setq roots (cons (car headers) roots))
4524                        (setcdr prev (cdr headers)))
4525                    (setq prev headers))
4526                  (setq headers (cdr headers)))))))
4527      gnus-newsgroup-dependencies)
4528
4529     (mapcar (lambda (root) (gnus-trim-thread (gnus-make-sub-thread root)))
4530             roots)))
4531
4532 (defun gnus-trim-thread (thread)
4533   (if (and (eq gnus-fetch-old-headers 'some)
4534            (memq (header-number (car thread)) gnus-newsgroup-ancient)
4535            (= (length thread) 2))
4536       (gnus-trim-thread (nth 1 thread))
4537     thread))
4538
4539 (defun gnus-make-sub-thread (root)
4540   ;; This function makes a sub-tree for a node in the tree.
4541   (let ((children (reverse (cdr (gnus-gethash (downcase (header-id root))
4542                                               gnus-newsgroup-dependencies)))))
4543     (cons root (mapcar 'gnus-make-sub-thread children))))
4544
4545 (defun gnus-build-old-threads ()
4546   ;; Look at all the articles that refer back to old articles, and
4547   ;; fetch the headers for the articles that aren't there. This will
4548   ;; build complete threads - if the roots haven't been expired by the
4549   ;; server, that is.
4550   (let (id heads)
4551     (mapatoms
4552      (lambda (refs)
4553        (if (not (car (symbol-value refs)))
4554            (progn
4555              (setq heads (cdr (symbol-value refs)))
4556              (while heads
4557                (if (not (memq (header-number (car heads))
4558                               gnus-newsgroup-dormant))
4559                    (progn
4560                      (setq id (symbol-name refs))
4561                      (while (and (setq id (gnus-build-get-header id))
4562                                  (not (car (gnus-gethash 
4563                                             id gnus-newsgroup-dependencies)))))
4564                      (setq heads nil))
4565                  (setq heads (cdr heads)))))))
4566      gnus-newsgroup-dependencies)))
4567
4568 (defun gnus-build-get-header (id)
4569   ;; Look through the buffer of NOV lines and find the header to
4570   ;; ID. Enter this line into the dependencies hash table, and return
4571   ;; the id of the parent article (if any).
4572   (let ((deps gnus-newsgroup-dependencies)
4573         found header)
4574     (prog1
4575         (save-excursion
4576           (set-buffer nntp-server-buffer)
4577           (goto-char (point-min))
4578           (while (and (not found) (search-forward id nil t))
4579             (beginning-of-line)
4580             (setq found (looking-at (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
4581                                             (regexp-quote id))))
4582             (or found (beginning-of-line 2)))
4583           (if found
4584               (let (ref)
4585                 (beginning-of-line)
4586                 (and
4587                  (setq header (gnus-nov-parse-line 
4588                                (read (current-buffer)) deps))
4589                  (setq ref (header-references header))
4590                  (string-match "\\(<[^>]+>\\) *$" ref)
4591                  (substring ref (match-beginning 1) (match-end 1))))))
4592       (and header
4593            (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers)
4594                  gnus-newsgroup-ancient (cons (header-number header)
4595                                               gnus-newsgroup-ancient))))))
4596
4597 (defun gnus-sort-threads (threads)
4598   ;; Sort threads as specified in `gnus-thread-sort-functions'.
4599   (let ((fun gnus-thread-sort-functions))
4600     (while fun
4601       (setq threads (sort threads (car fun))
4602             fun (cdr fun))))
4603   threads)
4604
4605 (defun gnus-thread-header (thread)
4606   ;; Return header of first article in THREAD.
4607   (if (consp thread)
4608       (if (stringp (car thread))
4609           (car (car (cdr thread)))
4610         (car thread))
4611     thread))
4612
4613 (defun gnus-thread-sort-by-number (h1 h2)
4614   "Sort threads by root article number."
4615   (let ((h1 (gnus-thread-header h1))
4616         (h2 (gnus-thread-header h2)))
4617     (< (header-number h1) (header-number h2))))
4618
4619 (defun gnus-thread-sort-by-author (h1 h2)
4620   "Sort threads by root author."
4621   (let ((h1 (gnus-thread-header h1))
4622         (h2 (gnus-thread-header h2)))
4623     (string-lessp
4624      (let ((extract (gnus-extract-address-components (header-from h1))))
4625        (or (car extract) (cdr extract)))
4626      (let ((extract (gnus-extract-address-components (header-from h2))))
4627        (or (car extract) (cdr extract))))))
4628
4629 (defun gnus-thread-sort-by-subject (h1 h2)
4630   "Sort threads by root subject."
4631   (let ((h1 (gnus-thread-header h1))
4632         (h2 (gnus-thread-header h2)))
4633     (string-lessp
4634      (downcase (gnus-simplify-subject (header-subject h1)))
4635      (downcase (gnus-simplify-subject (header-subject h2))))))
4636
4637 (defun gnus-thread-sort-by-date (h1 h2)
4638   "Sort threads by root article date."
4639   (let ((h1 (gnus-thread-header h1))
4640         (h2 (gnus-thread-header h2)))
4641     (string-lessp
4642      (gnus-sortable-date (header-date h1))
4643      (gnus-sortable-date (header-date h2)))))
4644
4645 (defun gnus-thread-sort-by-score (h1 h2)
4646   "Sort threads by root article score.
4647 Unscored articles will be counted as havin a score of zero."
4648   (let ((h1 (gnus-thread-header h1))
4649         (h2 (gnus-thread-header h2)))
4650     (let ((s1 (assq (header-number h1) gnus-newsgroup-scored))
4651           (s2 (assq (header-number h2) gnus-newsgroup-scored)))
4652       (> (or (cdr s1) gnus-summary-default-score 0)
4653          (or (cdr s2) gnus-summary-default-score 0)))))
4654
4655 (defun gnus-thread-sort-by-total-score (h1 h2)
4656   "Sort threads by the sum of all scores in the thread.
4657 Unscored articles will be counted as havin a score of zero."
4658   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
4659
4660 (defun gnus-thread-total-score (thread)
4661   ;;  This function find the total score of  THREAD.
4662   (if (consp thread)
4663       (if (stringp (car thread))
4664           (apply gnus-thread-score-function 0
4665                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
4666         (gnus-thread-total-score-1 thread))
4667     (gnus-thread-total-score-1 (list thread))))
4668
4669 (defun gnus-thread-total-score-1 (root)
4670   ;; This function find the total score of the thread below ROOT.
4671   (setq root (car root))
4672   (apply gnus-thread-score-function
4673          (or (cdr (assq (header-number root) gnus-newsgroup-scored))
4674              gnus-summary-default-score 0)
4675          (mapcar 'gnus-thread-total-score
4676                  (cdr (gnus-gethash (downcase (header-id root))
4677                                     gnus-newsgroup-dependencies)))))
4678
4679 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
4680 (defvar gnus-tmp-prev-subject "")
4681 (defvar gnus-tmp-prev-dormant nil)
4682
4683 ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>.
4684 (defun gnus-summary-prepare-threads 
4685   (threads level &optional not-child no-subject)
4686   "Prepare summary buffer from THREADS and indentation LEVEL.  
4687 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'  
4688 or a straight list of headers."
4689   (let (thread header number subject clevel)
4690     (while threads
4691       (setq thread (car threads)
4692             threads (cdr threads))
4693       ;; If `thread' is a cons, hierarchical threads are used.  If not,
4694       ;; `thread' is the header.
4695       (if (consp thread)
4696           (setq header (car thread))
4697         (setq header thread))
4698       (if (stringp header)
4699           ;; The header is a dummy root.
4700           (progn
4701             (cond ((eq gnus-summary-make-false-root 'adopt)
4702                    ;; We let the first article adopt the rest.
4703                    (gnus-summary-prepare-threads (list (car (cdr thread))) 0)
4704                    (setq thread (cdr (cdr thread)))
4705                    (while thread
4706                      (gnus-summary-prepare-threads (list (car thread)) 1 t)
4707                      (setq thread (cdr thread))))
4708                   ((eq gnus-summary-make-false-root 'dummy)
4709                    ;; We output a dummy root.
4710                    (gnus-summary-insert-dummy-line 
4711                     nil header (header-number (car (car (cdr thread)))))
4712                    (setq clevel 1))
4713                   ((eq gnus-summary-make-false-root 'empty)
4714                    ;; We print the articles with empty subject fields. 
4715                    (gnus-summary-prepare-threads (list (car (cdr thread))) 0)
4716                    (setq thread (cdr (cdr thread)))
4717                    (while thread
4718                      (gnus-summary-prepare-threads (list (car thread)) 0 nil
4719                                                    (not gnus-tmp-prev-dormant))
4720                      (setq thread (cdr thread))))
4721                   (t
4722                    ;; We do not make a root for the gathered
4723                    ;; sub-threads at all.  
4724                    (setq clevel 0)))
4725             ;; Print the sub-threads.
4726             (and (consp thread) (cdr thread)
4727                  (gnus-summary-prepare-threads (cdr thread) clevel)))
4728         ;; The header is a real article.
4729         (setq number (header-number header)
4730               subject (header-subject header)
4731               gnus-tmp-prev-dormant (memq number gnus-newsgroup-dormant))
4732         (gnus-summary-insert-line
4733          nil header level nil 
4734          (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
4735                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
4736                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
4737                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
4738                (t gnus-ancient-mark))
4739          (memq number gnus-newsgroup-replied)
4740          (memq number gnus-newsgroup-expirable)
4741          (if no-subject gnus-summary-same-subject
4742            (if (or (zerop level)
4743                    (and gnus-thread-ignore-subject
4744                         (not (string= 
4745                               (gnus-simplify-subject-re gnus-tmp-prev-subject)
4746                               (gnus-simplify-subject-re subject)))))
4747                subject
4748              gnus-summary-same-subject))
4749          not-child
4750          (cdr (assq number gnus-newsgroup-scored)))
4751         (setq gnus-tmp-prev-subject subject)
4752         ;; Recursively print subthreads.
4753         (and (consp thread) (cdr thread)
4754              (gnus-summary-prepare-threads (cdr thread) (1+ level)))))))
4755
4756 (defun gnus-select-newsgroup (group &optional read-all)
4757   "Select newsgroup GROUP.
4758 If READ-ALL is non-nil, all articles in the group are selected."
4759   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
4760          (info (nth 2 entry))
4761          articles header-marks)
4762     (and (eq (car entry) t)
4763          (or (gnus-activate-newsgroup (car info))
4764              (error "Couldn't request newsgroup %s" group)))
4765     (setq gnus-current-select-method (or (nth 4 info) gnus-select-method))
4766     (gnus-check-news-server (nth 4 info))
4767     (if (not (gnus-request-group group t))
4768         (error "Couldn't request newsgroup %s" group))
4769
4770     ;; Initialize the buffer that holds lines that have been removed
4771     ;; from the summary buffer.
4772     (setq gnus-newsgroup-expunged-buffer 
4773           (get-buffer-create (format " *gnus expunge %s*" group)))
4774     (save-excursion
4775       (set-buffer gnus-newsgroup-expunged-buffer)
4776       (buffer-disable-undo (current-buffer))
4777       (erase-buffer)
4778       (gnus-add-current-to-buffer-list))
4779     
4780     (setq gnus-newsgroup-name group)
4781     (setq gnus-newsgroup-unselected nil)
4782     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
4783
4784     (and info
4785          (progn
4786            (gnus-adjust-marked-articles info)
4787            (setq gnus-newsgroup-marked (cdr (assq 'tick (nth 3 info))))
4788            (setq gnus-newsgroup-replied (cdr (assq 'reply (nth 3 info))))
4789            (setq gnus-newsgroup-expirable (cdr (assq 'expire (nth 3 info))))
4790            (setq gnus-newsgroup-killed (cdr (assq 'killed (nth 3 info))))
4791            (setq gnus-newsgroup-bookmarks (cdr (assq 'bookmark (nth 3 info))))
4792            (setq gnus-newsgroup-dormant (cdr (assq 'dormant (nth 3 info))))
4793            (setq gnus-newsgroup-scored (cdr (assq 'score (nth 3 info))))
4794            (setq gnus-newsgroup-processable nil)))
4795
4796     (if (not (setq articles (gnus-articles-to-read group read-all)))
4797         nil
4798       ;; Init the dependencies hash table.
4799       (setq gnus-newsgroup-dependencies 
4800             (gnus-make-hashtable (length gnus-newsgroup-unreads)))
4801       ;; Retrieve the headers and read them in.
4802       (setq gnus-newsgroup-headers 
4803             (if (eq 'nov (setq gnus-headers-retrieved-by
4804                                (gnus-retrieve-headers 
4805                                 (if gnus-fetch-old-headers 
4806                                     (cons 1 articles) articles) 
4807                                 gnus-newsgroup-name)))
4808                 (progn
4809                   (gnus-get-newsgroup-headers-xover articles))
4810               (gnus-get-newsgroup-headers)))
4811       ;; If we were to fetch old headers, but the backend didn't
4812       ;; support XOVER, then it is possible we fetched one article
4813       ;; that we shouldn't have. If that's the case, we pop it off the
4814       ;; list of headers.
4815       (and (not (eq gnus-headers-retrieved-by 'nov))
4816            gnus-fetch-old-headers
4817            gnus-newsgroup-headers
4818            (/= (header-number (car gnus-newsgroup-headers)) (car articles))
4819            (setq gnus-newsgroup-headers (cdr gnus-newsgroup-headers)))
4820       ;; Remove cancelled articles from the list of unread articles.
4821       (setq gnus-newsgroup-unreads
4822             (gnus-intersection 
4823              gnus-newsgroup-unreads
4824              (mapcar (lambda (headers) (header-number headers))
4825                      gnus-newsgroup-headers)))
4826       ;; Check whether auto-expire is to be done in this group.
4827       (setq gnus-newsgroup-auto-expire
4828             (and (stringp gnus-auto-expirable-newsgroups)
4829                  (string-match gnus-auto-expirable-newsgroups 
4830                                (gnus-group-real-name group))))
4831       ;; First and last article in this newsgroup.
4832       (and gnus-newsgroup-headers
4833            (setq gnus-newsgroup-begin 
4834                  (header-number (car gnus-newsgroup-headers)))
4835            (setq gnus-newsgroup-end
4836                  (header-number (gnus-last-element gnus-newsgroup-headers))))
4837       (setq gnus-xref-hashtb nil)
4838       (setq gnus-reffed-article-number -1)
4839       ;; GROUP is successfully selected.
4840       (or gnus-newsgroup-headers t))))
4841
4842 (defun gnus-articles-to-read (group read-all)
4843   ;; Find out what articles the user wants to read.
4844   (let* ((articles
4845           ;; Select all articles if `read-all' is non-nil, or if all the
4846           ;; unread articles are dormant articles.
4847           (if (or read-all
4848                   (= (length gnus-newsgroup-unreads) 
4849                      (length gnus-newsgroup-scored)))
4850               (gnus-uncompress-sequence 
4851                (gnus-gethash group gnus-active-hashtb))
4852             gnus-newsgroup-unreads))
4853          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
4854          (scored (length scored-list))
4855          (number (length articles))
4856          (marked (+ (length gnus-newsgroup-marked)
4857                     (length gnus-newsgroup-dormant)))
4858          (select
4859           (condition-case ()
4860               (cond ((and (or (<= scored marked)
4861                               (= scored number))
4862                           (numberp gnus-large-newsgroup)
4863                           (> number gnus-large-newsgroup))
4864                      (let ((input
4865                             (read-string
4866                              (format
4867                               "How many articles from %s (default %d): "
4868                               gnus-newsgroup-name number))))
4869                        (if (string-equal input "")
4870                            number input)))
4871                     ((and (> scored marked) (< scored number))
4872                      (let ((input
4873                             (read-string
4874                              (format 
4875                               "%s %s (%d scored, %d total, %d default): "
4876                               "How many articles from"
4877                               group scored number scored))))
4878                        (if (string-equal input "")
4879                            scored input)))
4880                     (t number))
4881             (quit 0))))
4882     (setq select (if (numberp select) select (string-to-number select)))
4883     (if (zerop select)
4884         ()
4885       (if (and (not (zerop scored)) (<= (abs select) scored))
4886           (progn
4887             (setq articles (sort scored-list '<))
4888             (setq number (length articles)))
4889         (setq articles (copy-sequence articles)))
4890
4891       (if (< (abs select) number)
4892           (if (< select 0) 
4893               ;; Select the N oldest articles.
4894               (setcdr (nthcdr (1- (abs select)) articles) nil)
4895             ;; Select the N most recent articles.
4896             (setq articles (nthcdr (- number select) articles))))
4897       (setq gnus-newsgroup-unselected
4898             (gnus-set-difference gnus-newsgroup-unreads articles))
4899       articles)))
4900
4901 (defun gnus-killed-articles (killed articles)
4902   (let (out)
4903     (while articles
4904       (if (inline (gnus-member-of-range (car articles) killed))
4905           (setq out (cons (car articles) out)))
4906       (setq articles (cdr articles)))
4907     out))
4908
4909 (defun gnus-adjust-marked-articles (info)
4910   "Remove all marked articles that are no longer legal."
4911   (let ((marked-lists (nth 3 info))
4912         (active (gnus-gethash (car info) gnus-active-hashtb))
4913         marked m prev)
4914     ;; There are four types of marked articles - ticked, replied,
4915     ;; expirable and dormant.  
4916     (while marked-lists
4917       (setq m (cdr (setq prev (car marked-lists))))
4918       (cond ((or (eq 'tick (car prev)) (eq 'dormant (car prev)))
4919              ;; Make sure that all ticked articles are a subset of the
4920              ;; unread/unselected articles.
4921              (while m
4922                (if (or (memq (car m) gnus-newsgroup-unreads)
4923                        (memq (car m) gnus-newsgroup-unselected))
4924                    (setq prev m)
4925                  (setcdr prev (cdr m)))
4926                (setq m (cdr m))))
4927             ((eq 'score (car prev))
4928              ;; Scored articles should be a subset of
4929              ;; unread/unselected articles. 
4930              (while m
4931                (if (or (memq (car (car m)) gnus-newsgroup-unreads)
4932                        (memq (car (car m)) gnus-newsgroup-unreads))
4933                    (setq prev m)
4934                  (setcdr prev (cdr m)))
4935                (setq m (cdr m))))
4936             ((eq 'bookmark (car prev))
4937              ;; Bookmarks should be a subset of active articles.
4938              (while m
4939                (if (< (car (car m)) (car active))
4940                    (setcdr prev (cdr m))
4941                  (setq prev m))
4942                (setq m (cdr m))))
4943             ((eq 'killed (car prev))
4944              ;; Articles that have been through the kill process are
4945              ;; to be a subset of active articles.
4946              (while (and m (< (cdr (car m)) (car active)))
4947                (setcdr prev (cdr m))
4948                (setq m (cdr m)))
4949              (if (and m (< (car (car m)) (car active))) 
4950                  (setcar (car m) (car active))))
4951             ((or (eq 'reply (car marked)) (eq 'expire (car marked)))
4952              ;; The replied and expirable articles have to be articles
4953              ;; that are active. 
4954              (while m
4955                (if (< (car m) (car active))
4956                    (setcdr prev (cdr m))
4957                  (setq prev m))
4958                (setq m (cdr m)))))
4959       (setq marked-lists (cdr marked-lists)))
4960     ;; Remove all lists that are empty.
4961     (setq marked-lists (nth 3 info))
4962     (if marked-lists
4963         (progn
4964           (while (= 1 (length (car marked-lists)))
4965             (setq marked-lists (cdr marked-lists)))
4966           (setq m (cdr (setq prev marked-lists)))
4967           (while m
4968             (if (= 1 (length (car m)))
4969                 (setcdr prev (cdr m))
4970               (setq prev m))
4971             (setq m (cdr m)))
4972           (setcar (nthcdr 3 info) marked-lists)))
4973     ;; Finally, if there are no marked lists at all left, and if there
4974     ;; are no elements after the lists in the info list, we just chop
4975     ;; the info list off before the marked lists.
4976     (if (and (null marked-lists) (not (nthcdr 4 info)))
4977         (setcdr (nthcdr 2 info) nil)))
4978   info)
4979
4980 (defun gnus-set-marked-articles 
4981   (info ticked replied expirable killed dormant bookmark score) 
4982   "Enter the various lists of marked articles into the newsgroup info list."
4983   (let (newmarked)
4984     (and ticked (setq newmarked (cons (cons 'tick ticked) nil)))
4985     (and replied (setq newmarked (cons (cons 'reply replied) newmarked)))
4986     (and expirable (setq newmarked (cons (cons 'expire expirable) 
4987                                          newmarked)))
4988     (and killed (setq newmarked (cons (cons 'killed killed) newmarked)))
4989     (and dormant (setq newmarked (cons (cons 'dormant dormant) newmarked)))
4990     (and bookmark (setq newmarked (cons (cons 'bookmark bookmark) 
4991                                         newmarked)))
4992     (and score (setq newmarked (cons (cons 'score score) newmarked)))
4993     (if (nthcdr 3 info)
4994         (if newmarked
4995             (setcar (nthcdr 3 info) newmarked)
4996           (if (not (nthcdr 4 info))
4997               (setcdr (nthcdr 2 info) nil)
4998             (setcar (nthcdr 3 info) nil)))
4999       (if newmarked
5000           (setcdr (nthcdr 2 info) (cons newmarked nil))))))
5001
5002 (defun gnus-add-marked-articles (group type articles &optional info)
5003   ;; Add ARTICLES of TYPE to the info of GROUP.
5004   ;; If INFO is non-nil, use that info.
5005   (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
5006         marked m)
5007     (or (not info)
5008         (and (not (setq marked (nthcdr 3 info)))
5009              (setcdr (nthcdr 2 info) (list (list (cons type articles)))))
5010         (and (not (setq m (assq type (car marked))))
5011              (setcar marked (cons (cons type articles) (car marked))))
5012         (while articles
5013           (or (memq (car articles) m) (setcdr m (cons (car articles)
5014                                                       (cdr m))))
5015           (setq articles (cdr articles))))))
5016          
5017 (defun gnus-set-mode-line (where)
5018   "This function sets the mode line of the article or summary buffers.
5019 If WHERE is `summary', the summary mode line format will be used."
5020   (if (memq where gnus-updated-mode-lines)
5021       (let (mode-string)
5022         (save-excursion
5023           (set-buffer gnus-summary-buffer)
5024           (let* ((mformat (if (eq where 'article) 
5025                               gnus-article-mode-line-format-spec
5026                             gnus-summary-mode-line-format-spec))
5027                  (group-name gnus-newsgroup-name)
5028                  (article-number (or gnus-current-article 0))
5029                  (unread (- (length gnus-newsgroup-unreads)
5030                             (length gnus-newsgroup-dormant)))
5031                  (unselected (length gnus-newsgroup-unselected))
5032                  (unread-and-unselected
5033                   (cond ((and (zerop unread) (zerop unselected)) "")
5034                         ((zerop unselected) (format "{%d more}" unread))
5035                         (t (format "{%d(+%d) more}" unread unselected))))
5036                  (subject
5037                   (if gnus-current-headers
5038                       (header-subject gnus-current-headers) ""))
5039                  (max-len (if (eq where 'summary) 59 59)))
5040             (setq mode-string (eval mformat))
5041             (if (> (length mode-string) max-len) 
5042                 (setq mode-string 
5043                       (concat (substring mode-string 0 (- max-len 3)) "...")))
5044             (setq mode-string (format (format "%%-%ds" max-len 5)
5045                                       mode-string))))
5046         (setq mode-line-buffer-identification mode-string)
5047         (set-buffer-modified-p t))))
5048
5049 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
5050   "Go through the HEADERS list and add all Xrefs to a hash table.
5051 The resulting hash table is returned, or nil if no Xrefs were found."
5052   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
5053          (prefix (if (and 
5054                       (gnus-group-foreign-p from-newsgroup)
5055                       (not (eq 'nnvirtual (car from-method))))
5056                      (gnus-group-real-prefix from-newsgroup)))
5057          (xref-hashtb (make-vector 63 0))
5058          start group entry number xrefs header)
5059     (while headers
5060       (setq header (car headers))
5061       (if (and (setq xrefs (header-xref header))
5062                (not (memq (header-number header) unreads)))
5063           (progn
5064             (setq start 0)
5065             (while (string-match "\\([^ ]+\\):\\([0-9]+\\)" xrefs start)
5066               (setq start (match-end 0))
5067               (setq group (concat prefix (substring xrefs (match-beginning 1) 
5068                                                     (match-end 1))))
5069               (setq number 
5070                     (string-to-int (substring xrefs (match-beginning 2) 
5071                                               (match-end 2))))
5072               (if (setq entry (gnus-gethash group xref-hashtb))
5073                   (setcdr entry (cons number (cdr entry)))
5074                 (gnus-sethash group (cons number nil) xref-hashtb)))))
5075       (setq headers (cdr headers)))
5076     (if start xref-hashtb nil)))
5077
5078 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable)
5079   "Look through all the headers and mark the Xrefs as read."
5080   (let (name entry read info xref-hashtb idlist active num range exps)
5081     (set-buffer gnus-group-buffer)
5082     (if (setq xref-hashtb 
5083               (gnus-create-xref-hashtb from-newsgroup headers unreads))
5084         (mapatoms 
5085          (lambda (group)
5086            (if (string= from-newsgroup (setq name (symbol-name group)))
5087                ()
5088              (setq idlist (symbol-value group))
5089              ;; Dead groups are not updated.
5090              (if (and (setq entry (gnus-gethash name gnus-newsrc-hashtb))
5091                       ;; Only do the xrefs if the group has the same
5092                       ;; select method as the group we have just read.
5093                       (or (and (not (nth 4 (setq info (nth 2 entry))))
5094                                (eq (gnus-find-method-for-group from-newsgroup)
5095                                    gnus-select-method))
5096                           (eq (car (gnus-find-method-for-group 
5097                                     from-newsgroup)) 'nnvirtual)
5098                           (equal (nth 4 info) 
5099                                  (gnus-find-method-for-group from-newsgroup))))
5100                  (progn
5101                    (setq num 0)
5102                    ;; Set the new list of read articles in this group.
5103                    (setq active (gnus-gethash name gnus-active-hashtb))
5104                    ;; First peel off all illegal article numbers.
5105                    (if active
5106                        (let ((ids idlist)
5107                              (ticked (cdr (memq 'tick (nth 3 info))))
5108                              (dormant (cdr (memq 'dormant (nth 3 info))))
5109                              id)
5110                          (setq exps nil)
5111                          (while ids
5112                            (setq id (car ids))
5113                            (if (or (> id (cdr active))
5114                                    (< id (car active))
5115                                    (memq id ticked)
5116                                    (memq id dormant))
5117                                (setq idlist (delq id idlist)))
5118                            (and (memq id expirable)
5119                                 (setq exps (cons id exps)))
5120                            (setq ids (cdr ids)))))
5121                    ;; Update expirable articles.
5122                    (gnus-add-marked-articles nil 'expirable exps info)
5123                    (setcar (nthcdr 2 info)
5124                            (setq range
5125                                  (gnus-add-to-range 
5126                                   (nth 2 info) 
5127                                   (setq idlist (sort idlist '<)))))
5128                    ;; Then we have to re-compute how many unread
5129                    ;; articles there are in this group.
5130                    (if active
5131                        (progn
5132                          (if (atom (car range))
5133                              (if (not range)
5134                                  (setq num (- (1+ (cdr active)) (car active)))
5135                                (setq num (- (cdr active) (- (1+ (cdr range)) 
5136                                                             (car range)))))
5137                            (while range
5138                              (setq num (+ num (- (1+ (cdr (car range))) 
5139                                                  (car (car range)))))
5140                              (setq range (cdr range)))
5141                            (setq num (- (cdr active) num)))
5142                          ;; Update the number of unread articles.
5143                          (setcar entry (max 0 num))
5144                          ;; Update the group buffer.
5145                          (gnus-group-update-group name t)))))))
5146          xref-hashtb))))
5147
5148 (defsubst gnus-header-value ()
5149   (buffer-substring (match-end 0) (save-excursion (end-of-line) (point))))
5150
5151 (defun gnus-get-newsgroup-headers ()
5152   (setq gnus-article-internal-prepare-hook nil)
5153   (let ((cur nntp-server-buffer)
5154         (dependencies gnus-newsgroup-dependencies)
5155         (none-id 0)
5156         headers char article id dep end)
5157     (save-excursion
5158       (set-buffer nntp-server-buffer)
5159       (goto-char 1)
5160       ;; Search to the beginning of the next header. Error messages
5161       ;; do not begin with 2 or 3.
5162       (while (re-search-forward "^[23][0-9]+ " nil t)
5163         (let ((header (make-vector 9 nil))
5164               (c (following-char))
5165               (case-fold-search t)
5166               (p (point))
5167               from subject in-reply-to references ref)
5168           (setq id nil
5169                 ref nil
5170                 references nil
5171                 subject nil
5172                 from nil)
5173           (header-set-number header (setq article (read cur)))
5174           ;; This implementation of this function, with nine
5175           ;; search-forwards instead of the one re-search-forward and
5176           ;; a case (which basically was the old function) is actually
5177           ;; about twice as fast, even though it looks messier. You
5178           ;; can't have everything, I guess. Speed and elegance
5179           ;; doesn't always come hand in hand.
5180           (save-restriction
5181             (narrow-to-region (point) (save-excursion 
5182                                         (search-forward "\n.\n" nil t)))
5183             (if (search-forward "\nfrom: " nil t)
5184                 (header-set-from header (gnus-header-value))
5185               (header-set-from header "(nobody)"))
5186             (goto-char p)
5187             (if (search-forward "\nsubject: " nil t)
5188                 (header-set-subject header (gnus-header-value))
5189               (header-set-subject header "(none)"))
5190             (goto-char p)
5191             (and (search-forward "\nxref: " nil t)
5192                  (header-set-xref header (gnus-header-value)))
5193             (goto-char p)
5194             (and (search-forward "\nlines: " nil t)
5195                  (header-set-lines header (read cur)))
5196             (goto-char p)
5197             (and (search-forward "\ndate: " nil t)
5198                  (header-set-date header (gnus-header-value)))
5199             (goto-char p)
5200             (if (search-forward "\nmessage-id: " nil t)
5201                 (header-set-id header (setq id (gnus-header-value)))
5202               ;; If there was no message-id, we just fake one to make
5203               ;; subsequent routines simpler.
5204               (header-set-id 
5205                header 
5206                (setq id (concat "none+" (int-to-string 
5207                                          (setq none-id (1+ none-id)))))))
5208             (goto-char p)
5209             (if (search-forward "\nreferences: " nil t)
5210                 (progn
5211                   (header-set-references header (gnus-header-value))
5212                   (setq end (match-end 0))
5213                   (save-excursion
5214                     (setq ref 
5215                           (downcase
5216                            (buffer-substring
5217                             (progn 
5218                               (end-of-line)
5219                               (search-backward ">" end t)
5220                               (1+ (point)))
5221                             (progn
5222                               (search-backward "<" end t)
5223                               (point)))))))
5224               ;; Get the references from the in-reply-to header if there
5225               ;; was no references, and the in-reply-to header looks
5226               ;; promising. 
5227               (if (and (search-forward "\nin-reply-to: " nil t)
5228                        (setq in-reply-to (gnus-header-value))
5229                        (string-match "<[^>]+>" in-reply-to))
5230                   (progn
5231                     (header-set-references 
5232                      header 
5233                      (setq ref (substring in-reply-to (match-beginning 0)
5234                                           (match-end 0))))
5235                     (setq ref (downcase ref)))
5236                 (setq ref "none")))
5237             ;; We do some threading while we read the headers. The
5238             ;; message-id and the last reference are both entered into
5239             ;; the same hash table. Some tippy-toeing around has to be
5240             ;; done in case an article has arrived before the article
5241             ;; which it refers to.
5242             (if (boundp (setq dep (intern (downcase id) dependencies)))
5243                 (if (car (symbol-value dep))
5244                     (setq header nil)
5245                   (setcar (symbol-value dep) header))
5246               (set dep (list header)))
5247             (if header
5248                 (progn
5249                   (if (boundp (setq dep (intern ref dependencies)))
5250                       (setcdr (symbol-value dep) 
5251                               (cons header (cdr (symbol-value dep))))
5252                     (set dep (list nil header)))
5253                   (setq headers (cons header headers))))
5254             (goto-char (point-max))))))
5255     (nreverse headers)))
5256
5257 ;; The following macros and functions were written by Felix Lee
5258 ;; <flee@cse.psu.edu>. 
5259
5260 ;; This is almost 4x faster than (string-to-int (buffer-substring ... ))
5261 ;; primarily because of garbage collection.  -jwz
5262 (defmacro gnus-read-integer (&optional point move-p)
5263   (` ((, (if move-p 'progn 'save-excursion))
5264       (,@ (if point (list (list 'goto-char point))))
5265       (if (and (<= (following-char) ?9)
5266                (>= (following-char) ?0))
5267           (read (current-buffer))
5268         0))))
5269
5270 (defmacro gnus-nov-skip-field ()
5271   '(search-forward "\t" eol 'end))
5272
5273 (defmacro gnus-nov-field ()
5274   '(buffer-substring
5275     (point)
5276     (progn (gnus-nov-skip-field) (1- (point)))))
5277
5278 ;; Goes through the xover lines and returns a list of vectors
5279 (defun gnus-get-newsgroup-headers-xover (sequence)
5280   "Parse the news overview data in the server buffer, and return a
5281 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
5282   ;; Get the Xref when the users reads the articles since most/some
5283   ;; NNTP servers do not include Xrefs when using XOVER.
5284   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
5285   (let ((cur nntp-server-buffer)
5286         (dependencies gnus-newsgroup-dependencies)
5287         (none 0)
5288         number headers header)
5289     (save-excursion
5290       (set-buffer nntp-server-buffer)
5291       (goto-char (point-min))
5292       (while (and sequence (not (eobp)))
5293         (setq number (read cur))
5294         (while (and sequence (< (car sequence) number))
5295           (setq sequence (cdr sequence)))
5296         (and sequence 
5297              (eq number (car sequence))
5298              (progn
5299                (setq sequence (cdr sequence))
5300                (if (setq header 
5301                          (inline (gnus-nov-parse-line number dependencies)))
5302                    (setq headers (cons header headers)))))
5303         (forward-line 1))
5304       (setq headers (nreverse headers)))
5305     headers))
5306
5307 (defun gnus-nov-parse-line (number dependencies)
5308   "Point has to be after the number on the beginning of the line."
5309   (let ((none 0)
5310         header eol ref id dep)
5311     (save-excursion
5312       (end-of-line)
5313       (setq eol (point)))
5314     (forward-char)
5315     ;; overview: [num subject from date id refs chars lines misc]
5316     (setq header
5317           (vector 
5318            number                       ; number
5319            (gnus-nov-field)             ; subject
5320            (gnus-nov-field)             ; from
5321            (gnus-nov-field)             ; date
5322            (setq id (gnus-nov-field))   ; id
5323            (progn
5324              (save-excursion
5325                (let ((beg (point)))
5326                  (search-forward "\t" eol)
5327                  (if (search-backward ">" beg t)
5328                      (setq ref 
5329                            (downcase 
5330                             (buffer-substring 
5331                              (1+ (point))
5332                              (progn
5333                                (search-backward "<" beg t)
5334                                (point)))))
5335                    (setq ref nil))))
5336              (gnus-nov-field))          ; refs
5337            (read (current-buffer))      ; chars
5338            (read (current-buffer))      ; lines
5339            (if (/= (following-char) ?\t)
5340                nil
5341              (forward-char 1)
5342              (gnus-nov-field))          ; misc
5343            ))
5344     ;; We build the thread tree.
5345     (if (boundp 
5346          (setq dep 
5347                (intern 
5348                 (downcase 
5349                  (or id (concat "none+"
5350                                 (int-to-string 
5351                                  (setq none (1+ none))))))
5352                 dependencies)))
5353         (if (car (symbol-value dep))
5354             (setq header nil)
5355           (setcar (symbol-value dep) header))
5356       (set dep (list header)))
5357     (if header
5358         (progn
5359           (if (boundp (setq dep (intern (or ref "none") 
5360                                         dependencies)))
5361               (setcdr (symbol-value dep) 
5362                       (cons header (cdr (symbol-value dep))))
5363             (set dep (list nil header)))))
5364     header))
5365
5366 (defun gnus-article-get-xrefs ()
5367   "Fill in the Xref value in `gnus-current-headers', if necessary.
5368 This is meant to be called in `gnus-article-internal-prepare-hook'."
5369   (or (not gnus-use-cross-reference)
5370       (let ((case-fold-search t)
5371             xref)
5372         (save-restriction
5373           (gnus-narrow-to-headers)
5374           (goto-char (point-min))
5375           (if (or (and (eq (downcase (following-char)) ?x)
5376                        (looking-at "Xref:"))
5377                   (search-forward "\nXref:" nil t))
5378               (progn
5379                 (goto-char (1+ (match-end 0)))
5380                 (setq xref (buffer-substring (point) 
5381                                              (progn (end-of-line) (point))))
5382                 (save-excursion
5383                   (set-buffer gnus-summary-buffer)
5384                   (header-set-xref gnus-current-headers xref))))))))
5385
5386 (defalias 'gnus-find-header-by-number 'gnus-get-header-by-number)
5387 (make-obsolete 'gnus-find-header-by-number 'gnus-get-header-by-number)
5388
5389 ;; Return a header specified by a NUMBER.
5390 (defun gnus-get-header-by-number (number)
5391   (save-excursion
5392     (set-buffer gnus-summary-buffer)
5393     (or gnus-newsgroup-headers-hashtb-by-number
5394         (gnus-make-headers-hashtable-by-number))
5395     (gnus-gethash (int-to-string number)
5396                   gnus-newsgroup-headers-hashtb-by-number)))
5397
5398 (defun gnus-make-headers-hashtable-by-number ()
5399   "Make hashtable for the variable gnus-newsgroup-headers by number."
5400   (save-excursion
5401     (set-buffer gnus-summary-buffer)
5402     (let ((headers gnus-newsgroup-headers)
5403           header)
5404       (setq gnus-newsgroup-headers-hashtb-by-number
5405             (gnus-make-hashtable (length headers)))
5406       (while headers
5407         (setq header (car headers))
5408         (gnus-sethash (int-to-string (header-number header))
5409                       header gnus-newsgroup-headers-hashtb-by-number)
5410         (setq headers (cdr headers))))))
5411
5412 (defun gnus-more-header-backward ()
5413   "Find new header backward."
5414   (let ((first (car (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
5415         (artnum gnus-newsgroup-begin)
5416         (header nil))
5417     (while (and (not header)
5418                 (> artnum first))
5419       (setq artnum (1- artnum))
5420       (setq header (gnus-read-header artnum)))
5421     header))
5422
5423 (defun gnus-more-header-forward ()
5424   "Find new header forward."
5425   (let ((last (cdr (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
5426         (artnum gnus-newsgroup-end)
5427         (header nil))
5428     (while (and (not header)
5429                 (< artnum last))
5430       (setq artnum (1+ artnum))
5431       (setq header (gnus-read-header artnum)))
5432     header))
5433
5434 (defun gnus-extend-newsgroup (header &optional backward)
5435   "Extend newsgroup selection with HEADER.
5436 Optional argument BACKWARD means extend toward backward."
5437   (if header
5438       (let ((artnum (header-number header)))
5439         (setq gnus-newsgroup-headers
5440               (if backward
5441                   (cons header gnus-newsgroup-headers)
5442                 (nconc gnus-newsgroup-headers (list header))))
5443         (setq gnus-newsgroup-unselected
5444               (delq artnum gnus-newsgroup-unselected))
5445         (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
5446         (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum)))))
5447
5448
5449 (defun gnus-summary-search-group (&optional backward use-level)
5450   "Search for next unread newsgroup.
5451 If optional argument BACKWARD is non-nil, search backward instead."
5452   (save-excursion
5453     (set-buffer gnus-group-buffer)
5454     (save-excursion
5455       ;; We don't want to alter current point of group mode buffer.
5456       (if (gnus-group-search-forward 
5457            backward t 
5458            (if use-level (gnus-group-group-level) nil))
5459           (gnus-group-group-name))
5460       )))
5461
5462 (defun gnus-summary-search-subject (&optional backward unread subject)
5463   "Search for article forward.
5464 If BACKWARD is non-nil, search backward.
5465 If UNREAD is non-nil, only unread articles are selected.
5466 If SUBJECT is non-nil, the article which has the same subject will be
5467 searched for." 
5468   (let ((func (if backward 'previous-single-property-change
5469                 'next-single-property-change))
5470         (beg (point))
5471         (did t)
5472         pos)
5473     (beginning-of-line)
5474     (forward-char (if backward (if (bobp) 0 -1) (if (eobp) 0 1)))
5475     (while (and (setq pos (funcall func (point) 'gnus-number))
5476                 (goto-char (if backward (1- pos) pos))
5477                 (setq did
5478                       (not (and (or (not unread)
5479                                     (= (get-text-property (point) 'gnus-mark) 
5480                                        gnus-unread-mark))
5481                                 (or (not subject)
5482                                     (string= (gnus-simplify-subject-re 
5483                                               subject)
5484                                              (gnus-simplify-subject-re
5485                                               (get-text-property 
5486                                                (point) 
5487                                                'gnus-subject)))))))
5488                 (if backward (if (bobp) nil (forward-char -1) t)
5489                   (if (eobp) nil (forward-char 1) t))))
5490     (if did
5491         (progn (goto-char beg) nil)
5492       (prog1
5493           (get-text-property (point) 'gnus-number)
5494         (gnus-summary-position-cursor)))))
5495
5496 (defun gnus-summary-search-forward (&optional unread subject backward)
5497   "Search for article forward.
5498 If UNREAD is non-nil, only unread articles are selected.
5499 If SUBJECT is non-nil, the article which has the same subject will be
5500 searched for. 
5501 If BACKWARD is non-nil, the search will be performed backwards instead."
5502   (gnus-summary-search-subject backward unread subject))
5503
5504 (defun gnus-summary-search-backward (&optional unread subject)
5505   "Search for article backward.
5506 If 1st optional argument UNREAD is non-nil, only unread article is selected.
5507 If 2nd optional argument SUBJECT is non-nil, the article which has
5508 the same subject will be searched for."
5509   (gnus-summary-search-forward unread subject t))
5510
5511 (defun gnus-summary-article-number (&optional number-or-nil)
5512   "The article number of the article on the current line.
5513 If there isn's an article number here, then we return the current
5514 article number."
5515   (let ((number (get-text-property (save-excursion (beginning-of-line) (point))
5516                                    'gnus-number)))
5517     (if number-or-nil number (or number gnus-current-article))))
5518
5519 (defun gnus-summary-thread-level ()
5520   "The thread level of the article on the current line."
5521   (or (get-text-property (save-excursion (beginning-of-line) (point))
5522                          'gnus-thread)
5523       0))
5524
5525 (defun gnus-summary-pseudo-article ()
5526   "The thread level of the article on the current line."
5527   (get-text-property (save-excursion (beginning-of-line) (point)) 
5528                      'gnus-pseudo))
5529
5530 (defun gnus-summary-article-mark ()
5531   "The mark on the current line."
5532   (get-text-property (save-excursion (beginning-of-line) (point))
5533                      'gnus-mark))
5534
5535 (defun gnus-summary-subject-string ()
5536   "Return current subject string or nil if nothing."
5537   (get-text-property (save-excursion (beginning-of-line) (point))
5538                      'gnus-subject))
5539
5540 (defalias 'gnus-summary-score 'gnus-summary-article-score)
5541 (make-obsolete 'gnus-summary-score 'gnus-summary-article-score)
5542 (defun gnus-summary-article-score ()
5543   "Return current article score."
5544   (or (cdr (assq (gnus-summary-article-number) gnus-newsgroup-scored))
5545       gnus-summary-default-score))
5546
5547 (defun gnus-summary-recenter ()
5548   "Center point in summary window."
5549   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
5550   ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
5551   (let ((half (/ (- (window-height) 2) 2)))
5552     (and 
5553      ;; It has to be wanted,
5554      gnus-auto-center-summary 
5555      ;; the article buffer must be displayed,
5556      (get-buffer-window gnus-article-buffer)
5557      ;; there must be lines left to scroll forward,
5558      (zerop (save-excursion (forward-line (1+ half))))
5559      ;; so we recenter.
5560      (recenter half))))
5561
5562 (defun gnus-summary-jump-to-group (newsgroup)
5563   "Move point to NEWSGROUP in group mode buffer."
5564   ;; Keep update point of group mode buffer if visible.
5565   (if (eq (current-buffer)
5566           (get-buffer gnus-group-buffer))
5567       (save-window-excursion
5568         ;; Take care of tree window mode.
5569         (if (get-buffer-window gnus-group-buffer)
5570             (pop-to-buffer gnus-group-buffer))
5571         (gnus-group-jump-to-group newsgroup))
5572     (save-excursion
5573       ;; Take care of tree window mode.
5574       (if (get-buffer-window gnus-group-buffer)
5575           (pop-to-buffer gnus-group-buffer)
5576         (set-buffer gnus-group-buffer))
5577       (gnus-group-jump-to-group newsgroup))))
5578
5579 ;; This function returns a list of article numbers based on the
5580 ;; difference between the ranges of read articles in this group and
5581 ;; the range of active articles.
5582 (defun gnus-list-of-unread-articles (group)
5583   (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
5584          (active (gnus-gethash group gnus-active-hashtb))
5585          (last (cdr active))
5586          unread first nlast unread)
5587     ;; If none are read, then all are unread. 
5588     (if (not read)
5589           (setq first (car active))
5590       ;; If the range of read articles is a single range, then the
5591       ;; first unread article is the article after the last read
5592       ;; article. Sounds logical, doesn't it?
5593       (if (atom (car read))
5594           (setq first (1+ (cdr read)))
5595         ;; `read' is a list of ranges.
5596         (while read
5597           (if first 
5598               (while (< first nlast)
5599                 (setq unread (cons first unread))
5600                 (setq first (1+ first))))
5601           (setq first (1+ (cdr (car read))))
5602           (setq nlast (car (car (cdr read))))
5603           (setq read (cdr read)))))
5604     ;; And add the last unread articles.
5605     (while (<= first last)
5606       (setq unread (cons first unread))
5607       (setq first (1+ first)))
5608     ;; Return the list of unread articles.
5609     (nreverse unread)))
5610
5611 ;; Various summary commands
5612
5613 (defun gnus-summary-universal-argument ()
5614   "Perform any operation on all articles marked with the process mark."
5615   (interactive)
5616   (let ((articles (reverse gnus-newsgroup-processable))
5617         key func)
5618     (or articles (error "No articles marked"))
5619     (or (setq func (key-binding (read-key-sequence "C-c C-u")))
5620         (error "Undefined key"))
5621     (while articles
5622       (gnus-summary-goto-subject (car articles))
5623       (command-execute func)
5624       (gnus-summary-remove-process-mark (car articles))
5625       (setq articles (cdr articles)))))
5626
5627 (defun gnus-summary-toggle-truncation (arg)
5628   "Toggle truncation of summary lines.
5629 With arg, turn line truncation on iff arg is positive."
5630   (interactive "P")
5631   (setq truncate-lines
5632         (if (null arg) (not truncate-lines)
5633           (> (prefix-numeric-value arg) 0)))
5634   (redraw-display))
5635
5636 (defun gnus-summary-reselect-current-group (show-all)
5637   "Once exit and then reselect the current newsgroup.
5638 Prefix argument SHOW-ALL means to select all articles."
5639   (interactive "P")
5640   (let ((current-subject (gnus-summary-article-number)))
5641     (gnus-summary-exit t)
5642     ;; We have to adjust the point of group mode buffer because the
5643     ;; current point was moved to the next unread newsgroup by
5644     ;; exiting.
5645     (gnus-summary-jump-to-group gnus-newsgroup-name)
5646     (gnus-group-read-group show-all t)
5647     (gnus-summary-goto-subject current-subject)
5648     ))
5649
5650 (defun gnus-summary-rescan-group (all)
5651   "Exit the newsgroup, ask for new articles, and select the newsgroup."
5652   (interactive "P")
5653   ;; Fix by Ilja Weis <kult@uni-paderborn.de>.
5654   (let ((group gnus-newsgroup-name))
5655     (gnus-summary-exit t)
5656     (gnus-summary-jump-to-group group)
5657     (save-excursion
5658       (set-buffer gnus-group-buffer)
5659       (gnus-group-get-new-news-this-group 1))
5660     (gnus-summary-jump-to-group group)
5661     (gnus-group-read-group all)))
5662
5663 (defun gnus-summary-exit (&optional temporary)
5664   "Exit reading current newsgroup, and then return to group selection mode.
5665 gnus-exit-group-hook is called with no arguments if that value is non-nil."
5666   (interactive)
5667   (gnus-kill-save-kill-buffer)
5668   (let ((group gnus-newsgroup-name)
5669         (mode major-mode)
5670         (buf (current-buffer)))
5671     (if gnus-newsgroup-kill-headers
5672         (setq gnus-newsgroup-killed
5673               (gnus-compress-sequence
5674                (nconc
5675                 (gnus-intersection
5676                  (gnus-uncompress-sequence gnus-newsgroup-killed)
5677                  (setq gnus-newsgroup-unselected
5678                        (sort gnus-newsgroup-unselected '<)))
5679                 (setq gnus-newsgroup-unreads
5680                       (sort gnus-newsgroup-unreads '<))))))
5681     (or (listp (cdr gnus-newsgroup-killed))
5682         (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
5683     (let ((updated nil)
5684           (headers gnus-newsgroup-headers)
5685           (unreads gnus-newsgroup-unreads)
5686           (unselected gnus-newsgroup-unselected)
5687           (ticked gnus-newsgroup-marked))
5688       (gnus-close-group group)
5689       ;; Important internal variables are saved, so we can reenter
5690       ;; the summary buffer even if the hook changes them.
5691       (run-hooks 'gnus-exit-group-hook)
5692       (gnus-score-save)
5693       (gnus-update-read-articles 
5694        group unreads unselected ticked
5695        t gnus-newsgroup-replied gnus-newsgroup-expirable
5696        gnus-newsgroup-killed gnus-newsgroup-dormant
5697        gnus-newsgroup-bookmarks gnus-newsgroup-scored)
5698       ;; t means ignore unsubscribed newsgroups.
5699       (and gnus-use-cross-reference
5700            (gnus-mark-xrefs-as-read 
5701             group headers unreads gnus-newsgroup-expirable))
5702       ;; Do not switch windows but change the buffer to work.
5703       (set-buffer gnus-group-buffer)
5704       (gnus-group-update-group group))
5705     ;; Make sure where I was, and go to next newsgroup.
5706     (gnus-group-jump-to-group group)
5707     (gnus-group-next-unread-group 1)
5708     (if temporary
5709         ;; If exiting temporary, caller should adjust group mode
5710         ;; buffer point by itself.
5711         nil                             ;Nothing to do.
5712       ;; Return to group mode buffer. 
5713       (if (and (get-buffer buf) 
5714                (eq mode 'gnus-summary-mode))
5715           (kill-buffer buf))
5716       (if (get-buffer gnus-article-buffer)
5717           (bury-buffer gnus-article-buffer))
5718       (setq gnus-current-select-method gnus-select-method)
5719       (and gnus-newsgroup-expunged-buffer
5720            (buffer-name gnus-newsgroup-expunged-buffer)
5721            (kill-buffer gnus-newsgroup-expunged-buffer))
5722       (gnus-configure-windows 'newsgroups t)
5723       (pop-to-buffer gnus-group-buffer))))
5724
5725 (defun gnus-summary-quit (&optional no-questions)
5726   "Quit reading current newsgroup without updating read article info."
5727   (interactive)
5728   (if (or no-questions
5729           (y-or-n-p "Do you really wanna quit reading this group? "))
5730       (progn
5731         (message "")                    ;Erase "Yes or No" question.
5732         ;; Return to group selection mode.
5733         (if (get-buffer gnus-summary-buffer)
5734             (kill-buffer gnus-summary-buffer))
5735         (if (get-buffer gnus-article-buffer)
5736             (bury-buffer gnus-article-buffer))
5737         (gnus-configure-windows 'newsgroups)
5738         (pop-to-buffer gnus-group-buffer)
5739         (gnus-group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
5740         (gnus-group-next-group 1))))
5741
5742 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
5743 (defun gnus-summary-describe-group ()
5744   "Describe the current newsgroup."
5745   (interactive)
5746   (gnus-group-describe-group gnus-newsgroup-name))
5747
5748 (defun gnus-summary-describe-briefly ()
5749   "Describe summary mode commands briefly."
5750   (interactive)
5751   (message
5752     (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")))
5753
5754 ;; Walking around group mode buffer from summary mode.
5755
5756 (defun gnus-summary-next-group (&optional no-article group)
5757   "Exit current newsgroup and then select next unread newsgroup.
5758 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
5759   (interactive "P")
5760   (let ((ingroup gnus-newsgroup-name))
5761     (gnus-summary-exit t)               ;Update all information.
5762     (gnus-group-jump-to-group ingroup)
5763     (let ((group (or group (gnus-summary-search-group)))
5764           (buf gnus-summary-buffer))
5765       (if (null group)
5766           (gnus-summary-quit t)
5767         (message "Selecting %s..." group)
5768         ;; We are now in group mode buffer.
5769         ;; Make sure group mode buffer point is on GROUP.
5770         (gnus-group-jump-to-group group)
5771         (unwind-protect
5772             (gnus-summary-read-group group nil no-article buf)
5773           (and (string= gnus-newsgroup-name ingroup)
5774                (gnus-summary-quit t)))))))
5775
5776 (defun gnus-summary-prev-group (no-article)
5777   "Exit current newsgroup and then select previous unread newsgroup.
5778 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
5779   (interactive "P")
5780   ;; Make sure group mode buffer point is on current newsgroup.
5781   (gnus-summary-jump-to-group gnus-newsgroup-name)
5782   (let ((group (gnus-summary-search-group t)))
5783     (if (null group)
5784         (progn
5785           (message "Exiting %s..." gnus-newsgroup-name)  
5786           (gnus-summary-exit)
5787           (message ""))
5788       (message "Selecting %s..." group)
5789       (gnus-summary-exit t)             ;Exit summary mode temporary.
5790       ;; We are now in group mode buffer.
5791       ;; We have to adjust point of group mode buffer because current
5792       ;; point is moved to next unread newsgroup by exiting.
5793       (gnus-summary-jump-to-group group)
5794       (gnus-summary-read-group group nil no-article)
5795       (or (eq (current-buffer)
5796               (get-buffer gnus-summary-buffer))
5797           (eq gnus-auto-select-next t)
5798           ;; Expected newsgroup has nothing to read since the articles
5799           ;; are marked as read by cross-referencing. So, try next
5800           ;; newsgroup. (Make sure we are in group mode buffer now.)
5801           (and (eq (current-buffer)
5802                    (get-buffer gnus-group-buffer))
5803                (gnus-summary-search-group t)
5804                (gnus-summary-read-group
5805                 (gnus-summary-search-group t) nil no-article))
5806           )
5807       )))
5808
5809 ;; Walking around summary lines.
5810
5811 (defun gnus-summary-first-subject (unread)
5812   "Go to the first unread subject.
5813 If UNREAD is non-nil, go to the first unread article.
5814 Returns nil if there are no unread articles."
5815   (let ((begin (point)))
5816     (if unread
5817         (if (not (gnus-goto-char 
5818                   (text-property-any (point-min) (point-max)
5819                                      'gnus-mark gnus-unread-mark)))
5820             (progn
5821               ;; If there is no unread articles, stay where you are.
5822               (goto-char begin)
5823               (message "No more unread articles")
5824               nil)
5825           t)
5826       (goto-char (point-min)))))
5827
5828 (defun gnus-summary-next-subject (n &optional unread)
5829   "Go to next N'th summary line.
5830 If N is negative, go to the previous N'th subject line.
5831 If UNREAD is non-nil, only unread articles are selected.
5832 The difference between N and the actual number of steps taken is
5833 returned."
5834   (interactive "p")
5835   (let ((backward (< n 0))
5836         (n (abs n)))
5837   (while (and (> n 0)
5838               (gnus-summary-search-forward unread nil backward))
5839     (setq n (1- n)))
5840   (gnus-summary-recenter)
5841   (if (/= 0 n) (message "No more%s articles" (if unread " unread" "")))
5842 ;  (gnus-summary-position-cursor)
5843  n))
5844
5845 (defun gnus-summary-next-unread-subject (n)
5846   "Go to next N'th unread summary line."
5847   (interactive "p")
5848   (gnus-summary-next-subject n t))
5849
5850 (defun gnus-summary-prev-subject (n &optional unread)
5851   "Go to previous N'th summary line.
5852 If optional argument UNREAD is non-nil, only unread article is selected."
5853   (interactive "p")
5854   (gnus-summary-next-subject (- n) unread))
5855
5856 (defun gnus-summary-prev-unread-subject (n)
5857   "Go to previous N'th unread summary line."
5858   (interactive "p")
5859   (gnus-summary-next-subject (- n) t))
5860
5861 (defun gnus-summary-goto-subject (article)
5862   "Go the subject line of ARTICLE."
5863   (interactive
5864    (list
5865     (string-to-int
5866      (completing-read "Article number: "
5867                       (mapcar
5868                        (lambda (headers)
5869                          (list
5870                           (int-to-string (header-number headers))))
5871                        gnus-newsgroup-headers)
5872                       nil 'require-match))))
5873   (or article (error "No article number"))
5874   (if (or (eq article (gnus-summary-article-number t))
5875           (gnus-goto-char
5876            (text-property-any
5877             (point-min) (point-max) 'gnus-number article)))
5878       article))
5879
5880 ;; Walking around summary lines with displaying articles.
5881
5882 (defun gnus-summary-expand-window ()
5883   "Expand summary window to show headers full window."
5884   (interactive)
5885   (gnus-configure-windows 'summary)
5886   (pop-to-buffer gnus-summary-buffer))
5887
5888 (defun gnus-summary-display-article (article &optional all-header)
5889   "Display ARTICLE in article buffer."
5890   (setq gnus-summary-buffer (current-buffer))
5891   (if (null article)
5892       nil
5893     (gnus-article-prepare article all-header)
5894     (if (= (gnus-summary-article-mark) ?Z) 
5895         (progn
5896           (forward-line 1)
5897           (gnus-summary-position-cursor)))
5898     (gnus-summary-recenter)
5899     (run-hooks 'gnus-select-article-hook)
5900     (gnus-summary-goto-subject article)
5901     (gnus-configure-windows 'article)
5902     ;; Successfully display article.
5903     t))
5904
5905 (defun gnus-summary-select-article (&optional all-headers force pseudo)
5906   "Select the current article.
5907 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
5908 non-nil, the article will be re-fetched even if it already present in
5909 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
5910 be displayed."
5911   (and (not pseudo) (gnus-summary-pseudo-article)
5912        (error "This is a pseudo-article."))
5913   (let ((article (gnus-summary-article-number))
5914         (all-headers (not (not all-headers)))) ;Must be T or NIL.
5915     (if (or (null gnus-current-article)
5916             (null gnus-article-current)
5917             (/= article (cdr gnus-article-current))
5918             (not (equal (car gnus-article-current) gnus-newsgroup-name))
5919             force)
5920         ;; The requested article is different from the current article.
5921         (progn
5922           (gnus-summary-display-article article all-headers)
5923           article)
5924       (if all-headers (gnus-article-show-all-headers))
5925       (gnus-configure-windows 'article)
5926       (pop-to-buffer gnus-summary-buffer)
5927       nil)))
5928
5929 (defun gnus-summary-set-current-mark (&optional current-mark)
5930   "Obsolete function."
5931   nil)
5932
5933 (defun gnus-summary-next-article (unread &optional subject)
5934   "Select the article after the current one.
5935 If UNREAD is non-nil, only unread articles are selected."
5936   (interactive "P")
5937   (let ((header nil))
5938     (cond ((gnus-summary-display-article
5939             (gnus-summary-search-forward unread subject)))
5940           ((and subject
5941                 gnus-auto-select-same
5942                 (gnus-set-difference gnus-newsgroup-unreads
5943                                      (append gnus-newsgroup-marked
5944                                              gnus-newsgroup-dormant))
5945                 (memq this-command
5946                       '(gnus-summary-next-unread-article
5947                         gnus-summary-next-page
5948                         gnus-summary-kill-same-subject-and-select
5949                         ;;gnus-summary-next-article
5950                         ;;gnus-summary-next-same-subject
5951                         ;;gnus-summary-next-unread-same-subject
5952                         )))
5953            ;; Wrap article pointer if there are unread articles.
5954            ;; Hook function, such as gnus-summary-rmail-digest, may
5955            ;; change current buffer, so need check.
5956            (let ((buffer (current-buffer))
5957                  (last-point (point)))
5958              ;; No more articles with same subject, so jump to the first
5959              ;; unread article.
5960              (gnus-summary-first-unread-article)
5961              ;;(and (eq buffer (current-buffer))
5962              ;; (= (point) last-point)
5963              ;; ;; Ignore given SUBJECT, and try again.
5964              ;; (gnus-summary-next-article unread nil))
5965              (and (eq buffer (current-buffer))
5966                   (< (point) last-point)
5967                   (message "Wrapped"))
5968              ))
5969           ((and gnus-auto-extend-newsgroup
5970                 (not unread)            ;Not unread only
5971                 (not subject)           ;Only if subject is not specified.
5972                 (setq header (gnus-more-header-forward)))
5973            ;; Extend to next article if possible.
5974            ;; Basic ideas by himacdonald@watdragon.waterloo.edu
5975            (gnus-extend-newsgroup header nil)
5976            ;; Threads feature must be turned off.
5977            (let ((buffer-read-only nil))
5978              (goto-char (point-max))
5979              (gnus-summary-prepare-threads (list header) 0))
5980            (gnus-summary-goto-article gnus-newsgroup-end))
5981           (t
5982            ;; Select next newsgroup automatically if requested.
5983            (gnus-summary-jump-to-group gnus-newsgroup-name)
5984            (let ((cmd (aref (this-command-keys) 0))
5985                  (group (gnus-summary-search-group nil gnus-keep-same-level))
5986                  (auto-select
5987                   (and gnus-auto-select-next
5988                        ;;(null (gnus-set-difference gnus-newsgroup-unreads
5989                        ;;                               gnus-newsgroup-marked))
5990                        (memq this-command
5991                              '(gnus-summary-next-unread-article
5992                                gnus-summary-next-article
5993                                gnus-summary-next-page
5994                                gnus-summary-next-same-subject
5995                                gnus-summary-next-unread-same-subject
5996                                gnus-summary-kill-same-subject
5997                                gnus-summary-kill-same-subject-and-select
5998                                ))
5999                        ;; Ignore characters typed ahead.
6000                        (not (input-pending-p))
6001                        )))
6002              ;; Keep just the event type of CMD.
6003              (if (listp cmd)
6004                  (setq cmd (car cmd)))
6005              (message "No more%s articles%s"
6006                       (if unread " unread" "")
6007                       (if (and auto-select
6008                                (not (eq gnus-auto-select-next 'quietly)))
6009                           (if group
6010                               (format " (Type %s for %s [%s])"
6011                                       (single-key-description cmd)
6012                                       group
6013                                       (car (gnus-gethash 
6014                                             group gnus-newsrc-hashtb)))
6015                             (format " (Type %s to exit %s)"
6016                                     (single-key-description cmd)
6017                                     gnus-newsgroup-name))
6018                         ""))
6019              ;; Select next unread newsgroup automagically.
6020              (cond ((and auto-select
6021                          (eq gnus-auto-select-next 'quietly))
6022                     ;; Select quietly.
6023                     (gnus-summary-next-group))
6024                    (auto-select
6025                     ;; Confirm auto selection.
6026                     (let* ((event (read-event))
6027                            (type
6028                             (if (listp event)
6029                                 (car event)
6030                               event)))
6031                       (if (and (eq event type) (eq event cmd))
6032                           (gnus-summary-next-group)
6033                         (setq unread-command-events (list event)))))
6034                    )
6035              ))
6036           )))
6037
6038 (defun gnus-summary-next-unread-article ()
6039   "Select unread article after current one."
6040   (interactive)
6041   (gnus-summary-next-article t (and gnus-auto-select-same
6042                                     (gnus-summary-subject-string)))
6043   (gnus-summary-position-cursor))
6044
6045 (defun gnus-summary-prev-article (unread &optional subject)
6046   "Select the article after the current one.
6047 If UNREAD is non-nil, only unread articles are selected."
6048   (interactive "P")
6049   (let ((header nil))
6050     (cond ((gnus-summary-display-article
6051             (gnus-summary-search-backward unread subject)))
6052           ((and subject
6053                 gnus-auto-select-same
6054                 (gnus-set-difference gnus-newsgroup-unreads
6055                                      (append gnus-newsgroup-marked
6056                                              gnus-newsgroup-dormant))
6057                 (memq this-command
6058                       '(gnus-summary-prev-unread-article
6059                         gnus-summary-prev-page)))
6060            ;; Wrap article pointer if there are unread articles.
6061            ;; Hook function, such as gnus-summary-rmail-digest, may
6062            ;; change current buffer, so need check.
6063            (let ((buffer (current-buffer))
6064                  (last-point (point)))
6065              ;; No more articles with same subject, so jump to the first
6066              ;; unread article.
6067              (gnus-summary-first-unread-article)
6068              (and (eq buffer (current-buffer))
6069                   (< (point) last-point)
6070                   (message "Wrapped"))
6071              ))
6072           ((and gnus-auto-extend-newsgroup
6073                 (not unread)            ;Not unread only
6074                 (not subject)           ;Only if subject is not specified.
6075                 (setq header (gnus-more-header-backward)))
6076            ;; Extend to next article if possible.
6077            ;; Basic ideas by himacdonald@watdragon.waterloo.edu
6078            (gnus-extend-newsgroup header t)
6079            ;; Threads feature must be turned off.
6080            (let ((buffer-read-only nil))
6081              (goto-char (point-min))
6082              (gnus-summary-prepare-threads (list header) 0))
6083            (gnus-summary-goto-article gnus-newsgroup-begin))
6084           (t
6085            ;; Select prev newsgroup automatically if requested.
6086            (gnus-summary-jump-to-group gnus-newsgroup-name)
6087            (let ((cmd (aref (this-command-keys) 0))
6088                  (group (gnus-summary-search-group t gnus-keep-same-level))
6089                  (auto-select
6090                   (and gnus-auto-select-next
6091                        (memq this-command
6092                              '(gnus-summary-prev-unread-article
6093                                gnus-summary-prev-article
6094                                gnus-summary-prev-page))
6095                        ;; Ignore characters typed ahead.
6096                        (not (input-pending-p)))))
6097              ;; Keep just the event type of CMD.
6098              (if (listp cmd)
6099                  (setq cmd (car cmd)))
6100              (message "No more%s articles%s"
6101                       (if unread " unread" "")
6102                       (if (and auto-select
6103                                (not (eq gnus-auto-select-next 'quietly)))
6104                           (if group
6105                               (format " (Type %s for %s [%s])"
6106                                       (single-key-description cmd)
6107                                       group
6108                                       (car (gnus-gethash 
6109                                             group gnus-newsrc-hashtb)))
6110                             (format " (Type %s to exit %s)"
6111                                     (single-key-description cmd)
6112                                     gnus-newsgroup-name))
6113                         ""))
6114              ;; Select next unread newsgroup automagically.
6115              (cond ((and auto-select
6116                          (eq gnus-auto-select-next 'quietly))
6117                     ;; Select quietly.
6118                     (gnus-summary-prev-group 1))
6119                    (auto-select
6120                     ;; Confirm auto selection.
6121                     (let* ((event (read-event))
6122                            (type
6123                             (if (listp event)
6124                                 (car event)
6125                               event)))
6126                       (if (and (eq event type) (eq event cmd))
6127                           (gnus-summary-prev-group 1)
6128                         (setq unread-command-events (list event)))))
6129                    )
6130              ))
6131           )))
6132
6133 (defun gnus-summary-prev-unread-article ()
6134   "Select unred article before current one."
6135   (interactive)
6136   (gnus-summary-prev-article t (and gnus-auto-select-same
6137                                     (gnus-summary-subject-string))))
6138
6139 (defun gnus-summary-next-page (lines &optional circular)
6140   "Show next page of selected article.
6141 If end of article, select next article.
6142 Argument LINES specifies lines to be scrolled up.
6143 If CIRCULAR is non-nil, go to the start of the article instead of 
6144 instead of selecting the next article when reaching the end of the
6145 current article." 
6146   (interactive "P")
6147   (setq gnus-summary-buffer (current-buffer))
6148   (let ((article (gnus-summary-article-number))
6149         (endp nil))
6150     (if (or (null gnus-current-article)
6151             (null gnus-article-current)
6152             (/= article (cdr gnus-article-current))
6153             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
6154         ;; Selected subject is different from current article's.
6155         (gnus-summary-display-article article)
6156       (gnus-configure-windows 'article)
6157       (pop-to-buffer gnus-summary-buffer)
6158       (gnus-eval-in-buffer-window
6159        gnus-article-buffer
6160        (setq endp (gnus-article-next-page lines)))
6161       (if endp
6162           (cond (circular
6163                  (gnus-summary-beginning-of-article))
6164                 (lines
6165                  (message "End of message"))
6166                 ((null lines)
6167                  (gnus-summary-next-unread-article))))
6168       (gnus-summary-position-cursor))))
6169
6170 (defun gnus-summary-prev-page (lines)
6171   "Show previous page of selected article.
6172 Argument LINES specifies lines to be scrolled down."
6173   (interactive "P")
6174   (let ((article (gnus-summary-article-number)))
6175     (if (or (null gnus-current-article)
6176             (null gnus-article-current)
6177             (/= article (cdr gnus-article-current))
6178             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
6179         ;; Selected subject is different from current article's.
6180         (gnus-summary-display-article article)
6181       (gnus-configure-windows 'article)
6182       (pop-to-buffer gnus-summary-buffer)
6183       (gnus-eval-in-buffer-window gnus-article-buffer
6184         (gnus-article-prev-page lines))
6185       (gnus-summary-position-cursor))))
6186
6187 (defun gnus-summary-scroll-up (lines)
6188   "Scroll up (or down) one line current article.
6189 Argument LINES specifies lines to be scrolled up (or down if negative)."
6190   (interactive "p")
6191   (or (gnus-summary-select-article nil nil 'pseudo)
6192       (gnus-eval-in-buffer-window 
6193        gnus-article-buffer
6194        (cond ((> lines 0)
6195               (if (gnus-article-next-page lines)
6196                   (message "End of message")))
6197              ((< lines 0)
6198               (gnus-article-prev-page (- lines))))))
6199   (gnus-summary-position-cursor))
6200
6201 (defun gnus-summary-next-same-subject ()
6202   "Select next article which has the same subject as current one."
6203   (interactive)
6204   (gnus-summary-next-article nil (gnus-summary-subject-string)))
6205
6206 (defun gnus-summary-prev-same-subject ()
6207   "Select previous article which has the same subject as current one."
6208   (interactive)
6209   (gnus-summary-prev-article nil (gnus-summary-subject-string)))
6210
6211 (defun gnus-summary-next-unread-same-subject ()
6212   "Select next unread article which has the same subject as current one."
6213   (interactive)
6214   (gnus-summary-next-article t (gnus-summary-subject-string)))
6215
6216 (defun gnus-summary-prev-unread-same-subject ()
6217   "Select previous unread article which has the same subject as current one."
6218   (interactive)
6219   (gnus-summary-prev-article t (gnus-summary-subject-string)))
6220
6221 (defun gnus-summary-first-unread-article ()
6222   "Select the first unread article. 
6223 Return nil if there are no unread articles."
6224   (interactive)
6225   (if (gnus-summary-first-subject t)
6226       (gnus-summary-display-article (gnus-summary-article-number))))
6227
6228 (defun gnus-summary-best-unread-article ()
6229   "Select the unread article with the highest score."
6230   (interactive)
6231   (let ((scored gnus-newsgroup-scored)
6232         (best -1000000)
6233         article art)
6234     (while scored
6235       (or (> best (cdr (car scored)))
6236           (and (memq (setq art (car (car scored))) gnus-newsgroup-unreads)
6237                (not (memq art gnus-newsgroup-marked))
6238                (not (memq art gnus-newsgroup-dormant))
6239                (if (= best (cdr (car scored)))
6240                    (setq article (min art article))
6241                  (setq article art)
6242                  (setq best (cdr (car scored))))))
6243       (setq scored (cdr scored)))
6244     (if article 
6245         (gnus-summary-goto-article article)
6246       (gnus-summary-first-unread-article))))
6247
6248 (defun gnus-summary-goto-article (article &optional all-headers)
6249   "Fetch ARTICLE and display it if it exists.
6250 If ALL-HEADERS is non-nil, no header lines are hidden."
6251   (interactive
6252    (list
6253     (string-to-int
6254      (completing-read 
6255       "Article number: "
6256       (mapcar (lambda (headers) (list (int-to-string (header-number headers))))
6257               gnus-newsgroup-headers) 
6258       nil 'require-match))))
6259   (if (gnus-summary-goto-subject article)
6260       (gnus-summary-display-article article all-headers)))
6261
6262 (defun gnus-summary-goto-last-article ()
6263   "Go to the last article."
6264   (interactive)
6265   (if gnus-last-article
6266       (gnus-summary-goto-article gnus-last-article)))
6267
6268 ;; Summary article oriented commands
6269
6270 (defun gnus-summary-refer-parent-article (n)
6271   "Refer parent article N times.
6272 The difference between N and the number of articles fetched is returned."
6273   (interactive "p")
6274   (while 
6275       (and 
6276        (> n 0)
6277        (let ((ref (header-references (gnus-get-header-by-number
6278                                       (gnus-summary-article-number)))))
6279          (if (and ref (not (equal ref ""))
6280                   (string-match "<[^<>]*>[ \t]*$" ref))
6281              (gnus-summary-refer-article 
6282               (substring ref (match-beginning 0) (match-end 0))))))
6283     (setq n (1- n)))
6284   (or (zerop n) (message "No references in article or expired article."))
6285   n)
6286     
6287 (defun gnus-summary-refer-article (message-id)
6288   "Refer article specified by MESSAGE-ID.
6289 NOTE: This command only works with newsgroup that use NNTP."
6290   (interactive "sMessage-ID: ")
6291   (if (or (not (stringp message-id))
6292           (zerop (length message-id)))
6293       ()
6294     ;; Construct the correct Message-ID if necessary.
6295     ;; Suggested by tale@pawl.rpi.edu.
6296     (or (string-match "^<" message-id)
6297         (setq message-id (concat "<" message-id)))
6298     (or (string-match ">$" message-id)
6299         (setq message-id (concat message-id ">")))
6300     (let ((header (car (gnus-gethash message-id gnus-newsgroup-dependencies))))
6301       (if header
6302           (gnus-summary-goto-article (header-number header))
6303         (if (gnus-article-prepare message-id nil (gnus-read-header message-id))
6304             (progn
6305               (gnus-summary-insert-line 
6306                nil gnus-current-headers 0 nil gnus-read-mark nil nil 
6307                (header-subject gnus-current-headers))
6308               (forward-line -1)
6309               (gnus-summary-position-cursor)
6310               (gnus-summary-update-line)
6311               message-id)
6312           (message "No such references")
6313           nil)))))
6314
6315 (defun gnus-summary-next-digest (nth)
6316   "Move to head of NTH next digested message."
6317   (interactive "p")
6318   (gnus-summary-select-article)
6319   (gnus-eval-in-buffer-window gnus-article-buffer
6320     (gnus-article-next-digest (or nth 1))
6321     ))
6322
6323 (defun gnus-summary-prev-digest (nth)
6324   "Move to head of NTH previous digested message."
6325   (interactive "p")
6326   (gnus-summary-select-article)
6327   (gnus-eval-in-buffer-window gnus-article-buffer
6328     (gnus-article-prev-digest (or nth 1))
6329     ))
6330
6331 (defun gnus-summary-rmail-digest ()
6332   "Run RMAIL on current digest article.
6333 gnus-select-digest-hook will be called with no arguments, if that
6334 value is non-nil. It is possible to modify the article so that Rmail
6335 can work with it.
6336 gnus-rmail-digest-hook will be called with no arguments, if that value
6337 is non-nil. The hook is intended to customize Rmail mode."
6338   (interactive)
6339   (gnus-summary-select-article)
6340   (require 'rmail)
6341   (let ((artbuf gnus-article-buffer)
6342         (digbuf (get-buffer-create gnus-digest-buffer))
6343         (mail-header-separator ""))
6344     (set-buffer digbuf)
6345     (gnus-add-current-to-buffer-list)
6346     (buffer-disable-undo (current-buffer))
6347     (setq buffer-read-only nil)
6348     (erase-buffer)
6349     (insert-buffer-substring artbuf)
6350     (run-hooks 'gnus-select-digest-hook)
6351     (gnus-convert-article-to-rmail)
6352     (goto-char (point-min))
6353     ;; Rmail initializations.
6354     (rmail-insert-rmail-file-header)
6355     (rmail-mode)
6356     (rmail-set-message-counters)
6357     (rmail-show-message)
6358     (condition-case ()
6359         (progn
6360           (undigestify-rmail-message)
6361           (rmail-expunge)               ;Delete original message.
6362           ;; File name is meaningless but `save-buffer' requires it.
6363           (setq buffer-file-name "Gnus Digest")
6364           (setq mode-line-buffer-identification
6365                 (concat "Digest: "
6366                         (header-subject gnus-current-headers)))
6367           ;; There is no need to write this buffer to a file.
6368           (make-local-variable 'write-file-hooks)
6369           (setq write-file-hooks
6370                 (list (lambda ()
6371                         (set-buffer-modified-p nil)
6372                         (message "(No changes need to be saved)")
6373                         'no-need-to-write-this-buffer)))
6374           ;; Default file name saving digest messages.
6375           (setq rmail-default-rmail-file
6376                 (funcall gnus-rmail-save-name gnus-newsgroup-name
6377                          gnus-current-headers gnus-newsgroup-last-rmail))
6378           (setq rmail-default-file
6379                 (funcall gnus-mail-save-name gnus-newsgroup-name
6380                          gnus-current-headers gnus-newsgroup-last-mail))
6381           ;; Prevent generating new buffer named ***<N> each time.
6382           (setq rmail-summary-buffer
6383                 (get-buffer-create gnus-digest-summary-buffer))
6384           (run-hooks 'gnus-rmail-digest-hook)
6385           ;; Take all windows safely.
6386           (gnus-configure-windows '(1 0 0))
6387           (pop-to-buffer gnus-group-buffer)
6388           ;; Use summary article windows for Digest summary and
6389           ;; Digest buffers.
6390           (if gnus-digest-show-summary
6391               (let ((gnus-summary-buffer gnus-digest-summary-buffer)
6392                     (gnus-article-buffer gnus-digest-buffer))
6393                 (gnus-configure-windows 'article)
6394                 (pop-to-buffer gnus-digest-buffer)
6395                 (rmail-summary)
6396                 (pop-to-buffer gnus-digest-summary-buffer)
6397                 (message (substitute-command-keys
6398                           "Type \\[rmail-summary-quit] to return to Gnus")))
6399             (let ((gnus-summary-buffer gnus-digest-buffer))
6400               (gnus-configure-windows 'summary)
6401               (pop-to-buffer gnus-digest-buffer)
6402               (message (substitute-command-keys
6403                         "Type \\[rmail-quit] to return to Gnus")))
6404             )
6405           ;; Move the buffers to the end of buffer list.
6406           (bury-buffer gnus-article-buffer)
6407           (bury-buffer gnus-group-buffer)
6408           (bury-buffer gnus-digest-summary-buffer)
6409           (bury-buffer gnus-digest-buffer))
6410       (error (set-buffer-modified-p nil)
6411              (kill-buffer digbuf)
6412              ;; This command should not signal an error because the
6413              ;; command is called from hooks.
6414              (ding) (message "Article is not a digest")))
6415     ))
6416
6417 (defun gnus-summary-isearch-article ()
6418   "Do incremental search forward on current article."
6419   (interactive)
6420   (gnus-summary-select-article)
6421   (gnus-eval-in-buffer-window gnus-article-buffer
6422                               (isearch-forward)))
6423
6424 (defun gnus-summary-search-article-forward (regexp)
6425   "Search for an article containing REGEXP forward.
6426 gnus-select-article-hook is not called during the search."
6427   (interactive
6428    (list (read-string
6429           (concat "Search forward (regexp): "
6430                   (if gnus-last-search-regexp
6431                       (concat "(default " gnus-last-search-regexp ") "))))))
6432   (if (string-equal regexp "")
6433       (setq regexp (or gnus-last-search-regexp ""))
6434     (setq gnus-last-search-regexp regexp))
6435   (if (gnus-summary-search-article regexp nil)
6436       (gnus-eval-in-buffer-window gnus-article-buffer
6437         (recenter 0)
6438         ;;(sit-for 1)
6439         )
6440     (error "Search failed: \"%s\"" regexp)
6441     ))
6442
6443 (defun gnus-summary-search-article-backward (regexp)
6444   "Search for an article containing REGEXP backward.
6445 gnus-select-article-hook is not called during the search."
6446   (interactive
6447    (list (read-string
6448           (concat "Search backward (regexp): "
6449                   (if gnus-last-search-regexp
6450                       (concat "(default " gnus-last-search-regexp ") "))))))
6451   (if (string-equal regexp "")
6452       (setq regexp (or gnus-last-search-regexp ""))
6453     (setq gnus-last-search-regexp regexp))
6454   (if (gnus-summary-search-article regexp t)
6455       (gnus-eval-in-buffer-window gnus-article-buffer
6456         (recenter 0)
6457         ;;(sit-for 1)
6458         )
6459     (error "Search failed: \"%s\"" regexp)
6460     ))
6461
6462 (defun gnus-summary-search-article (regexp &optional backward)
6463   "Search for an article containing REGEXP.
6464 Optional argument BACKWARD means do search for backward.
6465 gnus-select-article-hook is not called during the search."
6466   (let ((gnus-select-article-hook nil)  ;Disable hook.
6467         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
6468         (re-search
6469          (if backward
6470              (function re-search-backward) (function re-search-forward)))
6471         (found nil)
6472         (last nil))
6473     ;; Hidden thread subtrees must be searched for ,too.
6474     (gnus-summary-show-all-threads)
6475     ;; First of all, search current article.
6476     ;; We don't want to read article again from NNTP server nor reset
6477     ;; current point.
6478     (gnus-summary-select-article)
6479     (message "Searching article: %d..." gnus-current-article)
6480     (setq last gnus-current-article)
6481     (gnus-eval-in-buffer-window gnus-article-buffer
6482       (save-restriction
6483         (widen)
6484         ;; Begin search from current point.
6485         (setq found (funcall re-search regexp nil t))))
6486     ;; Then search next articles.
6487     (while (and (not found)
6488                 (gnus-summary-display-article 
6489                  (gnus-summary-search-subject backward nil nil)))
6490       (message "Searching article: %d..." gnus-current-article)
6491       (gnus-eval-in-buffer-window gnus-article-buffer
6492         (save-restriction
6493           (widen)
6494           (goto-char (if backward (point-max) (point-min)))
6495           (setq found (funcall re-search regexp nil t)))
6496         ))
6497     (message "")
6498     ;; Adjust article pointer.
6499     (or (eq last gnus-current-article)
6500         (setq gnus-last-article last))
6501     ;; Return T if found such article.
6502     found
6503     ))
6504
6505 (defun gnus-summary-execute-command (field regexp command &optional backward)
6506   "If FIELD of article header matches REGEXP, execute a COMMAND string.
6507 If FIELD is an empty string (or nil), entire article body is searched for.
6508 If optional (prefix) argument BACKWARD is non-nil, do backward instead."
6509   (interactive
6510    (list (let ((completion-ignore-case t))
6511            (completing-read "Field name: "
6512                             '(("Number")("Subject")("From")
6513                               ("Lines")("Date")("Id")
6514                               ("Xref")("References"))
6515                             nil 'require-match))
6516          (read-string "Regexp: ")
6517          (read-key-sequence "Command: ")
6518          current-prefix-arg))
6519   ;; Hidden thread subtrees must be searched for ,too.
6520   (gnus-summary-show-all-threads)
6521   ;; We don't want to change current point nor window configuration.
6522   (save-excursion
6523     (save-window-excursion
6524       (message "Executing %s..." (key-description command))
6525       ;; We'd like to execute COMMAND interactively so as to give arguments.
6526       (gnus-execute field regexp
6527                     (` (lambda ()
6528                          (call-interactively '(, (key-binding command)))))
6529                     backward)
6530       (message "Executing %s... done" (key-description command)))))
6531
6532 (defun gnus-summary-beginning-of-article ()
6533   "Scroll the article back to the beginning."
6534   (interactive)
6535   (gnus-summary-select-article)
6536   (gnus-eval-in-buffer-window gnus-article-buffer
6537     (widen)
6538     (goto-char (point-min))
6539     (if gnus-break-pages
6540         (gnus-narrow-to-page))
6541     ))
6542
6543 (defun gnus-summary-end-of-article ()
6544   "Scroll to the end of the article."
6545   (interactive)
6546   (gnus-summary-select-article)
6547   (gnus-eval-in-buffer-window gnus-article-buffer
6548     (widen)
6549     (goto-char (point-max))
6550     (if gnus-break-pages
6551         (gnus-narrow-to-page))
6552     ))
6553
6554 (defun gnus-summary-show-article ()
6555   "Force re-fetching of the current article."
6556   (interactive)
6557   (gnus-summary-select-article gnus-have-all-headers t t))
6558
6559 (defun gnus-summary-toggle-header (arg)
6560   "Show the headers if they are hidden, or hide them if they are shown.
6561 If ARG is a positive number, show the entire header.
6562 If ARG is a negative number, hide the unwanted header lines."
6563   (interactive "P")
6564   (save-excursion
6565     (set-buffer gnus-article-buffer)
6566     (let ((buffer-read-only nil))
6567       (if (numberp arg) 
6568           (if (> arg 0) (remove-text-properties 1 (point-max) '(invisible t))
6569             (if (< arg 0) (run-hooks 'gnus-article-display-hook)))
6570         (if (text-property-any 1 (point-max) 'invisible t)
6571             (remove-text-properties 1 (point-max) '(invisible t))
6572           (run-hooks 'gnus-article-display-hook))))))
6573
6574 (defun gnus-summary-show-all-headers ()
6575   "Make all header lines visible."
6576   (interactive)
6577   (gnus-article-show-all-headers))
6578
6579 (defun gnus-summary-toggle-mime (arg)
6580   "Toggle MIME processing.
6581 If ARG is a positive number, turn MIME processing on."
6582   (interactive "P")
6583   (setq gnus-show-mime
6584         (if (null arg) (not gnus-show-mime)
6585           (> (prefix-numeric-value arg) 0)))
6586   (gnus-summary-select-article t 'force))
6587
6588 (defun gnus-summary-caesar-message (rotnum)
6589   "Caesar rotates all letters of current message by 13/47 places.
6590 With prefix arg, specifies the number of places to rotate each letter forward.
6591 Caesar rotates Japanese letters by 47 places in any case."
6592   (interactive "P")
6593   (gnus-summary-select-article)
6594   (gnus-overload-functions)
6595   (gnus-eval-in-buffer-window gnus-article-buffer
6596     (save-restriction
6597       (widen)
6598       ;; We don't want to jump to the beginning of the message.
6599       ;; `save-excursion' does not do its job.
6600       (move-to-window-line 0)
6601       (let ((last (point)))
6602         (news-caesar-buffer-body rotnum)
6603         (goto-char last)
6604         (recenter 0)
6605         ))
6606     ))
6607
6608 (defun gnus-summary-stop-page-breaking ()
6609   "Stop page breaking in the current article."
6610   (interactive)
6611   (gnus-summary-select-article)
6612   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
6613
6614 ;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
6615
6616 (defun gnus-summary-move-article (n &optional to-newsgroup select-method)
6617   "Move the current article to a different newsgroup.
6618 If N is a positive number, move the N next articles.
6619 If N is a negative number, move the N previous articles.
6620 If N is nil and any articles have been marked with the process mark,
6621 move those articles instead.
6622 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. 
6623 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
6624 re-spool using this method.
6625 For this function to work, both the current newsgroup and the
6626 newsgroup that you want to move to have to support the `request-move'
6627 and `request-accept' functions. (Ie. mail newsgroups at present.)"
6628   (interactive "P")
6629   (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)
6630       (error "The current newsgroup does not support article moving"))
6631   (let (articles art-group)
6632     (if (and n (numberp n))
6633         (let ((backward (< n 0))
6634               (n (abs n)))
6635           (save-excursion
6636             (while (and (> n 0)
6637                         (setq articles (cons (gnus-summary-article-number) 
6638                                              articles))
6639                         (gnus-summary-search-forward nil nil backward))
6640               (setq n (1- n))))
6641           (setq articles (sort articles (function <))))
6642       (setq articles (or (setq gnus-newsgroup-processable
6643                                (sort gnus-newsgroup-processable (function <)))
6644                          (list (gnus-summary-article-number)))))
6645     (if (and (not to-newsgroup) (not select-method))
6646         (setq to-newsgroup
6647               (completing-read 
6648                (format "Where do you want to move %s? "
6649                        (if (> (length articles) 1)
6650                            (format "these %d articles" (length articles))
6651                          "this article"))
6652                gnus-active-hashtb nil t)))
6653     (or (gnus-check-backend-function 'request-accept-article 
6654                                      (or select-method to-newsgroup))
6655         (error "%s does not support article moving" to-newsgroup))
6656     (message "Moving to %s: %s..." (or select-method to-newsgroup) articles)
6657     (while articles
6658       (if (setq art-group
6659                 (gnus-request-move-article 
6660                  (car articles)
6661                  gnus-newsgroup-name 
6662                  (nth 1 (gnus-find-method-for-group gnus-newsgroup-name))
6663                  (list 'gnus-request-accept-article 
6664                        (if select-method
6665                            (quote select-method)
6666                          to-newsgroup))))
6667           (let* ((buffer-read-only nil)
6668                  (entry 
6669                   (or
6670                    (gnus-gethash (car art-group) gnus-newsrc-hashtb)
6671                    (gnus-gethash 
6672                     (gnus-group-prefixed-name 
6673                      (car art-group) 
6674                      (if select-method (list select-method "")
6675                        (gnus-find-method-for-group to-newsgroup)))
6676                     gnus-newsrc-hashtb)))
6677                  (info (nth 2 entry))
6678                  (article (car articles))
6679                  (marked (nth 3 info)))
6680             (gnus-summary-goto-subject article)
6681             (delete-region (progn (beginning-of-line) (point))
6682                            (progn (forward-line 1) (point)))
6683             (if (not (memq article gnus-newsgroup-unreads))
6684                 (setcar (cdr (cdr info))
6685                         (gnus-add-to-range (nth 2 info) 
6686                                            (list (cdr art-group)))))
6687             ;; !!! Here one should copy all the marks over to the new
6688             ;; newsgroup, but I couldn't be bothered. nth on that!
6689             )
6690         (message "Couldn't move article %s" (car articles)))
6691       (setq articles (cdr articles)))))
6692
6693 (defun gnus-summary-respool-article (n &optional respool-method)
6694   "Respool the current article.
6695 The article will be squeezed through the mail spooling process again,
6696 which means that it will be put in some mail newsgroup or other
6697 depending on `nnmail-split-methods'.
6698 If N is a positive number, respool the N next articles.
6699 If N is a negative number, respool the N previous articles.
6700 If N is nil and any articles have been marked with the process mark,
6701 respool those articles instead.
6702 For this function to work, both the current newsgroup and the
6703 newsgroup that you want to move to have to support the `request-move'
6704 and `request-accept' functions. (Ie. mail newsgroups at present.)"
6705   (interactive "P")
6706   (or respool-method
6707       (setq respool-method
6708             (completing-read
6709              "What method do you want to use when respooling? "
6710              (gnus-methods-using 'respool) nil t)))
6711   (gnus-summary-move-article n nil (intern respool-method)))
6712
6713 ;; Summary score commands.
6714
6715 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
6716
6717 (defun gnus-summary-raise-score (n)
6718   "Raise the score of the current article by N."
6719   (interactive "p")
6720   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
6721
6722 (defun gnus-summary-lower-score (n)
6723   "Lower the score of the current article by N."
6724   (interactive "p")
6725   (gnus-summary-raise-score (- n)))
6726
6727 (defun gnus-summary-set-score (n)
6728   "Set the score of the current article to N."
6729   (interactive "p")
6730   ;; Skip dummy header line.
6731   (save-excursion
6732     (if (= (gnus-summary-article-mark) ?Z) (forward-line 1))
6733     (let ((buffer-read-only nil))
6734       ;; Set score.
6735       (beginning-of-line)
6736       (forward-char 2)
6737       (delete-char 1)
6738       (insert (if (= n gnus-summary-default-score) ? 
6739                 (if (< n gnus-summary-default-score) ?- ?+))))
6740     (let* ((article (gnus-summary-article-number))
6741            (score (assq article gnus-newsgroup-scored)))
6742       (if score (setcdr score n)
6743         (setq gnus-newsgroup-scored 
6744               (cons (cons article n) gnus-newsgroup-scored))))
6745     (gnus-summary-update-line)))
6746
6747 (defmacro gnus-raise (field expression level)
6748   (` (gnus-kill (, field) (, expression)
6749                 (function (gnus-summary-raise-score (, level))) t)))
6750
6751 (defmacro gnus-lower (field expression level)
6752   (` (gnus-kill (, field) (, expression)
6753                 (function (gnus-summary-raise-score (- (, level)))) t)))
6754
6755 ;; Summary marking commands.
6756
6757 (defun gnus-summary-raise-same-subject-and-select (score)
6758   "Raise articles which has the same subject with SCORE and select the next."
6759   (interactive "p")
6760   (let ((subject (gnus-summary-subject-string)))
6761     (gnus-summary-raise-score score)
6762     (while (gnus-summary-search-subject nil nil subject)
6763       (gnus-summary-raise-score score))
6764     (gnus-summary-next-article t)))
6765
6766 (defun gnus-summary-raise-same-subject (score)
6767   "Raise articles which has the same subject with SCORE."
6768   (interactive "p")
6769   (let ((subject (gnus-summary-subject-string)))
6770     (gnus-summary-raise-score score)
6771     (while (gnus-summary-search-subject nil nil subject)
6772       (gnus-summary-raise-score score))
6773     (gnus-summary-next-subject 1 t)))
6774
6775 (defun gnus-summary-raise-thread (score)
6776   "Raise articles under current thread with SCORE."
6777   (interactive "p")
6778   (let (e)
6779     (save-excursion
6780       (let ((level (gnus-summary-thread-level)))
6781         (gnus-summary-raise-score score)
6782         (while (and (zerop (gnus-summary-next-subject 1))
6783                     (> (gnus-summary-thread-level) level))
6784           (gnus-summary-raise-score score))
6785         (setq e (point))))
6786     (or (zerop (gnus-summary-next-subject 1 t))
6787         (goto-char e)))
6788   (gnus-summary-position-cursor))
6789
6790 (defun gnus-summary-lower-same-subject-and-select (score)
6791   "Raise articles which has the same subject with SCORE and select the next."
6792   (interactive "p")
6793   (gnus-summary-raise-same-subject-and-select (- score)))
6794
6795 (defun gnus-summary-lower-same-subject (score)
6796   "Raise articles which has the same subject with SCORE."
6797   (interactive "p")
6798   (gnus-summary-raise-same-subject (- score)))
6799
6800 (defun gnus-summary-lower-thread (score)
6801   "Raise articles under current thread with SCORE."
6802   (interactive "p")
6803   (gnus-summary-raise-thread (- score)))
6804
6805 (defun gnus-summary-kill-same-subject-and-select (unmark)
6806   "Mark articles which has the same subject as read, and then select the next.
6807 If UNMARK is positive, remove any kind of mark.
6808 If UNMARK is negative, tick articles."
6809   (interactive "P")
6810   (if unmark
6811       (setq unmark (prefix-numeric-value unmark)))
6812   (let ((count
6813          (gnus-summary-mark-same-subject
6814           (gnus-summary-subject-string) unmark)))
6815     ;; Select next unread article. If auto-select-same mode, should
6816     ;; select the first unread article.
6817     (gnus-summary-next-article t (and gnus-auto-select-same
6818                                       (gnus-summary-subject-string)))
6819     (message "%d articles are marked as %s"
6820              count (if unmark "unread" "read"))
6821     ))
6822
6823 (defun gnus-summary-kill-same-subject (unmark)
6824   "Mark articles which has the same subject as read. 
6825 If UNMARK is positive, remove any kind of mark.
6826 If UNMARK is negative, tick articles."
6827   (interactive "P")
6828   (if unmark
6829       (setq unmark (prefix-numeric-value unmark)))
6830   (let ((count
6831          (gnus-summary-mark-same-subject
6832           (gnus-summary-subject-string) unmark)))
6833     ;; If marked as read, go to next unread subject.
6834     (if (null unmark)
6835         ;; Go to next unread subject.
6836         (gnus-summary-next-subject 1 t))
6837     (message "%d articles are marked as %s"
6838              count (if unmark "unread" "read"))
6839     ))
6840
6841 (defun gnus-summary-mark-same-subject (subject &optional unmark)
6842   "Mark articles with same SUBJECT as read, and return marked number.
6843 If optional argument UNMARK is positive, remove any kinds of marks.
6844 If optional argument UNMARK is negative, mark articles as unread instead."
6845   (let ((count 1))
6846     (save-excursion
6847       (cond ((null unmark)
6848              (gnus-summary-mark-as-read nil gnus-killed-mark))
6849             ((> unmark 0)
6850              (gnus-summary-tick-article nil t))
6851             (t
6852              (gnus-summary-tick-article)))
6853       (while (and subject
6854                   (gnus-summary-search-forward nil subject))
6855         (cond ((null unmark)
6856                (gnus-summary-mark-as-read nil gnus-killed-mark))
6857               ((> unmark 0)
6858                (gnus-summary-tick-article nil t))
6859               (t
6860                (gnus-summary-tick-article)))
6861         (setq count (1+ count))
6862         ))
6863     ;; Hide killed thread subtrees.  Does not work properly always.
6864     ;;(and (null unmark)
6865     ;;     gnus-thread-hide-killed
6866     ;;     (gnus-summary-hide-thread))
6867     ;; Return number of articles marked as read.
6868     count
6869     ))
6870
6871 (defun gnus-summary-mark-as-processable (n &optional unmark)
6872   "Set the process mark on the next N articles.
6873 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
6874 the process mark instead.  The difference between N and the actual
6875 number of articles marked is returned."
6876   (interactive "p")
6877   (let ((backward (< n 0))
6878         (n (abs n)))
6879   (while (and 
6880           (> n 0)
6881           (if unmark
6882               (gnus-summary-remove-process-mark (gnus-summary-article-number))
6883             (gnus-summary-set-process-mark (gnus-summary-article-number)))
6884           (zerop (gnus-summary-next-subject (if backward -1 1))))
6885     (setq n (1- n)))
6886   (if (/= 0 n) (message "No more articles"))
6887   n))
6888
6889 (defun gnus-summary-unmark-as-processable (n)
6890   "Remove the process mark from the next N articles.
6891 If N is negative, mark backward instead.  The difference between N and
6892 the actual number of articles marked is returned."
6893   (interactive "p")
6894   (gnus-summary-mark-as-processable n t))
6895
6896 (defun gnus-summary-unmark-all-processable ()
6897   "Remove the process mark from all articles."
6898   (interactive)
6899   (save-excursion
6900     (while gnus-newsgroup-processable
6901       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
6902   (gnus-summary-position-cursor))
6903
6904 (defun gnus-summary-mark-as-expirable (n)
6905   "Mark N articles forward as expirable.
6906 If N is negative, mark backward instead. The difference between N and
6907 the actual number of articles marked is returned."
6908   (interactive "p")
6909   (gnus-summary-mark-forward n gnus-expirable-mark))
6910
6911 (defun gnus-summary-expire-articles ()
6912   "Expire all articles that are marked as expirable in the current group."
6913   (interactive)
6914   (if (and gnus-newsgroup-expirable
6915            (gnus-check-backend-function 
6916             'gnus-request-expire-articles gnus-newsgroup-name))
6917       (let ((expirable gnus-newsgroup-expirable))
6918         ;; The list of articles that weren't expired is returned.
6919         (setq gnus-newsgroup-expirable 
6920               (gnus-request-expire-articles gnus-newsgroup-expirable
6921                                             gnus-newsgroup-name))
6922         ;; We go through the old list of expirable, and mark all
6923         ;; really expired articles as non-existant.
6924         (while expirable
6925           (or (memq (car expirable) gnus-newsgroup-expirable)
6926               (gnus-summary-mark-as-read (car expirable) "%"))
6927           (setq expirable (cdr expirable))))))
6928
6929 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
6930 (defun gnus-summary-delete-article (n)
6931   "Delete the N next (mail) articles.
6932 This command actually deletes articles. This is not a marking
6933 command. The article will disappear forever from you life, never to
6934 return. 
6935 If N is negative, delete backwards.
6936 If N is nil and articles have been marked with the process mark,
6937 delete these instead."
6938   (interactive "P")
6939   (or (gnus-check-backend-function 'request-expire-articles 
6940                                    gnus-newsgroup-name)
6941       (error "The current newsgroup does not support article deletion."))
6942   ;; Compute the list of articles to delete.
6943   (let (articles)
6944     (if (and n (numberp n))
6945         (let ((backward (< n 0))
6946               (n (abs n)))
6947           (save-excursion
6948             (while (and (> n 0)
6949                         (setq articles (cons (gnus-summary-article-number) 
6950                                              articles))
6951                         (gnus-summary-search-forward nil nil backward))
6952               (setq n (1- n))))
6953           (setq articles (sort articles (function <))))
6954       (setq articles (or (setq gnus-newsgroup-processable
6955                                (sort gnus-newsgroup-processable (function <)))
6956                          (list (gnus-summary-article-number)))))
6957     (if (and gnus-novice-user
6958              (not (y-or-n-p 
6959                    (format "Do you really want to delete %s forever?"
6960                            (if (> (length articles) 1) "these articles"
6961                              "this article")))))
6962         ()
6963       ;; Delete the articles.
6964       (setq gnus-newsgroup-expirable 
6965             (gnus-request-expire-articles 
6966              articles gnus-newsgroup-name 'force)))))
6967
6968 (defun gnus-summary-mark-article-as-replied (article)
6969   "Mark ARTICLE replied and update the summary line."
6970   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
6971   (let ((buffer-read-only nil))
6972     (if (gnus-summary-goto-subject article)
6973         (progn
6974           (beginning-of-line)
6975           (forward-char 1)
6976           (delete-char 1)
6977           (insert gnus-replied-mark)
6978           t))))
6979
6980 (defun gnus-summary-set-bookmark (article)
6981   "Set a bookmark in current article."
6982   (interactive (list (gnus-summary-article-number)))
6983   (if (or (not (get-buffer gnus-article-buffer))
6984           (not gnus-current-article)
6985           (not gnus-article-current)
6986           (not (equal gnus-newsgroup-name (car gnus-article-current))))
6987       (error "No current article selected"))
6988   ;; Remove old bookmark, if one exists.
6989   (let ((old (assq article gnus-newsgroup-bookmarks)))
6990     (if old (setq gnus-newsgroup-bookmarks 
6991                   (delq old gnus-newsgroup-bookmarks))))
6992   ;; Set the new bookmark, which is on the form 
6993   ;; (article-number . line-number-in-body).
6994   (setq gnus-newsgroup-bookmarks 
6995         (cons 
6996          (cons article 
6997                (save-excursion
6998                  (set-buffer gnus-article-buffer)
6999                  (count-lines
7000                   (min (point)
7001                        (save-excursion
7002                          (goto-char 1)
7003                          (search-forward "\n\n" nil t)
7004                          (point)))
7005                   (point))))
7006          gnus-newsgroup-bookmarks))
7007   (message "A bookmark has been added to the current article."))
7008
7009 (defun gnus-summary-remove-bookmark (article)
7010   "Remove the bookmark from the current article."
7011   (interactive (list (gnus-summary-article-number)))
7012   ;; Remove old bookmark, if one exists.
7013   (let ((old (assq article gnus-newsgroup-bookmarks)))
7014     (if old 
7015         (progn
7016           (setq gnus-newsgroup-bookmarks 
7017                 (delq old gnus-newsgroup-bookmarks))
7018           (message "Removed bookmark."))
7019       (message "No bookmark in current article."))))
7020
7021 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
7022 (defun gnus-summary-mark-as-dormant (n)
7023   "Mark N articles forward as dormant.
7024 If N is negative, mark backward instead.  The difference between N and
7025 the actual number of articles marked is returned."
7026   (interactive "p")
7027   (gnus-summary-mark-forward n gnus-dormant-mark))
7028
7029 (defun gnus-summary-set-process-mark (article)
7030   "Set the process mark on ARTICLE and update the summary line."
7031   (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable))
7032   (let ((buffer-read-only nil))
7033     (if (gnus-summary-goto-subject article)
7034         (progn
7035           (if (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7036           (beginning-of-line)
7037           (forward-char 1)
7038           (delete-char 1)
7039           (insert gnus-process-mark)
7040           (gnus-summary-update-line)
7041           t))))
7042
7043 (defun gnus-summary-remove-process-mark (article)
7044   "Remove the process mark from ARTICLE and update the summary line."
7045   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
7046   (let ((buffer-read-only nil))
7047     (if (gnus-summary-goto-subject article)
7048         (progn
7049           (and (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7050           (beginning-of-line)
7051           (forward-char 1)
7052           (delete-char 1)
7053           (insert (if (memq article gnus-newsgroup-replied) 
7054                       gnus-replied-mark ? ))
7055           (gnus-summary-update-line)
7056           t))))
7057
7058 (defun gnus-summary-mark-forward (n &optional mark)
7059   "Mark N articles as read forwards.
7060 If N is negative, mark backwards instead.
7061 Mark with MARK. If MARK is ? , ?! or ??, articles will be
7062 marked as unread. 
7063 The difference between N and the actual number of articles marked is
7064 returned."
7065   (interactive "p")
7066   (let ((backward (< n 0))
7067         (n (abs n))
7068         (mark (or mark gnus-read-mark)))
7069   (while (and (> n 0)
7070               (gnus-summary-mark-article nil mark)
7071               (zerop (gnus-summary-next-subject (if backward -1 1))))
7072     (setq n (1- n)))
7073   (if (/= 0 n) (message "No more %sarticles" (if mark "" "unread ")))
7074   (gnus-set-mode-line 'summary)
7075   n))
7076
7077 (defun gnus-summary-mark-article (&optional article mark)
7078   "Mark ARTICLE with MARK.
7079 MARK can be any character.
7080 Five MARK strings are reserved: ?  (unread), 
7081 ?! (ticked), ?? (dormant), ?D (read), ?E (expirable).
7082 If MARK is nil, then the default character ?D is used.
7083 If ARTICLE is nil, then the article on the current line will be
7084 marked." 
7085   ;; If no mark is given, then we check auto-expiring.
7086   (and (or (not mark)
7087            (and (numberp mark) (= mark gnus-killed-mark)))
7088        (and gnus-newsgroup-auto-expire (setq mark gnus-expirable-mark)))
7089   (let* ((buffer-read-only nil)
7090          (mark (or (and (stringp mark) (aref mark 0)) mark gnus-read-mark))
7091          (article (or article (gnus-summary-article-number))))
7092     (if (or (= mark gnus-unread-mark) 
7093             (= mark gnus-ticked-mark) 
7094             (= mark gnus-dormant-mark))
7095         (gnus-mark-article-as-unread article mark)
7096       (gnus-mark-article-as-read article mark))
7097     (if (gnus-summary-goto-subject article)
7098         (progn
7099           (gnus-summary-show-thread)
7100           (beginning-of-line)
7101           (if (= (gnus-summary-article-mark) ?Z) (forward-line 1))
7102           ;; Fix the mark.
7103           (let ((plist (text-properties-at (point))))
7104             (delete-char 1)
7105             (setcar (cdr (memq 'gnus-mark plist)) mark)
7106             (insert mark)
7107             (add-text-properties (1- (point)) (point) plist))
7108           t))))
7109
7110 (defun gnus-mark-article-as-read (article &optional mark)
7111   "Enter ARTICLE in the pertinent lists and remove it from others."
7112   ;; Make the article expirable.
7113   (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-read-mark)))
7114     (if (= mark gnus-expirable-mark)
7115         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
7116       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
7117     ;; Remove from unread and marked lists.
7118     (setq gnus-newsgroup-unreads
7119           (delq article gnus-newsgroup-unreads))
7120     (setq gnus-newsgroup-marked
7121           (delq article gnus-newsgroup-marked))
7122     (setq gnus-newsgroup-dormant
7123           (delq article gnus-newsgroup-dormant))))
7124
7125 (defun gnus-mark-article-as-unread (article &optional mark)
7126   "Enter ARTICLE in the pertinent lists and remove it from others."
7127   (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-ticked-mark)))
7128     ;; Add to unread list.
7129     (or (memq article gnus-newsgroup-unreads)
7130         (setq gnus-newsgroup-unreads
7131               (cons article gnus-newsgroup-unreads)))
7132     ;; If CLEAR-MARK is non-nil, the article must be removed from marked
7133     ;; list.  Otherwise, it must be added to the list.
7134     (setq gnus-newsgroup-marked
7135           (delq article gnus-newsgroup-marked))
7136     (setq gnus-newsgroup-dormant
7137           (delq article gnus-newsgroup-dormant))
7138     (setq gnus-newsgroup-expirable 
7139           (delq article gnus-newsgroup-expirable))
7140     (if (= mark gnus-ticked-mark)
7141         (setq gnus-newsgroup-marked 
7142               (cons article gnus-newsgroup-marked)))
7143     (if (= mark gnus-dormant-mark)
7144         (setq gnus-newsgroup-dormant 
7145               (cons article gnus-newsgroup-dormant)))))
7146
7147 (defalias 'gnus-summary-mark-as-unread-forward 
7148   'gnus-summary-tick-article-forward)
7149 (make-obsolete 'gnus-summary-mark-as-unread-forward 
7150                'gnus-summary-tick-article--forward)
7151 (defun gnus-summary-tick-article-forward (n)
7152   "Tick N articles forwards.
7153 If N is negative, tick backwards instead.
7154 The difference between N and the number of articles ticked is returned."
7155   (interactive "p")
7156   (gnus-summary-mark-forward n gnus-ticked-mark))
7157
7158 (defalias 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward)
7159 (make-obsolete 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward)
7160 (defun gnus-summary-tick-article-backward (n)
7161   "Tick N articles backwards.
7162 The difference between N and the number of articles ticked is returned."
7163   (interactive "p")
7164   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
7165
7166 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
7167 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
7168 (defun gnus-summary-tick-article (&optional article clear-mark)
7169   "Mark current article as unread.
7170 Optional 1st argument ARTICLE specifies article number to be marked as unread.
7171 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
7172   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
7173                                        gnus-ticked-mark)))
7174
7175 (defun gnus-summary-mark-as-read-forward (n)
7176   "Mark N articles as read forwards.
7177 If N is negative, mark backwards instead.
7178 The difference between N and the actual number of articles marked is
7179 returned."
7180   (interactive "p")
7181   (gnus-summary-mark-forward n))
7182
7183 (defun gnus-summary-mark-as-read-backward (n)
7184   "Mark the N articles as read backwards.
7185 The difference between N and the actual number of articles marked is
7186 returned."
7187   (interactive "p")
7188   (gnus-summary-mark-forward (- n)))
7189
7190 (defun gnus-summary-mark-as-read (&optional article mark)
7191   "Mark current article as read.
7192 ARTICLE specifies the article to be marked as read.
7193 MARK specifies a string to be inserted at the beginning of the line.
7194 Any kind of string (length 1) except for a space and `-' is ok."
7195   (gnus-summary-mark-article article mark))
7196
7197 (defun gnus-summary-clear-mark-forward (n)
7198   "Clear marks from N articles forward.
7199 If N is negative, clear backward instead.
7200 The difference between N and the number of marks cleared is returned."
7201   (interactive "p")
7202   (gnus-summary-mark-forward n gnus-unread-mark))
7203
7204 (defun gnus-summary-clear-mark-backward (n)
7205   "Clear marks from N articles backward.
7206 The difference between N and the number of marks cleared is returned."
7207   (interactive "p")
7208   (gnus-summary-mark-forward (- n) gnus-unread-mark))
7209
7210 ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
7211 (defalias 'gnus-summary-delete-marked-as-read 
7212   'gnus-summary-remove-lines-marked-as-read)
7213 (make-obsolete 'gnus-summary-delete-marked-as-read 
7214                'gnus-summary-remove-lines-marked-as-read)
7215 (defun gnus-summary-remove-lines-marked-as-read ()
7216   "Remove lines that are marked as read."
7217   (interactive)
7218   (gnus-summary-remove-lines-marked-with 
7219    (concat (mapconcat
7220             (lambda (char) (char-to-string (symbol-value char)))
7221             '(gnus-read-mark 
7222               gnus-killed-mark gnus-kill-file-mark
7223               gnus-low-score-mark gnus-expirable-mark)
7224             ""))))
7225
7226 (defalias 'gnus-summary-delete-marked-with 
7227   'gnus-summary-remove-lines-marked-with)
7228 (make-obsolete 'gnus-summary-delete-marked-with 
7229                'gnus-summary-remove-lines-marked-with)
7230 ;; Rewrite by Daniel Quinlan <quinlan@best.com>.
7231 (defun gnus-summary-remove-lines-marked-with (marks)
7232   "Remove lines that are marked with MARKS (e.g. \"DK\")."
7233   (interactive "sMarks: ")
7234   ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
7235   (save-excursion
7236     (set-buffer gnus-summary-buffer)
7237     (let ((buffer-read-only nil)
7238           (marks (concat "^[" marks "]"))
7239           beg)
7240       (goto-char (point-min))
7241       (while (search-forward-regexp marks (point-max) t)
7242         (progn
7243           (move-to-column 0)
7244           (setq beg (point))
7245           (forward-line 1)
7246           ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
7247           (append-to-buffer gnus-newsgroup-expunged-buffer beg (point))
7248           (delete-region beg (point)))))
7249     (or (zerop (buffer-size))
7250         (if (eobp)
7251             (gnus-summary-prev-subject 1)
7252           (gnus-summary-position-cursor)))))
7253
7254 (defun gnus-summary-expunge-below (score)
7255   "Remove articles with score less than SCORE."
7256   (interactive "P")
7257   (setq score (if score
7258                   (prefix-numeric-value score)
7259                 gnus-summary-default-score))
7260   (save-excursion
7261     (set-buffer gnus-summary-buffer)
7262     (goto-char (point-min))
7263     (let ((buffer-read-only nil)
7264           beg)
7265       (while (not (eobp))
7266         (if (< (gnus-summary-article-score) score)
7267             (progn
7268               (setq beg (point))
7269               (forward-line 1)
7270               (append-to-buffer gnus-newsgroup-expunged-buffer beg (point))
7271               (delete-region beg (point)))
7272           (forward-line 1)))
7273       ;; Adjust point.
7274       (or (zerop (buffer-size))
7275           (if (eobp)
7276               (gnus-summary-prev-subject 1)
7277             (gnus-summary-position-cursor))))))
7278
7279 (defun gnus-summary-mark-below (score mark)
7280   "Mark articles with score less than SCORE with MARK."
7281   (interactive "P\ncMark: ")
7282   (setq score (if score
7283                   (prefix-numeric-value score)
7284                 gnus-summary-default-score))
7285   (save-excursion
7286     (set-buffer gnus-summary-buffer)
7287     (goto-char (point-min))
7288     (while (not (eobp))
7289       (if (< (gnus-summary-article-score) score)
7290           (progn
7291             (gnus-summary-mark-article nil (char-to-string mark))
7292             (forward-line 1))
7293         (forward-line 1)))))
7294
7295 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
7296 (defun gnus-summary-set-mark-below (score)
7297   "Automatically mark articles with score below SCORE as read."
7298   (interactive "P")
7299   (setq score (if score
7300                   (prefix-numeric-value score)
7301                 gnus-summary-default-score))
7302   (setq gnus-summary-mark-below score)
7303   (gnus-summary-update-lines))
7304
7305 (defun gnus-summary-kill-below (score)
7306   "Mark articles with score below SCORE as read."
7307   (interactive "P")
7308   (gnus-summary-mark-below score gnus-killed-mark))
7309
7310 (defun gnus-summary-clear-above (score)
7311   "Clear all marks from articles with score above SCORE."
7312   (interactive "P")
7313   (gnus-summary-mark-above score gnus-unread-mark))
7314
7315 (defun gnus-summary-tick-above (score)
7316   "Tick all articles with score above SCORE."
7317   (interactive "P")
7318   (gnus-summary-mark-above score gnus-ticked-mark))
7319
7320 (defun gnus-summary-mark-above (score mark)
7321   "Mark articles with score less than SCORE with MARK."
7322   (interactive "P\ncMark: ")
7323   (setq score (if score
7324                   (prefix-numeric-value score)
7325                 gnus-summary-default-score))
7326   (save-excursion
7327     (set-buffer gnus-summary-buffer)
7328     (goto-char (point-min))
7329     (while (not (eobp))
7330       (if (> (gnus-summary-article-score) score)
7331           (progn
7332             (gnus-summary-mark-article nil mark)
7333             (forward-line 1))
7334         (forward-line 1)))))
7335
7336 ;; Suggested by Daniel Quinlan <quinlan@best.com>.  
7337 (defun gnus-summary-show-all-expunged ()
7338   "Show all previously expunge articles."
7339   (interactive)
7340   (let ((buffer-read-only nil))
7341     (save-excursion
7342       (if (and gnus-newsgroup-expunged-buffer
7343                (progn
7344                  (set-buffer gnus-newsgroup-expunged-buffer)
7345                  (not (zerop (buffer-size)))))
7346           (progn
7347             (append-to-buffer gnus-summary-buffer (point-min) (point-max))
7348             (erase-buffer))
7349         (error "No lines expunged")))))
7350
7351 (defun gnus-summary-show-all-dormant ()
7352   "Display all the hidden articles that are marked as dormant."
7353   (interactive)
7354   (let ((int gnus-newsgroup-dormant-subjects)
7355         (buffer-read-only nil))
7356     (if (not int)
7357         (error "No dormant articles hidden."))
7358     (goto-char (point-min))
7359     (save-excursion
7360       (while int
7361         (insert (cdr (car int)))
7362         (setq int (cdr int))))
7363     (gnus-summary-position-cursor)
7364     (setq gnus-newsgroup-dormant-subjects nil)))
7365
7366 (defun gnus-summary-catchup (all &optional quietly to-here)
7367   "Mark all articles not marked as unread in this newsgroup as read.
7368 If prefix argument ALL is non-nil, all articles are marked as read.
7369 If QUIETLY is non-nil, no questions will be asked.
7370 If TO-HERE is non-nil, it should be a point in the buffer. All
7371 articles before this point will be marked as read.
7372 The number of articles marked as read is returned."
7373   (interactive "P")
7374   (if (or quietly
7375           (not gnus-interactive-catchup) ;Without confirmation?
7376           gnus-expert-user
7377           (y-or-n-p
7378            (if all
7379                "Mark absolutely all articles as read? "
7380              "Mark all unread articles as read? ")))
7381       (let ((unreads (length gnus-newsgroup-unreads)))
7382         (if (gnus-summary-first-subject (not all))
7383             (while (and (gnus-summary-mark-as-read nil gnus-catchup-mark)
7384                         (if to-here (< (point) to-here) t)
7385                         (gnus-summary-search-subject nil (not all)))))
7386         (- unreads (length gnus-newsgroup-unreads)))))
7387
7388 (defun gnus-summary-catchup-to-here (&optional all)
7389   "Mark all unticked articles before the current one as read.
7390 If ALL is non-nil, also mark ticked and dormant articles as read."
7391   (interactive)
7392   (beginning-of-line)
7393   (gnus-summary-catchup all nil (point))
7394   (gnus-summary-position-cursor))
7395
7396 (defun gnus-summary-catchup-all (&optional quietly)
7397   "Mark all articles in this newsgroup as read."
7398   (interactive)
7399   (gnus-summary-catchup t quietly))
7400
7401 (defun gnus-summary-catchup-and-exit (all &optional quietly)
7402   "Mark all articles not marked as unread in this newsgroup as read, then exit.
7403 If prefix argument ALL is non-nil, all articles are marked as read."
7404   (interactive "P")
7405   (gnus-summary-catchup all quietly)
7406   ;; Select next newsgroup or exit.
7407   (if (eq gnus-auto-select-next 'quietly)
7408       (gnus-summary-next-group nil)
7409     (gnus-summary-exit)))
7410
7411 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
7412   "Mark all articles in this newsgroup as read, and then exit."
7413   (interactive)
7414   (gnus-summary-catchup-and-exit t quietly))
7415
7416 ;; Thread-based commands.
7417
7418 (defun gnus-summary-toggle-threads (arg)
7419   "Toggle showing conversation threads.
7420 If ARG is positive number, turn showing conversation threads on."
7421   (interactive "P")
7422   (let ((current (gnus-summary-article-number)))
7423     (setq gnus-show-threads
7424           (if (null arg) (not gnus-show-threads)
7425             (> (prefix-numeric-value arg) 0)))
7426     (gnus-summary-prepare)
7427     (gnus-summary-goto-subject current)))
7428
7429 (defun gnus-summary-show-all-threads ()
7430   "Show all threads."
7431   (interactive)
7432   (if gnus-show-threads
7433       (save-excursion
7434         (let ((buffer-read-only nil))
7435           (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))))
7436
7437 (defun gnus-summary-show-thread ()
7438   "Show thread subtrees."
7439   (interactive)
7440   (if gnus-show-threads
7441       (save-excursion
7442         (let ((buffer-read-only nil))
7443           (subst-char-in-region 
7444            (progn (beginning-of-line) (point))
7445            (progn (end-of-line) (point)) ?\^M ?\n t)))))
7446
7447 (defun gnus-summary-hide-all-threads ()
7448   "Hide all thread subtrees."
7449   (interactive)
7450   (if gnus-show-threads
7451       (save-excursion
7452         (goto-char (point-min))
7453         (gnus-summary-hide-thread)
7454         (while (gnus-summary-search-forward)
7455           (gnus-summary-hide-thread)))))
7456
7457 (defun gnus-summary-hide-thread ()
7458   "Hide thread subtrees."
7459   (interactive)
7460   (if gnus-show-threads
7461       (save-excursion
7462         (let ((buffer-read-only nil)
7463               (start (point))
7464               (level (gnus-summary-thread-level))
7465               (end (point)))
7466           ;; Go forward until either the buffer ends or the subthread
7467           ;; ends. 
7468           (while (and (zerop (forward-line 1))
7469                       (> (gnus-summary-thread-level) level))
7470             (setq end (point)))
7471           (subst-char-in-region start end ?\n ?\^M t)))))
7472
7473 (defun gnus-summary-go-to-next-thread (&optional previous)
7474   "Go to the same level (or less) next thread.
7475 If PREVIOUS is non-nil, go to previous thread instead.
7476 Return the article number moved to, or nil if moving was impossible."
7477   (let ((level (gnus-summary-thread-level))
7478         (article (gnus-summary-article-number)))
7479     (if previous 
7480         (while (and (zerop (gnus-summary-prev-subject 1))
7481                     (> (gnus-summary-thread-level) level)))
7482       (while (and (zerop (gnus-summary-next-subject 1))
7483                   (> (gnus-summary-thread-level) level))))
7484     (let ((oart (gnus-summary-article-number)))
7485       (and (/= oart article) oart))))
7486
7487 (defun gnus-summary-next-thread (n)
7488   "Go to the same level next N'th thread.
7489 If N is negative, search backward instead.
7490 Returns the difference between N and the number of skips actually
7491 done."
7492   (interactive "p")
7493   (let ((backward (< n 0))
7494         (n (abs n)))
7495   (while (and (> n 0)
7496               (gnus-summary-go-to-next-thread backward))
7497     (setq n (1- n)))
7498   (gnus-summary-position-cursor)
7499   (if (/= 0 n) (message "No more threads" ))
7500   n))
7501
7502 (defun gnus-summary-prev-thread (n)
7503   "Go to the same level previous N'th thread.
7504 Returns the difference between N and the number of skips actually
7505 done."
7506   (interactive "p")
7507   (gnus-summary-next-thread (- n)))
7508
7509 (defun gnus-summary-go-down-thread (&optional same)
7510   "Go down one level in the current thread.
7511 If SAME is non-nil, also move to articles of the same level."
7512   (let ((level (gnus-summary-thread-level))
7513         (start (point)))
7514     (if (and (zerop (forward-line 1))
7515              (> (gnus-summary-thread-level) level))
7516         t
7517       (goto-char start)
7518       nil)))
7519
7520 (defun gnus-summary-go-up-thread ()
7521   "Go up one level in the current thread."
7522   (let ((level (gnus-summary-thread-level))
7523         (start (point)))
7524     (while (and (zerop (forward-line -1))
7525                 (>= (gnus-summary-thread-level) level)))
7526     (if (>= (gnus-summary-thread-level) level)
7527         (progn
7528           (goto-char start)
7529           nil)
7530       t)))
7531
7532 (defun gnus-summary-down-thread (n)
7533   "Go down thread N steps.
7534 If N is negative, go up instead.
7535 Returns the difference between N and how many steps down that were
7536 taken."
7537   (interactive "p")
7538   (let ((up (< n 0))
7539         (n (abs n)))
7540   (while (and (> n 0)
7541               (if up (gnus-summary-go-up-thread)
7542                 (gnus-summary-go-down-thread)))
7543     (setq n (1- n)))
7544   (gnus-summary-position-cursor)
7545   (if (/= 0 n) (message "Can't go further" ))
7546   n))
7547
7548 (defun gnus-summary-up-thread (n)
7549   "Go up thread N steps.
7550 If N is negative, go up instead.
7551 Returns the difference between N and how many steps down that were
7552 taken."
7553   (interactive "p")
7554   (gnus-summary-down-thread (- n)))
7555
7556 (defun gnus-summary-kill-thread (unmark)
7557   "Mark articles under current thread as read.
7558 If the prefix argument is positive, remove any kinds of marks.
7559 If the prefix argument is negative, tick articles instead."
7560   (interactive "P")
7561   (if unmark
7562       (setq unmark (prefix-numeric-value unmark)))
7563   (let ((killing t)
7564         (level (gnus-summary-thread-level)))
7565     (save-excursion
7566       (while killing
7567         ;; Mark the article...
7568         (cond ((null unmark) (gnus-summary-mark-as-read nil gnus-killed-mark))
7569               ((> unmark 0) (gnus-summary-tick-article nil t))
7570               (t (gnus-summary-tick-article)))
7571         ;; ...and go forward until either the buffer ends or the subtree
7572         ;; ends. 
7573         (if (not (and (zerop (forward-line 1))
7574                       (> (gnus-summary-thread-level) level)))
7575             (setq killing nil))))
7576     ;; Hide killed subtrees.
7577     (and (null unmark)
7578          gnus-thread-hide-killed
7579          (gnus-summary-hide-thread))
7580     ;; If marked as read, go to next unread subject.
7581     (if (null unmark)
7582         ;; Go to next unread subject.
7583         (gnus-summary-next-subject 1 t)))
7584   (gnus-set-mode-line 'summary))
7585
7586 ;; Summary sorting commands
7587
7588 (defun gnus-summary-sort-by-number (reverse)
7589   "Sort summary buffer by article number.
7590 Argument REVERSE means reverse order."
7591   (interactive "P")
7592   (gnus-summary-sort 'gnus-summary-article-number reverse))
7593
7594 (defun gnus-summary-sort-by-author (reverse)
7595   "Sort summary buffer by author name alphabetically.
7596 If case-fold-search is non-nil, case of letters is ignored.
7597 Argument REVERSE means reverse order."
7598   (interactive "P")
7599   (gnus-summary-sort
7600    (lambda ()
7601      (let ((extract (gnus-extract-address-components
7602                      (header-from (gnus-get-header-by-number
7603                                    (gnus-summary-article-number))))))
7604        (or (car extract) (cdr extract))))
7605    reverse))
7606
7607 (defun gnus-summary-sort-by-subject (reverse)
7608   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
7609 If case-fold-search is non-nil, case of letters is ignored.
7610 Argument REVERSE means reverse order."
7611   (interactive "P")
7612   (gnus-summary-sort
7613    (lambda ()
7614      (downcase (gnus-simplify-subject (gnus-summary-subject-string))))
7615    reverse))
7616
7617 (defun gnus-summary-sort-by-date (reverse)
7618   "Sort summary buffer by date.
7619 Argument REVERSE means reverse order."
7620   (interactive "P")
7621   (gnus-summary-sort
7622    (lambda ()
7623      (gnus-sortable-date
7624       (header-date (gnus-get-header-by-number (gnus-summary-article-number)))))
7625    reverse))
7626
7627 (defun gnus-summary-sort-by-score (reverse)
7628   "Sort summary buffer by score.
7629 Argument REVERSE means reverse order."
7630   (interactive "P")
7631   (gnus-summary-sort 'gnus-summary-article-score (not reverse)))
7632
7633 (defun gnus-summary-sort (predicate reverse)
7634   ;; Sort summary buffer by PREDICATE.  REVERSE means reverse order. 
7635   (let (buffer-read-only)
7636     (goto-char (point-min))
7637     (sort-subr reverse 'forward-line 'end-of-line predicate)))
7638
7639 (defun gnus-sortable-date (date)
7640   "Make sortable string by string-lessp from DATE.
7641 Timezone package is used."
7642   (let* ((date   (timezone-fix-time date nil nil)) ;[Y M D H M S]
7643          (year   (aref date 0))
7644          (month  (aref date 1))
7645          (day    (aref date 2)))
7646     (timezone-make-sortable-date year month day 
7647                                  (timezone-make-time-string
7648                                   (aref date 3) (aref date 4) (aref date 5)))
7649     ))
7650
7651
7652 ;; Summary saving commands.
7653
7654 (defun gnus-summary-save-article (n)
7655   "Save the current article using the default saver function.
7656 If N is a positive number, save the N next articles.
7657 If N is a negative number, save the N previous articles.
7658 If N is nil and any articles have been marked with the process mark,
7659 save those articles instead.
7660 The variable `gnus-default-article-saver' specifies the saver function."
7661   (interactive "P")
7662   (let (articles process)
7663     (if (and n (numberp n))
7664         (let ((backward (< n 0))
7665               (n (abs n)))
7666           (save-excursion
7667             (while (and (> n 0)
7668                         (setq articles (cons (gnus-summary-article-number) 
7669                                              articles))
7670                         (gnus-summary-search-forward nil nil backward))
7671               (setq n (1- n))))
7672           (setq articles (sort articles (function <))))
7673       (if gnus-newsgroup-processable
7674           (progn
7675             (setq articles (setq gnus-newsgroup-processable
7676                                  (nreverse gnus-newsgroup-processable)))
7677             (setq process t))
7678         (setq articles (list (gnus-summary-article-number)))))
7679     (while articles
7680       (let ((header (gnus-gethash (int-to-string (car articles))
7681                                   gnus-newsgroup-headers-hashtb-by-number)))
7682         (if (vectorp header)
7683             (progn
7684               (gnus-summary-display-article (car articles) t)
7685               (if (not gnus-save-all-headers)
7686                   (gnus-article-hide-headers t))
7687               (if gnus-default-article-saver
7688                   (funcall gnus-default-article-saver)
7689                 (error "No default saver is defined.")))
7690           (if (assq 'name header)
7691               (gnus-copy-file (cdr (assq 'name header)))
7692             (message "Article %d is unsaveable" (car articles)))))
7693       (if process
7694           (gnus-summary-remove-process-mark (car articles)))
7695       (setq articles (cdr articles)))
7696     (if process (setq gnus-newsgroup-processable 
7697                       (nreverse gnus-newsgroup-processable)))
7698     (gnus-summary-position-cursor)
7699     n))
7700
7701 (defun gnus-summary-pipe-output (arg)
7702   "Pipe the current article to a subprocess.
7703 If N is a positive number, pipe the N next articles.
7704 If N is a negative number, pipe the N previous articles.
7705 If N is nil and any articles have been marked with the process mark,
7706 pipe those articles instead."
7707   (interactive "P")
7708   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
7709     (gnus-summary-save-article arg)))
7710
7711 (defun gnus-summary-save-article-mail (arg)
7712   "Append the current article to an mail file.
7713 If N is a positive number, save the N next articles.
7714 If N is a negative number, save the N previous articles.
7715 If N is nil and any articles have been marked with the process mark,
7716 save those articles instead."
7717   (interactive "P")
7718   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
7719     (gnus-summary-save-article arg)))
7720
7721 (defun gnus-summary-save-in-rmail (&optional filename)
7722   "Append this article to Rmail file.
7723 Optional argument FILENAME specifies file name.
7724 Directory to save to is default to `gnus-article-save-directory' which
7725 is initialized from the SAVEDIR environment variable."
7726   (interactive)
7727   (let ((default-name
7728           (funcall gnus-rmail-save-name gnus-newsgroup-name
7729                    gnus-current-headers gnus-newsgroup-last-rmail)))
7730     (or filename
7731         (setq filename
7732               (read-file-name
7733                (concat "Save article in rmail file: (default "
7734                        (file-name-nondirectory default-name) ") ")
7735                (file-name-directory default-name)
7736                default-name)))
7737     (gnus-make-directory (file-name-directory filename))
7738     (gnus-eval-in-buffer-window 
7739      gnus-article-buffer
7740      (save-excursion
7741        (save-restriction
7742          (widen)
7743          (gnus-output-to-rmail filename))))
7744     ;; Remember the directory name to save articles.
7745     (setq gnus-newsgroup-last-rmail filename)))
7746
7747 (defun gnus-summary-save-in-mail (&optional filename)
7748   "Append this article to Unix mail file.
7749 Optional argument FILENAME specifies file name.
7750 Directory to save to is default to `gnus-article-save-directory' which
7751 is initialized from the SAVEDIR environment variable."
7752   (interactive)
7753   (let ((default-name
7754           (funcall gnus-mail-save-name gnus-newsgroup-name
7755                    gnus-current-headers gnus-newsgroup-last-mail)))
7756     (or filename
7757         (setq filename
7758               (read-file-name
7759                (concat "Save article in Unix mail file: (default "
7760                        (file-name-nondirectory default-name) ") ")
7761                (file-name-directory default-name)
7762                default-name)))
7763     (setq filename
7764           (expand-file-name filename
7765                             (and default-name
7766                                  (file-name-directory default-name))))
7767     (gnus-make-directory (file-name-directory filename))
7768     (gnus-eval-in-buffer-window 
7769      gnus-article-buffer
7770      (save-excursion
7771        (save-restriction
7772          (widen)
7773          (if (and (file-readable-p filename) (rmail-file-p filename))
7774              (gnus-output-to-rmail filename)
7775            (rmail-output filename 1 t t)))))
7776     ;; Remember the directory name to save articles.
7777     (setq gnus-newsgroup-last-mail filename)))
7778
7779 (defun gnus-summary-save-in-file (&optional filename)
7780   "Append this article to file.
7781 Optional argument FILENAME specifies file name.
7782 Directory to save to is default to `gnus-article-save-directory' which
7783 is initialized from the SAVEDIR environment variable."
7784   (interactive)
7785   (let ((default-name
7786           (funcall gnus-file-save-name gnus-newsgroup-name
7787                    gnus-current-headers gnus-newsgroup-last-file)))
7788     (or filename
7789         (setq filename
7790               (read-file-name
7791                (concat "Save article in file: (default "
7792                        (file-name-nondirectory default-name) ") ")
7793                (file-name-directory default-name)
7794                default-name)))
7795     (gnus-make-directory (file-name-directory filename))
7796     (gnus-eval-in-buffer-window 
7797      gnus-article-buffer
7798      (save-excursion
7799        (save-restriction
7800          (widen)
7801          (gnus-output-to-file filename))))
7802     ;; Remember the directory name to save articles.
7803     (setq gnus-newsgroup-last-file filename)))
7804
7805 (defun gnus-summary-save-in-pipe (&optional command)
7806   "Pipe this article to subprocess."
7807   (interactive)
7808   (let ((command (read-string "Shell command on article: "
7809                               gnus-last-shell-command)))
7810     (if (string-equal command "")
7811         (setq command gnus-last-shell-command))
7812     (gnus-eval-in-buffer-window 
7813      gnus-article-buffer
7814      (save-restriction
7815        (widen)
7816        (shell-command-on-region (point-min) (point-max) command nil)))
7817     (setq gnus-last-shell-command command)))
7818
7819 ;; Summary extract commands
7820
7821 (defun gnus-summary-insert-pseudos (pslist)
7822   (let ((buffer-read-only nil)
7823         (article (gnus-summary-article-number))
7824         b)
7825     (or (gnus-summary-goto-subject article)
7826         (error (format "No such article: %d" article)))
7827     (gnus-summary-position-cursor)
7828     (save-excursion
7829       (forward-line 1)
7830       (while pslist
7831         (setq b (point))
7832         (insert "          " (file-name-nondirectory 
7833                               (cdr (assq 'name (car pslist))))
7834                 ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
7835         (add-text-properties 
7836          b (1+ b) (list 'gnus-subject (cdr (assq 'name (car pslist)))
7837                         'gnus-number gnus-reffed-article-number
7838                         'gnus-mark gnus-unread-mark
7839                         'gnus-pseudo (car pslist)
7840                         'gnus-thread 0))
7841         (gnus-sethash (int-to-string gnus-reffed-article-number)
7842                       (car pslist) gnus-newsgroup-headers-hashtb-by-number)
7843         (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
7844         (setq pslist (cdr pslist))))))
7845
7846 (defun gnus-request-pseudo-article (props)
7847   (cond ((assq 'execute props)
7848          (gnus-execute-command (cdr (assq 'execute props))))
7849         ((assq 'digest props)
7850          )
7851         )
7852   (let ((gnus-current-article (gnus-summary-article-number)))
7853     (run-hooks 'gnus-mark-article-hook)))
7854
7855 (defun gnus-execute-command (command)
7856   (save-excursion
7857     (gnus-article-setup-buffer)
7858     (set-buffer gnus-article-buffer)
7859     (let ((command (read-string "Command: " command))
7860           (buffer-read-only nil))
7861       (erase-buffer)
7862       (insert "$ " command "\n\n")
7863       (if gnus-view-pseudo-asynchronously
7864           (start-process "gnus-execute" nil "sh" "-c" command)
7865         (call-process "sh" nil t nil "-c" command)))))
7866
7867 (defun gnus-copy-file (file &optional to)
7868   "Copy FILE to TO."
7869   (interactive
7870    (list (read-file-name "Copy file: " default-directory)
7871          (read-file-name "Copy file to: " default-directory)))
7872   (or to (setq to (read-file-name "Copy file to: " default-directory)))
7873   (and (file-directory-p to) 
7874        (setq to (concat (file-name-as-directory to)
7875                         (file-name-nondirectory file))))
7876   (copy-file file to))
7877
7878 ;; Summary score file commands
7879
7880 ;; Much modification of the kill (ahem, score) code and lots of the
7881 ;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
7882
7883 (defun gnus-summary-header (header)
7884   ;; Return HEADER for current articles, or error.
7885   (let ((article (gnus-summary-article-number)))
7886     (if article
7887         (aref (gnus-get-header-by-number article)
7888               (nth 1 (assoc header gnus-header-index)))
7889       (error "No article on current line"))))
7890
7891 (defun gnus-summary-score-entry (header match type score date &optional prompt)
7892   "Enter score file entry.
7893 HEADER is the header being scored.
7894 MATCH is the string we are looking for.
7895 TYPE is a flag indicating if it is a regexp or substring.
7896 SCORE is the score to add.
7897 DATE is the expire date."
7898   (interactive (list (completing-read "Header: "
7899                                       gnus-header-index
7900                                       (lambda (x) (fboundp (nth 2 x)))
7901                                       t)
7902                      (read-string "Match: ")
7903                      (y-or-n-p "Use regexp match? ")
7904                      (prefix-numeric-value current-prefix-arg)
7905                      (if (y-or-n-p "Expire kill? ")
7906                          (current-time-string)
7907                        nil)))
7908   (if (not prompt)
7909       ()
7910     (setq match (read-string "Match: " match)))
7911   (let ((score (or score gnus-score-interactive-default-score)))
7912     (gnus-summary-score-effect header match type score)
7913   
7914     (gnus-summary-score-effect header match type score)
7915     (gnus-score-set header
7916                     (cons (list match type score date) 
7917                           (gnus-score-get header)))
7918     (gnus-score-set 'touched t)))
7919
7920 (defun gnus-summary-score-effect (header match type score)
7921   "Simulate the effect of a score file entry.
7922 HEADER is the header being scored.
7923 MATCH is the string we are looking for.
7924 TYPE is a flag indicating if it is a regexp or substring.
7925 SCORE is the score to add."
7926   (interactive (list (completing-read "Header: "
7927                                       gnus-header-index
7928                                       (lambda (x) (fboundp (nth 2 x)))
7929                                       t)
7930                      (read-string "Match: ")
7931                      (y-or-n-p "Use regexp match? ")
7932                      (prefix-numeric-value current-prefix-arg)))
7933   (save-excursion
7934     (or (and (stringp match) (> (length match) 0))
7935       (error "No match"))
7936     (goto-char (point-min))
7937     (let ((regexp (if type
7938                       match
7939                     (concat "\\`.*" (regexp-quote match) ".*\\'"))))
7940       (while (not (eobp))
7941         (let ((content (gnus-summary-header header))
7942               (case-fold-search t))
7943           (and content
7944                (if (string-match regexp content)
7945                    (gnus-summary-raise-score score))))
7946         (beginning-of-line 2)))))
7947
7948 (defun gnus-summary-score-crossposting (score date)
7949    ;; Enter score file entry for current crossposting.
7950    ;; SCORE is the score to add.
7951    ;; DATE is the expire date.
7952    (let ((xref (gnus-summary-header "xref"))
7953          (start 0)
7954          group)
7955      (or xref (error "This article is not crossposted"))
7956      (while (string-match " \\([^ \t]+\\):" xref start)
7957        (setq start (match-end 0))
7958        (if (not (string= 
7959                  (setq group 
7960                        (substring xref (match-beginning 1) (match-end 1)))
7961                  gnus-newsgroup-name))
7962            (gnus-summary-score-entry
7963             "xref" (concat " " group ":") nil score date)))))
7964
7965 (defun gnus-summary-temporarily-lower-by-subject (level)
7966   "Temporarily lower score by LEVEL for current subject.
7967 See `gnus-kill-expiry-days'."
7968   (interactive "P")
7969   (gnus-summary-score-entry
7970    "subject" (gnus-summary-header "subject") nil (- level) (current-time-string)))
7971
7972 (defun gnus-summary-temporarily-lower-by-author (level)
7973   "Temporarily lower score by LEVEL for current author.
7974 See `gnus-kill-expiry-days'."
7975   (interactive "P")
7976   (gnus-summary-score-entry
7977    "from" (gnus-summary-header "from") nil (- level) (current-time-string)))
7978
7979 (defun gnus-summary-temporarily-lower-by-xref (level)
7980   "Temporarily lower score by LEVEL for current xref.
7981 See `gnus-kill-expiry-days'."
7982   (interactive "P")
7983   (gnus-summary-score-crossposting (- level) (current-time-string)))
7984
7985 (defun gnus-summary-temporarily-lower-by-thread (level)
7986   "Temporarily lower score by LEVEL for current thread.
7987 See `gnus-kill-expiry-days'."
7988   (interactive "P")
7989   (gnus-summary-score-entry
7990    "references" (gnus-summary-header "id")
7991    nil (- level) (current-time-string)))
7992
7993 (defun gnus-summary-lower-by-subject (level)
7994   "Lower score by LEVEL for current subject."
7995   (interactive "P")
7996   (gnus-summary-score-entry
7997    "subject" (gnus-summary-header "subject") nil (- level) nil))
7998
7999 (defun gnus-summary-lower-by-author (level)
8000   "Lower score by LEVEL for current author."
8001   (interactive "P")
8002   (gnus-summary-score-entry
8003    "from" (gnus-summary-header "from") nil (- level) nil))
8004
8005 (defun gnus-summary-lower-by-xref (level)
8006   "Lower score by LEVEL for current xref."
8007   (interactive "P")
8008   (gnus-summary-score-crossposting (- level) nil))
8009
8010 (defun gnus-summary-lower-followups-to-author (level)
8011   "Lower score by LEVEL for all followups to the current author."
8012   (interactive "P")
8013   (gnus-kill-file-lower-followups-to-author
8014    level
8015    (let ((article (gnus-summary-article-number)))
8016      (if article (gnus-get-header-by-number article)
8017        (error "No article on current line")))))
8018
8019 (defun gnus-summary-temporarily-raise-by-subject (level)
8020   "Temporarily raise score by LEVEL for current subject.
8021 See `gnus-kill-expiry-days'."
8022   (interactive "P")
8023   (gnus-summary-score-entry
8024    "subject" (gnus-summary-header "subject") nil level (current-time-string)))
8025
8026 (defun gnus-summary-temporarily-raise-by-author (level)
8027   "Temporarily raise score by LEVEL for current author.
8028 See `gnus-kill-expiry-days'."
8029   (interactive "P")
8030   (gnus-summary-score-entry
8031    "from" (gnus-summary-header "from") nil level (current-time-string)))
8032
8033 (defun gnus-summary-temporarily-raise-by-xref (level)
8034   "Temporarily raise score by LEVEL for current xref.
8035 See `gnus-kill-expiry-days'."
8036   (interactive "P")
8037   (gnus-summary-score-crossposting level (current-time-string)))
8038
8039 (defun gnus-summary-temporarily-raise-by-thread (level)
8040   "Temporarily raise score by LEVEL for current thread.
8041 See `gnus-kill-expiry-days'."
8042   (interactive "P")
8043   (gnus-summary-score-entry
8044    "references" (gnus-summary-header "id")
8045    nil level (current-time-string)))
8046
8047 (defun gnus-summary-raise-by-subject (level)
8048   "Raise score by LEVEL for current subject."
8049   (interactive "P")
8050   (gnus-summary-score-entry
8051    "subject" (gnus-summary-header "subject") nil level nil))
8052
8053 (defun gnus-summary-raise-by-author (level)
8054   "Raise score by LEVEL for current author."
8055   (interactive "P")
8056   (gnus-summary-score-entry
8057    "from" (gnus-summary-header "from") nil level nil t))
8058
8059 (defun gnus-summary-raise-by-xref (level)
8060   "Raise score by LEVEL for current xref."
8061   (interactive "P")
8062   (gnus-summary-score-crossposting level nil))
8063
8064 (defun gnus-summary-edit-global-kill ()
8065   "Edit a global score file."
8066   (interactive)
8067   (setq gnus-current-kill-article (gnus-summary-article-number))
8068   (gnus-kill-file-edit-file nil)        ;Nil stands for global score file.
8069   (message
8070    (substitute-command-keys
8071     "Editing a global score file (Type \\[gnus-kill-file-exit] to exit)")))
8072
8073 (defun gnus-summary-raise-followups-to-author (level)
8074   "Raise score by LEVEL for all followups to the current author."
8075   (interactive "P")
8076   (gnus-kill-file-raise-followups-to-author
8077    level
8078    (let ((article (gnus-summary-article-number)))
8079      (if article (gnus-get-header-by-number article)
8080        (error "No article on current line")))))
8081
8082 (defun gnus-summary-edit-local-kill ()
8083   "Edit a local score file applied to the current newsgroup."
8084   (interactive)
8085   (setq gnus-current-kill-article (gnus-summary-article-number))
8086   (gnus-kill-file-edit-file gnus-newsgroup-name)
8087   (message
8088    (substitute-command-keys
8089     "Editing a local score file (Type \\[gnus-kill-file-exit] to exit)")))
8090
8091
8092 \f
8093 ;;;
8094 ;;; Gnus article mode
8095 ;;;
8096
8097 (if gnus-article-mode-map
8098     nil
8099   (setq gnus-article-mode-map (make-keymap))
8100   (suppress-keymap gnus-article-mode-map)
8101   (define-key gnus-article-mode-map " " 'gnus-article-next-page)
8102   (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
8103   (define-key gnus-article-mode-map "\C-x^" 'gnus-article-refer-article)
8104   (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
8105   (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
8106   (define-key gnus-article-mode-map "\C-xm" 'gnus-article-mail)
8107   (define-key gnus-article-mode-map "\C-xM" 'gnus-article-mail-with-original)
8108   (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
8109   
8110   ;; Duplicate almost all summary keystrokes in the article mode map.
8111   (let ((commands 
8112          (list "#" "\M-#" "\C-c\M-#" "\r" "n" "p"
8113                "N" "P" "\M-\C-n" "\M-\C-p" "." "\M-s" "\M-r"
8114                "<" ">" "l" "j" "^" "\M-^" "-" "u" "U" "d" "D"
8115                "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" "c" "x" "X" 
8116                "\M-\C-x" "\M-\177" "b" "B" "$" "w" "\C-c\C-r"
8117                "t" "\M-t" "a" "f" "F" "C" "S" "r" "R" "\C-c\C-f"
8118                "m" "o" "\C-o" "|" "\M-m" "\M-\C-m" "\M-k" "m" "M"
8119                "V" "\C-c\C-d" "q" "Q")))
8120     (while commands
8121       (define-key gnus-article-mode-map (car commands) 
8122         'gnus-article-summary-command)
8123       (setq commands (cdr commands))))
8124
8125   (if gnus-visual (gnus-article-make-menu-bar)))
8126
8127 (defun gnus-article-mode ()
8128   "Major mode for reading an article.
8129 All normal editing commands are switched off.
8130 The following commands are available:
8131
8132 \\<gnus-article-mode-map>
8133 \\[gnus-article-next-page]\t Scroll the article one page forwards
8134 \\[gnus-article-prev-page]\t Scroll the article one page backwards
8135 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
8136 \\[gnus-article-show-summary]\t Display the summary buffer
8137 \\[gnus-article-mail]\t Send a reply to the address near point
8138 \\[gnus-article-mail-with-original]\t Send a reply to the address near point; include the original article
8139 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
8140 \\[gnus-info-find-node]\t Go to the Gnus info node
8141
8142 "
8143   (interactive)
8144   (kill-all-local-variables)
8145   (setq mode-line-modified "-- ")
8146   (make-local-variable 'mode-line-format)
8147   (setq mode-line-format (copy-sequence mode-line-format))
8148   (and (equal (nth 3 mode-line-format) "   ")
8149        (setcar (nthcdr 3 mode-line-format) ""))
8150   (setq mode-name "Article")
8151   (setq major-mode 'gnus-article-mode)
8152   (make-local-variable 'minor-mode-alist)
8153   (or (assq 'gnus-show-mime minor-mode-alist)
8154       (setq minor-mode-alist
8155             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
8156   (use-local-map gnus-article-mode-map)
8157   (make-local-variable 'page-delimiter)
8158   (setq page-delimiter gnus-page-delimiter)
8159   (make-local-variable 'mail-header-separator)
8160   (setq mail-header-separator "")       ;For caesar function.
8161   (buffer-disable-undo (current-buffer))
8162   (setq buffer-read-only t)             ;Disable modification
8163   (run-hooks 'gnus-article-mode-hook))
8164
8165 (defun gnus-article-setup-buffer ()
8166   "Initialize article mode buffer."
8167   (or (get-buffer gnus-article-buffer)
8168       (save-excursion
8169         (set-buffer (get-buffer-create gnus-article-buffer))
8170         (gnus-add-current-to-buffer-list)
8171         (gnus-article-mode))
8172       ))
8173
8174 (defun gnus-request-article-this-buffer (article &optional group)
8175   "Get an article and insert it into this buffer."
8176   (setq group (or group gnus-newsgroup-name))
8177   ;; Using `gnus-request-article' directly will insert the article into
8178   ;; `nntp-server-buffer' - so we'll save some time by not having to
8179   ;; copy it from the server buffer into the article buffer.
8180
8181   ;; We only request an article by message-id when we do not have the
8182   ;; headers for it, so we'll have to get those.
8183   (and (stringp article) (gnus-read-header article))
8184
8185   ;; If the article number is negative, that means that this article
8186   ;; doesn't belong in this newsgroup (possibly), so we find its
8187   ;; message-id and request it by id instead of number.
8188   (if (and (numberp article) (< article 0))
8189       (save-excursion
8190         (set-buffer gnus-summary-buffer)
8191         (let ((header (gnus-gethash (int-to-string article)
8192                                     gnus-newsgroup-headers-hashtb-by-number)))
8193           (if (vectorp header)
8194               ;; It's a real article.
8195               (setq article (header-id header))
8196             ;; It is an extracted pseudo-article.
8197             (setq article nil)
8198             (gnus-request-pseudo-article header)))))
8199   ;; Get the article and into the article buffer.
8200   (if article
8201       (progn
8202        (erase-buffer)
8203        (and (gnus-request-article article group (current-buffer))
8204             'article))
8205     'pseudo))
8206
8207 (defun gnus-read-header (id)
8208   "Read the headers of article ID and enter them into the Gnus system."
8209   (or gnus-newsgroup-headers-hashtb-by-number
8210       (gnus-make-headers-hashtable-by-number))
8211   (let (header)
8212     (if (not (setq header 
8213                    (car (if (let ((gnus-nov-is-evil t))
8214                               (gnus-retrieve-headers 
8215                                (list id) gnus-newsgroup-name))
8216                             (gnus-get-newsgroup-headers)))))
8217         nil
8218       (if (stringp id)
8219           (header-set-number header gnus-reffed-article-number))
8220       (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers))
8221       (gnus-sethash (int-to-string (header-number header)) header
8222                     gnus-newsgroup-headers-hashtb-by-number)
8223       (if (stringp id)
8224           (setq gnus-reffed-article-number (1- gnus-reffed-article-number)))
8225       (setq gnus-current-headers header)
8226       header)))
8227
8228 (defun gnus-article-prepare (article &optional all-headers header)
8229   "Prepare ARTICLE in article mode buffer.
8230 ARTICLE should either be an article number or a Message-ID.
8231 If ARTICLE is an id, HEADER should be the article headers.
8232 If ALL-HEADERS is non-nil, no headers are hidden."
8233   (save-excursion
8234     ;; Make sure we start in a summary buffer.
8235     (or (eq major-mode 'gnus-summary-mode)
8236         (set-buffer gnus-summary-buffer))
8237     (setq gnus-summary-buffer (current-buffer))
8238     ;; Make sure the connection to the server is alive.
8239     (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name))
8240         (progn
8241           (gnus-check-news-server 
8242            (gnus-find-method-for-group gnus-newsgroup-name))
8243           (gnus-request-group gnus-newsgroup-name t)))
8244     (or gnus-newsgroup-headers-hashtb-by-number
8245         (gnus-make-headers-hashtable-by-number))
8246     (let* ((article (if header (header-number header) article))
8247            (summary-buffer (current-buffer))
8248            (internal-hook gnus-article-internal-prepare-hook)
8249            (bookmark (cdr (assq article gnus-newsgroup-bookmarks)))
8250            (group gnus-newsgroup-name)
8251            result)
8252       (save-excursion
8253         (gnus-article-setup-buffer)
8254         (set-buffer gnus-article-buffer)
8255         (let ((buffer-read-only nil))
8256           (if (not (setq result (gnus-request-article-this-buffer 
8257                                  article group)))
8258               ;; There is no such article.
8259               (progn
8260                 (and (numberp article) 
8261                      (gnus-summary-mark-as-read article gnus-canceled-mark))
8262                 (message "No such article (may be canceled)")
8263                 (ding) 
8264                 nil)
8265             (if (not (eq result 'article))
8266                 (progn
8267                   (save-excursion
8268                     (set-buffer summary-buffer)
8269                     (setq gnus-last-article gnus-current-article
8270                           gnus-current-article 0
8271                           gnus-current-headers nil
8272                           gnus-article-current nil)
8273                     (gnus-configure-windows 'article)
8274                     (gnus-set-mode-line 'summary)
8275                     (gnus-set-global-variables))
8276                   (gnus-set-mode-line 'article))
8277               ;; The result from the `request' was an actual article -
8278               ;; or at least some text that is now displayed in the
8279               ;; article buffer.
8280               (if (and (numberp article)
8281                        (not (eq article gnus-current-article)))
8282                   ;; Seems like a new article has been selected.
8283                   ;; `gnus-current-article' must be an article number.
8284                   (save-excursion
8285                     (set-buffer summary-buffer)
8286                     (setq gnus-last-article gnus-current-article)
8287                     (setq gnus-current-article article)
8288                     (setq gnus-current-headers 
8289                           (gnus-get-header-by-number gnus-current-article))
8290                     (setq gnus-article-current 
8291                           (cons gnus-newsgroup-name gnus-current-article))
8292                     (gnus-set-mode-line 'summary)
8293                     (run-hooks 'gnus-mark-article-hook)
8294                     (and gnus-visual 
8295                          (run-hooks 'gnus-visual-mark-article-hook))
8296                     ;; Set the global newsgroup variables here.
8297                     ;; Suggested by Jim Sisolak
8298                     ;; <sisolak@trans4.neep.wisc.edu>.
8299                     (gnus-set-global-variables)))
8300               ;; gnus-have-all-headers must be either T or NIL.
8301               (setq gnus-have-all-headers
8302                     (not (not (or all-headers gnus-show-all-headers))))
8303               ;; Hooks for getting information from the article.
8304               ;; This hook must be called before being narrowed.
8305               (run-hooks 'internal-hook)
8306               (run-hooks 'gnus-article-prepare-hook)
8307               ;; Decode MIME message.
8308               (if (and gnus-show-mime
8309                        (gnus-fetch-field "Mime-Version"))
8310                   (funcall gnus-show-mime-method))
8311               ;; Perform the article display hooks.
8312               (let ((buffer-read-only nil))
8313                 (run-hooks 'gnus-article-display-hook))
8314               ;; Do page break.
8315               (goto-char (point-min))
8316               (and gnus-break-pages (gnus-narrow-to-page))
8317               (gnus-set-mode-line 'article)
8318               (goto-char 1)
8319               (if bookmark
8320                   (progn
8321                     (message "Moved to bookmark")
8322                     (search-forward "\n\n" nil t)
8323                     (forward-line bookmark)))
8324               (set-window-start 
8325                (get-buffer-window gnus-article-buffer) (point-min))
8326               t)))))))
8327
8328 (defun gnus-article-show-all-headers ()
8329   "Show all article headers in article mode buffer."
8330   (save-excursion 
8331     (setq gnus-have-all-headers t)
8332     (gnus-article-setup-buffer)
8333     (set-buffer gnus-article-buffer)
8334     (let ((buffer-read-only nil))
8335       (remove-text-properties 1 (point-max) '(invisible t)))))
8336
8337 (defun gnus-article-hide-headers-if-wanted ()
8338   "Hide unwanted headers if `gnus-have-all-headers' is nil.
8339 Provided for backwards compatability."
8340   (or gnus-have-all-headers
8341       (gnus-article-hide-headers)))
8342
8343 (defun gnus-article-hide-headers (&optional delete)
8344   "Hide unwanted headers and possibly sort them as well."
8345   (save-excursion
8346     (save-restriction
8347       (let ((sorted gnus-sorted-header-list)
8348             (buffer-read-only nil)
8349             want want-list beg want-l)
8350         ;; First we narrow to just the headers.
8351         (widen)
8352         (goto-char 1)
8353         ;; Hide any "From " lines at the beginning of (mail) articles. 
8354         (while (looking-at rmail-unix-mail-delimiter)
8355           (forward-line 1))
8356         (if (/= (point) 1) 
8357             (add-text-properties 1 (point) '(invisible t)))
8358         ;; Then treat the rest of the header lines.
8359         (narrow-to-region 
8360          (point) 
8361          (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
8362         ;; Then we use the two regular expressions
8363         ;; `gnus-ignored-headers' and `gnus-visible-headers' to
8364         ;; select which header lines is to remain visible in the
8365         ;; article buffer.
8366         (goto-char 1)
8367         (while (re-search-forward "^[^ \t]*:" nil t)
8368           (beginning-of-line)
8369           ;; We add the headers we want to keep to a list and delete
8370           ;; them from the buffer.
8371           (if (or (and (stringp gnus-visible-headers)
8372                        (looking-at gnus-visible-headers))
8373                   (and (not (stringp gnus-visible-headers))
8374                        (stringp gnus-ignored-headers)
8375                        (not (looking-at gnus-ignored-headers))))
8376               (progn
8377                 (setq beg (point))
8378                 (forward-line 1)
8379                 ;; Be sure to get multi-line headers...
8380                 (re-search-forward "^[^ \t]*:" nil t)
8381                 (beginning-of-line)
8382                 (setq want-list 
8383                       (cons (buffer-substring beg (point)) want-list))
8384                 (delete-region beg (point))
8385                 (goto-char beg))
8386             (forward-line 1)))
8387         ;; Next we perform the sorting by looking at
8388         ;; `gnus-sorted-header-list'. 
8389         (goto-char 1)
8390         (while (and sorted want-list)
8391           (setq want-l want-list)
8392           (while (and want-l
8393                       (not (string-match (car sorted) (car want-l))))
8394             (setq want-l (cdr want-l)))
8395           (if want-l 
8396               (progn
8397                 (insert (car want-l))
8398                 (setq want-list (delq (car want-l) want-list))))
8399           (setq sorted (cdr sorted)))
8400         ;; Any headers that were not matched by the sorted list we
8401         ;; just tack on the end of the visible header list.
8402         (while want-list
8403           (insert (car want-list))
8404           (setq want-list (cdr want-list)))
8405         ;; And finally we make the unwanted headers invisible.
8406         (if delete
8407             (delete-region (point) (point-max))
8408           ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
8409           (add-text-properties (point) (point-max) '(invisible t)))))))
8410
8411 (defun gnus-article-hide-signature ()
8412   "Hides the signature in an article.
8413 It does this by hiding everyting after \"^-- *$\", which is what all
8414 signatures should be preceded by. Note that this may mean that parts
8415 of an article may disappear if the article has such a line in the
8416 middle of the text."
8417   (interactive)
8418   (save-excursion
8419     (goto-char (point-max))
8420     (if (re-search-backward "^-- *$" nil t)
8421         (progn
8422           (add-text-properties (point) (point-max) '(invisible t))))))
8423
8424 (defun gnus-article-hide-citation ()
8425   "Hide all cited text.
8426 This function uses the famous, extremely intelligent \"shoot in foot\"
8427 algorithm - which is simply deleting all lines that start with
8428 \">\". Your mileage may vary. If you come up with anything better,
8429 please do mail it to me."
8430   (interactive)
8431   (save-excursion
8432     (goto-char 1)
8433     (search-forward "\n\n" nil t)
8434     (while (not (eobp))
8435       (if (looking-at ">")
8436           (add-text-properties 
8437            (point) (save-excursion (forward-line 1) (point))
8438            '(invisible t)))
8439       (forward-line 1))))
8440
8441 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
8442 (defun gnus-article-treat-overstrike ()
8443   ;; Prepare article for overstrike commands.
8444   (interactive)
8445   (save-excursion
8446     (while (search-forward "\b" nil t)
8447       (let ((next (following-char))
8448             (previous (char-after (- (point) 2))))
8449         (cond ((eq next previous)
8450                (delete-region (- (point) 2) (point))
8451                (put-text-property (point) (1+ (point))
8452                                   'face 'bold))
8453               ((eq next ?_)
8454                (delete-region (1- (point)) (1+ (point)))
8455                (put-text-property (1- (point)) (point)
8456                                   'face 'underline))
8457               ((eq previous ?_)
8458                (delete-region (- (point) 2) (point))
8459                (put-text-property (point) (1+ (point))
8460                                   'face 'underline)))))))
8461
8462 (defun gnus-article-remove-cr ()
8463   (interactive)
8464   (while (search-forward "\r" nil t)
8465     (replace-match "")))
8466
8467 (defun gnus-article-de-quoted-unreadable ()
8468   (interactive)
8469   (save-excursion
8470     (save-restriction
8471       (widen)
8472       (goto-char (point-min))
8473       (while (re-search-forward "=[0-9A-F][0-9A-F]" nil t)
8474         (replace-match 
8475          (char-to-string 
8476           (+
8477            (* 16 (gnus-hex-char-to-integer 
8478                   (char-after (1+ (match-beginning 0)))))
8479            (gnus-hex-char-to-integer
8480             (char-after (1- (match-end 0)))))))))))
8481
8482 ;; Taken from hexl.el.
8483 (defun gnus-hex-char-to-integer (character)
8484   "Take a char and return its value as if it was a hex digit."
8485   (if (and (>= character ?0) (<= character ?9))
8486       (- character ?0)
8487     (let ((ch (logior character 32)))
8488       (if (and (>= ch ?a) (<= ch ?f))
8489           (- ch (- ?a 10))
8490         (error (format "Invalid hex digit `%c'." ch))))))
8491
8492 ;; Article savers.
8493
8494 (defun gnus-output-to-rmail (file-name)
8495   "Append the current article to an Rmail file named FILE-NAME."
8496   (require 'rmail)
8497   ;; Most of these codes are borrowed from rmailout.el.
8498   (setq file-name (expand-file-name file-name))
8499   (setq rmail-default-rmail-file file-name)
8500   (let ((artbuf (current-buffer))
8501         (tmpbuf (get-buffer-create " *Gnus-output*")))
8502     (save-excursion
8503       (or (get-file-buffer file-name)
8504           (file-exists-p file-name)
8505           (if (yes-or-no-p
8506                (concat "\"" file-name "\" does not exist, create it? "))
8507               (let ((file-buffer (create-file-buffer file-name)))
8508                 (save-excursion
8509                   (set-buffer file-buffer)
8510                   (rmail-insert-rmail-file-header)
8511                   (let ((require-final-newline nil))
8512                     (write-region (point-min) (point-max) file-name t 1)))
8513                 (kill-buffer file-buffer))
8514             (error "Output file does not exist")))
8515       (set-buffer tmpbuf)
8516       (buffer-disable-undo (current-buffer))
8517       (erase-buffer)
8518       (insert-buffer-substring artbuf)
8519       (gnus-convert-article-to-rmail)
8520       ;; Decide whether to append to a file or to an Emacs buffer.
8521       (let ((outbuf (get-file-buffer file-name)))
8522         (if (not outbuf)
8523             (append-to-file (point-min) (point-max) file-name)
8524           ;; File has been visited, in buffer OUTBUF.
8525           (set-buffer outbuf)
8526           (let ((buffer-read-only nil)
8527                 (msg (and (boundp 'rmail-current-message)
8528                           rmail-current-message)))
8529             ;; If MSG is non-nil, buffer is in RMAIL mode.
8530             (if msg
8531                 (progn (widen)
8532                        (narrow-to-region (point-max) (point-max))))
8533             (insert-buffer-substring tmpbuf)
8534             (if msg
8535                 (progn
8536                   (goto-char (point-min))
8537                   (widen)
8538                   (search-backward "\^_")
8539                   (narrow-to-region (point) (point-max))
8540                   (goto-char (1+ (point-min)))
8541                   (rmail-count-new-messages t)
8542                   (rmail-show-message msg))))))
8543       )
8544     (kill-buffer tmpbuf)
8545     ))
8546
8547 (defun gnus-output-to-file (file-name)
8548   "Append the current article to a file named FILE-NAME."
8549   (setq file-name (expand-file-name file-name))
8550   (let ((artbuf (current-buffer))
8551         (tmpbuf (get-buffer-create " *Gnus-output*")))
8552     (save-excursion
8553       (set-buffer tmpbuf)
8554       (buffer-disable-undo (current-buffer))
8555       (erase-buffer)
8556       (insert-buffer-substring artbuf)
8557       ;; Append newline at end of the buffer as separator, and then
8558       ;; save it to file.
8559       (goto-char (point-max))
8560       (insert "\n")
8561       (append-to-file (point-min) (point-max) file-name))
8562     (kill-buffer tmpbuf)
8563     ))
8564
8565 (defun gnus-convert-article-to-rmail ()
8566   "Convert article in current buffer to Rmail message format."
8567   (let ((buffer-read-only nil))
8568     ;; Convert article directly into Babyl format.
8569     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
8570     (goto-char (point-min))
8571     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
8572     (while (search-forward "\n\^_" nil t) ;single char
8573       (replace-match "\n^_"))           ;2 chars: "^" and "_"
8574     (goto-char (point-max))
8575     (insert "\^_")))
8576
8577 (defun gnus-narrow-to-page (&optional arg)
8578   "Make text outside current page invisible except for page delimiter.
8579 A numeric arg specifies to move forward or backward by that many pages,
8580 thus showing a page other than the one point was originally in."
8581   (interactive "P")
8582   (setq arg (if arg (prefix-numeric-value arg) 0))
8583   (save-excursion
8584     (forward-page -1)                   ;Beginning of current page.
8585     (widen)
8586     (if (> arg 0)
8587         (forward-page arg)
8588       (if (< arg 0)
8589           (forward-page (1- arg))))
8590     ;; Find the end of the page.
8591     (forward-page)
8592     ;; If we stopped due to end of buffer, stay there.
8593     ;; If we stopped after a page delimiter, put end of restriction
8594     ;; at the beginning of that line.
8595     ;; These are commented out.
8596     ;;    (if (save-excursion (beginning-of-line)
8597     ;;                  (looking-at page-delimiter))
8598     ;;  (beginning-of-line))
8599     (narrow-to-region (point)
8600                       (progn
8601                         ;; Find the top of the page.
8602                         (forward-page -1)
8603                         ;; If we found beginning of buffer, stay there.
8604                         ;; If extra text follows page delimiter on same line,
8605                         ;; include it.
8606                         ;; Otherwise, show text starting with following line.
8607                         (if (and (eolp) (not (bobp)))
8608                             (forward-line 1))
8609                         (point)))
8610     ))
8611
8612 (defun gnus-gmt-to-local ()
8613   "Rewrite Date: field described in GMT to local in current buffer.
8614 The variable gnus-local-timezone is used for local time zone.
8615 Intended to be used with gnus-article-prepare-hook."
8616   (save-excursion
8617     (save-restriction
8618       (widen)
8619       (goto-char (point-min))
8620       (narrow-to-region (point-min)
8621                         (progn (search-forward "\n\n" nil 'move) (point)))
8622       (goto-char (point-min))
8623       (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
8624           (let ((buffer-read-only nil)
8625                 (date (buffer-substring (match-beginning 1) (match-end 1))))
8626             (delete-region (match-beginning 1) (match-end 1))
8627             (insert
8628              (timezone-make-date-arpa-standard date nil gnus-local-timezone))
8629             ))
8630       )))
8631
8632
8633 ;; Article mode commands
8634
8635 (defun gnus-article-next-page (lines)
8636   "Show next page of current article.
8637 If end of article, return non-nil. Otherwise return nil.
8638 Argument LINES specifies lines to be scrolled up."
8639   (interactive "P")
8640   (move-to-window-line -1)
8641   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
8642   (if (save-excursion
8643         (end-of-line)
8644         (and (pos-visible-in-window-p)  ;Not continuation line.
8645              (eobp)))
8646       ;; Nothing in this page.
8647       (if (or (not gnus-break-pages)
8648               (save-excursion
8649                 (save-restriction
8650                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
8651           t                             ;Nothing more.
8652         (gnus-narrow-to-page 1)         ;Go to next page.
8653         nil
8654         )
8655     ;; More in this page.
8656     (condition-case ()
8657         (scroll-up lines)
8658       (end-of-buffer
8659        ;; Long lines may cause an end-of-buffer error.
8660        (goto-char (point-max))))
8661     nil
8662     ))
8663
8664 (defun gnus-article-prev-page (lines)
8665   "Show previous page of current article.
8666 Argument LINES specifies lines to be scrolled down."
8667   (interactive "P")
8668   (move-to-window-line 0)
8669   (if (and gnus-break-pages
8670            (bobp)
8671            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
8672       (progn
8673         (gnus-narrow-to-page -1) ;Go to previous page.
8674         (goto-char (point-max))
8675         (recenter -1))
8676     (scroll-down lines)))
8677
8678 (defun gnus-article-next-digest (nth)
8679   "Move to head of NTH next digested message.
8680 Set mark at end of digested message."
8681   ;; Stop page breaking in digest mode.
8682   (widen)
8683   (end-of-line)
8684   ;; Skip NTH - 1 digest.
8685   ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
8686   ;; Digest separator is customizable.
8687   ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
8688   (while (and (> nth 1)
8689               (re-search-forward gnus-digest-separator nil 'move))
8690     (setq nth (1- nth)))
8691   (if (re-search-forward gnus-digest-separator nil t)
8692       (let ((begin (point)))
8693         ;; Search for end of this message.
8694         (end-of-line)
8695         (if (re-search-forward gnus-digest-separator nil t)
8696             (progn
8697               (search-backward "\n\n")  ;This may be incorrect.
8698               (forward-line 1))
8699           (goto-char (point-max)))
8700         (push-mark)                     ;Set mark at end of digested message.
8701         (goto-char begin)
8702         (beginning-of-line)
8703         ;; Show From and Subject fields.
8704         (recenter 1))
8705     (message "End of message")
8706     ))
8707
8708 (defun gnus-article-prev-digest (nth)
8709   "Move to head of NTH previous digested message."
8710   ;; Stop page breaking in digest mode.
8711   (widen)
8712   (beginning-of-line)
8713   ;; Skip NTH - 1 digest.
8714   ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
8715   ;; Digest separator is customizable.
8716   ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
8717   (while (and (> nth 1)
8718               (re-search-backward gnus-digest-separator nil 'move))
8719     (setq nth (1- nth)))
8720   (if (re-search-backward gnus-digest-separator nil t)
8721       (let ((begin (point)))
8722         ;; Search for end of this message.
8723         (end-of-line)
8724         (if (re-search-forward gnus-digest-separator nil t)
8725             (progn
8726               (search-backward "\n\n")  ;This may be incorrect.
8727               (forward-line 1))
8728           (goto-char (point-max)))
8729         (push-mark)                     ;Set mark at end of digested message.
8730         (goto-char begin)
8731         ;; Show From: and Subject: fields.
8732         (recenter 1))
8733     (goto-char (point-min))
8734     (message "Top of message")
8735     ))
8736
8737 (defun gnus-article-refer-article ()
8738   "Read article specified by message-id around point."
8739   (interactive)
8740   (search-forward ">" nil t)    ;Move point to end of "<....>".
8741   (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
8742       (let ((message-id
8743              (buffer-substring (match-beginning 1) (match-end 1))))
8744         (set-buffer gnus-summary-buffer)
8745         (gnus-summary-refer-article message-id))
8746     (error "No references around point")))
8747
8748 (defun gnus-article-mail (yank)
8749   "Send a reply to the address near point.
8750 If YANK is non-nil, include the original article."
8751   (interactive "P")
8752   (let ((address 
8753          (buffer-substring
8754           (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
8755           (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
8756     (and address
8757          (progn
8758            (switch-to-buffer gnus-summary-buffer)
8759            (funcall gnus-mail-reply-method yank address)))))
8760
8761 (defun gnus-article-mail-with-original ()
8762   "Send a reply to the address near point and include the original article."
8763   (interactive)
8764   (gnus-article-mail 'yank))
8765
8766 (defun gnus-article-show-summary ()
8767   "Reconfigure windows to show summary buffer."
8768   (interactive)
8769   (gnus-configure-windows 'article)
8770   (pop-to-buffer gnus-summary-buffer)
8771   (gnus-summary-goto-subject gnus-current-article))
8772
8773 (defun gnus-article-describe-briefly ()
8774   "Describe article mode commands briefly."
8775   (interactive)
8776   (message
8777    (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")))
8778
8779 (defun gnus-article-summary-command ()
8780   "Execute the last keystroke in the summary buffer."
8781   (interactive)
8782   (message "                                                                              ")
8783   (let ((obuf (current-buffer))
8784         (owin (current-window-configuration)))
8785     (switch-to-buffer gnus-summary-buffer 'norecord)
8786     (execute-kbd-macro (this-command-keys))
8787     (set-buffer obuf)
8788     (let ((npoint (point)))
8789       (set-window-configuration owin)
8790       (set-window-start (get-buffer-window (current-buffer)) (point)))))
8791
8792 ;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
8793 ;; Modified by tower@prep Nov 86
8794 ;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
8795
8796 (defun gnus-caesar-region (&optional n)
8797   "Caesar rotation of region by N, default 13, for decrypting netnews.
8798 ROT47 will be performed for Japanese text in any case."
8799   (interactive (if current-prefix-arg   ; Was there a prefix arg?
8800                    (list (prefix-numeric-value current-prefix-arg))
8801                  (list nil)))
8802   (cond ((not (numberp n)) (setq n 13))
8803         (t (setq n (mod n 26))))        ;canonicalize N
8804   (if (not (zerop n))           ; no action needed for a rot of 0
8805       (progn
8806         (if (or (not (boundp 'caesar-translate-table))
8807                 (not caesar-translate-table)
8808                 (/= (aref caesar-translate-table ?a) (+ ?a n)))
8809             (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
8810               (message "Building caesar-translate-table...")
8811               (setq caesar-translate-table (make-vector 256 0))
8812               (while (< i 256)
8813                 (aset caesar-translate-table i i)
8814                 (setq i (1+ i)))
8815               (setq lower (concat lower lower) upper (upcase lower) i 0)
8816               (while (< i 26)
8817                 (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
8818                 (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
8819                 (setq i (1+ i)))
8820               ;; ROT47 for Japanese text.
8821               ;; Thanks to ichikawa@flab.fujitsu.junet.
8822               (setq i 161)
8823               (let ((t1 (logior ?O 128))
8824                     (t2 (logior ?! 128))
8825                     (t3 (logior ?~ 128)))
8826                 (while (< i 256)
8827                   (aset caesar-translate-table i
8828                         (let ((v (aref caesar-translate-table i)))
8829                           (if (<= v t1) (if (< v t2) v (+ v 47))
8830                             (if (<= v t3) (- v 47) v))))
8831                   (setq i (1+ i))))
8832               (message "Building caesar-translate-table... done")))
8833         (let ((from (region-beginning))
8834               (to (region-end))
8835               (i 0) str len)
8836           (setq str (buffer-substring from to))
8837           (setq len (length str))
8838           (while (< i len)
8839             (aset str i (aref caesar-translate-table (aref str i)))
8840             (setq i (1+ i)))
8841           (goto-char from)
8842           (delete-region from to)
8843           (insert str)))))
8844
8845 \f
8846 ;;;
8847 ;;; Gnus Score File Mode
8848 ;;;
8849
8850 (if gnus-kill-file-mode-map
8851     nil
8852   (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
8853   (define-key gnus-kill-file-mode-map "\C-c\C-x"
8854     'gnus-kill-file-set-expunge-below)
8855   (define-key gnus-kill-file-mode-map "\C-c@"
8856     'gnus-kill-file-set-mark-below)
8857   (define-key gnus-kill-file-mode-map "\C-c\C-k\C-s"
8858     'gnus-kill-file-temporarily-lower-by-subject)
8859   (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a"
8860     'gnus-kill-file-temporarily-lower-by-author)
8861   (define-key gnus-kill-file-mode-map "\C-c\C-k\C-x"
8862     'gnus-kill-file-temporarily-lower-by-xref)
8863   (define-key gnus-kill-file-mode-map "\C-c\C-ks"
8864     'gnus-kill-file-lower-by-subject)
8865   (define-key gnus-kill-file-mode-map "\C-c\C-ka"
8866     'gnus-kill-file-lower-by-author)
8867   (define-key gnus-kill-file-mode-map "\C-c\C-kt"
8868     'gnus-kill-file-lower-by-thread)
8869   (define-key gnus-kill-file-mode-map "\C-c\C-kx"
8870     'gnus-kill-file-lower-by-xref)
8871   (define-key gnus-kill-file-mode-map "\C-c\C-kf"
8872     'gnus-kill-file-lower-followups-to-author)
8873   (define-key gnus-kill-file-mode-map "\C-c\C-i\C-s"
8874     'gnus-kill-file-temporarily-raise-by-subject)
8875   (define-key gnus-kill-file-mode-map "\C-c\C-i\C-a"
8876     'gnus-kill-file-temporarily-raise-by-author)
8877   (define-key gnus-kill-file-mode-map "\C-c\C-i\C-t"
8878     'gnus-kill-file-temporarily-raise-by-thread)
8879   (define-key gnus-kill-file-mode-map "\C-c\C-i\C-x"
8880     'gnus-kill-file-temporarily-raise-by-xref)
8881   (define-key gnus-kill-file-mode-map "\C-c\C-is"
8882     'gnus-kill-file-raise-by-subject)
8883   (define-key gnus-kill-file-mode-map "\C-c\C-ia"
8884     'gnus-kill-file-raise-by-author)
8885   (define-key gnus-kill-file-mode-map "\C-c\C-ix"
8886     'gnus-kill-file-raise-by-xref)
8887   (define-key gnus-kill-file-mode-map "\C-c\C-if"
8888     'gnus-kill-file-raise-followups-to-author)
8889   (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer)
8890   (define-key gnus-kill-file-mode-map "\C-c\C-e" 'gnus-kill-file-apply-last-sexp)
8891   (define-key gnus-kill-file-mode-map "\C-c\C-c" 'gnus-kill-file-exit)
8892   (define-key gnus-kill-file-mode-map "\C-c\C-i" 'gnus-info-find-node))
8893
8894 (defun gnus-kill-file-mode ()
8895   "Major mode for editing score files.
8896
8897 In addition to Emacs-Lisp mode, the following commands are available:
8898
8899 \\[gnus-kill-file-set-expunge-below]    Automatically expunge articles below LEVEL.
8900 \\[gnus-kill-file-set-mark-below]       Automatically mark articles below LEVEL.
8901 \\[gnus-kill-file-temporarily-lower-by-author]  Insert temporary lower command for current author.
8902 \\[gnus-kill-file-temporarily-lower-by-thread]  Insert temporary lower command for current thread.
8903 \\[gnus-kill-file-temporarily-lower-by-xref]            Insert temporary lower command for current cross-posting.
8904 \\[gnus-kill-file-lower-by-subject]     Insert permanent lower command for current subject.
8905 \\[gnus-kill-file-lower-by-author]      Insert permanent lower command for current author.
8906 \\[gnus-kill-file-lower-followups-to-author]    Insert permanent lower command for followups to the current author.
8907 \\[gnus-kill-file-lower-by-xref]                Insert permanent lower command for current cross-posting.
8908 \\[gnus-kill-file-temporarily-raise-by-subject] Insert temporary raise command for current subject.
8909 \\[gnus-kill-file-temporarily-raise-by-author]  Insert temporary raise command for current author.
8910 \\[gnus-kill-file-temporarily-raise-by-thread]  Insert temporary raise command for current thread.
8911 \\[gnus-kill-file-temporarily-raise-by-xref]            Insert temporary raise command for current cross-posting.
8912 \\[gnus-kill-file-raise-by-subject]     Insert permanent raise command for current subject.
8913 \\[gnus-kill-file-raise-by-author]      Insert permanent raise command for current author.
8914 \\[gnus-kill-file-raise-followups-to-author]    Insert permanent raise command for followups to the current author.
8915 \\[gnus-kill-file-raise-by-xref]                Insert permanent raise command for current cross-posting.
8916 \\[gnus-kill-file-apply-buffer] Apply current buffer to selected newsgroup.
8917 \\[gnus-kill-file-apply-last-sexp]      Apply sexp before point to selected newsgroup.
8918 \\[gnus-kill-file-exit] Save file and exit editing score file.
8919 \\[gnus-info-find-node] Read Info about score files.
8920
8921   A score file contains Lisp expressions to be applied to a selected
8922 newsgroup.  The purpose is to mark articles as read on the basis of
8923 some set of regexps.  A global score file is applied to every
8924 newsgroup, and a local score file is applied to a specified newsgroup.
8925 Since a global score file is applied to every newsgroup, for better
8926 performance use a local one.
8927
8928   A score file can contain any kind of Emacs Lisp expressions expected
8929 to be evaluated in the summary buffer.  Writing Lisp programs for this
8930 purpose is not so easy because the internal working of Gnus must be
8931 well-known.  For this reason, Gnus provides a general function which
8932 does this easily for non-Lisp programmers.
8933
8934   The `gnus-kill' function executes commands available in summary mode
8935 by their key sequences. `gnus-kill' should be called with FIELD,
8936 REGEXP and optional COMMAND and ALL.  FIELD is a string representing
8937 the header field or an empty string.  If FIELD is an empty string, the
8938 entire article body is searched for.  REGEXP is a string which is
8939 compared with FIELD value. COMMAND is a string representing a valid
8940 key sequence in summary mode or Lisp expression. COMMAND defaults to
8941 '(gnus-summary-mark-as-read nil \"X\").  Make sure that COMMAND is
8942 executed in the summary buffer.  If the second optional argument ALL
8943 is non-nil, the COMMAND is applied to articles which are already
8944 marked as read or unread.  Articles which are marked are skipped over
8945 by default.
8946
8947   For example, if you want to mark articles of which subjects contain
8948 the string `AI' as read, a possible score file may look like:
8949
8950         (gnus-kill \"Subject\" \"AI\")
8951
8952   If you want to mark articles with `D' instead of `X', you can use
8953 the following expression:
8954
8955         (gnus-kill \"Subject\" \"AI\" \"d\")
8956
8957 In this example it is assumed that the command
8958 `gnus-summary-mark-as-read-forward' is assigned to `d' in summary mode.
8959
8960   It is possible to remove unnecessary headers which are marked with
8961 `X' in a score file as follows:
8962
8963         (gnus-expunge \"X\")
8964
8965   If the summary buffer is empty after applying score files, Gnus will
8966 exit the selected newsgroup normally.  If headers which are marked
8967 with `D' are deleted in a score file, it is impossible to read articles
8968 which are marked as read in the previous Gnus sessions.  Marks other
8969 than `D' should be used for articles which should really be deleted.
8970
8971 Entry to this mode calls emacs-lisp-mode-hook and
8972 gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
8973   (interactive)
8974   (kill-all-local-variables)
8975   (use-local-map gnus-kill-file-mode-map)
8976   (set-syntax-table emacs-lisp-mode-syntax-table)
8977   (setq major-mode 'gnus-kill-file-mode)
8978   (setq mode-name "score-file")
8979   (lisp-mode-variables nil)
8980   (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
8981
8982 (defun gnus-kill-file-edit-file (newsgroup)
8983   "Begin editing a score file for NEWSGROUP.
8984 If NEWSGROUP is nil, the global score file is selected."
8985   (interactive "sNewsgroup: ")
8986   (let ((file (gnus-newsgroup-kill-file newsgroup)))
8987     (gnus-make-directory (file-name-directory file))
8988     ;; Save current window configuration if this is first invocation.
8989     (or (and (get-file-buffer file)
8990              (get-buffer-window (get-file-buffer file)))
8991         (setq gnus-winconf-kill-file (current-window-configuration)))
8992     ;; Hack windows.
8993     (let ((buffer (find-file-noselect file)))
8994       (cond ((get-buffer-window buffer)
8995              (pop-to-buffer buffer))
8996             ((eq major-mode 'gnus-group-mode)
8997              (gnus-configure-windows '(1 0 0)) ;Take all windows.
8998              (pop-to-buffer gnus-group-buffer)
8999              ;; Fix by sachs@SLINKY.CS.NYU.EDU (Jay Sachs).
9000              (let ((gnus-summary-buffer buffer))
9001                (gnus-configure-windows '(1 1 0))) ;Split into two.
9002              (pop-to-buffer buffer))
9003             ((eq major-mode 'gnus-summary-mode)
9004              (gnus-configure-windows 'article)
9005              (pop-to-buffer gnus-article-buffer)
9006              (bury-buffer gnus-article-buffer)
9007              (switch-to-buffer buffer))
9008             (t                          ;No good rules.
9009              (find-file-other-window file))
9010             ))
9011     (gnus-kill-file-mode)
9012     ))
9013
9014 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
9015 (defun gnus-kill-set-kill-buffer ()
9016   (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))
9017          (buffer (find-file-noselect file)))
9018     (set-buffer buffer)
9019     (gnus-kill-file-mode)
9020     (bury-buffer buffer)))
9021
9022 (defun gnus-kill-save-kill-buffer ()
9023   (save-excursion
9024     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
9025       (if (get-file-buffer file)
9026           (progn
9027             (set-buffer (get-file-buffer file))
9028             (and (buffer-modified-p) (save-buffer))
9029             (kill-buffer (current-buffer)))))))
9030
9031 (defun gnus-article-fetch-field (field)
9032   (save-excursion
9033     (set-buffer gnus-article-buffer)
9034     (save-restriction
9035       (widen)
9036       (goto-char 1)
9037       (narrow-to-region 1 (save-excursion 
9038                             (search-forward "\n\n" nil t) (point)))
9039       (goto-char 1)
9040       (prog1
9041           (mail-fetch-field field)
9042         (widen)))))
9043
9044 (defun gnus-kill-file-enter-kill (field regexp level date edit)
9045   ;; Enter score file entry.
9046   ;; FIELD: String containing the name of the header field to score.
9047   ;; REGEXP: The string to score.
9048   ;; LEVEL: How much to raise the score by.
9049   ;; DATE: A date string for expire score or nil for permanent kills.
9050   ;; EDIT: Allow the user to edit REGEXP iff non-nil.
9051   (save-excursion
9052     (gnus-kill-set-kill-buffer)
9053     (goto-char (point-min))
9054     (let ((regexp 
9055            (if edit (read-string 
9056                      (format "Add %d to articles with %s matching: " 
9057                              level (downcase field))
9058                      regexp)
9059              regexp))
9060           entry string kill beg)
9061       (setq entry (if date (cons regexp date) regexp)
9062             string (format "(gnus-raise %S (quote %S) %S)\n"
9063                            field entry level))
9064       (while (and (setq beg (point))
9065                   (condition-case nil
9066                       (setq kill (read (current-buffer)))
9067                     (error nil))
9068                   (or (not (eq (nth 0 kill) 'gnus-raise))
9069                       (not (string= (downcase (nth 1 kill)) (downcase field)))
9070                       (not (eq (nth 3 kill) level))))
9071         (setq kill nil))
9072       (if (not kill)
9073           (progn
9074             (goto-char (point-min))
9075             (insert string))
9076         (let ((list (nth 2 kill)))
9077           (if (and (listp list) (eq 'quote (car list)))
9078               (setq list (car (cdr list))))
9079           (setcar 
9080            (nthcdr 2 kill) 
9081            (if (and (listp list) (listp (cdr list)))
9082                (list 'quote (cons entry list))
9083              (list 'quote (list entry list)))))
9084         (delete-region beg (point))
9085         (insert (gnus-pp-gnus-kill kill)))
9086       (gnus-kill-file-apply-string string))
9087     ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
9088     (or edit 
9089         (message "Added kill file entry %s: %s" (downcase field) regexp))))
9090     
9091 (defun gnus-kill-file-set-variable (symbol value)
9092    ;; Set SYMBOL to VALUE in the score file.
9093    (save-excursion
9094      (gnus-kill-set-kill-buffer)
9095      (goto-char (point-min))
9096      (let ((string (format "(setq %S %S)\n" symbol value))
9097            kill beg)
9098        (while (and (setq beg (point))
9099                    (condition-case nil
9100                        (setq kill (read (current-buffer)))
9101                      (error nil))
9102                    (or (not (eq (nth 0 kill) 'setq))
9103                        (not (eq (nth 1 kill) symbol))))
9104          (setq kill nil))
9105        (if (not kill)
9106            (progn
9107              (goto-char (point-min))
9108              (insert string))
9109          (delete-region beg (point))
9110          (insert string)))))
9111     
9112 (defun gnus-kill-file-set-expunge-below (level)
9113    "Automatically expunge articles with score below LEVEL."
9114    (interactive "P")
9115    (setq level (if level
9116                   (prefix-numeric-value level)
9117                 gnus-summary-default-score))
9118    (if (eq major-mode 'gnus-summary-mode)
9119        (progn
9120          (gnus-score-set 'expunge level)
9121          (gnus-score-set 'touched t))
9122      (gnus-kill-file-set-variable 'expunge-below level))
9123    (message "Set expunge below level to %d." level))
9124
9125  (defun gnus-kill-file-set-mark-below (level)
9126    "Automatically mark articles with score below LEVEL as read."
9127    (interactive "P")
9128    (setq level (if level
9129                    (prefix-numeric-value level)
9130                  gnus-summary-default-score))
9131    (if (eq major-mode 'gnus-summary-mode)
9132        (progn
9133          (gnus-score-set 'mark level)
9134          (gnus-score-set 'touched t)
9135          (gnus-summary-set-mark-below level))
9136      (gnus-kill-file-set-variable 'mark-below level))
9137    (message "Set mark below level to %d." level))
9138  
9139  (defun gnus-kill-file-temporarily-raise-by-subject (level &optional header)
9140    "Temporarily raise score by LEVEL for current subject.
9141  See `gnus-kill-expiry-days'."
9142    (interactive "p")
9143    (gnus-kill-file-raise-by-subject level header (current-time-string)))
9144   
9145  (defun gnus-kill-file-temporarily-raise-by-author (level &optional header)
9146    "Temporarily raise score by LEVEL for current author.
9147  See `gnus-kill-expiry-days'."
9148    (interactive "p")
9149    (gnus-kill-file-raise-by-author level header (current-time-string)))
9150   
9151  (defun gnus-kill-file-temporarily-raise-by-thread (level &optional header)
9152    "Temporarily raise score by LEVEL for current thread.
9153  See `gnus-kill-expiry-days'."
9154    (interactive "p")
9155    (gnus-kill-file-enter-kill 
9156     "References"
9157     (regexp-quote (header-id (or header gnus-current-headers)))
9158     level
9159     (current-time-string)
9160     nil))
9161   
9162  (defun gnus-kill-file-temporarily-raise-by-xref (level &optional header)
9163    "Insert temporary score commands for articles that have been crossposted.
9164  By default use the current crossposted groups.
9165  See `gnus-kill-expiry-days'."
9166    (interactive "p")
9167    (gnus-kill-file-raise-by-xref level header (current-time-string)))
9168   
9169  (defun gnus-kill-file-raise-by-subject (level &optional header date)
9170    "Raise score by LEVEL for current subject."
9171    (interactive "p")
9172    (gnus-kill-file-enter-kill
9173     "Subject"
9174     (regexp-quote 
9175      (gnus-simplify-subject 
9176       (header-subject (or header gnus-current-headers))))
9177     level
9178     date
9179     t))
9180   
9181  (defun gnus-kill-file-raise-by-author (level &optional header date)
9182    "Raise score by LEVEL for current author."
9183    (interactive "p")
9184    (gnus-kill-file-enter-kill
9185     "From"
9186     (regexp-quote (header-from (or header gnus-current-headers)))
9187     level
9188     date
9189     t))
9190  
9191  (defun gnus-kill-file-raise-by-xref (level &optional header date)
9192    "Raise score by LEVEL for articles that have been crossposted.
9193  By default use the current crossposted groups."
9194    (interactive "p")
9195    (let ((xref (header-xref (or header gnus-current-headers)))
9196          (start 0)
9197          group)
9198      (if xref
9199          (while (string-match " \\([^ \t]+\\):" xref start)
9200            (setq start (match-end 0))
9201            (if (not (string= 
9202                      (setq group 
9203                            (substring xref (match-beginning 1) (match-end 1)))
9204                      gnus-newsgroup-name))
9205                (gnus-kill-file-enter-kill 
9206                 "Xref"
9207                 (concat " " (regexp-quote group) ":")
9208                 level
9209                 date
9210                 t))))))
9211
9212 (defun gnus-kill-file-raise-followups-to-author
9213   (level &optional header)
9214   "Raise score for all followups to the current author."
9215   (interactive)
9216   (let ((name (header-from (or header gnus-current-headers)))
9217         (string))
9218     (save-excursion
9219       (gnus-kill-set-kill-buffer)
9220       (goto-char (point-min))
9221       (setq name (read-string (concat "Add " level
9222                                       " to followup articles to: ")
9223                               (regexp-quote name)))
9224       (setq string
9225             (format "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
9226                     "From" name level))
9227       (insert string)
9228       (gnus-kill-file-apply-string string))
9229     (message "Added permanent score file entry for followups to %s." name)))
9230
9231 (defun gnus-kill-file-temporarily-lower-by-subject (level &optional header)
9232   "Temporarily lower score by LEVEL for current subject.
9233 See `gnus-kill-expiry-days'."
9234   (interactive "p")
9235   (gnus-kill-file-lower-by-subject level header (current-time-string)))
9236
9237 (defun gnus-kill-file-temporarily-lower-by-author (level &optional header)
9238   "Temporarily lower score by LEVEL for current author.
9239 See `gnus-kill-expiry-days'."
9240   (interactive "p")
9241   (gnus-kill-file-lower-by-author level header (current-time-string)))
9242
9243 (defun gnus-kill-file-temporarily-lower-by-thread (level &optional header)
9244   "Temporarily lower score by LEVEL for current thread.
9245 See `gnus-kill-expiry-days'."
9246   (interactive "p")
9247   (gnus-kill-file-temporarily-raise-by-thread (- level) header))
9248
9249 (defun gnus-kill-file-temporarily-lower-by-xref (level &optional header)
9250   "Insert temporary score commands for articles that have been crossposted.
9251 By default use the current crossposted groups.
9252 See `gnus-kill-expiry-days'."
9253   (interactive "p")
9254   (gnus-kill-file-lower-by-xref level header (current-time-string)))
9255
9256 (defun gnus-kill-file-lower-by-subject (level &optional header date)
9257     "Lower score by LEVEL for current subject."
9258   (interactive "p")
9259   (gnus-kill-file-raise-by-subject (- level) header date))
9260
9261 (defun gnus-kill-file-lower-by-author (level &optional header date)
9262   "Lower score by LEVEL for current author."
9263   (interactive "p")
9264   (gnus-kill-file-raise-by-author (- level) header date))
9265
9266 (defun gnus-kill-file-lower-by-xref (level &optional header date)
9267   "Lower score by LEVEL for articles that have been crossposted.
9268 By default use the current crossposted groups."
9269   (gnus-kill-file-raise-by-xref (- level) header date))
9270
9271 (defun gnus-kill-file-lower-followups-to-author
9272   (level &optional header)
9273   "Lower score for all followups to the current author."
9274   (interactive "p")
9275   (gnus-kill-file-raise-followups-to-author (- level) header))
9276
9277 (defun gnus-kill-file-apply-buffer ()
9278   "Apply current buffer to current newsgroup."
9279   (interactive)
9280   (if (and gnus-current-kill-article
9281            (get-buffer gnus-summary-buffer))
9282       ;; Assume newsgroup is selected.
9283       (gnus-kill-file-apply-string (buffer-string))
9284     (ding) (message "No newsgroup is selected.")))
9285
9286 (defun gnus-kill-file-apply-string (string)
9287   "Apply STRING to current newsgroup."
9288   (interactive)
9289   (let ((string (concat "(progn \n" string "\n)" )))
9290     (save-excursion
9291       (save-window-excursion
9292         (pop-to-buffer gnus-summary-buffer)
9293         (eval (car (read-from-string string)))))))
9294
9295 (defun gnus-kill-file-apply-last-sexp ()
9296   "Apply sexp before point in current buffer to current newsgroup."
9297   (interactive)
9298   (if (and gnus-current-kill-article
9299            (get-buffer gnus-summary-buffer))
9300       ;; Assume newsgroup is selected.
9301       (let ((string
9302              (buffer-substring
9303               (save-excursion (forward-sexp -1) (point)) (point))))
9304         (save-excursion
9305           (save-window-excursion
9306             (pop-to-buffer gnus-summary-buffer)
9307             (eval (car (read-from-string string))))))
9308     (ding) (message "No newsgroup is selected.")))
9309
9310 (defun gnus-kill-file-exit ()
9311   "Save a score file, then return to the previous buffer."
9312   (interactive)
9313   (save-buffer)
9314   (let ((killbuf (current-buffer)))
9315     ;; We don't want to return to article buffer.
9316     (and (get-buffer gnus-article-buffer)
9317          (bury-buffer gnus-article-buffer))
9318     ;; Delete the KILL file windows.
9319     (delete-windows-on killbuf)
9320     ;; Restore last window configuration if available.
9321     (and gnus-winconf-kill-file
9322          (set-window-configuration gnus-winconf-kill-file))
9323     (setq gnus-winconf-kill-file nil)
9324     ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
9325     (kill-buffer killbuf)))
9326
9327 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
9328
9329 (defalias 'gnus-batch-kill 'gnus-batch-score)
9330 ;;;###autoload
9331 (defun gnus-batch-score ()
9332   "Run batched scoring.
9333 Usage: emacs -batch -l gnus -f gnus-batch-kill <newsgroups> ...
9334 Newsgroups is a list of strings on the .newsrc options -n format. 
9335 If you want to score the comp hierarchy, you'd say \"comp.all\". If
9336 you would not like to score the alt hierarchy, you'd say
9337 \"!alt.all\"."
9338   (interactive)
9339 ;  (or noninteractive
9340 ;      (error "gnus-batch-kill is to be used only with -batch"))
9341   (let* ((yes-and-no
9342           (gnus-parse-n-options
9343            (apply (function concat)
9344                   (mapcar (lambda (g) (concat g " "))
9345                           command-line-args-left))))
9346          (yes (car yes-and-no))
9347          (no (cdr yes-and-no))
9348          group subscribed newsrc entry
9349          ;; Disable verbose message.
9350          gnus-novice-user gnus-large-newsgroup)
9351     ;; Eat all arguments.
9352     (setq command-line-args-left nil)
9353     ;; Start Gnus.
9354     (gnus)
9355     ;; Apply kills to specified newsgroups in command line arguments.
9356     (setq newsrc gnus-newsrc-assoc)
9357     (while newsrc
9358       (setq group (car (car newsrc)))
9359       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
9360       (if (and (<= (nth 1 (car newsrc)) 5)
9361                (and (car entry)
9362                     (or (eq (car entry) t)
9363                         (not (zerop (car entry)))))
9364                (if yes (string-match yes group) t)
9365                (or (null no) (not (string-match no group))))
9366           (progn
9367             (gnus-summary-read-group group nil t)
9368             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
9369                  (gnus-summary-exit))))
9370       (setq newsrc (cdr newsrc)))
9371     ;; Exit Emacs.
9372     (set-buffer gnus-group-buffer)
9373     (gnus-group-exit)))
9374
9375 ;; For score files
9376
9377 (defun gnus-Newsgroup-kill-file (newsgroup)
9378   "Return the name of a score file for NEWSGROUP.
9379 If NEWSGROUP is nil, return the global score file instead."
9380   (cond ((or (null newsgroup)
9381              (string-equal newsgroup ""))
9382          ;; The global score file is placed at top of the directory.
9383          (expand-file-name gnus-kill-file-name
9384                            (or gnus-kill-files-directory "~/News")))
9385         (gnus-use-long-file-name
9386          ;; Append ".KILL" to capitalized newsgroup name.
9387          (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
9388                                    "." gnus-kill-file-name)
9389                            (or gnus-kill-files-directory "~/News")))
9390         (t
9391          ;; Place "KILL" under the hierarchical directory.
9392          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
9393                                    "/" gnus-kill-file-name)
9394                            (or gnus-kill-files-directory "~/News")))
9395         ))
9396
9397 (defun gnus-newsgroup-kill-file (newsgroup)
9398   "Return the name of a score file name for NEWSGROUP.
9399 If NEWSGROUP is nil, return the global score file name instead."
9400   (cond ((or (null newsgroup)
9401              (string-equal newsgroup ""))
9402          ;; The global KILL file is placed at top of the directory.
9403          (expand-file-name gnus-kill-file-name
9404                            (or gnus-kill-files-directory "~/News")))
9405         (gnus-use-long-file-name
9406          ;; Append ".KILL" to newsgroup name.
9407          (expand-file-name (concat newsgroup "." gnus-kill-file-name)
9408                            (or gnus-kill-files-directory "~/News")))
9409         (t
9410          ;; Place "KILL" under the hierarchical directory.
9411          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
9412                                    "/" gnus-kill-file-name)
9413                            (or gnus-kill-files-directory "~/News")))
9414         ))
9415
9416
9417 (defalias 'gnus-expunge 'gnus-summary-remove-lines-marked-with)
9418
9419 (defun gnus-apply-kill-file ()
9420   "Apply a score file to the current newsgroup.
9421 Returns the number of articles marked as read."
9422   (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
9423                            (gnus-newsgroup-kill-file gnus-newsgroup-name)))
9424          (unreads (length gnus-newsgroup-unreads))
9425          (gnus-summary-inhibit-highlight t)
9426          (mark-below (or gnus-summary-mark-below gnus-summary-default-score))
9427          (expunge-below gnus-summary-expunge-below)
9428          form beg)
9429     (setq gnus-newsgroup-kill-headers nil)
9430     (or gnus-newsgroup-headers-hashtb-by-number
9431         (gnus-make-headers-hashtable-by-number))
9432     ;; If there are any previously scored articles, we remove these
9433     ;; from the `gnus-newsgroup-headers' list that the score functions
9434     ;; will see. This is probably pretty wasteful when it comes to
9435     ;; conses, but is, I think, faster than having to assq in every
9436     ;; single score funtion.
9437     (let ((files kill-files))
9438       (while files
9439         (if (file-exists-p (car files))
9440             (let ((headers gnus-newsgroup-headers))
9441               (if gnus-kill-killed
9442                   (setq gnus-newsgroup-kill-headers
9443                         (mapcar (lambda (header) (header-number header))
9444                                 headers))
9445                 (while headers
9446                   (or (gnus-member-of-range 
9447                        (header-number (car headers)) 
9448                        gnus-newsgroup-killed)
9449                       (setq gnus-newsgroup-kill-headers 
9450                             (cons (header-number (car headers))
9451                                   gnus-newsgroup-kill-headers)))
9452                   (setq headers (cdr headers))))
9453               (setq files nil))
9454           (setq files (cdr files)))))
9455     (if gnus-newsgroup-kill-headers
9456         (save-excursion
9457           (while kill-files
9458             (if (file-exists-p (car kill-files))
9459                 (progn
9460                   (message "Processing kill file %s..." (car kill-files))
9461                   (find-file (car kill-files))
9462                   (goto-char (point-min))
9463                   (while (progn
9464                            (setq beg (point))
9465                            (setq form (condition-case nil 
9466                                           (read (current-buffer)) 
9467                                         (error nil))))
9468                     (if (or (eq (car form) 'gnus-kill)
9469                             (eq (car form) 'gnus-raise)
9470                             (eq (car form) 'gnus-lower))
9471                         (progn
9472                           (delete-region beg (point))
9473                           (insert (or (eval form) "")))
9474                       (eval form)))
9475                   (and (buffer-modified-p) (save-buffer))
9476                   (message "Processing kill file %s...done" (car kill-files))))
9477             (setq kill-files (cdr kill-files)))))
9478     (if expunge-below (gnus-summary-expunge-below expunge-below))
9479     (let (gnus-summary-inhibit-highlight)
9480       (gnus-summary-set-mark-below mark-below))
9481     (if beg
9482         (let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
9483           (or (eq nunreads 0)
9484               (message "Marked %d articles as read" nunreads))
9485           nunreads)
9486       0)))
9487
9488 ;; Kill changes and new format by suggested by JWZ and Sudish Joseph
9489 ;; <joseph@cis.ohio-state.edu>.  
9490 (defun gnus-kill (field regexp &optional exe-command all)
9491   "If FIELD of an article matches REGEXP, execute COMMAND.
9492 Optional 1st argument COMMAND is default to
9493         (gnus-summary-mark-as-read nil \"X\").
9494 If optional 2nd argument ALL is non-nil, articles marked are also applied to.
9495 If FIELD is an empty string (or nil), entire article body is searched for.
9496 COMMAND must be a lisp expression or a string representing a key sequence."
9497   ;; We don't want to change current point nor window configuration.
9498   (save-excursion
9499     (save-window-excursion
9500       ;; Selected window must be summary buffer to execute keyboard
9501       ;; macros correctly. See command_loop_1.
9502       (switch-to-buffer gnus-summary-buffer 'norecord)
9503       (goto-char (point-min))           ;From the beginning.
9504       (let ((kill-list regexp)
9505             (date (current-time-string))
9506             (command (or exe-command '(gnus-summary-mark-as-read 
9507                                        nil gnus-kill-file-mark)))
9508             kill kdate prev)
9509         (if (listp kill-list)
9510             ;; It is a list.
9511             (if (not (consp (cdr kill-list)))
9512                 ;; It's on the form (regexp . date).
9513                 (if (zerop (gnus-execute field (car kill-list) 
9514                                          command nil (not all)))
9515                     (if (> (gnus-days-between date (cdr kill-list))
9516                            gnus-kill-expiry-days)
9517                         (setq regexp nil))
9518                   (setcdr kill-list date))
9519               (while (setq kill (car kill-list))
9520                 (if (consp kill)
9521                     ;; It's a temporary kill.
9522                     (progn
9523                       (setq kdate (cdr kill))
9524                       (if (zerop (gnus-execute 
9525                                   field (car kill) command nil (not all)))
9526                           (if (> (gnus-days-between date kdate)
9527                                  gnus-kill-expiry-days)
9528                               ;; Time limit has been exceeded, so we
9529                               ;; remove the match.
9530                               (if prev
9531                                   (setcdr prev (cdr kill-list))
9532                                 (setq regexp (cdr regexp))))
9533                         ;; Successful kill. Set the date to today.
9534                         (setcdr kill date)))
9535                   ;; It's a permanent kill.
9536                   (gnus-execute field kill command nil (not all)))
9537                 (setq prev kill-list)
9538                 (setq kill-list (cdr kill-list))))
9539           (gnus-execute field kill-list command nil (not all)))
9540         )))
9541   (if regexp
9542       (gnus-pp-gnus-kill
9543        (nconc (list 'gnus-kill field 
9544                     (if (consp regexp) (list 'quote regexp) regexp))
9545               (if (or exe-command all) (list (list 'quote exe-command)))
9546               (if all (list t) nil)))))
9547
9548 (defun gnus-pp-gnus-kill (object)
9549   (if (or (not (consp (nth 2 object)))
9550           (not (consp (cdr (nth 2 object))))
9551           (and (eq 'quote (car (nth 2 object)))
9552                (not (consp (cdr (car (cdr (nth 2 object))))))))
9553       (concat "\n" (prin1-to-string object))
9554     (save-excursion
9555       (set-buffer (get-buffer-create "*Gnus PP*"))
9556       (buffer-disable-undo (current-buffer))
9557       (erase-buffer)
9558       (insert (format "\n(%S %S\n  '(" (nth 0 object) (nth 1 object)))
9559       (let ((klist (car (cdr (nth 2 object))))
9560             (first t))
9561         (while klist
9562           (insert (if first (progn (setq first nil) "")  "\n    ")
9563                   (prin1-to-string (car klist)))
9564           (setq klist (cdr klist))))
9565       (insert ")")
9566       (and (nth 3 object)
9567            (insert "\n  " 
9568                    (if (and (consp (nth 3 object))
9569                             (not (eq 'quote (car (nth 3 object))))) 
9570                        "'" "")
9571                    (prin1-to-string (nth 3 object))))
9572       (and (nth 4 object)
9573            (insert "\n  t"))
9574       (insert ")")
9575       (prog1
9576           (buffer-substring (point-min) (point-max))
9577         (kill-buffer (current-buffer))))))
9578
9579 (defun gnus-execute-1 (function regexp form header)
9580   (save-excursion
9581     (let (did-kill)
9582       (if (null header)
9583           nil                           ;Nothing to do.
9584         (if function
9585             ;; Compare with header field.
9586             (let (value)
9587               (and header
9588                    (progn
9589                      (setq value (funcall function header))
9590                      ;; Number (Lines:) or symbol must be converted to string.
9591                      (or (stringp value)
9592                          (setq value (prin1-to-string value)))
9593                      (setq did-kill (string-match regexp value)))
9594                    (if (stringp form)   ;Keyboard macro.
9595                        (execute-kbd-macro form)
9596                      (funcall form))))
9597           ;; Search article body.
9598           (let ((gnus-current-article nil) ;Save article pointer.
9599                 (gnus-last-article nil)
9600                 (gnus-break-pages nil)  ;No need to break pages.
9601                 (gnus-mark-article-hook nil)) ;Inhibit marking as read.
9602             (message "Searching for article: %d..." (header-number header))
9603             (gnus-article-setup-buffer)
9604             (gnus-article-prepare (header-number header) t)
9605             (if (save-excursion
9606                   (set-buffer gnus-article-buffer)
9607                   (goto-char (point-min))
9608                   (setq did-kill (re-search-forward regexp nil t)))
9609                 (if (stringp form)      ;Keyboard macro.
9610                     (execute-kbd-macro form)
9611                   (funcall form))))))
9612       did-kill)))
9613
9614 (defun gnus-execute (field regexp form &optional backward ignore-marked)
9615   "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
9616 If FIELD is an empty string (or nil), entire article body is searched for.
9617 If optional 1st argument BACKWARD is non-nil, do backward instead.
9618 If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
9619 marked as read or ticked are ignored."
9620   (save-excursion
9621     (let ((killed-no 0)
9622           function header article)
9623       (if (or (null field) (string-equal field ""))
9624           (setq field nil)
9625         ;; Get access function of header filed.
9626         (setq function (intern-soft (concat "gnus-header-" (downcase field))))
9627         (if (and function (fboundp function))
9628             (setq function (symbol-function function))
9629           (error "Unknown header field: \"%s\"" field))
9630         ;; Make FORM funcallable.
9631         (if (and (listp form) (not (eq (car form) 'lambda)))
9632             (setq form (list 'lambda nil form)))
9633         ;; Starting from the current article.
9634         (while (or (and (not article)
9635                         (setq article (gnus-summary-article-number))
9636                         t)
9637                    (setq article 
9638                          (gnus-summary-search-subject 
9639                           backward (not ignore-marked))))
9640           (and (memq article gnus-newsgroup-kill-headers)
9641                (gnus-execute-1 function regexp form 
9642                                (gnus-get-header-by-number article))
9643                (setq killed-no (1+ killed-no)))))
9644       killed-no)))
9645
9646 \f
9647 ;;; Gnus Score File
9648
9649 ;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
9650
9651 (defun gnus-score-set (symbol value &optional alist)
9652   ;; Set SYMBOL to VALUE in ALIST.
9653   (let* ((alist (or alist gnus-score-alist
9654                     (progn
9655                       (gnus-score-load gnus-newsgroup-name)
9656                       gnus-score-alist)))
9657          (entry (assoc symbol alist)))
9658     (cond (entry
9659            (setcdr entry value))
9660           ((null alist)
9661            (error "Empty alist"))
9662           (t
9663            (setcdr alist (cons (cons symbol value) (cdr alist)))))))
9664
9665 (defun gnus-score-get (symbol &optional alist)
9666   ;; Get SYMBOL's definition in ALIST.
9667   (cdr (assoc symbol (or alist gnus-score-alist
9668                          (progn
9669                            (gnus-score-load gnus-newsgroup-name)
9670                            gnus-score-alist)))))
9671
9672 (defun gnus-score-edit-file (group)
9673   "Edit score file for GROUP."
9674   (interactive (list (read-string "Edit SCORE file for: "
9675                                   (cons (or gnus-newsgroup-name "") 1))))
9676   (and (get-buffer gnus-summary-buffer) (gnus-score-save))
9677   (find-file (gnus-score-file-name group))
9678   (emacs-lisp-mode))
9679
9680 (defun gnus-score-load-file (file)
9681   ;; Load score file FILE.
9682   (let ((cache (assoc file gnus-score-cache)))
9683     (if cache
9684         (setq gnus-score-alist (cdr cache))
9685       (setq gnus-score-alist nil)
9686       (load file t nil t)
9687       (or gnus-score-alist
9688           (setq gnus-score-alist (copy-alist '((touched . nil)))))
9689       (setq gnus-score-cache
9690             (cons (cons file gnus-score-alist) gnus-score-cache))))
9691   (let ((mark (gnus-score-get 'mark))
9692         (expunge (gnus-score-get 'expunge))
9693         (files (gnus-score-get 'files))
9694         (eval (gnus-score-get 'eval)))
9695     (if files (mapcar (lambda (file) (gnus-score-load-file file)) files))
9696     (if eval (eval eval))
9697     (if mark (setq gnus-summary-mark-below mark))
9698     (if expunge (setq gnus-summary-expunge-below expunge))))
9699
9700 (defun gnus-score-load (group)
9701   ;; Load score file for GROUP.
9702   ;; If optional argument NO-RECURSE is set, the files and eval
9703   ;; members will be ignored.
9704   ;; Updates free variables `gnus-score-alist' and `scores'.
9705
9706   (let ((cache (assoc group gnus-score-cache)))
9707     (if cache
9708         (setq gnus-score-alist (cdr cache))
9709       (setq gnus-score-alist nil)
9710       (load (gnus-score-file-name group) t nil t)
9711       (or gnus-score-alist
9712           (setq gnus-score-alist (copy-alist '((touched . nil)))))
9713       (setq gnus-score-cache
9714             (cons (cons (gnus-score-file-name group)
9715                         gnus-score-alist) gnus-score-cache))))
9716   (let ((mark (gnus-score-get 'mark))
9717         (expunge (gnus-score-get 'expunge))
9718         (files (gnus-score-get 'files))
9719         (eval (gnus-score-get 'eval)))
9720     (if eval (eval eval))
9721     (if mark (setq gnus-summary-mark-below mark))
9722     (if expunge (setq gnus-summary-expunge-below expunge))
9723     (if files (mapcar (lambda (file) (gnus-score-load-file file)) files))))
9724   
9725 (defun gnus-score-save ()
9726   ;; Save all SCORE information.
9727   (let (cache)
9728     (save-excursion
9729       (set-buffer gnus-summary-buffer)
9730       (setq cache gnus-score-cache
9731             gnus-score-cache nil))
9732     (save-excursion
9733       (setq gnus-score-alist nil)
9734       (set-buffer (get-buffer-create "*Score*"))
9735       (buffer-disable-undo)
9736       (let (entry score file)
9737         (while cache
9738           (setq entry (car cache)
9739                 cache (cdr cache)
9740                 file (car entry)
9741                 score (cdr entry))
9742           (if (null (gnus-score-get 'touched score))
9743               ()
9744             (gnus-score-set 'touched nil score)
9745             (erase-buffer)
9746             (pp (list 'setq 'gnus-score-alist (list 'quote score))
9747                 (current-buffer))
9748             (make-directory (file-name-directory file) t)
9749               (write-region (point-min) (point-max) file nil 'silent))))
9750       (kill-buffer (current-buffer)))))
9751   
9752 (defun gnus-score-headers ()
9753   ;; Score `gnus-newsgroup-headers'.
9754   (let ((score-files (gnus-score-files-for-group gnus-newsgroup-name))
9755         scores)
9756     ;; Load the SCORE files.
9757     (while score-files
9758       (gnus-score-load-file (car score-files))
9759       (if (< 1 (length gnus-score-alist))
9760          (setq scores (cons gnus-score-alist scores)))
9761       (setq score-files (cdr score-files)))
9762     (if (not (and gnus-summary-default-score
9763                   scores
9764                   (> (length gnus-newsgroup-headers)
9765                      (length gnus-newsgroup-scored))))
9766         ()
9767       (let* ((entries gnus-header-index)
9768              (now (current-time-string))
9769              (expire (- (gnus-useful-date now) gnus-kill-expiry-days))
9770              (headers gnus-newsgroup-headers)
9771              entry articles header)
9772         (message "Scoring...")
9773         ;; Create articles, an alist of the form `(HEADER . SCORE)'.
9774         (while headers
9775           (setq header (car headers)
9776                 headers (cdr headers))
9777           ;; WARNING: The assq makes the function O(N*S) while it could
9778           ;; be written as O(N+S), where N is (length gnus-newsgroup-headers)
9779           ;; and S is (length gnus-newsgroup-scored).
9780           (or (assq (header-number header) gnus-newsgroup-scored)
9781               (setq articles            ;Total of 2 * N cons-cells used.
9782                     (cons (cons header gnus-summary-default-score)
9783                           articles))))
9784   
9785         (save-excursion
9786           (set-buffer (get-buffer-create "*Headers*"))
9787           (buffer-disable-undo)
9788           ;; Run each header through the score process.
9789           (while entries
9790             (setq entry (car entries)
9791                   header (nth 0 entry)
9792                   entries (cdr entries))
9793             (setq gnus-score-index (nth 1 (assoc header gnus-header-index)))
9794             (if (< 0 (apply 'max (mapcar
9795                                   (lambda (score)
9796                                     (length (gnus-score-get header score)))
9797                                   scores)))
9798                 (progn
9799                   ;; Sorting the articles costs os O(N*log N) but will
9800                   ;; allow us to only match with each unique header.
9801                   ;; Thus the actual matching will be O(M*U) where M
9802                   ;; is the number of strings to match with, and U is
9803                   ;; the number of unique headers.  It is assumed (but
9804                   ;; untested) this will be a net win because of the
9805                   ;; large constant factor involved with string
9806                   ;; matching.
9807                   (message "Scoring...%s sort" header)
9808                   (setq articles (sort articles 'gnus-score-compare-articles))
9809                   (funcall (nth 2 entry) scores header articles now expire))))
9810           ;; Remove the buffer.
9811           (kill-buffer (current-buffer)))
9812
9813         (message "Scoring...")
9814         ;; Add articles to `gnus-newsgroup-scored'.
9815         (while articles
9816           (or (= gnus-summary-default-score (cdr (car articles)))
9817               (setq gnus-newsgroup-scored
9818                     (cons (cons (header-number (car (car articles)))
9819                                 (cdr (car articles)))
9820                           gnus-newsgroup-scored)))
9821           (setq articles (cdr articles)))
9822
9823         (message "Scoring...done")))))
9824
9825 (defun gnus-score-integer (scores header articles now expire)
9826   )
9827
9828 (defun gnus-score-date (scores header articles now expire)
9829   )
9830
9831 (defun gnus-score-string (scores header articles now expire)
9832   ;; Score ARTICLES according to HEADER in SCORES.
9833   ;; Update matches entries to NOW and remove unmatched entried older
9834   ;; than EXPIRE.
9835   
9836   ;; Insert the unique article headers in the buffer.
9837   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
9838         ;; gnus-score-index is used as a free variable.
9839         alike last this art entries alist)
9840
9841     (message "Scoring...%s build" header)
9842     (erase-buffer)
9843     (while articles
9844       (setq art (car articles)
9845             this (aref (car art) gnus-score-index)
9846             articles (cdr articles))
9847       (if (equal last this)
9848           ;; O(N*H) cons-cells used here, where H is the number of
9849           ;; headers.
9850           (setq alike (cons art alike))
9851         (if last
9852             (progn
9853               ;; Insert the line, with a text property on the
9854               ;; terminating newline refering to the articles with
9855               ;; this line.
9856               (insert last ?\n)
9857               (put-text-property (1- (point)) (point) 'articles alike)))
9858         (setq alike (list art)
9859               last this)))
9860     (and last                           ; Bwadr, duplicate code.
9861          (progn
9862            (insert last ?\n)                    
9863            (put-text-property (1- (point)) (point) 'articles alike)))
9864   
9865     ;; Find matches.
9866     (message "Scoring...%s match" header)
9867     (while scores
9868       (setq alist (car scores)
9869             scores (cdr scores)
9870             entries (assoc header alist))
9871       (while (cdr entries)              ;First entry is the header index.
9872         (let* ((rest (cdr entries))             
9873                (kill (car rest))
9874                (match (nth 0 kill))
9875                (type (nth 1 kill))
9876                (score (nth 2 kill))
9877                (date (nth 3 kill))
9878                (found nil)
9879                (case-fold-search t)
9880                arts art)
9881           (goto-char (point-min))
9882           (while (if type
9883                      (re-search-forward match nil t)
9884                    (search-forward match nil t))
9885             (end-of-line 1)
9886             (setq found t
9887                   arts (get-text-property (point) 'articles))
9888             ;; Found a match, update scores.
9889             (while arts
9890               (setq art (car arts)
9891                     arts (cdr arts))
9892               (setcdr art (+ score (cdr art)))))
9893           ;; Update expire date
9894           (cond ((null date))           ;Permanent entry.
9895                 (found                  ;Match, update date.
9896                  (gnus-score-set 'touched t alist)
9897                  (setcar (nthcdr 3 kill) now))
9898                 ((< (gnus-useful-date date) expire) ;Old entry, remove.
9899                  (gnus-score-set 'touched t alist)
9900                  (setcdr entries (cdr rest))
9901                  (setq rest entries)))
9902           (setq entries rest))))))
9903
9904 (defun gnus-score-compare-articles (a1 a2)
9905   ;; Compare headers in articles A2 and A2.
9906   ;; The header index used is the free variable `gnus-score-index'.
9907   (string-lessp (aref (car a1) gnus-score-index)
9908                 (aref (car a2) gnus-score-index)))
9909
9910 (defun gnus-useful-date (date)
9911   ;; Return the numeric day corresponding to the DATE string.
9912   (let ((d (mapcar (lambda (s) (and s (string-to-int s)) )
9913                    (timezone-parse-date date))))
9914     (timezone-absolute-from-gregorian (nth 1 d) (nth 2 d) (car d))))
9915
9916 (defun gnus-score-build-cons (article)
9917   ;; Build a `gnus-newsgroup-scored' type cons from ARTICLE.
9918   (cons (header-number (car article)) (cdr article)))
9919
9920 (defconst gnus-header-index
9921   ;; Name to index alist.
9922   '(("number" 0 gnus-score-integer)
9923     ("subject" 1 gnus-score-string)
9924     ("from" 2 gnus-score-string)
9925     ("date" 3 gnus-score-date)
9926     ("id" 4 gnus-score-string) 
9927     ("references" 5 gnus-score-string) 
9928     ("chars" 6 gnus-score-integer) 
9929     ("lines" 7 gnus-score-integer) 
9930     ("xref" 8 gnus-score-string)))
9931
9932 (defvar gnus-score-file-suffix "SCORE"
9933   "Suffix of the score files.")
9934
9935 (defun gnus-score-file-name (newsgroup)
9936   "Return the name of a score file for NEWSGROUP."
9937   (cond  ((or (null newsgroup)
9938               (string-equal newsgroup ""))
9939           ;; The global score file is placed at top of the directory.
9940           (expand-file-name gnus-score-file-suffix
9941                             (or gnus-kill-files-directory "~/News")))
9942          (gnus-use-long-file-name
9943           ;; Append ".SCORE" to newsgroup name.
9944           (expand-file-name (concat newsgroup "." gnus-score-file-suffix)
9945                             (or gnus-kill-files-directory "~/News")))
9946          (t
9947           ;; Place "KILL" under the hierarchical directory.
9948           (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
9949                                     "/" gnus-score-file-suffix)
9950                             (or gnus-kill-files-directory "~/News")))))
9951
9952 (defun gnus-score-score-files (group)
9953   "Return a list of all possible score files."
9954   (or gnus-kill-files-directory (setq gnus-kill-files-directory "~/News/"))
9955   (if (not (file-exists-p gnus-kill-files-directory))
9956       (setq gnus-score-file-list nil)
9957     (if gnus-use-long-file-name
9958         (if (or (not gnus-score-file-list)
9959                 (gnus-file-newer-than gnus-kill-files-directory
9960                                       (car gnus-score-file-list)))
9961             (setq gnus-score-file-list
9962                   (cons (nth 5 (file-attributes gnus-kill-files-directory))
9963                         (directory-files
9964                          gnus-kill-files-directory t
9965                          (concat gnus-score-file-suffix "$")))))
9966       (let ((dir (expand-file-name
9967                   (concat gnus-kill-files-directory
9968                           (gnus-replace-chars-in-string group ?. ?/))))
9969             (mdir (length (expand-file-name gnus-kill-files-directory)))
9970             files)
9971         (if (file-exists-p (concat dir "/" gnus-score-file-suffix))
9972             (setq files (list (concat dir "/" gnus-score-file-suffix))))
9973         (while (>= (1+ (length dir)) mdir)
9974           (and (file-exists-p (concat dir "/all/" gnus-score-file-suffix))
9975                (setq files (cons (concat dir "/all/" gnus-score-file-suffix)
9976                                  files)))
9977           (string-match "/[^/]*$" dir)
9978           (setq dir (substring dir (match-beginning 0))))
9979         (setq gnus-score-file-list (cons nil files)))))
9980   (cdr gnus-score-file-list))
9981         
9982 (defun gnus-score-files-for-group (group)
9983   "Return a list of score files for GROUP."
9984   (if (and gnus-score-find-score-files-function
9985            (fboundp gnus-score-find-score-files-function))
9986       (funcall gnus-score-find-score-files-function group)
9987     (if (not gnus-score-hierarchical)
9988         (let ((file (gnus-score-file-name group)))
9989           (and (file-exists-p file)
9990                (list file)))
9991       (let ((sfiles (gnus-score-score-files group))
9992             (klen (length (expand-file-name gnus-kill-files-directory)))
9993             ofiles not-match regexp)
9994         (save-excursion
9995           (set-buffer (get-buffer-create "*gnus score files*"))
9996           (buffer-disable-undo)
9997           (while sfiles
9998             (erase-buffer)
9999             (insert (car sfiles))
10000             (goto-char 1)
10001             (re-search-forward (concat "." gnus-score-file-suffix "$"))
10002             (replace-match "") 
10003             (goto-char 1)
10004             (delete-char klen)
10005             (while (search-forward "all" nil t)
10006               (replace-match ".+"))
10007             (goto-char 1)
10008             (if (looking-at "not.")
10009                 (progn
10010                   (setq not-match t)
10011                   (setq regexp (buffer-substring 5 (point-max))))
10012               (setq regexp (buffer-substring 1 (point-max)))
10013               (setq not-match nil))
10014             (if (or (and not-match
10015                          (not (string-match regexp group)))
10016                     (and (not not-match)
10017                          (string-match regexp group)))
10018                 (setq ofiles (cons (car sfiles) ofiles)))
10019             (setq sfiles (cdr sfiles)))
10020           (kill-buffer (current-buffer))
10021           ofiles)))))
10022
10023
10024 \f
10025 ;;; Gnus Posting Functions
10026 ;;;
10027
10028 (defvar gnus-organization-file "/usr/lib/news/organization"
10029   "*Local news organization file.")
10030
10031 (defvar gnus-post-news-buffer "*post-news*")
10032 (defvar gnus-winconf-post-news nil)
10033
10034 (autoload 'news-reply-mode "rnewspost")
10035
10036 ;;; Post news commands of Gnus group mode and summary mode
10037
10038 (defun gnus-group-post-news ()
10039   "Post an article."
10040   (interactive)
10041   ;; Save window configuration.
10042   (setq gnus-winconf-post-news (current-window-configuration))
10043   ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
10044   (or gnus-newsgroup-name (setq gnus-newsgroup-name (gnus-group-group-name)))
10045   (unwind-protect
10046       (gnus-post-news 'post nil)
10047     (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
10048              (not (zerop (buffer-size))))
10049         ;; Restore last window configuration.
10050         (and gnus-winconf-post-news
10051              (set-window-configuration gnus-winconf-post-news))))
10052   ;; We don't want to return to summary buffer nor article buffer later.
10053   (setq gnus-winconf-post-news nil)
10054   (if (get-buffer gnus-summary-buffer)
10055       (bury-buffer gnus-summary-buffer))
10056   (if (get-buffer gnus-article-buffer)
10057       (bury-buffer gnus-article-buffer)))
10058
10059 (defun gnus-summary-post-news ()
10060   "Post an article."
10061   (interactive)
10062   ;; Save window configuration.
10063   (setq gnus-winconf-post-news (current-window-configuration))
10064   (unwind-protect
10065       (gnus-post-news 'post gnus-newsgroup-name)
10066     (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
10067              (not (zerop (buffer-size))))
10068         ;; Restore last window configuration.
10069         (and gnus-winconf-post-news
10070              (set-window-configuration gnus-winconf-post-news))))
10071   ;; We don't want to return to article buffer later.
10072   (setq gnus-winconf-post-news nil)
10073   (if (get-buffer gnus-article-buffer)
10074       (bury-buffer gnus-article-buffer)))
10075
10076 (defun gnus-summary-followup (yank)
10077   "Compose a followup to an article.
10078 If prefix argument YANK is non-nil, original article is yanked automatically."
10079   (interactive "P")
10080   (gnus-summary-select-article t)
10081   (let ((headers gnus-current-headers)
10082         (gnus-newsgroup-name gnus-newsgroup-name))
10083     ;; Check Followup-To: poster.
10084     (set-buffer gnus-article-buffer)
10085     (if (and gnus-use-followup-to
10086              (string-equal "poster" (gnus-fetch-field "followup-to"))
10087              (or (not (eq gnus-use-followup-to t))
10088                  (not (y-or-n-p 
10089                        "Do you want to ignore `Followup-To: poster'? "))))
10090         ;; Mail to the poster.  Gnus is now RFC1036 compliant.
10091         (gnus-summary-reply yank)
10092       ;; Save window configuration.
10093       (setq gnus-winconf-post-news (current-window-configuration))
10094       (unwind-protect
10095           (gnus-post-news 'followup headers gnus-article-buffer yank)
10096         (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
10097                  (not (zerop (buffer-size))))
10098             ;; Restore last window configuration.
10099             (and gnus-winconf-post-news
10100                  (set-window-configuration gnus-winconf-post-news))))
10101       ;; We don't want to return to article buffer later.
10102       (setq gnus-winconf-post-news nil)
10103       (bury-buffer gnus-article-buffer))))
10104
10105 (defun gnus-summary-followup-with-original ()
10106   "Compose a followup to an article and include the original article."
10107   (interactive)
10108   (gnus-summary-followup t))
10109
10110 (defun gnus-summary-cancel-article ()
10111   "Cancel an article you posted."
10112   (interactive)
10113   (gnus-summary-select-article t)
10114   (gnus-eval-in-buffer-window gnus-article-buffer
10115                               (gnus-cancel-news)))
10116
10117 (defun gnus-summary-supersede-article ()
10118   "Compose an article that will supersede a previous article.
10119 This is done simply by taking the old article and adding a Supersedes
10120 header line with the old Message-ID."
10121   (interactive)
10122   (if (not
10123        (string-equal
10124         (downcase (mail-strip-quoted-names 
10125                    (header-from gnus-current-headers)))
10126         (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
10127       (error "This article is not yours."))
10128   (gnus-summary-select-article t)
10129   (save-excursion
10130     (set-buffer gnus-article-buffer)
10131     (let ((buffer-read-only nil))
10132       (goto-char (point-min))
10133       (search-forward "\n\n" nil t)
10134       (if (not (re-search-backward "^Message-ID: " nil t))
10135           (error "No Message-ID in this article"))))
10136   (if (gnus-post-news 'post gnus-newsgroup-name)
10137       (progn
10138         (erase-buffer)
10139         (insert-buffer gnus-article-buffer)
10140         (goto-char (point-min))
10141         (search-forward "\n\n" nil t)
10142         (if (not (re-search-backward "^Message-ID: " nil t))
10143             (error "No Message-ID in this article")
10144           (replace-match "Supersedes: "))
10145         (search-forward "\n\n")
10146         (forward-line -1)
10147         (insert mail-header-separator))))
10148
10149 \f
10150 ;;; Post a News using NNTP
10151
10152 ;;;###autoload
10153 (fset 'sendnews 'gnus-post-news)
10154
10155 ;;;###autoload
10156 (fset 'postnews 'gnus-post-news)
10157
10158 (defun gnus-post-news (method &optional header article-buffer yank)
10159   "Begin editing a new USENET news article to be posted.
10160 Type \\[describe-mode] in the buffer to get a list of commands."
10161   (interactive)
10162   (if (or (not gnus-novice-user)
10163           gnus-expert-user
10164           (not (eq 'post 
10165                    (nth 1 (assoc 
10166                            (format "%s" (car (gnus-find-method-for-group 
10167                                               gnus-newsgroup-name)))
10168                            gnus-valid-select-methods))))
10169           (y-or-n-p "Are you sure you want to post to all of USENET? "))
10170       (let ((sumart (if (eq method 'followup)
10171                         (save-excursion
10172                           (set-buffer gnus-summary-buffer)
10173                           (cons (current-buffer) gnus-current-article))))
10174             post-buf)
10175         (if (and gnus-interactive-post
10176                  (not gnus-expert-user)
10177                  (eq method 'post)
10178                  (not header))
10179             (setq header 
10180                   (completing-read "Group: " gnus-active-hashtb nil t)))
10181         (setq mail-reply-buffer article-buffer)
10182         (setq gnus-post-news-buffer 
10183               (setq post-buf
10184                     (gnus-request-post-buffer 
10185                      method (if (stringp header) 
10186                                 (gnus-group-real-name header) header)
10187                      article-buffer)))
10188         (if (eq method 'post)
10189             (progn
10190               (delete-other-windows)
10191               (switch-to-buffer post-buf))
10192           (delete-other-windows)
10193           (if (not yank)
10194               (progn
10195                 (switch-to-buffer article-buffer)
10196                 (pop-to-buffer post-buf))
10197             (switch-to-buffer post-buf)))
10198         (gnus-overload-functions)
10199         (make-local-variable 'gnus-article-reply)
10200         (make-local-variable 'gnus-article-check-size)
10201         (setq gnus-article-reply sumart)
10202         ;; Handle author copy using BCC field.
10203         (if gnus-mail-self-blind
10204             (progn
10205               (mail-position-on-field "BCC")
10206               (insert (if (stringp gnus-mail-self-blind)
10207                           gnus-mail-self-blind
10208                         (user-login-name)))))
10209         ;; Handle author copy using FCC field.
10210         (if gnus-author-copy
10211             (progn
10212               (mail-position-on-field "FCC")
10213               (insert gnus-author-copy)))
10214         (goto-char (point-min))
10215         (if (and (eq method 'post) (not header))
10216             (end-of-line)
10217           (search-forward (concat "\n" mail-header-separator "\n"))
10218           (if yank 
10219               (save-excursion
10220                 (run-hooks 'news-reply-header-hook)
10221                 (mail-yank-original nil)))
10222           (if gnus-post-prepare-function
10223               (funcall gnus-post-prepare-function 
10224                        (if (stringp header) header gnus-newsgroup-name))))))
10225   (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum)))
10226   (message "")
10227   t)
10228
10229 (defun gnus-inews-news ()
10230   "Send a news message."
10231   (interactive)
10232   ;; Check whether the article is a Good Net Citizen.
10233   (if (and gnus-article-check-size (not (gnus-inews-check-post)))
10234       ;; Aber nein!
10235       ()
10236     ;; Looks ok, so we do the nasty.
10237     (let* ((case-fold-search nil)
10238            (server-running (gnus-server-opened gnus-select-method))
10239            (reply gnus-article-reply))
10240       (save-excursion
10241         ;; Connect to default NNTP server if necessary.
10242         ;; Suggested by yuki@flab.fujitsu.junet.
10243         (gnus-start-news-server)        ;Use default server.
10244         ;; NNTP server must be opened before current buffer is modified.
10245         (widen)
10246         (goto-char (point-min))
10247         (run-hooks 'news-inews-hook)
10248         (save-restriction
10249           (narrow-to-region
10250            (point-min)
10251            (progn
10252              (goto-char (point-min))
10253              (search-forward (concat "\n" mail-header-separator "\n"))
10254              (point)))
10255
10256           ;; Correct newsgroups field: change sequence of spaces to comma and 
10257           ;; eliminate spaces around commas.  Eliminate imbedded line breaks.
10258           (goto-char (point-min))
10259           (if (search-forward-regexp "^Newsgroups: +" nil t)
10260               (save-restriction
10261                 (narrow-to-region
10262                  (point)
10263                  (if (re-search-forward "^[^ \t]" nil 'end)
10264                      (match-beginning 0)
10265                    (point-max)))
10266                 (goto-char (point-min))
10267                 (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
10268                 (goto-char (point-min))
10269                 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
10270
10271           ;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
10272           ;; Help save the the world!
10273           (or 
10274            gnus-expert-user
10275            (let ((newsgroups (mail-fetch-field "newsgroups"))
10276                  (followup-to (mail-fetch-field "followup-to"))
10277                  groups to)
10278              (if (and (string-match "," newsgroups) (not followup-to))
10279                  (progn
10280                    (while (string-match "," newsgroups)
10281                      (setq groups
10282                            (cons (list (substring newsgroups
10283                                                   0 (match-beginning 0)))
10284                                  groups))
10285                      (setq newsgroups (substring newsgroups (match-end 0))))
10286                    (setq groups (nreverse (cons (list newsgroups) groups)))
10287
10288                    (setq to
10289                          (completing-read "Followups to: (default all groups) "
10290                                           groups))
10291                    (if (> (length to) 0)
10292                        (progn
10293                          (goto-char (point-min))
10294                          (insert "Followup-To: " to "\n")))))))
10295
10296           ;; Cleanup Followup-To.
10297           (goto-char (point-min))
10298           (if (search-forward-regexp "^Followup-To: +" nil t)
10299               (save-restriction
10300                 (narrow-to-region
10301                  (point)
10302                  (if (re-search-forward "^[^ \t]" nil 'end)
10303                      (match-beginning 0)
10304                    (point-max)))
10305                 (goto-char (point-min))
10306                 (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
10307                 (goto-char (point-min))
10308                 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
10309
10310           ;; Mail the message too if To:, Bcc:. or Cc: exists.
10311           (if (or (mail-fetch-field "to" nil t)
10312                   (mail-fetch-field "bcc" nil t)
10313                   (mail-fetch-field "cc" nil t))
10314               (if gnus-mail-send-method
10315                   (progn
10316                     (message "Sending via mail...")
10317                     (widen)
10318                     (funcall gnus-mail-send-method)
10319                     (message "Sending via mail... done"))
10320                 (ding)
10321                 (message "No mailer defined.  To: and/or Cc: fields ignored.")
10322                 (sit-for 1))))
10323
10324         ;; Send to NNTP server. 
10325         (message "Posting to USENET...")
10326         (if (gnus-inews-article)
10327             (progn
10328               (message "Posting to USENET... done")
10329               (if (and reply
10330                        (get-buffer (car reply))
10331                        (buffer-name (car reply)))
10332                   (progn
10333                     (save-excursion
10334                       (set-buffer gnus-summary-buffer)
10335                       (gnus-summary-mark-article-as-replied 
10336                        (cdr reply))))))
10337           ;; We cannot signal an error.
10338           (ding) (message "Article rejected: %s" 
10339                           (gnus-status-message gnus-select-method)))
10340         (set-buffer-modified-p nil))
10341       ;; If NNTP server is opened by gnus-inews-news, close it by myself.
10342       (or server-running
10343           (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name)))
10344       (and (fboundp 'bury-buffer) (bury-buffer))
10345       ;; Restore last window configuration.
10346       (and gnus-winconf-post-news
10347            (set-window-configuration gnus-winconf-post-news))
10348       (setq gnus-winconf-post-news nil))))
10349
10350 (defun gnus-inews-check-post ()
10351   "Check whether the post looks ok."
10352   (and 
10353    ;; Check excessive size.
10354    (if (> (buffer-size) 60000)
10355        (y-or-n-p (format "The article is %d octets long. Really post? "
10356                          (buffer-size)))
10357      t)
10358    ;; Check for commands in Subject.
10359    (save-excursion
10360      (save-restriction
10361        (goto-char (point-min))
10362        (narrow-to-region (point) (search-forward mail-header-separator))
10363        (if (string-match "^cmsg " (mail-fetch-field "subject"))
10364            (y-or-n-p
10365             "The control code \"cmsg \" is in the subject. Really post? ")
10366          t)))
10367    ;; Check for control characters.
10368    (save-excursion
10369      (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
10370          (y-or-n-p "The article contains control characters. Really post? ")
10371        t))
10372    ;; Check for multiple identical headers.
10373    (let (found)
10374      (save-excursion
10375        (save-restriction
10376          (goto-char (point-min))
10377          (narrow-to-region (point) (search-forward mail-header-separator))
10378          (goto-char (point-min))
10379          (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t))
10380            (save-excursion
10381              (or (re-search-forward 
10382                   (concat "^" (setq found
10383                                     (buffer-substring (match-beginning 0) 
10384                                                       (match-end 0))))
10385                   nil t)
10386                  (setq found nil))))
10387          (if found
10388              (y-or-n-p (format "Multiple %s headers. Really post? " found))
10389            t))))
10390    ;; Check for version and sendsys.
10391    (save-excursion
10392      (save-restriction
10393        (goto-char (point-min))
10394        (narrow-to-region (point) (search-forward mail-header-separator))
10395        (if (re-search-backward "^Sendsys:\\|^Version:" nil t)
10396            (yes-or-no-p
10397             (format "The article contains a %s command. Really post? "
10398                     (buffer-substring (match-beginning 0) (match-end 0))))
10399          t)))
10400    (save-excursion
10401      (save-restriction
10402        (goto-char (point-min))
10403        (narrow-to-region (point) (search-forward mail-header-separator))
10404        (let* ((case-fold-search t)
10405               (from (mail-fetch-field "from")))
10406          (if (and from
10407                   (string-match "@" from)
10408                   (not (string-match "@[^\\.]*\\." from)))
10409              (yes-or-no-p
10410               (format "The domain looks strange: \"%s\". Really post? "
10411                       from))
10412            t))))
10413    ;; Use the (size . checksum) variable to see whether the
10414    ;; article is empty or has only quoted text.
10415    (if (and (= (buffer-size) (car gnus-article-check-size))
10416             (= (gnus-article-checksum) (cdr gnus-article-check-size)))
10417        (yes-or-no-p "It looks like there's no new text in your article. Really post? ")
10418      t)))
10419
10420 (defun gnus-article-checksum ()
10421   (let ((sum 0))
10422     (save-excursion
10423       (while (not (eobp))
10424         (setq sum (logxor sum (following-char)))
10425         (forward-char 1)))
10426     sum))
10427
10428 (defun gnus-cancel-news ()
10429   "Cancel an article you posted."
10430   (interactive)
10431   (if (yes-or-no-p "Do you really want to cancel this article? ")
10432       (let ((from nil)
10433             (newsgroups nil)
10434             (message-id nil)
10435             (distribution nil))
10436         (save-excursion
10437           ;; Get header info. from original article.
10438           (save-restriction
10439             (gnus-article-show-all-headers)
10440             (goto-char (point-min))
10441             (search-forward "\n\n" nil 'move)
10442             (narrow-to-region (point-min) (point))
10443             (setq from (mail-fetch-field "from"))
10444             (setq newsgroups (mail-fetch-field "newsgroups"))
10445             (setq message-id (mail-fetch-field "message-id"))
10446             (setq distribution (mail-fetch-field "distribution")))
10447           ;; Verify if the article is absolutely user's by comparing
10448           ;; user id with value of its From: field.
10449           (if (not
10450                (string-equal
10451                 (downcase (mail-strip-quoted-names from))
10452                 (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
10453               (progn
10454                 (ding) (message "This article is not yours."))
10455             ;; Make control article.
10456             (set-buffer (get-buffer-create " *Gnus-canceling*"))
10457             (buffer-disable-undo (current-buffer))
10458             (erase-buffer)
10459             (insert "Newsgroups: " newsgroups "\n"
10460                     "Subject: cancel " message-id "\n"
10461                     "Control: cancel " message-id "\n"
10462                     mail-header-separator "\n"
10463                     "This is a cancel message from " from ".\n")
10464             ;; Send the control article to NNTP server.
10465             (message "Canceling your article...")
10466             (if (gnus-inews-article)
10467                 (message "Canceling your article... done")
10468               (ding) (message "Failed to cancel your article"))
10469             ;; Kill the article buffer.
10470             (kill-buffer (current-buffer))
10471             )))
10472     ))
10473
10474 \f
10475 ;;; Lowlevel inews interface
10476
10477 (defun gnus-inews-article ()
10478   "Post an article in current buffer using NNTP protocol."
10479   (let ((artbuf (current-buffer))
10480         (tmpbuf (get-buffer-create " *Gnus-posting*")))
10481     (widen)
10482     (goto-char (point-max))
10483     ;; require a newline at the end for inews to append .signature to
10484     (or (= (preceding-char) ?\n)
10485         (insert ?\n))
10486     ;; Prepare article headers.  All message body such as signature
10487     ;; must be inserted before Lines: field is prepared.
10488     (save-restriction
10489       (goto-char (point-min))
10490       (narrow-to-region 
10491        (point-min) 
10492        (save-excursion
10493          (search-forward (concat "\n" mail-header-separator "\n")) 
10494          (forward-line -1) 
10495          (point)))
10496       (gnus-inews-insert-headers)
10497       (widen))
10498     (save-excursion
10499       (set-buffer tmpbuf)
10500       (buffer-disable-undo (current-buffer))
10501       (erase-buffer)
10502       (insert-buffer-substring artbuf)
10503       ;; Remove the header separator.
10504       (goto-char (point-min))
10505       (search-forward (concat "\n" mail-header-separator "\n"))
10506       (replace-match "\n\n")
10507       ;; This hook may insert a signature.
10508       (run-hooks 'gnus-prepare-article-hook)
10509       ;; Run final inews hooks.  This hook may do FCC.
10510       ;; The article must be saved before being posted because
10511       ;; `gnus-request-post' modifies the buffer.
10512       (run-hooks 'gnus-inews-article-hook)
10513       ;; Post an article to NNTP server.
10514       ;; Return NIL if post failed.
10515       (prog1
10516           (gnus-request-post (gnus-find-method-for-group gnus-newsgroup-name))
10517         (kill-buffer (current-buffer)))
10518       )))
10519
10520 (defun gnus-inews-insert-headers ()
10521   "Prepare article headers.
10522 Headers already prepared in the buffer are not modified.
10523 Headers in `gnus-required-headers' will be generated."
10524   (let ((Date (gnus-inews-date))
10525         (Message-ID (gnus-inews-message-id))
10526         (Organization (gnus-inews-organization))
10527         (From (gnus-inews-user-name))
10528         (Path (gnus-inews-path))
10529         (Subject nil)
10530         (Newsgroups nil)
10531         (Distribution nil)
10532         (Lines (gnus-inews-lines))
10533         (X-Newsreader gnus-version)
10534         (headers gnus-required-headers)
10535         (case-fold-search t)
10536         header value)
10537     ;; First we remove any old Message-IDs. This might be slightly
10538     ;; fascist, but if the user really wants to generate Message-IDs
10539     ;; by herself, she should remove it from the `gnus-required-list'. 
10540     (goto-char (point-min))
10541     (and (memq 'Message-ID headers)
10542          (re-search-forward "^Message-ID:" nil t)
10543          (delete-region (progn (beginning-of-line) (point))
10544                         (progn (forward-line 1) (point))))
10545     ;; Remove NNTP-posting-host.
10546     (goto-char (point-min))
10547     (and (re-search-forward "nntp-posting-host^:" nil t)
10548          (delete-region (progn (beginning-of-line) (point))
10549                         (progn (forward-line 1) (point))))
10550     ;; Insert new Sender if the From is strange. 
10551     (let ((from (mail-fetch-field "from")))
10552       (if (and from (not (string= (downcase from) (downcase From))))
10553           (progn
10554             (goto-char (point-min))    
10555             (and (re-search-forward "^Sender:" nil t)
10556                  (delete-region (progn (beginning-of-line) (point))
10557                                 (progn (forward-line 1) (point))))
10558             (insert "Sender: " From "\n"))))
10559     ;; If there are References, and no "Re: ", then the thread has
10560     ;; changed name. See Son-of-1036.
10561     (if (and (mail-fetch-field "references")
10562              (get-buffer gnus-article-buffer))
10563         (let ((psubject (gnus-simplify-subject-re
10564                          (mail-fetch-field "subject")))
10565               subject)
10566           (save-excursion
10567             (set-buffer (get-buffer gnus-article-buffer))
10568             (save-restriction
10569               (gnus-narrow-to-headers)
10570               (if (setq subject (mail-fetch-field "subject"))
10571                   (progn
10572                     (and gnus-summary-gather-subject-limit
10573                          (> (length subject) gnus-summary-gather-subject-limit)
10574                          (setq subject
10575                                (substring subject 0
10576                                           gnus-summary-gather-subject-limit)))
10577                     (setq subject (gnus-simplify-subject-re subject))))))
10578           (or (and psubject subject (string= subject psubject))
10579               (progn
10580                 (string-match "@" Message-ID)
10581                 (setq Message-ID
10582                       (concat (substring Message-ID 0 (match-beginning 0))
10583                               "_-_" 
10584                               (substring Message-ID (match-beginning 0))))))))
10585     ;; Go through all the required headers and see if they are in the
10586     ;; articles already. If they are not, or are empty, they are
10587     ;; inserted automatically - except for Subject, Newsgroups and
10588     ;; Distribution. 
10589     (while headers
10590       (goto-char (point-min))
10591       (setq header (car headers))
10592       (if (or (not (re-search-forward 
10593                     (concat "^" (downcase (symbol-name header)) ":") nil t))
10594               (progn
10595                 (if (= (following-char) ? ) (forward-char 1) (insert " "))
10596                 (looking-at "[ \t]*$")))
10597           (progn
10598             (setq value (or (and (boundp header) (symbol-value header))
10599                             (read-from-minibuffer
10600                              (format "Empty header for %s; enter value: " 
10601                                      header))))
10602             (if (bolp)
10603                 (save-excursion
10604                   (goto-char (point-max))
10605                   (insert (symbol-name header) ": " value "\n"))
10606               (replace-match value))))
10607       (setq headers (cdr headers)))))
10608
10609 (defun gnus-inews-insert-signature ()
10610   "Insert a signature file.
10611 If `gnus-signature-function' is bound and returns a string, this
10612 string is used instead of the variable `gnus-signature-file'.
10613 In either case, if the string is a file name, this file is
10614 inserted. If the string is not a file name, the string itself is
10615 inserted. 
10616 If you never want any signature inserted, set both those variables to
10617 nil."
10618   (save-excursion
10619     (let ((signature 
10620            (or (and gnus-signature-function
10621                     (fboundp gnus-signature-function)
10622                     (funcall gnus-signature-function gnus-newsgroup-name))
10623                gnus-signature-file))
10624           b)
10625       (if (and signature
10626                (or (file-exists-p signature)
10627                    (string-match " " signature)
10628                    (not (string-match 
10629                          "^/[^/]+/" (expand-file-name signature)))))
10630           (progn
10631             (goto-char (point-max))
10632             ;; Delete any previous signatures.
10633             (if (and mail-signature (search-backward "\n-- \n" nil t))
10634                 (delete-region (1+ (point)) (point-max)))
10635             (insert "\n-- \n")
10636             (and (< 4 (setq b (count-lines 
10637                                (point)
10638                                (progn
10639                                  (if (file-exists-p signature)
10640                                      (insert-file-contents signature)
10641                                    (insert signature))
10642                                  (goto-char (point-max))
10643                                  (or (bolp) (insert "\n"))
10644                                  (point)))))
10645                  (not gnus-expert-user)
10646                  (not
10647                   (y-or-n-p
10648                    (format
10649                     "Your .sig is %d lines; it should be max 4. Really post? "
10650                     b)))
10651                  (if (file-exists-p signature)
10652                      (error (format "Edit %s." signature))
10653                    (error "Trim your signature."))))))))
10654
10655 (defun gnus-inews-do-fcc ()
10656   "Process FCC: fields in current article buffer.
10657 Unless the first character of the field is `|', the article is saved
10658 to the specified file using the function specified by the variable
10659 gnus-author-copy-saver.  The default function rmail-output saves in
10660 Unix mailbox format.
10661 If the first character is `|', the contents of the article is send to
10662 a program specified by the rest of the value."
10663   (let ((fcc-list nil)
10664         (fcc-file nil)
10665         (case-fold-search t))           ;Should ignore case.
10666     (save-excursion
10667       (save-restriction
10668         (goto-char (point-min))
10669         (search-forward "\n\n")
10670         (narrow-to-region (point-min) (point))
10671         (goto-char (point-min))
10672         (while (re-search-forward "^FCC:[ \t]*" nil t)
10673           (setq fcc-list
10674                 (cons (buffer-substring
10675                        (point)
10676                        (progn
10677                          (end-of-line)
10678                          (skip-chars-backward " \t")
10679                          (point)))
10680                       fcc-list))
10681           (delete-region (match-beginning 0)
10682                          (progn (forward-line 1) (point))))
10683         ;; Process FCC operations.
10684         (widen)
10685         (while fcc-list
10686           (setq fcc-file (car fcc-list))
10687           (setq fcc-list (cdr fcc-list))
10688           (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
10689                  (let ((program (substring fcc-file
10690                                            (match-beginning 1) (match-end 1))))
10691                    ;; Suggested by yuki@flab.fujitsu.junet.
10692                    ;; Send article to named program.
10693                    (call-process-region (point-min) (point-max) shell-file-name
10694                                         nil nil nil "-c" program)
10695                    ))
10696                 (t
10697                  ;; Suggested by hyoko@flab.fujitsu.junet.
10698                  ;; Save article in Unix mail format by default.
10699                  (if (and gnus-author-copy-saver
10700                           (not (eq gnus-author-copy-saver 'rmail-output)))
10701                      (funcall gnus-author-copy-saver fcc-file)
10702                    (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file))
10703                        (gnus-output-to-rmail fcc-file)
10704                      (rmail-output fcc-file 1 t t)))
10705                  ))
10706           )
10707         ))
10708     ))
10709
10710 (defun gnus-inews-path ()
10711   "Return uucp path."
10712   (let ((login-name (gnus-inews-login-name)))
10713     (cond ((null gnus-use-generic-path)
10714            (concat (nth 1 gnus-select-method) "!" login-name))
10715           ((stringp gnus-use-generic-path)
10716            ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
10717            (concat gnus-use-generic-path "!" login-name))
10718           (t login-name))
10719     ))
10720
10721 (defun gnus-inews-user-name ()
10722   "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
10723   (let ((full-name (gnus-inews-full-name)))
10724     (concat (if (or gnus-user-login-name gnus-use-generic-from
10725                     gnus-local-domain (getenv "DOMAINNAME"))
10726                 (concat (gnus-inews-login-name) "@"
10727                         (gnus-inews-domain-name gnus-use-generic-from))
10728               user-mail-address)
10729             ;; User's full name.
10730             (cond ((string-equal full-name "") "")
10731                   ((string-equal full-name "&") ;Unix hack.
10732                    (concat " (" (user-login-name) ")"))
10733                   (t
10734                    (concat " (" full-name ")"))))))
10735
10736 (defun gnus-inews-login-name ()
10737   "Return login name."
10738   (or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
10739
10740 (defun gnus-inews-full-name ()
10741   "Return full user name."
10742   (or gnus-user-full-name (getenv "NAME") (user-full-name)))
10743
10744 (defun gnus-inews-domain-name (&optional genericfrom)
10745   "Return user's domain name.
10746 If optional argument GENERICFROM is a string, use it as the domain
10747 name; if it is non-nil, strip off local host name from the domain name.
10748 If the function `system-name' returns full internet name and the
10749 domain is undefined, the domain name is got from it."
10750   (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
10751       (let ((domain 
10752              (or (if (stringp genericfrom) genericfrom)
10753                  (getenv "DOMAINNAME")
10754                  gnus-local-domain
10755                  ;; Function `system-name' may return full internet name.
10756                  ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
10757                  (if (string-match "\\." (system-name))
10758                      (substring (system-name) (match-end 0)))
10759                  (read-string "Domain name (no host): ")))
10760             (host (or (if (string-match "\\." (system-name))
10761                           (substring (system-name) 0 (match-beginning 0)))
10762                       (system-name))))
10763         (if (string-equal "." (substring domain 0 1))
10764             (setq domain (substring domain 1)))
10765         ;; Support GENERICFROM as same as standard Bnews system.
10766         ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
10767         (cond ((null genericfrom)
10768                (concat host "." domain))
10769               ;;((stringp genericfrom) genericfrom)
10770               (t domain)))
10771     (substring user-mail-address (1+ (string-match "@" user-mail-address)))))
10772
10773 (defun gnus-inews-full-address ()
10774   (let ((domain (gnus-inews-domain-name))
10775         (system (system-name))
10776         (case-fold-search t))
10777     (if (string-match "\\." system) system
10778       (if (string-match (concat "^" (regexp-quote system)) domain) domain
10779         (concat system "." domain)))))
10780
10781 (defun gnus-inews-message-id ()
10782   "Generate unique Message-ID for user."
10783   ;; Message-ID should not contain a slash and should be terminated by
10784   ;; a number.  I don't know the reason why it is so.
10785   (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">"))
10786
10787 (defconst gnus-inews-unique-id-char ?a)
10788
10789 (defun gnus-inews-unique-id ()
10790   "Generate unique ID from user name and current time."
10791   (let* ((char (char-to-string 
10792                 (setq gnus-inews-unique-id-char
10793                       (if (or (> gnus-inews-unique-id-char ?z)
10794                               (< gnus-inews-unique-id-char ?a))
10795                           ?a (1+ gnus-inews-unique-id-char)))))
10796          (date (timezone-parse-date (current-time-string)))
10797          (time (aref date 3))
10798          (user-name (downcase (gnus-inews-login-name)))
10799          string)
10800     (save-excursion
10801       (set-buffer (get-buffer-create " *gnus id work*"))
10802       (buffer-disable-undo)
10803       (erase-buffer)
10804       (insert user-name)
10805       (random t)
10806       (goto-char (point-min))
10807       (while (re-search-forward "[^-a-zA-Z0-9\\.]" nil t)
10808         (replace-match (char-to-string (+ (random 26) ?a))))
10809       (setq user-name (buffer-substring (point-min) (point-max)))
10810       (kill-buffer (current-buffer)))
10811     (setq string
10812           (concat user-name
10813                   (aref date 0)
10814                   (aref date 1)
10815                   (aref date 2)
10816                   (substring time 0 1)
10817                   (substring time 3 4)
10818                   (substring time 7 8)
10819                   char))
10820     (let ((i (1- (length string)))
10821           c)
10822       (while (>= i 0)
10823         (setq c (aref string i))
10824         (if (and (>= c ?0) (<= c ?9))
10825             (aset string i (- ?z (- c ?0))))
10826         (setq i (1- i))))
10827     string))
10828
10829 (defun gnus-inews-date ()
10830   "Current time string."
10831   (timezone-make-date-arpa-standard (current-time-string)))
10832
10833 (defun gnus-inews-organization ()
10834   "Return user's organization.
10835 The ORGANIZATION environment variable is used if defined.
10836 If not, the variable `gnus-local-organization' is used instead.
10837 If it is a function, the function will be called with the current
10838 newsgroup name as the argument.
10839 If this is a file name, the contents of this file will be used as the
10840 organization."
10841   (let* ((organization 
10842           (or (getenv "ORGANIZATION")
10843               (if gnus-local-organization
10844                   (if (and (symbolp gnus-local-organization)
10845                            (fboundp gnus-local-organization))
10846                       (funcall gnus-local-organization gnus-newsgroup-name)
10847                     gnus-local-organization))
10848               gnus-organization-file
10849               "~/.organization")))
10850     (and (stringp organization)
10851          (> (length organization) 0)
10852          (or (file-exists-p organization)
10853              (string-match " " organization)
10854              (not (string-match  "^/[^/]+/" (expand-file-name organization))))
10855          (save-excursion
10856            (set-buffer (get-buffer-create " *Gnus organization*"))
10857            (buffer-disable-undo (current-buffer))
10858            (erase-buffer)
10859            (if (file-exists-p organization)
10860                (insert-file-contents organization)
10861              (insert organization))
10862            (goto-char (point-min))
10863            (while (re-search-forward " *\n *" nil t)
10864              (replace-match " "))
10865            (buffer-substring (point-min) (point-max))))))
10866
10867 (defun gnus-inews-lines ()
10868   "Count the number of lines and return numeric string."
10869   (save-excursion
10870     (save-restriction
10871       (widen)
10872       (goto-char (point-min))
10873       (search-forward "\n\n" nil 'move)
10874       (int-to-string (count-lines (point) (point-max))))))
10875
10876 \f
10877 ;;;
10878 ;;; Gnus Mail Functions 
10879 ;;;
10880
10881 (autoload 'news-mail-reply "rnewspost")
10882 (autoload 'news-mail-other-window "rnewspost")
10883
10884 ;;; Mail reply commands of Gnus summary mode
10885
10886 (defun gnus-summary-reply (yank)
10887   "Reply mail to news author.
10888 If prefix argument YANK is non-nil, original article is yanked automatically.
10889 Customize the variable gnus-mail-reply-method to use another mailer."
10890   (interactive "P")
10891   ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
10892   ;; Stripping headers should be specified with mail-yank-ignored-headers.
10893   (gnus-summary-select-article t)
10894   (setq gnus-winconf-post-news (current-window-configuration))
10895   (let ((gnus-newsgroup-name gnus-newsgroup-name))
10896     (bury-buffer gnus-article-buffer)
10897     (funcall gnus-mail-reply-method yank)))
10898
10899 (defun gnus-summary-reply-with-original ()
10900   "Reply mail to news author with original article.
10901 Customize the variable gnus-mail-reply-method to use another mailer."
10902   (interactive)
10903   (gnus-summary-reply t))
10904
10905 (defun gnus-summary-mail-forward ()
10906   "Forward the current message to another user.
10907 Customize the variable gnus-mail-forward-method to use another mailer."
10908   (interactive)
10909   (gnus-summary-select-article t)
10910   (set-buffer gnus-article-buffer)
10911   (let ((gnus-newsgroup-name gnus-newsgroup-name))
10912     (funcall gnus-mail-forward-method)))
10913
10914 (defun gnus-summary-mail-other-window ()
10915   "Compose mail in other window.
10916 Customize the variable `gnus-mail-other-window-method' to use another
10917 mailer."
10918   (interactive)
10919   (let ((gnus-newsgroup-name gnus-newsgroup-name))
10920     (funcall gnus-mail-other-window-method)))
10921
10922 (defun gnus-mail-reply-using-mail (&optional yank to-address)
10923   (save-excursion
10924     (set-buffer gnus-summary-buffer)
10925     (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb)))
10926           (group (gnus-group-real-name gnus-newsgroup-name))
10927           (cur (cons (current-buffer) gnus-current-article))
10928           from subject date to reply-to message-of
10929           references message-id sender follow-to cc)
10930       (set-buffer (get-buffer-create "*mail*"))
10931       (mail-mode)
10932       (make-local-variable 'gnus-article-reply)
10933       (setq gnus-article-reply cur)
10934       (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
10935       (if (and (buffer-modified-p)
10936                (> (buffer-size) 0)
10937                (not (y-or-n-p "Unsent article being composed; erase it? ")))
10938           ()
10939         (erase-buffer)
10940         (save-excursion
10941           (set-buffer gnus-article-buffer)
10942           (let ((buffer-read-only nil))
10943             (goto-char (point-min))
10944             (narrow-to-region (point-min)
10945                               (progn (search-forward "\n\n") (point)))
10946             (add-text-properties (point-min) (point-max) '(invisible nil)))
10947           (if (and (boundp 'gnus-reply-to-function)
10948                    gnus-reply-to-function)
10949               (save-excursion
10950                 (save-restriction
10951                   (gnus-narrow-to-headers)
10952                   (setq follow-to (funcall gnus-reply-to-function group)))))
10953           (setq from (mail-fetch-field "from"))
10954           (setq date (mail-fetch-field "date"))
10955           (and from
10956                (let ((stop-pos 
10957                       (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
10958                  (setq message-of
10959                        (concat (if stop-pos (substring from 0 stop-pos) from)
10960                                "'s message of " date))))
10961           (setq sender (mail-fetch-field "sender"))
10962           (setq subject (or (mail-fetch-field "subject")
10963                             "Re: none"))
10964           (or (string-match "^[Rr][Ee]:" subject)
10965               (setq subject (concat "Re: " subject)))
10966           (setq cc (mail-fetch-field "cc"))
10967           (setq reply-to (mail-fetch-field "reply-to"))
10968           (setq references (mail-fetch-field "references"))
10969           (setq message-id (mail-fetch-field "message-id"))
10970           (widen))
10971         (setq news-reply-yank-from from)
10972         (setq news-reply-yank-message-id message-id)
10973         (mail-setup (or to-address follow-to reply-to from sender "") 
10974                     subject message-of nil gnus-article-buffer nil)
10975         ;; Fold long references line to follow RFC1036.
10976         (mail-position-on-field "References")
10977         (let ((begin (- (point) (length "References: ")))
10978               (fill-column 78)
10979               (fill-prefix "\t"))
10980           (if references (insert references))
10981           (if (and references message-id) (insert " "))
10982           (if message-id (insert message-id))
10983           ;; The region must end with a newline to fill the region
10984           ;; without inserting extra newline.
10985           (fill-region-as-paragraph begin (1+ (point))))
10986         (goto-char (point-min))
10987         (search-forward (concat "\n" mail-header-separator "\n"))
10988         (if yank
10989             (let ((last (point)))
10990               (run-hooks 'news-reply-header-hook)
10991               (mail-yank-original nil)
10992               (goto-char last))))
10993       (if (not yank)
10994           (let ((mail (current-buffer)))
10995             (switch-to-buffer gnus-article-buffer)
10996             (delete-other-windows)
10997             (switch-to-buffer-other-window mail))
10998         (delete-other-windows)
10999         (switch-to-buffer (current-buffer))))))
11000
11001 (defun gnus-mail-yank-original ()
11002   (interactive)
11003   (run-hooks 'news-reply-header-hook)
11004   (mail-yank-original nil))
11005
11006 (defun gnus-mail-send-and-exit ()
11007   (interactive)
11008   (let ((cbuf (current-buffer)))
11009     (mail-send-and-exit nil)
11010     (if (get-buffer gnus-group-buffer)
11011         (progn
11012           (save-excursion
11013             (set-buffer cbuf)
11014             (let ((reply gnus-article-reply))
11015               (if (and reply
11016                        (get-buffer (car reply))
11017                        (buffer-name (car reply)))
11018                   (progn
11019                     (set-buffer (car reply))
11020                     (gnus-summary-mark-article-as-replied 
11021                      (cdr reply))))))
11022           (and gnus-winconf-post-news
11023                (set-window-configuration gnus-winconf-post-news))
11024           (setq gnus-winconf-post-news nil)))))
11025
11026 (defun gnus-mail-forward-using-mail ()
11027   "Forward the current message to another user using mail."
11028   ;; This is almost a carbon copy of rmail-forward in rmail.el.
11029   (let ((forward-buffer (current-buffer))
11030         (subject
11031          (concat "[" gnus-newsgroup-name "] "
11032                  (or (gnus-fetch-field "Subject") "")))
11033         beg)
11034     ;; If only one window, use it for the mail buffer.
11035     ;; Otherwise, use another window for the mail buffer
11036     ;; so that the Rmail buffer remains visible
11037     ;; and sending the mail will get back to it.
11038     (if (if (one-window-p t)
11039             (mail nil nil subject)
11040           (mail-other-window nil nil subject))
11041         (save-excursion
11042           (setq beg (goto-char (point-max)))
11043           (insert "------- Start of forwarded message -------\n")
11044           (insert-buffer forward-buffer)
11045           (goto-char (point-max))
11046           (insert "------- End of forwarded message -------\n")
11047           ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>. 
11048           (goto-char beg)
11049           (while (setq beg (next-single-property-change (point) 'invisible))
11050             (goto-char beg)
11051             (delete-region beg (or (next-single-property-change 
11052                                     (point) 'invisible)
11053                                    (point-max))))
11054           ;; You have a chance to arrange the message.
11055           (run-hooks 'gnus-mail-forward-hook)))))
11056
11057 (defun gnus-mail-other-window-using-mail ()
11058   "Compose mail other window using mail."
11059   (news-mail-other-window)
11060   (gnus-overload-functions))
11061
11062 \f
11063 ;;;
11064 ;;; Dribble file
11065 ;;;
11066
11067 (defvar gnus-dribble-ignore nil)
11068
11069 (defun gnus-dribble-file-name ()
11070   (concat gnus-startup-file "-dribble"))
11071
11072 (defun gnus-dribble-open ()
11073   (save-excursion 
11074     (set-buffer 
11075      (setq gnus-dribble-buffer (find-file-noselect (gnus-dribble-file-name))))
11076     (buffer-disable-undo (current-buffer))
11077     (bury-buffer gnus-dribble-buffer)
11078     (auto-save-mode t)
11079     (goto-char (point-max))))
11080
11081 (defun gnus-dribble-enter (string)
11082   (if (not gnus-dribble-ignore)
11083       (let ((obuf (current-buffer)))
11084         (set-buffer gnus-dribble-buffer)
11085         (insert string "\n")
11086         (set-window-point (get-buffer-window (current-buffer)) (point-max))
11087         (set-buffer obuf))))
11088
11089 (defun gnus-dribble-read-file ()
11090   (let ((dribble-file (gnus-dribble-file-name)))
11091     (save-excursion 
11092       (set-buffer (setq gnus-dribble-buffer 
11093                         (get-buffer-create 
11094                          (file-name-nondirectory dribble-file))))
11095       (gnus-add-current-to-buffer-list)
11096       (erase-buffer)
11097       (set-visited-file-name dribble-file)
11098       (buffer-disable-undo (current-buffer))
11099       (bury-buffer (current-buffer))
11100       (set-buffer-modified-p nil)
11101       (let ((auto (make-auto-save-file-name))
11102             (gnus-dribble-ignore t))
11103         (if (or (file-exists-p auto) (file-exists-p dribble-file))
11104             (progn
11105               (if (file-newer-than-file-p auto dribble-file)
11106                   (setq dribble-file auto))
11107               (insert-file-contents dribble-file)
11108               (if (not (zerop (buffer-size)))
11109                   (set-buffer-modified-p t))
11110               (if (y-or-n-p "Auto-save file exists. Do you want to read it? ")
11111                   (progn
11112                     (message "Reading %s..." dribble-file) 
11113                     (eval-current-buffer)
11114                     (message "Reading %s...done" dribble-file)))))))))
11115
11116 (defun gnus-dribble-delete-file ()
11117   (save-excursion
11118     (set-buffer gnus-dribble-buffer)
11119     (let ((auto (make-auto-save-file-name)))
11120       (if (file-exists-p auto)
11121           (delete-file auto))
11122       (if (file-exists-p (gnus-dribble-file-name))
11123           (delete-file (gnus-dribble-file-name)))
11124       (erase-buffer)
11125       (set-buffer-modified-p nil))))
11126
11127 (defun gnus-dribble-save ()
11128   (if (and gnus-dribble-buffer
11129            (buffer-name gnus-dribble-buffer))
11130       (save-excursion
11131         (set-buffer gnus-dribble-buffer)
11132         (save-buffer))))
11133
11134 (defun gnus-dribble-clear ()
11135   (save-excursion
11136     (if (and gnus-dribble-buffer
11137              (buffer-name (get-buffer gnus-dribble-buffer)))
11138         (progn
11139           (set-buffer gnus-dribble-buffer)
11140           (erase-buffer)
11141           (set-buffer-modified-p nil)
11142           (setq buffer-saved-size (buffer-size))))))
11143
11144 ;;;
11145 ;;; Server Communication
11146 ;;;
11147
11148 (defun gnus-start-news-server (&optional confirm)
11149   "Open a method for getting news.
11150 If CONFIRM is non-nil, the user will be asked for an NNTP server."
11151   (let (how where)
11152     (if gnus-current-select-method
11153         ;; Stream is already opened.
11154         nil
11155       ;; Open NNTP server.
11156       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
11157       (if confirm
11158           (progn
11159             ;; Read server name with completion.
11160             (setq gnus-nntp-server
11161                   (completing-read "NNTP server: "
11162                                    (mapcar (lambda (server) (list server))
11163                                            (cons (list gnus-nntp-server)
11164                                                  gnus-secondary-servers))
11165                                    nil nil gnus-nntp-server))
11166             (setq gnus-select-method 
11167                   (list 'nntp gnus-nntp-server)))
11168
11169         (if (and gnus-nntp-server 
11170                  (stringp gnus-nntp-server)
11171                  (not (string= gnus-nntp-server "")))
11172             (setq gnus-select-method
11173                   (cond ((or (string= gnus-nntp-server "")
11174                              (string= gnus-nntp-server "::"))
11175                          (list 'nnspool (system-name)))
11176                         ((string-match ":" gnus-nntp-server)
11177                          (list 'nnmh gnus-nntp-server))
11178                         (t
11179                          (list 'nntp gnus-nntp-server))))))
11180
11181       (setq how (car gnus-select-method))
11182       (setq where (car (cdr gnus-select-method)))
11183       (cond ((eq how 'nnspool)
11184              (require 'nnspool)
11185              (message "Looking up local news spool..."))
11186             ((eq how 'nnmh)
11187              (require 'nnmh)
11188              (message "Looking up mh spool..."))
11189             (t
11190              (require 'nntp)))
11191       (setq gnus-current-select-method gnus-select-method)
11192       (run-hooks 'gnus-open-server-hook)
11193       (or 
11194        ;; gnus-open-server-hook might have opened it
11195        (gnus-server-opened gnus-select-method)  
11196        (gnus-open-server gnus-select-method)
11197        (error "%s" (gnus-nntp-message 
11198                     (format "Cannot open NNTP server on %s" 
11199                             where))))
11200       gnus-select-method)))
11201
11202 (defun gnus-check-news-server (method)
11203   "If the news server is down, start it up again."
11204   (let ((method (if method method gnus-select-method)))
11205     (if (gnus-server-opened method)
11206         ;; Stream is already opened.
11207         t
11208       ;; Open server.
11209       (message "Opening server %s on %s..." (car method) (nth 1 method))
11210       (run-hooks 'gnus-open-server-hook)
11211       (or (gnus-server-opened method)
11212           (gnus-open-server method))
11213       (message ""))))
11214
11215 (defun gnus-nntp-message (&optional message)
11216   "Check the status of the NNTP server.
11217 If the status of the server is clear and MESSAGE is non-nil, MESSAGE
11218 is returned insted of the status string."
11219   (let ((status (gnus-status-message (gnus-find-method-for-group 
11220                                       gnus-newsgroup-name)))
11221         (message (or message "")))
11222     (if (and (stringp status) (> (length status) 0))
11223         status message)))
11224
11225 (defun gnus-get-function (method function)
11226   (let ((func (intern (format "%s-%s" (car method) function))))
11227     (if (not (fboundp func)) 
11228         (progn
11229           (require (car method))
11230           (if (not (fboundp func)) 
11231               (error "No such function: %s" func))))
11232     func))
11233
11234 ;; Specifying port number suggested by Stephane Laveau <laveau@corse.inria.fr>.
11235 (defun gnus-open-server (method)
11236   (apply (gnus-get-function method 'open-server) (cdr method)))
11237
11238 (defun gnus-close-server (method)
11239   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
11240
11241 (defun gnus-request-list (method)
11242   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
11243
11244 (defun gnus-request-list-newsgroups (method)
11245   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
11246
11247 (defun gnus-request-newgroups (date method)
11248   (funcall (gnus-get-function method 'request-newgroups) 
11249            date (nth 1 method)))
11250
11251 (defun gnus-server-opened (method)
11252   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
11253
11254 (defun gnus-status-message (method)
11255   (funcall (gnus-get-function method 'status-message) (nth 1 method)))
11256
11257 (defun gnus-request-group (group &optional dont-check)
11258   (let ((method (gnus-find-method-for-group group)))
11259     (funcall (gnus-get-function method 'request-group) 
11260              (gnus-group-real-name group) (nth 1 method) dont-check)))
11261
11262 (defun gnus-close-group (group)
11263   (let ((method (gnus-find-method-for-group group)))
11264     (funcall (gnus-get-function method 'close-group) 
11265              (gnus-group-real-name group) (nth 1 method))))
11266
11267 (defun gnus-retrieve-headers (articles group)
11268   (let ((method (gnus-find-method-for-group group)))
11269     (funcall (gnus-get-function method 'retrieve-headers) 
11270              articles (gnus-group-real-name group) (nth 1 method))))
11271
11272 (defun gnus-request-article (article group buffer)
11273   (let ((method (gnus-find-method-for-group group)))
11274     (funcall (gnus-get-function method 'request-article) 
11275              article (gnus-group-real-name group) (nth 1 method) buffer)))
11276
11277 (defun gnus-request-head (article group)
11278   (let ((method (gnus-find-method-for-group group)))
11279     (funcall (gnus-get-function method 'request-head) 
11280              article (gnus-group-real-name group) (nth 1 method))))
11281
11282 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11283 (defun gnus-request-post-buffer (post header artbuf)
11284    (let* ((group gnus-newsgroup-name)
11285           (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
11286           (method
11287            (if (and gnus-post-method
11288                     ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
11289                     (memq 'post (assoc
11290                                  (format "%s" (car (gnus-find-method-for-group
11291                                                     gnus-newsgroup-name)))
11292                                         gnus-valid-select-methods)))
11293                gnus-post-method
11294              (gnus-find-method-for-group gnus-newsgroup-name))))
11295     (funcall (gnus-get-function method 'request-post-buffer) 
11296              post header artbuf (gnus-group-real-name group) info)))
11297
11298 (defun gnus-request-post (method)
11299   (and gnus-post-method
11300        (memq 'post (assoc (format "%s" (car method))
11301                           gnus-valid-select-methods))
11302        (setq method gnus-post-method))
11303   (funcall (gnus-get-function method 'request-post) 
11304            (nth 1 method)))
11305
11306 (defun gnus-request-expire-articles (articles group &optional force)
11307   (let ((method (gnus-find-method-for-group group)))
11308     (funcall (gnus-get-function method 'request-expire-articles) 
11309              articles (gnus-group-real-name group) (nth 1 method)
11310              force)))
11311
11312 (defun gnus-request-move-article (article group server accept-function)
11313   (let ((method (gnus-find-method-for-group group)))
11314     (funcall (gnus-get-function method 'request-move-article) 
11315              article (gnus-group-real-name group) 
11316              (nth 1 method) accept-function)))
11317
11318 (defun gnus-request-accept-article (group)
11319   (let ((func (if (symbolp group) group
11320                 (car (gnus-find-method-for-group group)))))
11321     (funcall (intern (format "%s-request-accept-article" func))
11322              (if (stringp group) (gnus-group-real-name group)
11323                group))))
11324
11325 (defun gnus-find-method-for-group (group)
11326   (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
11327     (if (or (not info)
11328             (not (nth 4 info)))
11329         gnus-select-method
11330       (nth 4 info))))
11331
11332 (defun gnus-check-backend-function (func group)
11333   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
11334                  group)))
11335     (fboundp (intern (format "%s-%s" method func)))))
11336
11337 (defun gnus-methods-using (method)
11338   (let ((valids gnus-valid-select-methods)
11339         outs)
11340     (while valids
11341       (if (memq method (car valids)) 
11342           (setq outs (cons (car valids) outs)))
11343       (setq valids (cdr valids)))
11344     outs))
11345
11346 ;;; 
11347 ;;; Active & Newsrc File Handling
11348 ;;;
11349
11350 ;; Newsrc related functions.
11351 ;; Gnus internal format of gnus-newsrc-assoc:
11352 ;; (("alt.general" 3 (1 . 1))
11353 ;;  ("alt.misc"    3 ((1 . 10) (12 . 15)))
11354 ;;  ("alt.test"    7 (1 . 99) (45 57 93)) ...)
11355 ;; The first item is the group name; the second is the subscription
11356 ;; level; the third is either a range of a list of ranges of read
11357 ;; articles, the optional fourth element is a list of marked articles,
11358 ;; the optional fifth element is the select method.
11359 ;;
11360 ;; Gnus internal format of gnus-newsrc-hashtb:
11361 ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...)
11362 ;; This is the entry for "alt.misc". The first element is the number
11363 ;; of unread articles in "alt.misc". The cdr of this entry is the
11364 ;; element *before* "alt.misc" in gnus-newsrc-assoc, which makes is
11365 ;; trivial to remove or add new elements into gnus-newsrc-assoc
11366 ;; without scanning the entire list. So, to get the actual information
11367 ;; of "alt.misc", you'd say something like 
11368 ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb))
11369 ;;
11370 ;; Gnus internal format of gnus-active-hashtb:
11371 ;; ((1 . 1))
11372 ;;  (5 . 10))
11373 ;;  (67 . 99)) ...)
11374 ;; The only element in each entry in this hash table is a range of
11375 ;; (possibly) available articles. (Articles in this range may have
11376 ;; been expired or cancelled.)
11377 ;;
11378 ;; Gnus internal format of gnus-killed-list and gnus-zombie-list:
11379 ;; ("alt.misc" "alt.test" "alt.general" ...)
11380
11381 (defun gnus-setup-news (&optional rawfile level)
11382   "Setup news information.
11383 If RAWFILE is non-nil, the .newsrc file will also be read.
11384 If LEVEL is non-nil, the news will be set up at level LEVEL."
11385   (let ((init (not (and gnus-newsrc-assoc gnus-active-hashtb (not rawfile)))))
11386     ;; Clear some variables to re-initialize news information.
11387     (if init (setq gnus-newsrc-assoc nil gnus-active-hashtb nil))
11388     ;; Read the active file and create `gnus-active-hashtb'.
11389     ;; If `gnus-read-active-file' is nil, then we just create an empty
11390     ;; hash table. The partial filling out of the hash table will be
11391     ;; done in `gnus-get-unread-articles'.
11392     (if (and gnus-read-active-file (not level))
11393         (gnus-read-active-file)
11394       (setq gnus-active-hashtb (make-vector 4095 0)))
11395
11396     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
11397     (if init (gnus-read-newsrc-file rawfile))
11398     ;; Find the number of unread articles in each non-dead group.
11399     (gnus-get-unread-articles (or level 6))
11400     ;; Find new newsgroups and treat them.
11401     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level))
11402         (gnus-find-new-newsgroups))
11403     (if (and init gnus-check-bogus-newsgroups 
11404              gnus-read-active-file (not level))
11405         (gnus-check-bogus-newsgroups))))
11406
11407 (defun gnus-find-new-newsgroups ()
11408   "Search for new newsgroups and add them.
11409 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
11410 The `-n' option line from .newsrc is respected."
11411   (interactive)
11412   (or (gnus-check-first-time-used)
11413       (if (eq gnus-check-new-newsgroups 'ask-server)
11414           (gnus-ask-server-for-new-groups)
11415         (let ((groups 0)
11416               group new-newsgroups)
11417           (or gnus-have-read-active-file (gnus-read-active-file))
11418           (setq gnus-newsrc-last-checked-date (current-time-string))
11419           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
11420           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
11421           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
11422           (mapatoms
11423            (lambda (sym)
11424              (setq group (symbol-name sym))
11425              (if (or (gnus-gethash group gnus-killed-hashtb)
11426                      (gnus-gethash group gnus-newsrc-hashtb))
11427                  ()
11428                (if (and gnus-newsrc-options-n-yes
11429                         (string-match gnus-newsrc-options-n-yes group))
11430                    (progn
11431                      (setq groups (1+ groups))
11432                      (gnus-sethash group group gnus-killed-hashtb)
11433                      (funcall gnus-subscribe-options-newsgroup-method group))
11434                  (if (or (null gnus-newsrc-options-n-no)
11435                          (not (string-match gnus-newsrc-options-n-no group)))
11436                      ;; Add this group.
11437                      (progn
11438                        (setq groups (1+ groups))
11439                        (gnus-sethash group group gnus-killed-hashtb)
11440                        (if gnus-subscribe-hierarchical-interactive
11441                            (setq new-newsgroups (cons group new-newsgroups))
11442                          (funcall gnus-subscribe-newsgroup-method group)))))))
11443            gnus-active-hashtb)
11444           (if new-newsgroups 
11445               (gnus-subscribe-hierarchical-interactive new-newsgroups))
11446           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
11447           (if (> groups 0)
11448               (message "%d new newsgroup%s arrived." 
11449                        groups (if (> groups 1) "s have" " has")))))))
11450
11451 (defun gnus-ask-server-for-new-groups ()
11452   (let* ((date (timezone-parse-date (or gnus-newsrc-last-checked-date
11453                                         (current-time-string))))
11454          (methods (cons gnus-select-method gnus-secondary-select-methods))
11455          (time-string
11456           (format "%s%02d%02d %s%s%s"
11457                   (substring (aref date 0) 2) (string-to-int (aref date 1)) 
11458                   (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
11459                   (substring (aref date 3) 3 5) (substring (aref date 3) 6 8)))
11460          (groups 0)
11461          (new-date (current-time-string))
11462          hashtb group new-newsgroups)
11463     (while methods
11464       (if (gnus-request-newgroups time-string (car methods))
11465           (save-excursion
11466             (or hashtb (setq hashtb (gnus-make-hashtable 
11467                                      (count-lines (point-min) (point-max)))))
11468             (set-buffer nntp-server-buffer)
11469             (gnus-active-to-gnus-format (car methods) hashtb)))
11470       (setq methods (cdr methods)))
11471     (mapatoms
11472      (lambda (group-sym)
11473        (setq group (symbol-name group-sym))
11474        (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb)
11475        (if (and gnus-newsrc-options-n-yes
11476                 (string-match gnus-newsrc-options-n-yes group))
11477            (progn
11478              (setq groups (1+ groups))
11479              (funcall gnus-subscribe-options-newsgroup-method group))
11480          (if (or (null gnus-newsrc-options-n-no)
11481                  (not (string-match gnus-newsrc-options-n-no group)))
11482              ;; Add this group.
11483              (progn
11484                (setq groups (1+ groups))
11485                (if gnus-subscribe-hierarchical-interactive
11486                    (setq new-newsgroups (cons group new-newsgroups))
11487                  (funcall gnus-subscribe-newsgroup-method group))))))
11488      hashtb)
11489     (if new-newsgroups 
11490         (gnus-subscribe-hierarchical-interactive new-newsgroups))
11491     (setq gnus-newsrc-last-checked-date new-date)
11492     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
11493     (if (> groups 0)
11494         (message "%d new newsgroup%s arrived." 
11495                  groups (if (> groups 1) "s have" " has")))))
11496
11497 (defun gnus-check-first-time-used ()
11498   (if (or (file-exists-p gnus-startup-file)
11499           (file-exists-p (concat gnus-startup-file ".el"))
11500           (file-exists-p (concat gnus-startup-file ".eld")))
11501       nil
11502     (message "First time user; subscribing you to default groups")
11503     (or gnus-have-read-active-file (gnus-read-active-file))
11504     (setq gnus-newsrc-last-checked-date (current-time-string))
11505     (let ((groups gnus-default-subscribed-newsgroups)
11506           group)
11507       (if (eq groups t)
11508           nil
11509         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
11510         (mapatoms
11511          (lambda (sym)
11512            (setq group (symbol-name sym))
11513            (if (and gnus-newsrc-options-n-yes
11514                     (string-match gnus-newsrc-options-n-yes group))
11515                (funcall gnus-subscribe-options-newsgroup-method group)
11516              (and (or (null gnus-newsrc-options-n-no)
11517                       (not (string-match gnus-newsrc-options-n-no group)))
11518                   (setq gnus-killed-list (cons group gnus-killed-list)))))
11519          gnus-active-hashtb)
11520         (while groups
11521           (if (gnus-gethash (car groups) gnus-active-hashtb)
11522               (gnus-group-change-level (car groups) 3 9))
11523           (setq groups (cdr groups)))))))
11524
11525 ;; `gnus-group-change-level' is the fundamental function for changing
11526 ;; subscription levels of newsgroups. This might mean just changing
11527 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
11528 ;; again, which subscribes/unsubscribes a group, which is equally
11529 ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and
11530 ;; from 8-9 to 1-7 means that you remove the group from the list of
11531 ;; killed (or zombie) groups and add them to the (kinda) subscribed
11532 ;; groups. And last but not least, moving from 8 to 9 and 9 to 8,
11533 ;; which is trivial.
11534 ;; ENTRY can either be a string (newsgroup name) or a list (if
11535 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
11536 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
11537 ;; entries. 
11538 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
11539 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
11540 ;; after. 
11541 (defun gnus-group-change-level (entry level &optional oldlevel
11542                                       previous fromkilled)
11543   (let (group info active num)
11544     ;; Glean what info we can from the arguments
11545     (if (consp entry)
11546         (if fromkilled (setq group (nth 1 entry))
11547           (setq group (car (nth 2 entry))))
11548       (setq group entry))
11549     (if (and (stringp entry)
11550              oldlevel 
11551              (< oldlevel 8))
11552         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
11553     (if (and (not oldlevel)
11554              (listp entry))
11555         (setq oldlevel (car (cdr (nth 2 entry)))))
11556     (if (stringp previous)
11557         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
11558
11559     (gnus-dribble-enter
11560      (format "(gnus-group-change-level %S %S %S %S %S)" 
11561              group level oldlevel (car (nth 2 previous)) fromkilled))
11562     
11563     ;; Then we remove the newgroup from any old structures, if needed.
11564     ;; If the group was killed, we remove it from the killed or zombie
11565     ;; list. If not, and it is in fact going to be killed, we remove
11566     ;; it from the newsrc hash table and assoc.
11567     (cond ((>= oldlevel 8)
11568            (if (= oldlevel 8)
11569                (setq gnus-zombie-list (delete group gnus-zombie-list))
11570              (setq gnus-killed-list (delete group gnus-killed-list))))
11571           (t
11572            (if (>= level 8)
11573                (progn
11574                  (gnus-sethash (car (nth 2 entry))
11575                                nil gnus-newsrc-hashtb)
11576                  (if (nth 3 entry)
11577                      (setcdr (gnus-gethash (car (nth 3 entry))
11578                                            gnus-newsrc-hashtb)
11579                              (cdr entry)))
11580                  (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
11581
11582     ;; Finally we enter (if needed) the list where it is supposed to
11583     ;; go, and change the subscription level. If it is to be killed,
11584     ;; we enter it into the killed or zombie list.
11585     (cond ((>= level 8)
11586            (if (= level 8)
11587                (setq gnus-zombie-list (cons group gnus-zombie-list))
11588              (setq gnus-killed-list (cons group gnus-killed-list))))
11589           (t
11590            ;; If the list is to be entered into the newsrc assoc, and
11591            ;; it was killed, we have to create an entry in the newsrc
11592            ;; hashtb format and fix the pointers in the newsrc assoc.
11593            (if (>= oldlevel 8)
11594                (progn
11595                  (if (listp entry)
11596                      (progn
11597                        (setq info (cdr entry))
11598                        (setq num (car entry)))
11599                    (setq active (gnus-gethash group gnus-active-hashtb))
11600                    (setq num (- (1+ (cdr active)) (car active)))
11601                    ;; Check whether the group is foreign. If so, the
11602                    ;; foreign select method has to be entered into the
11603                    ;; info. 
11604                    (let ((method (gnus-group-method-name group)))
11605                      (if (eq method gnus-select-method)
11606                          (setq info (list group level 
11607                                           (cons 1 (1- (car active)))))
11608                        (setq info (list group level (cons 1 (1- (car active)))
11609                                         nil method)))))
11610                  (setq entry (cons info (if previous (cdr (cdr previous))
11611                                           (cdr gnus-newsrc-assoc))))
11612                  (setcdr (if previous (cdr previous) gnus-newsrc-assoc)
11613                          entry)
11614                  (gnus-sethash group (cons num (if previous (cdr previous)
11615                                                  gnus-newsrc-assoc))
11616                                gnus-newsrc-hashtb)
11617                  (if (cdr entry)
11618                      (setcdr (gnus-gethash (car (car (cdr entry)))
11619                                            gnus-newsrc-hashtb)
11620                              entry)))
11621              ;; It was alive, and it is going to stay alive, so we
11622              ;; just change the level and don't change any pointers or
11623              ;; hash table entries.
11624              (setcar (cdr (car (cdr (cdr entry)))) level))))))
11625
11626 (defun gnus-kill-newsgroup (newsgroup)
11627   "Obsolete function. Kills a newsgroup."
11628   (gnus-group-change-level (gnus-gethash newsgroup gnus-newsrc-hashtb) 9))
11629
11630 (defun gnus-check-bogus-newsgroups (&optional confirm)
11631   "Remove bogus newsgroups.
11632 If CONFIRM is non-nil, the user has to confirm the deletion of every
11633 newsgroup." 
11634   (let ((newsrc (cdr gnus-newsrc-assoc))
11635         bogus group)
11636     (message "Checking bogus newsgroups...")
11637     (or gnus-have-read-active-file (gnus-read-active-file))
11638     ;; Find all bogus newsgroup that are subscribed.
11639     (while newsrc
11640       (setq group (car (car newsrc)))
11641       (if (or (gnus-gethash group gnus-active-hashtb)
11642               (nth 4 (car newsrc))
11643               (and confirm
11644                    (not (y-or-n-p
11645                          (format "Remove bogus newsgroup: %s " group)))))
11646           ;; Active newsgroup.
11647           ()
11648         ;; Found a bogus newsgroup.
11649         (setq bogus (cons group bogus)))
11650       (setq newsrc (cdr newsrc)))
11651     ;; Remove all bogus subscribed groups by first killing them, and
11652     ;; then removing them from the list of killed groups.
11653     (while bogus
11654       (gnus-group-change-level 
11655        (gnus-gethash (car bogus) gnus-newsrc-hashtb) 9)
11656       (setq gnus-killed-list (delete (car bogus) gnus-killed-list))
11657       (setq bogus (cdr bogus)))
11658     ;; Then we remove all bogus groups from the list of killed and
11659     ;; zombie groups. They are are removed without confirmation.
11660     (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
11661           killed)
11662       (while dead-lists
11663         (setq killed (symbol-value (car dead-lists)))
11664         (while killed
11665           (setq group (car killed))
11666           (or (gnus-gethash group gnus-active-hashtb)
11667               ;; The group is bogus.
11668               (set (car dead-lists)
11669                    (delete group (symbol-value (car dead-lists)))))
11670           (setq killed (cdr killed)))
11671         (setq dead-lists (cdr dead-lists))))
11672     ;; While we're at it, we check the killed list for duplicates.
11673     ;; This has nothing to do with bogosity, but it's a convenient
11674     ;; place to put the check.
11675     (let ((killed gnus-killed-list))
11676       (while killed
11677         (message "%d" (length killed))
11678         (setcdr killed (delete (car killed) (cdr killed)))
11679         (setq killed (cdr killed))))
11680     (message "Checking bogus newsgroups... done")))
11681
11682 ;; Go though `gnus-newsrc-assoc' and compare with `gnus-active-hashtb'
11683 ;; and compute how many unread articles there are in each group.
11684 (defun gnus-get-unread-articles (&optional level)
11685   (let ((newsrc (cdr gnus-newsrc-assoc))
11686         (level (or level 6))
11687         info group active)
11688     (message "Checking new news...")
11689     (while newsrc
11690       (setq info (car newsrc))
11691       (setq group (car info))
11692       (setq active (gnus-gethash group gnus-active-hashtb))
11693
11694       ;; Check newsgroups. If the user doesn't want to check them, or
11695       ;; they can't be checked (for instance, if the news server can't
11696       ;; be reached) we just set the number of unread articles in this
11697       ;; newsgroup to t. This means that Gnus thinks that there are
11698       ;; unread articles, but it has no idea how many.
11699       (if (nth 4 info)
11700           (if (or (and gnus-activate-foreign-newsgroups 
11701                        (not (numberp gnus-activate-foreign-newsgroups)))
11702                   (and (numberp gnus-activate-foreign-newsgroups)
11703                        (<= (nth 1 info) gnus-activate-foreign-newsgroups)
11704                        (<= (nth 1 info) level)))
11705               (or (eq (car (nth 4 info)) 'nnvirtual)
11706                   (setq active (gnus-activate-newsgroup (car info)))))
11707         (if (and (not gnus-read-active-file)
11708                  (<= (nth 1 info) level))
11709             (progn
11710               (setq active (gnus-activate-newsgroup (car info))))))
11711       
11712       (or active (progn (gnus-sethash group nil gnus-active-hashtb)
11713                         (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
11714       (and active (gnus-get-unread-articles-in-group info active))
11715       (setq newsrc (cdr newsrc)))
11716     (message "Checking new news... done")))
11717
11718 ;; Create a hash table out of the newsrc alist. The `car's of the
11719 ;; alist elements are used as keys.
11720 (defun gnus-make-hashtable-from-newsrc-alist ()
11721   (let ((alist gnus-newsrc-assoc)
11722          prev)
11723     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
11724     (setq alist 
11725           (setq prev (setq gnus-newsrc-assoc 
11726                            (cons (list "dummy.group" 0 (cons 0 0)) alist))))
11727     (while alist
11728       (gnus-sethash (car (car alist)) (cons nil prev) gnus-newsrc-hashtb)
11729       (setq prev alist)
11730       (setq alist (cdr alist)))))
11731
11732 (defun gnus-make-hashtable-from-killed ()
11733   "Create a hash table from the killed and zombie lists."
11734   (let ((lists '(gnus-killed-list gnus-zombie-list))
11735         list)
11736     (setq gnus-killed-hashtb 
11737           (gnus-make-hashtable 
11738            (+ (length gnus-killed-list) (length gnus-zombie-list))))
11739     (while lists
11740       (setq list (symbol-value (car lists)))
11741       (setq lists (cdr lists))
11742       (while list
11743         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
11744         (setq list (cdr list))))))
11745
11746 (defun gnus-get-unread-articles-in-group (info active)
11747   (let* (num srange lowest range group)
11748     ;; Modify the list of read articles according to what articles 
11749     ;; are available; then tally the unread articles and add the
11750     ;; number to the group hash table entry.
11751     (setq range (nth 2 info))
11752     (setq num 0)
11753     (cond ((zerop (cdr active))
11754            (setq num 0))
11755           ((not range)
11756            (setq num (- (1+ (cdr active)) (car active))))
11757           ((atom (car range))
11758            ;; Fix a single (num . num) range according to the
11759            ;; active hash table.
11760            (if (< (cdr range) (car active)) (setcdr range (car active)))
11761            ;; Compute number of unread articles.
11762            (setq num (max 0 (- (cdr active) 
11763                                (- (1+ (cdr range)) (car range))))))
11764           (t
11765            ;; The read list is a list of ranges. Fix them according to
11766            ;; the active hash table.
11767            (setq srange range)
11768            (setq lowest (1- (car active)))
11769            (while (and (< (cdr (car srange)) lowest))
11770              (if (and (cdr srange)
11771                       (<= (cdr (car srange)) (1+ lowest)))
11772                  (progn
11773                    (setcdr (car srange) (cdr (car (cdr srange))))
11774                    (setcdr srange (cdr (cdr srange))))
11775                (setcdr (car srange) lowest)))
11776            ;; Compute the number of unread articles.
11777            (while range
11778              (setq num (+ num (- (1+ (cdr (car range))) 
11779                                  (car (car range)))))
11780              (setq range (cdr range)))
11781            (setq num (max 0 (- (cdr active) num)))))
11782     (setcar (gnus-gethash (car info) gnus-newsrc-hashtb) num)
11783     num))
11784
11785 (defun gnus-activate-newsgroup (group)
11786   (let (active)
11787     (and (gnus-request-group group)
11788          (save-excursion
11789            (set-buffer nntp-server-buffer)
11790            (goto-char 1)
11791            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
11792                 (progn
11793                   (goto-char (match-beginning 1))
11794                   (gnus-sethash 
11795                    group (setq active (cons (read (current-buffer))
11796                                             (read (current-buffer))))
11797                    gnus-active-hashtb)))))
11798     active))
11799
11800 (defun gnus-update-read-articles 
11801   (group unread unselected ticked &optional domarks replied expirable killed
11802          dormant bookmark score)
11803   "Update the list of read and ticked articles in GROUP using the
11804 UNREAD and TICKED lists.
11805 Note: UNSELECTED has to be sorted over `<'."
11806   (let* ((active (gnus-gethash group gnus-active-hashtb))
11807          (entry (gnus-gethash group gnus-newsrc-hashtb))
11808          (number (car entry))
11809          (info (nth 2 entry))
11810          (marked (nth 3 info))
11811          (prev 1)
11812          (unread (sort (copy-sequence unread) (function <)))
11813          last read)
11814     (if (not info)
11815         ;; There is no info on this group if it was, in fact,
11816         ;; killed. Gnus stores no information on killed groups, so
11817         ;; there's nothing to be done. 
11818         ;; One could store the information somewhere temporarily,
11819         ;; perhaps... Hmmm... 
11820         ()
11821       ;; Remove any negative articles numbers.
11822       (while (and unread (< (car unread) 0))
11823         (setq unread (cdr unread)))
11824       (if (not (and (numberp number) (zerop number)))
11825           (setq unread (nconc unselected unread)))
11826       ;; Set the number of unread articles in gnus-newsrc-hashtb.
11827 ;      (or (eq 'nnvirtual (car (gnus-find-method-for-group 
11828 ;                              gnus-newsgroup-name)))
11829       (setcar entry (length unread))
11830       ;; Compute the ranges of read articles by looking at the list of
11831       ;; unread articles.  
11832       (while unread
11833         (if (/= (car unread) prev)
11834             (setq read (cons (cons prev (1- (car unread))) read)))
11835         (setq prev (1+ (car unread)))
11836         (setq unread (cdr unread)))
11837       (if (<= prev (cdr active))
11838           (setq read (cons (cons prev (cdr active)) read)))
11839       ;; Enter this list into the group info.
11840       (setcar (cdr (cdr info)) 
11841               (if (> (length read) 1) (nreverse read) (car read)))
11842       ;; Enter the list of ticked articles.
11843       (gnus-set-marked-articles 
11844        info ticked
11845        (if domarks replied (cdr (assq 'reply marked)))
11846        (if domarks expirable (cdr (assq 'expire marked)))
11847        (if domarks killed (cdr (assq 'killed marked)))
11848        (if domarks dormant (cdr (assq 'dormant marked)))
11849        (if domarks bookmark (cdr (assq 'bookmark marked)))
11850        (if domarks score (cdr (assq 'score marked)))))))
11851
11852 (defun gnus-make-articles-unread (group articles)
11853   "Mark ARTICLES in GROUP as unread."
11854   (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
11855     (setcar (nthcdr 2 info)
11856             (gnus-remove-from-range (nth 2 info) articles))
11857     (gnus-group-update-group group t)))
11858
11859 (defun gnus-read-active-file ()
11860   "Get active file from NNTP server."
11861   (gnus-group-set-mode-line)
11862   (let ((methods (cons gnus-select-method gnus-secondary-select-methods)))
11863     (setq gnus-have-read-active-file nil)
11864     (while methods
11865       (let* ((where (nth 1 (car methods)))
11866              (mesg (format "Reading active file%s via %s..."
11867                            (if (and where (not (zerop (length where))))
11868                                (concat " from " where) "")
11869                            (car (car methods)))))
11870         (message mesg)
11871         (if (gnus-request-list (car methods)) ; Get active 
11872             (save-excursion
11873               (set-buffer nntp-server-buffer)
11874               (gnus-active-to-gnus-format 
11875                (and gnus-have-read-active-file (car methods)))
11876               (setq gnus-have-read-active-file t)
11877               (message "%s...done" mesg))
11878           (message "Cannot read active file from %s server." 
11879                    (car (car methods)))
11880           (ding)))
11881       (setq methods (cdr methods)))))
11882
11883 ;; rewritten by jwz based on ideas from Rick Sladkey <jrs@world.std.com>
11884 ;; Further rewrites by lmi.
11885 (defun gnus-active-to-gnus-format (method &optional hashtb)
11886   "Convert active file format to internal format.
11887 Lines matching `gnus-ignored-newsgroups' are ignored."
11888   (let ((cur (current-buffer))
11889         (hashtb (or hashtb 
11890                     (if method
11891                         gnus-active-hashtb
11892                       (setq gnus-active-hashtb
11893                             (gnus-make-hashtable 
11894                              (count-lines (point-min) (point-max))))))))
11895     ;; Delete unnecessary lines.
11896     (goto-char (point-min))
11897     (delete-matching-lines gnus-ignored-newsgroups)
11898     (and method (not (eq method gnus-select-method))
11899          (let ((prefix (gnus-group-prefixed-name "" method)))
11900            (goto-char (point-min))
11901            (while (and (not (eobp))
11902                        (null (insert prefix))
11903                        (zerop (forward-line 1))))))
11904     (goto-char (point-min))
11905     ;; Store active file in hashtable.
11906     (save-restriction
11907       (if (or (re-search-forward "\n.\r?$" nil t)
11908               (goto-char (point-max)))
11909           (progn
11910             (beginning-of-line)
11911             (narrow-to-region (point-min) (point))))
11912       (goto-char (point-min))
11913       (if (string-match "%[oO]" gnus-group-line-format)
11914           ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
11915           ;; If we want information on moderated groups, we use this
11916           ;; loop...   
11917           (condition-case ()
11918               (let ((mod-hashtb (make-vector 7 0))
11919                     group max mod)
11920                 (while (not (eobp))
11921                   (setq group (let ((obarray hashtb))
11922                                 (read cur)))
11923                   (setq max (read cur))
11924                   (set group (cons (read cur) max))
11925                   ;; Enter moderated groups into a list.
11926                   (if (string= 
11927                        (symbol-name  (let ((obarray mod-hashtb)) (read cur)))
11928                        "m")
11929                       (setq gnus-moderated-list 
11930                             (cons (symbol-name group) gnus-moderated-list)))
11931                   (forward-line 1)))
11932             (error 
11933              (progn (ding) (message "Possible error in active file."))))
11934         ;; And if we do not care about moderation, we use this loop,
11935         ;; which is faster.
11936         (condition-case ()
11937             (let (group max)
11938               (while (not (eobp))
11939                 ;; group gets set to a symbol interned in the hash table
11940                 ;; (what a hack!!)
11941                 (setq group (let ((obarray hashtb)) (read cur)))
11942                 (setq max (read cur))
11943                 (set group (cons (read cur) max))
11944                 (forward-line 1)))
11945           (error 
11946            (progn (ding) (message "Possible error in active file."))))))))
11947
11948 (defun gnus-read-newsrc-file (&optional force)
11949   "Read startup file.
11950 If FORCE is non-nil, the .newsrc file is read."
11951   (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
11952   ;; Reset variables that might be defined in the .newsrc.eld file.
11953   (let ((variables gnus-variable-list))
11954     (while variables
11955       (set (car variables) nil)
11956       (setq variables (cdr variables))))
11957   (let* ((newsrc-file gnus-current-startup-file)
11958          (quick-file (concat newsrc-file ".el")))
11959     (save-excursion
11960       ;; We always load the .newsrc.eld file. If always contains
11961       ;; much information that can not be gotten from the .newsrc
11962       ;; file (ticked articles, killed groups, foreign methods, etc.)
11963       (gnus-read-newsrc-el-file quick-file)
11964  
11965       (if (or force
11966               (and (file-newer-than-file-p newsrc-file quick-file)
11967                    (file-newer-than-file-p newsrc-file 
11968                                            (concat quick-file "d")))
11969               (not gnus-newsrc-assoc))
11970           ;; We read the .newsrc file. Note that if there if a
11971           ;; .newsrc.eld file exists, it has already been read, and
11972           ;; the `gnus-newsrc-hashtb' has been created. While reading
11973           ;; the .newsrc file, Gnus will only use the information it
11974           ;; can find there for changing the data already read -
11975           ;; ie. reading the .newsrc file will not trash the data
11976           ;; already read (except for read articles).
11977           (save-excursion
11978             (message "Reading %s..." newsrc-file)
11979             (set-buffer (find-file-noselect newsrc-file))
11980             (buffer-disable-undo (current-buffer))
11981             (gnus-newsrc-to-gnus-format)
11982             (kill-buffer (current-buffer))
11983             (message "Reading %s... done" newsrc-file)))
11984       (gnus-dribble-read-file))))
11985
11986 (defun gnus-read-newsrc-el-file (file)
11987   (let ((ding-file (concat file "d")))
11988     ;; We always, always read the .eld file.
11989     (message "Reading %s..." ding-file)
11990     (condition-case nil
11991         (load ding-file t t t)
11992       (error nil))
11993     (gnus-make-hashtable-from-newsrc-alist)
11994     (if (not (file-newer-than-file-p file ding-file))
11995         ()
11996       ;; Old format quick file
11997       (message "Reading %s..." file)
11998       ;; The .el file is newer than the .eld file, so we read that one
11999       ;; as well. 
12000       (gnus-read-old-newsrc-el-file file))))
12001
12002 ;; Parse the old-style quick startup file
12003 (defun gnus-read-old-newsrc-el-file (file)
12004   (let (newsrc killed marked group g m len info)
12005     (prog1
12006         (let (gnus-killed-assoc gnus-marked-assoc gnus-newsrc-assoc)
12007           (prog1
12008               (condition-case nil
12009                   (load file t t t)
12010                 (error nil))
12011             (setq newsrc gnus-newsrc-assoc
12012                   killed gnus-killed-assoc
12013                   marked gnus-marked-assoc)))
12014       (setq gnus-newsrc-assoc nil)
12015       (while newsrc
12016         (setq group (car newsrc))
12017         (let ((info (nth 2 (gnus-gethash (car group) gnus-newsrc-hashtb))))
12018           (if info
12019               (progn
12020                 (setcar (nthcdr 2 info) (cdr (cdr group)))
12021                 (setcar (cdr info) (if (nth 1 group) 3 6))
12022                 (setq gnus-newsrc-assoc (cons info gnus-newsrc-assoc)))
12023             (setq gnus-newsrc-assoc
12024                   (cons 
12025                    (setq info
12026                          (list (car group)
12027                                (if (nth 1 group) 3 6) (cdr (cdr group))))
12028                    gnus-newsrc-assoc)))
12029           (if (setq m (assoc (car group) marked))
12030             (setcdr (cdr (cdr info)) (cons (list (cons 'tick (cdr m))) nil))))
12031         (setq newsrc (cdr newsrc)))
12032       (setq newsrc killed)
12033       (while newsrc
12034         (setcar newsrc (car (car newsrc)))
12035         (setq newsrc (cdr newsrc)))
12036       (setq gnus-killed-list killed))
12037     (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
12038     (gnus-make-hashtable-from-newsrc-alist)))
12039       
12040 (defun gnus-make-newsrc-file (file)
12041   "Make server dependent file name by catenating FILE and server host name."
12042   (let* ((file (expand-file-name file nil))
12043          (real-file (concat file "-" (nth 1 gnus-select-method))))
12044     (if (file-exists-p real-file)
12045         real-file file)
12046     ))
12047
12048 ;; jwz: rewrote this function to be much more efficient, and not be subject
12049 ;; to regexp overflow errors when it encounters very long lines -- the old
12050 ;; behavior was to blow off the rest of the *file* when a line was encountered
12051 ;; that was too long to match!!  Now it uses only simple looking-at calls, and
12052 ;; doesn't create as many temporary strings.  It also now handles multiple
12053 ;; consecutive options lines (before it only handled the first.)
12054 ;; Tiny rewrite by lmi. 
12055 (defun gnus-newsrc-to-gnus-format ()
12056   "Parse current buffer as .newsrc file."
12057   ;; We have to re-initialize these variables (except for
12058   ;; gnus-killed-list) because the quick startup file may contain bogus
12059   ;; values.
12060   (setq gnus-newsrc-options nil)
12061   (setq gnus-newsrc-options-n-yes nil)
12062   (setq gnus-newsrc-options-n-no nil)
12063   (setq gnus-newsrc-assoc nil)
12064   (gnus-parse-options-lines)
12065   (gnus-parse-newsrc-body))
12066
12067 (defun gnus-parse-options-lines ()
12068   ;; newsrc.5 seems to indicate that the options line can come anywhere
12069   ;; in the file, and that there can be any number of them:
12070   ;;
12071   ;;       An  options  line  starts  with  the  word  options (left-
12072   ;;       justified).  Then there are the list of  options  just  as
12073   ;;       they would be on the readnews command line.  For instance:
12074   ;;
12075   ;;       options -n all !net.sf-lovers !mod.human-nets -r
12076   ;;       options -c -r
12077   ;;
12078   ;;       A string of lines beginning with a space or tab after  the
12079   ;;       initial  options  line  will  be  considered  continuation
12080   ;;       lines.
12081   ;;
12082   ;; For now, we only accept it at the beginning of the file.
12083
12084   (goto-char (point-min))
12085   (skip-chars-forward " \t\n")
12086   (setq gnus-newsrc-options nil)
12087   (while (looking-at "^options[ \t]*\\(.*\\)\n")
12088     ;; handle consecutive options lines
12089     (setq gnus-newsrc-options (concat gnus-newsrc-options
12090                                       (if gnus-newsrc-options "\n\t")
12091                                       (buffer-substring (match-beginning 1)
12092                                                         (match-end 1))))
12093     (forward-line 1)
12094     (while (looking-at "[ \t]+\\(.*\\)\n")
12095       ;; handle subsequent continuation lines of this options line
12096       (setq gnus-newsrc-options (concat gnus-newsrc-options "\n\t"
12097                                         (buffer-substring (match-beginning 1)
12098                                                           (match-end 1))))
12099       (forward-line 1)))
12100   ;; Gather all "-n" options lines.
12101   (let ((start 0)
12102         (result nil))
12103     (if gnus-newsrc-options
12104         (while (and (string-match "^[ \t]*-n\\([^\n]*\\)$"
12105                                   gnus-newsrc-options
12106                                   start)
12107                     (setq start (match-end 0)))
12108           (setq result (concat result
12109                                (and result " ")
12110                                (substring gnus-newsrc-options
12111                                           (match-beginning 1)
12112                                           (match-end 1))))))
12113     (let ((yes-and-no (and result (gnus-parse-n-options result))))
12114       (setq gnus-newsrc-options-n-yes (car yes-and-no))
12115       (setq gnus-newsrc-options-n-no (cdr yes-and-no)))
12116     nil))
12117
12118 (defun gnus-parse-newsrc-body ()
12119   ;; Point has been positioned after the options lines.  We shouldn't
12120   ;; see any more in here.
12121
12122   (let ((subscribe nil)
12123         (read-list nil)
12124         (line (1+ (count-lines (point-min) (point))))
12125         newsgroup
12126         p p2)
12127     (save-restriction
12128       (skip-chars-forward " \t")
12129       (while (not (eobp))
12130         (cond
12131          ((= (following-char) ?\n)
12132           ;; skip blank lines
12133           nil)
12134          (t
12135           (setq p (point))
12136           (skip-chars-forward "^:!\n")
12137           (if (= (following-char) ?\n)
12138               (error "line %d is unparsable in %s" line (buffer-name)))
12139           (setq p2 (point))
12140           (skip-chars-backward " \t")
12141
12142           ;; #### note: we could avoid consing a string here by binding obarray
12143           ;; and reading the newsgroup directly into the gnus-newsrc-hashtb,
12144           ;; then setq'ing newsgroup to symbol-name of that, like we do in
12145           ;; gnus-active-to-gnus-format.
12146           (setq newsgroup (buffer-substring p (point)))
12147           (goto-char p2)
12148
12149           (setq subscribe (= (following-char) ?:))
12150           (setq read-list nil)
12151
12152           (forward-char 1)              ; after : or !
12153           (skip-chars-forward " \t")
12154           (while (not (= (following-char) ?\n))
12155             (skip-chars-forward " \t")
12156             (or
12157              (and (cond
12158                    ((looking-at "\\([0-9]+\\)-\\([0-9]+\\)") ; a range
12159                     (setq read-list
12160                           (cons
12161                            (cons
12162                             (progn
12163                               ;; faster that buffer-substring/string-to-int
12164                               (narrow-to-region (point-min) (match-end 1))
12165                               (read (current-buffer)))
12166                             (progn
12167                               (narrow-to-region (point-min) (match-end 2))
12168                               (forward-char) ; skip over "-"
12169                               (prog1
12170                                   (read (current-buffer))
12171                                 (widen))))
12172                            read-list))
12173                     t)
12174                    ((looking-at "[0-9]+")
12175                     ;; faster that buffer-substring/string-to-int
12176                     (narrow-to-region (point-min) (match-end 0))
12177                     (setq p (read (current-buffer)))
12178                     (widen)
12179                     (setq read-list (cons (cons p p) read-list))
12180                     t)
12181                    (t
12182                     ;; bogus chars in ranges
12183                     nil))
12184                   (progn
12185                     (goto-char (match-end 0))
12186                     (skip-chars-forward " \t")
12187                     (cond ((= (following-char) ?,)
12188                            (forward-char 1)
12189                            t)
12190                           ((= (following-char) ?\n)
12191                            t)
12192                           (t
12193                            ;; bogus char after range
12194                            nil))))
12195              ;; if we get here, the parse failed
12196              (progn
12197                (end-of-line)            ; give up on this line
12198                (ding)
12199                (message "Ignoring bogus line %d for %s in %s"
12200                         line newsgroup (buffer-name))
12201                (sleep-for 1))))
12202           ;; We have already read .newsrc.eld, so we gently update the
12203           ;; data in the hash table with the information we have just
12204           ;; read. 
12205           (let ((info (nth 2 (gnus-gethash newsgroup gnus-newsrc-hashtb))))
12206             (if info
12207                 (progn
12208                   (setcar (nthcdr 2 info) (nreverse read-list))
12209                   (setcar (cdr info) (if subscribe 3 (if read-list 6 7)))
12210                   (setq gnus-newsrc-assoc (cons info gnus-newsrc-assoc)))
12211               (setq gnus-newsrc-assoc
12212                     (cons (list newsgroup (if subscribe 3 (if read-list 6 7))
12213                                 (nreverse read-list))
12214                           gnus-newsrc-assoc))))))
12215         (setq line (1+ line))
12216         (forward-line 1))))
12217   (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
12218   (gnus-make-hashtable-from-newsrc-alist)
12219   nil)
12220
12221 (defun gnus-parse-n-options (options)
12222   "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
12223   (let ((yes nil)
12224         (no nil)
12225         (yes-or-no nil)                 ;`!' or not.
12226         (newsgroup nil))
12227     ;; Parse each newsgroup description such as "comp.all".  Commas
12228     ;; and white spaces can be a newsgroup separator.
12229     (while
12230         (string-match "^[ \t\n,]*\\(!?\\)\\([^- \t\n,][^ \t\n,]*\\)" options)
12231       (setq yes-or-no
12232             (substring options (match-beginning 1) (match-end 1)))
12233       (setq newsgroup
12234             (regexp-quote
12235              (substring options
12236                         (match-beginning 2) (match-end 2))))
12237       (setq options (substring options (match-end 2)))
12238       ;; Rewrite "all" to ".+" not ".*".  ".+" requires at least one
12239       ;; character.
12240       (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
12241         (setq newsgroup
12242               (concat (substring newsgroup 0 (match-end 1))
12243                       ".+"
12244                       (substring newsgroup (match-beginning 2)))))
12245       ;; It is yes or no.
12246       (cond ((string-equal yes-or-no "!")
12247              (setq no (cons newsgroup no)))
12248             ((string-equal newsgroup ".+")) ;Ignore `all'.
12249             (t
12250              (setq yes (cons newsgroup yes))))
12251       )
12252     ;; Make a cons of regexps from parsing result.
12253     ;; We have to append \(\.\|$\) to prevent matching substring of
12254     ;; newsgroup.  For example, "jp.net" should not match with
12255     ;; "jp.network".
12256     ;; Fixes for large regexp problems are from yonezu@nak.math.keio.ac.jp.
12257     (cons (if yes
12258               (concat "^\\("
12259                       (apply (function concat)
12260                              (mapcar
12261                               (lambda (newsgroup)
12262                                 (concat newsgroup "\\|"))
12263                               (cdr yes)))
12264                       (car yes) "\\)\\(\\.\\|$\\)"))
12265           (if no
12266               (concat "^\\("
12267                       (apply (function concat)
12268                              (mapcar
12269                               (lambda (newsgroup)
12270                                 (concat newsgroup "\\|"))
12271                               (cdr no)))
12272                       (car no) "\\)\\(\\.\\|$\\)")))
12273     ))
12274
12275 (defun gnus-save-newsrc-file ()
12276   "Save .newsrc file."
12277   ;; Note: We cannot save .newsrc file if all newsgroups are removed
12278   ;; from the variable gnus-newsrc-assoc.
12279   (and (or gnus-newsrc-assoc gnus-killed-list)
12280        gnus-current-startup-file
12281        (save-excursion
12282          (if (zerop (save-excursion
12283                     (set-buffer gnus-dribble-buffer)
12284                     (buffer-size)))
12285              (message "(No changes need to be saved)")
12286            (if gnus-save-newsrc-file
12287                (let ((make-backup-files t)
12288                      (version-control nil)
12289                      (require-final-newline t)) ;Don't ask even if requested.
12290                  (message "Saving %s..." gnus-current-startup-file)
12291                  ;; Make backup file of master newsrc.
12292                  ;; You can stop or change version control of backup file.
12293                  ;; Suggested by jason@violet.berkeley.edu.
12294                  (run-hooks 'gnus-save-newsrc-hook)
12295                  (gnus-gnus-to-newsrc-format)
12296                  (message "Saving %s... done" gnus-current-startup-file)))
12297            ;; Quickly loadable .newsrc.
12298            (set-buffer (get-buffer-create " *Gnus-newsrc*"))
12299            (gnus-add-current-to-buffer-list)
12300            (buffer-disable-undo (current-buffer))
12301            (erase-buffer)
12302            (message "Saving %s.eld..." gnus-current-startup-file)
12303            (gnus-gnus-to-quick-newsrc-format)
12304            (let ((make-backup-files nil)
12305                  (version-control nil)
12306                  (require-final-newline t)) ;Don't ask even if requested.
12307              (write-region 1 (point-max) 
12308                            (concat gnus-current-startup-file ".eld") 
12309                            nil 'nomesg))
12310            (kill-buffer (current-buffer))
12311            (message "Saving %s.eld... done" gnus-current-startup-file)
12312            (gnus-dribble-delete-file)))))
12313
12314 (defun gnus-gnus-to-quick-newsrc-format ()
12315   "Insert Gnus variables such as gnus-newsrc-assoc in lisp format."
12316   (insert ";; (ding) Gnus startup file.\n")
12317   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
12318   (insert ";; to read .newsrc.\n")
12319   (let ((variables gnus-variable-list)
12320         (gnus-newsrc-assoc (cdr gnus-newsrc-assoc))
12321         variable)
12322     ;; insert lisp expressions.
12323     (while variables
12324       (setq variable (car variables))
12325       (and (boundp variable)
12326            (symbol-value variable)
12327            (or gnus-save-killed-list (not (eq variable 'gnus-killed-list)))
12328            (insert "(setq " (symbol-name variable) " '"
12329                    (prin1-to-string (symbol-value variable))
12330                    ")\n"))
12331       (setq variables (cdr variables)))))
12332
12333 (defun gnus-gnus-to-newsrc-format ()
12334   ;; Generate and save the .newsrc file.
12335   (let ((newsrc (cdr gnus-newsrc-assoc))
12336         info ranges range)
12337     (save-excursion
12338       (set-buffer (create-file-buffer gnus-startup-file))
12339       (buffer-disable-undo (current-buffer))
12340       (erase-buffer)
12341       ;; Write options.
12342       (if gnus-newsrc-options (insert "options " gnus-newsrc-options "\n"))
12343       ;; Write subscribed and unsubscribed.
12344       (while newsrc
12345         (setq info (car newsrc))
12346         (if (not (nth 4 info))          ;Don't write foreign groups to .newsrc.
12347             (progn
12348               (insert (car info) (if (>= (nth 1 info) 6) "!" ":"))
12349               (if (setq ranges (nth 2 info))
12350                   (progn
12351                     (insert " ")
12352                     (if (atom (car ranges))
12353                         (if (= (car ranges) (cdr ranges))
12354                             (insert (int-to-string (car ranges)))
12355                           (insert (int-to-string (car ranges)) "-" 
12356                                   (int-to-string (cdr ranges))))
12357                       (while ranges
12358                         (setq range (car ranges)
12359                               ranges (cdr ranges))
12360                         (if (= (car range) (cdr range))
12361                             (insert (int-to-string (car range)))
12362                           (insert (int-to-string (car range)) "-"
12363                                   (int-to-string (cdr range))))
12364                         (if ranges (insert ","))))))
12365               (insert "\n")))
12366         (setq newsrc (cdr newsrc)))
12367       (write-region 1 (point-max) gnus-current-startup-file nil 'nomesg)
12368       (kill-buffer (current-buffer)))))
12369
12370 (defun gnus-read-descriptions-file ()
12371   (message "Reading descriptions file...")
12372   (if (not (gnus-request-list-newsgroups gnus-select-method))
12373       (progn
12374         (message "Couldn't read newsgroups descriptions")
12375         nil)
12376     (let (group)
12377       (setq gnus-description-hashtb 
12378             (gnus-make-hashtable (length gnus-active-hashtb)))
12379       (save-excursion
12380         (save-restriction
12381           (set-buffer nntp-server-buffer)
12382           (goto-char (point-min))
12383           (delete-non-matching-lines "^[a-zA-Z\\.0-9]+[ \t]")
12384           (goto-char (point-min))
12385           (if (or (search-forward "\n.\n" nil t)
12386                   (goto-char (point-max)))
12387               (progn
12388                 (beginning-of-line)
12389                 (narrow-to-region (point-min) (point))))
12390           (goto-char (point-min))
12391           (while (not (eobp))
12392             (setq group (let ((obarray gnus-description-hashtb))
12393                           (read (current-buffer))))
12394             (skip-chars-forward " \t")
12395             (set group (buffer-substring 
12396                         (point) (save-excursion (end-of-line) (point))))
12397             (forward-line 1))))
12398       (message "Reading descriptions file...done")
12399       t)))
12400
12401 (provide 'gnus)
12402
12403 ;;; gnus.el ends here