*** empty log message ***
[gnus] / lisp / gnus.el
1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29 (eval '(run-hooks 'gnus-load-hook))
30
31 (require 'mail-utils)
32 (require 'timezone)
33 (require 'nnheader)
34 (require 'nnmail)
35 (require 'nnoo)
36
37 (eval-when-compile (require 'cl))
38
39 (defvar gnus-directory (or (getenv "SAVEDIR") "~/News/")
40   "*Directory variable from which all other Gnus file variables are derived.")
41
42 ;; Site dependent variables.  These variables should be defined in
43 ;; paths.el.
44
45 (defvar gnus-default-nntp-server nil
46   "Specify a default NNTP server.
47 This variable should be defined in paths.el, and should never be set
48 by the user.
49 If you want to change servers, you should use `gnus-select-method'.
50 See the documentation to that variable.")
51
52 (defvar gnus-backup-default-subscribed-newsgroups
53   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
54   "Default default new newsgroups the first time Gnus is run.
55 Should be set in paths.el, and shouldn't be touched by the user.")
56
57 (defvar gnus-local-domain nil
58   "Local domain name without a host name.
59 The DOMAINNAME environment variable is used instead if it is defined.
60 If the `system-name' function returns the full Internet name, there is
61 no need to set this variable.")
62
63 (defvar gnus-local-organization nil
64   "String with a description of what organization (if any) the user belongs to.
65 The ORGANIZATION environment variable is used instead if it is defined.
66 If this variable contains a function, this function will be called
67 with the current newsgroup name as the argument.  The function should
68 return a string.
69
70 In any case, if the string (either in the variable, in the environment
71 variable, or returned by the function) is a file name, the contents of
72 this file will be used as the organization.")
73
74 ;; Customization variables
75
76 ;; Don't touch this variable.
77 (defvar gnus-nntp-service "nntp"
78   "*NNTP service name (\"nntp\" or 119).
79 This is an obsolete variable, which is scarcely used.  If you use an
80 nntp server for your newsgroup and want to change the port number
81 used to 899, you would say something along these lines:
82
83  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
84
85 (defvar gnus-nntpserver-file "/etc/nntpserver"
86   "*A file with only the name of the nntp server in it.")
87
88 ;; This function is used to check both the environment variable
89 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
90 ;; an nntp server name default.
91 (defun gnus-getenv-nntpserver ()
92   (or (getenv "NNTPSERVER")
93       (and (file-readable-p gnus-nntpserver-file)
94            (save-excursion
95              (set-buffer (get-buffer-create " *gnus nntp*"))
96              (buffer-disable-undo (current-buffer))
97              (insert-file-contents gnus-nntpserver-file)
98              (let ((name (buffer-string)))
99                (prog1
100                    (if (string-match "^[ \t\n]*$" name)
101                        nil
102                      name)
103                  (kill-buffer (current-buffer))))))))
104
105 (defvar gnus-select-method
106   (nconc
107    (list 'nntp (or (condition-case ()
108                        (gnus-getenv-nntpserver)
109                      (error nil))
110                    (if (and gnus-default-nntp-server
111                             (not (string= gnus-default-nntp-server "")))
112                        gnus-default-nntp-server)
113                    (system-name)))
114    (if (or (null gnus-nntp-service)
115            (equal gnus-nntp-service "nntp"))
116        nil
117      (list gnus-nntp-service)))
118   "*Default method for selecting a newsgroup.
119 This variable should be a list, where the first element is how the
120 news is to be fetched, the second is the address.
121
122 For instance, if you want to get your news via NNTP from
123 \"flab.flab.edu\", you could say:
124
125 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
126
127 If you want to use your local spool, say:
128
129 (setq gnus-select-method (list 'nnspool (system-name)))
130
131 If you use this variable, you must set `gnus-nntp-server' to nil.
132
133 There is a lot more to know about select methods and virtual servers -
134 see the manual for details.")
135
136 (defvar gnus-message-archive-method 
137   `(nnfolder
138     "archive"
139     (nnfolder-directory ,(nnheader-concat message-directory "archive"))
140     (nnfolder-active-file 
141      ,(nnheader-concat message-directory "archive/active"))
142     (nnfolder-get-new-mail nil)
143     (nnfolder-inhibit-expiry t))
144   "*Method used for archiving messages you've sent.
145 This should be a mail method.
146
147 It's probably not a very effective to change this variable once you've
148 run Gnus once.  After doing that, you must edit this server from the
149 server buffer.")
150
151 (defvar gnus-message-archive-group nil
152   "*Name of the group in which to save the messages you've written.
153 This can either be a string, a list of strings; or an alist
154 of regexps/functions/forms to be evaluated to return a string (or a list
155 of strings).  The functions are called with the name of the current
156 group (or nil) as a parameter.
157
158 If you want to save your mail in one group and the news articles you
159 write in another group, you could say something like:
160
161  \(setq gnus-message-archive-group 
162         '((if (message-news-p)
163               \"misc-news\" 
164             \"misc-mail\")))
165
166 Normally the group names returned by this variable should be
167 unprefixed -- which implictly means \"store on the archive server\".
168 However, you may wish to store the message on some other server.  In
169 that case, just return a fully prefixed name of the group --
170 \"nnml+private:mail.misc\", for instance.")
171
172 (defvar gnus-refer-article-method nil
173   "*Preferred method for fetching an article by Message-ID.
174 If you are reading news from the local spool (with nnspool), fetching
175 articles by Message-ID is painfully slow.  By setting this method to an
176 nntp method, you might get acceptable results.
177
178 The value of this variable must be a valid select method as discussed
179 in the documentation of `gnus-select-method'.")
180
181 (defvar gnus-secondary-select-methods nil
182   "*A list of secondary methods that will be used for reading news.
183 This is a list where each element is a complete select method (see
184 `gnus-select-method').
185
186 If, for instance, you want to read your mail with the nnml backend,
187 you could set this variable:
188
189 (setq gnus-secondary-select-methods '((nnml \"\")))")
190
191 (defvar gnus-secondary-servers nil
192   "*List of NNTP servers that the user can choose between interactively.
193 To make Gnus query you for a server, you have to give `gnus' a
194 non-numeric prefix - `C-u M-x gnus', in short.")
195
196 (defvar gnus-nntp-server nil
197   "*The name of the host running the NNTP server.
198 This variable is semi-obsolete.  Use the `gnus-select-method'
199 variable instead.")
200
201 (defvar gnus-startup-file "~/.newsrc"
202   "*Your `.newsrc' file.
203 `.newsrc-SERVER' will be used instead if that exists.")
204
205 (defvar gnus-init-file "~/.gnus"
206   "*Your Gnus elisp startup file.
207 If a file with the .el or .elc suffixes exist, it will be read
208 instead.")
209
210 (defvar gnus-group-faq-directory
211   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
212     "/ftp@sunsite.auc.dk:/pub/usenet/"
213     "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
214     "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
215     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
216     "/ftp@rtfm.mit.edu:/pub/usenet/"
217     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
218     "/ftp@ftp.sunet.se:/pub/usenet/"
219     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
220     "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
221     "/ftp@ftp.hk.super.net:/mirror/faqs/")
222   "*Directory where the group FAQs are stored.
223 This will most commonly be on a remote machine, and the file will be
224 fetched by ange-ftp.
225
226 This variable can also be a list of directories.  In that case, the
227 first element in the list will be used by default.  The others can
228 be used when being prompted for a site.
229
230 Note that Gnus uses an aol machine as the default directory.  If this
231 feels fundamentally unclean, just think of it as a way to finally get
232 something of value back from them.
233
234 If the default site is too slow, try one of these:
235
236    North America: mirrors.aol.com                /pub/rtfm/usenet
237                   ftp.seas.gwu.edu               /pub/rtfm
238                   rtfm.mit.edu                   /pub/usenet
239    Europe:        ftp.uni-paderborn.de           /pub/FAQ
240                   src.doc.ic.ac.uk               /usenet/news-FAQS
241                   ftp.sunet.se                   /pub/usenet
242                   sunsite.auc.dk                 /pub/usenet
243    Asia:          nctuccca.edu.tw                /USENET/FAQ
244                   hwarang.postech.ac.kr          /pub/usenet
245                   ftp.hk.super.net               /mirror/faqs")
246
247 (defvar gnus-group-archive-directory
248   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
249   "*The address of the (ding) archives.")
250
251 (defvar gnus-group-recent-archive-directory
252   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
253   "*The address of the most recent (ding) articles.")
254
255 (defvar gnus-default-subscribed-newsgroups nil
256   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
257 It should be a list of strings.
258 If it is `t', Gnus will not do anything special the first time it is
259 started; it'll just use the normal newsgroups subscription methods.")
260
261 (defvar gnus-use-cross-reference t
262   "*Non-nil means that cross referenced articles will be marked as read.
263 If nil, ignore cross references.  If t, mark articles as read in
264 subscribed newsgroups.  If neither t nor nil, mark as read in all
265 newsgroups.")
266
267 (defvar gnus-single-article-buffer t
268   "*If non-nil, display all articles in the same buffer.
269 If nil, each group will get its own article buffer.")
270
271 (defvar gnus-use-dribble-file t
272   "*Non-nil means that Gnus will use a dribble file to store user updates.
273 If Emacs should crash without saving the .newsrc files, complete
274 information can be restored from the dribble file.")
275
276 (defvar gnus-dribble-directory nil
277   "*The directory where dribble files will be saved.
278 If this variable is nil, the directory where the .newsrc files are
279 saved will be used.")
280
281 (defvar gnus-asynchronous nil
282   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
283
284 (defvar gnus-kill-summary-on-exit t
285   "*If non-nil, kill the summary buffer when you exit from it.
286 If nil, the summary will become a \"*Dead Summary*\" buffer, and
287 it will be killed sometime later.")
288
289 (defvar gnus-large-newsgroup 200
290   "*The number of articles which indicates a large newsgroup.
291 If the number of articles in a newsgroup is greater than this value,
292 confirmation is required for selecting the newsgroup.")
293
294 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
295 (defvar gnus-no-groups-message "No news is horrible news"
296   "*Message displayed by Gnus when no groups are available.")
297
298 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
299   "*Non-nil means that the default name of a file to save articles in is the group name.
300 If it's nil, the directory form of the group name is used instead.
301
302 If this variable is a list, and the list contains the element
303 `not-score', long file names will not be used for score files; if it
304 contains the element `not-save', long file names will not be used for
305 saving; and if it contains the element `not-kill', long file names
306 will not be used for kill files.
307
308 Note that the default for this variable varies according to what system
309 type you're using.  On `usg-unix-v' and `xenix' this variable defaults
310 to nil while on all other systems it defaults to t.")
311
312 (defvar gnus-article-save-directory gnus-directory
313   "*Name of the directory articles will be saved in (default \"~/News\").")
314
315 (defvar gnus-kill-files-directory gnus-directory
316   "*Name of the directory where kill files will be stored (default \"~/News\").")
317
318 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
319   "*A function to save articles in your favorite format.
320 The function must be interactively callable (in other words, it must
321 be an Emacs command).
322
323 Gnus provides the following functions:
324
325 * gnus-summary-save-in-rmail (Rmail format)
326 * gnus-summary-save-in-mail (Unix mail format)
327 * gnus-summary-save-in-folder (MH folder)
328 * gnus-summary-save-in-file (article format).
329 * gnus-summary-save-in-vm (use VM's folder format).")
330
331 (defvar gnus-prompt-before-saving 'always
332   "*This variable says how much prompting is to be done when saving articles.
333 If it is nil, no prompting will be done, and the articles will be
334 saved to the default files.  If this variable is `always', each and
335 every article that is saved will be preceded by a prompt, even when
336 saving large batches of articles.  If this variable is neither nil not
337 `always', there the user will be prompted once for a file name for
338 each invocation of the saving commands.")
339
340 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
341   "*A function generating a file name to save articles in Rmail format.
342 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
343
344 (defvar gnus-mail-save-name (function gnus-plain-save-name)
345   "*A function generating a file name to save articles in Unix mail format.
346 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
347
348 (defvar gnus-folder-save-name (function gnus-folder-save-name)
349   "*A function generating a file name to save articles in MH folder.
350 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
351
352 (defvar gnus-file-save-name (function gnus-numeric-save-name)
353   "*A function generating a file name to save articles in article format.
354 The function is called with NEWSGROUP, HEADERS, and optional
355 LAST-FILE.")
356
357 (defvar gnus-split-methods
358   '((gnus-article-archive-name))
359   "*Variable used to suggest where articles are to be saved.
360 For instance, if you would like to save articles related to Gnus in
361 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
362 you could set this variable to something like:
363
364  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
365    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
366
367 This variable is an alist where the where the key is the match and the
368 value is a list of possible files to save in if the match is non-nil.
369
370 If the match is a string, it is used as a regexp match on the
371 article.  If the match is a symbol, that symbol will be funcalled
372 from the buffer of the article to be saved with the newsgroup as the
373 parameter.  If it is a list, it will be evaled in the same buffer.
374
375 If this form or function returns a string, this string will be used as
376 a possible file name; and if it returns a non-nil list, that list will
377 be used as possible file names.")
378
379 (defvar gnus-move-split-methods nil
380   "*Variable used to suggest where articles are to be moved to.
381 It uses the same syntax as the `gnus-split-methods' variable.")
382
383 (defvar gnus-save-score nil
384   "*If non-nil, save group scoring info.")
385
386 (defvar gnus-use-adaptive-scoring nil
387   "*If non-nil, use some adaptive scoring scheme.")
388
389 (defvar gnus-use-cache 'passive
390   "*If nil, Gnus will ignore the article cache.
391 If `passive', it will allow entering (and reading) articles
392 explicitly entered into the cache.  If anything else, use the
393 cache to the full extent of the law.")
394
395 (defvar gnus-use-trees nil
396   "*If non-nil, display a thread tree buffer.")
397
398 (defvar gnus-use-grouplens nil
399   "*If non-nil, use GroupLens ratings.")
400
401 (defvar gnus-keep-backlog nil
402   "*If non-nil, Gnus will keep read articles for later re-retrieval.
403 If it is a number N, then Gnus will only keep the last N articles
404 read.  If it is neither nil nor a number, Gnus will keep all read
405 articles.  This is not a good idea.")
406
407 (defvar gnus-use-nocem nil
408   "*If non-nil, Gnus will read NoCeM cancel messages.")
409
410 (defvar gnus-use-demon nil
411   "If non-nil, Gnus might use some demons.")
412
413 (defvar gnus-use-scoring t
414   "*If non-nil, enable scoring.")
415
416 (defvar gnus-use-picons nil
417   "*If non-nil, display picons.")
418
419 (defvar gnus-fetch-old-headers nil
420   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
421 If an unread article in the group refers to an older, already read (or
422 just marked as read) article, the old article will not normally be
423 displayed in the Summary buffer.  If this variable is non-nil, Gnus
424 will attempt to grab the headers to the old articles, and thereby
425 build complete threads.  If it has the value `some', only enough
426 headers to connect otherwise loose threads will be displayed.
427 This variable can also be a number.  In that case, no more than that
428 number of old headers will be fetched.
429
430 The server has to support NOV for any of this to work.")
431
432 ;see gnus-cus.el
433 ;(defvar gnus-visual t
434 ;  "*If non-nil, will do various highlighting.
435 ;If nil, no mouse highlights (or any other highlights) will be
436 ;performed.  This might speed up Gnus some when generating large group
437 ;and summary buffers.")
438
439 (defvar gnus-novice-user t
440   "*Non-nil means that you are a usenet novice.
441 If non-nil, verbose messages may be displayed and confirmations may be
442 required.")
443
444 (defvar gnus-expert-user nil
445   "*Non-nil means that you will never be asked for confirmation about anything.
446 And that means *anything*.")
447
448 (defvar gnus-verbose 7
449   "*Integer that says how verbose Gnus should be.
450 The higher the number, the more messages Gnus will flash to say what
451 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
452 display most important messages; and at ten, Gnus will keep on
453 jabbering all the time.")
454
455 (defvar gnus-keep-same-level nil
456   "*Non-nil means that the next newsgroup after the current will be on the same level.
457 When you type, for instance, `n' after reading the last article in the
458 current newsgroup, you will go to the next newsgroup.  If this variable
459 is nil, the next newsgroup will be the next from the group
460 buffer.
461 If this variable is non-nil, Gnus will either put you in the
462 next newsgroup with the same level, or, if no such newsgroup is
463 available, the next newsgroup with the lowest possible level higher
464 than the current level.
465 If this variable is `best', Gnus will make the next newsgroup the one
466 with the best level.")
467
468 (defvar gnus-summary-make-false-root 'adopt
469   "*nil means that Gnus won't gather loose threads.
470 If the root of a thread has expired or been read in a previous
471 session, the information necessary to build a complete thread has been
472 lost.  Instead of having many small sub-threads from this original thread
473 scattered all over the summary buffer, Gnus can gather them.
474
475 If non-nil, Gnus will try to gather all loose sub-threads from an
476 original thread into one large thread.
477
478 If this variable is non-nil, it should be one of `none', `adopt',
479 `dummy' or `empty'.
480
481 If this variable is `none', Gnus will not make a false root, but just
482 present the sub-threads after another.
483 If this variable is `dummy', Gnus will create a dummy root that will
484 have all the sub-threads as children.
485 If this variable is `adopt', Gnus will make one of the \"children\"
486 the parent and mark all the step-children as such.
487 If this variable is `empty', the \"children\" are printed with empty
488 subject fields.  (Or rather, they will be printed with a string
489 given by the `gnus-summary-same-subject' variable.)")
490
491 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
492   "*A regexp to match subjects to be excluded from loose thread gathering.
493 As loose thread gathering is done on subjects only, that means that
494 there can be many false gatherings performed.  By rooting out certain
495 common subjects, gathering might become saner.")
496
497 (defvar gnus-summary-gather-subject-limit nil
498   "*Maximum length of subject comparisons when gathering loose threads.
499 Use nil to compare full subjects.  Setting this variable to a low
500 number will help gather threads that have been corrupted by
501 newsreaders chopping off subject lines, but it might also mean that
502 unrelated articles that have subject that happen to begin with the
503 same few characters will be incorrectly gathered.
504
505 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
506 comparing subjects.")
507
508 (defvar gnus-simplify-ignored-prefixes nil
509   "*Regexp, matches for which are removed from subject lines when simplifying fuzzily.")
510
511 (defvar gnus-build-sparse-threads nil
512   "*If non-nil, fill in the gaps in threads.
513 If `some', only fill in the gaps that are needed to tie loose threads
514 together.  If `more', fill in all leaf nodes that Gnus can find.  If
515 non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
516
517 (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
518   "Function used for gathering loose threads.
519 There are two pre-defined functions: `gnus-gather-threads-by-subject',
520 which only takes Subjects into consideration; and
521 `gnus-gather-threads-by-references', which compared the References
522 headers of the articles to find matches.")
523
524 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
525 (defvar gnus-summary-same-subject ""
526   "*String indicating that the current article has the same subject as the previous.
527 This variable will only be used if the value of
528 `gnus-summary-make-false-root' is `empty'.")
529
530 (defvar gnus-summary-goto-unread t
531   "*If non-nil, marking commands will go to the next unread article.
532 If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
533 whether it is read or not.")
534
535 (defvar gnus-group-goto-unread t
536   "*If non-nil, movement commands will go to the next unread and subscribed group.")
537
538 (defvar gnus-goto-next-group-when-activating t
539   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
540
541 (defvar gnus-check-new-newsgroups t
542   "*Non-nil means that Gnus will run gnus-find-new-newsgroups at startup.
543 This normally finds new newsgroups by comparing the active groups the
544 servers have already reported with those Gnus already knows, either alive
545 or killed.
546
547 When any of the following are true, gnus-find-new-newsgroups will instead
548 ask the servers (primary, secondary, and archive servers) to list new
549 groups since the last time it checked:
550   1. This variable is `ask-server'.
551   2. This variable is a list of select methods (see below).
552   3. `gnus-read-active-file' is nil or `some'.
553   4. A prefix argument is given to gnus-find-new-newsgroups interactively.
554
555 Thus, if this variable is `ask-server' or a list of select methods or
556 `gnus-read-active-file' is nil or `some', then the killed list is no
557 longer necessary, so you could safely set `gnus-save-killed-list' to nil.
558
559 This variable can be a list of select methods which Gnus will query with
560 the `ask-server' method in addition to the primary, secondary, and archive
561 servers.
562
563 Eg.
564   (setq gnus-check-new-newsgroups
565         '((nntp \"some.server\") (nntp \"other.server\")))
566
567 If this variable is nil, then you have to tell Gnus explicitly to
568 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
569
570 (defvar gnus-check-bogus-newsgroups nil
571   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
572 If this variable is nil, then you have to tell Gnus explicitly to
573 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
574
575 (defvar gnus-read-active-file t
576   "*Non-nil means that Gnus will read the entire active file at startup.
577 If this variable is nil, Gnus will only know about the groups in your
578 `.newsrc' file.
579
580 If this variable is `some', Gnus will try to only read the relevant
581 parts of the active file from the server.  Not all servers support
582 this, and it might be quite slow with other servers, but this should
583 generally be faster than both the t and nil value.
584
585 If you set this variable to nil or `some', you probably still want to
586 be told about new newsgroups that arrive.  To do that, set
587 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
588 properly with all servers.")
589
590 (defvar gnus-level-subscribed 5
591   "*Groups with levels less than or equal to this variable are subscribed.")
592
593 (defvar gnus-level-unsubscribed 7
594   "*Groups with levels less than or equal to this variable are unsubscribed.
595 Groups with levels less than `gnus-level-subscribed', which should be
596 less than this variable, are subscribed.")
597
598 (defvar gnus-level-zombie 8
599   "*Groups with this level are zombie groups.")
600
601 (defvar gnus-level-killed 9
602   "*Groups with this level are killed.")
603
604 (defvar gnus-level-default-subscribed 3
605   "*New subscribed groups will be subscribed at this level.")
606
607 (defvar gnus-level-default-unsubscribed 6
608   "*New unsubscribed groups will be unsubscribed at this level.")
609
610 (defvar gnus-activate-level (1+ gnus-level-subscribed)
611   "*Groups higher than this level won't be activated on startup.
612 Setting this variable to something log might save lots of time when
613 you have many groups that you aren't interested in.")
614
615 (defvar gnus-activate-foreign-newsgroups 4
616   "*If nil, Gnus will not check foreign newsgroups at startup.
617 If it is non-nil, it should be a number between one and nine.  Foreign
618 newsgroups that have a level lower or equal to this number will be
619 activated on startup.  For instance, if you want to active all
620 subscribed newsgroups, but not the rest, you'd set this variable to
621 `gnus-level-subscribed'.
622
623 If you subscribe to lots of newsgroups from different servers, startup
624 might take a while.  By setting this variable to nil, you'll save time,
625 but you won't be told how many unread articles there are in the
626 groups.")
627
628 (defvar gnus-save-newsrc-file t
629   "*Non-nil means that Gnus will save the `.newsrc' file.
630 Gnus always saves its own startup file, which is called
631 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
632 be readily understood by other newsreaders.  If you don't plan on
633 using other newsreaders, set this variable to nil to save some time on
634 exit.")
635
636 (defvar gnus-save-killed-list t
637   "*If non-nil, save the list of killed groups to the startup file.
638 If you set this variable to nil, you'll save both time (when starting
639 and quitting) and space (both memory and disk), but it will also mean
640 that Gnus has no record of which groups are new and which are old, so
641 the automatic new newsgroups subscription methods become meaningless.
642
643 You should always set `gnus-check-new-newsgroups' to `ask-server' or
644 nil if you set this variable to nil.")
645
646 (defvar gnus-interactive-catchup t
647   "*If non-nil, require your confirmation when catching up a group.")
648
649 (defvar gnus-interactive-exit t
650   "*If non-nil, require your confirmation when exiting Gnus.")
651
652 (defvar gnus-kill-killed t
653   "*If non-nil, Gnus will apply kill files to already killed articles.
654 If it is nil, Gnus will never apply kill files to articles that have
655 already been through the scoring process, which might very well save lots
656 of time.")
657
658 (defvar gnus-extract-address-components 'gnus-extract-address-components
659   "*Function for extracting address components from a From header.
660 Two pre-defined function exist: `gnus-extract-address-components',
661 which is the default, quite fast, and too simplistic solution, and
662 `mail-extract-address-components', which works much better, but is
663 slower.")
664
665 (defvar gnus-summary-default-score 0
666   "*Default article score level.
667 If this variable is nil, scoring will be disabled.")
668
669 (defvar gnus-summary-zcore-fuzz 0
670   "*Fuzziness factor for the zcore in the summary buffer.
671 Articles with scores closer than this to `gnus-summary-default-score'
672 will not be marked.")
673
674 (defvar gnus-simplify-subject-fuzzy-regexp nil
675   "*Strings to be removed when doing fuzzy matches.
676 This can either be a regular expression or list of regular expressions
677 that will be removed from subject strings if fuzzy subject
678 simplification is selected.")
679
680 (defvar gnus-permanently-visible-groups nil
681   "*Regexp to match groups that should always be listed in the group buffer.
682 This means that they will still be listed when there are no unread
683 articles in the groups.")
684
685 (defvar gnus-list-groups-with-ticked-articles t
686   "*If non-nil, list groups that have only ticked articles.
687 If nil, only list groups that have unread articles.")
688
689 (defvar gnus-group-default-list-level gnus-level-subscribed
690   "*Default listing level.
691 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
692
693 (defvar gnus-group-use-permanent-levels nil
694   "*If non-nil, once you set a level, Gnus will use this level.")
695
696 (defvar gnus-group-list-inactive-groups t
697   "*If non-nil, inactive groups will be listed.")
698
699 (defvar gnus-show-mime nil
700   "*If non-nil, do mime processing of articles.
701 The articles will simply be fed to the function given by
702 `gnus-show-mime-method'.")
703
704 (defvar gnus-strict-mime t
705   "*If nil, MIME-decode even if there is no Mime-Version header in the article.")
706
707 (defvar gnus-show-mime-method 'metamail-buffer
708   "*Function to process a MIME message.
709 The function is called from the article buffer.")
710
711 (defvar gnus-decode-encoded-word-method (lambda ())
712   "*Function to decode a MIME encoded-words.
713 The function is called from the article buffer.")
714
715 (defvar gnus-show-threads t
716   "*If non-nil, display threads in summary mode.")
717
718 (defvar gnus-thread-hide-subtree nil
719   "*If non-nil, hide all threads initially.
720 If threads are hidden, you have to run the command
721 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
722 to expose hidden threads.")
723
724 (defvar gnus-thread-hide-killed t
725   "*If non-nil, hide killed threads automatically.")
726
727 (defvar gnus-thread-ignore-subject nil
728   "*If non-nil, ignore subjects and do all threading based on the Reference header.
729 If nil, which is the default, articles that have different subjects
730 from their parents will start separate threads.")
731
732 (defvar gnus-thread-operation-ignore-subject t
733   "*If non-nil, subjects will be ignored when doing thread commands.
734 This affects commands like `gnus-summary-kill-thread' and
735 `gnus-summary-lower-thread'.
736
737 If this variable is nil, articles in the same thread with different
738 subjects will not be included in the operation in question.  If this
739 variable is `fuzzy', only articles that have subjects that are fuzzily
740 equal will be included.")
741
742 (defvar gnus-thread-indent-level 4
743   "*Number that says how much each sub-thread should be indented.")
744
745 (defvar gnus-ignored-newsgroups
746   (purecopy (mapconcat 'identity
747                        '("^to\\."       ; not "real" groups
748                          "^[0-9. \t]+ " ; all digits in name
749                          "[][\"#'()]"   ; bogus characters
750                          )
751                        "\\|"))
752   "*A regexp to match uninteresting newsgroups in the active file.
753 Any lines in the active file matching this regular expression are
754 removed from the newsgroup list before anything else is done to it,
755 thus making them effectively non-existent.")
756
757 (defvar gnus-ignored-headers
758   "^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:"
759   "*All headers that match this regexp will be hidden.
760 This variable can also be a list of regexps of headers to be ignored.
761 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
762
763 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
764   "*All headers that do not match this regexp will be hidden.
765 This variable can also be a list of regexp of headers to remain visible.
766 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
767
768 (defvar gnus-sorted-header-list
769   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
770     "^Cc:" "^Date:" "^Organization:")
771   "*This variable is a list of regular expressions.
772 If it is non-nil, headers that match the regular expressions will
773 be placed first in the article buffer in the sequence specified by
774 this list.")
775
776 (defvar gnus-boring-article-headers
777   '(empty followup-to reply-to)
778   "*Headers that are only to be displayed if they have interesting data.
779 Possible values in this list are `empty', `newsgroups', `followup-to',
780 `reply-to', and `date'.")
781
782 (defvar gnus-show-all-headers nil
783   "*If non-nil, don't hide any headers.")
784
785 (defvar gnus-save-all-headers t
786   "*If non-nil, don't remove any headers before saving.")
787
788 (defvar gnus-saved-headers gnus-visible-headers
789   "*Headers to keep if `gnus-save-all-headers' is nil.
790 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
791 If that variable is nil, however, all headers that match this regexp
792 will be kept while the rest will be deleted before saving.")
793
794 (defvar gnus-inhibit-startup-message nil
795   "*If non-nil, the startup message will not be displayed.")
796
797 (defvar gnus-signature-separator "^-- *$"
798   "Regexp matching signature separator.")
799
800 (defvar gnus-signature-limit nil
801   "Provide a limit to what is considered a signature.
802 If it is a number, no signature may not be longer (in characters) than
803 that number.  If it is a function, the function will be called without
804 any parameters, and if it returns nil, there is no signature in the
805 buffer.  If it is a string, it will be used as a regexp.  If it
806 matches, the text in question is not a signature.")
807
808 (defvar gnus-auto-extend-newsgroup t
809   "*If non-nil, extend newsgroup forward and backward when requested.")
810
811 (defvar gnus-auto-select-first t
812   "*If nil, don't select the first unread article when entering a group.
813 If this variable is `best', select the highest-scored unread article
814 in the group.  If neither nil nor `best', select the first unread
815 article.
816
817 If you want to prevent automatic selection of the first unread article
818 in some newsgroups, set the variable to nil in
819 `gnus-select-group-hook'.")
820
821 (defvar gnus-auto-select-next t
822   "*If non-nil, offer to go to the next group from the end of the previous.
823 If the value is t and the next newsgroup is empty, Gnus will exit
824 summary mode and go back to group mode.  If the value is neither nil
825 nor t, Gnus will select the following unread newsgroup.  In
826 particular, if the value is the symbol `quietly', the next unread
827 newsgroup will be selected without any confirmation, and if it is
828 `almost-quietly', the next group will be selected without any
829 confirmation if you are located on the last article in the group.
830 Finally, if this variable is `slightly-quietly', the `Z n' command
831 will go to the next group without confirmation.")
832
833 (defvar gnus-auto-select-same nil
834   "*If non-nil, select the next article with the same subject.")
835
836 (defvar gnus-summary-check-current nil
837   "*If non-nil, consider the current article when moving.
838 The \"unread\" movement commands will stay on the same line if the
839 current article is unread.")
840
841 (defvar gnus-auto-center-summary t
842   "*If non-nil, always center the current summary buffer.
843 In particular, if `vertical' do only vertical recentering.  If non-nil
844 and non-`vertical', do both horizontal and vertical recentering.")
845
846 (defvar gnus-break-pages t
847   "*If non-nil, do page breaking on articles.
848 The page delimiter is specified by the `gnus-page-delimiter'
849 variable.")
850
851 (defvar gnus-page-delimiter "^\^L"
852   "*Regexp describing what to use as article page delimiters.
853 The default value is \"^\^L\", which is a form linefeed at the
854 beginning of a line.")
855
856 (defvar gnus-use-full-window t
857   "*If non-nil, use the entire Emacs screen.")
858
859 (defvar gnus-window-configuration nil
860   "Obsolete variable.  See `gnus-buffer-configuration'.")
861
862 (defvar gnus-window-min-width 2
863   "*Minimum width of Gnus buffers.")
864
865 (defvar gnus-window-min-height 1
866   "*Minimum height of Gnus buffers.")
867
868 (defvar gnus-buffer-configuration
869   '((group
870      (vertical 1.0
871                (group 1.0 point)
872                (if gnus-carpal '(group-carpal 4))))
873     (summary
874      (vertical 1.0
875                (summary 1.0 point)
876                (if gnus-carpal '(summary-carpal 4))))
877     (article
878      (cond 
879       (gnus-use-picons
880        '(frame 1.0
881                (vertical 1.0
882                          (summary 0.25 point)
883                          (if gnus-carpal '(summary-carpal 4))
884                          (article 1.0))
885                (vertical ((height . 5) (width . 15)
886                           (user-position . t)
887                           (left . -1) (top . 1))
888                          (picons 1.0))))
889       (gnus-use-trees
890        '(vertical 1.0
891                   (summary 0.25 point)
892                   (tree 0.25)
893                   (article 1.0)))
894       (t
895        '(vertical 1.0
896                  (summary 0.25 point)
897                  (if gnus-carpal '(summary-carpal 4))
898                  (article 1.0)))))
899     (server
900      (vertical 1.0
901                (server 1.0 point)
902                (if gnus-carpal '(server-carpal 2))))
903     (browse
904      (vertical 1.0
905                (browse 1.0 point)
906                (if gnus-carpal '(browse-carpal 2))))
907     (message
908      (vertical 1.0
909                (message 1.0 point)))
910     (pick
911      (vertical 1.0
912                (article 1.0 point)))
913     (info
914      (vertical 1.0
915                (info 1.0 point)))
916     (summary-faq
917      (vertical 1.0
918                (summary 0.25)
919                (faq 1.0 point)))
920     (edit-group
921      (vertical 1.0
922                (group 0.5)
923                (edit-group 1.0 point)))
924     (edit-server
925      (vertical 1.0
926                (server 0.5)
927                (edit-server 1.0 point)))
928     (edit-score
929      (vertical 1.0
930                (summary 0.25)
931                (edit-score 1.0 point)))
932     (post
933      (vertical 1.0
934                (post 1.0 point)))
935     (reply
936      (vertical 1.0
937                (article-copy 0.5)
938                (message 1.0 point)))
939     (forward
940      (vertical 1.0
941                (message 1.0 point)))
942     (reply-yank
943      (vertical 1.0
944                (message 1.0 point)))
945     (mail-bounce
946      (vertical 1.0
947                (article 0.5)
948                (message 1.0 point)))
949     (draft
950      (vertical 1.0
951                (draft 1.0 point)))
952     (pipe
953      (vertical 1.0
954                (summary 0.25 point)
955                (if gnus-carpal '(summary-carpal 4))
956                ("*Shell Command Output*" 1.0)))
957     (bug
958      (vertical 1.0
959                ("*Gnus Help Bug*" 0.5)
960                ("*Gnus Bug*" 1.0 point)))
961     (compose-bounce
962      (vertical 1.0
963                (article 0.5)
964                (message 1.0 point))))
965   "Window configuration for all possible Gnus buffers.
966 This variable is a list of lists.  Each of these lists has a NAME and
967 a RULE.  The NAMEs are commonsense names like `group', which names a
968 rule used when displaying the group buffer; `summary', which names a
969 rule for what happens when you enter a group and do not display an
970 article buffer; and so on.  See the value of this variable for a
971 complete list of NAMEs.
972
973 Each RULE is a list of vectors.  The first element in this vector is
974 the name of the buffer to be displayed; the second element is the
975 percentage of the screen this buffer is to occupy (a number in the
976 0.0-0.99 range); the optional third element is `point', which should
977 be present to denote which buffer point is to go to after making this
978 buffer configuration.")
979
980 (defvar gnus-window-to-buffer
981   '((group . gnus-group-buffer)
982     (summary . gnus-summary-buffer)
983     (article . gnus-article-buffer)
984     (server . gnus-server-buffer)
985     (browse . "*Gnus Browse Server*")
986     (edit-group . gnus-group-edit-buffer)
987     (edit-server . gnus-server-edit-buffer)
988     (group-carpal . gnus-carpal-group-buffer)
989     (summary-carpal . gnus-carpal-summary-buffer)
990     (server-carpal . gnus-carpal-server-buffer)
991     (browse-carpal . gnus-carpal-browse-buffer)
992     (edit-score . gnus-score-edit-buffer)
993     (message . gnus-message-buffer)
994     (mail . gnus-message-buffer)
995     (post-news . gnus-message-buffer)
996     (faq . gnus-faq-buffer)
997     (picons . "*Picons*")
998     (tree . gnus-tree-buffer)
999     (info . gnus-info-buffer)
1000     (article-copy . gnus-article-copy)
1001     (draft . gnus-draft-buffer))
1002   "Mapping from short symbols to buffer names or buffer variables.")
1003
1004 (defvar gnus-carpal nil
1005   "*If non-nil, display clickable icons.")
1006
1007 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
1008   "*Function called with a group name when new group is detected.
1009 A few pre-made functions are supplied: `gnus-subscribe-randomly'
1010 inserts new groups at the beginning of the list of groups;
1011 `gnus-subscribe-alphabetically' inserts new groups in strict
1012 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
1013 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
1014 for your decision; `gnus-subscribe-killed' kills all new groups;
1015 `gnus-subscribe-zombies' will make all new groups into zombies.")
1016
1017 ;; Suggested by a bug report by Hallvard B Furuseth.
1018 ;; <h.b.furuseth@usit.uio.no>.
1019 (defvar gnus-subscribe-options-newsgroup-method
1020   (function gnus-subscribe-alphabetically)
1021   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
1022 If, for instance, you want to subscribe to all newsgroups in the
1023 \"no\" and \"alt\" hierarchies, you'd put the following in your
1024 .newsrc file:
1025
1026 options -n no.all alt.all
1027
1028 Gnus will the subscribe all new newsgroups in these hierarchies with
1029 the subscription method in this variable.")
1030
1031 (defvar gnus-subscribe-hierarchical-interactive nil
1032   "*If non-nil, Gnus will offer to subscribe hierarchically.
1033 When a new hierarchy appears, Gnus will ask the user:
1034
1035 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
1036
1037 If the user pressed `d', Gnus will descend the hierarchy, `y' will
1038 subscribe to all newsgroups in the hierarchy and `s' will skip this
1039 hierarchy in its entirety.")
1040
1041 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
1042   "*Function used for sorting the group buffer.
1043 This function will be called with group info entries as the arguments
1044 for the groups to be sorted.  Pre-made functions include
1045 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
1046 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
1047 `gnus-group-sort-by-rank'.
1048
1049 This variable can also be a list of sorting functions.  In that case,
1050 the most significant sort function should be the last function in the
1051 list.")
1052
1053 ;; Mark variables suggested by Thomas Michanek
1054 ;; <Thomas.Michanek@telelogic.se>.
1055 (defvar gnus-unread-mark ? 
1056   "*Mark used for unread articles.")
1057 (defvar gnus-ticked-mark ?!
1058   "*Mark used for ticked articles.")
1059 (defvar gnus-dormant-mark ??
1060   "*Mark used for dormant articles.")
1061 (defvar gnus-del-mark ?r
1062   "*Mark used for del'd articles.")
1063 (defvar gnus-read-mark ?R
1064   "*Mark used for read articles.")
1065 (defvar gnus-expirable-mark ?E
1066   "*Mark used for expirable articles.")
1067 (defvar gnus-killed-mark ?K
1068   "*Mark used for killed articles.")
1069 (defvar gnus-souped-mark ?F
1070   "*Mark used for killed articles.")
1071 (defvar gnus-kill-file-mark ?X
1072   "*Mark used for articles killed by kill files.")
1073 (defvar gnus-low-score-mark ?Y
1074   "*Mark used for articles with a low score.")
1075 (defvar gnus-catchup-mark ?C
1076   "*Mark used for articles that are caught up.")
1077 (defvar gnus-replied-mark ?A
1078   "*Mark used for articles that have been replied to.")
1079 (defvar gnus-cached-mark ?*
1080   "*Mark used for articles that are in the cache.")
1081 (defvar gnus-saved-mark ?S
1082   "*Mark used for articles that have been saved to.")
1083 (defvar gnus-process-mark ?#
1084   "*Process mark.")
1085 (defvar gnus-ancient-mark ?O
1086   "*Mark used for ancient articles.")
1087 (defvar gnus-sparse-mark ?Q
1088   "*Mark used for sparsely reffed articles.")
1089 (defvar gnus-canceled-mark ?G
1090   "*Mark used for canceled articles.")
1091 (defvar gnus-score-over-mark ?+
1092   "*Score mark used for articles with high scores.")
1093 (defvar gnus-score-below-mark ?-
1094   "*Score mark used for articles with low scores.")
1095 (defvar gnus-empty-thread-mark ? 
1096   "*There is no thread under the article.")
1097 (defvar gnus-not-empty-thread-mark ?=
1098   "*There is a thread under the article.")
1099
1100 (defvar gnus-view-pseudo-asynchronously nil
1101   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
1102
1103 (defvar gnus-view-pseudos nil
1104   "*If `automatic', pseudo-articles will be viewed automatically.
1105 If `not-confirm', pseudos will be viewed automatically, and the user
1106 will not be asked to confirm the command.")
1107
1108 (defvar gnus-view-pseudos-separately t
1109   "*If non-nil, one pseudo-article will be created for each file to be viewed.
1110 If nil, all files that use the same viewing command will be given as a
1111 list of parameters to that command.")
1112
1113 (defvar gnus-insert-pseudo-articles t
1114   "*If non-nil, insert pseudo-articles when decoding articles.")
1115
1116 (defvar gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
1117   "*Format of group lines.
1118 It works along the same lines as a normal formatting string,
1119 with some simple extensions.
1120
1121 %M    Only marked articles (character, \"*\" or \" \")
1122 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
1123 %L    Level of subscribedness (integer)
1124 %N    Number of unread articles (integer)
1125 %I    Number of dormant articles (integer)
1126 %i    Number of ticked and dormant (integer)
1127 %T    Number of ticked articles (integer)
1128 %R    Number of read articles (integer)
1129 %t    Total number of articles (integer)
1130 %y    Number of unread, unticked articles (integer)
1131 %G    Group name (string)
1132 %g    Qualified group name (string)
1133 %D    Group description (string)
1134 %s    Select method (string)
1135 %o    Moderated group (char, \"m\")
1136 %p    Process mark (char)
1137 %O    Moderated group (string, \"(m)\" or \"\")
1138 %P    Topic indentation (string)
1139 %l    Whether there are GroupLens predictions for this group (string)
1140 %n    Select from where (string)
1141 %z    A string that look like `<%s:%n>' if a foreign select method is used
1142 %u    User defined specifier.  The next character in the format string should
1143       be a letter.  Gnus will call the function gnus-user-format-function-X,
1144       where X is the letter following %u.  The function will be passed the
1145       current header as argument.  The function should return a string, which
1146       will be inserted into the buffer just like information from any other
1147       group specifier.
1148
1149 Text between %( and %) will be highlighted with `gnus-mouse-face' when
1150 the mouse point move inside the area.  There can only be one such area.
1151
1152 Note that this format specification is not always respected.  For
1153 reasons of efficiency, when listing killed groups, this specification
1154 is ignored altogether.  If the spec is changed considerably, your
1155 output may end up looking strange when listing both alive and killed
1156 groups.
1157
1158 If you use %o or %O, reading the active file will be slower and quite
1159 a bit of extra memory will be used. %D will also worsen performance.
1160 Also note that if you change the format specification to include any
1161 of these specs, you must probably re-start Gnus to see them go into
1162 effect.")
1163
1164 (defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
1165   "*The format specification of the lines in the summary buffer.
1166
1167 It works along the same lines as a normal formatting string,
1168 with some simple extensions.
1169
1170 %N   Article number, left padded with spaces (string)
1171 %S   Subject (string)
1172 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1173 %n   Name of the poster (string)
1174 %a   Extracted name of the poster (string)
1175 %A   Extracted address of the poster (string)
1176 %F   Contents of the From: header (string)
1177 %x   Contents of the Xref: header (string)
1178 %D   Date of the article (string)
1179 %d   Date of the article (string) in DD-MMM format
1180 %M   Message-id of the article (string)
1181 %r   References of the article (string)
1182 %c   Number of characters in the article (integer)
1183 %L   Number of lines in the article (integer)
1184 %I   Indentation based on thread level (a string of spaces)
1185 %T   A string with two possible values: 80 spaces if the article
1186      is on thread level two or larger and 0 spaces on level one
1187 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1188 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1189 %[   Opening bracket (character, \"[\" or \"<\")
1190 %]   Closing bracket (character, \"]\" or \">\")
1191 %>   Spaces of length thread-level (string)
1192 %<   Spaces of length (- 20 thread-level) (string)
1193 %i   Article score (number)
1194 %z   Article zcore (character)
1195 %t   Number of articles under the current thread (number).
1196 %e   Whether the thread is empty or not (character).
1197 %l   GroupLens score (string).
1198 %u   User defined specifier.  The next character in the format string should
1199      be a letter.  Gnus will call the function gnus-user-format-function-X,
1200      where X is the letter following %u.  The function will be passed the
1201      current header as argument.  The function should return a string, which
1202      will be inserted into the summary just like information from any other
1203      summary specifier.
1204
1205 Text between %( and %) will be highlighted with `gnus-mouse-face'
1206 when the mouse point is placed inside the area.  There can only be one
1207 such area.
1208
1209 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1210 with care.  For reasons of efficiency, Gnus will compute what column
1211 these characters will end up in, and \"hard-code\" that.  This means that
1212 it is illegal to have these specs after a variable-length spec.  Well,
1213 you might not be arrested, but your summary buffer will look strange,
1214 which is bad enough.
1215
1216 The smart choice is to have these specs as for to the left as
1217 possible.
1218
1219 This restriction may disappear in later versions of Gnus.")
1220
1221 (defvar gnus-summary-dummy-line-format
1222   "*  %(:                          :%) %S\n"
1223   "*The format specification for the dummy roots in the summary buffer.
1224 It works along the same lines as a normal formatting string,
1225 with some simple extensions.
1226
1227 %S  The subject")
1228
1229 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
1230   "*The format specification for the summary mode line.
1231 It works along the same lines as a normal formatting string,
1232 with some simple extensions:
1233
1234 %G  Group name
1235 %p  Unprefixed group name
1236 %A  Current article number
1237 %V  Gnus version
1238 %U  Number of unread articles in the group
1239 %e  Number of unselected articles in the group
1240 %Z  A string with unread/unselected article counts
1241 %g  Shortish group name
1242 %S  Subject of the current article
1243 %u  User-defined spec
1244 %s  Current score file name
1245 %d  Number of dormant articles
1246 %r  Number of articles that have been marked as read in this session
1247 %E  Number of articles expunged by the score files")
1248
1249 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1250   "*The format specification for the article mode line.
1251 See `gnus-summary-mode-line-format' for a closer description.")
1252
1253 (defvar gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
1254   "*The format specification for the group mode line.
1255 It works along the same lines as a normal formatting string,
1256 with some simple extensions:
1257
1258 %S   The native news server.
1259 %M   The native select method.
1260 %:   \":\" if %S isn't \"\".")
1261
1262 (defvar gnus-valid-select-methods
1263   '(("nntp" post address prompt-address)
1264     ("nnspool" post address)
1265     ("nnvirtual" post-mail virtual prompt-address)
1266     ("nnmbox" mail respool address)
1267     ("nnml" mail respool address)
1268     ("nnmh" mail respool address)
1269     ("nndir" post-mail prompt-address address)
1270     ("nneething" none address prompt-address)
1271     ("nndoc" none address prompt-address)
1272     ("nnbabyl" mail address respool)
1273     ("nnkiboze" post virtual)
1274     ("nnsoup" post-mail address)
1275     ("nndraft" post-mail)
1276     ("nnfolder" mail respool address))
1277   "An alist of valid select methods.
1278 The first element of each list lists should be a string with the name
1279 of the select method.  The other elements may be the category of
1280 this method (ie. `post', `mail', `none' or whatever) or other
1281 properties that this method has (like being respoolable).
1282 If you implement a new select method, all you should have to change is
1283 this variable.  I think.")
1284
1285 (defvar gnus-updated-mode-lines '(group article summary tree)
1286   "*List of buffers that should update their mode lines.
1287 The list may contain the symbols `group', `article' and `summary'.  If
1288 the corresponding symbol is present, Gnus will keep that mode line
1289 updated with information that may be pertinent.
1290 If this variable is nil, screen refresh may be quicker.")
1291
1292 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1293 (defvar gnus-mode-non-string-length nil
1294   "*Max length of mode-line non-string contents.
1295 If this is nil, Gnus will take space as is needed, leaving the rest
1296 of the modeline intact.")
1297
1298 ;see gnus-cus.el
1299 ;(defvar gnus-mouse-face 'highlight
1300 ;  "*Face used for mouse highlighting in Gnus.
1301 ;No mouse highlights will be done if `gnus-visual' is nil.")
1302
1303 (defvar gnus-summary-mark-below 0
1304   "*Mark all articles with a score below this variable as read.
1305 This variable is local to each summary buffer and usually set by the
1306 score file.")
1307
1308 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
1309   "*List of functions used for sorting articles in the summary buffer.
1310 This variable is only used when not using a threaded display.")
1311
1312 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1313   "*List of functions used for sorting threads in the summary buffer.
1314 By default, threads are sorted by article number.
1315
1316 Each function takes two threads and return non-nil if the first thread
1317 should be sorted before the other.  If you use more than one function,
1318 the primary sort function should be the last.  You should probably
1319 always include `gnus-thread-sort-by-number' in the list of sorting
1320 functions -- preferably first.
1321
1322 Ready-mady functions include `gnus-thread-sort-by-number',
1323 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1324 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1325 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1326
1327 (defvar gnus-thread-score-function '+
1328   "*Function used for calculating the total score of a thread.
1329
1330 The function is called with the scores of the article and each
1331 subthread and should then return the score of the thread.
1332
1333 Some functions you can use are `+', `max', or `min'.")
1334
1335 (defvar gnus-summary-expunge-below nil
1336   "All articles that have a score less than this variable will be expunged.")
1337
1338 (defvar gnus-thread-expunge-below nil
1339   "All threads that have a total score less than this variable will be expunged.
1340 See `gnus-thread-score-function' for en explanation of what a
1341 \"thread score\" is.")
1342
1343 (defvar gnus-auto-subscribed-groups
1344   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1345   "*All new groups that match this regexp will be subscribed automatically.
1346 Note that this variable only deals with new groups.  It has no effect
1347 whatsoever on old groups.
1348
1349 New groups that match this regexp will not be handled by
1350 `gnus-subscribe-newsgroup-method'.  Instead, they will
1351 be subscribed using `gnus-subscribe-options-newsgroup-method'.")
1352
1353 (defvar gnus-options-subscribe nil
1354   "*All new groups matching this regexp will be subscribed unconditionally.
1355 Note that this variable deals only with new newsgroups.  This variable
1356 does not affect old newsgroups.
1357
1358 New groups that match this regexp will not be handled by
1359 `gnus-subscribe-newsgroup-method'.  Instead, they will
1360 be subscribed using `gnus-subscribe-options-newsgroup-method'.")
1361
1362 (defvar gnus-options-not-subscribe nil
1363   "*All new groups matching this regexp will be ignored.
1364 Note that this variable deals only with new newsgroups.  This variable
1365 does not affect old (already subscribed) newsgroups.")
1366
1367 (defvar gnus-auto-expirable-newsgroups nil
1368   "*Groups in which to automatically mark read articles as expirable.
1369 If non-nil, this should be a regexp that should match all groups in
1370 which to perform auto-expiry.  This only makes sense for mail groups.")
1371
1372 (defvar gnus-total-expirable-newsgroups nil
1373   "*Groups in which to perform expiry of all read articles.
1374 Use with extreme caution.  All groups that match this regexp will be
1375 expiring - which means that all read articles will be deleted after
1376 (say) one week.  (This only goes for mail groups and the like, of
1377 course.)")
1378
1379 (defvar gnus-group-uncollapsed-levels 1
1380   "Number of group name elements to leave alone when making a short group name.")
1381
1382 (defvar gnus-hidden-properties '(invisible t intangible t)
1383   "Property list to use for hiding text.")
1384
1385 (defvar gnus-modtime-botch nil
1386   "*Non-nil means .newsrc should be deleted prior to save.  
1387 Its use is due to the bogus appearance that .newsrc was modified on
1388 disc.")
1389
1390 ;; Hooks.
1391
1392 (defvar gnus-group-mode-hook nil
1393   "*A hook for Gnus group mode.")
1394
1395 (defvar gnus-summary-mode-hook nil
1396   "*A hook for Gnus summary mode.
1397 This hook is run before any variables are set in the summary buffer.")
1398
1399 (defvar gnus-article-mode-hook nil
1400   "*A hook for Gnus article mode.")
1401
1402 (defvar gnus-summary-prepare-exit-hook nil
1403   "*A hook called when preparing to exit from the summary buffer.
1404 It calls `gnus-summary-expire-articles' by default.")
1405 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1406
1407 (defvar gnus-summary-exit-hook nil
1408   "*A hook called on exit from the summary buffer.")
1409
1410 (defvar gnus-check-bogus-groups-hook nil
1411   "A hook run after removing bogus groups.")
1412
1413 (defvar gnus-group-catchup-group-hook nil
1414   "*A hook run when catching up a group from the group buffer.")
1415
1416 (defvar gnus-group-update-group-hook nil
1417   "*A hook called when updating group lines.")
1418
1419 (defvar gnus-open-server-hook nil
1420   "*A hook called just before opening connection to the news server.")
1421
1422 (defvar gnus-load-hook nil
1423   "*A hook run while Gnus is loaded.")
1424
1425 (defvar gnus-startup-hook nil
1426   "*A hook called at startup.
1427 This hook is called after Gnus is connected to the NNTP server.")
1428
1429 (defvar gnus-get-new-news-hook nil
1430   "*A hook run just before Gnus checks for new news.")
1431
1432 (defvar gnus-after-getting-new-news-hook nil
1433   "*A hook run after Gnus checks for new news.")
1434
1435 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1436   "*A function that is called to generate the group buffer.
1437 The function is called with three arguments: The first is a number;
1438 all group with a level less or equal to that number should be listed,
1439 if the second is non-nil, empty groups should also be displayed.  If
1440 the third is non-nil, it is a number.  No groups with a level lower
1441 than this number should be displayed.
1442
1443 The only current function implemented is `gnus-group-prepare-flat'.")
1444
1445 (defvar gnus-group-prepare-hook nil
1446   "*A hook called after the group buffer has been generated.
1447 If you want to modify the group buffer, you can use this hook.")
1448
1449 (defvar gnus-summary-prepare-hook nil
1450   "*A hook called after the summary buffer has been generated.
1451 If you want to modify the summary buffer, you can use this hook.")
1452
1453 (defvar gnus-summary-generate-hook nil
1454   "*A hook run just before generating the summary buffer.
1455 This hook is commonly used to customize threading variables and the
1456 like.")
1457
1458 (defvar gnus-article-prepare-hook nil
1459   "*A hook called after an article has been prepared in the article buffer.
1460 If you want to run a special decoding program like nkf, use this hook.")
1461
1462 ;(defvar gnus-article-display-hook nil
1463 ;  "*A hook called after the article is displayed in the article buffer.
1464 ;The hook is designed to change the contents of the article
1465 ;buffer.  Typical functions that this hook may contain are
1466 ;`gnus-article-hide-headers' (hide selected headers),
1467 ;`gnus-article-maybe-highlight' (perform fancy article highlighting),
1468 ;`gnus-article-hide-signature' (hide signature) and
1469 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1470 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1471 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1472 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1473
1474 (defvar gnus-article-x-face-too-ugly nil
1475   "Regexp matching posters whose face shouldn't be shown automatically.")
1476
1477 (defvar gnus-select-group-hook nil
1478   "*A hook called when a newsgroup is selected.
1479
1480 If you'd like to simplify subjects like the
1481 `gnus-summary-next-same-subject' command does, you can use the
1482 following hook:
1483
1484  (setq gnus-select-group-hook
1485       (list
1486         (lambda ()
1487           (mapcar (lambda (header)
1488                      (mail-header-set-subject
1489                       header
1490                       (gnus-simplify-subject
1491                        (mail-header-subject header) 're-only)))
1492                   gnus-newsgroup-headers))))")
1493
1494 (defvar gnus-select-article-hook nil
1495   "*A hook called when an article is selected.")
1496
1497 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1498   "*A hook called to apply kill files to a group.
1499 This hook is intended to apply a kill file to the selected newsgroup.
1500 The function `gnus-apply-kill-file' is called by default.
1501
1502 Since a general kill file is too heavy to use only for a few
1503 newsgroups, I recommend you to use a lighter hook function.  For
1504 example, if you'd like to apply a kill file to articles which contains
1505 a string `rmgroup' in subject in newsgroup `control', you can use the
1506 following hook:
1507
1508  (setq gnus-apply-kill-hook
1509       (list
1510         (lambda ()
1511           (cond ((string-match \"control\" gnus-newsgroup-name)
1512                  (gnus-kill \"Subject\" \"rmgroup\")
1513                  (gnus-expunge \"X\"))))))")
1514
1515 (defvar gnus-visual-mark-article-hook
1516   (list 'gnus-highlight-selected-summary)
1517   "*Hook run after selecting an article in the summary buffer.
1518 It is meant to be used for highlighting the article in some way.  It
1519 is not run if `gnus-visual' is nil.")
1520
1521 (defvar gnus-parse-headers-hook nil
1522   "*A hook called before parsing the headers.")
1523 (add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522)
1524
1525 (defvar gnus-exit-group-hook nil
1526   "*A hook called when exiting (not quitting) summary mode.")
1527
1528 (defvar gnus-suspend-gnus-hook nil
1529   "*A hook called when suspending (not exiting) Gnus.")
1530
1531 (defvar gnus-exit-gnus-hook nil
1532   "*A hook called when exiting Gnus.")
1533
1534 (defvar gnus-after-exiting-gnus-hook nil
1535   "*A hook called after exiting Gnus.")
1536
1537 (defvar gnus-save-newsrc-hook nil
1538   "*A hook called before saving any of the newsrc files.")
1539
1540 (defvar gnus-save-quick-newsrc-hook nil
1541   "*A hook called just before saving the quick newsrc file.
1542 Can be used to turn version control on or off.")
1543
1544 (defvar gnus-save-standard-newsrc-hook nil
1545   "*A hook called just before saving the standard newsrc file.
1546 Can be used to turn version control on or off.")
1547
1548 (defvar gnus-summary-update-hook
1549   (list 'gnus-summary-highlight-line)
1550   "*A hook called when a summary line is changed.
1551 The hook will not be called if `gnus-visual' is nil.
1552
1553 The default function `gnus-summary-highlight-line' will
1554 highlight the line according to the `gnus-summary-highlight'
1555 variable.")
1556
1557 (defvar gnus-group-update-hook '(gnus-group-highlight-line)
1558   "*A hook called when a group line is changed.
1559 The hook will not be called if `gnus-visual' is nil.
1560
1561 The default function `gnus-group-highlight-line' will
1562 highlight the line according to the `gnus-group-highlight'
1563 variable.")
1564
1565 (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
1566   "*A hook called when an article is selected for the first time.
1567 The hook is intended to mark an article as read (or unread)
1568 automatically when it is selected.")
1569
1570 (defvar gnus-group-change-level-function nil
1571   "Function run when a group level is changed.
1572 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
1573
1574 ;; Remove any hilit infestation.
1575 (add-hook 'gnus-startup-hook
1576           (lambda ()
1577             (remove-hook 'gnus-summary-prepare-hook
1578                          'hilit-rehighlight-buffer-quietly)
1579             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1580             (setq gnus-mark-article-hook
1581                   '(gnus-summary-mark-read-and-unread-as-read))
1582             (remove-hook 'gnus-article-prepare-hook
1583                          'hilit-rehighlight-buffer-quietly)))
1584
1585 \f
1586 ;; Internal variables
1587
1588 (defvar gnus-tree-buffer "*Tree*"
1589   "Buffer where Gnus thread trees are displayed.")
1590
1591 ;; Dummy variable.
1592 (defvar gnus-use-generic-from nil)
1593
1594 (defvar gnus-thread-indent-array nil)
1595 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
1596
1597 (defvar gnus-newsrc-file-version nil)
1598
1599 (defvar gnus-method-history nil)
1600 ;; Variable holding the user answers to all method prompts.
1601
1602 (defvar gnus-group-history nil)
1603 ;; Variable holding the user answers to all group prompts.
1604
1605 (defvar gnus-server-alist nil
1606   "List of available servers.")
1607
1608 (defvar gnus-group-indentation-function nil)
1609
1610 (defvar gnus-topic-indentation "") ;; Obsolete variable.
1611
1612 (defvar gnus-goto-missing-group-function nil)
1613
1614 (defvar gnus-override-subscribe-method nil)
1615
1616 (defvar gnus-group-goto-next-group-function nil
1617   "Function to override finding the next group after listing groups.")
1618
1619 (defconst gnus-article-mark-lists
1620   '((marked . tick) (replied . reply)
1621     (expirable . expire) (killed . killed)
1622     (bookmarks . bookmark) (dormant . dormant)
1623     (scored . score) (saved . save)
1624     (cached . cache)
1625     ))
1626
1627 ;; Avoid highlighting in kill files.
1628 (defvar gnus-summary-inhibit-highlight nil)
1629 (defvar gnus-newsgroup-selected-overlay nil)
1630
1631 (defvar gnus-inhibit-hiding nil)
1632 (defvar gnus-group-indentation "")
1633 (defvar gnus-inhibit-limiting nil)
1634 (defvar gnus-created-frames nil)
1635
1636 (defvar gnus-article-mode-map nil)
1637 (defvar gnus-dribble-buffer nil)
1638 (defvar gnus-headers-retrieved-by nil)
1639 (defvar gnus-article-reply nil)
1640 (defvar gnus-override-method nil)
1641 (defvar gnus-article-check-size nil)
1642
1643 (defvar gnus-current-score-file nil)
1644 (defvar gnus-newsgroup-adaptive-score-file nil)
1645 (defvar gnus-scores-exclude-files nil)
1646
1647 (defvar gnus-opened-servers nil)
1648
1649 (defvar gnus-current-move-group nil)
1650 (defvar gnus-current-copy-group nil)
1651 (defvar gnus-current-crosspost-group nil)
1652
1653 (defvar gnus-newsgroup-dependencies nil)
1654 (defvar gnus-newsgroup-async nil)
1655 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1656
1657 (defvar gnus-newsgroup-adaptive nil)
1658
1659 (defvar gnus-summary-display-table nil)
1660 (defvar gnus-summary-display-article-function nil)
1661
1662 (defvar gnus-summary-highlight-line-function nil
1663   "Function called after highlighting a summary line.")
1664
1665 (defvar gnus-group-line-format-alist
1666   `((?M gnus-tmp-marked-mark ?c)
1667     (?S gnus-tmp-subscribed ?c)
1668     (?L gnus-tmp-level ?d)
1669     (?N (cond ((eq number t) "*" )
1670               ((numberp number) 
1671                (int-to-string
1672                 (+ number
1673                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1674                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
1675               (t number)) ?s)
1676     (?R gnus-tmp-number-of-read ?s)
1677     (?t gnus-tmp-number-total ?d)
1678     (?y gnus-tmp-number-of-unread ?s)
1679     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1680     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1681     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1682            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1683     (?g gnus-tmp-group ?s)
1684     (?G gnus-tmp-qualified-group ?s)
1685     (?c (gnus-short-group-name gnus-tmp-group) ?s)
1686     (?D gnus-tmp-newsgroup-description ?s)
1687     (?o gnus-tmp-moderated ?c)
1688     (?O gnus-tmp-moderated-string ?s)
1689     (?p gnus-tmp-process-marked ?c)
1690     (?s gnus-tmp-news-server ?s)
1691     (?n gnus-tmp-news-method ?s)
1692     (?P gnus-group-indentation ?s)
1693     (?l gnus-tmp-grouplens ?s)
1694     (?z gnus-tmp-news-method-string ?s)
1695     (?u gnus-tmp-user-defined ?s)))
1696
1697 (defvar gnus-summary-line-format-alist
1698   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1699     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1700     (?s gnus-tmp-subject-or-nil ?s)
1701     (?n gnus-tmp-name ?s)
1702     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1703         ?s)
1704     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1705             gnus-tmp-from) ?s)
1706     (?F gnus-tmp-from ?s)
1707     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1708     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1709     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1710     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1711     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1712     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1713     (?L gnus-tmp-lines ?d)
1714     (?I gnus-tmp-indentation ?s)
1715     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1716     (?R gnus-tmp-replied ?c)
1717     (?\[ gnus-tmp-opening-bracket ?c)
1718     (?\] gnus-tmp-closing-bracket ?c)
1719     (?\> (make-string gnus-tmp-level ? ) ?s)
1720     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1721     (?i gnus-tmp-score ?d)
1722     (?z gnus-tmp-score-char ?c)
1723     (?l (bbb-grouplens-score gnus-tmp-header) ?s)
1724     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1725     (?U gnus-tmp-unread ?c)
1726     (?t (gnus-summary-number-of-articles-in-thread
1727          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1728         ?d)
1729     (?e (gnus-summary-number-of-articles-in-thread
1730          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1731         ?c)
1732     (?u gnus-tmp-user-defined ?s))
1733   "An alist of format specifications that can appear in summary lines,
1734 and what variables they correspond with, along with the type of the
1735 variable (string, integer, character, etc).")
1736
1737 (defvar gnus-summary-dummy-line-format-alist
1738   `((?S gnus-tmp-subject ?s)
1739     (?N gnus-tmp-number ?d)
1740     (?u gnus-tmp-user-defined ?s)))
1741
1742 (defvar gnus-summary-mode-line-format-alist
1743   `((?G gnus-tmp-group-name ?s)
1744     (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1745     (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1746     (?A gnus-tmp-article-number ?d)
1747     (?Z gnus-tmp-unread-and-unselected ?s)
1748     (?V gnus-version ?s)
1749     (?U gnus-tmp-unread-and-unticked ?d)
1750     (?S gnus-tmp-subject ?s)
1751     (?e gnus-tmp-unselected ?d)
1752     (?u gnus-tmp-user-defined ?s)
1753     (?d (length gnus-newsgroup-dormant) ?d)
1754     (?t (length gnus-newsgroup-marked) ?d)
1755     (?r (length gnus-newsgroup-reads) ?d)
1756     (?E gnus-newsgroup-expunged-tally ?d)
1757     (?s (gnus-current-score-file-nondirectory) ?s)))
1758
1759 (defvar gnus-article-mode-line-format-alist
1760   gnus-summary-mode-line-format-alist)
1761
1762 (defvar gnus-group-mode-line-format-alist
1763   `((?S gnus-tmp-news-server ?s)
1764     (?M gnus-tmp-news-method ?s)
1765     (?u gnus-tmp-user-defined ?s)
1766     (?: gnus-tmp-colon ?s)))
1767
1768 (defvar gnus-have-read-active-file nil)
1769
1770 (defconst gnus-maintainer
1771   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1772   "The mail address of the Gnus maintainers.")
1773
1774 (defconst gnus-version-number "5.2.36"
1775   "Version number for this version of Gnus.")
1776
1777 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
1778   "Version string for this version of Gnus.")
1779
1780 (defvar gnus-info-nodes
1781   '((gnus-group-mode "(gnus)The Group Buffer")
1782     (gnus-summary-mode "(gnus)The Summary Buffer")
1783     (gnus-article-mode "(gnus)The Article Buffer")
1784     (gnus-server-mode "(gnus)The Server Buffer")
1785     (gnus-browse-mode "(gnus)Browse Foreign Server")
1786     (gnus-tree-mode "(gnus)Tree Display")
1787     )
1788   "Alist of major modes and related Info nodes.")
1789
1790 (defvar gnus-group-buffer "*Group*")
1791 (defvar gnus-summary-buffer "*Summary*")
1792 (defvar gnus-article-buffer "*Article*")
1793 (defvar gnus-server-buffer "*Server*")
1794
1795 (defvar gnus-work-buffer " *gnus work*")
1796
1797 (defvar gnus-original-article-buffer " *Original Article*")
1798 (defvar gnus-original-article nil)
1799
1800 (defvar gnus-buffer-list nil
1801   "Gnus buffers that should be killed on exit.")
1802
1803 (defvar gnus-slave nil
1804   "Whether this Gnus is a slave or not.")
1805
1806 (defvar gnus-variable-list
1807   '(gnus-newsrc-options gnus-newsrc-options-n
1808     gnus-newsrc-last-checked-date
1809     gnus-newsrc-alist gnus-server-alist
1810     gnus-killed-list gnus-zombie-list
1811     gnus-topic-topology gnus-topic-alist
1812     gnus-format-specs)
1813   "Gnus variables saved in the quick startup file.")
1814
1815 (defvar gnus-newsrc-options nil
1816   "Options line in the .newsrc file.")
1817
1818 (defvar gnus-newsrc-options-n nil
1819   "List of regexps representing groups to be subscribed/ignored unconditionally.")
1820
1821 (defvar gnus-newsrc-last-checked-date nil
1822   "Date Gnus last asked server for new newsgroups.")
1823
1824 (defvar gnus-topic-topology nil
1825   "The complete topic hierarchy.")
1826
1827 (defvar gnus-topic-alist nil
1828   "The complete topic-group alist.")
1829
1830 (defvar gnus-newsrc-alist nil
1831   "Assoc list of read articles.
1832 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1833
1834 (defvar gnus-newsrc-hashtb nil
1835   "Hashtable of gnus-newsrc-alist.")
1836
1837 (defvar gnus-killed-list nil
1838   "List of killed newsgroups.")
1839
1840 (defvar gnus-killed-hashtb nil
1841   "Hash table equivalent of gnus-killed-list.")
1842
1843 (defvar gnus-zombie-list nil
1844   "List of almost dead newsgroups.")
1845
1846 (defvar gnus-description-hashtb nil
1847   "Descriptions of newsgroups.")
1848
1849 (defvar gnus-list-of-killed-groups nil
1850   "List of newsgroups that have recently been killed by the user.")
1851
1852 (defvar gnus-active-hashtb nil
1853   "Hashtable of active articles.")
1854
1855 (defvar gnus-moderated-list nil
1856   "List of moderated newsgroups.")
1857
1858 (defvar gnus-group-marked nil)
1859
1860 (defvar gnus-current-startup-file nil
1861   "Startup file for the current host.")
1862
1863 (defvar gnus-last-search-regexp nil
1864   "Default regexp for article search command.")
1865
1866 (defvar gnus-last-shell-command nil
1867   "Default shell command on article.")
1868
1869 (defvar gnus-current-select-method nil
1870   "The current method for selecting a newsgroup.")
1871
1872 (defvar gnus-group-list-mode nil)
1873
1874 (defvar gnus-article-internal-prepare-hook nil)
1875
1876 (defvar gnus-newsgroup-name nil)
1877 (defvar gnus-newsgroup-begin nil)
1878 (defvar gnus-newsgroup-end nil)
1879 (defvar gnus-newsgroup-last-rmail nil)
1880 (defvar gnus-newsgroup-last-mail nil)
1881 (defvar gnus-newsgroup-last-folder nil)
1882 (defvar gnus-newsgroup-last-file nil)
1883 (defvar gnus-newsgroup-auto-expire nil)
1884 (defvar gnus-newsgroup-active nil)
1885
1886 (defvar gnus-newsgroup-data nil)
1887 (defvar gnus-newsgroup-data-reverse nil)
1888 (defvar gnus-newsgroup-limit nil)
1889 (defvar gnus-newsgroup-limits nil)
1890
1891 (defvar gnus-newsgroup-unreads nil
1892   "List of unread articles in the current newsgroup.")
1893
1894 (defvar gnus-newsgroup-unselected nil
1895   "List of unselected unread articles in the current newsgroup.")
1896
1897 (defvar gnus-newsgroup-reads nil
1898   "Alist of read articles and article marks in the current newsgroup.")
1899
1900 (defvar gnus-newsgroup-expunged-tally nil)
1901
1902 (defvar gnus-newsgroup-marked nil
1903   "List of ticked articles in the current newsgroup (a subset of unread art).")
1904
1905 (defvar gnus-newsgroup-killed nil
1906   "List of ranges of articles that have been through the scoring process.")
1907
1908 (defvar gnus-newsgroup-cached nil
1909   "List of articles that come from the article cache.")
1910
1911 (defvar gnus-newsgroup-saved nil
1912   "List of articles that have been saved.")
1913
1914 (defvar gnus-newsgroup-kill-headers nil)
1915
1916 (defvar gnus-newsgroup-replied nil
1917   "List of articles that have been replied to in the current newsgroup.")
1918
1919 (defvar gnus-newsgroup-expirable nil
1920   "List of articles in the current newsgroup that can be expired.")
1921
1922 (defvar gnus-newsgroup-processable nil
1923   "List of articles in the current newsgroup that can be processed.")
1924
1925 (defvar gnus-newsgroup-bookmarks nil
1926   "List of articles in the current newsgroup that have bookmarks.")
1927
1928 (defvar gnus-newsgroup-dormant nil
1929   "List of dormant articles in the current newsgroup.")
1930
1931 (defvar gnus-newsgroup-scored nil
1932   "List of scored articles in the current newsgroup.")
1933
1934 (defvar gnus-newsgroup-headers nil
1935   "List of article headers in the current newsgroup.")
1936
1937 (defvar gnus-newsgroup-threads nil)
1938
1939 (defvar gnus-newsgroup-prepared nil
1940   "Whether the current group has been prepared properly.")
1941
1942 (defvar gnus-newsgroup-ancient nil
1943   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1944
1945 (defvar gnus-newsgroup-sparse nil)
1946
1947 (defvar gnus-current-article nil)
1948 (defvar gnus-article-current nil)
1949 (defvar gnus-current-headers nil)
1950 (defvar gnus-have-all-headers nil)
1951 (defvar gnus-last-article nil)
1952 (defvar gnus-newsgroup-history nil)
1953 (defvar gnus-current-kill-article nil)
1954
1955 ;; Save window configuration.
1956 (defvar gnus-prev-winconf nil)
1957
1958 (defvar gnus-summary-mark-positions nil)
1959 (defvar gnus-group-mark-positions nil)
1960
1961 (defvar gnus-reffed-article-number nil)
1962
1963 ;;; Let the byte-compiler know that we know about this variable.
1964 (defvar rmail-default-rmail-file)
1965
1966 (defvar gnus-cache-removable-articles nil)
1967
1968 (defvar gnus-dead-summary nil)
1969
1970 (defconst gnus-summary-local-variables
1971   '(gnus-newsgroup-name
1972     gnus-newsgroup-begin gnus-newsgroup-end
1973     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1974     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1975     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1976     gnus-newsgroup-unselected gnus-newsgroup-marked
1977     gnus-newsgroup-reads gnus-newsgroup-saved
1978     gnus-newsgroup-replied gnus-newsgroup-expirable
1979     gnus-newsgroup-processable gnus-newsgroup-killed
1980     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1981     gnus-newsgroup-headers gnus-newsgroup-threads
1982     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1983     gnus-current-article gnus-current-headers gnus-have-all-headers
1984     gnus-last-article gnus-article-internal-prepare-hook
1985     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1986     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1987     gnus-newsgroup-async gnus-thread-expunge-below
1988     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
1989     (gnus-summary-mark-below . global)
1990     gnus-newsgroup-active gnus-scores-exclude-files
1991     gnus-newsgroup-history gnus-newsgroup-ancient
1992     gnus-newsgroup-sparse
1993     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1994     gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
1995     (gnus-newsgroup-expunged-tally . 0)
1996     gnus-cache-removable-articles gnus-newsgroup-cached
1997     gnus-newsgroup-data gnus-newsgroup-data-reverse
1998     gnus-newsgroup-limit gnus-newsgroup-limits)
1999   "Variables that are buffer-local to the summary buffers.")
2000
2001 (defconst gnus-bug-message
2002   "Sending a bug report to the Gnus Towers.
2003 ========================================
2004
2005 The buffer below is a mail buffer.  When you press `C-c C-c', it will
2006 be sent to the Gnus Bug Exterminators.
2007
2008 At the bottom of the buffer you'll see lots of variable settings.
2009 Please do not delete those.  They will tell the Bug People what your
2010 environment is, so that it will be easier to locate the bugs.
2011
2012 If you have found a bug that makes Emacs go \"beep\", set
2013 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
2014 and include the backtrace in your bug report.
2015
2016 Please describe the bug in annoying, painstaking detail.
2017
2018 Thank you for your help in stamping out bugs.
2019 ")
2020
2021 ;;; End of variables.
2022
2023 ;; Define some autoload functions Gnus might use.
2024 (eval-and-compile
2025
2026   ;; This little mapcar goes through the list below and marks the
2027   ;; symbols in question as autoloaded functions.
2028   (mapcar
2029    (lambda (package)
2030      (let ((interactive (nth 1 (memq ':interactive package))))
2031        (mapcar
2032         (lambda (function)
2033           (let (keymap)
2034             (when (consp function)
2035               (setq keymap (car (memq 'keymap function)))
2036               (setq function (car function)))
2037             (autoload function (car package) nil interactive keymap)))
2038         (if (eq (nth 1 package) ':interactive)
2039             (cdddr package)
2040           (cdr package)))))
2041    '(("metamail" metamail-buffer)
2042      ("info" Info-goto-node)
2043      ("hexl" hexl-hex-string-to-integer)
2044      ("pp" pp pp-to-string pp-eval-expression)
2045      ("mail-extr" mail-extract-address-components)
2046      ("nnmail" nnmail-split-fancy nnmail-article-group)
2047      ("nnvirtual" nnvirtual-catchup-group)
2048      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
2049       timezone-make-sortable-date timezone-make-time-string)
2050      ("rmailout" rmail-output)
2051      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
2052       rmail-show-message)
2053      ("gnus-soup" :interactive t
2054       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
2055       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
2056      ("nnsoup" nnsoup-pack-replies)
2057      ("score-mode" :interactive t gnus-score-mode)
2058      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
2059       gnus-Folder-save-name gnus-folder-save-name)
2060      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
2061      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
2062       gnus-server-make-menu-bar gnus-article-make-menu-bar
2063       gnus-browse-make-menu-bar gnus-highlight-selected-summary
2064       gnus-summary-highlight-line gnus-carpal-setup-buffer
2065       gnus-group-highlight-line
2066       gnus-article-add-button gnus-insert-next-page-button
2067       gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
2068      ("gnus-vis" :interactive t
2069       gnus-article-push-button gnus-article-press-button
2070       gnus-article-highlight gnus-article-highlight-some
2071       gnus-article-highlight-headers gnus-article-highlight-signature
2072       gnus-article-add-buttons gnus-article-add-buttons-to-head
2073       gnus-article-next-button gnus-article-prev-button)
2074      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
2075       gnus-demon-add-disconnection gnus-demon-add-handler
2076       gnus-demon-remove-handler)
2077      ("gnus-demon" :interactive t
2078       gnus-demon-init gnus-demon-cancel)
2079      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
2080       gnus-tree-open gnus-tree-close)
2081      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
2082       gnus-nocem-unwanted-article-p)
2083      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
2084      ("gnus-srvr" gnus-browse-foreign-server)
2085      ("gnus-cite" :interactive t
2086       gnus-article-highlight-citation gnus-article-hide-citation-maybe
2087       gnus-article-hide-citation gnus-article-fill-cited-article
2088       gnus-article-hide-citation-in-followups)
2089      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
2090       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
2091       gnus-execute gnus-expunge)
2092      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
2093       gnus-cache-possibly-remove-articles gnus-cache-request-article
2094       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2095       gnus-cache-enter-remove-article gnus-cached-article-p
2096       gnus-cache-open gnus-cache-close gnus-cache-update-article)
2097      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2098       gnus-cache-remove-article)
2099      ("gnus-score" :interactive t
2100       gnus-summary-increase-score gnus-summary-lower-score
2101       gnus-score-flush-cache gnus-score-close
2102       gnus-score-raise-same-subject-and-select
2103       gnus-score-raise-same-subject gnus-score-default
2104       gnus-score-raise-thread gnus-score-lower-same-subject-and-select
2105       gnus-score-lower-same-subject gnus-score-lower-thread
2106       gnus-possibly-score-headers gnus-summary-raise-score 
2107       gnus-summary-set-score gnus-summary-current-score)
2108      ("gnus-score"
2109       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
2110       gnus-current-score-file-nondirectory gnus-score-adaptive
2111       gnus-score-find-trace gnus-score-file-name)
2112      ("gnus-edit" :interactive t gnus-score-customize)
2113      ("gnus-topic" :interactive t gnus-topic-mode)
2114      ("gnus-topic" gnus-topic-remove-group)
2115      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
2116      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2117      ("gnus-uu" :interactive t
2118       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2119       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2120       gnus-uu-mark-by-regexp gnus-uu-mark-all
2121       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2122       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2123       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2124       gnus-uu-decode-binhex gnus-uu-decode-uu-view
2125       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2126       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2127       gnus-uu-decode-binhex-view)
2128      ("gnus-msg" (gnus-summary-send-map keymap)
2129       gnus-mail-yank-original gnus-mail-send-and-exit
2130       gnus-article-mail gnus-new-mail gnus-mail-reply
2131       gnus-copy-article-buffer)
2132      ("gnus-msg" :interactive t
2133       gnus-group-post-news gnus-group-mail gnus-summary-post-news
2134       gnus-summary-followup gnus-summary-followup-with-original
2135       gnus-summary-cancel-article gnus-summary-supersede-article
2136       gnus-post-news gnus-inews-news 
2137       gnus-summary-reply gnus-summary-reply-with-original
2138       gnus-summary-mail-forward gnus-summary-mail-other-window
2139       gnus-bug)
2140      ("gnus-picon" :interactive t gnus-article-display-picons
2141       gnus-group-display-picons gnus-picons-article-display-x-face
2142       gnus-picons-display-x-face)
2143      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 
2144       gnus-grouplens-mode)
2145      ("smiley" :interactive t gnus-smiley-display)
2146      ("gnus-vm" gnus-vm-mail-setup)
2147      ("gnus-vm" :interactive t gnus-summary-save-in-vm
2148       gnus-summary-save-article-vm))))
2149
2150 \f
2151
2152 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2153 ;; If you want the cursor to go somewhere else, set these two
2154 ;; functions in some startup hook to whatever you want.
2155 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
2156 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2157
2158 ;;; Various macros and substs.
2159
2160 (defun gnus-header-from (header)
2161   (mail-header-from header))
2162
2163 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
2164   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
2165   (let ((tempvar (make-symbol "GnusStartBufferWindow"))
2166         (w (make-symbol "w"))
2167         (buf (make-symbol "buf")))
2168     `(let* ((,tempvar (selected-window))
2169             (,buf ,buffer)
2170             (,w (get-buffer-window ,buf 'visible)))
2171        (unwind-protect
2172            (progn
2173              (if ,w
2174                  (select-window ,w)
2175                (pop-to-buffer ,buf))
2176              ,@forms)
2177          (select-window ,tempvar)))))
2178
2179 (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
2180 (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
2181 (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
2182
2183 (defmacro gnus-gethash (string hashtable)
2184   "Get hash value of STRING in HASHTABLE."
2185   `(symbol-value (intern-soft ,string ,hashtable)))
2186
2187 (defmacro gnus-sethash (string value hashtable)
2188   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2189   `(set (intern ,string ,hashtable) ,value))
2190
2191 (defmacro gnus-intern-safe (string hashtable)
2192   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2193   `(let ((symbol (intern ,string ,hashtable)))
2194      (or (boundp symbol)
2195          (set symbol nil))
2196      symbol))
2197
2198 (defmacro gnus-group-unread (group)
2199   "Get the currently computed number of unread articles in GROUP."
2200   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2201
2202 (defmacro gnus-group-entry (group)
2203   "Get the newsrc entry for GROUP."
2204   `(gnus-gethash ,group gnus-newsrc-hashtb))
2205
2206 (defmacro gnus-active (group)
2207   "Get active info on GROUP."
2208   `(gnus-gethash ,group gnus-active-hashtb))
2209
2210 (defmacro gnus-set-active (group active)
2211   "Set GROUP's active info."
2212   `(gnus-sethash ,group ,active gnus-active-hashtb))
2213
2214 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2215 ;;   function `substring' might cut on a middle of multi-octet
2216 ;;   character.
2217 (defun gnus-truncate-string (str width)
2218   (substring str 0 width))
2219
2220 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
2221 ;; to limit the length of a string.  This function is necessary since
2222 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
2223 (defsubst gnus-limit-string (str width)
2224   (if (> (length str) width)
2225       (substring str 0 width)
2226     str))
2227
2228 (defsubst gnus-simplify-subject-re (subject)
2229   "Remove \"Re:\" from subject lines."
2230   (if (string-match "^[Rr][Ee]: *" subject)
2231       (substring subject (match-end 0))
2232     subject))
2233
2234 (defsubst gnus-functionp (form)
2235   "Return non-nil if FORM is funcallable."
2236   (or (and (symbolp form) (fboundp form))
2237       (and (listp form) (eq (car form) 'lambda))))
2238
2239 (defsubst gnus-goto-char (point)
2240   (and point (goto-char point)))
2241
2242 (defmacro gnus-buffer-exists-p (buffer)
2243   `(let ((buffer ,buffer))
2244      (and buffer
2245           (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
2246                    buffer))))
2247
2248 (defmacro gnus-kill-buffer (buffer)
2249   `(let ((buf ,buffer))
2250      (if (gnus-buffer-exists-p buf)
2251          (kill-buffer buf))))
2252
2253 (defsubst gnus-point-at-bol ()
2254   "Return point at the beginning of the line."
2255   (let ((p (point)))
2256     (beginning-of-line)
2257     (prog1
2258         (point)
2259       (goto-char p))))
2260
2261 (defsubst gnus-point-at-eol ()
2262   "Return point at the end of the line."
2263   (let ((p (point)))
2264     (end-of-line)
2265     (prog1
2266         (point)
2267       (goto-char p))))
2268
2269 (defun gnus-alive-p ()
2270   "Say whether Gnus is running or not."
2271   (and gnus-group-buffer
2272        (get-buffer gnus-group-buffer)))
2273
2274 (defun gnus-delete-first (elt list)
2275   "Delete by side effect the first occurrence of ELT as a member of LIST."
2276   (if (equal (car list) elt)
2277       (cdr list)
2278     (let ((total list))
2279       (while (and (cdr list)
2280                   (not (equal (cadr list) elt)))
2281         (setq list (cdr list)))
2282       (when (cdr list)
2283         (setcdr list (cddr list)))
2284       total)))
2285
2286 ;; Delete the current line (and the next N lines.);
2287 (defmacro gnus-delete-line (&optional n)
2288   `(delete-region (progn (beginning-of-line) (point))
2289                   (progn (forward-line ,(or n 1)) (point))))
2290
2291 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2292 (defvar gnus-init-inhibit nil)
2293 (defun gnus-read-init-file (&optional inhibit-next)
2294   (if gnus-init-inhibit
2295       (setq gnus-init-inhibit nil)
2296     (setq gnus-init-inhibit inhibit-next)
2297     (and gnus-init-file
2298          (or (and (file-exists-p gnus-init-file)
2299                   ;; Don't try to load a directory.
2300                   (not (file-directory-p gnus-init-file)))
2301              (file-exists-p (concat gnus-init-file ".el"))
2302              (file-exists-p (concat gnus-init-file ".elc")))
2303          (condition-case var
2304              (load gnus-init-file nil t)
2305            (error
2306             (error "Error in %s: %s" gnus-init-file var))))))
2307
2308 ;; Info access macros.
2309
2310 (defmacro gnus-info-group (info)
2311   `(nth 0 ,info))
2312 (defmacro gnus-info-rank (info)
2313   `(nth 1 ,info))
2314 (defmacro gnus-info-read (info)
2315   `(nth 2 ,info))
2316 (defmacro gnus-info-marks (info)
2317   `(nth 3 ,info))
2318 (defmacro gnus-info-method (info)
2319   `(nth 4 ,info))
2320 (defmacro gnus-info-params (info)
2321   `(nth 5 ,info))
2322
2323 (defmacro gnus-info-level (info)
2324   `(let ((rank (gnus-info-rank ,info)))
2325      (if (consp rank)
2326          (car rank)
2327        rank)))
2328 (defmacro gnus-info-score (info)
2329   `(let ((rank (gnus-info-rank ,info)))
2330      (or (and (consp rank) (cdr rank)) 0)))
2331
2332 (defmacro gnus-info-set-group (info group)
2333   `(setcar ,info ,group))
2334 (defmacro gnus-info-set-rank (info rank)
2335   `(setcar (nthcdr 1 ,info) ,rank))
2336 (defmacro gnus-info-set-read (info read)
2337   `(setcar (nthcdr 2 ,info) ,read))
2338 (defmacro gnus-info-set-marks (info marks)
2339   `(setcar (nthcdr 3 ,info) ,marks))
2340 (defmacro gnus-info-set-method (info method)
2341   `(setcar (nthcdr 4 ,info) ,method))
2342 (defmacro gnus-info-set-params (info params)
2343   `(setcar (nthcdr 5 ,info) ,params))
2344
2345 (defmacro gnus-info-set-level (info level)
2346   `(let ((rank (cdr ,info)))
2347      (if (consp (car rank))
2348          (setcar (car rank) ,level)
2349        (setcar rank ,level))))
2350 (defmacro gnus-info-set-score (info score)
2351   `(let ((rank (cdr ,info)))
2352      (if (consp (car rank))
2353          (setcdr (car rank) ,score)
2354        (setcar rank (cons (car rank) ,score)))))
2355
2356 (defmacro gnus-get-info (group)
2357   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2358
2359 (defun gnus-byte-code (func)
2360   "Return a form that can be `eval'ed based on FUNC."
2361   (let ((fval (symbol-function func)))
2362     (if (byte-code-function-p fval)
2363         (let ((flist (append fval nil)))
2364           (setcar flist 'byte-code)
2365           flist)
2366       (cons 'progn (cddr fval)))))
2367
2368 ;; Find out whether the gnus-visual TYPE is wanted.
2369 (defun gnus-visual-p (&optional type class)
2370   (and gnus-visual                      ; Has to be non-nil, at least.
2371        (if (not type)                   ; We don't care about type.
2372            gnus-visual
2373          (if (listp gnus-visual)        ; It's a list, so we check it.
2374              (or (memq type gnus-visual)
2375                  (memq class gnus-visual))
2376            t))))
2377
2378 ;;; Load the compatability functions.
2379
2380 (require 'gnus-cus)
2381 (require 'gnus-ems)
2382
2383 \f
2384 ;;;
2385 ;;; Shutdown
2386 ;;;
2387
2388 (defvar gnus-shutdown-alist nil)
2389
2390 (defun gnus-add-shutdown (function &rest symbols)
2391   "Run FUNCTION whenever one of SYMBOLS is shut down."
2392   (push (cons function symbols) gnus-shutdown-alist))
2393
2394 (defun gnus-shutdown (symbol)
2395   "Shut down everything that waits for SYMBOL."
2396   (let ((alist gnus-shutdown-alist)
2397         entry)
2398     (while (setq entry (pop alist))
2399       (when (memq symbol (cdr entry))
2400         (funcall (car entry))))))
2401
2402 \f
2403
2404 ;; Format specs.  The chunks below are the machine-generated forms
2405 ;; that are to be evaled as the result of the default format strings.
2406 ;; We write them in here to get them byte-compiled.  That way the
2407 ;; default actions will be quite fast, while still retaining the full
2408 ;; flexibility of the user-defined format specs.
2409
2410 ;; First we have lots of dummy defvars to let the compiler know these
2411 ;; are really dynamic variables.
2412
2413 (defvar gnus-tmp-unread)
2414 (defvar gnus-tmp-replied)
2415 (defvar gnus-tmp-score-char)
2416 (defvar gnus-tmp-indentation)
2417 (defvar gnus-tmp-opening-bracket)
2418 (defvar gnus-tmp-lines)
2419 (defvar gnus-tmp-name)
2420 (defvar gnus-tmp-closing-bracket)
2421 (defvar gnus-tmp-subject-or-nil)
2422 (defvar gnus-tmp-subject)
2423 (defvar gnus-tmp-marked)
2424 (defvar gnus-tmp-marked-mark)
2425 (defvar gnus-tmp-subscribed)
2426 (defvar gnus-tmp-process-marked)
2427 (defvar gnus-tmp-number-of-unread)
2428 (defvar gnus-tmp-group-name)
2429 (defvar gnus-tmp-group)
2430 (defvar gnus-tmp-article-number)
2431 (defvar gnus-tmp-unread-and-unselected)
2432 (defvar gnus-tmp-news-method)
2433 (defvar gnus-tmp-news-server)
2434 (defvar gnus-tmp-article-number)
2435 (defvar gnus-mouse-face)
2436 (defvar gnus-mouse-face-prop)
2437
2438 (defun gnus-summary-line-format-spec ()
2439   (insert gnus-tmp-unread gnus-tmp-replied
2440           gnus-tmp-score-char gnus-tmp-indentation)
2441   (gnus-put-text-property
2442    (point)
2443    (progn
2444      (insert
2445       gnus-tmp-opening-bracket
2446       (format "%4d: %-20s"
2447               gnus-tmp-lines
2448               (if (> (length gnus-tmp-name) 20)
2449                   (substring gnus-tmp-name 0 20)
2450                 gnus-tmp-name))
2451       gnus-tmp-closing-bracket)
2452      (point))
2453    gnus-mouse-face-prop gnus-mouse-face)
2454   (insert " " gnus-tmp-subject-or-nil "\n"))
2455
2456 (defvar gnus-summary-line-format-spec
2457   (gnus-byte-code 'gnus-summary-line-format-spec))
2458
2459 (defun gnus-summary-dummy-line-format-spec ()
2460   (insert "*  ")
2461   (gnus-put-text-property
2462    (point)
2463    (progn
2464      (insert ":                          :")
2465      (point))
2466    gnus-mouse-face-prop gnus-mouse-face)
2467   (insert " " gnus-tmp-subject "\n"))
2468
2469 (defvar gnus-summary-dummy-line-format-spec
2470   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2471
2472 (defun gnus-group-line-format-spec ()
2473   (insert gnus-tmp-marked-mark gnus-tmp-subscribed
2474           gnus-tmp-process-marked
2475           gnus-group-indentation
2476           (format "%5s: " gnus-tmp-number-of-unread))
2477   (gnus-put-text-property
2478    (point)
2479    (progn
2480      (insert gnus-tmp-group "\n")
2481      (1- (point)))
2482    gnus-mouse-face-prop gnus-mouse-face))
2483 (defvar gnus-group-line-format-spec
2484   (gnus-byte-code 'gnus-group-line-format-spec))
2485
2486 (defvar gnus-format-specs
2487   `((version . ,emacs-version)
2488     (group ,gnus-group-line-format ,gnus-group-line-format-spec)
2489     (summary-dummy ,gnus-summary-dummy-line-format
2490                    ,gnus-summary-dummy-line-format-spec)
2491     (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
2492
2493 (defvar gnus-article-mode-line-format-spec nil)
2494 (defvar gnus-summary-mode-line-format-spec nil)
2495 (defvar gnus-group-mode-line-format-spec nil)
2496
2497 ;;; Phew.  All that gruft is over, fortunately.
2498
2499 \f
2500 ;;;
2501 ;;; Gnus Utility Functions
2502 ;;;
2503
2504 (defun gnus-extract-address-components (from)
2505   (let (name address)
2506     ;; First find the address - the thing with the @ in it.  This may
2507     ;; not be accurate in mail addresses, but does the trick most of
2508     ;; the time in news messages.
2509     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2510         (setq address (substring from (match-beginning 0) (match-end 0))))
2511     ;; Then we check whether the "name <address>" format is used.
2512     (and address
2513          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2514          ;; Linear white space is not required.
2515          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2516          (and (setq name (substring from 0 (match-beginning 0)))
2517               ;; Strip any quotes from the name.
2518               (string-match "\".*\"" name)
2519               (setq name (substring name 1 (1- (match-end 0))))))
2520     ;; If not, then "address (name)" is used.
2521     (or name
2522         (and (string-match "(.+)" from)
2523              (setq name (substring from (1+ (match-beginning 0))
2524                                    (1- (match-end 0)))))
2525         (and (string-match "()" from)
2526              (setq name address))
2527         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2528         ;; XOVER might not support folded From headers.
2529         (and (string-match "(.*" from)
2530              (setq name (substring from (1+ (match-beginning 0))
2531                                    (match-end 0)))))
2532     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2533     (list (or name from) (or address from))))
2534
2535 (defun gnus-fetch-field (field)
2536   "Return the value of the header FIELD of current article."
2537   (save-excursion
2538     (save-restriction
2539       (let ((case-fold-search t)
2540             (inhibit-point-motion-hooks t))
2541         (nnheader-narrow-to-headers)
2542         (message-fetch-field field)))))
2543
2544 (defun gnus-goto-colon ()
2545   (beginning-of-line)
2546   (search-forward ":" (gnus-point-at-eol) t))
2547
2548 ;;;###autoload
2549 (defun gnus-update-format (var)
2550   "Update the format specification near point."
2551   (interactive
2552    (list
2553     (save-excursion
2554       (eval-defun nil)
2555       ;; Find the end of the current word.
2556       (re-search-forward "[ \t\n]" nil t)
2557       ;; Search backward.
2558       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2559         (match-string 1)))))
2560   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
2561                               (match-string 1 var))))
2562          (entry (assq type gnus-format-specs))
2563          value spec)
2564     (when entry
2565       (setq gnus-format-specs (delq entry gnus-format-specs)))
2566     (set
2567      (intern (format "%s-spec" var))
2568      (gnus-parse-format (setq value (symbol-value (intern var)))
2569                         (symbol-value (intern (format "%s-alist" var)))
2570                         (not (string-match "mode" var))))
2571     (setq spec (symbol-value (intern (format "%s-spec" var))))
2572     (push (list type value spec) gnus-format-specs)
2573
2574     (pop-to-buffer "*Gnus Format*")
2575     (erase-buffer)
2576     (lisp-interaction-mode)
2577     (insert (pp-to-string spec))))
2578
2579 (defun gnus-update-format-specifications (&optional force)
2580   "Update all (necessary) format specifications."
2581   ;; Make the indentation array.
2582   (gnus-make-thread-indent-array)
2583
2584   ;; See whether all the stored info needs to be flushed.
2585   (when (or force
2586             (not (equal emacs-version
2587                         (cdr (assq 'version gnus-format-specs)))))
2588     (setq gnus-format-specs nil))
2589
2590   ;; Go through all the formats and see whether they need updating.
2591   (let ((types '(summary summary-dummy group
2592                          summary-mode group-mode article-mode))
2593         new-format entry type val)
2594     (while (setq type (pop types))
2595       ;; Jump to the proper buffer to find out the value of
2596       ;; the variable, if possible.  (It may be buffer-local.)
2597       (save-excursion
2598         (let ((buffer (intern (format "gnus-%s-buffer" type)))
2599               val)
2600           (when (and (boundp buffer)
2601                      (setq val (symbol-value buffer))
2602                      (get-buffer val)
2603                      (buffer-name (get-buffer val)))
2604             (set-buffer (get-buffer val)))
2605           (setq new-format (symbol-value
2606                             (intern (format "gnus-%s-line-format" type))))))
2607       (setq entry (cdr (assq type gnus-format-specs)))
2608       (if (and entry
2609                (equal (car entry) new-format))
2610           ;; Use the old format.
2611           (set (intern (format "gnus-%s-line-format-spec" type))
2612                (cadr entry))
2613         ;; This is a new format.
2614         (setq val
2615               (if (not (stringp new-format))
2616                   ;; This is a function call or something.
2617                   new-format
2618                 ;; This is a "real" format.
2619                 (gnus-parse-format
2620                  new-format
2621                  (symbol-value
2622                   (intern (format "gnus-%s-line-format-alist"
2623                                   (if (eq type 'article-mode)
2624                                       'summary-mode type))))
2625                  (not (string-match "mode$" (symbol-name type))))))
2626         ;; Enter the new format spec into the list.
2627         (if entry
2628             (progn
2629               (setcar (cdr entry) val)
2630               (setcar entry new-format))
2631           (push (list type new-format val) gnus-format-specs))
2632         (set (intern (format "gnus-%s-line-format-spec" type)) val))))
2633
2634   (unless (assq 'version gnus-format-specs)
2635     (push (cons 'version emacs-version) gnus-format-specs))
2636
2637   (gnus-update-group-mark-positions)
2638   (gnus-update-summary-mark-positions))
2639
2640 (defun gnus-update-summary-mark-positions ()
2641   "Compute where the summary marks are to go."
2642   (save-excursion
2643     (when (and gnus-summary-buffer
2644                (get-buffer gnus-summary-buffer)
2645                (buffer-name (get-buffer gnus-summary-buffer)))
2646       (set-buffer gnus-summary-buffer))
2647     (let ((gnus-replied-mark 129)
2648           (gnus-score-below-mark 130)
2649           (gnus-score-over-mark 130)
2650           (thread nil)
2651           (gnus-visual nil)
2652           (spec gnus-summary-line-format-spec)
2653           pos)
2654       (save-excursion
2655         (gnus-set-work-buffer)
2656         (let ((gnus-summary-line-format-spec spec))
2657           (gnus-summary-insert-line
2658            [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2659           (goto-char (point-min))
2660           (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2661                                              (- (point) 2)))))
2662           (goto-char (point-min))
2663           (push (cons 'replied (and (search-forward "\201" nil t) 
2664                                     (- (point) 2)))
2665                 pos)
2666           (goto-char (point-min))
2667           (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
2668                 pos)))
2669       (setq gnus-summary-mark-positions pos))))
2670
2671 (defun gnus-update-group-mark-positions ()
2672   (save-excursion
2673     (let ((gnus-process-mark 128)
2674           (gnus-group-marked '("dummy.group"))
2675           (gnus-active-hashtb (make-vector 10 0)))
2676       (gnus-set-active "dummy.group" '(0 . 0))
2677       (gnus-set-work-buffer)
2678       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2679       (goto-char (point-min))
2680       (setq gnus-group-mark-positions
2681             (list (cons 'process (and (search-forward "\200" nil t)
2682                                       (- (point) 2))))))))
2683
2684 (defvar gnus-mouse-face-0 'highlight)
2685 (defvar gnus-mouse-face-1 'highlight)
2686 (defvar gnus-mouse-face-2 'highlight)
2687 (defvar gnus-mouse-face-3 'highlight)
2688 (defvar gnus-mouse-face-4 'highlight)
2689
2690 (defun gnus-mouse-face-function (form type)
2691   `(gnus-put-text-property
2692     (point) (progn ,@form (point))
2693     gnus-mouse-face-prop
2694     ,(if (equal type 0)
2695          'gnus-mouse-face
2696        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2697
2698 (defvar gnus-face-0 'bold)
2699 (defvar gnus-face-1 'italic)
2700 (defvar gnus-face-2 'bold-italic)
2701 (defvar gnus-face-3 'bold)
2702 (defvar gnus-face-4 'bold)
2703
2704 (defun gnus-face-face-function (form type)
2705   `(gnus-put-text-property
2706     (point) (progn ,@form (point))
2707     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2708
2709 (defun gnus-max-width-function (el max-width)
2710   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2711   (if (symbolp el)
2712       `(if (> (length ,el) ,max-width)
2713            (substring ,el 0 ,max-width)
2714          ,el)
2715     `(let ((val (eval ,el)))
2716        (if (numberp val)
2717            (setq val (int-to-string val)))
2718        (if (> (length val) ,max-width)
2719            (substring val 0 ,max-width)
2720          val))))
2721
2722 (defun gnus-parse-format (format spec-alist &optional insert)
2723   ;; This function parses the FORMAT string with the help of the
2724   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2725   ;; string.  If the FORMAT string contains the specifiers %( and %)
2726   ;; the text between them will have the mouse-face text property.
2727   (if (string-match
2728        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2729        format)
2730       (gnus-parse-complex-format format spec-alist)
2731     ;; This is a simple format.
2732     (gnus-parse-simple-format format spec-alist insert)))
2733
2734 (defun gnus-parse-complex-format (format spec-alist)
2735   (save-excursion
2736     (gnus-set-work-buffer)
2737     (insert format)
2738     (goto-char (point-min))
2739     (while (re-search-forward "\"" nil t)
2740       (replace-match "\\\"" nil t))
2741     (goto-char (point-min))
2742     (insert "(\"")
2743     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2744       (let ((number (if (match-beginning 1)
2745                         (match-string 1) "0"))
2746             (delim (aref (match-string 2) 0)))
2747         (if (or (= delim ?\() (= delim ?\{))
2748             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2749                                    " " number " \""))
2750           (replace-match "\")\""))))
2751     (goto-char (point-max))
2752     (insert "\")")
2753     (goto-char (point-min))
2754     (let ((form (read (current-buffer))))
2755       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2756
2757 (defun gnus-complex-form-to-spec (form spec-alist)
2758   (delq nil
2759         (mapcar
2760          (lambda (sform)
2761            (if (stringp sform)
2762                (gnus-parse-simple-format sform spec-alist t)
2763              (funcall (intern (format "gnus-%s-face-function" (car sform)))
2764                       (gnus-complex-form-to-spec (cddr sform) spec-alist)
2765                       (nth 1 sform))))
2766          form)))
2767
2768 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2769   ;; This function parses the FORMAT string with the help of the
2770   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2771   ;; string.
2772   (let ((max-width 0)
2773         spec flist fstring newspec elem beg result dontinsert)
2774     (save-excursion
2775       (gnus-set-work-buffer)
2776       (insert format)
2777       (goto-char (point-min))
2778       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2779                                 nil t)
2780         (if (= (setq spec (string-to-char (match-string 2))) ?%)
2781               (setq newspec "%"
2782                     beg (1+ (match-beginning 0)))
2783           ;; First check if there are any specs that look anything like
2784           ;; "%12,12A", ie. with a "max width specification".  These have
2785           ;; to be treated specially.
2786           (if (setq beg (match-beginning 1))
2787               (setq max-width
2788                     (string-to-int
2789                      (buffer-substring
2790                       (1+ (match-beginning 1)) (match-end 1))))
2791             (setq max-width 0)
2792             (setq beg (match-beginning 2)))
2793           ;; Find the specification from `spec-alist'.
2794           (unless (setq elem (cdr (assq spec spec-alist)))
2795             (setq elem '("*" ?s)))
2796           ;; Treat user defined format specifiers specially.
2797           (when (eq (car elem) 'gnus-tmp-user-defined)
2798             (setq elem
2799                   (list
2800                    (list (intern (concat "gnus-user-format-function-"
2801                                          (match-string 3)))
2802                          'gnus-tmp-header) ?s))
2803             (delete-region (match-beginning 3) (match-end 3)))
2804           (if (not (zerop max-width))
2805               (let ((el (car elem)))
2806                 (cond ((= (cadr elem) ?c)
2807                        (setq el (list 'char-to-string el)))
2808                       ((= (cadr elem) ?d)
2809                        (setq el (list 'int-to-string el))))
2810                 (setq flist (cons (gnus-max-width-function el max-width)
2811                                   flist))
2812                 (setq newspec ?s))
2813             (progn
2814               (setq flist (cons (car elem) flist))
2815               (setq newspec (cadr elem)))))
2816         ;; Remove the old specification (and possibly a ",12" string).
2817         (delete-region beg (match-end 2))
2818         ;; Insert the new specification.
2819         (goto-char beg)
2820         (insert newspec))
2821       (setq fstring (buffer-substring 1 (point-max))))
2822     ;; Do some postprocessing to increase efficiency.
2823     (setq
2824      result
2825      (cond
2826       ;; Emptyness.
2827       ((string= fstring "")
2828        nil)
2829       ;; Not a format string.
2830       ((not (string-match "%" fstring))
2831        (list fstring))
2832       ;; A format string with just a single string spec.
2833       ((string= fstring "%s")
2834        (list (car flist)))
2835       ;; A single character.
2836       ((string= fstring "%c")
2837        (list (car flist)))
2838       ;; A single number.
2839       ((string= fstring "%d")
2840        (setq dontinsert)
2841        (if insert
2842            (list `(princ ,(car flist)))
2843          (list `(int-to-string ,(car flist)))))
2844       ;; Just lots of chars and strings.
2845       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2846        (nreverse flist))
2847       ;; A single string spec at the beginning of the spec.
2848       ((string-match "\\`%[sc][^%]+\\'" fstring)
2849        (list (car flist) (substring fstring 2)))
2850       ;; A single string spec in the middle of the spec.
2851       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2852        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2853       ;; A single string spec in the end of the spec.
2854       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2855        (list (match-string 1 fstring) (car flist)))
2856       ;; A more complex spec.
2857       (t
2858        (list (cons 'format (cons fstring (nreverse flist)))))))
2859
2860     (if insert
2861         (when result
2862           (if dontinsert
2863               result
2864             (cons 'insert result)))
2865       (cond ((stringp result)
2866              result)
2867             ((consp result)
2868              (cons 'concat result))
2869             (t "")))))
2870
2871 (defun gnus-eval-format (format &optional alist props)
2872   "Eval the format variable FORMAT, using ALIST.
2873 If PROPS, insert the result."
2874   (let ((form (gnus-parse-format format alist props)))
2875     (if props
2876         (gnus-add-text-properties (point) (progn (eval form) (point)) props)
2877       (eval form))))
2878
2879 (defun gnus-remove-text-with-property (prop)
2880   "Delete all text in the current buffer with text property PROP."
2881   (save-excursion
2882     (goto-char (point-min))
2883     (while (not (eobp))
2884       (while (get-text-property (point) prop)
2885         (delete-char 1))
2886       (goto-char (next-single-property-change (point) prop nil (point-max))))))
2887
2888 (defun gnus-set-work-buffer ()
2889   (if (get-buffer gnus-work-buffer)
2890       (progn
2891         (set-buffer gnus-work-buffer)
2892         (erase-buffer))
2893     (set-buffer (get-buffer-create gnus-work-buffer))
2894     (kill-all-local-variables)
2895     (buffer-disable-undo (current-buffer))
2896     (gnus-add-current-to-buffer-list)))
2897
2898 ;; Article file names when saving.
2899
2900 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2901   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2902 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2903 Otherwise, it is like ~/News/news/group/num."
2904   (let ((default
2905           (expand-file-name
2906            (concat (if (gnus-use-long-file-name 'not-save)
2907                        (gnus-capitalize-newsgroup newsgroup)
2908                      (gnus-newsgroup-directory-form newsgroup))
2909                    "/" (int-to-string (mail-header-number headers)))
2910            gnus-article-save-directory)))
2911     (if (and last-file
2912              (string-equal (file-name-directory default)
2913                            (file-name-directory last-file))
2914              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2915         default
2916       (or last-file default))))
2917
2918 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2919   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2920 If variable `gnus-use-long-file-name' is non-nil, it is
2921 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2922   (let ((default
2923           (expand-file-name
2924            (concat (if (gnus-use-long-file-name 'not-save)
2925                        newsgroup
2926                      (gnus-newsgroup-directory-form newsgroup))
2927                    "/" (int-to-string (mail-header-number headers)))
2928            gnus-article-save-directory)))
2929     (if (and last-file
2930              (string-equal (file-name-directory default)
2931                            (file-name-directory last-file))
2932              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2933         default
2934       (or last-file default))))
2935
2936 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2937   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2938 If variable `gnus-use-long-file-name' is non-nil, it is
2939 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2940   (or last-file
2941       (expand-file-name
2942        (if (gnus-use-long-file-name 'not-save)
2943            (gnus-capitalize-newsgroup newsgroup)
2944          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2945        gnus-article-save-directory)))
2946
2947 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2948   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2949 If variable `gnus-use-long-file-name' is non-nil, it is
2950 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2951   (or last-file
2952       (expand-file-name
2953        (if (gnus-use-long-file-name 'not-save)
2954            newsgroup
2955          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2956        gnus-article-save-directory)))
2957
2958 ;; For subscribing new newsgroup
2959
2960 (defun gnus-subscribe-hierarchical-interactive (groups)
2961   (let ((groups (sort groups 'string<))
2962         prefixes prefix start ans group starts)
2963     (while groups
2964       (setq prefixes (list "^"))
2965       (while (and groups prefixes)
2966         (while (not (string-match (car prefixes) (car groups)))
2967           (setq prefixes (cdr prefixes)))
2968         (setq prefix (car prefixes))
2969         (setq start (1- (length prefix)))
2970         (if (and (string-match "[^\\.]\\." (car groups) start)
2971                  (cdr groups)
2972                  (setq prefix
2973                        (concat "^" (substring (car groups) 0 (match-end 0))))
2974                  (string-match prefix (cadr groups)))
2975             (progn
2976               (setq prefixes (cons prefix prefixes))
2977               (message "Descend hierarchy %s? ([y]nsq): "
2978                        (substring prefix 1 (1- (length prefix))))
2979               (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q)))
2980                 (ding)
2981                 (message "Descend hierarchy %s? ([y]nsq): "
2982                          (substring prefix 1 (1- (length prefix)))))
2983               (cond ((= ans ?n)
2984                      (while (and groups
2985                                  (string-match prefix
2986                                                (setq group (car groups))))
2987                        (setq gnus-killed-list
2988                              (cons group gnus-killed-list))
2989                        (gnus-sethash group group gnus-killed-hashtb)
2990                        (setq groups (cdr groups)))
2991                      (setq starts (cdr starts)))
2992                     ((= ans ?s)
2993                      (while (and groups
2994                                  (string-match prefix
2995                                                (setq group (car groups))))
2996                        (gnus-sethash group group gnus-killed-hashtb)
2997                        (gnus-subscribe-alphabetically (car groups))
2998                        (setq groups (cdr groups)))
2999                      (setq starts (cdr starts)))
3000                     ((= ans ?q)
3001                      (while groups
3002                        (setq group (car groups))
3003                        (setq gnus-killed-list (cons group gnus-killed-list))
3004                        (gnus-sethash group group gnus-killed-hashtb)
3005                        (setq groups (cdr groups))))
3006                     (t nil)))
3007           (message "Subscribe %s? ([n]yq)" (car groups))
3008           (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n)))
3009             (ding)
3010             (message "Subscribe %s? ([n]yq)" (car groups)))
3011           (setq group (car groups))
3012           (cond ((= ans ?y)
3013                  (gnus-subscribe-alphabetically (car groups))
3014                  (gnus-sethash group group gnus-killed-hashtb))
3015                 ((= ans ?q)
3016                  (while groups
3017                    (setq group (car groups))
3018                    (setq gnus-killed-list (cons group gnus-killed-list))
3019                    (gnus-sethash group group gnus-killed-hashtb)
3020                    (setq groups (cdr groups))))
3021                 (t
3022                  (setq gnus-killed-list (cons group gnus-killed-list))
3023                  (gnus-sethash group group gnus-killed-hashtb)))
3024           (setq groups (cdr groups)))))))
3025
3026 (defun gnus-subscribe-randomly (newsgroup)
3027   "Subscribe new NEWSGROUP by making it the first newsgroup."
3028   (gnus-subscribe-newsgroup newsgroup))
3029
3030 (defun gnus-subscribe-alphabetically (newgroup)
3031   "Subscribe new NEWSGROUP and insert it in alphabetical order."
3032   (let ((groups (cdr gnus-newsrc-alist))
3033         before)
3034     (while (and (not before) groups)
3035       (if (string< newgroup (caar groups))
3036           (setq before (caar groups))
3037         (setq groups (cdr groups))))
3038     (gnus-subscribe-newsgroup newgroup before)))
3039
3040 (defun gnus-subscribe-hierarchically (newgroup)
3041   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
3042   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
3043   (save-excursion
3044     (set-buffer (find-file-noselect gnus-current-startup-file))
3045     (let ((groupkey newgroup)
3046           before)
3047       (while (and (not before) groupkey)
3048         (goto-char (point-min))
3049         (let ((groupkey-re
3050                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
3051           (while (and (re-search-forward groupkey-re nil t)
3052                       (progn
3053                         (setq before (match-string 1))
3054                         (string< before newgroup)))))
3055         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
3056         (setq groupkey
3057               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
3058                   (substring groupkey (match-beginning 1) (match-end 1)))))
3059       (gnus-subscribe-newsgroup newgroup before))
3060     (kill-buffer (current-buffer))))
3061
3062 (defun gnus-subscribe-interactively (group)
3063   "Subscribe the new GROUP interactively.
3064 It is inserted in hierarchical newsgroup order if subscribed.  If not,
3065 it is killed."
3066   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
3067       (gnus-subscribe-hierarchically group)
3068     (push group gnus-killed-list)))
3069
3070 (defun gnus-subscribe-zombies (group)
3071   "Make the new GROUP into a zombie group."
3072   (push group gnus-zombie-list))
3073
3074 (defun gnus-subscribe-killed (group)
3075   "Make the new GROUP a killed group."
3076   (push group gnus-killed-list))
3077
3078 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
3079   "Subscribe new NEWSGROUP.
3080 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
3081 the first newsgroup."
3082   ;; We subscribe the group by changing its level to `subscribed'.
3083   (gnus-group-change-level
3084    newsgroup gnus-level-default-subscribed
3085    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
3086   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
3087
3088 ;; For directories
3089
3090 (defun gnus-newsgroup-directory-form (newsgroup)
3091   "Make hierarchical directory name from NEWSGROUP name."
3092   (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
3093         (len (length newsgroup))
3094         idx)
3095     ;; If this is a foreign group, we don't want to translate the
3096     ;; entire name.
3097     (if (setq idx (string-match ":" newsgroup))
3098         (aset newsgroup idx ?/)
3099       (setq idx 0))
3100     ;; Replace all occurrences of `.' with `/'.
3101     (while (< idx len)
3102       (if (= (aref newsgroup idx) ?.)
3103           (aset newsgroup idx ?/))
3104       (setq idx (1+ idx)))
3105     newsgroup))
3106
3107 (defun gnus-newsgroup-savable-name (group)
3108   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
3109   ;; with dots.
3110   (nnheader-replace-chars-in-string group ?/ ?.))
3111
3112 (defun gnus-make-directory (dir)
3113   "Make DIRECTORY recursively."
3114   ;; Why don't we use `(make-directory dir 'parents)'?  That's just one
3115   ;; of the many mysteries of the universe.
3116   (let* ((dir (expand-file-name dir default-directory))
3117          dirs err)
3118     (if (string-match "/$" dir)
3119         (setq dir (substring dir 0 (match-beginning 0))))
3120     ;; First go down the path until we find a directory that exists.
3121     (while (not (file-exists-p dir))
3122       (setq dirs (cons dir dirs))
3123       (string-match "/[^/]+$" dir)
3124       (setq dir (substring dir 0 (match-beginning 0))))
3125     ;; Then create all the subdirs.
3126     (while (and dirs (not err))
3127       (condition-case ()
3128           (make-directory (car dirs))
3129         (error (setq err t)))
3130       (setq dirs (cdr dirs)))
3131     ;; We return whether we were successful or not.
3132     (not dirs)))
3133
3134 (defun gnus-capitalize-newsgroup (newsgroup)
3135   "Capitalize NEWSGROUP name."
3136   (and (not (zerop (length newsgroup)))
3137        (concat (char-to-string (upcase (aref newsgroup 0)))
3138                (substring newsgroup 1))))
3139
3140 ;; Various... things.
3141
3142 (defun gnus-simplify-subject (subject &optional re-only)
3143   "Remove `Re:' and words in parentheses.
3144 If RE-ONLY is non-nil, strip leading `Re:'s only."
3145   (let ((case-fold-search t))           ;Ignore case.
3146     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
3147     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
3148       (setq subject (substring subject (match-end 0))))
3149     ;; Remove uninteresting prefixes.
3150     (if (and (not re-only)
3151              gnus-simplify-ignored-prefixes
3152              (string-match gnus-simplify-ignored-prefixes subject))
3153         (setq subject (substring subject (match-end 0))))
3154     ;; Remove words in parentheses from end.
3155     (unless re-only
3156       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
3157         (setq subject (substring subject 0 (match-beginning 0)))))
3158     ;; Return subject string.
3159     subject))
3160
3161 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
3162 ;; all whitespace.
3163 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
3164 (defun gnus-simplify-buffer-fuzzy ()
3165   (let ((case-fold-search t))
3166     (goto-char (point-min))
3167     (while (search-forward "\t" nil t)
3168       (replace-match " " t t))
3169     (goto-char (point-min))
3170     (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
3171     (goto-char (match-beginning 0))
3172     (while (or
3173             (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
3174             (looking-at "^[[].*: .*[]]$"))
3175       (goto-char (point-min))
3176       (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
3177                                 nil t)
3178         (replace-match "" t t))
3179       (goto-char (point-min))
3180       (while (re-search-forward "^[[].*: .*[]]$" nil t)
3181         (goto-char (match-end 0))
3182         (delete-char -1)
3183         (delete-region
3184          (progn (goto-char (match-beginning 0)))
3185          (re-search-forward ":"))))
3186     (goto-char (point-min))
3187     (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
3188       (replace-match "" t t))
3189     (goto-char (point-min))
3190     (while (re-search-forward "  +" nil t)
3191       (replace-match " " t t))
3192     (goto-char (point-min))
3193     (while (re-search-forward " $" nil t)
3194       (replace-match "" t t))
3195     (goto-char (point-min))
3196     (while (re-search-forward "^ +" nil t)
3197       (replace-match "" t t))
3198     (goto-char (point-min))
3199     (when gnus-simplify-subject-fuzzy-regexp
3200       (if (listp gnus-simplify-subject-fuzzy-regexp)
3201           (let ((list gnus-simplify-subject-fuzzy-regexp))
3202             (while list
3203               (goto-char (point-min))
3204               (while (re-search-forward (car list) nil t)
3205                 (replace-match "" t t))
3206               (setq list (cdr list))))
3207         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
3208           (replace-match "" t t))))))
3209
3210 (defun gnus-simplify-subject-fuzzy (subject)
3211   "Siplify a subject string fuzzily."
3212   (save-excursion
3213     (gnus-set-work-buffer)
3214     (let ((case-fold-search t))
3215       (insert subject)
3216       (inline (gnus-simplify-buffer-fuzzy))
3217       (buffer-string))))
3218
3219 ;; Add the current buffer to the list of buffers to be killed on exit.
3220 (defun gnus-add-current-to-buffer-list ()
3221   (or (memq (current-buffer) gnus-buffer-list)
3222       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
3223
3224 (defun gnus-string> (s1 s2)
3225   (not (or (string< s1 s2)
3226            (string= s1 s2))))
3227
3228 (defun gnus-read-active-file-p ()
3229   "Say whether the active file has been read from `gnus-select-method'."
3230   (memq gnus-select-method gnus-have-read-active-file))
3231
3232 ;;; General various misc type functions.
3233
3234 (defun gnus-clear-system ()
3235   "Clear all variables and buffers."
3236   ;; Clear Gnus variables.
3237   (let ((variables gnus-variable-list))
3238     (while variables
3239       (set (car variables) nil)
3240       (setq variables (cdr variables))))
3241   ;; Clear other internal variables.
3242   (setq gnus-list-of-killed-groups nil
3243         gnus-have-read-active-file nil
3244         gnus-newsrc-alist nil
3245         gnus-newsrc-hashtb nil
3246         gnus-killed-list nil
3247         gnus-zombie-list nil
3248         gnus-killed-hashtb nil
3249         gnus-active-hashtb nil
3250         gnus-moderated-list nil
3251         gnus-description-hashtb nil
3252         gnus-current-headers nil
3253         gnus-thread-indent-array nil
3254         gnus-newsgroup-headers nil
3255         gnus-newsgroup-name nil
3256         gnus-server-alist nil
3257         gnus-group-list-mode nil
3258         gnus-opened-servers nil
3259         gnus-group-mark-positions nil
3260         gnus-newsgroup-data nil
3261         gnus-newsgroup-unreads nil
3262         nnoo-state-alist nil
3263         gnus-current-select-method nil)
3264   (gnus-shutdown 'gnus)
3265   ;; Kill the startup file.
3266   (and gnus-current-startup-file
3267        (get-file-buffer gnus-current-startup-file)
3268        (kill-buffer (get-file-buffer gnus-current-startup-file)))
3269   ;; Clear the dribble buffer.
3270   (gnus-dribble-clear)
3271   ;; Kill global KILL file buffer.
3272   (when (get-file-buffer (gnus-newsgroup-kill-file nil))
3273     (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
3274   (gnus-kill-buffer nntp-server-buffer)
3275   ;; Kill Gnus buffers.
3276   (while gnus-buffer-list
3277     (gnus-kill-buffer (pop gnus-buffer-list)))
3278   ;; Remove Gnus frames.
3279   (gnus-kill-gnus-frames))
3280
3281 (defun gnus-kill-gnus-frames ()
3282   "Kill all frames Gnus has created."
3283   (while gnus-created-frames
3284     (when (frame-live-p (car gnus-created-frames))
3285       ;; We slap a condition-case around this `delete-frame' to ensure 
3286       ;; against errors if we try do delete the single frame that's left.
3287       (condition-case ()
3288           (delete-frame (car gnus-created-frames))
3289         (error nil)))
3290     (pop gnus-created-frames)))
3291
3292 (defun gnus-windows-old-to-new (setting)
3293   ;; First we take care of the really, really old Gnus 3 actions.
3294   (when (symbolp setting)
3295     (setq setting
3296           ;; Take care of ooold GNUS 3.x values.
3297           (cond ((eq setting 'SelectArticle) 'article)
3298                 ((memq setting '(SelectSubject ExpandSubject)) 'summary)
3299                 ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group)
3300                 (t setting))))
3301   (if (or (listp setting)
3302           (not (and gnus-window-configuration
3303                     (memq setting '(group summary article)))))
3304       setting
3305     (let* ((setting (if (eq setting 'group)
3306                         (if (assq 'newsgroup gnus-window-configuration)
3307                             'newsgroup
3308                           'newsgroups) setting))
3309            (elem (cadr (assq setting gnus-window-configuration)))
3310            (total (apply '+ elem))
3311            (types '(group summary article))
3312            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
3313            (i 0)
3314            perc
3315            out)
3316       (while (< i 3)
3317         (or (not (numberp (nth i elem)))
3318             (zerop (nth i elem))
3319             (progn
3320               (setq perc (if (= i 2)
3321                              1.0
3322                            (/ (float (nth 0 elem)) total)))
3323               (setq out (cons (if (eq pbuf (nth i types))
3324                                   (list (nth i types) perc 'point)
3325                                 (list (nth i types) perc))
3326                               out))))
3327         (setq i (1+ i)))
3328       `(vertical 1.0 ,@(nreverse out)))))
3329
3330 ;;;###autoload
3331 (defun gnus-add-configuration (conf)
3332   "Add the window configuration CONF to `gnus-buffer-configuration'."
3333   (setq gnus-buffer-configuration
3334         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
3335                          gnus-buffer-configuration))))
3336
3337 (defvar gnus-frame-list nil)
3338
3339 (defun gnus-configure-frame (split &optional window)
3340   "Split WINDOW according to SPLIT."
3341   (unless window
3342     (setq window (get-buffer-window (current-buffer))))
3343   (select-window window)
3344   ;; This might be an old-stylee buffer config.
3345   (when (vectorp split)
3346     (setq split (append split nil)))
3347   (when (or (consp (car split))
3348             (vectorp (car split)))
3349     (push 1.0 split)
3350     (push 'vertical split))
3351   ;; The SPLIT might be something that is to be evaled to
3352   ;; return a new SPLIT.
3353   (while (and (not (assq (car split) gnus-window-to-buffer))
3354               (gnus-functionp (car split)))
3355     (setq split (eval split)))
3356   (let* ((type (car split))
3357          (subs (cddr split))
3358          (len (if (eq type 'horizontal) (window-width) (window-height)))
3359          (total 0)
3360          (window-min-width (or gnus-window-min-width window-min-width))
3361          (window-min-height (or gnus-window-min-height window-min-height))
3362          s result new-win rest comp-subs size sub)
3363     (cond
3364      ;; Nothing to do here.
3365      ((null split))
3366      ;; Don't switch buffers.
3367      ((null type)
3368       (and (memq 'point split) window))
3369      ;; This is a buffer to be selected.
3370      ((not (memq type '(frame horizontal vertical)))
3371       (let ((buffer (cond ((stringp type) type)
3372                           (t (cdr (assq type gnus-window-to-buffer)))))
3373             buf)
3374         (unless buffer
3375           (error "Illegal buffer type: %s" type))
3376         (unless (setq buf (get-buffer (if (symbolp buffer)
3377                                           (symbol-value buffer) buffer)))
3378           (setq buf (get-buffer-create (if (symbolp buffer)
3379                                            (symbol-value buffer) buffer))))
3380         (switch-to-buffer buf)
3381         ;; We return the window if it has the `point' spec.
3382         (and (memq 'point split) window)))
3383      ;; This is a frame split.
3384      ((eq type 'frame)
3385       (unless gnus-frame-list
3386         (setq gnus-frame-list (list (window-frame
3387                                      (get-buffer-window (current-buffer))))))
3388       (let ((i 0)
3389             params frame fresult)
3390         (while (< i (length subs))
3391           ;; Frame parameter is gotten from the sub-split.
3392           (setq params (cadr (elt subs i)))
3393           ;; It should be a list.
3394           (unless (listp params)
3395             (setq params nil))
3396           ;; Create a new frame?
3397           (unless (setq frame (elt gnus-frame-list i))
3398             (nconc gnus-frame-list (list (setq frame (make-frame params))))
3399             (push frame gnus-created-frames))
3400           ;; Is the old frame still alive?
3401           (unless (frame-live-p frame)
3402             (setcar (nthcdr i gnus-frame-list)
3403                     (setq frame (make-frame params))))
3404           ;; Select the frame in question and do more splits there.
3405           (select-frame frame)
3406           (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
3407           (incf i))
3408         ;; Select the frame that has the selected buffer.
3409         (when fresult
3410           (select-frame (window-frame fresult)))))
3411      ;; This is a normal split.
3412      (t
3413       (when (> (length subs) 0)
3414         ;; First we have to compute the sizes of all new windows.
3415         (while subs
3416           (setq sub (append (pop subs) nil))
3417           (while (and (not (assq (car sub) gnus-window-to-buffer))
3418                       (gnus-functionp (car sub)))
3419             (setq sub (eval sub)))
3420           (when sub
3421             (push sub comp-subs)
3422             (setq size (cadar comp-subs))
3423             (cond ((equal size 1.0)
3424                    (setq rest (car comp-subs))
3425                    (setq s 0))
3426                   ((floatp size)
3427                    (setq s (floor (* size len))))
3428                   ((integerp size)
3429                    (setq s size))
3430                   (t
3431                    (error "Illegal size: %s" size)))
3432             ;; Try to make sure that we are inside the safe limits.
3433             (cond ((zerop s))
3434                   ((eq type 'horizontal)
3435                    (setq s (max s window-min-width)))
3436                   ((eq type 'vertical)
3437                    (setq s (max s window-min-height))))
3438             (setcar (cdar comp-subs) s)
3439             (incf total s)))
3440         ;; Take care of the "1.0" spec.
3441         (if rest
3442             (setcar (cdr rest) (- len total))
3443           (error "No 1.0 specs in %s" split))
3444         ;; The we do the actual splitting in a nice recursive
3445         ;; fashion.
3446         (setq comp-subs (nreverse comp-subs))
3447         (while comp-subs
3448           (if (null (cdr comp-subs))
3449               (setq new-win window)
3450             (setq new-win
3451                   (split-window window (cadar comp-subs)
3452                                 (eq type 'horizontal))))
3453           (setq result (or (gnus-configure-frame
3454                             (car comp-subs) window) result))
3455           (select-window new-win)
3456           (setq window new-win)
3457           (setq comp-subs (cdr comp-subs))))
3458       ;; Return the proper window, if any.
3459       (when result
3460         (select-window result))))))
3461
3462 (defvar gnus-frame-split-p nil)
3463
3464 (defun gnus-configure-windows (setting &optional force)
3465   (setq setting (gnus-windows-old-to-new setting))
3466   (let ((split (if (symbolp setting)
3467                    (cadr (assq setting gnus-buffer-configuration))
3468                  setting))
3469         all-visible)
3470
3471     (setq gnus-frame-split-p nil)
3472
3473     (unless split
3474       (error "No such setting: %s" setting))
3475
3476     (if (and (setq all-visible (gnus-all-windows-visible-p split))
3477              (not force))
3478         ;; All the windows mentioned are already visible, so we just
3479         ;; put point in the assigned buffer, and do not touch the
3480         ;; winconf.
3481         (select-window all-visible)
3482
3483       ;; Either remove all windows or just remove all Gnus windows.
3484       (let ((frame (selected-frame)))
3485         (unwind-protect
3486             (if gnus-use-full-window
3487                 ;; We want to remove all other windows.
3488                 (if (not gnus-frame-split-p)
3489                     ;; This is not a `frame' split, so we ignore the
3490                     ;; other frames.  
3491                     (delete-other-windows)
3492                   ;; This is a `frame' split, so we delete all windows
3493                   ;; on all frames.
3494                   (mapcar 
3495                    (lambda (frame)
3496                      (unless (eq (cdr (assq 'minibuffer
3497                                             (frame-parameters frame)))
3498                                  'only)
3499                        (select-frame frame)
3500                        (delete-other-windows)))
3501                    (frame-list)))
3502               ;; Just remove some windows.
3503               (gnus-remove-some-windows)
3504               (switch-to-buffer nntp-server-buffer))
3505           (select-frame frame)))
3506
3507       (switch-to-buffer nntp-server-buffer)
3508       (gnus-configure-frame split (get-buffer-window (current-buffer))))))
3509
3510 (defun gnus-all-windows-visible-p (split)
3511   "Say whether all buffers in SPLIT are currently visible.
3512 In particular, the value returned will be the window that
3513 should have point."
3514   (let ((stack (list split))
3515         (all-visible t)
3516         type buffer win buf)
3517     (while (and (setq split (pop stack))
3518                 all-visible)
3519       ;; Be backwards compatible.
3520       (when (vectorp split)
3521         (setq split (append split nil)))
3522       (when (or (consp (car split))
3523                 (vectorp (car split)))
3524         (push 1.0 split)
3525         (push 'vertical split))
3526       ;; The SPLIT might be something that is to be evaled to
3527       ;; return a new SPLIT.
3528       (while (and (not (assq (car split) gnus-window-to-buffer))
3529                   (gnus-functionp (car split)))
3530         (setq split (eval split)))
3531
3532       (setq type (elt split 0))
3533       (cond
3534        ;; Nothing here.
3535        ((null split) t)
3536        ;; A buffer.
3537        ((not (memq type '(horizontal vertical frame)))
3538         (setq buffer (cond ((stringp type) type)
3539                            (t (cdr (assq type gnus-window-to-buffer)))))
3540         (unless buffer
3541           (error "Illegal buffer type: %s" type))
3542         (when (setq buf (get-buffer (if (symbolp buffer)
3543                                         (symbol-value buffer)
3544                                       buffer)))
3545           (setq win (get-buffer-window buf t)))
3546         (if win
3547             (when (memq 'point split)
3548                 (setq all-visible win))
3549           (setq all-visible nil)))
3550        (t
3551         (when (eq type 'frame)
3552           (setq gnus-frame-split-p t))
3553         (setq stack (append (cddr split) stack)))))
3554     (unless (eq all-visible t)
3555       all-visible)))
3556
3557 (defun gnus-window-top-edge (&optional window)
3558   (nth 1 (window-edges window)))
3559
3560 (defun gnus-remove-some-windows ()
3561   (let ((buffers gnus-window-to-buffer)
3562         buf bufs lowest-buf lowest)
3563     (save-excursion
3564       ;; Remove windows on all known Gnus buffers.
3565       (while buffers
3566         (setq buf (cdar buffers))
3567         (if (symbolp buf)
3568             (setq buf (and (boundp buf) (symbol-value buf))))
3569         (and buf
3570              (get-buffer-window buf)
3571              (progn
3572                (setq bufs (cons buf bufs))
3573                (pop-to-buffer buf)
3574                (if (or (not lowest)
3575                        (< (gnus-window-top-edge) lowest))
3576                    (progn
3577                      (setq lowest (gnus-window-top-edge))
3578                      (setq lowest-buf buf)))))
3579         (setq buffers (cdr buffers)))
3580       ;; Remove windows on *all* summary buffers.
3581       (walk-windows
3582        (lambda (win)
3583          (let ((buf (window-buffer win)))
3584            (if (string-match    "^\\*Summary" (buffer-name buf))
3585                (progn
3586                  (setq bufs (cons buf bufs))
3587                  (pop-to-buffer buf)
3588                  (if (or (not lowest)
3589                          (< (gnus-window-top-edge) lowest))
3590                      (progn
3591                        (setq lowest-buf buf)
3592                        (setq lowest (gnus-window-top-edge)))))))))
3593       (and lowest-buf
3594            (progn
3595              (pop-to-buffer lowest-buf)
3596              (switch-to-buffer nntp-server-buffer)))
3597       (while bufs
3598         (and (not (eq (car bufs) lowest-buf))
3599              (delete-windows-on (car bufs)))
3600         (setq bufs (cdr bufs))))))
3601
3602 (defun gnus-version (&optional arg)
3603   "Version number of this version of Gnus.
3604 If ARG, insert string at point."
3605   (interactive "P")
3606   (let ((methods gnus-valid-select-methods)
3607         (mess gnus-version)
3608         meth)
3609     ;; Go through all the legal select methods and add their version
3610     ;; numbers to the total version string.  Only the backends that are
3611     ;; currently in use will have their message numbers taken into
3612     ;; consideration.
3613     (while methods
3614       (setq meth (intern (concat (caar methods) "-version")))
3615       (and (boundp meth)
3616            (stringp (symbol-value meth))
3617            (setq mess (concat mess "; " (symbol-value meth))))
3618       (setq methods (cdr methods)))
3619     (if arg
3620         (insert (message mess))
3621       (message mess))))
3622
3623 (defun gnus-info-find-node ()
3624   "Find Info documentation of Gnus."
3625   (interactive)
3626   ;; Enlarge info window if needed.
3627   (let ((mode major-mode)
3628         gnus-info-buffer)
3629     (Info-goto-node (cadr (assq mode gnus-info-nodes)))
3630     (setq gnus-info-buffer (current-buffer))
3631     (gnus-configure-windows 'info)))
3632
3633 (defun gnus-days-between (date1 date2)
3634   ;; Return the number of days between date1 and date2.
3635   (- (gnus-day-number date1) (gnus-day-number date2)))
3636
3637 (defun gnus-day-number (date)
3638   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3639                      (timezone-parse-date date))))
3640     (timezone-absolute-from-gregorian
3641      (nth 1 dat) (nth 2 dat) (car dat))))
3642
3643 (defun gnus-encode-date (date)
3644   "Convert DATE to internal time."
3645   (let* ((parse (timezone-parse-date date))
3646          (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
3647          (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
3648     (encode-time (caddr time) (cadr time) (car time)
3649                  (caddr date) (cadr date) (car date) (nth 4 date))))
3650
3651 (defun gnus-time-minus (t1 t2)
3652   "Subtract two internal times."
3653   (let ((borrow (< (cadr t1) (cadr t2))))
3654     (list (- (car t1) (car t2) (if borrow 1 0))
3655           (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3656
3657 (defun gnus-file-newer-than (file date)
3658   (let ((fdate (nth 5 (file-attributes file))))
3659     (or (> (car fdate) (car date))
3660         (and (= (car fdate) (car date))
3661              (> (nth 1 fdate) (nth 1 date))))))
3662
3663 (defmacro gnus-local-set-keys (&rest plist)
3664   "Set the keys in PLIST in the current keymap."
3665   `(gnus-define-keys-1 (current-local-map) ',plist))
3666
3667 (defmacro gnus-define-keys (keymap &rest plist)
3668   "Define all keys in PLIST in KEYMAP."
3669   `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
3670
3671 (put 'gnus-define-keys 'lisp-indent-function 1)
3672 (put 'gnus-define-keys 'lisp-indent-hook 1)
3673 (put 'gnus-define-keymap 'lisp-indent-function 1)
3674 (put 'gnus-define-keymap 'lisp-indent-hook 1)
3675
3676 (defmacro gnus-define-keymap (keymap &rest plist)
3677   "Define all keys in PLIST in KEYMAP."
3678   `(gnus-define-keys-1 ,keymap (quote ,plist)))
3679
3680 (defun gnus-define-keys-1 (keymap plist)
3681   (when (null keymap)
3682     (error "Can't set keys in a null keymap"))
3683   (cond ((symbolp keymap)
3684          (setq keymap (symbol-value keymap)))
3685         ((keymapp keymap))
3686         ((listp keymap)
3687          (set (car keymap) nil)
3688          (define-prefix-command (car keymap))
3689          (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
3690          (setq keymap (symbol-value (car keymap)))))
3691   (let (key)
3692     (while plist
3693       (when (symbolp (setq key (pop plist)))
3694         (setq key (symbol-value key)))
3695       (define-key keymap key (pop plist)))))
3696
3697 (defun gnus-group-read-only-p (&optional group)
3698   "Check whether GROUP supports editing or not.
3699 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3700 that that variable is buffer-local to the summary buffers."
3701   (let ((group (or group gnus-newsgroup-name)))
3702     (not (gnus-check-backend-function 'request-replace-article group))))
3703
3704 (defun gnus-group-total-expirable-p (group)
3705   "Check whether GROUP is total-expirable or not."
3706   (let ((params (gnus-info-params (gnus-get-info group))))
3707     (or (memq 'total-expire params)
3708         (cdr (assq 'total-expire params)) ; (total-expire . t)
3709         (and gnus-total-expirable-newsgroups ; Check var.
3710              (string-match gnus-total-expirable-newsgroups group)))))
3711
3712 (defun gnus-group-auto-expirable-p (group)
3713   "Check whether GROUP is total-expirable or not."
3714   (let ((params (gnus-info-params (gnus-get-info group))))
3715     (or (memq 'auto-expire params)
3716         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3717         (and gnus-auto-expirable-newsgroups ; Check var.
3718              (string-match gnus-auto-expirable-newsgroups group)))))
3719
3720 (defun gnus-virtual-group-p (group)
3721   "Say whether GROUP is virtual or not."
3722   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3723                         gnus-valid-select-methods)))
3724
3725 (defun gnus-news-group-p (group &optional article)
3726   "Return non-nil if GROUP (and ARTICLE) come from a news server."
3727   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
3728       (and (gnus-member-of-valid 'post-mail group) ; Combined group.
3729            (eq (gnus-request-type group article) 'news))))
3730
3731 (defsubst gnus-simplify-subject-fully (subject)
3732   "Simplify a subject string according to the user's wishes."
3733   (cond
3734    ((null gnus-summary-gather-subject-limit)
3735     (gnus-simplify-subject-re subject))
3736    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3737     (gnus-simplify-subject-fuzzy subject))
3738    ((numberp gnus-summary-gather-subject-limit)
3739     (gnus-limit-string (gnus-simplify-subject-re subject)
3740                        gnus-summary-gather-subject-limit))
3741    (t
3742     subject)))
3743
3744 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
3745   "Check whether two subjects are equal.  If optional argument
3746 simple-first is t, first argument is already simplified."
3747   (cond
3748    ((null simple-first)
3749     (equal (gnus-simplify-subject-fully s1)
3750            (gnus-simplify-subject-fully s2)))
3751    (t
3752     (equal s1
3753            (gnus-simplify-subject-fully s2)))))
3754
3755 ;; Returns a list of writable groups.
3756 (defun gnus-writable-groups ()
3757   (let ((alist gnus-newsrc-alist)
3758         groups group)
3759     (while (setq group (car (pop alist)))
3760       (unless (gnus-group-read-only-p group)
3761         (push group groups)))
3762     (nreverse groups)))
3763
3764 (defun gnus-completing-read (default prompt &rest args)
3765   ;; Like `completing-read', except that DEFAULT is the default argument.
3766   (let* ((prompt (if default 
3767                      (concat prompt " (default " default ") ")
3768                    (concat prompt " ")))
3769          (answer (apply 'completing-read prompt args)))
3770     (if (or (null answer) (zerop (length answer)))
3771         default
3772       answer)))
3773
3774 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3775 ;; the echo area.
3776 (defun gnus-y-or-n-p (prompt)
3777   (prog1
3778       (y-or-n-p prompt)
3779     (message "")))
3780
3781 (defun gnus-yes-or-no-p (prompt)
3782   (prog1
3783       (yes-or-no-p prompt)
3784     (message "")))
3785
3786 ;; Check whether to use long file names.
3787 (defun gnus-use-long-file-name (symbol)
3788   ;; The variable has to be set...
3789   (and gnus-use-long-file-name
3790        ;; If it isn't a list, then we return t.
3791        (or (not (listp gnus-use-long-file-name))
3792            ;; If it is a list, and the list contains `symbol', we
3793            ;; return nil.
3794            (not (memq symbol gnus-use-long-file-name)))))
3795
3796 ;; I suspect there's a better way, but I haven't taken the time to do
3797 ;; it yet. -erik selberg@cs.washington.edu
3798 (defun gnus-dd-mmm (messy-date)
3799   "Return a string like DD-MMM from a big messy string"
3800   (let ((datevec (condition-case () (timezone-parse-date messy-date) 
3801                    (error nil))))
3802     (if (not datevec)
3803         "??-???"
3804       (format "%2s-%s"
3805               (condition-case ()
3806                   ;; Make sure leading zeroes are stripped.
3807                   (number-to-string (string-to-number (aref datevec 2)))
3808                 (error "??"))
3809               (capitalize
3810                (or (car
3811                     (nth (1- (string-to-number (aref datevec 1)))
3812                          timezone-months-assoc))
3813                    "???"))))))
3814
3815 (defun gnus-mode-string-quote (string)
3816   "Quote all \"%\" in STRING."
3817   (save-excursion
3818     (gnus-set-work-buffer)
3819     (insert string)
3820     (goto-char (point-min))
3821     (while (search-forward "%" nil t)
3822       (insert "%"))
3823     (buffer-string)))
3824
3825 ;; Make a hash table (default and minimum size is 255).
3826 ;; Optional argument HASHSIZE specifies the table size.
3827 (defun gnus-make-hashtable (&optional hashsize)
3828   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3829
3830 ;; Make a number that is suitable for hashing; bigger than MIN and one
3831 ;; less than 2^x.
3832 (defun gnus-create-hash-size (min)
3833   (let ((i 1))
3834     (while (< i min)
3835       (setq i (* 2 i)))
3836     (1- i)))
3837
3838 ;; Show message if message has a lower level than `gnus-verbose'.
3839 ;; Guideline for numbers:
3840 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3841 ;; for things that take a long time, 7 - not very important messages
3842 ;; on stuff, 9 - messages inside loops.
3843 (defun gnus-message (level &rest args)
3844   (if (<= level gnus-verbose)
3845       (apply 'message args)
3846     ;; We have to do this format thingy here even if the result isn't
3847     ;; shown - the return value has to be the same as the return value
3848     ;; from `message'.
3849     (apply 'format args)))
3850
3851 (defun gnus-error (level &rest args)
3852   "Beep an error if LEVEL is equal to or less than `gnus-verbose'."
3853   (when (<= (floor level) gnus-verbose)
3854     (apply 'message args)
3855     (ding)
3856     (let (duration)
3857       (when (and (floatp level)
3858                  (not (zerop (setq duration (* 10 (- level (floor level)))))))
3859         (sit-for duration))))
3860   nil)
3861
3862 ;; Generate a unique new group name.
3863 (defun gnus-generate-new-group-name (leaf)
3864   (let ((name leaf)
3865         (num 0))
3866     (while (gnus-gethash name gnus-newsrc-hashtb)
3867       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3868     name))
3869
3870 (defsubst gnus-hide-text (b e props)
3871   "Set text PROPS on the B to E region, extending `intangible' 1 past B."
3872   (gnus-add-text-properties b e props)
3873   (when (memq 'intangible props)
3874     (gnus-put-text-property (max (1- b) (point-min))
3875                        b 'intangible (cddr (memq 'intangible props)))))
3876
3877 (defsubst gnus-unhide-text (b e)
3878   "Remove hidden text properties from region between B and E."
3879   (remove-text-properties b e gnus-hidden-properties)
3880   (when (memq 'intangible gnus-hidden-properties)
3881     (gnus-put-text-property (max (1- b) (point-min))
3882                             b 'intangible nil)))
3883
3884 (defun gnus-hide-text-type (b e type)
3885   "Hide text of TYPE between B and E."
3886   (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties))))
3887
3888 (defun gnus-parent-headers (headers &optional generation)
3889   "Return the headers of the GENERATIONeth parent of HEADERS."
3890   (unless generation 
3891     (setq generation 1))
3892   (let (references parent)
3893     (while (and headers (not (zerop generation)))
3894       (setq references (mail-header-references headers))
3895       (when (and references
3896                  (setq parent (gnus-parent-id references))
3897                  (setq headers (car (gnus-id-to-thread parent))))
3898         (decf generation)))
3899     headers))
3900
3901 (defun gnus-parent-id (references)
3902   "Return the last Message-ID in REFERENCES."
3903   (when (and references
3904              (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references))
3905     (substring references (match-beginning 1) (match-end 1))))
3906
3907 (defun gnus-split-references (references)
3908   "Return a list of Message-IDs in REFERENCES."
3909   (let ((beg 0)
3910         ids)
3911     (while (string-match "<[^>]+>" references beg)
3912       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
3913             ids))
3914     (nreverse ids)))
3915
3916 (defun gnus-buffer-live-p (buffer)
3917   "Say whether BUFFER is alive or not."
3918   (and buffer
3919        (get-buffer buffer)
3920        (buffer-name (get-buffer buffer))))
3921
3922 (defun gnus-ephemeral-group-p (group)
3923   "Say whether GROUP is ephemeral or not."
3924   (gnus-group-get-parameter group 'quit-config))
3925
3926 (defun gnus-group-quit-config (group)
3927   "Return the quit-config of GROUP."
3928   (gnus-group-get-parameter group 'quit-config))
3929
3930 (defun gnus-simplify-mode-line ()
3931   "Make mode lines a bit simpler."
3932   (setq mode-line-modified "-- ")
3933   (when (listp mode-line-format)
3934     (make-local-variable 'mode-line-format)
3935     (setq mode-line-format (copy-sequence mode-line-format))
3936     (when (equal (nth 3 mode-line-format) "   ")
3937       (setcar (nthcdr 3 mode-line-format) " "))))
3938
3939 ;;; List and range functions
3940
3941 (defun gnus-last-element (list)
3942   "Return last element of LIST."
3943   (while (cdr list)
3944     (setq list (cdr list)))
3945   (car list))
3946
3947 (defun gnus-copy-sequence (list)
3948   "Do a complete, total copy of a list."
3949   (if (and (consp list) (not (consp (cdr list))))
3950       (cons (car list) (cdr list))
3951     (mapcar (lambda (elem) (if (consp elem)
3952                                (if (consp (cdr elem))
3953                                    (gnus-copy-sequence elem)
3954                                  (cons (car elem) (cdr elem)))
3955                              elem))
3956             list)))
3957
3958 (defun gnus-set-difference (list1 list2)
3959   "Return a list of elements of LIST1 that do not appear in LIST2."
3960   (let ((list1 (copy-sequence list1)))
3961     (while list2
3962       (setq list1 (delq (car list2) list1))
3963       (setq list2 (cdr list2)))
3964     list1))
3965
3966 (defun gnus-sorted-complement (list1 list2)
3967   "Return a list of elements of LIST1 that do not appear in LIST2.
3968 Both lists have to be sorted over <."
3969   (let (out)
3970     (if (or (null list1) (null list2))
3971         (or list1 list2)
3972       (while (and list1 list2)
3973         (cond ((= (car list1) (car list2))
3974                (setq list1 (cdr list1)
3975                      list2 (cdr list2)))
3976               ((< (car list1) (car list2))
3977                (setq out (cons (car list1) out))
3978                (setq list1 (cdr list1)))
3979               (t
3980                (setq out (cons (car list2) out))
3981                (setq list2 (cdr list2)))))
3982       (nconc (nreverse out) (or list1 list2)))))
3983
3984 (defun gnus-intersection (list1 list2)
3985   (let ((result nil))
3986     (while list2
3987       (if (memq (car list2) list1)
3988           (setq result (cons (car list2) result)))
3989       (setq list2 (cdr list2)))
3990     result))
3991
3992 (defun gnus-sorted-intersection (list1 list2)
3993   ;; LIST1 and LIST2 have to be sorted over <.
3994   (let (out)
3995     (while (and list1 list2)
3996       (cond ((= (car list1) (car list2))
3997              (setq out (cons (car list1) out)
3998                    list1 (cdr list1)
3999                    list2 (cdr list2)))
4000             ((< (car list1) (car list2))
4001              (setq list1 (cdr list1)))
4002             (t
4003              (setq list2 (cdr list2)))))
4004     (nreverse out)))
4005
4006 (defun gnus-set-sorted-intersection (list1 list2)
4007   ;; LIST1 and LIST2 have to be sorted over <.
4008   ;; This function modifies LIST1.
4009   (let* ((top (cons nil list1))
4010          (prev top))
4011     (while (and list1 list2)
4012       (cond ((= (car list1) (car list2))
4013              (setq prev list1
4014                    list1 (cdr list1)
4015                    list2 (cdr list2)))
4016             ((< (car list1) (car list2))
4017              (setcdr prev (cdr list1))
4018              (setq list1 (cdr list1)))
4019             (t
4020              (setq list2 (cdr list2)))))
4021     (setcdr prev nil)
4022     (cdr top)))
4023
4024 (defun gnus-compress-sequence (numbers &optional always-list)
4025   "Convert list of numbers to a list of ranges or a single range.
4026 If ALWAYS-LIST is non-nil, this function will always release a list of
4027 ranges."
4028   (let* ((first (car numbers))
4029          (last (car numbers))
4030          result)
4031     (if (null numbers)
4032         nil
4033       (if (not (listp (cdr numbers)))
4034           numbers
4035         (while numbers
4036           (cond ((= last (car numbers)) nil) ;Omit duplicated number
4037                 ((= (1+ last) (car numbers)) ;Still in sequence
4038                  (setq last (car numbers)))
4039                 (t                      ;End of one sequence
4040                  (setq result
4041                        (cons (if (= first last) first
4042                                (cons first last)) result))
4043                  (setq first (car numbers))
4044                  (setq last  (car numbers))))
4045           (setq numbers (cdr numbers)))
4046         (if (and (not always-list) (null result))
4047             (if (= first last) (list first) (cons first last))
4048           (nreverse (cons (if (= first last) first (cons first last))
4049                           result)))))))
4050
4051 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
4052 (defun gnus-uncompress-range (ranges)
4053   "Expand a list of ranges into a list of numbers.
4054 RANGES is either a single range on the form `(num . num)' or a list of
4055 these ranges."
4056   (let (first last result)
4057     (cond
4058      ((null ranges)
4059       nil)
4060      ((not (listp (cdr ranges)))
4061       (setq first (car ranges))
4062       (setq last (cdr ranges))
4063       (while (<= first last)
4064         (setq result (cons first result))
4065         (setq first (1+ first)))
4066       (nreverse result))
4067      (t
4068       (while ranges
4069         (if (atom (car ranges))
4070             (if (numberp (car ranges))
4071                 (setq result (cons (car ranges) result)))
4072           (setq first (caar ranges))
4073           (setq last  (cdar ranges))
4074           (while (<= first last)
4075             (setq result (cons first result))
4076             (setq first (1+ first))))
4077         (setq ranges (cdr ranges)))
4078       (nreverse result)))))
4079
4080 (defun gnus-add-to-range (ranges list)
4081   "Return a list of ranges that has all articles from both RANGES and LIST.
4082 Note: LIST has to be sorted over `<'."
4083   (if (not ranges)
4084       (gnus-compress-sequence list t)
4085     (setq list (copy-sequence list))
4086     (or (listp (cdr ranges))
4087         (setq ranges (list ranges)))
4088     (let ((out ranges)
4089           ilist lowest highest temp)
4090       (while (and ranges list)
4091         (setq ilist list)
4092         (setq lowest (or (and (atom (car ranges)) (car ranges))
4093                          (caar ranges)))
4094         (while (and list (cdr list) (< (cadr list) lowest))
4095           (setq list (cdr list)))
4096         (if (< (car ilist) lowest)
4097             (progn
4098               (setq temp list)
4099               (setq list (cdr list))
4100               (setcdr temp nil)
4101               (setq out (nconc (gnus-compress-sequence ilist t) out))))
4102         (setq highest (or (and (atom (car ranges)) (car ranges))
4103                           (cdar ranges)))
4104         (while (and list (<= (car list) highest))
4105           (setq list (cdr list)))
4106         (setq ranges (cdr ranges)))
4107       (if list
4108           (setq out (nconc (gnus-compress-sequence list t) out)))
4109       (setq out (sort out (lambda (r1 r2)
4110                             (< (or (and (atom r1) r1) (car r1))
4111                                (or (and (atom r2) r2) (car r2))))))
4112       (setq ranges out)
4113       (while ranges
4114         (if (atom (car ranges))
4115             (if (cdr ranges)
4116                 (if (atom (cadr ranges))
4117                     (if (= (1+ (car ranges)) (cadr ranges))
4118                         (progn
4119                           (setcar ranges (cons (car ranges)
4120                                                (cadr ranges)))
4121                           (setcdr ranges (cddr ranges))))
4122                   (if (= (1+ (car ranges)) (caadr ranges))
4123                       (progn
4124                         (setcar (cadr ranges) (car ranges))
4125                         (setcar ranges (cadr ranges))
4126                         (setcdr ranges (cddr ranges))))))
4127           (if (cdr ranges)
4128               (if (atom (cadr ranges))
4129                   (if (= (1+ (cdar ranges)) (cadr ranges))
4130                       (progn
4131                         (setcdr (car ranges) (cadr ranges))
4132                         (setcdr ranges (cddr ranges))))
4133                 (if (= (1+ (cdar ranges)) (caadr ranges))
4134                     (progn
4135                       (setcdr (car ranges) (cdadr ranges))
4136                       (setcdr ranges (cddr ranges)))))))
4137         (setq ranges (cdr ranges)))
4138       out)))
4139
4140 (defun gnus-remove-from-range (ranges list)
4141   "Return a list of ranges that has all articles from LIST removed from RANGES.
4142 Note: LIST has to be sorted over `<'."
4143   ;; !!! This function shouldn't look like this, but I've got a headache.
4144   (gnus-compress-sequence
4145    (gnus-sorted-complement
4146     (gnus-uncompress-range ranges) list)))
4147
4148 (defun gnus-member-of-range (number ranges)
4149   (if (not (listp (cdr ranges)))
4150       (and (>= number (car ranges))
4151            (<= number (cdr ranges)))
4152     (let ((not-stop t))
4153       (while (and ranges
4154                   (if (numberp (car ranges))
4155                       (>= number (car ranges))
4156                     (>= number (caar ranges)))
4157                   not-stop)
4158         (if (if (numberp (car ranges))
4159                 (= number (car ranges))
4160               (and (>= number (caar ranges))
4161                    (<= number (cdar ranges))))
4162             (setq not-stop nil))
4163         (setq ranges (cdr ranges)))
4164       (not not-stop))))
4165
4166 (defun gnus-range-length (range)
4167   "Return the length RANGE would have if uncompressed."
4168   (length (gnus-uncompress-range range)))
4169
4170 (defun gnus-sublist-p (list sublist)
4171   "Test whether all elements in SUBLIST are members of LIST."
4172   (let ((sublistp t))
4173     (while sublist
4174       (unless (memq (pop sublist) list)
4175         (setq sublistp nil
4176               sublist nil)))
4177     sublistp))
4178
4179 \f
4180 ;;;
4181 ;;; Gnus group mode
4182 ;;;
4183
4184 (defvar gnus-group-mode-map nil)
4185 (put 'gnus-group-mode 'mode-class 'special)
4186
4187 (unless gnus-group-mode-map
4188   (setq gnus-group-mode-map (make-keymap))
4189   (suppress-keymap gnus-group-mode-map)
4190
4191   (gnus-define-keys gnus-group-mode-map
4192     " " gnus-group-read-group
4193     "=" gnus-group-select-group
4194     "\r" gnus-group-select-group
4195     "\M-\r" gnus-group-quick-select-group
4196     "j" gnus-group-jump-to-group
4197     "n" gnus-group-next-unread-group
4198     "p" gnus-group-prev-unread-group
4199     "\177" gnus-group-prev-unread-group
4200     [delete] gnus-group-prev-unread-group
4201     "N" gnus-group-next-group
4202     "P" gnus-group-prev-group
4203     "\M-n" gnus-group-next-unread-group-same-level
4204     "\M-p" gnus-group-prev-unread-group-same-level
4205     "," gnus-group-best-unread-group
4206     "." gnus-group-first-unread-group
4207     "u" gnus-group-unsubscribe-current-group
4208     "U" gnus-group-unsubscribe-group
4209     "c" gnus-group-catchup-current
4210     "C" gnus-group-catchup-current-all
4211     "l" gnus-group-list-groups
4212     "L" gnus-group-list-all-groups
4213     "m" gnus-group-mail
4214     "g" gnus-group-get-new-news
4215     "\M-g" gnus-group-get-new-news-this-group
4216     "R" gnus-group-restart
4217     "r" gnus-group-read-init-file
4218     "B" gnus-group-browse-foreign-server
4219     "b" gnus-group-check-bogus-groups
4220     "F" gnus-find-new-newsgroups
4221     "\C-c\C-d" gnus-group-describe-group
4222     "\M-d" gnus-group-describe-all-groups
4223     "\C-c\C-a" gnus-group-apropos
4224     "\C-c\M-\C-a" gnus-group-description-apropos
4225     "a" gnus-group-post-news
4226     "\ek" gnus-group-edit-local-kill
4227     "\eK" gnus-group-edit-global-kill
4228     "\C-k" gnus-group-kill-group
4229     "\C-y" gnus-group-yank-group
4230     "\C-w" gnus-group-kill-region
4231     "\C-x\C-t" gnus-group-transpose-groups
4232     "\C-c\C-l" gnus-group-list-killed
4233     "\C-c\C-x" gnus-group-expire-articles
4234     "\C-c\M-\C-x" gnus-group-expire-all-groups
4235     "V" gnus-version
4236     "s" gnus-group-save-newsrc
4237     "z" gnus-group-suspend
4238 ;    "Z" gnus-group-clear-dribble
4239     "q" gnus-group-exit
4240     "Q" gnus-group-quit
4241     "?" gnus-group-describe-briefly
4242     "\C-c\C-i" gnus-info-find-node
4243     "\M-e" gnus-group-edit-group-method
4244     "^" gnus-group-enter-server-mode
4245     gnus-mouse-2 gnus-mouse-pick-group
4246     "<" beginning-of-buffer
4247     ">" end-of-buffer
4248     "\C-c\C-b" gnus-bug
4249     "\C-c\C-s" gnus-group-sort-groups
4250     "t" gnus-topic-mode
4251     "\C-c\M-g" gnus-activate-all-groups
4252     "\M-&" gnus-group-universal-argument
4253     "#" gnus-group-mark-group
4254     "\M-#" gnus-group-unmark-group)
4255
4256   (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
4257     "m" gnus-group-mark-group
4258     "u" gnus-group-unmark-group
4259     "w" gnus-group-mark-region
4260     "m" gnus-group-mark-buffer
4261     "r" gnus-group-mark-regexp
4262     "U" gnus-group-unmark-all-groups)
4263
4264   (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
4265     "d" gnus-group-make-directory-group
4266     "h" gnus-group-make-help-group
4267     "a" gnus-group-make-archive-group
4268     "k" gnus-group-make-kiboze-group
4269     "m" gnus-group-make-group
4270     "E" gnus-group-edit-group
4271     "e" gnus-group-edit-group-method
4272     "p" gnus-group-edit-group-parameters
4273     "v" gnus-group-add-to-virtual
4274     "V" gnus-group-make-empty-virtual
4275     "D" gnus-group-enter-directory
4276     "f" gnus-group-make-doc-group
4277     "r" gnus-group-rename-group
4278     "\177" gnus-group-delete-group
4279     [delete] gnus-group-delete-group)
4280
4281    (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
4282      "b" gnus-group-brew-soup
4283      "w" gnus-soup-save-areas
4284      "s" gnus-soup-send-replies
4285      "p" gnus-soup-pack-packet
4286      "r" nnsoup-pack-replies)
4287
4288    (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
4289      "s" gnus-group-sort-groups
4290      "a" gnus-group-sort-groups-by-alphabet
4291      "u" gnus-group-sort-groups-by-unread
4292      "l" gnus-group-sort-groups-by-level
4293      "v" gnus-group-sort-groups-by-score
4294      "r" gnus-group-sort-groups-by-rank
4295      "m" gnus-group-sort-groups-by-method)
4296
4297    (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
4298      "k" gnus-group-list-killed
4299      "z" gnus-group-list-zombies
4300      "s" gnus-group-list-groups
4301      "u" gnus-group-list-all-groups
4302      "A" gnus-group-list-active
4303      "a" gnus-group-apropos
4304      "d" gnus-group-description-apropos
4305      "m" gnus-group-list-matching
4306      "M" gnus-group-list-all-matching
4307      "l" gnus-group-list-level)
4308
4309    (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
4310      "f" gnus-score-flush-cache)
4311
4312    (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
4313      "f" gnus-group-fetch-faq)
4314
4315    (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
4316      "l" gnus-group-set-current-level
4317      "t" gnus-group-unsubscribe-current-group
4318      "s" gnus-group-unsubscribe-group
4319      "k" gnus-group-kill-group
4320      "y" gnus-group-yank-group
4321      "w" gnus-group-kill-region
4322      "\C-k" gnus-group-kill-level
4323      "z" gnus-group-kill-all-zombies))
4324
4325 (defun gnus-group-mode ()
4326   "Major mode for reading news.
4327
4328 All normal editing commands are switched off.
4329 \\<gnus-group-mode-map>
4330 The group buffer lists (some of) the groups available.  For instance,
4331 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
4332 lists all zombie groups.
4333
4334 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
4335 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
4336
4337 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
4338
4339 The following commands are available:
4340
4341 \\{gnus-group-mode-map}"
4342   (interactive)
4343   (when (and menu-bar-mode
4344              (gnus-visual-p 'group-menu 'menu))
4345     (gnus-group-make-menu-bar))
4346   (kill-all-local-variables)
4347   (gnus-simplify-mode-line)
4348   (setq major-mode 'gnus-group-mode)
4349   (setq mode-name "Group")
4350   (gnus-group-set-mode-line)
4351   (setq mode-line-process nil)
4352   (use-local-map gnus-group-mode-map)
4353   (buffer-disable-undo (current-buffer))
4354   (setq truncate-lines t)
4355   (setq buffer-read-only t)
4356   (gnus-make-local-hook 'post-command-hook)
4357   (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
4358   (run-hooks 'gnus-group-mode-hook))
4359
4360 (defun gnus-clear-inboxes-moved ()
4361   (setq nnmail-moved-inboxes nil))
4362
4363 (defun gnus-mouse-pick-group (e)
4364   "Enter the group under the mouse pointer."
4365   (interactive "e")
4366   (mouse-set-point e)
4367   (gnus-group-read-group nil))
4368
4369 ;; Look at LEVEL and find out what the level is really supposed to be.
4370 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
4371 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
4372 (defun gnus-group-default-level (&optional level number-or-nil)
4373   (cond
4374    (gnus-group-use-permanent-levels
4375     (or (setq gnus-group-use-permanent-levels
4376               (or level (if (numberp gnus-group-use-permanent-levels)
4377                             gnus-group-use-permanent-levels
4378                           (or gnus-group-default-list-level
4379                               gnus-level-subscribed))))
4380         gnus-group-default-list-level gnus-level-subscribed))
4381    (number-or-nil
4382     level)
4383    (t
4384     (or level gnus-group-default-list-level gnus-level-subscribed))))
4385
4386 ;;;###autoload
4387 (defun gnus-slave-no-server (&optional arg)
4388   "Read network news as a slave, without connecting to local server"
4389   (interactive "P")
4390   (gnus-no-server arg t))
4391
4392 ;;;###autoload
4393 (defun gnus-no-server (&optional arg slave)
4394   "Read network news.
4395 If ARG is a positive number, Gnus will use that as the
4396 startup level.  If ARG is nil, Gnus will be started at level 2.
4397 If ARG is non-nil and not a positive number, Gnus will
4398 prompt the user for the name of an NNTP server to use.
4399 As opposed to `gnus', this command will not connect to the local server."
4400   (interactive "P")
4401   (let ((val (or arg (1- gnus-level-default-subscribed))))
4402     (gnus val t slave)
4403     (make-local-variable 'gnus-group-use-permanent-levels)
4404     (setq gnus-group-use-permanent-levels val)))
4405
4406 ;;;###autoload
4407 (defun gnus-slave (&optional arg)
4408   "Read news as a slave."
4409   (interactive "P")
4410   (gnus arg nil 'slave))
4411
4412 ;;;###autoload
4413 (defun gnus-other-frame (&optional arg)
4414   "Pop up a frame to read news."
4415   (interactive "P")
4416   (if (get-buffer gnus-group-buffer)
4417       (let ((pop-up-frames t))
4418         (gnus arg))
4419     (select-frame (make-frame))
4420     (gnus arg)))
4421
4422 ;;;###autoload
4423 (defun gnus (&optional arg dont-connect slave)
4424   "Read network news.
4425 If ARG is non-nil and a positive number, Gnus will use that as the
4426 startup level.  If ARG is non-nil and not a positive number, Gnus will
4427 prompt the user for the name of an NNTP server to use."
4428   (interactive "P")
4429
4430   (if (get-buffer gnus-group-buffer)
4431       (progn
4432         (switch-to-buffer gnus-group-buffer)
4433         (gnus-group-get-new-news))
4434
4435     (gnus-clear-system)
4436     (nnheader-init-server-buffer)
4437     (gnus-read-init-file)
4438     (setq gnus-slave slave)
4439
4440     (gnus-group-setup-buffer)
4441     (let ((buffer-read-only nil))
4442       (erase-buffer)
4443       (if (not gnus-inhibit-startup-message)
4444           (progn
4445             (gnus-group-startup-message)
4446             (sit-for 0))))
4447
4448     (let ((level (and (numberp arg) (> arg 0) arg))
4449           did-connect)
4450       (unwind-protect
4451           (progn
4452             (or dont-connect
4453                 (setq did-connect
4454                       (gnus-start-news-server (and arg (not level))))))
4455         (if (and (not dont-connect)
4456                  (not did-connect))
4457             (gnus-group-quit)
4458           (run-hooks 'gnus-startup-hook)
4459           ;; NNTP server is successfully open.
4460
4461           ;; Find the current startup file name.
4462           (setq gnus-current-startup-file
4463                 (gnus-make-newsrc-file gnus-startup-file))
4464
4465           ;; Read the dribble file.
4466           (when (or gnus-slave gnus-use-dribble-file)
4467             (gnus-dribble-read-file))
4468
4469           ;; Allow using GroupLens predictions.
4470           (when gnus-use-grouplens
4471             (bbb-login)
4472             (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
4473
4474           (gnus-summary-make-display-table)
4475           ;; Do the actual startup.
4476           (gnus-setup-news nil level dont-connect)
4477           ;; Generate the group buffer.
4478           (gnus-group-list-groups level)
4479           (gnus-group-first-unread-group)
4480           (gnus-configure-windows 'group)
4481           (gnus-group-set-mode-line))))))
4482
4483 (defun gnus-unload ()
4484   "Unload all Gnus features."
4485   (interactive)
4486   (or (boundp 'load-history)
4487       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
4488   (let ((history load-history)
4489         feature)
4490     (while history
4491       (and (string-match "^\\(gnus\\|nn\\)" (caar history))
4492            (setq feature (cdr (assq 'provide (car history))))
4493            (unload-feature feature 'force))
4494       (setq history (cdr history)))))
4495
4496 (defun gnus-compile ()
4497   "Byte-compile the user-defined format specs."
4498   (interactive)
4499   (let ((entries gnus-format-specs)
4500         entry gnus-tmp-func)
4501     (save-excursion
4502       (gnus-message 7 "Compiling format specs...")
4503
4504       (while entries
4505         (setq entry (pop entries))
4506         (if (eq (car entry) 'version)
4507             (setq gnus-format-specs (delq entry gnus-format-specs))
4508           (when (and (listp (caddr entry))
4509                      (not (eq 'byte-code (caaddr entry))))
4510             (fset 'gnus-tmp-func
4511                   `(lambda () ,(caddr entry)))
4512             (byte-compile 'gnus-tmp-func)
4513             (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4514
4515       (push (cons 'version emacs-version) gnus-format-specs)
4516       ;; Mark the .newsrc.eld file as "dirty".
4517       (gnus-dribble-enter " ")
4518       (gnus-message 7 "Compiling user specs...done"))))
4519
4520 (defun gnus-indent-rigidly (start end arg)
4521   "Indent rigidly using only spaces and no tabs."
4522   (save-excursion
4523     (save-restriction
4524       (narrow-to-region start end)
4525       (indent-rigidly start end arg)
4526       (goto-char (point-min))
4527       (while (search-forward "\t" nil t)
4528         (replace-match "        " t t)))))
4529
4530 (defun gnus-group-startup-message (&optional x y)
4531   "Insert startup message in current buffer."
4532   ;; Insert the message.
4533   (erase-buffer)
4534   (insert
4535    (format "              %s
4536           _    ___ _             _
4537           _ ___ __ ___  __    _ ___
4538           __   _     ___    __  ___
4539               _           ___     _
4540              _  _ __             _
4541              ___   __            _
4542                    __           _
4543                     _      _   _
4544                    _      _    _
4545                       _  _    _
4546                   __  ___
4547                  _   _ _     _
4548                 _   _
4549               _    _
4550              _    _
4551             _
4552           __
4553
4554 "
4555            ""))
4556   ;; And then hack it.
4557   (gnus-indent-rigidly (point-min) (point-max)
4558                        (/ (max (- (window-width) (or x 46)) 0) 2))
4559   (goto-char (point-min))
4560   (forward-line 1)
4561   (let* ((pheight (count-lines (point-min) (point-max)))
4562          (wheight (window-height))
4563          (rest (- wheight pheight)))
4564     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
4565   ;; Fontify some.
4566   (goto-char (point-min))
4567   (and (search-forward "Praxis" nil t)
4568        (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
4569   (goto-char (point-min))
4570   (let* ((mode-string (gnus-group-set-mode-line)))
4571     (setq mode-line-buffer-identification
4572           (list (concat gnus-version (substring (car mode-string) 4))))
4573     (set-buffer-modified-p t)))
4574
4575 (defun gnus-group-setup-buffer ()
4576   (or (get-buffer gnus-group-buffer)
4577       (progn
4578         (switch-to-buffer gnus-group-buffer)
4579         (gnus-add-current-to-buffer-list)
4580         (gnus-group-mode)
4581         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4582
4583 (defun gnus-group-list-groups (&optional level unread lowest)
4584   "List newsgroups with level LEVEL or lower that have unread articles.
4585 Default is all subscribed groups.
4586 If argument UNREAD is non-nil, groups with no unread articles are also
4587 listed."
4588   (interactive (list (if current-prefix-arg
4589                          (prefix-numeric-value current-prefix-arg)
4590                        (or
4591                         (gnus-group-default-level nil t)
4592                         gnus-group-default-list-level
4593                         gnus-level-subscribed))))
4594   (or level
4595       (setq level (car gnus-group-list-mode)
4596             unread (cdr gnus-group-list-mode)))
4597   (setq level (gnus-group-default-level level))
4598   (gnus-group-setup-buffer)             ;May call from out of group buffer
4599   (gnus-update-format-specifications)
4600   (let ((case-fold-search nil)
4601         (props (text-properties-at (gnus-point-at-bol)))
4602         (group (gnus-group-group-name)))
4603     (set-buffer gnus-group-buffer)
4604     (funcall gnus-group-prepare-function level unread lowest)
4605     (if (zerop (buffer-size))
4606         (gnus-message 5 gnus-no-groups-message)
4607       (goto-char (point-max))
4608       (when (or (not gnus-group-goto-next-group-function)
4609                 (not (funcall gnus-group-goto-next-group-function 
4610                               group props)))
4611         (if (not group)
4612             ;; Go to the first group with unread articles.
4613             (gnus-group-search-forward t)
4614           ;; Find the right group to put point on.  If the current group
4615           ;; has disappeared in the new listing, try to find the next
4616           ;; one.        If no next one can be found, just leave point at the
4617           ;; first newsgroup in the buffer.
4618           (if (not (gnus-goto-char
4619                     (text-property-any
4620                      (point-min) (point-max)
4621                      'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4622               (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
4623                 (while (and newsrc
4624                             (not (gnus-goto-char
4625                                   (text-property-any
4626                                    (point-min) (point-max) 'gnus-group
4627                                    (gnus-intern-safe
4628                                     (caar newsrc) gnus-active-hashtb)))))
4629                   (setq newsrc (cdr newsrc)))
4630                 (or newsrc (progn (goto-char (point-max))
4631                                   (forward-line -1)))))))
4632       ;; Adjust cursor point.
4633       (gnus-group-position-point))))
4634
4635 (defun gnus-group-list-level (level &optional all)
4636   "List groups on LEVEL.
4637 If ALL (the prefix), also list groups that have no unread articles."
4638   (interactive "nList groups on level: \nP")
4639   (gnus-group-list-groups level all level))
4640
4641 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
4642   "List all newsgroups with unread articles of level LEVEL or lower.
4643 If ALL is non-nil, list groups that have no unread articles.
4644 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4645 If REGEXP, only list groups matching REGEXP."
4646   (set-buffer gnus-group-buffer)
4647   (let ((buffer-read-only nil)
4648         (newsrc (cdr gnus-newsrc-alist))
4649         (lowest (or lowest 1))
4650         info clevel unread group params)
4651     (erase-buffer)
4652     (if (< lowest gnus-level-zombie)
4653         ;; List living groups.
4654         (while newsrc
4655           (setq info (car newsrc)
4656                 group (gnus-info-group info)
4657                 params (gnus-info-params info)
4658                 newsrc (cdr newsrc)
4659                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4660           (and unread                   ; This group might be bogus
4661                (or (not regexp)
4662                    (string-match regexp group))
4663                (<= (setq clevel (gnus-info-level info)) level)
4664                (>= clevel lowest)
4665                (or all                  ; We list all groups?
4666                    (if (eq unread t)    ; Unactivated?
4667                        gnus-group-list-inactive-groups ; We list unactivated 
4668                      (> unread 0))      ; We list groups with unread articles
4669                    (and gnus-list-groups-with-ticked-articles
4670                         (cdr (assq 'tick (gnus-info-marks info))))
4671                                         ; And groups with tickeds
4672                    ;; Check for permanent visibility.
4673                    (and gnus-permanently-visible-groups
4674                         (string-match gnus-permanently-visible-groups
4675                                       group))
4676                    (memq 'visible params)
4677                    (cdr (assq 'visible params)))
4678                (gnus-group-insert-group-line
4679                 group (gnus-info-level info)
4680                 (gnus-info-marks info) unread (gnus-info-method info)))))
4681
4682     ;; List dead groups.
4683     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4684          (gnus-group-prepare-flat-list-dead
4685           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
4686           gnus-level-zombie ?Z
4687           regexp))
4688     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4689          (gnus-group-prepare-flat-list-dead
4690           (setq gnus-killed-list (sort gnus-killed-list 'string<))
4691           gnus-level-killed ?K regexp))
4692
4693     (gnus-group-set-mode-line)
4694     (setq gnus-group-list-mode (cons level all))
4695     (run-hooks 'gnus-group-prepare-hook)))
4696
4697 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4698   ;; List zombies and killed lists somewhat faster, which was
4699   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4700   ;; this by ignoring the group format specification altogether.
4701   (let (group)
4702     (if regexp
4703         ;; This loop is used when listing groups that match some
4704         ;; regexp.
4705         (while groups
4706           (setq group (pop groups))
4707           (when (string-match regexp group)
4708             (gnus-add-text-properties
4709              (point) (prog1 (1+ (point))
4710                        (insert " " mark "     *: " group "\n"))
4711              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4712                    'gnus-unread t
4713                    'gnus-level level))))
4714       ;; This loop is used when listing all groups.
4715       (while groups
4716         (gnus-add-text-properties
4717          (point) (prog1 (1+ (point))
4718                    (insert " " mark "     *: "
4719                            (setq group (pop groups)) "\n"))
4720          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4721                'gnus-unread t
4722                'gnus-level level))))))
4723
4724 (defmacro gnus-group-real-name (group)
4725   "Find the real name of a foreign newsgroup."
4726   `(let ((gname ,group))
4727      (if (string-match ":[^:]+$" gname)
4728          (substring gname (1+ (match-beginning 0)))
4729        gname)))
4730
4731 (defsubst gnus-server-add-address (method)
4732   (let ((method-name (symbol-name (car method))))
4733     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4734              (not (assq (intern (concat method-name "-address")) method)))
4735         (append method (list (list (intern (concat method-name "-address"))
4736                                    (nth 1 method))))
4737       method)))
4738
4739 (defsubst gnus-server-get-method (group method)
4740   ;; Input either a server name, and extended server name, or a
4741   ;; select method, and return a select method.
4742   (cond ((stringp method)
4743          (gnus-server-to-method method))
4744         ((equal method gnus-select-method)
4745          gnus-select-method)
4746         ((and (stringp (car method)) group)
4747          (gnus-server-extend-method group method))
4748         ((and method (not group)
4749               (equal (cadr method) ""))
4750          method)
4751         (t
4752          (gnus-server-add-address method))))
4753
4754 (defun gnus-server-to-method (server)
4755   "Map virtual server names to select methods."
4756   (or 
4757    ;; Is this a method, perhaps?
4758    (and server (listp server) server)
4759    ;; Perhaps this is the native server?
4760    (and (equal server "native") gnus-select-method)
4761    ;; It should be in the server alist.
4762    (cdr (assoc server gnus-server-alist))
4763    ;; If not, we look through all the opened server
4764    ;; to see whether we can find it there.
4765    (let ((opened gnus-opened-servers))
4766      (while (and opened
4767                  (not (equal server (format "%s:%s" (caaar opened)
4768                                             (cadaar opened)))))
4769        (pop opened))
4770      (caar opened))))
4771
4772 (defmacro gnus-method-equal (ss1 ss2)
4773   "Say whether two servers are equal."
4774   `(let ((s1 ,ss1)
4775          (s2 ,ss2))
4776      (or (equal s1 s2)
4777          (and (= (length s1) (length s2))
4778               (progn
4779                 (while (and s1 (member (car s1) s2))
4780                   (setq s1 (cdr s1)))
4781                 (null s1))))))
4782
4783 (defun gnus-server-equal (m1 m2)
4784   "Say whether two methods are equal."
4785   (let ((m1 (cond ((null m1) gnus-select-method)
4786                   ((stringp m1) (gnus-server-to-method m1))
4787                   (t m1)))
4788         (m2 (cond ((null m2) gnus-select-method)
4789                   ((stringp m2) (gnus-server-to-method m2))
4790                   (t m2))))
4791     (gnus-method-equal m1 m2)))
4792
4793 (defun gnus-servers-using-backend (backend)
4794   "Return a list of known servers using BACKEND."
4795   (let ((opened gnus-opened-servers)
4796         out)
4797     (while opened
4798       (when (eq backend (caaar opened))
4799         (push (caar opened) out))
4800       (pop opened))
4801     out))
4802
4803 (defun gnus-archive-server-wanted-p ()
4804   "Say whether the user wants to use the archive server."
4805   (cond 
4806    ((or (not gnus-message-archive-method)
4807         (not gnus-message-archive-group))
4808     nil)
4809    ((and gnus-message-archive-method gnus-message-archive-group)
4810     t)
4811    (t
4812     (let ((active (cadr (assq 'nnfolder-active-file
4813                               gnus-message-archive-method))))
4814       (and active
4815            (file-exists-p active))))))
4816
4817 (defun gnus-group-prefixed-name (group method)
4818   "Return the whole name from GROUP and METHOD."
4819   (and (stringp method) (setq method (gnus-server-to-method method)))
4820   (concat (format "%s" (car method))
4821           (if (and
4822                (or (assoc (format "%s" (car method)) 
4823                           (gnus-methods-using 'address))
4824                    (gnus-server-equal method gnus-message-archive-method))
4825                (nth 1 method)
4826                (not (string= (nth 1 method) "")))
4827               (concat "+" (nth 1 method)))
4828           ":" group))
4829
4830 (defun gnus-group-real-prefix (group)
4831   "Return the prefix of the current group name."
4832   (if (string-match "^[^:]+:" group)
4833       (substring group 0 (match-end 0))
4834     ""))
4835
4836 (defun gnus-group-method (group)
4837   "Return the server or method used for selecting GROUP."
4838   (let ((prefix (gnus-group-real-prefix group)))
4839     (if (equal prefix "")
4840         gnus-select-method
4841       (let ((servers gnus-opened-servers)
4842             (server "")
4843             backend possible found)
4844         (if (string-match "^[^\\+]+\\+" prefix)
4845             (setq backend (intern (substring prefix 0 (1- (match-end 0))))
4846                   server (substring prefix (match-end 0) (1- (length prefix))))
4847           (setq backend (intern (substring prefix 0 (1- (length prefix))))))
4848         (while servers
4849           (when (eq (caaar servers) backend)
4850             (setq possible (caar servers))
4851             (when (equal (cadaar servers) server)
4852               (setq found (caar servers))))
4853           (pop servers))
4854         (or (car (rassoc found gnus-server-alist))
4855             found
4856             (car (rassoc possible gnus-server-alist))
4857             possible
4858             (list backend server))))))
4859
4860 (defsubst gnus-secondary-method-p (method)
4861   "Return whether METHOD is a secondary select method."
4862   (let ((methods gnus-secondary-select-methods)
4863         (gmethod (gnus-server-get-method nil method)))
4864     (while (and methods
4865                 (not (equal (gnus-server-get-method nil (car methods))
4866                             gmethod)))
4867       (setq methods (cdr methods)))
4868     methods))
4869
4870 (defun gnus-group-foreign-p (group)
4871   "Say whether a group is foreign or not."
4872   (and (not (gnus-group-native-p group))
4873        (not (gnus-group-secondary-p group))))
4874
4875 (defun gnus-group-native-p (group)
4876   "Say whether the group is native or not."
4877   (not (string-match ":" group)))
4878
4879 (defun gnus-group-secondary-p (group)
4880   "Say whether the group is secondary or not."
4881   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4882
4883 (defun gnus-group-get-parameter (group &optional symbol)
4884   "Returns the group parameters for GROUP.
4885 If SYMBOL, return the value of that symbol in the group parameters."
4886   (let ((params (gnus-info-params (gnus-get-info group))))
4887     (if symbol
4888         (gnus-group-parameter-value params symbol)
4889       params)))
4890
4891 (defun gnus-group-parameter-value (params symbol)
4892   "Return the value of SYMBOL in group PARAMS."
4893   (or (car (memq symbol params))        ; It's either a simple symbol
4894       (cdr (assq symbol params))))      ; or a cons.
4895
4896 (defun gnus-group-add-parameter (group param)
4897   "Add parameter PARAM to GROUP."
4898   (let ((info (gnus-get-info group)))
4899     (if (not info)
4900         () ; This is a dead group.  We just ignore it.
4901       ;; Cons the new param to the old one and update.
4902       (gnus-group-set-info (cons param (gnus-info-params info))
4903                            group 'params))))
4904
4905 (defun gnus-group-set-parameter (group name value)
4906   "Set parameter NAME to VALUE in GROUP."
4907   (let ((info (gnus-get-info group)))
4908     (if (not info)
4909         () ; This is a dead group.  We just ignore it.
4910       (let ((old-params (gnus-info-params info))
4911             (new-params (list (cons name value))))
4912         (while old-params
4913           (if (or (not (listp (car old-params)))
4914                   (not (eq (caar old-params) name)))
4915               (setq new-params (append new-params (list (car old-params)))))
4916           (setq old-params (cdr old-params)))
4917         (gnus-group-set-info new-params group 'params)))))
4918
4919 (defun gnus-group-add-score (group &optional score)
4920   "Add SCORE to the GROUP score.
4921 If SCORE is nil, add 1 to the score of GROUP."
4922   (let ((info (gnus-get-info group)))
4923     (when info
4924       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
4925
4926 (defun gnus-summary-bubble-group ()
4927   "Increase the score of the current group.
4928 This is a handy function to add to `gnus-summary-exit-hook' to
4929 increase the score of each group you read."
4930   (gnus-group-add-score gnus-newsgroup-name))
4931
4932 (defun gnus-group-set-info (info &optional method-only-group part)
4933   (let* ((entry (gnus-gethash
4934                  (or method-only-group (gnus-info-group info))
4935                  gnus-newsrc-hashtb))
4936          (part-info info)
4937          (info (if method-only-group (nth 2 entry) info))
4938          method)
4939     (when method-only-group
4940       (unless entry
4941         (error "Trying to change non-existent group %s" method-only-group))
4942       ;; We have received parts of the actual group info - either the
4943       ;; select method or the group parameters.  We first check
4944       ;; whether we have to extend the info, and if so, do that.
4945       (let ((len (length info))
4946             (total (if (eq part 'method) 5 6)))
4947         (when (< len total)
4948           (setcdr (nthcdr (1- len) info)
4949                   (make-list (- total len) nil)))
4950         ;; Then we enter the new info.
4951         (setcar (nthcdr (1- total) info) part-info)))
4952     (unless entry
4953       ;; This is a new group, so we just create it.
4954       (save-excursion
4955         (set-buffer gnus-group-buffer)
4956         (setq method (gnus-info-method info))
4957         (when (gnus-server-equal method "native")
4958           (setq method nil))
4959         (save-excursion
4960           (set-buffer gnus-group-buffer)
4961           (if method
4962               ;; It's a foreign group...
4963               (gnus-group-make-group
4964                (gnus-group-real-name (gnus-info-group info))
4965                (if (stringp method) method
4966                  (prin1-to-string (car method)))
4967                (and (consp method)
4968                     (nth 1 (gnus-info-method info))))
4969             ;; It's a native group.
4970             (gnus-group-make-group (gnus-info-group info))))
4971         (gnus-message 6 "Note: New group created")
4972         (setq entry
4973               (gnus-gethash (gnus-group-prefixed-name
4974                              (gnus-group-real-name (gnus-info-group info))
4975                              (or (gnus-info-method info) gnus-select-method))
4976                             gnus-newsrc-hashtb))))
4977     ;; Whether it was a new group or not, we now have the entry, so we
4978     ;; can do the update.
4979     (if entry
4980         (progn
4981           (setcar (nthcdr 2 entry) info)
4982           (when (and (not (eq (car entry) t))
4983                      (gnus-active (gnus-info-group info)))
4984             (setcar entry (length (gnus-list-of-unread-articles (car info))))))
4985       (error "No such group: %s" (gnus-info-group info)))))
4986
4987 (defun gnus-group-set-method-info (group select-method)
4988   (gnus-group-set-info select-method group 'method))
4989
4990 (defun gnus-group-set-params-info (group params)
4991   (gnus-group-set-info params group 'params))
4992
4993 (defun gnus-group-update-group-line ()
4994   "Update the current line in the group buffer."
4995   (let* ((buffer-read-only nil)
4996          (group (gnus-group-group-name))
4997          (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
4998          gnus-group-indentation)
4999     (when group
5000       (and entry
5001            (not (gnus-ephemeral-group-p group))
5002            (gnus-dribble-enter
5003             (concat "(gnus-group-set-info '"
5004                     (prin1-to-string (nth 2 entry)) ")")))
5005       (setq gnus-group-indentation (gnus-group-group-indentation))
5006       (gnus-delete-line)
5007       (gnus-group-insert-group-line-info group)
5008       (forward-line -1)
5009       (gnus-group-position-point))))
5010
5011 (defun gnus-group-insert-group-line-info (group)
5012   "Insert GROUP on the current line."
5013   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
5014         active info)
5015     (if entry
5016         (progn
5017           ;; (Un)subscribed group.
5018           (setq info (nth 2 entry))
5019           (gnus-group-insert-group-line
5020            group (gnus-info-level info) (gnus-info-marks info)
5021            (or (car entry) t) (gnus-info-method info)))
5022       ;; This group is dead.
5023       (gnus-group-insert-group-line
5024        group
5025        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
5026        nil
5027        (if (setq active (gnus-active group))
5028            (- (1+ (cdr active)) (car active)) 0)
5029        nil))))
5030
5031 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level 
5032                                                     gnus-tmp-marked number
5033                                                     gnus-tmp-method)
5034   "Insert a group line in the group buffer."
5035   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
5036          (gnus-tmp-number-total
5037           (if gnus-tmp-active
5038               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
5039             0))
5040          (gnus-tmp-number-of-unread
5041           (if (numberp number) (int-to-string (max 0 number))
5042             "*"))
5043          (gnus-tmp-number-of-read
5044           (if (numberp number)
5045               (int-to-string (max 0 (- gnus-tmp-number-total number)))
5046             "*"))
5047          (gnus-tmp-subscribed
5048           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
5049                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
5050                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
5051                 (t ?K)))
5052          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
5053          (gnus-tmp-newsgroup-description
5054           (if gnus-description-hashtb
5055               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
5056             ""))
5057          (gnus-tmp-moderated
5058           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
5059          (gnus-tmp-moderated-string
5060           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
5061          (gnus-tmp-method
5062           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
5063          (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
5064          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
5065          (gnus-tmp-news-method-string
5066           (if gnus-tmp-method
5067               (format "(%s:%s)" (car gnus-tmp-method)
5068                       (cadr gnus-tmp-method)) ""))
5069          (gnus-tmp-marked-mark
5070           (if (and (numberp number)
5071                    (zerop number)
5072                    (cdr (assq 'tick gnus-tmp-marked)))
5073               ?* ? ))
5074          (gnus-tmp-process-marked
5075           (if (member gnus-tmp-group gnus-group-marked)
5076               gnus-process-mark ? ))
5077          (gnus-tmp-grouplens
5078           (or (and gnus-use-grouplens
5079                    (bbb-grouplens-group-p gnus-tmp-group))
5080               ""))
5081          (buffer-read-only nil)
5082          header gnus-tmp-header)        ; passed as parameter to user-funcs.
5083     (beginning-of-line)
5084     (gnus-add-text-properties
5085      (point)
5086      (prog1 (1+ (point))
5087        ;; Insert the text.
5088        (eval gnus-group-line-format-spec))
5089      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
5090        gnus-unread ,(if (numberp number)
5091                         (string-to-int gnus-tmp-number-of-unread)
5092                       t)
5093        gnus-marked ,gnus-tmp-marked-mark
5094        gnus-indentation ,gnus-group-indentation
5095        gnus-level ,gnus-tmp-level))
5096     (when (inline (gnus-visual-p 'group-highlight 'highlight))
5097       (forward-line -1)
5098       (run-hooks 'gnus-group-update-hook)
5099       (forward-line))
5100     ;; Allow XEmacs to remove front-sticky text properties.
5101     (gnus-group-remove-excess-properties)))
5102
5103 (defun gnus-group-update-group (group &optional visible-only)
5104   "Update all lines where GROUP appear.
5105 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
5106 already."
5107   (save-excursion
5108     (set-buffer gnus-group-buffer)
5109     ;; The buffer may be narrowed.
5110     (save-restriction
5111       (widen)
5112       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
5113             (loc (point-min))
5114             found buffer-read-only)
5115         ;; Enter the current status into the dribble buffer.
5116         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
5117           (if (and entry (not (gnus-ephemeral-group-p group)))
5118               (gnus-dribble-enter
5119                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
5120                        ")"))))
5121         ;; Find all group instances.  If topics are in use, each group
5122         ;; may be listed in more than once.
5123         (while (setq loc (text-property-any
5124                           loc (point-max) 'gnus-group ident))
5125           (setq found t)
5126           (goto-char loc)
5127           (let ((gnus-group-indentation (gnus-group-group-indentation)))
5128             (gnus-delete-line)
5129             (gnus-group-insert-group-line-info group)
5130             (save-excursion
5131               (forward-line -1)
5132               (run-hooks 'gnus-group-update-group-hook)))
5133           (setq loc (1+ loc)))
5134         (unless (or found visible-only)
5135           ;; No such line in the buffer, find out where it's supposed to
5136           ;; go, and insert it there (or at the end of the buffer).
5137           (if gnus-goto-missing-group-function
5138               (funcall gnus-goto-missing-group-function group)
5139             (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
5140               (while (and entry (car entry)
5141                           (not
5142                            (gnus-goto-char
5143                             (text-property-any
5144                              (point-min) (point-max)
5145                              'gnus-group (gnus-intern-safe
5146                                           (caar entry) gnus-active-hashtb)))))
5147                 (setq entry (cdr entry)))
5148               (or entry (goto-char (point-max)))))
5149           ;; Finally insert the line.
5150           (let ((gnus-group-indentation (gnus-group-group-indentation)))
5151             (gnus-group-insert-group-line-info group)
5152             (save-excursion
5153               (forward-line -1)
5154               (run-hooks 'gnus-group-update-group-hook))))
5155         (gnus-group-set-mode-line)))))
5156
5157 (defun gnus-group-set-mode-line ()
5158   "Update the mode line in the group buffer."
5159   (when (memq 'group gnus-updated-mode-lines)
5160     ;; Yes, we want to keep this mode line updated.
5161     (save-excursion
5162       (set-buffer gnus-group-buffer)
5163       (let* ((gformat (or gnus-group-mode-line-format-spec
5164                           (setq gnus-group-mode-line-format-spec
5165                                 (gnus-parse-format
5166                                  gnus-group-mode-line-format
5167                                  gnus-group-mode-line-format-alist))))
5168              (gnus-tmp-news-server (cadr gnus-select-method))
5169              (gnus-tmp-news-method (car gnus-select-method))
5170              (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
5171              (max-len 60)
5172              gnus-tmp-header            ;Dummy binding for user-defined formats
5173              ;; Get the resulting string.
5174              (modified 
5175               (and gnus-dribble-buffer
5176                    (buffer-name gnus-dribble-buffer)
5177                    (buffer-modified-p gnus-dribble-buffer)
5178                    (save-excursion
5179                      (set-buffer gnus-dribble-buffer)
5180                      (not (zerop (buffer-size))))))
5181              (mode-string (eval gformat)))
5182         ;; Say whether the dribble buffer has been modified.
5183         (setq mode-line-modified
5184               (if modified "---*- " "----- "))
5185         ;; If the line is too long, we chop it off.
5186         (when (> (length mode-string) max-len)
5187           (setq mode-string (substring mode-string 0 (- max-len 4))))
5188         (prog1
5189             (setq mode-line-buffer-identification 
5190                   (gnus-mode-line-buffer-identification
5191                    (list mode-string)))
5192           (set-buffer-modified-p modified))))))
5193
5194 (defun gnus-group-group-name ()
5195   "Get the name of the newsgroup on the current line."
5196   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
5197     (and group (symbol-name group))))
5198
5199 (defun gnus-group-group-level ()
5200   "Get the level of the newsgroup on the current line."
5201   (get-text-property (gnus-point-at-bol) 'gnus-level))
5202
5203 (defun gnus-group-group-indentation ()
5204   "Get the indentation of the newsgroup on the current line."
5205   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
5206       (and gnus-group-indentation-function
5207            (funcall gnus-group-indentation-function))
5208       ""))
5209
5210 (defun gnus-group-group-unread ()
5211   "Get the number of unread articles of the newsgroup on the current line."
5212   (get-text-property (gnus-point-at-bol) 'gnus-unread))
5213
5214 (defun gnus-group-search-forward (&optional backward all level first-too)
5215   "Find the next newsgroup with unread articles.
5216 If BACKWARD is non-nil, find the previous newsgroup instead.
5217 If ALL is non-nil, just find any newsgroup.
5218 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
5219 group exists.
5220 If FIRST-TOO, the current line is also eligible as a target."
5221   (let ((way (if backward -1 1))
5222         (low gnus-level-killed)
5223         (beg (point))
5224         pos found lev)
5225     (if (and backward (progn (beginning-of-line)) (bobp))
5226         nil
5227       (or first-too (forward-line way))
5228       (while (and
5229               (not (eobp))
5230               (not (setq
5231                     found
5232                     (and (or all
5233                              (and
5234                               (let ((unread
5235                                      (get-text-property (point) 'gnus-unread)))
5236                                 (and (numberp unread) (> unread 0)))
5237                               (setq lev (get-text-property (point)
5238                                                            'gnus-level))
5239                               (<= lev gnus-level-subscribed)))
5240                          (or (not level)
5241                              (and (setq lev (get-text-property (point)
5242                                                                'gnus-level))
5243                                   (or (= lev level)
5244                                       (and (< lev low)
5245                                            (< level lev)
5246                                            (progn
5247                                              (setq low lev)
5248                                              (setq pos (point))
5249                                              nil))))))))
5250               (zerop (forward-line way)))))
5251     (if found
5252         (progn (gnus-group-position-point) t)
5253       (goto-char (or pos beg))
5254       (and pos t))))
5255
5256 ;;; Gnus group mode commands
5257
5258 ;; Group marking.
5259
5260 (defun gnus-group-mark-group (n &optional unmark no-advance)
5261   "Mark the current group."
5262   (interactive "p")
5263   (let ((buffer-read-only nil)
5264         group)
5265     (while (and (> n 0)
5266                 (not (eobp)))
5267       (when (setq group (gnus-group-group-name))
5268         ;; Update the mark.
5269         (beginning-of-line)
5270         (forward-char
5271          (or (cdr (assq 'process gnus-group-mark-positions)) 2))
5272         (delete-char 1)
5273         (if unmark
5274             (progn
5275               (insert " ")
5276               (setq gnus-group-marked (delete group gnus-group-marked)))
5277           (insert "#")
5278           (setq gnus-group-marked
5279                 (cons group (delete group gnus-group-marked)))))
5280       (or no-advance (gnus-group-next-group 1))
5281       (decf n))
5282     (gnus-summary-position-point)
5283     n))
5284
5285 (defun gnus-group-unmark-group (n)
5286   "Remove the mark from the current group."
5287   (interactive "p")
5288   (gnus-group-mark-group n 'unmark)
5289   (gnus-group-position-point))
5290
5291 (defun gnus-group-unmark-all-groups ()
5292   "Unmark all groups."
5293   (interactive)
5294   (let ((groups gnus-group-marked))
5295     (save-excursion
5296       (while groups
5297         (gnus-group-remove-mark (pop groups)))))
5298   (gnus-group-position-point))
5299
5300 (defun gnus-group-mark-region (unmark beg end)
5301   "Mark all groups between point and mark.
5302 If UNMARK, remove the mark instead."
5303   (interactive "P\nr")
5304   (let ((num (count-lines beg end)))
5305     (save-excursion
5306       (goto-char beg)
5307       (- num (gnus-group-mark-group num unmark)))))
5308
5309 (defun gnus-group-mark-buffer (&optional unmark)
5310   "Mark all groups in the buffer.
5311 If UNMARK, remove the mark instead."
5312   (interactive "P")
5313   (gnus-group-mark-region unmark (point-min) (point-max)))
5314
5315 (defun gnus-group-mark-regexp (regexp)
5316   "Mark all groups that match some regexp."
5317   (interactive "sMark (regexp): ")
5318   (let ((alist (cdr gnus-newsrc-alist))
5319         group)
5320     (while alist
5321       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
5322         (gnus-group-set-mark group))))
5323   (gnus-group-position-point))
5324
5325 (defun gnus-group-remove-mark (group)
5326   "Remove the process mark from GROUP and move point there.
5327 Return nil if the group isn't displayed."
5328   (if (gnus-group-goto-group group)
5329       (save-excursion
5330         (gnus-group-mark-group 1 'unmark t)
5331         t)
5332     (setq gnus-group-marked
5333           (delete group gnus-group-marked))
5334     nil))
5335
5336 (defun gnus-group-set-mark (group)
5337   "Set the process mark on GROUP."
5338   (if (gnus-group-goto-group group) 
5339       (save-excursion
5340         (gnus-group-mark-group 1 nil t))
5341     (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
5342
5343 (defun gnus-group-universal-argument (arg &optional groups func)
5344   "Perform any command on all groups accoring to the process/prefix convention."
5345   (interactive "P")
5346   (let ((groups (or groups (gnus-group-process-prefix arg)))
5347         group func)
5348     (if (eq (setq func (or func
5349                            (key-binding
5350                             (read-key-sequence
5351                              (substitute-command-keys
5352                               "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
5353             'undefined)
5354         (gnus-error 1 "Undefined key")
5355       (while groups
5356         (gnus-group-remove-mark (setq group (pop groups)))
5357         (command-execute func))))
5358   (gnus-group-position-point))
5359
5360 (defun gnus-group-process-prefix (n)
5361   "Return a list of groups to work on.
5362 Take into consideration N (the prefix) and the list of marked groups."
5363   (cond
5364    (n
5365     (setq n (prefix-numeric-value n))
5366     ;; There is a prefix, so we return a list of the N next
5367     ;; groups.
5368     (let ((way (if (< n 0) -1 1))
5369           (n (abs n))
5370           group groups)
5371       (save-excursion
5372         (while (and (> n 0)
5373                     (setq group (gnus-group-group-name)))
5374           (setq groups (cons group groups))
5375           (setq n (1- n))
5376           (gnus-group-next-group way)))
5377       (nreverse groups)))
5378    ((and (boundp 'transient-mark-mode)
5379          transient-mark-mode
5380          (boundp 'mark-active)
5381          mark-active)
5382     ;; Work on the region between point and mark.
5383     (let ((max (max (point) (mark)))
5384           groups)
5385       (save-excursion
5386         (goto-char (min (point) (mark)))
5387         (while
5388             (and
5389              (push (gnus-group-group-name) groups)
5390              (zerop (gnus-group-next-group 1))
5391              (< (point) max)))
5392         (nreverse groups))))
5393    (gnus-group-marked
5394     ;; No prefix, but a list of marked articles.
5395     (reverse gnus-group-marked))
5396    (t
5397     ;; Neither marked articles or a prefix, so we return the
5398     ;; current group.
5399     (let ((group (gnus-group-group-name)))
5400       (and group (list group))))))
5401
5402 ;; Selecting groups.
5403
5404 (defun gnus-group-read-group (&optional all no-article group)
5405   "Read news in this newsgroup.
5406 If the prefix argument ALL is non-nil, already read articles become
5407 readable.  IF ALL is a number, fetch this number of articles.  If the
5408 optional argument NO-ARTICLE is non-nil, no article will be
5409 auto-selected upon group entry.  If GROUP is non-nil, fetch that
5410 group."
5411   (interactive "P")
5412   (let ((group (or group (gnus-group-group-name)))
5413         number active marked entry)
5414     (or group (error "No group on current line"))
5415     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
5416                                             group gnus-newsrc-hashtb)))))
5417     ;; This group might be a dead group.  In that case we have to get
5418     ;; the number of unread articles from `gnus-active-hashtb'.
5419     (setq number
5420           (cond ((numberp all) all)
5421                 (entry (car entry))
5422                 ((setq active (gnus-active group))
5423                  (- (1+ (cdr active)) (car active)))))
5424     (gnus-summary-read-group
5425      group (or all (and (numberp number)
5426                         (zerop (+ number (length (cdr (assq 'tick marked)))
5427                                   (length (cdr (assq 'dormant marked)))))))
5428      no-article)))
5429
5430 (defun gnus-group-select-group (&optional all)
5431   "Select this newsgroup.
5432 No article is selected automatically.
5433 If ALL is non-nil, already read articles become readable.
5434 If ALL is a number, fetch this number of articles."
5435   (interactive "P")
5436   (gnus-group-read-group all t))
5437
5438 (defun gnus-group-quick-select-group (&optional all)
5439   "Select the current group \"quickly\".
5440 This means that no highlighting or scoring will be performed."
5441   (interactive "P")
5442   (let (gnus-visual
5443         gnus-score-find-score-files-function
5444         gnus-apply-kill-hook
5445         gnus-summary-expunge-below)
5446     (gnus-group-read-group all t)))
5447
5448 (defun gnus-group-visible-select-group (&optional all)
5449   "Select the current group without hiding any articles."
5450   (interactive "P")
5451   (let ((gnus-inhibit-limiting t))
5452     (gnus-group-read-group all t)))
5453
5454 ;;;###autoload
5455 (defun gnus-fetch-group (group)
5456   "Start Gnus if necessary and enter GROUP.
5457 Returns whether the fetching was successful or not."
5458   (interactive "sGroup name: ")
5459   (or (get-buffer gnus-group-buffer)
5460       (gnus))
5461   (gnus-group-read-group nil nil group))
5462
5463 ;; Enter a group that is not in the group buffer.  Non-nil is returned
5464 ;; if selection was successful.
5465 (defun gnus-group-read-ephemeral-group
5466   (group method &optional activate quit-config)
5467   (let ((group (if (gnus-group-foreign-p group) group
5468                  (gnus-group-prefixed-name group method))))
5469     (gnus-sethash
5470      group
5471      `(t nil (,group ,gnus-level-default-subscribed nil nil ,method
5472                      ((quit-config . ,(if quit-config quit-config
5473                                         (cons (current-buffer) 'summary))))))
5474      gnus-newsrc-hashtb)
5475     (set-buffer gnus-group-buffer)
5476     (or (gnus-check-server method)
5477         (error "Unable to contact server: %s" (gnus-status-message method)))
5478     (if activate (or (gnus-request-group group)
5479                      (error "Couldn't request group")))
5480     (condition-case ()
5481         (gnus-group-read-group t t group)
5482       (error nil)
5483       (quit nil))))
5484
5485 (defun gnus-group-jump-to-group (group)
5486   "Jump to newsgroup GROUP."
5487   (interactive
5488    (list (completing-read
5489           "Group: " gnus-active-hashtb nil
5490           (gnus-read-active-file-p)
5491           nil
5492           'gnus-group-history)))
5493
5494   (when (equal group "")
5495     (error "Empty group name"))
5496
5497   (when (string-match "[\000-\032]" group)
5498     (error "Control characters in group: %s" group))
5499
5500   (let ((b (text-property-any
5501             (point-min) (point-max)
5502             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
5503     (unless (gnus-ephemeral-group-p group)
5504       (if b
5505           ;; Either go to the line in the group buffer...
5506           (goto-char b)
5507         ;; ... or insert the line.
5508         (or
5509          (gnus-active group)
5510          (gnus-activate-group group)
5511          (error "%s error: %s" group (gnus-status-message group)))
5512
5513         (gnus-group-update-group group)
5514         (goto-char (text-property-any
5515                     (point-min) (point-max)
5516                     'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
5517     ;; Adjust cursor point.
5518     (gnus-group-position-point)))
5519
5520 (defun gnus-group-goto-group (group)
5521   "Goto to newsgroup GROUP."
5522   (when group
5523     (let ((b (text-property-any (point-min) (point-max)
5524                                 'gnus-group (gnus-intern-safe
5525                                              group gnus-active-hashtb))))
5526       (and b (goto-char b)))))
5527
5528 (defun gnus-group-next-group (n &optional silent)
5529   "Go to next N'th newsgroup.
5530 If N is negative, search backward instead.
5531 Returns the difference between N and the number of skips actually
5532 done."
5533   (interactive "p")
5534   (gnus-group-next-unread-group n t nil silent))
5535
5536 (defun gnus-group-next-unread-group (n &optional all level silent)
5537   "Go to next N'th unread newsgroup.
5538 If N is negative, search backward instead.
5539 If ALL is non-nil, choose any newsgroup, unread or not.
5540 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
5541 such group can be found, the next group with a level higher than
5542 LEVEL.
5543 Returns the difference between N and the number of skips actually
5544 made."
5545   (interactive "p")
5546   (let ((backward (< n 0))
5547         (n (abs n)))
5548     (while (and (> n 0)
5549                 (gnus-group-search-forward
5550                  backward (or (not gnus-group-goto-unread) all) level))
5551       (setq n (1- n)))
5552     (when (and (/= 0 n)
5553                (not silent))
5554       (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
5555                     (if level " on this level or higher" "")))
5556     n))
5557
5558 (defun gnus-group-prev-group (n)
5559   "Go to previous N'th newsgroup.
5560 Returns the difference between N and the number of skips actually
5561 done."
5562   (interactive "p")
5563   (gnus-group-next-unread-group (- n) t))
5564
5565 (defun gnus-group-prev-unread-group (n)
5566   "Go to previous N'th unread newsgroup.
5567 Returns the difference between N and the number of skips actually
5568 done."
5569   (interactive "p")
5570   (gnus-group-next-unread-group (- n)))
5571
5572 (defun gnus-group-next-unread-group-same-level (n)
5573   "Go to next N'th unread newsgroup on the same level.
5574 If N is negative, search backward instead.
5575 Returns the difference between N and the number of skips actually
5576 done."
5577   (interactive "p")
5578   (gnus-group-next-unread-group n t (gnus-group-group-level))
5579   (gnus-group-position-point))
5580
5581 (defun gnus-group-prev-unread-group-same-level (n)
5582   "Go to next N'th unread newsgroup on the same level.
5583 Returns the difference between N and the number of skips actually
5584 done."
5585   (interactive "p")
5586   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
5587   (gnus-group-position-point))
5588
5589 (defun gnus-group-best-unread-group (&optional exclude-group)
5590   "Go to the group with the highest level.
5591 If EXCLUDE-GROUP, do not go to that group."
5592   (interactive)
5593   (goto-char (point-min))
5594   (let ((best 100000)
5595         unread best-point)
5596     (while (not (eobp))
5597       (setq unread (get-text-property (point) 'gnus-unread))
5598       (if (and (numberp unread) (> unread 0))
5599           (progn
5600             (if (and (get-text-property (point) 'gnus-level)
5601                      (< (get-text-property (point) 'gnus-level) best)
5602                      (or (not exclude-group)
5603                          (not (equal exclude-group (gnus-group-group-name)))))
5604                 (progn
5605                   (setq best (get-text-property (point) 'gnus-level))
5606                   (setq best-point (point))))))
5607       (forward-line 1))
5608     (if best-point (goto-char best-point))
5609     (gnus-summary-position-point)
5610     (and best-point (gnus-group-group-name))))
5611
5612 (defun gnus-group-first-unread-group ()
5613   "Go to the first group with unread articles."
5614   (interactive)
5615   (prog1
5616       (let ((opoint (point))
5617             unread)
5618         (goto-char (point-min))
5619         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
5620                 (and (numberp unread)   ; Not a topic.
5621                      (not (zerop unread))) ; Has unread articles.
5622                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
5623             (point)                     ; Success.
5624           (goto-char opoint)
5625           nil))                         ; Not success.
5626     (gnus-group-position-point)))
5627
5628 (defun gnus-group-enter-server-mode ()
5629   "Jump to the server buffer."
5630   (interactive)
5631   (gnus-enter-server-buffer))
5632
5633 (defun gnus-group-make-group (name &optional method address)
5634   "Add a new newsgroup.
5635 The user will be prompted for a NAME, for a select METHOD, and an
5636 ADDRESS."
5637   (interactive
5638    (cons
5639     (read-string "Group name: ")
5640     (let ((method
5641            (completing-read
5642             "Method: " (append gnus-valid-select-methods gnus-server-alist)
5643             nil t nil 'gnus-method-history)))
5644       (cond ((assoc method gnus-valid-select-methods)
5645              (list method
5646                    (if (memq 'prompt-address
5647                              (assoc method gnus-valid-select-methods))
5648                        (read-string "Address: ")
5649                      "")))
5650             ((assoc method gnus-server-alist)
5651              (list method))
5652             (t
5653              (list method ""))))))
5654
5655   (let* ((meth (and method (if address (list (intern method) address)
5656                              method)))
5657          (nname (if method (gnus-group-prefixed-name name meth) name))
5658          backend info)
5659     (when (gnus-gethash nname gnus-newsrc-hashtb)
5660       (error "Group %s already exists" nname))
5661     ;; Subscribe to the new group.
5662     (gnus-group-change-level
5663      (setq info (list t nname gnus-level-default-subscribed nil nil meth))
5664      gnus-level-default-subscribed gnus-level-killed
5665      (and (gnus-group-group-name)
5666           (gnus-gethash (gnus-group-group-name)
5667                         gnus-newsrc-hashtb))
5668      t)
5669     ;; Make it active.
5670     (gnus-set-active nname (cons 1 0))
5671     (or (gnus-ephemeral-group-p name)
5672         (gnus-dribble-enter
5673          (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
5674     ;; Insert the line.
5675     (gnus-group-insert-group-line-info nname)
5676     (forward-line -1)
5677     (gnus-group-position-point)
5678
5679     ;; Load the backend and try to make the backend create
5680     ;; the group as well.
5681     (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
5682                                                   nil meth))))
5683                  gnus-valid-select-methods)
5684       (require backend))
5685     (gnus-check-server meth)
5686     (and (gnus-check-backend-function 'request-create-group nname)
5687          (gnus-request-create-group nname))
5688     t))
5689
5690 (defun gnus-group-delete-group (group &optional force)
5691   "Delete the current group.  Only meaningful with mail groups.
5692 If FORCE (the prefix) is non-nil, all the articles in the group will
5693 be deleted.  This is \"deleted\" as in \"removed forever from the face
5694 of the Earth\".  There is no undo.  The user will be prompted before
5695 doing the deletion."
5696   (interactive
5697    (list (gnus-group-group-name)
5698          current-prefix-arg))
5699   (or group (error "No group to rename"))
5700   (or (gnus-check-backend-function 'request-delete-group group)
5701       (error "This backend does not support group deletion"))
5702   (prog1
5703       (if (not (gnus-yes-or-no-p
5704                 (format
5705                  "Do you really want to delete %s%s? "
5706                  group (if force " and all its contents" ""))))
5707           () ; Whew!
5708         (gnus-message 6 "Deleting group %s..." group)
5709         (if (not (gnus-request-delete-group group force))
5710             (gnus-error 3 "Couldn't delete group %s" group)
5711           (gnus-message 6 "Deleting group %s...done" group)
5712           (gnus-group-goto-group group)
5713           (gnus-group-kill-group 1 t)
5714           (gnus-sethash group nil gnus-active-hashtb)
5715           t))
5716     (gnus-group-position-point)))
5717
5718 (defun gnus-group-rename-group (group new-name)
5719   (interactive
5720    (list
5721     (gnus-group-group-name)
5722     (progn
5723       (or (gnus-check-backend-function
5724            'request-rename-group (gnus-group-group-name))
5725           (error "This backend does not support renaming groups"))
5726       (read-string "New group name: "))))
5727
5728   (or (gnus-check-backend-function 'request-rename-group group)
5729       (error "This backend does not support renaming groups"))
5730
5731   (or group (error "No group to rename"))
5732   (and (string-match "^[ \t]*$" new-name)
5733        (error "Not a valid group name"))
5734
5735   ;; We find the proper prefixed name.
5736   (setq new-name
5737         (gnus-group-prefixed-name
5738          (gnus-group-real-name new-name)
5739          (gnus-info-method (gnus-get-info group))))
5740
5741   (gnus-message 6 "Renaming group %s to %s..." group new-name)
5742   (prog1
5743       (if (not (gnus-request-rename-group group new-name))
5744           (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
5745         ;; We rename the group internally by killing it...
5746         (gnus-group-goto-group group)
5747         (gnus-group-kill-group)
5748         ;; ... changing its name ...
5749         (setcar (cdar gnus-list-of-killed-groups) new-name)
5750         ;; ... and then yanking it.  Magic!
5751         (gnus-group-yank-group)
5752         (gnus-set-active new-name (gnus-active group))
5753         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
5754         new-name)
5755     (gnus-group-position-point)))
5756
5757 (defun gnus-group-edit-group (group &optional part)
5758   "Edit the group on the current line."
5759   (interactive (list (gnus-group-group-name)))
5760   (let* ((part (or part 'info))
5761          (done-func `(lambda ()
5762                        "Exit editing mode and update the information."
5763                        (interactive)
5764                        (gnus-group-edit-group-done ',part ,group)))
5765          (winconf (current-window-configuration))
5766          info)
5767     (or group (error "No group on current line"))
5768     (or (setq info (gnus-get-info group))
5769         (error "Killed group; can't be edited"))
5770     (set-buffer (get-buffer-create gnus-group-edit-buffer))
5771     (gnus-configure-windows 'edit-group)
5772     (gnus-add-current-to-buffer-list)
5773     (emacs-lisp-mode)
5774     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
5775     (use-local-map (copy-keymap emacs-lisp-mode-map))
5776     (local-set-key "\C-c\C-c" done-func)
5777     (make-local-variable 'gnus-prev-winconf)
5778     (setq gnus-prev-winconf winconf)
5779     (erase-buffer)
5780     (insert
5781      (cond
5782       ((eq part 'method)
5783        ";; Type `C-c C-c' after editing the select method.\n\n")
5784       ((eq part 'params)
5785        ";; Type `C-c C-c' after editing the group parameters.\n\n")
5786       ((eq part 'info)
5787        ";; Type `C-c C-c' after editing the group info.\n\n")))
5788     (insert
5789      (pp-to-string
5790       (cond ((eq part 'method)
5791              (or (gnus-info-method info) "native"))
5792             ((eq part 'params)
5793              (gnus-info-params info))
5794             (t info)))
5795      "\n")))
5796
5797 (defun gnus-group-edit-group-method (group)
5798   "Edit the select method of GROUP."
5799   (interactive (list (gnus-group-group-name)))
5800   (gnus-group-edit-group group 'method))
5801
5802 (defun gnus-group-edit-group-parameters (group)
5803   "Edit the group parameters of GROUP."
5804   (interactive (list (gnus-group-group-name)))
5805   (gnus-group-edit-group group 'params))
5806
5807 (defun gnus-group-edit-group-done (part group)
5808   "Get info from buffer, update variables and jump to the group buffer."
5809   (set-buffer (get-buffer-create gnus-group-edit-buffer))
5810   (goto-char (point-min))
5811   (let* ((form (read (current-buffer)))
5812          (winconf gnus-prev-winconf)
5813          (method (cond ((eq part 'info) (nth 4 form))
5814                        ((eq part 'method) form)
5815                        (t nil)))
5816          (info (cond ((eq part 'info) form)
5817                      ((eq part 'method) (gnus-get-info group))
5818                      (t nil)))
5819          (new-group (if info
5820                       (if (or (not method)
5821                               (gnus-server-equal
5822                                gnus-select-method method))
5823                           (gnus-group-real-name (car info))
5824                         (gnus-group-prefixed-name
5825                          (gnus-group-real-name (car info)) method))
5826                       nil)))
5827     (when (and new-group
5828                (not (equal new-group group)))
5829       (when (gnus-group-goto-group group)
5830         (gnus-group-kill-group 1))
5831       (gnus-activate-group new-group))
5832     ;; Set the info.
5833     (if (and info new-group)
5834         (progn
5835           (setq info (gnus-copy-sequence info))
5836           (setcar info new-group)
5837           (unless (gnus-server-equal method "native")
5838             (unless (nthcdr 3 info)
5839               (nconc info (list nil nil)))
5840             (unless (nthcdr 4 info)
5841               (nconc info (list nil)))
5842             (gnus-info-set-method info method))
5843           (gnus-group-set-info info))
5844       (gnus-group-set-info form (or new-group group) part))
5845     (kill-buffer (current-buffer))
5846     (and winconf (set-window-configuration winconf))
5847     (set-buffer gnus-group-buffer)
5848     (gnus-group-update-group (or new-group group))
5849     (gnus-group-position-point)))
5850
5851 (defun gnus-group-make-help-group ()
5852   "Create the Gnus documentation group."
5853   (interactive)
5854   (let ((path load-path)
5855         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
5856         file dir)
5857     (and (gnus-gethash name gnus-newsrc-hashtb)
5858          (error "Documentation group already exists"))
5859     (while path
5860       (setq dir (file-name-as-directory (expand-file-name (pop path)))
5861             file nil)
5862       (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
5863                 (file-exists-p
5864                  (setq file (concat (file-name-directory
5865                                      (directory-file-name dir))
5866                                     "etc/gnus-tut.txt"))))
5867         (setq path nil)))
5868     (if (not file)
5869         (gnus-message 1 "Couldn't find doc group")
5870       (gnus-group-make-group
5871        (gnus-group-real-name name)
5872        (list 'nndoc "gnus-help"
5873              (list 'nndoc-address file)
5874              (list 'nndoc-article-type 'mbox)))))
5875   (gnus-group-position-point))
5876
5877 (defun gnus-group-make-doc-group (file type)
5878   "Create a group that uses a single file as the source."
5879   (interactive
5880    (list (read-file-name "File name: ")
5881          (and current-prefix-arg 'ask)))
5882   (when (eq type 'ask)
5883     (let ((err "")
5884           char found)
5885       (while (not found)
5886         (message
5887          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5888          err)
5889         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5890                           ((= char ?b) 'babyl)
5891                           ((= char ?d) 'digest)
5892                           ((= char ?f) 'forward)
5893                           ((= char ?a) 'mmfd)
5894                           (t (setq err (format "%c unknown. " char))
5895                              nil))))
5896       (setq type found)))
5897   (let* ((file (expand-file-name file))
5898          (name (gnus-generate-new-group-name
5899                 (gnus-group-prefixed-name
5900                  (file-name-nondirectory file) '(nndoc "")))))
5901     (gnus-group-make-group
5902      (gnus-group-real-name name)
5903      (list 'nndoc (file-name-nondirectory file)
5904            (list 'nndoc-address file)
5905            (list 'nndoc-article-type (or type 'guess))))))
5906
5907 (defun gnus-group-make-archive-group (&optional all)
5908   "Create the (ding) Gnus archive group of the most recent articles.
5909 Given a prefix, create a full group."
5910   (interactive "P")
5911   (let ((group (gnus-group-prefixed-name
5912                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5913     (and (gnus-gethash group gnus-newsrc-hashtb)
5914          (error "Archive group already exists"))
5915     (gnus-group-make-group
5916      (gnus-group-real-name group)
5917      (list 'nndir (if all "hpc" "edu")
5918            (list 'nndir-directory
5919                  (if all gnus-group-archive-directory
5920                    gnus-group-recent-archive-directory))))))
5921
5922 (defun gnus-group-make-directory-group (dir)
5923   "Create an nndir group.
5924 The user will be prompted for a directory.  The contents of this
5925 directory will be used as a newsgroup.  The directory should contain
5926 mail messages or news articles in files that have numeric names."
5927   (interactive
5928    (list (read-file-name "Create group from directory: ")))
5929   (or (file-exists-p dir) (error "No such directory"))
5930   (or (file-directory-p dir) (error "Not a directory"))
5931   (let ((ext "")
5932         (i 0)
5933         group)
5934     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5935       (setq group
5936             (gnus-group-prefixed-name
5937              (concat (file-name-as-directory (directory-file-name dir))
5938                      ext)
5939              '(nndir "")))
5940       (setq ext (format "<%d>" (setq i (1+ i)))))
5941     (gnus-group-make-group
5942      (gnus-group-real-name group)
5943      (list 'nndir group (list 'nndir-directory dir)))))
5944
5945 (defun gnus-group-make-kiboze-group (group address scores)
5946   "Create an nnkiboze group.
5947 The user will be prompted for a name, a regexp to match groups, and
5948 score file entries for articles to include in the group."
5949   (interactive
5950    (list
5951     (read-string "nnkiboze group name: ")
5952     (read-string "Source groups (regexp): ")
5953     (let ((headers (mapcar (lambda (group) (list group))
5954                            '("subject" "from" "number" "date" "message-id"
5955                              "references" "chars" "lines" "xref"
5956                              "followup" "all" "body" "head")))
5957           scores header regexp regexps)
5958       (while (not (equal "" (setq header (completing-read
5959                                           "Match on header: " headers nil t))))
5960         (setq regexps nil)
5961         (while (not (equal "" (setq regexp (read-string
5962                                             (format "Match on %s (string): "
5963                                                     header)))))
5964           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5965         (setq scores (cons (cons header regexps) scores)))
5966       scores)))
5967   (gnus-group-make-group group "nnkiboze" address)
5968   (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
5969     (let (emacs-lisp-mode-hook)
5970       (pp scores (current-buffer)))))
5971
5972 (defun gnus-group-add-to-virtual (n vgroup)
5973   "Add the current group to a virtual group."
5974   (interactive
5975    (list current-prefix-arg
5976          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5977                           "nnvirtual:")))
5978   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5979       (error "%s is not an nnvirtual group" vgroup))
5980   (let* ((groups (gnus-group-process-prefix n))
5981          (method (gnus-info-method (gnus-get-info vgroup))))
5982     (setcar (cdr method)
5983             (concat
5984              (nth 1 method) "\\|"
5985              (mapconcat
5986               (lambda (s)
5987                 (gnus-group-remove-mark s)
5988                 (concat "\\(^" (regexp-quote s) "$\\)"))
5989               groups "\\|"))))
5990   (gnus-group-position-point))
5991
5992 (defun gnus-group-make-empty-virtual (group)
5993   "Create a new, fresh, empty virtual group."
5994   (interactive "sCreate new, empty virtual group: ")
5995   (let* ((method (list 'nnvirtual "^$"))
5996          (pgroup (gnus-group-prefixed-name group method)))
5997     ;; Check whether it exists already.
5998     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
5999          (error "Group %s already exists." pgroup))
6000     ;; Subscribe the new group after the group on the current line.
6001     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
6002     (gnus-group-update-group pgroup)
6003     (forward-line -1)
6004     (gnus-group-position-point)))
6005
6006 (defun gnus-group-enter-directory (dir)
6007   "Enter an ephemeral nneething group."
6008   (interactive "DDirectory to read: ")
6009   (let* ((method (list 'nneething dir))
6010          (leaf (gnus-group-prefixed-name
6011                 (file-name-nondirectory (directory-file-name dir))
6012                 method))
6013          (name (gnus-generate-new-group-name leaf)))
6014     (let ((nneething-read-only t))
6015       (or (gnus-group-read-ephemeral-group
6016            name method t
6017            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
6018                                       'summary 'group)))
6019           (error "Couldn't enter %s" dir)))))
6020
6021 ;; Group sorting commands
6022 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
6023
6024 (defun gnus-group-sort-groups (func &optional reverse)
6025   "Sort the group buffer according to FUNC.
6026 If REVERSE, reverse the sorting order."
6027   (interactive (list gnus-group-sort-function
6028                      current-prefix-arg))
6029   (let ((func (cond 
6030                ((not (listp func)) func)
6031                ((null func) func)
6032                ((= 1 (length func)) (car func))
6033                (t `(lambda (t1 t2)
6034                      ,(gnus-make-sort-function 
6035                        (reverse func)))))))
6036     ;; We peel off the dummy group from the alist.
6037     (when func
6038       (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
6039         (pop gnus-newsrc-alist))
6040       ;; Do the sorting.
6041       (setq gnus-newsrc-alist
6042             (sort gnus-newsrc-alist func))
6043       (when reverse
6044         (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
6045       ;; Regenerate the hash table.
6046       (gnus-make-hashtable-from-newsrc-alist)
6047       (gnus-group-list-groups))))
6048
6049 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
6050   "Sort the group buffer alphabetically by group name.
6051 If REVERSE, sort in reverse order."
6052   (interactive "P")
6053   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
6054
6055 (defun gnus-group-sort-groups-by-unread (&optional reverse)
6056   "Sort the group buffer by number of unread articles.
6057 If REVERSE, sort in reverse order."
6058   (interactive "P")
6059   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
6060
6061 (defun gnus-group-sort-groups-by-level (&optional reverse)
6062   "Sort the group buffer by group level.
6063 If REVERSE, sort in reverse order."
6064   (interactive "P")
6065   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
6066
6067 (defun gnus-group-sort-groups-by-score (&optional reverse)
6068   "Sort the group buffer by group score.
6069 If REVERSE, sort in reverse order."
6070   (interactive "P")
6071   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
6072
6073 (defun gnus-group-sort-groups-by-rank (&optional reverse)
6074   "Sort the group buffer by group rank.
6075 If REVERSE, sort in reverse order."
6076   (interactive "P")
6077   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
6078
6079 (defun gnus-group-sort-groups-by-method (&optional reverse)
6080   "Sort the group buffer alphabetically by backend name.
6081 If REVERSE, sort in reverse order."
6082   (interactive "P")
6083   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
6084
6085 (defun gnus-group-sort-by-alphabet (info1 info2)
6086   "Sort alphabetically."
6087   (string< (gnus-info-group info1) (gnus-info-group info2)))
6088
6089 (defun gnus-group-sort-by-unread (info1 info2)
6090   "Sort by number of unread articles."
6091   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
6092         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
6093     (< (or (and (numberp n1) n1) 0)
6094        (or (and (numberp n2) n2) 0))))
6095
6096 (defun gnus-group-sort-by-level (info1 info2)
6097   "Sort by level."
6098   (< (gnus-info-level info1) (gnus-info-level info2)))
6099
6100 (defun gnus-group-sort-by-method (info1 info2)
6101   "Sort alphabetically by backend name."
6102   (string< (symbol-name (car (gnus-find-method-for-group
6103                               (gnus-info-group info1) info1)))
6104            (symbol-name (car (gnus-find-method-for-group
6105                               (gnus-info-group info2) info2)))))
6106
6107 (defun gnus-group-sort-by-score (info1 info2)
6108   "Sort by group score."
6109   (< (gnus-info-score info1) (gnus-info-score info2)))
6110
6111 (defun gnus-group-sort-by-rank (info1 info2)
6112   "Sort by level and score."
6113   (let ((level1 (gnus-info-level info1))
6114         (level2 (gnus-info-level info2)))
6115     (or (< level1 level2)
6116         (and (= level1 level2)
6117              (> (gnus-info-score info1) (gnus-info-score info2))))))
6118
6119 ;; Group catching up.
6120
6121 (defun gnus-group-clear-data (n)
6122   "Clear all marks and read ranges from the current group."
6123   (interactive "P")
6124   (let ((groups (gnus-group-process-prefix n))
6125         group info)
6126     (while (setq group (pop groups))
6127       (setq info (gnus-get-info group))
6128       (gnus-info-set-read info nil)
6129       (when (gnus-info-marks info)
6130         (gnus-info-set-marks info nil))
6131       (gnus-get-unread-articles-in-group info (gnus-active group) t)
6132       (when (gnus-group-goto-group group)
6133         (gnus-group-remove-mark group)
6134         (gnus-group-update-group-line)))))
6135
6136 (defun gnus-group-catchup-current (&optional n all)
6137   "Mark all articles not marked as unread in current newsgroup as read.
6138 If prefix argument N is numeric, the ARG next newsgroups will be
6139 caught up.  If ALL is non-nil, marked articles will also be marked as
6140 read.  Cross references (Xref: header) of articles are ignored.
6141 The difference between N and actual number of newsgroups that were
6142 caught up is returned."
6143   (interactive "P")
6144   (unless (gnus-group-group-name)
6145     (error "No group on the current line"))
6146   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
6147                gnus-expert-user
6148                (gnus-y-or-n-p
6149                 (if all
6150                     "Do you really want to mark all articles as read? "
6151                   "Mark all unread articles as read? "))))
6152       n
6153     (let ((groups (gnus-group-process-prefix n))
6154           (ret 0))
6155       (while groups
6156         ;; Virtual groups have to be given special treatment.
6157         (let ((method (gnus-find-method-for-group (car groups))))
6158           (if (eq 'nnvirtual (car method))
6159               (nnvirtual-catchup-group
6160                (gnus-group-real-name (car groups)) (nth 1 method) all)))
6161         (gnus-group-remove-mark (car groups))
6162         (if (>= (gnus-group-group-level) gnus-level-zombie)
6163             (gnus-message 2 "Dead groups can't be caught up")
6164           (if (prog1
6165                   (gnus-group-goto-group (car groups))
6166                 (gnus-group-catchup (car groups) all))
6167               (gnus-group-update-group-line)
6168             (setq ret (1+ ret))))
6169         (setq groups (cdr groups)))
6170       (gnus-group-next-unread-group 1)
6171       ret)))
6172
6173 (defun gnus-group-catchup-current-all (&optional n)
6174   "Mark all articles in current newsgroup as read.
6175 Cross references (Xref: header) of articles are ignored."
6176   (interactive "P")
6177   (gnus-group-catchup-current n 'all))
6178
6179 (defun gnus-group-catchup (group &optional all)
6180   "Mark all articles in GROUP as read.
6181 If ALL is non-nil, all articles are marked as read.
6182 The return value is the number of articles that were marked as read,
6183 or nil if no action could be taken."
6184   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
6185          (num (car entry)))
6186     ;; Do the updating only if the newsgroup isn't killed.
6187     (if (not (numberp (car entry)))
6188         (gnus-message 1 "Can't catch up; non-active group")
6189       ;; Do auto-expirable marks if that's required.
6190       (when (gnus-group-auto-expirable-p group)
6191         (gnus-add-marked-articles
6192          group 'expire (gnus-list-of-unread-articles group))
6193         (when all
6194           (let ((marks (nth 3 (nth 2 entry))))
6195             (gnus-add-marked-articles
6196              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
6197             (gnus-add-marked-articles
6198              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
6199       (when entry
6200         (gnus-update-read-articles group nil)
6201         ;; Also nix out the lists of marks and dormants.
6202         (when all
6203           (gnus-add-marked-articles group 'tick nil nil 'force)
6204           (gnus-add-marked-articles group 'dormant nil nil 'force))
6205         (run-hooks 'gnus-group-catchup-group-hook)
6206         num))))
6207
6208 (defun gnus-group-expire-articles (&optional n)
6209   "Expire all expirable articles in the current newsgroup."
6210   (interactive "P")
6211   (let ((groups (gnus-group-process-prefix n))
6212         group)
6213     (unless groups
6214       (error "No groups to expire"))
6215     (while (setq group (pop groups))
6216       (gnus-group-remove-mark group)
6217       (when (gnus-check-backend-function 'request-expire-articles group)
6218         (gnus-message 6 "Expiring articles in %s..." group)
6219         (let* ((info (gnus-get-info group))
6220                (expirable (if (gnus-group-total-expirable-p group)
6221                               (cons nil (gnus-list-of-read-articles group))
6222                             (assq 'expire (gnus-info-marks info))))
6223                (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
6224           (when expirable
6225             (setcdr
6226              expirable
6227              (gnus-compress-sequence
6228               (if expiry-wait
6229                   ;; We set the expiry variables to the groupp
6230                   ;; parameter. 
6231                   (let ((nnmail-expiry-wait-function nil)
6232                         (nnmail-expiry-wait expiry-wait))
6233                     (gnus-request-expire-articles
6234                      (gnus-uncompress-sequence (cdr expirable)) group))
6235                 ;; Just expire using the normal expiry values.
6236                 (gnus-request-expire-articles
6237                  (gnus-uncompress-sequence (cdr expirable)) group))))
6238             (gnus-close-group group))
6239           (gnus-message 6 "Expiring articles in %s...done" group)))
6240       (gnus-group-position-point))))
6241
6242 (defun gnus-group-expire-all-groups ()
6243   "Expire all expirable articles in all newsgroups."
6244   (interactive)
6245   (save-excursion
6246     (gnus-message 5 "Expiring...")
6247     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
6248                                      (cdr gnus-newsrc-alist))))
6249       (gnus-group-expire-articles nil)))
6250   (gnus-group-position-point)
6251   (gnus-message 5 "Expiring...done"))
6252
6253 (defun gnus-group-set-current-level (n level)
6254   "Set the level of the next N groups to LEVEL."
6255   (interactive
6256    (list
6257     current-prefix-arg
6258     (string-to-int
6259      (let ((s (read-string
6260                (format "Level (default %s): "
6261                        (or (gnus-group-group-level) 
6262                            gnus-level-default-subscribed)))))
6263        (if (string-match "^\\s-*$" s)
6264            (int-to-string (or (gnus-group-group-level) 
6265                               gnus-level-default-subscribed))
6266          s)))))
6267   (or (and (>= level 1) (<= level gnus-level-killed))
6268       (error "Illegal level: %d" level))
6269   (let ((groups (gnus-group-process-prefix n))
6270         group)
6271     (while (setq group (pop groups))
6272       (gnus-group-remove-mark group)
6273       (gnus-message 6 "Changed level of %s from %d to %d"
6274                     group (or (gnus-group-group-level) gnus-level-killed)
6275                     level)
6276       (gnus-group-change-level
6277        group level (or (gnus-group-group-level) gnus-level-killed))
6278       (gnus-group-update-group-line)))
6279   (gnus-group-position-point))
6280
6281 (defun gnus-group-unsubscribe-current-group (&optional n)
6282   "Toggle subscription of the current group.
6283 If given numerical prefix, toggle the N next groups."
6284   (interactive "P")
6285   (let ((groups (gnus-group-process-prefix n))
6286         group)
6287     (while groups
6288       (setq group (car groups)
6289             groups (cdr groups))
6290       (gnus-group-remove-mark group)
6291       (gnus-group-unsubscribe-group
6292        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
6293                  gnus-level-default-unsubscribed
6294                gnus-level-default-subscribed) t)
6295       (gnus-group-update-group-line))
6296     (gnus-group-next-group 1)))
6297
6298 (defun gnus-group-unsubscribe-group (group &optional level silent)
6299   "Toggle subscription to GROUP.
6300 Killed newsgroups are subscribed.  If SILENT, don't try to update the
6301 group line."
6302   (interactive
6303    (list (completing-read
6304           "Group: " gnus-active-hashtb nil
6305           (gnus-read-active-file-p)
6306           nil 
6307           'gnus-group-history)))
6308   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
6309     (cond
6310      ((string-match "^[ \t]$" group)
6311       (error "Empty group name"))
6312      (newsrc
6313       ;; Toggle subscription flag.
6314       (gnus-group-change-level
6315        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
6316                                       gnus-level-subscribed)
6317                                   (1+ gnus-level-subscribed)
6318                                 gnus-level-default-subscribed)))
6319       (unless silent
6320         (gnus-group-update-group group)))
6321      ((and (stringp group)
6322            (or (not (gnus-read-active-file-p))
6323                (gnus-active group)))
6324       ;; Add new newsgroup.
6325       (gnus-group-change-level
6326        group
6327        (if level level gnus-level-default-subscribed)
6328        (or (and (member group gnus-zombie-list)
6329                 gnus-level-zombie)
6330            gnus-level-killed)
6331        (and (gnus-group-group-name)
6332             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
6333       (unless silent
6334         (gnus-group-update-group group)))
6335      (t (error "No such newsgroup: %s" group)))
6336     (gnus-group-position-point)))
6337
6338 (defun gnus-group-transpose-groups (n)
6339   "Move the current newsgroup up N places.
6340 If given a negative prefix, move down instead.  The difference between
6341 N and the number of steps taken is returned."
6342   (interactive "p")
6343   (or (gnus-group-group-name)
6344       (error "No group on current line"))
6345   (gnus-group-kill-group 1)
6346   (prog1
6347       (forward-line (- n))
6348     (gnus-group-yank-group)
6349     (gnus-group-position-point)))
6350
6351 (defun gnus-group-kill-all-zombies ()
6352   "Kill all zombie newsgroups."
6353   (interactive)
6354   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
6355   (setq gnus-zombie-list nil)
6356   (gnus-group-list-groups))
6357
6358 (defun gnus-group-kill-region (begin end)
6359   "Kill newsgroups in current region (excluding current point).
6360 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
6361   (interactive "r")
6362   (let ((lines
6363          ;; Count lines.
6364          (save-excursion
6365            (count-lines
6366             (progn
6367               (goto-char begin)
6368               (beginning-of-line)
6369               (point))
6370             (progn
6371               (goto-char end)
6372               (beginning-of-line)
6373               (point))))))
6374     (goto-char begin)
6375     (beginning-of-line)                 ;Important when LINES < 1
6376     (gnus-group-kill-group lines)))
6377
6378 (defun gnus-group-kill-group (&optional n discard)
6379   "Kill the next N groups.
6380 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
6381 However, only groups that were alive can be yanked; already killed
6382 groups or zombie groups can't be yanked.
6383 The return value is the name of the group that was killed, or a list
6384 of groups killed."
6385   (interactive "P")
6386   (let ((buffer-read-only nil)
6387         (groups (gnus-group-process-prefix n))
6388         group entry level out)
6389     (if (< (length groups) 10)
6390         ;; This is faster when there are few groups.
6391         (while groups
6392           (push (setq group (pop groups)) out)
6393           (gnus-group-remove-mark group)
6394           (setq level (gnus-group-group-level))
6395           (gnus-delete-line)
6396           (when (and (not discard)
6397                      (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
6398             (push (cons (car entry) (nth 2 entry))
6399                   gnus-list-of-killed-groups))
6400           (gnus-group-change-level
6401            (if entry entry group) gnus-level-killed (if entry nil level)))
6402       ;; If there are lots and lots of groups to be killed, we use
6403       ;; this thing instead.
6404       (let (entry)
6405         (setq groups (nreverse groups))
6406         (while groups
6407           (gnus-group-remove-mark (setq group (pop groups)))
6408           (gnus-delete-line)
6409           (push group gnus-killed-list)
6410           (setq gnus-newsrc-alist
6411                 (delq (assoc group gnus-newsrc-alist)
6412                       gnus-newsrc-alist))
6413           (when gnus-group-change-level-function
6414             (funcall gnus-group-change-level-function group 9 3))
6415           (cond
6416            ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
6417             (push (cons (car entry) (nth 2 entry))
6418                   gnus-list-of-killed-groups)
6419             (setcdr (cdr entry) (cdddr entry)))
6420            ((member group gnus-zombie-list)
6421             (setq gnus-zombie-list (delete group gnus-zombie-list)))))
6422         (gnus-make-hashtable-from-newsrc-alist)))
6423
6424     (gnus-group-position-point)
6425     (if (< (length out) 2) (car out) (nreverse out))))
6426
6427 (defun gnus-group-yank-group (&optional arg)
6428   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
6429 inserting it before the current newsgroup.  The numeric ARG specifies
6430 how many newsgroups are to be yanked.  The name of the newsgroup yanked
6431 is returned, or (if several groups are yanked) a list of yanked groups
6432 is returned."
6433   (interactive "p")
6434   (setq arg (or arg 1))
6435   (let (info group prev out)
6436     (while (>= (decf arg) 0)
6437       (if (not (setq info (pop gnus-list-of-killed-groups)))
6438           (error "No more newsgroups to yank"))
6439       (push (setq group (nth 1 info)) out)
6440       ;; Find which newsgroup to insert this one before - search
6441       ;; backward until something suitable is found.  If there are no
6442       ;; other newsgroups in this buffer, just make this newsgroup the
6443       ;; first newsgroup.
6444       (setq prev (gnus-group-group-name))
6445       (gnus-group-change-level
6446        info (gnus-info-level (cdr info)) gnus-level-killed
6447        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
6448        t)
6449       (gnus-group-insert-group-line-info group))
6450     (forward-line -1)
6451     (gnus-group-position-point)
6452     (if (< (length out) 2) (car out) (nreverse out))))
6453
6454 (defun gnus-group-kill-level (level)
6455   "Kill all groups that is on a certain LEVEL."
6456   (interactive "nKill all groups on level: ")
6457   (cond
6458    ((= level gnus-level-zombie)
6459     (setq gnus-killed-list
6460           (nconc gnus-zombie-list gnus-killed-list))
6461     (setq gnus-zombie-list nil))
6462    ((and (< level gnus-level-zombie)
6463          (> level 0)
6464          (or gnus-expert-user
6465              (gnus-yes-or-no-p
6466               (format
6467                "Do you really want to kill all groups on level %d? "
6468                level))))
6469     (let* ((prev gnus-newsrc-alist)
6470            (alist (cdr prev)))
6471       (while alist
6472         (if (= (gnus-info-level (car alist)) level)
6473             (progn
6474               (push (gnus-info-group (car alist)) gnus-killed-list)
6475               (setcdr prev (cdr alist)))
6476           (setq prev alist))
6477         (setq alist (cdr alist)))
6478       (gnus-make-hashtable-from-newsrc-alist)
6479       (gnus-group-list-groups)))
6480    (t
6481     (error "Can't kill; illegal level: %d" level))))
6482
6483 (defun gnus-group-list-all-groups (&optional arg)
6484   "List all newsgroups with level ARG or lower.
6485 Default is gnus-level-unsubscribed, which lists all subscribed and most
6486 unsubscribed groups."
6487   (interactive "P")
6488   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
6489
6490 ;; Redefine this to list ALL killed groups if prefix arg used.
6491 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
6492 (defun gnus-group-list-killed (&optional arg)
6493   "List all killed newsgroups in the group buffer.
6494 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
6495 entail asking the server for the groups."
6496   (interactive "P")
6497   ;; Find all possible killed newsgroups if arg.
6498   (when arg
6499     (gnus-get-killed-groups))
6500   (if (not gnus-killed-list)
6501       (gnus-message 6 "No killed groups")
6502     (let (gnus-group-list-mode)
6503       (funcall gnus-group-prepare-function
6504                gnus-level-killed t gnus-level-killed))
6505     (goto-char (point-min)))
6506   (gnus-group-position-point))
6507
6508 (defun gnus-group-list-zombies ()
6509   "List all zombie newsgroups in the group buffer."
6510   (interactive)
6511   (if (not gnus-zombie-list)
6512       (gnus-message 6 "No zombie groups")
6513     (let (gnus-group-list-mode)
6514       (funcall gnus-group-prepare-function
6515                gnus-level-zombie t gnus-level-zombie))
6516     (goto-char (point-min)))
6517   (gnus-group-position-point))
6518
6519 (defun gnus-group-list-active ()
6520   "List all groups that are available from the server(s)."
6521   (interactive)
6522   ;; First we make sure that we have really read the active file.
6523   (unless (gnus-read-active-file-p)
6524     (let ((gnus-read-active-file t))
6525       (gnus-read-active-file)))
6526   ;; Find all groups and sort them.
6527   (let ((groups
6528          (sort
6529           (let (list)
6530             (mapatoms
6531              (lambda (sym)
6532                (and (boundp sym)
6533                     (symbol-value sym)
6534                     (setq list (cons (symbol-name sym) list))))
6535              gnus-active-hashtb)
6536             list)
6537           'string<))
6538         (buffer-read-only nil))
6539     (erase-buffer)
6540     (while groups
6541       (gnus-group-insert-group-line-info (pop groups)))
6542     (goto-char (point-min))))
6543
6544 (defun gnus-activate-all-groups (level)
6545   "Activate absolutely all groups."
6546   (interactive (list 7))
6547   (let ((gnus-activate-level level)
6548         (gnus-activate-foreign-newsgroups level))
6549     (gnus-group-get-new-news)))
6550
6551 (defun gnus-group-get-new-news (&optional arg)
6552   "Get newly arrived articles.
6553 If ARG is a number, it specifies which levels you are interested in
6554 re-scanning.  If ARG is non-nil and not a number, this will force
6555 \"hard\" re-reading of the active files from all servers."
6556   (interactive "P")
6557   (run-hooks 'gnus-get-new-news-hook)
6558   ;; We might read in new NoCeM messages here.
6559   (when (and gnus-use-nocem 
6560              (null arg))
6561     (gnus-nocem-scan-groups))
6562   ;; If ARG is not a number, then we read the active file.
6563   (when (and arg (not (numberp arg)))
6564     (let ((gnus-read-active-file t))
6565       (gnus-read-active-file))
6566     (setq arg nil))
6567
6568   (setq arg (gnus-group-default-level arg t))
6569   (if (and gnus-read-active-file (not arg))
6570       (progn
6571         (gnus-read-active-file)
6572         (gnus-get-unread-articles arg))
6573     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
6574       (gnus-get-unread-articles arg)))
6575   (run-hooks 'gnus-after-getting-new-news-hook)
6576   (gnus-group-list-groups))
6577
6578 (defun gnus-group-get-new-news-this-group (&optional n)
6579   "Check for newly arrived news in the current group (and the N-1 next groups).
6580 The difference between N and the number of newsgroup checked is returned.
6581 If N is negative, this group and the N-1 previous groups will be checked."
6582   (interactive "P")
6583   (let* ((groups (gnus-group-process-prefix n))
6584          (ret (if (numberp n) (- n (length groups)) 0))
6585          (beg (unless n (point)))
6586          group)
6587     (while (setq group (pop groups))
6588       (gnus-group-remove-mark group)
6589       (if (gnus-activate-group group 'scan)
6590           (progn
6591             (gnus-get-unread-articles-in-group
6592              (gnus-get-info group) (gnus-active group) t)
6593             (unless (gnus-virtual-group-p group)
6594               (gnus-close-group group))
6595             (gnus-group-update-group group))
6596         (if (eq (gnus-server-status (gnus-find-method-for-group group))
6597                 'denied)
6598             (gnus-error "Server denied access")
6599           (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
6600     (when beg (goto-char beg))
6601     (when gnus-goto-next-group-when-activating
6602       (gnus-group-next-unread-group 1 t))
6603     (gnus-summary-position-point)
6604     ret))
6605
6606 (defun gnus-group-fetch-faq (group &optional faq-dir)
6607   "Fetch the FAQ for the current group."
6608   (interactive
6609    (list
6610     (and (gnus-group-group-name)
6611          (gnus-group-real-name (gnus-group-group-name)))
6612     (cond (current-prefix-arg
6613            (completing-read
6614             "Faq dir: " (and (listp gnus-group-faq-directory)
6615                              (mapcar (lambda (file) (list file))
6616                                      gnus-group-faq-directory)))))))
6617   (or faq-dir
6618       (setq faq-dir (if (listp gnus-group-faq-directory)
6619                         (car gnus-group-faq-directory)
6620                       gnus-group-faq-directory)))
6621   (or group (error "No group name given"))
6622   (let ((file (concat (file-name-as-directory faq-dir)
6623                       (gnus-group-real-name group))))
6624     (if (not (file-exists-p file))
6625         (error "No such file: %s" file)
6626       (find-file file))))
6627
6628 (defun gnus-group-describe-group (force &optional group)
6629   "Display a description of the current newsgroup."
6630   (interactive (list current-prefix-arg (gnus-group-group-name)))
6631   (let* ((method (gnus-find-method-for-group group))
6632          (mname (gnus-group-prefixed-name "" method))
6633          desc)
6634     (when (and force
6635                gnus-description-hashtb)
6636       (gnus-sethash mname nil gnus-description-hashtb))
6637     (or group (error "No group name given"))
6638     (and (or (and gnus-description-hashtb
6639                   ;; We check whether this group's method has been
6640                   ;; queried for a description file.
6641                   (gnus-gethash mname gnus-description-hashtb))
6642              (setq desc (gnus-group-get-description group))
6643              (gnus-read-descriptions-file method))
6644          (gnus-message 1
6645           (or desc (gnus-gethash group gnus-description-hashtb)
6646               "No description available")))))
6647
6648 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6649 (defun gnus-group-describe-all-groups (&optional force)
6650   "Pop up a buffer with descriptions of all newsgroups."
6651   (interactive "P")
6652   (and force (setq gnus-description-hashtb nil))
6653   (if (not (or gnus-description-hashtb
6654                (gnus-read-all-descriptions-files)))
6655       (error "Couldn't request descriptions file"))
6656   (let ((buffer-read-only nil)
6657         b)
6658     (erase-buffer)
6659     (mapatoms
6660      (lambda (group)
6661        (setq b (point))
6662        (insert (format "      *: %-20s %s\n" (symbol-name group)
6663                        (symbol-value group)))
6664        (gnus-add-text-properties
6665         b (1+ b) (list 'gnus-group group
6666                        'gnus-unread t 'gnus-marked nil
6667                        'gnus-level (1+ gnus-level-subscribed))))
6668      gnus-description-hashtb)
6669     (goto-char (point-min))
6670     (gnus-group-position-point)))
6671
6672 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
6673 (defun gnus-group-apropos (regexp &optional search-description)
6674   "List all newsgroups that have names that match a regexp."
6675   (interactive "sGnus apropos (regexp): ")
6676   (let ((prev "")
6677         (obuf (current-buffer))
6678         groups des)
6679     ;; Go through all newsgroups that are known to Gnus.
6680     (mapatoms
6681      (lambda (group)
6682        (and (symbol-name group)
6683             (string-match regexp (symbol-name group))
6684             (setq groups (cons (symbol-name group) groups))))
6685      gnus-active-hashtb)
6686     ;; Also go through all descriptions that are known to Gnus.
6687     (when search-description
6688       (mapatoms
6689        (lambda (group)
6690          (and (string-match regexp (symbol-value group))
6691               (gnus-active (symbol-name group))
6692               (setq groups (cons (symbol-name group) groups))))
6693        gnus-description-hashtb))
6694     (if (not groups)
6695         (gnus-message 3 "No groups matched \"%s\"." regexp)
6696       ;; Print out all the groups.
6697       (save-excursion
6698         (pop-to-buffer "*Gnus Help*")
6699         (buffer-disable-undo (current-buffer))
6700         (erase-buffer)
6701         (setq groups (sort groups 'string<))
6702         (while groups
6703           ;; Groups may be entered twice into the list of groups.
6704           (if (not (string= (car groups) prev))
6705               (progn
6706                 (insert (setq prev (car groups)) "\n")
6707                 (if (and gnus-description-hashtb
6708                          (setq des (gnus-gethash (car groups)
6709                                                  gnus-description-hashtb)))
6710                     (insert "  " des "\n"))))
6711           (setq groups (cdr groups)))
6712         (goto-char (point-min))))
6713     (pop-to-buffer obuf)))
6714
6715 (defun gnus-group-description-apropos (regexp)
6716   "List all newsgroups that have names or descriptions that match a regexp."
6717   (interactive "sGnus description apropos (regexp): ")
6718   (if (not (or gnus-description-hashtb
6719                (gnus-read-all-descriptions-files)))
6720       (error "Couldn't request descriptions file"))
6721   (gnus-group-apropos regexp t))
6722
6723 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6724 (defun gnus-group-list-matching (level regexp &optional all lowest)
6725   "List all groups with unread articles that match REGEXP.
6726 If the prefix LEVEL is non-nil, it should be a number that says which
6727 level to cut off listing groups.
6728 If ALL, also list groups with no unread articles.
6729 If LOWEST, don't list groups with level lower than LOWEST.
6730
6731 This command may read the active file."
6732   (interactive "P\nsList newsgroups matching: ")
6733   ;; First make sure active file has been read.
6734   (when (and level
6735              (> (prefix-numeric-value level) gnus-level-killed))
6736     (gnus-get-killed-groups))
6737   (gnus-group-prepare-flat (or level gnus-level-subscribed)
6738                            all (or lowest 1) regexp)
6739   (goto-char (point-min))
6740   (gnus-group-position-point))
6741
6742 (defun gnus-group-list-all-matching (level regexp &optional lowest)
6743   "List all groups that match REGEXP.
6744 If the prefix LEVEL is non-nil, it should be a number that says which
6745 level to cut off listing groups.
6746 If LOWEST, don't list groups with level lower than LOWEST."
6747   (interactive "P\nsList newsgroups matching: ")
6748   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
6749
6750 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
6751 (defun gnus-group-save-newsrc (&optional force)
6752   "Save the Gnus startup files.
6753 If FORCE, force saving whether it is necessary or not."
6754   (interactive "P")
6755   (gnus-save-newsrc-file force))
6756
6757 (defun gnus-group-restart (&optional arg)
6758   "Force Gnus to read the .newsrc file."
6759   (interactive "P")
6760   (when (gnus-yes-or-no-p
6761          (format "Are you sure you want to read %s? "
6762                  gnus-current-startup-file))
6763     (gnus-save-newsrc-file)
6764     (gnus-setup-news 'force)
6765     (gnus-group-list-groups arg)))
6766
6767 (defun gnus-group-read-init-file ()
6768   "Read the Gnus elisp init file."
6769   (interactive)
6770   (gnus-read-init-file))
6771
6772 (defun gnus-group-check-bogus-groups (&optional silent)
6773   "Check bogus newsgroups.
6774 If given a prefix, don't ask for confirmation before removing a bogus
6775 group."
6776   (interactive "P")
6777   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
6778   (gnus-group-list-groups))
6779
6780 (defun gnus-group-edit-global-kill (&optional article group)
6781   "Edit the global kill file.
6782 If GROUP, edit that local kill file instead."
6783   (interactive "P")
6784   (setq gnus-current-kill-article article)
6785   (gnus-kill-file-edit-file group)
6786   (gnus-message
6787    6
6788    (substitute-command-keys
6789     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
6790             (if group "local" "global")))))
6791
6792 (defun gnus-group-edit-local-kill (article group)
6793   "Edit a local kill file."
6794   (interactive (list nil (gnus-group-group-name)))
6795   (gnus-group-edit-global-kill article group))
6796
6797 (defun gnus-group-force-update ()
6798   "Update `.newsrc' file."
6799   (interactive)
6800   (gnus-save-newsrc-file))
6801
6802 (defun gnus-group-suspend ()
6803   "Suspend the current Gnus session.
6804 In fact, cleanup buffers except for group mode buffer.
6805 The hook gnus-suspend-gnus-hook is called before actually suspending."
6806   (interactive)
6807   (run-hooks 'gnus-suspend-gnus-hook)
6808   ;; Kill Gnus buffers except for group mode buffer.
6809   (let* ((group-buf (get-buffer gnus-group-buffer))
6810          ;; Do this on a separate list in case the user does a ^G before we finish
6811          (gnus-buffer-list
6812           (delete group-buf (delete gnus-dribble-buffer
6813                                     (append gnus-buffer-list nil)))))
6814     (while gnus-buffer-list
6815       (gnus-kill-buffer (pop gnus-buffer-list)))
6816     (gnus-kill-gnus-frames)
6817     (when group-buf
6818       (setq gnus-buffer-list (list group-buf))
6819       (bury-buffer group-buf)
6820       (delete-windows-on group-buf t))))
6821
6822 (defun gnus-group-clear-dribble ()
6823   "Clear all information from the dribble buffer."
6824   (interactive)
6825   (gnus-dribble-clear)
6826   (gnus-message 7 "Cleared dribble buffer"))
6827
6828 (defun gnus-group-exit ()
6829   "Quit reading news after updating .newsrc.eld and .newsrc.
6830 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6831   (interactive)
6832   (when 
6833       (or noninteractive                ;For gnus-batch-kill
6834           (not gnus-interactive-exit)   ;Without confirmation
6835           gnus-expert-user
6836           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
6837     (run-hooks 'gnus-exit-gnus-hook)
6838     ;; Offer to save data from non-quitted summary buffers.
6839     (gnus-offer-save-summaries)
6840     ;; Save the newsrc file(s).
6841     (gnus-save-newsrc-file)
6842     ;; Kill-em-all.
6843     (gnus-close-backends)
6844     ;; Reset everything.
6845     (gnus-clear-system)
6846     ;; Allow the user to do things after cleaning up.
6847     (run-hooks 'gnus-after-exiting-gnus-hook)))
6848
6849 (defun gnus-close-backends ()
6850   ;; Send a close request to all backends that support such a request.
6851   (let ((methods gnus-valid-select-methods)
6852         func)
6853     (while methods
6854       (if (fboundp (setq func (intern (concat (caar methods)
6855                                               "-request-close"))))
6856           (funcall func))
6857       (setq methods (cdr methods)))))
6858
6859 (defun gnus-group-quit ()
6860   "Quit reading news without updating .newsrc.eld or .newsrc.
6861 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6862   (interactive)
6863   (when (or noninteractive              ;For gnus-batch-kill
6864             (zerop (buffer-size))
6865             (not (gnus-server-opened gnus-select-method))
6866             gnus-expert-user
6867             (not gnus-current-startup-file)
6868             (gnus-yes-or-no-p
6869              (format "Quit reading news without saving %s? "
6870                      (file-name-nondirectory gnus-current-startup-file))))
6871     (run-hooks 'gnus-exit-gnus-hook)
6872     (if gnus-use-full-window
6873         (delete-other-windows)
6874       (gnus-remove-some-windows))
6875     (gnus-dribble-save)
6876     (gnus-close-backends)
6877     (gnus-clear-system)
6878     ;; Allow the user to do things after cleaning up.
6879     (run-hooks 'gnus-after-exiting-gnus-hook)))
6880
6881 (defun gnus-offer-save-summaries ()
6882   "Offer to save all active summary buffers."
6883   (save-excursion
6884     (let ((buflist (buffer-list))
6885           buffers bufname)
6886       ;; Go through all buffers and find all summaries.
6887       (while buflist
6888         (and (setq bufname (buffer-name (car buflist)))
6889              (string-match "Summary" bufname)
6890              (save-excursion
6891                (set-buffer bufname)
6892                ;; We check that this is, indeed, a summary buffer.
6893                (and (eq major-mode 'gnus-summary-mode)
6894                     ;; Also make sure this isn't bogus.
6895                     gnus-newsgroup-prepared))
6896              (push bufname buffers))
6897         (setq buflist (cdr buflist)))
6898       ;; Go through all these summary buffers and offer to save them.
6899       (when buffers
6900         (map-y-or-n-p
6901          "Update summary buffer %s? "
6902          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
6903          buffers)))))
6904
6905 (defun gnus-group-describe-briefly ()
6906   "Give a one line description of the group mode commands."
6907   (interactive)
6908   (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select  \\[gnus-group-next-unread-group]:Forward  \\[gnus-group-prev-unread-group]:Backward  \\[gnus-group-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-group-describe-briefly]:This help")))
6909
6910 (defun gnus-group-browse-foreign-server (method)
6911   "Browse a foreign news server.
6912 If called interactively, this function will ask for a select method
6913  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
6914 If not, METHOD should be a list where the first element is the method
6915 and the second element is the address."
6916   (interactive
6917    (list (let ((how (completing-read
6918                      "Which backend: "
6919                      (append gnus-valid-select-methods gnus-server-alist)
6920                      nil t (cons "nntp" 0) 'gnus-method-history)))
6921            ;; We either got a backend name or a virtual server name.
6922            ;; If the first, we also need an address.
6923            (if (assoc how gnus-valid-select-methods)
6924                (list (intern how)
6925                      ;; Suggested by mapjph@bath.ac.uk.
6926                      (completing-read
6927                       "Address: "
6928                       (mapcar (lambda (server) (list server))
6929                               gnus-secondary-servers)))
6930              ;; We got a server name, so we find the method.
6931              (gnus-server-to-method how)))))
6932   (gnus-browse-foreign-server method))
6933
6934 \f
6935 ;;;
6936 ;;; Gnus summary mode
6937 ;;;
6938
6939 (defvar gnus-summary-mode-map nil)
6940
6941 (put 'gnus-summary-mode 'mode-class 'special)
6942
6943 (unless gnus-summary-mode-map
6944   (setq gnus-summary-mode-map (make-keymap))
6945   (suppress-keymap gnus-summary-mode-map)
6946
6947   ;; Non-orthogonal keys
6948
6949   (gnus-define-keys gnus-summary-mode-map
6950     " " gnus-summary-next-page
6951     "\177" gnus-summary-prev-page
6952     [delete] gnus-summary-prev-page
6953     "\r" gnus-summary-scroll-up
6954     "n" gnus-summary-next-unread-article
6955     "p" gnus-summary-prev-unread-article
6956     "N" gnus-summary-next-article
6957     "P" gnus-summary-prev-article
6958     "\M-\C-n" gnus-summary-next-same-subject
6959     "\M-\C-p" gnus-summary-prev-same-subject
6960     "\M-n" gnus-summary-next-unread-subject
6961     "\M-p" gnus-summary-prev-unread-subject
6962     "." gnus-summary-first-unread-article
6963     "," gnus-summary-best-unread-article
6964     "\M-s" gnus-summary-search-article-forward
6965     "\M-r" gnus-summary-search-article-backward
6966     "<" gnus-summary-beginning-of-article
6967     ">" gnus-summary-end-of-article
6968     "j" gnus-summary-goto-article
6969     "^" gnus-summary-refer-parent-article
6970     "\M-^" gnus-summary-refer-article
6971     "u" gnus-summary-tick-article-forward
6972     "!" gnus-summary-tick-article-forward
6973     "U" gnus-summary-tick-article-backward
6974     "d" gnus-summary-mark-as-read-forward
6975     "D" gnus-summary-mark-as-read-backward
6976     "E" gnus-summary-mark-as-expirable
6977     "\M-u" gnus-summary-clear-mark-forward
6978     "\M-U" gnus-summary-clear-mark-backward
6979     "k" gnus-summary-kill-same-subject-and-select
6980     "\C-k" gnus-summary-kill-same-subject
6981     "\M-\C-k" gnus-summary-kill-thread
6982     "\M-\C-l" gnus-summary-lower-thread
6983     "e" gnus-summary-edit-article
6984     "#" gnus-summary-mark-as-processable
6985     "\M-#" gnus-summary-unmark-as-processable
6986     "\M-\C-t" gnus-summary-toggle-threads
6987     "\M-\C-s" gnus-summary-show-thread
6988     "\M-\C-h" gnus-summary-hide-thread
6989     "\M-\C-f" gnus-summary-next-thread
6990     "\M-\C-b" gnus-summary-prev-thread
6991     "\M-\C-u" gnus-summary-up-thread
6992     "\M-\C-d" gnus-summary-down-thread
6993     "&" gnus-summary-execute-command
6994     "c" gnus-summary-catchup-and-exit
6995     "\C-w" gnus-summary-mark-region-as-read
6996     "\C-t" gnus-summary-toggle-truncation
6997     "?" gnus-summary-mark-as-dormant
6998     "\C-c\M-\C-s" gnus-summary-limit-include-expunged
6999     "\C-c\C-s\C-n" gnus-summary-sort-by-number
7000     "\C-c\C-s\C-a" gnus-summary-sort-by-author
7001     "\C-c\C-s\C-s" gnus-summary-sort-by-subject
7002     "\C-c\C-s\C-d" gnus-summary-sort-by-date
7003     "\C-c\C-s\C-i" gnus-summary-sort-by-score
7004     "=" gnus-summary-expand-window
7005     "\C-x\C-s" gnus-summary-reselect-current-group
7006     "\M-g" gnus-summary-rescan-group
7007     "w" gnus-summary-stop-page-breaking
7008     "\C-c\C-r" gnus-summary-caesar-message
7009     "\M-t" gnus-summary-toggle-mime
7010     "f" gnus-summary-followup
7011     "F" gnus-summary-followup-with-original
7012     "C" gnus-summary-cancel-article
7013     "r" gnus-summary-reply
7014     "R" gnus-summary-reply-with-original
7015     "\C-c\C-f" gnus-summary-mail-forward
7016     "o" gnus-summary-save-article
7017     "\C-o" gnus-summary-save-article-mail
7018     "|" gnus-summary-pipe-output
7019     "\M-k" gnus-summary-edit-local-kill
7020     "\M-K" gnus-summary-edit-global-kill
7021     "V" gnus-version
7022     "\C-c\C-d" gnus-summary-describe-group
7023     "q" gnus-summary-exit
7024     "Q" gnus-summary-exit-no-update
7025     "\C-c\C-i" gnus-info-find-node
7026     gnus-mouse-2 gnus-mouse-pick-article
7027     "m" gnus-summary-mail-other-window
7028     "a" gnus-summary-post-news
7029     "x" gnus-summary-limit-to-unread
7030     "s" gnus-summary-isearch-article
7031     "t" gnus-article-hide-headers
7032     "g" gnus-summary-show-article
7033     "l" gnus-summary-goto-last-article
7034     "\C-c\C-v\C-v" gnus-uu-decode-uu-view
7035     "\C-d" gnus-summary-enter-digest-group
7036     "\C-c\C-b" gnus-bug
7037     "*" gnus-cache-enter-article
7038     "\M-*" gnus-cache-remove-article
7039     "\M-&" gnus-summary-universal-argument
7040     "\C-l" gnus-recenter
7041     "I" gnus-summary-increase-score
7042     "L" gnus-summary-lower-score
7043
7044     "V" gnus-summary-score-map
7045     "X" gnus-uu-extract-map
7046     "S" gnus-summary-send-map)
7047
7048   ;; Sort of orthogonal keymap
7049   (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
7050     "t" gnus-summary-tick-article-forward
7051     "!" gnus-summary-tick-article-forward
7052     "d" gnus-summary-mark-as-read-forward
7053     "r" gnus-summary-mark-as-read-forward
7054     "c" gnus-summary-clear-mark-forward
7055     " " gnus-summary-clear-mark-forward
7056     "e" gnus-summary-mark-as-expirable
7057     "x" gnus-summary-mark-as-expirable
7058     "?" gnus-summary-mark-as-dormant
7059     "b" gnus-summary-set-bookmark
7060     "B" gnus-summary-remove-bookmark
7061     "#" gnus-summary-mark-as-processable
7062     "\M-#" gnus-summary-unmark-as-processable
7063     "S" gnus-summary-limit-include-expunged
7064     "C" gnus-summary-catchup
7065     "H" gnus-summary-catchup-to-here
7066     "\C-c" gnus-summary-catchup-all
7067     "k" gnus-summary-kill-same-subject-and-select
7068     "K" gnus-summary-kill-same-subject
7069     "P" gnus-uu-mark-map)
7070
7071   (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map)
7072     "c" gnus-summary-clear-above
7073     "u" gnus-summary-tick-above
7074     "m" gnus-summary-mark-above
7075     "k" gnus-summary-kill-below)
7076
7077   (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
7078     "/" gnus-summary-limit-to-subject
7079     "n" gnus-summary-limit-to-articles
7080     "w" gnus-summary-pop-limit
7081     "s" gnus-summary-limit-to-subject
7082     "a" gnus-summary-limit-to-author
7083     "u" gnus-summary-limit-to-unread
7084     "m" gnus-summary-limit-to-marks
7085     "v" gnus-summary-limit-to-score
7086     "D" gnus-summary-limit-include-dormant
7087     "d" gnus-summary-limit-exclude-dormant
7088     ;;  "t" gnus-summary-limit-exclude-thread
7089     "E" gnus-summary-limit-include-expunged
7090     "c" gnus-summary-limit-exclude-childless-dormant
7091     "C" gnus-summary-limit-mark-excluded-as-read)
7092
7093   (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
7094     "n" gnus-summary-next-unread-article
7095     "p" gnus-summary-prev-unread-article
7096     "N" gnus-summary-next-article
7097     "P" gnus-summary-prev-article
7098     "\C-n" gnus-summary-next-same-subject
7099     "\C-p" gnus-summary-prev-same-subject
7100     "\M-n" gnus-summary-next-unread-subject
7101     "\M-p" gnus-summary-prev-unread-subject
7102     "f" gnus-summary-first-unread-article
7103     "b" gnus-summary-best-unread-article
7104     "j" gnus-summary-goto-article
7105     "g" gnus-summary-goto-subject
7106     "l" gnus-summary-goto-last-article
7107     "p" gnus-summary-pop-article)
7108
7109   (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
7110     "k" gnus-summary-kill-thread
7111     "l" gnus-summary-lower-thread
7112     "i" gnus-summary-raise-thread
7113     "T" gnus-summary-toggle-threads
7114     "t" gnus-summary-rethread-current
7115     "^" gnus-summary-reparent-thread
7116     "s" gnus-summary-show-thread
7117     "S" gnus-summary-show-all-threads
7118     "h" gnus-summary-hide-thread
7119     "H" gnus-summary-hide-all-threads
7120     "n" gnus-summary-next-thread
7121     "p" gnus-summary-prev-thread
7122     "u" gnus-summary-up-thread
7123     "o" gnus-summary-top-thread
7124     "d" gnus-summary-down-thread
7125     "#" gnus-uu-mark-thread
7126     "\M-#" gnus-uu-unmark-thread)
7127
7128   (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
7129     "c" gnus-summary-catchup-and-exit
7130     "C" gnus-summary-catchup-all-and-exit
7131     "E" gnus-summary-exit-no-update
7132     "Q" gnus-summary-exit
7133     "Z" gnus-summary-exit
7134     "n" gnus-summary-catchup-and-goto-next-group
7135     "R" gnus-summary-reselect-current-group
7136     "G" gnus-summary-rescan-group
7137     "N" gnus-summary-next-group
7138     "P" gnus-summary-prev-group)
7139
7140   (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
7141     " " gnus-summary-next-page
7142     "n" gnus-summary-next-page
7143     "\177" gnus-summary-prev-page
7144     [delete] gnus-summary-prev-page
7145     "p" gnus-summary-prev-page
7146     "\r" gnus-summary-scroll-up
7147     "<" gnus-summary-beginning-of-article
7148     ">" gnus-summary-end-of-article
7149     "b" gnus-summary-beginning-of-article
7150     "e" gnus-summary-end-of-article
7151     "^" gnus-summary-refer-parent-article
7152     "r" gnus-summary-refer-parent-article
7153     "R" gnus-summary-refer-references
7154     "g" gnus-summary-show-article
7155     "s" gnus-summary-isearch-article)
7156
7157   (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
7158     "b" gnus-article-add-buttons
7159     "B" gnus-article-add-buttons-to-head
7160     "o" gnus-article-treat-overstrike
7161     ;;  "w" gnus-article-word-wrap
7162     "w" gnus-article-fill-cited-article
7163     "c" gnus-article-remove-cr
7164     "L" gnus-article-remove-trailing-blank-lines
7165     "q" gnus-article-de-quoted-unreadable
7166     "f" gnus-article-display-x-face
7167     "l" gnus-summary-stop-page-breaking
7168     "r" gnus-summary-caesar-message
7169     "t" gnus-article-hide-headers
7170     "v" gnus-summary-verbose-headers
7171     "m" gnus-summary-toggle-mime)
7172
7173   (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
7174     "a" gnus-article-hide
7175     "h" gnus-article-hide-headers
7176     "b" gnus-article-hide-boring-headers
7177     "s" gnus-article-hide-signature
7178     "c" gnus-article-hide-citation
7179     "p" gnus-article-hide-pgp
7180     "P" gnus-article-hide-pem
7181     "\C-c" gnus-article-hide-citation-maybe)
7182
7183   (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
7184     "a" gnus-article-highlight
7185     "h" gnus-article-highlight-headers
7186     "c" gnus-article-highlight-citation
7187     "s" gnus-article-highlight-signature)
7188
7189   (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
7190     "z" gnus-article-date-ut
7191     "u" gnus-article-date-ut
7192     "l" gnus-article-date-local
7193     "e" gnus-article-date-lapsed
7194     "o" gnus-article-date-original)
7195
7196   (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
7197     "v" gnus-version
7198     "f" gnus-summary-fetch-faq
7199     "d" gnus-summary-describe-group
7200     "h" gnus-summary-describe-briefly
7201     "i" gnus-info-find-node)
7202
7203   (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
7204     "e" gnus-summary-expire-articles
7205     "\M-\C-e" gnus-summary-expire-articles-now
7206     "\177" gnus-summary-delete-article
7207     [delete] gnus-summary-delete-article
7208     "m" gnus-summary-move-article
7209     "r" gnus-summary-respool-article
7210     "w" gnus-summary-edit-article
7211     "c" gnus-summary-copy-article
7212     "B" gnus-summary-crosspost-article
7213     "q" gnus-summary-respool-query
7214     "i" gnus-summary-import-article)
7215
7216   (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
7217     "o" gnus-summary-save-article
7218     "m" gnus-summary-save-article-mail
7219     "r" gnus-summary-save-article-rmail
7220     "f" gnus-summary-save-article-file
7221     "b" gnus-summary-save-article-body-file
7222     "h" gnus-summary-save-article-folder
7223     "v" gnus-summary-save-article-vm
7224     "p" gnus-summary-pipe-output
7225     "s" gnus-soup-add-article)
7226   )
7227
7228 \f
7229
7230 (defun gnus-summary-mode (&optional group)
7231   "Major mode for reading articles.
7232
7233 All normal editing commands are switched off.
7234 \\<gnus-summary-mode-map>
7235 Each line in this buffer represents one article.  To read an
7236 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
7237 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
7238 respectively.
7239
7240 You can also post articles and send mail from this buffer.  To
7241 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
7242 of an article, type `\\[gnus-summary-reply]'.
7243
7244 There are approx. one gazillion commands you can execute in this
7245 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
7246
7247 The following commands are available:
7248
7249 \\{gnus-summary-mode-map}"
7250   (interactive)
7251   (when (and menu-bar-mode
7252              (gnus-visual-p 'summary-menu 'menu))
7253     (gnus-summary-make-menu-bar))
7254   (kill-all-local-variables)
7255   (gnus-summary-make-local-variables)
7256   (gnus-make-thread-indent-array)
7257   (gnus-simplify-mode-line)
7258   (setq major-mode 'gnus-summary-mode)
7259   (setq mode-name "Summary")
7260   (make-local-variable 'minor-mode-alist)
7261   (use-local-map gnus-summary-mode-map)
7262   (buffer-disable-undo (current-buffer))
7263   (setq buffer-read-only t)             ;Disable modification
7264   (setq truncate-lines t)
7265   (setq selective-display t)
7266   (setq selective-display-ellipses t)   ;Display `...'
7267   (setq buffer-display-table gnus-summary-display-table)
7268   (setq gnus-newsgroup-name group)
7269   (make-local-variable 'gnus-summary-line-format)
7270   (make-local-variable 'gnus-summary-line-format-spec)
7271   (make-local-variable 'gnus-summary-mark-positions)
7272   (gnus-make-local-hook 'post-command-hook)
7273   (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
7274   (run-hooks 'gnus-summary-mode-hook))
7275
7276 (defun gnus-summary-make-local-variables ()
7277   "Make all the local summary buffer variables."
7278   (let ((locals gnus-summary-local-variables)
7279         global local)
7280     (while (setq local (pop locals))
7281       (if (consp local)
7282           (progn
7283             (if (eq (cdr local) 'global)
7284                 ;; Copy the global value of the variable.
7285                 (setq global (symbol-value (car local)))
7286               ;; Use the value from the list.
7287               (setq global (eval (cdr local))))
7288             (make-local-variable (car local))
7289             (set (car local) global))
7290         ;; Simple nil-valued local variable.
7291         (make-local-variable local)
7292         (set local nil)))))
7293
7294 (defun gnus-summary-make-display-table ()
7295   ;; Change the display table.  Odd characters have a tendency to mess
7296   ;; up nicely formatted displays - we make all possible glyphs
7297   ;; display only a single character.
7298
7299   ;; We start from the standard display table, if any.
7300   (setq gnus-summary-display-table
7301         (or (copy-sequence standard-display-table)
7302             (make-display-table)))
7303   ;; Nix out all the control chars...
7304   (let ((i 32))
7305     (while (>= (setq i (1- i)) 0)
7306       (aset gnus-summary-display-table i [??])))
7307   ;; ... but not newline and cr, of course. (cr is necessary for the
7308   ;; selective display).
7309   (aset gnus-summary-display-table ?\n nil)
7310   (aset gnus-summary-display-table ?\r nil)
7311   ;; We nix out any glyphs over 126 that are not set already.
7312   (let ((i 256))
7313     (while (>= (setq i (1- i)) 127)
7314       ;; Only modify if the entry is nil.
7315       (or (aref gnus-summary-display-table i)
7316           (aset gnus-summary-display-table i [??])))))
7317
7318 (defun gnus-summary-clear-local-variables ()
7319   (let ((locals gnus-summary-local-variables))
7320     (while locals
7321       (if (consp (car locals))
7322           (and (vectorp (caar locals))
7323                (set (caar locals) nil))
7324         (and (vectorp (car locals))
7325              (set (car locals) nil)))
7326       (setq locals (cdr locals)))))
7327
7328 ;; Summary data functions.
7329
7330 (defmacro gnus-data-number (data)
7331   `(car ,data))
7332
7333 (defmacro gnus-data-set-number (data number)
7334   `(setcar ,data ,number))
7335
7336 (defmacro gnus-data-mark (data)
7337   `(nth 1 ,data))
7338
7339 (defmacro gnus-data-set-mark (data mark)
7340   `(setcar (nthcdr 1 ,data) ,mark))
7341
7342 (defmacro gnus-data-pos (data)
7343   `(nth 2 ,data))
7344
7345 (defmacro gnus-data-set-pos (data pos)
7346   `(setcar (nthcdr 2 ,data) ,pos))
7347
7348 (defmacro gnus-data-header (data)
7349   `(nth 3 ,data))
7350
7351 (defmacro gnus-data-level (data)
7352   `(nth 4 ,data))
7353
7354 (defmacro gnus-data-unread-p (data)
7355   `(= (nth 1 ,data) gnus-unread-mark))
7356
7357 (defmacro gnus-data-pseudo-p (data)
7358   `(consp (nth 3 ,data)))
7359
7360 (defmacro gnus-data-find (number)
7361   `(assq ,number gnus-newsgroup-data))
7362
7363 (defmacro gnus-data-find-list (number &optional data)
7364   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
7365      (memq (assq ,number bdata)
7366            bdata)))
7367
7368 (defmacro gnus-data-make (number mark pos header level)
7369   `(list ,number ,mark ,pos ,header ,level))
7370
7371 (defun gnus-data-enter (after-article number mark pos header level offset)
7372   (let ((data (gnus-data-find-list after-article)))
7373     (or data (error "No such article: %d" after-article))
7374     (setcdr data (cons (gnus-data-make number mark pos header level)
7375                        (cdr data)))
7376     (setq gnus-newsgroup-data-reverse nil)
7377     (gnus-data-update-list (cddr data) offset)))
7378
7379 (defun gnus-data-enter-list (after-article list &optional offset)
7380   (when list
7381     (let ((data (and after-article (gnus-data-find-list after-article)))
7382           (ilist list))
7383       (or data (not after-article) (error "No such article: %d" after-article))
7384       ;; Find the last element in the list to be spliced into the main
7385       ;; list.
7386       (while (cdr list)
7387         (setq list (cdr list)))
7388       (if (not data)
7389           (progn
7390             (setcdr list gnus-newsgroup-data)
7391             (setq gnus-newsgroup-data ilist)
7392             (and offset (gnus-data-update-list (cdr list) offset)))
7393         (setcdr list (cdr data))
7394         (setcdr data ilist)
7395         (and offset (gnus-data-update-list (cdr data) offset)))
7396       (setq gnus-newsgroup-data-reverse nil))))
7397
7398 (defun gnus-data-remove (article &optional offset)
7399   (let ((data gnus-newsgroup-data))
7400     (if (= (gnus-data-number (car data)) article)
7401         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
7402               gnus-newsgroup-data-reverse nil)
7403       (while (cdr data)
7404         (and (= (gnus-data-number (cadr data)) article)
7405              (progn
7406                (setcdr data (cddr data))
7407                (and offset (gnus-data-update-list (cdr data) offset))
7408                (setq data nil
7409                      gnus-newsgroup-data-reverse nil)))
7410         (setq data (cdr data))))))
7411
7412 (defmacro gnus-data-list (backward)
7413   `(if ,backward
7414        (or gnus-newsgroup-data-reverse
7415            (setq gnus-newsgroup-data-reverse
7416                  (reverse gnus-newsgroup-data)))
7417      gnus-newsgroup-data))
7418
7419 (defun gnus-data-update-list (data offset)
7420   "Add OFFSET to the POS of all data entries in DATA."
7421   (while data
7422     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
7423     (setq data (cdr data))))
7424
7425 (defun gnus-data-compute-positions ()
7426   "Compute the positions of all articles."
7427   (let ((data gnus-newsgroup-data)
7428         pos)
7429     (while data
7430       (when (setq pos (text-property-any
7431                        (point-min) (point-max)
7432                        'gnus-number (gnus-data-number (car data))))
7433         (gnus-data-set-pos (car data) (+ pos 3)))
7434       (setq data (cdr data)))))
7435
7436 (defun gnus-summary-article-pseudo-p (article)
7437   "Say whether this article is a pseudo article or not."
7438   (not (vectorp (gnus-data-header (gnus-data-find article)))))
7439
7440 (defun gnus-article-parent-p (number)
7441   "Say whether this article is a parent or not."
7442   (let ((data (gnus-data-find-list number)))
7443     (and (cdr data)                     ; There has to be an article after...
7444          (< (gnus-data-level (car data)) ; And it has to have a higher level.
7445             (gnus-data-level (nth 1 data))))))
7446
7447 (defun gnus-article-children (number)
7448   "Return a list of all children to NUMBER."
7449   (let* ((data (gnus-data-find-list number))
7450          (level (gnus-data-level (car data)))
7451          children)
7452     (setq data (cdr data))
7453     (while (and data            
7454                 (= (gnus-data-level (car data)) (1+ level)))
7455       (push (gnus-data-number (car data)) children)
7456       (setq data (cdr data)))
7457     children))
7458
7459 (defmacro gnus-summary-skip-intangible ()
7460   "If the current article is intangible, then jump to a different article."
7461   '(let ((to (get-text-property (point) 'gnus-intangible)))
7462     (and to (gnus-summary-goto-subject to))))
7463
7464 (defmacro gnus-summary-article-intangible-p ()
7465   "Say whether this article is intangible or not."
7466   '(get-text-property (point) 'gnus-intangible))
7467
7468 ;; Some summary mode macros.
7469
7470 (defmacro gnus-summary-article-number ()
7471   "The article number of the article on the current line.
7472 If there isn's an article number here, then we return the current
7473 article number."
7474   '(progn
7475      (gnus-summary-skip-intangible)
7476      (or (get-text-property (point) 'gnus-number)
7477          (gnus-summary-last-subject))))
7478
7479 (defmacro gnus-summary-article-header (&optional number)
7480   `(gnus-data-header (gnus-data-find
7481                       ,(or number '(gnus-summary-article-number)))))
7482
7483 (defmacro gnus-summary-thread-level (&optional number)
7484   `(if (and (eq gnus-summary-make-false-root 'dummy)
7485             (get-text-property (point) 'gnus-intangible))
7486        0
7487      (gnus-data-level (gnus-data-find
7488                        ,(or number '(gnus-summary-article-number))))))
7489
7490 (defmacro gnus-summary-article-mark (&optional number)
7491   `(gnus-data-mark (gnus-data-find
7492                     ,(or number '(gnus-summary-article-number)))))
7493
7494 (defmacro gnus-summary-article-pos (&optional number)
7495   `(gnus-data-pos (gnus-data-find
7496                    ,(or number '(gnus-summary-article-number)))))
7497
7498 (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
7499 (defmacro gnus-summary-article-subject (&optional number)
7500   "Return current subject string or nil if nothing."
7501   `(let ((headers
7502           ,(if number
7503                `(gnus-data-header (assq ,number gnus-newsgroup-data))
7504              '(gnus-data-header (assq (gnus-summary-article-number)
7505                                       gnus-newsgroup-data)))))
7506      (and headers
7507           (vectorp headers)
7508           (mail-header-subject headers))))
7509
7510 (defmacro gnus-summary-article-score (&optional number)
7511   "Return current article score."
7512   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
7513                   gnus-newsgroup-scored))
7514        gnus-summary-default-score 0))
7515
7516 (defun gnus-summary-article-children (&optional number)
7517   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
7518          (level (gnus-data-level (car data)))
7519          l children)
7520     (while (and (setq data (cdr data))
7521                 (> (setq l (gnus-data-level (car data))) level))
7522       (and (= (1+ level) l)
7523            (setq children (cons (gnus-data-number (car data))
7524                                 children))))
7525     (nreverse children)))
7526
7527 (defun gnus-summary-article-parent (&optional number)
7528   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
7529                                     (gnus-data-list t)))
7530          (level (gnus-data-level (car data))))
7531     (if (zerop level)
7532         () ; This is a root.
7533       ;; We search until we find an article with a level less than
7534       ;; this one.  That function has to be the parent.
7535       (while (and (setq data (cdr data))
7536                   (not (< (gnus-data-level (car data)) level))))
7537       (and data (gnus-data-number (car data))))))
7538
7539 (defun gnus-unread-mark-p (mark)
7540   "Say whether MARK is the unread mark."
7541   (= mark gnus-unread-mark))
7542
7543 (defun gnus-read-mark-p (mark)
7544   "Say whether MARK is one of the marks that mark as read.
7545 This is all marks except unread, ticked, dormant, and expirable."
7546   (not (or (= mark gnus-unread-mark)
7547            (= mark gnus-ticked-mark)
7548            (= mark gnus-dormant-mark)
7549            (= mark gnus-expirable-mark))))
7550
7551 ;; Saving hidden threads.
7552
7553 (put 'gnus-save-hidden-threads 'lisp-indent-function 0)
7554 (put 'gnus-save-hidden-threads 'lisp-indent-hook 0)
7555 (put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
7556
7557 (defmacro gnus-save-hidden-threads (&rest forms)
7558   "Save hidden threads, eval FORMS, and restore the hidden threads."
7559   (let ((config (make-symbol "config")))
7560     `(let ((,config (gnus-hidden-threads-configuration)))
7561        (unwind-protect
7562            (progn
7563              ,@forms)
7564          (gnus-restore-hidden-threads-configuration ,config)))))
7565
7566 (defun gnus-hidden-threads-configuration ()
7567   "Return the current hidden threads configuration."
7568   (save-excursion
7569     (let (config)
7570       (goto-char (point-min))
7571       (while (search-forward "\r" nil t)
7572         (push (1- (point)) config))
7573       config)))
7574
7575 (defun gnus-restore-hidden-threads-configuration (config)
7576   "Restore hidden threads configuration from CONFIG."
7577   (let (point buffer-read-only)
7578     (while (setq point (pop config))
7579       (when (and (< point (point-max))
7580                  (goto-char point)
7581                  (= (following-char) ?\n))
7582         (subst-char-in-region point (1+ point) ?\n ?\r)))))
7583
7584 ;; Various summary mode internalish functions.
7585
7586 (defun gnus-mouse-pick-article (e)
7587   (interactive "e")
7588   (mouse-set-point e)
7589   (gnus-summary-next-page nil t))
7590
7591 (defun gnus-summary-setup-buffer (group)
7592   "Initialize summary buffer."
7593   (let ((buffer (concat "*Summary " group "*")))
7594     (if (get-buffer buffer)
7595         (progn
7596           (set-buffer buffer)
7597           (setq gnus-summary-buffer (current-buffer))
7598           (not gnus-newsgroup-prepared))
7599       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
7600       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
7601       (gnus-add-current-to-buffer-list)
7602       (gnus-summary-mode group)
7603       (when gnus-carpal
7604         (gnus-carpal-setup-buffer 'summary))
7605       (unless gnus-single-article-buffer
7606         (make-local-variable 'gnus-article-buffer)
7607         (make-local-variable 'gnus-article-current)
7608         (make-local-variable 'gnus-original-article-buffer))
7609       (setq gnus-newsgroup-name group)
7610       t)))
7611
7612 (defun gnus-set-global-variables ()
7613   ;; Set the global equivalents of the summary buffer-local variables
7614   ;; to the latest values they had.  These reflect the summary buffer
7615   ;; that was in action when the last article was fetched.
7616   (when (eq major-mode 'gnus-summary-mode)
7617     (setq gnus-summary-buffer (current-buffer))
7618     (let ((name gnus-newsgroup-name)
7619           (marked gnus-newsgroup-marked)
7620           (unread gnus-newsgroup-unreads)
7621           (headers gnus-current-headers)
7622           (data gnus-newsgroup-data)
7623           (summary gnus-summary-buffer)
7624           (article-buffer gnus-article-buffer)
7625           (original gnus-original-article-buffer)
7626           (gac gnus-article-current)
7627           (reffed gnus-reffed-article-number)
7628           (score-file gnus-current-score-file))
7629       (save-excursion
7630         (set-buffer gnus-group-buffer)
7631         (setq gnus-newsgroup-name name)
7632         (setq gnus-newsgroup-marked marked)
7633         (setq gnus-newsgroup-unreads unread)
7634         (setq gnus-current-headers headers)
7635         (setq gnus-newsgroup-data data)
7636         (setq gnus-article-current gac)
7637         (setq gnus-summary-buffer summary)
7638         (setq gnus-article-buffer article-buffer)
7639         (setq gnus-original-article-buffer original)
7640         (setq gnus-reffed-article-number reffed)
7641         (setq gnus-current-score-file score-file)))))
7642
7643 (defun gnus-summary-last-article-p (&optional article)
7644   "Return whether ARTICLE is the last article in the buffer."
7645   (if (not (setq article (or article (gnus-summary-article-number))))
7646       t ; All non-existant numbers are the last article. :-)
7647     (not (cdr (gnus-data-find-list article)))))
7648
7649 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
7650   "Insert a dummy root in the summary buffer."
7651   (beginning-of-line)
7652   (gnus-add-text-properties
7653    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
7654    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
7655
7656 (defun gnus-make-thread-indent-array ()
7657   (let ((n 200))
7658     (unless (and gnus-thread-indent-array
7659                  (= gnus-thread-indent-level gnus-thread-indent-array-level))
7660       (setq gnus-thread-indent-array (make-vector 201 "")
7661             gnus-thread-indent-array-level gnus-thread-indent-level)
7662       (while (>= n 0)
7663         (aset gnus-thread-indent-array n
7664               (make-string (* n gnus-thread-indent-level) ? ))
7665         (setq n (1- n))))))
7666
7667 (defun gnus-summary-insert-line
7668   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
7669                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
7670                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
7671   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
7672          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
7673          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
7674          (gnus-tmp-score-char
7675           (if (or (null gnus-summary-default-score)
7676                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7677                       gnus-summary-zcore-fuzz)) ? 
7678             (if (< gnus-tmp-score gnus-summary-default-score)
7679                 gnus-score-below-mark gnus-score-over-mark)))
7680          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
7681                                  ((memq gnus-tmp-current gnus-newsgroup-cached)
7682                                   gnus-cached-mark)
7683                                  (gnus-tmp-replied gnus-replied-mark)
7684                                  ((memq gnus-tmp-current gnus-newsgroup-saved)
7685                                   gnus-saved-mark)
7686                                  (t gnus-unread-mark)))
7687          (gnus-tmp-from (mail-header-from gnus-tmp-header))
7688          (gnus-tmp-name
7689           (cond
7690            ((string-match "(.+)" gnus-tmp-from)
7691             (substring gnus-tmp-from
7692                        (1+ (match-beginning 0)) (1- (match-end 0))))
7693            ((string-match "<[^>]+> *$" gnus-tmp-from)
7694             (let ((beg (match-beginning 0)))
7695               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7696                        (substring gnus-tmp-from (1+ (match-beginning 0))
7697                                   (1- (match-end 0))))
7698                   (substring gnus-tmp-from 0 beg))))
7699            (t gnus-tmp-from)))
7700          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
7701          (gnus-tmp-number (mail-header-number gnus-tmp-header))
7702          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
7703          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
7704          (buffer-read-only nil))
7705     (when (string= gnus-tmp-name "")
7706       (setq gnus-tmp-name gnus-tmp-from))
7707     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7708     (gnus-put-text-property
7709      (point)
7710      (progn (eval gnus-summary-line-format-spec) (point))
7711      'gnus-number gnus-tmp-number)
7712     (when (gnus-visual-p 'summary-highlight 'highlight)
7713       (forward-line -1)
7714       (run-hooks 'gnus-summary-update-hook)
7715       (forward-line 1))))
7716
7717 (defun gnus-summary-update-line (&optional dont-update)
7718   ;; Update summary line after change.
7719   (when (and gnus-summary-default-score
7720              (not gnus-summary-inhibit-highlight))
7721     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
7722            (article (gnus-summary-article-number))
7723            (score (gnus-summary-article-score article)))
7724       (unless dont-update
7725         (if (and gnus-summary-mark-below
7726                  (< (gnus-summary-article-score)
7727                     gnus-summary-mark-below))
7728             ;; This article has a low score, so we mark it as read.
7729             (when (memq article gnus-newsgroup-unreads)
7730               (gnus-summary-mark-article-as-read gnus-low-score-mark))
7731           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
7732             ;; This article was previously marked as read on account
7733             ;; of a low score, but now it has risen, so we mark it as
7734             ;; unread.
7735             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
7736         (gnus-summary-update-mark
7737          (if (or (null gnus-summary-default-score)
7738                  (<= (abs (- score gnus-summary-default-score))
7739                      gnus-summary-zcore-fuzz)) ? 
7740            (if (< score gnus-summary-default-score)
7741                gnus-score-below-mark gnus-score-over-mark)) 'score))
7742       ;; Do visual highlighting.
7743       (when (gnus-visual-p 'summary-highlight 'highlight)
7744         (run-hooks 'gnus-summary-update-hook)))))
7745
7746 (defvar gnus-tmp-new-adopts nil)
7747
7748 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
7749   ;; Sum up all elements (and sub-elements) in a list.
7750   (let* ((number
7751           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
7752           (cond
7753            ((and (consp thread) (cdr thread))
7754             (apply
7755              '+ 1 (mapcar
7756                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
7757            ((null thread)
7758             1)
7759            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
7760             1)
7761            (t 0))))
7762     (when (and level (zerop level) gnus-tmp-new-adopts)
7763       (incf number
7764             (apply '+ (mapcar
7765                        'gnus-summary-number-of-articles-in-thread
7766                        gnus-tmp-new-adopts))))
7767     (if char
7768         (if (> number 1) gnus-not-empty-thread-mark
7769           gnus-empty-thread-mark)
7770       number)))
7771
7772 (defun gnus-summary-set-local-parameters (group)
7773  "Go through the local params of GROUP and set all variable specs in that list."
7774   (let ((params (gnus-info-params (gnus-get-info group)))
7775         elem)
7776     (while params
7777       (setq elem (car params)
7778             params (cdr params))
7779       (and (consp elem)                 ; Has to be a cons.
7780            (consp (cdr elem))           ; The cdr has to be a list.
7781            (symbolp (car elem))         ; Has to be a symbol in there.
7782            (not (memq (car elem) 
7783                       '(quit-config to-address to-list to-group)))
7784            (progn                       ; So we set it.
7785              (make-local-variable (car elem))
7786              (set (car elem) (eval (nth 1 elem))))))))
7787
7788 (defun gnus-summary-read-group (group &optional show-all no-article
7789                                       kill-buffer no-display)
7790   "Start reading news in newsgroup GROUP.
7791 If SHOW-ALL is non-nil, already read articles are also listed.
7792 If NO-ARTICLE is non-nil, no article is selected initially.
7793 If NO-DISPLAY, don't generate a summary buffer."
7794   (gnus-message 5 "Retrieving newsgroup: %s..." group)
7795   (let* ((new-group (gnus-summary-setup-buffer group))
7796          (quit-config (gnus-group-quit-config group))
7797          (did-select (and new-group (gnus-select-newsgroup group show-all))))
7798     (cond
7799      ;; This summary buffer exists already, so we just select it.
7800      ((not new-group)
7801       (gnus-set-global-variables)
7802       (when kill-buffer
7803         (gnus-kill-or-deaden-summary kill-buffer))
7804       (gnus-configure-windows 'summary 'force)
7805       (gnus-set-mode-line 'summary)
7806       (gnus-summary-position-point)
7807       (message "")
7808       t)
7809      ;; We couldn't select this group.
7810      ((null did-select)
7811       (when (and (eq major-mode 'gnus-summary-mode)
7812                  (not (equal (current-buffer) kill-buffer)))
7813         (kill-buffer (current-buffer))
7814         (if (not quit-config)
7815             (progn
7816               (set-buffer gnus-group-buffer)
7817               (gnus-group-jump-to-group group)
7818               (gnus-group-next-unread-group 1))
7819           (if (not (buffer-name (car quit-config)))
7820               (gnus-configure-windows 'group 'force)
7821             (set-buffer (car quit-config))
7822             (and (eq major-mode 'gnus-summary-mode)
7823                  (gnus-set-global-variables))
7824             (gnus-configure-windows (cdr quit-config)))))
7825       (gnus-message 3 "Can't select group")
7826       nil)
7827      ;; The user did a `C-g' while prompting for number of articles,
7828      ;; so we exit this group.
7829      ((eq did-select 'quit)
7830       (and (eq major-mode 'gnus-summary-mode)
7831            (not (equal (current-buffer) kill-buffer))
7832            (kill-buffer (current-buffer)))
7833       (when kill-buffer
7834         (gnus-kill-or-deaden-summary kill-buffer))
7835       (if (not quit-config)
7836           (progn
7837             (set-buffer gnus-group-buffer)
7838             (gnus-group-jump-to-group group)
7839             (gnus-group-next-unread-group 1)
7840             (gnus-configure-windows 'group 'force))
7841         (if (not (buffer-name (car quit-config)))
7842             (gnus-configure-windows 'group 'force)
7843           (set-buffer (car quit-config))
7844           (and (eq major-mode 'gnus-summary-mode)
7845                (gnus-set-global-variables))
7846           (gnus-configure-windows (cdr quit-config))))
7847       ;; Finally signal the quit.
7848       (signal 'quit nil))
7849      ;; The group was successfully selected.
7850      (t
7851       (gnus-set-global-variables)
7852       ;; Save the active value in effect when the group was entered.
7853       (setq gnus-newsgroup-active
7854             (gnus-copy-sequence
7855              (gnus-active gnus-newsgroup-name)))
7856       ;; You can change the summary buffer in some way with this hook.
7857       (run-hooks 'gnus-select-group-hook)
7858       ;; Set any local variables in the group parameters.
7859       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7860       (gnus-update-format-specifications)
7861       ;; Do score processing.
7862       (when gnus-use-scoring
7863         (gnus-possibly-score-headers))
7864       ;; Check whether to fill in the gaps in the threads.
7865       (when gnus-build-sparse-threads
7866         (gnus-build-sparse-threads))
7867       ;; Find the initial limit.
7868       (if gnus-show-threads
7869           (if show-all
7870               (let ((gnus-newsgroup-dormant nil))
7871                 (gnus-summary-initial-limit show-all))
7872             (gnus-summary-initial-limit show-all))
7873         (setq gnus-newsgroup-limit 
7874               (mapcar 
7875                (lambda (header) (mail-header-number header))
7876                gnus-newsgroup-headers)))
7877       ;; Generate the summary buffer.
7878       (unless no-display
7879         (gnus-summary-prepare))
7880       (when gnus-use-trees
7881         (gnus-tree-open group)
7882         (setq gnus-summary-highlight-line-function
7883               'gnus-tree-highlight-article))
7884       ;; If the summary buffer is empty, but there are some low-scored
7885       ;; articles or some excluded dormants, we include these in the
7886       ;; buffer.
7887       (when (and (zerop (buffer-size))
7888                  (not no-display))
7889         (cond (gnus-newsgroup-dormant
7890                (gnus-summary-limit-include-dormant))
7891               ((and gnus-newsgroup-scored show-all)
7892                (gnus-summary-limit-include-expunged t))))
7893       ;; Function `gnus-apply-kill-file' must be called in this hook.
7894       (run-hooks 'gnus-apply-kill-hook)
7895       (if (and (zerop (buffer-size))
7896                (not no-display))
7897           (progn
7898             ;; This newsgroup is empty.
7899             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7900             (gnus-message 6 "No unread news")
7901             (when kill-buffer
7902               (gnus-kill-or-deaden-summary kill-buffer))
7903             ;; Return nil from this function.
7904             nil)
7905         ;; Hide conversation thread subtrees.  We cannot do this in
7906         ;; gnus-summary-prepare-hook since kill processing may not
7907         ;; work with hidden articles.
7908         (and gnus-show-threads
7909              gnus-thread-hide-subtree
7910              (gnus-summary-hide-all-threads))
7911         ;; Show first unread article if requested.
7912         (if (and (not no-article)
7913                  (not no-display)
7914                  gnus-newsgroup-unreads
7915                  gnus-auto-select-first)
7916             (unless (if (eq gnus-auto-select-first 'best)
7917                         (gnus-summary-best-unread-article)
7918                       (gnus-summary-first-unread-article))
7919               (gnus-configure-windows 'summary))
7920           ;; Don't select any articles, just move point to the first
7921           ;; article in the group.
7922           (goto-char (point-min))
7923           (gnus-summary-position-point)
7924           (gnus-set-mode-line 'summary)
7925           (gnus-configure-windows 'summary 'force))
7926         ;; If we are in async mode, we send some info to the backend.
7927         (when gnus-newsgroup-async
7928           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7929         (when kill-buffer
7930           (gnus-kill-or-deaden-summary kill-buffer))
7931         (when (get-buffer-window gnus-group-buffer t)
7932           ;; Gotta use windows, because recenter does wierd stuff if
7933           ;; the current buffer ain't the displayed window.
7934           (let ((owin (selected-window)))
7935             (select-window (get-buffer-window gnus-group-buffer t))
7936             (when (gnus-group-goto-group group)
7937               (recenter))
7938             (select-window owin))))
7939       ;; Mark this buffer as "prepared".
7940       (setq gnus-newsgroup-prepared t)
7941       t))))
7942
7943 (defun gnus-summary-prepare ()
7944   "Generate the summary buffer."
7945   (let ((buffer-read-only nil))
7946     (erase-buffer)
7947     (setq gnus-newsgroup-data nil
7948           gnus-newsgroup-data-reverse nil)
7949     (run-hooks 'gnus-summary-generate-hook)
7950     ;; Generate the buffer, either with threads or without.
7951     (when gnus-newsgroup-headers
7952       (gnus-summary-prepare-threads
7953        (if gnus-show-threads
7954            (gnus-sort-gathered-threads
7955             (funcall gnus-summary-thread-gathering-function
7956                      (gnus-sort-threads
7957                       (gnus-cut-threads (gnus-make-threads)))))
7958          ;; Unthreaded display.
7959          (gnus-sort-articles gnus-newsgroup-headers))))
7960     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7961     ;; Call hooks for modifying summary buffer.
7962     (goto-char (point-min))
7963     (run-hooks 'gnus-summary-prepare-hook)))
7964
7965 (defun gnus-gather-threads-by-subject (threads)
7966   "Gather threads by looking at Subject headers."
7967   (if (not gnus-summary-make-false-root)
7968       threads
7969     (let ((hashtb (gnus-make-hashtable 1023))
7970           (prev threads)
7971           (result threads)
7972           subject hthread whole-subject)
7973       (while threads
7974         (setq whole-subject (mail-header-subject (caar threads)))
7975         (setq subject
7976               (cond
7977                ;; Truncate the subject.
7978                ((numberp gnus-summary-gather-subject-limit)
7979                 (setq subject (gnus-simplify-subject-re whole-subject))
7980                 (if (> (length subject) gnus-summary-gather-subject-limit)
7981                     (substring subject 0 gnus-summary-gather-subject-limit)
7982                   subject))
7983                ;; Fuzzily simplify it.
7984                ((eq 'fuzzy gnus-summary-gather-subject-limit)
7985                 (gnus-simplify-subject-fuzzy whole-subject))
7986                ;; Just remove the leading "Re:".
7987                (t
7988                 (gnus-simplify-subject-re whole-subject))))
7989
7990         (if (and gnus-summary-gather-exclude-subject
7991                  (string-match gnus-summary-gather-exclude-subject
7992                                subject))
7993             ()          ; We don't want to do anything with this article.
7994           ;; We simplify the subject before looking it up in the
7995           ;; hash table.
7996
7997           (if (setq hthread (gnus-gethash subject hashtb))
7998               (progn
7999                 ;; We enter a dummy root into the thread, if we
8000                 ;; haven't done that already.
8001                 (unless (stringp (caar hthread))
8002                   (setcar hthread (list whole-subject (car hthread))))
8003                 ;; We add this new gathered thread to this gathered
8004                 ;; thread.
8005                 (setcdr (car hthread)
8006                         (nconc (cdar hthread) (list (car threads))))
8007                 ;; Remove it from the list of threads.
8008                 (setcdr prev (cdr threads))
8009                 (setq threads prev))
8010             ;; Enter this thread into the hash table.
8011             (gnus-sethash subject threads hashtb)))
8012         (setq prev threads)
8013         (setq threads (cdr threads)))
8014       result)))
8015
8016 (defun gnus-gather-threads-by-references (threads)
8017   "Gather threads by looking at References headers."
8018   (let ((idhashtb (gnus-make-hashtable 1023))
8019         (thhashtb (gnus-make-hashtable 1023))
8020         (prev threads)
8021         (result threads)
8022         ids references id gthread gid entered)
8023     (while threads
8024       (when (setq references (mail-header-references (caar threads)))
8025         (setq id (mail-header-id (caar threads)))
8026         (setq ids (gnus-split-references references))
8027         (setq entered nil)
8028         (while ids
8029           (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
8030               (progn
8031                 (gnus-sethash (car ids) id idhashtb)
8032                 (gnus-sethash id threads thhashtb))
8033             (setq gthread (gnus-gethash gid thhashtb))
8034             (unless entered
8035               ;; We enter a dummy root into the thread, if we
8036               ;; haven't done that already.
8037               (unless (stringp (caar gthread))
8038                 (setcar gthread (list (mail-header-subject (caar gthread))
8039                                       (car gthread))))
8040               ;; We add this new gathered thread to this gathered
8041               ;; thread.
8042               (setcdr (car gthread)
8043                       (nconc (cdar gthread) (list (car threads)))))
8044             ;; Add it into the thread hash table.
8045             (gnus-sethash id gthread thhashtb)
8046             (setq entered t)
8047             ;; Remove it from the list of threads.
8048             (setcdr prev (cdr threads))
8049             (setq threads prev))
8050           (setq ids (cdr ids))))
8051       (setq prev threads)
8052       (setq threads (cdr threads)))
8053     result))
8054
8055 (defun gnus-sort-gathered-threads (threads)
8056   "Sort subtreads inside each gathered thread by article number."
8057   (let ((result threads))
8058     (while threads
8059       (when (stringp (caar threads))
8060         (setcdr (car threads)
8061                 (sort (cdar threads) 'gnus-thread-sort-by-number)))
8062       (setq threads (cdr threads)))
8063     result))
8064
8065 (defun gnus-make-threads ()
8066   "Go through the dependency hashtb and find the roots.  Return all threads."
8067   (let (threads)
8068     (mapatoms
8069      (lambda (refs)
8070        (unless (car (symbol-value refs))
8071          ;; These threads do not refer back to any other articles,
8072          ;; so they're roots.
8073          (setq threads (append (cdr (symbol-value refs)) threads))))
8074      gnus-newsgroup-dependencies)
8075     threads))
8076
8077 (defun gnus-build-sparse-threads ()
8078   (let ((headers gnus-newsgroup-headers)
8079         (deps gnus-newsgroup-dependencies)
8080         header references generation relations 
8081         cthread subject child end pthread relation)
8082     ;; First we create an alist of generations/relations, where 
8083     ;; generations is how much we trust the ralation, and the relation
8084     ;; is parent/child.
8085     (gnus-message 7 "Making sparse threads...")
8086     (save-excursion
8087       (nnheader-set-temp-buffer " *gnus sparse threads*")
8088       (while (setq header (pop headers))
8089         (when (and (setq references (mail-header-references header))
8090                    (not (string= references "")))
8091           (insert references)
8092           (setq child (mail-header-id header)
8093                 subject (mail-header-subject header))
8094           (setq generation 0)
8095           (while (search-backward ">" nil t)
8096             (setq end (1+ (point)))
8097             (when (search-backward "<" nil t)
8098               (push (list (incf generation) 
8099                           child (setq child (buffer-substring (point) end))
8100                           subject)
8101                     relations)))
8102           (push (list (1+ generation) child nil subject) relations)
8103           (erase-buffer)))
8104       (kill-buffer (current-buffer)))
8105     ;; Sort over trustworthiness.
8106     (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
8107     (while (setq relation (pop relations))
8108       (when (if (boundp (setq cthread (intern (cadr relation) deps)))
8109                 (unless (car (symbol-value cthread))
8110                   ;; Make this article the parent of these threads.
8111                   (setcar (symbol-value cthread)
8112                           (vector gnus-reffed-article-number 
8113                                   (cadddr relation) 
8114                                   "" ""
8115                                   (cadr relation) 
8116                                   (or (caddr relation) "") 0 0 "")))
8117               (set cthread (list (vector gnus-reffed-article-number
8118                                          (cadddr relation) 
8119                                          "" "" (cadr relation) 
8120                                          (or (caddr relation) "") 0 0 ""))))
8121         (push gnus-reffed-article-number gnus-newsgroup-limit)
8122         (push gnus-reffed-article-number gnus-newsgroup-sparse)
8123         (push (cons gnus-reffed-article-number gnus-sparse-mark)
8124               gnus-newsgroup-reads)
8125         (decf gnus-reffed-article-number)
8126         ;; Make this new thread the child of its parent.
8127         (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
8128             (setcdr (symbol-value pthread)
8129                     (nconc (cdr (symbol-value pthread))
8130                            (list (symbol-value cthread))))
8131           (set pthread (list nil (symbol-value cthread))))))
8132     (gnus-message 7 "Making sparse threads...done")))
8133
8134 (defun gnus-build-old-threads ()
8135   ;; Look at all the articles that refer back to old articles, and
8136   ;; fetch the headers for the articles that aren't there.  This will
8137   ;; build complete threads - if the roots haven't been expired by the
8138   ;; server, that is.
8139   (let (id heads)
8140     (mapatoms
8141      (lambda (refs)
8142        (when (not (car (symbol-value refs)))
8143          (setq heads (cdr (symbol-value refs)))
8144          (while heads
8145            (if (memq (mail-header-number (caar heads))
8146                      gnus-newsgroup-dormant)
8147                (setq heads (cdr heads))
8148              (setq id (symbol-name refs))
8149              (while (and (setq id (gnus-build-get-header id))
8150                          (not (car (gnus-gethash
8151                                     id gnus-newsgroup-dependencies)))))
8152              (setq heads nil)))))
8153      gnus-newsgroup-dependencies)))
8154
8155 (defun gnus-build-get-header (id)
8156   ;; Look through the buffer of NOV lines and find the header to
8157   ;; ID.  Enter this line into the dependencies hash table, and return
8158   ;; the id of the parent article (if any).
8159   (let ((deps gnus-newsgroup-dependencies)
8160         found header)
8161     (prog1
8162         (save-excursion
8163           (set-buffer nntp-server-buffer)
8164           (goto-char (point-min))
8165           (while (and (not found) (search-forward id nil t))
8166             (beginning-of-line)
8167             (setq found (looking-at
8168                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
8169                                  (regexp-quote id))))
8170             (or found (beginning-of-line 2)))
8171           (when found
8172             (beginning-of-line)
8173             (and
8174              (setq header (gnus-nov-parse-line
8175                            (read (current-buffer)) deps))
8176              (gnus-parent-id (mail-header-references header)))))
8177       (when header
8178         (let ((number (mail-header-number header)))
8179           (push number gnus-newsgroup-limit)
8180           (push header gnus-newsgroup-headers)
8181           (if (memq number gnus-newsgroup-unselected)
8182               (progn
8183                 (push number gnus-newsgroup-unreads)
8184                 (setq gnus-newsgroup-unselected
8185                       (delq number gnus-newsgroup-unselected)))
8186             (push number gnus-newsgroup-ancient)))))))
8187
8188 (defun gnus-summary-update-article (article &optional iheader)
8189   "Update ARTICLE in the summary buffer."
8190   (set-buffer gnus-summary-buffer)
8191   (let* ((header (or iheader (gnus-summary-article-header article)))
8192          (id (mail-header-id header))
8193          (data (gnus-data-find article))
8194          (thread (gnus-id-to-thread id))
8195          (references (mail-header-references header))
8196          (parent
8197           (gnus-id-to-thread
8198            (or (gnus-parent-id 
8199                 (if (and references
8200                          (not (equal "" references)))
8201                     references))
8202                "none")))
8203          (buffer-read-only nil)
8204          (old (car thread))
8205          (number (mail-header-number header))
8206          pos)
8207     (when thread
8208       ;; !!! Should this be in or not?
8209       (unless iheader
8210         (setcar thread nil))
8211       (when parent
8212         (delq thread parent))
8213       (if (gnus-summary-insert-subject id header iheader)
8214           ;; Set the (possibly) new article number in the data structure.
8215           (gnus-data-set-number data (gnus-id-to-article id))
8216         (setcar thread old)
8217         nil))))
8218
8219 (defun gnus-rebuild-thread (id)
8220   "Rebuild the thread containing ID."
8221   (let ((buffer-read-only nil)
8222         current thread data)
8223     (if (not gnus-show-threads)
8224         (setq thread (list (car (gnus-id-to-thread id))))
8225       ;; Get the thread this article is part of.
8226       (setq thread (gnus-remove-thread id)))
8227     (setq current (save-excursion
8228                     (and (zerop (forward-line -1))
8229                          (gnus-summary-article-number))))
8230     ;; If this is a gathered thread, we have to go some re-gathering.
8231     (when (stringp (car thread))
8232       (let ((subject (car thread))
8233             roots thr)
8234         (setq thread (cdr thread))
8235         (while thread
8236           (unless (memq (setq thr (gnus-id-to-thread
8237                                       (gnus-root-id
8238                                        (mail-header-id (caar thread)))))
8239                         roots)
8240             (push thr roots))
8241           (setq thread (cdr thread)))
8242         ;; We now have all (unique) roots.
8243         (if (= (length roots) 1)
8244             ;; All the loose roots are now one solid root.
8245             (setq thread (car roots))
8246           (setq thread (cons subject (gnus-sort-threads roots))))))
8247     (let (threads)
8248       ;; We then insert this thread into the summary buffer.
8249       (let (gnus-newsgroup-data gnus-newsgroup-threads)
8250         (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
8251         (setq data (nreverse gnus-newsgroup-data))
8252         (setq threads gnus-newsgroup-threads))
8253       ;; We splice the new data into the data structure.
8254       (gnus-data-enter-list current data)
8255       (gnus-data-compute-positions)
8256       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
8257
8258 (defun gnus-number-to-header (number)
8259   "Return the header for article NUMBER."
8260   (let ((headers gnus-newsgroup-headers))
8261     (while (and headers
8262                 (not (= number (mail-header-number (car headers)))))
8263       (pop headers))
8264     (when headers
8265       (car headers))))
8266
8267 (defun gnus-id-to-thread (id)
8268   "Return the (sub-)thread where ID appears."
8269   (gnus-gethash id gnus-newsgroup-dependencies))
8270
8271 (defun gnus-id-to-article (id)
8272   "Return the article number of ID."
8273   (let ((thread (gnus-id-to-thread id)))
8274     (when (and thread
8275                (car thread))
8276       (mail-header-number (car thread)))))
8277
8278 (defun gnus-id-to-header (id)
8279   "Return the article headers of ID."
8280   (car (gnus-id-to-thread id)))
8281
8282 (defun gnus-article-displayed-root-p (article)
8283   "Say whether ARTICLE is a root(ish) article."
8284   (let ((level (gnus-summary-thread-level article))
8285         (refs (mail-header-references  (gnus-summary-article-header article)))
8286         particle)
8287     (cond 
8288      ((null level) nil)
8289      ((zerop level) t)
8290      ((null refs) t)
8291      ((null (gnus-parent-id refs)) t)
8292      ((and (= 1 level)
8293            (null (setq particle (gnus-id-to-article
8294                                  (gnus-parent-id refs))))
8295            (null (gnus-summary-thread-level particle)))))))
8296
8297 (defun gnus-root-id (id)
8298   "Return the id of the root of the thread where ID appears."
8299   (let (last-id prev)
8300     (while (and id (setq prev (car (gnus-gethash 
8301                                     id gnus-newsgroup-dependencies))))
8302       (setq last-id id
8303             id (gnus-parent-id (mail-header-references prev))))
8304     last-id))
8305
8306 (defun gnus-remove-thread (id &optional dont-remove)
8307   "Remove the thread that has ID in it."
8308   (let ((dep gnus-newsgroup-dependencies)
8309         headers thread last-id)
8310     ;; First go up in this thread until we find the root.
8311     (setq last-id (gnus-root-id id))
8312     (setq headers (list (car (gnus-id-to-thread last-id))
8313                         (caadr (gnus-id-to-thread last-id))))
8314     ;; We have now found the real root of this thread.  It might have
8315     ;; been gathered into some loose thread, so we have to search
8316     ;; through the threads to find the thread we wanted.
8317     (let ((threads gnus-newsgroup-threads)
8318           sub)
8319       (while threads
8320         (setq sub (car threads))
8321         (if (stringp (car sub))
8322             ;; This is a gathered thread, so we look at the roots
8323             ;; below it to find whether this article is in this
8324             ;; gathered root.
8325             (progn
8326               (setq sub (cdr sub))
8327               (while sub
8328                 (when (member (caar sub) headers)
8329                   (setq thread (car threads)
8330                         threads nil
8331                         sub nil))
8332                 (setq sub (cdr sub))))
8333           ;; It's an ordinary thread, so we check it.
8334           (when (eq (car sub) (car headers))
8335             (setq thread sub
8336                   threads nil)))
8337         (setq threads (cdr threads)))
8338       ;; If this article is in no thread, then it's a root.
8339       (if thread
8340           (unless dont-remove
8341             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
8342         (setq thread (gnus-gethash last-id dep)))
8343       (when thread
8344         (prog1
8345             thread ; We return this thread.
8346           (unless dont-remove
8347             (if (stringp (car thread))
8348                 (progn
8349                   ;; If we use dummy roots, then we have to remove the
8350                   ;; dummy root as well.
8351                   (when (eq gnus-summary-make-false-root 'dummy)
8352                     ;; Uhm.
8353                     )
8354                   (setq thread (cdr thread))
8355                   (while thread
8356                     (gnus-remove-thread-1 (car thread))
8357                     (setq thread (cdr thread))))
8358               (gnus-remove-thread-1 thread))))))))
8359
8360 (defun gnus-remove-thread-1 (thread)
8361   "Remove the thread THREAD recursively."
8362   (let ((number (mail-header-number (car thread)))
8363         pos)
8364     (when (setq pos (text-property-any
8365                      (point-min) (point-max) 'gnus-number number))
8366       (goto-char pos)
8367       (gnus-delete-line)
8368       (gnus-data-remove number))
8369     (setq thread (cdr thread))
8370     (while thread
8371       (gnus-remove-thread-1 (pop thread)))))
8372
8373 (defun gnus-sort-threads (threads)
8374   "Sort THREADS."
8375   (if (not gnus-thread-sort-functions)
8376       threads
8377     (let ((func (if (= 1 (length gnus-thread-sort-functions))
8378                     (car gnus-thread-sort-functions)
8379                   `(lambda (t1 t2)
8380                      ,(gnus-make-sort-function 
8381                        (reverse gnus-thread-sort-functions))))))
8382       (gnus-message 7 "Sorting threads...")
8383       (prog1
8384           (sort threads func)
8385         (gnus-message 7 "Sorting threads...done")))))
8386
8387 (defun gnus-sort-articles (articles)
8388   "Sort ARTICLES."
8389   (when gnus-article-sort-functions
8390     (let ((func (if (= 1 (length gnus-article-sort-functions))
8391                     (car gnus-article-sort-functions)
8392                   `(lambda (t1 t2)
8393                      ,(gnus-make-sort-function 
8394                        (reverse gnus-article-sort-functions))))))
8395       (gnus-message 7 "Sorting articles...")
8396       (prog1
8397           (setq gnus-newsgroup-headers (sort articles func))
8398         (gnus-message 7 "Sorting articles...done")))))
8399
8400 (defun gnus-make-sort-function (funs)
8401   "Return a composite sort condition based on the functions in FUNC."
8402   (if (cdr funs)
8403       `(or (,(car funs) t1 t2)
8404            (and (not (,(car funs) t2 t1))
8405                 ,(gnus-make-sort-function (cdr funs))))
8406     `(,(car funs) t1 t2)))
8407                  
8408 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
8409 (defmacro gnus-thread-header (thread)
8410   ;; Return header of first article in THREAD.
8411   ;; Note that THREAD must never, ever be anything else than a variable -
8412   ;; using some other form will lead to serious barfage.
8413   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
8414   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
8415   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
8416         (vector thread) 2))
8417
8418 (defsubst gnus-article-sort-by-number (h1 h2)
8419   "Sort articles by article number."
8420   (< (mail-header-number h1)
8421      (mail-header-number h2)))
8422
8423 (defun gnus-thread-sort-by-number (h1 h2)
8424   "Sort threads by root article number."
8425   (gnus-article-sort-by-number
8426    (gnus-thread-header h1) (gnus-thread-header h2)))
8427
8428 (defsubst gnus-article-sort-by-author (h1 h2)
8429   "Sort articles by root author."
8430   (string-lessp
8431    (let ((extract (funcall
8432                    gnus-extract-address-components
8433                    (mail-header-from h1))))
8434      (or (car extract) (cdr extract)))
8435    (let ((extract (funcall
8436                    gnus-extract-address-components
8437                    (mail-header-from h2))))
8438      (or (car extract) (cdr extract)))))
8439
8440 (defun gnus-thread-sort-by-author (h1 h2)
8441   "Sort threads by root author."
8442   (gnus-article-sort-by-author
8443    (gnus-thread-header h1)  (gnus-thread-header h2)))
8444
8445 (defsubst gnus-article-sort-by-subject (h1 h2)
8446   "Sort articles by root subject."
8447   (string-lessp
8448    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
8449    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
8450
8451 (defun gnus-thread-sort-by-subject (h1 h2)
8452   "Sort threads by root subject."
8453   (gnus-article-sort-by-subject
8454    (gnus-thread-header h1) (gnus-thread-header h2)))
8455
8456 (defsubst gnus-article-sort-by-date (h1 h2)
8457   "Sort articles by root article date."
8458   (string-lessp
8459    (inline (gnus-sortable-date (mail-header-date h1)))
8460    (inline (gnus-sortable-date (mail-header-date h2)))))
8461
8462 (defun gnus-thread-sort-by-date (h1 h2)
8463   "Sort threads by root article date."
8464   (gnus-article-sort-by-date
8465    (gnus-thread-header h1) (gnus-thread-header h2)))
8466
8467 (defsubst gnus-article-sort-by-score (h1 h2)
8468   "Sort articles by root article score.
8469 Unscored articles will be counted as having a score of zero."
8470   (> (or (cdr (assq (mail-header-number h1)
8471                     gnus-newsgroup-scored))
8472          gnus-summary-default-score 0)
8473      (or (cdr (assq (mail-header-number h2)
8474                     gnus-newsgroup-scored))
8475          gnus-summary-default-score 0)))
8476
8477 (defun gnus-thread-sort-by-score (h1 h2)
8478   "Sort threads by root article score."
8479   (gnus-article-sort-by-score
8480    (gnus-thread-header h1) (gnus-thread-header h2)))
8481
8482 (defun gnus-thread-sort-by-total-score (h1 h2)
8483   "Sort threads by the sum of all scores in the thread.
8484 Unscored articles will be counted as having a score of zero."
8485   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
8486
8487 (defun gnus-thread-total-score (thread)
8488   ;;  This function find the total score of THREAD.
8489   (cond ((null thread)
8490          0)
8491         ((consp thread)
8492          (if (stringp (car thread))
8493              (apply gnus-thread-score-function 0
8494                     (mapcar 'gnus-thread-total-score-1 (cdr thread)))
8495            (gnus-thread-total-score-1 thread)))
8496         (t
8497          (gnus-thread-total-score-1 (list thread)))))
8498
8499 (defun gnus-thread-total-score-1 (root)
8500   ;; This function find the total score of the thread below ROOT.
8501   (setq root (car root))
8502   (apply gnus-thread-score-function
8503          (or (append
8504               (mapcar 'gnus-thread-total-score
8505                       (cdr (gnus-gethash (mail-header-id root)
8506                                          gnus-newsgroup-dependencies)))
8507                  (if (> (mail-header-number root) 0)
8508                      (list (or (cdr (assq (mail-header-number root) 
8509                                           gnus-newsgroup-scored))
8510                                gnus-summary-default-score 0))))
8511              (list gnus-summary-default-score)
8512              '(0))))
8513
8514 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
8515 (defvar gnus-tmp-prev-subject nil)
8516 (defvar gnus-tmp-false-parent nil)
8517 (defvar gnus-tmp-root-expunged nil)
8518 (defvar gnus-tmp-dummy-line nil)
8519
8520 (defun gnus-summary-prepare-threads (threads)
8521   "Prepare summary buffer from THREADS and indentation LEVEL.
8522 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
8523 or a straight list of headers."
8524   (gnus-message 7 "Generating summary...")
8525
8526   (setq gnus-newsgroup-threads threads)
8527   (beginning-of-line)
8528
8529   (let ((gnus-tmp-level 0)
8530         (default-score (or gnus-summary-default-score 0))
8531         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
8532         thread number subject stack state gnus-tmp-gathered beg-match
8533         new-roots gnus-tmp-new-adopts thread-end
8534         gnus-tmp-header gnus-tmp-unread
8535         gnus-tmp-replied gnus-tmp-subject-or-nil
8536         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
8537         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
8538         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
8539
8540     (setq gnus-tmp-prev-subject nil)
8541
8542     (if (vectorp (car threads))
8543         ;; If this is a straight (sic) list of headers, then a
8544         ;; threaded summary display isn't required, so we just create
8545         ;; an unthreaded one.
8546         (gnus-summary-prepare-unthreaded threads)
8547
8548       ;; Do the threaded display.
8549
8550       (while (or threads stack gnus-tmp-new-adopts new-roots)
8551
8552         (if (and (= gnus-tmp-level 0)
8553                  (not (setq gnus-tmp-dummy-line nil))
8554                  (or (not stack)
8555                      (= (caar stack) 0))
8556                  (not gnus-tmp-false-parent)
8557                  (or gnus-tmp-new-adopts new-roots))
8558             (if gnus-tmp-new-adopts
8559                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
8560                       thread (list (car gnus-tmp-new-adopts))
8561                       gnus-tmp-header (caar thread)
8562                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
8563               (if new-roots
8564                   (setq thread (list (car new-roots))
8565                         gnus-tmp-header (caar thread)
8566                         new-roots (cdr new-roots))))
8567
8568           (if threads
8569               ;; If there are some threads, we do them before the
8570               ;; threads on the stack.
8571               (setq thread threads
8572                     gnus-tmp-header (caar thread))
8573             ;; There were no current threads, so we pop something off
8574             ;; the stack.
8575             (setq state (car stack)
8576                   gnus-tmp-level (car state)
8577                   thread (cdr state)
8578                   stack (cdr stack)
8579                   gnus-tmp-header (caar thread))))
8580
8581         (setq gnus-tmp-false-parent nil)
8582         (setq gnus-tmp-root-expunged nil)
8583         (setq thread-end nil)
8584
8585         (if (stringp gnus-tmp-header)
8586             ;; The header is a dummy root.
8587             (cond
8588              ((eq gnus-summary-make-false-root 'adopt)
8589               ;; We let the first article adopt the rest.
8590               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
8591                                                (cddar thread)))
8592               (setq gnus-tmp-gathered
8593                     (nconc (mapcar
8594                             (lambda (h) (mail-header-number (car h)))
8595                             (cddar thread))
8596                            gnus-tmp-gathered))
8597               (setq thread (cons (list (caar thread)
8598                                        (cadar thread))
8599                                  (cdr thread)))
8600               (setq gnus-tmp-level -1
8601                     gnus-tmp-false-parent t))
8602              ((eq gnus-summary-make-false-root 'empty)
8603               ;; We print adopted articles with empty subject fields.
8604               (setq gnus-tmp-gathered
8605                     (nconc (mapcar
8606                             (lambda (h) (mail-header-number (car h)))
8607                             (cddar thread))
8608                            gnus-tmp-gathered))
8609               (setq gnus-tmp-level -1))
8610              ((eq gnus-summary-make-false-root 'dummy)
8611               ;; We remember that we probably want to output a dummy
8612               ;; root.
8613               (setq gnus-tmp-dummy-line gnus-tmp-header)
8614               (setq gnus-tmp-prev-subject gnus-tmp-header))
8615              (t
8616               ;; We do not make a root for the gathered
8617               ;; sub-threads at all.
8618               (setq gnus-tmp-level -1)))
8619
8620           (setq number (mail-header-number gnus-tmp-header)
8621                 subject (mail-header-subject gnus-tmp-header))
8622
8623           (cond
8624            ;; If the thread has changed subject, we might want to make
8625            ;; this subthread into a root.
8626            ((and (null gnus-thread-ignore-subject)
8627                  (not (zerop gnus-tmp-level))
8628                  gnus-tmp-prev-subject
8629                  (not (inline
8630                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
8631             (setq new-roots (nconc new-roots (list (car thread)))
8632                   thread-end t
8633                   gnus-tmp-header nil))
8634            ;; If the article lies outside the current limit,
8635            ;; then we do not display it.
8636            ((and (not (memq number gnus-newsgroup-limit))
8637                  (not gnus-tmp-dummy-line))
8638             (setq gnus-tmp-gathered
8639                   (nconc (mapcar
8640                           (lambda (h) (mail-header-number (car h)))
8641                           (cdar thread))
8642                          gnus-tmp-gathered))
8643             (setq gnus-tmp-new-adopts (if (cdar thread)
8644                                           (append gnus-tmp-new-adopts
8645                                                   (cdar thread))
8646                                         gnus-tmp-new-adopts)
8647                   thread-end t
8648                   gnus-tmp-header nil)
8649             (when (zerop gnus-tmp-level)
8650               (setq gnus-tmp-root-expunged t)))
8651            ;; Perhaps this article is to be marked as read?
8652            ((and gnus-summary-mark-below
8653                  (< (or (cdr (assq number gnus-newsgroup-scored))
8654                         default-score)
8655                     gnus-summary-mark-below)
8656                  ;; Don't touch sparse articles.
8657                  (not (memq number gnus-newsgroup-sparse))
8658                  (not (memq number gnus-newsgroup-ancient)))
8659             (setq gnus-newsgroup-unreads
8660                   (delq number gnus-newsgroup-unreads))
8661             (if gnus-newsgroup-auto-expire
8662                 (push number gnus-newsgroup-expirable)
8663               (push (cons number gnus-low-score-mark)
8664                     gnus-newsgroup-reads))))
8665
8666           (when gnus-tmp-header
8667             ;; We may have an old dummy line to output before this
8668             ;; article.
8669             (when gnus-tmp-dummy-line
8670               (gnus-summary-insert-dummy-line
8671                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
8672               (setq gnus-tmp-dummy-line nil))
8673
8674             ;; Compute the mark.
8675             (setq
8676              gnus-tmp-unread
8677              (cond
8678               ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8679               ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8680               ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8681               ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8682               (t (or (cdr (assq number gnus-newsgroup-reads))
8683                      gnus-ancient-mark))))
8684
8685             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
8686                                   gnus-tmp-header gnus-tmp-level)
8687                   gnus-newsgroup-data)
8688
8689             ;; Actually insert the line.
8690             (setq
8691              gnus-tmp-subject-or-nil
8692              (cond
8693               ((and gnus-thread-ignore-subject
8694                     gnus-tmp-prev-subject
8695                     (not (inline (gnus-subject-equal
8696                                   gnus-tmp-prev-subject subject))))
8697                subject)
8698               ((zerop gnus-tmp-level)
8699                (if (and (eq gnus-summary-make-false-root 'empty)
8700                         (memq number gnus-tmp-gathered)
8701                         gnus-tmp-prev-subject
8702                         (inline (gnus-subject-equal
8703                                  gnus-tmp-prev-subject subject)))
8704                    gnus-summary-same-subject
8705                  subject))
8706               (t gnus-summary-same-subject)))
8707             (if (and (eq gnus-summary-make-false-root 'adopt)
8708                      (= gnus-tmp-level 1)
8709                      (memq number gnus-tmp-gathered))
8710                 (setq gnus-tmp-opening-bracket ?\<
8711                       gnus-tmp-closing-bracket ?\>)
8712               (setq gnus-tmp-opening-bracket ?\[
8713                     gnus-tmp-closing-bracket ?\]))
8714             (setq
8715              gnus-tmp-indentation
8716              (aref gnus-thread-indent-array gnus-tmp-level)
8717              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
8718              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
8719                                 gnus-summary-default-score 0)
8720              gnus-tmp-score-char
8721              (if (or (null gnus-summary-default-score)
8722                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
8723                          gnus-summary-zcore-fuzz)) ? 
8724                (if (< gnus-tmp-score gnus-summary-default-score)
8725                    gnus-score-below-mark gnus-score-over-mark))
8726              gnus-tmp-replied
8727              (cond ((memq number gnus-newsgroup-processable)
8728                     gnus-process-mark)
8729                    ((memq number gnus-newsgroup-cached)
8730                     gnus-cached-mark)
8731                    ((memq number gnus-newsgroup-replied)
8732                     gnus-replied-mark)
8733                    ((memq number gnus-newsgroup-saved)
8734                     gnus-saved-mark)
8735                    (t gnus-unread-mark))
8736              gnus-tmp-from (mail-header-from gnus-tmp-header)
8737              gnus-tmp-name
8738              (cond
8739               ((string-match "(.+)" gnus-tmp-from)
8740                (substring gnus-tmp-from
8741                           (1+ (match-beginning 0)) (1- (match-end 0))))
8742               ((string-match "<[^>]+> *$" gnus-tmp-from)
8743                (setq beg-match (match-beginning 0))
8744                (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
8745                         (substring gnus-tmp-from (1+ (match-beginning 0))
8746                                    (1- (match-end 0))))
8747                    (substring gnus-tmp-from 0 beg-match)))
8748               (t gnus-tmp-from)))
8749             (when (string= gnus-tmp-name "")
8750               (setq gnus-tmp-name gnus-tmp-from))
8751             (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
8752             (gnus-put-text-property
8753              (point)
8754              (progn (eval gnus-summary-line-format-spec) (point))
8755              'gnus-number number)
8756             (when gnus-visual-p
8757               (forward-line -1)
8758               (run-hooks 'gnus-summary-update-hook)
8759               (forward-line 1))
8760
8761             (setq gnus-tmp-prev-subject subject)))
8762
8763         (when (nth 1 thread)
8764           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
8765         (incf gnus-tmp-level)
8766         (setq threads (if thread-end nil (cdar thread)))
8767         (unless threads
8768           (setq gnus-tmp-level 0)))))
8769   (gnus-message 7 "Generating summary...done"))
8770
8771 (defun gnus-summary-prepare-unthreaded (headers)
8772   "Generate an unthreaded summary buffer based on HEADERS."
8773   (let (header number mark)
8774
8775     (while headers
8776       ;; We may have to root out some bad articles...
8777       (when (memq (setq number (mail-header-number
8778                                 (setq header (pop headers))))
8779                   gnus-newsgroup-limit)
8780         ;; Mark article as read when it has a low score.
8781         (when (and gnus-summary-mark-below
8782                    (< (or (cdr (assq number gnus-newsgroup-scored))
8783                           gnus-summary-default-score 0)
8784                       gnus-summary-mark-below)
8785                    (not (memq number gnus-newsgroup-ancient)))
8786           (setq gnus-newsgroup-unreads
8787                 (delq number gnus-newsgroup-unreads))
8788           (if gnus-newsgroup-auto-expire
8789               (push number gnus-newsgroup-expirable)
8790             (push (cons number gnus-low-score-mark)
8791                   gnus-newsgroup-reads)))
8792
8793         (setq mark
8794               (cond
8795                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8796                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8797                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8798                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8799                (t (or (cdr (assq number gnus-newsgroup-reads))
8800                       gnus-ancient-mark))))
8801         (setq gnus-newsgroup-data
8802               (cons (gnus-data-make number mark (1+ (point)) header 0)
8803                     gnus-newsgroup-data))
8804         (gnus-summary-insert-line
8805          header 0 nil mark (memq number gnus-newsgroup-replied)
8806          (memq number gnus-newsgroup-expirable)
8807          (mail-header-subject header) nil
8808          (cdr (assq number gnus-newsgroup-scored))
8809          (memq number gnus-newsgroup-processable))))))
8810
8811 (defun gnus-select-newsgroup (group &optional read-all)
8812   "Select newsgroup GROUP.
8813 If READ-ALL is non-nil, all articles in the group are selected."
8814   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
8815          (info (nth 2 entry))
8816          articles fetched-articles cached)
8817
8818     (or (gnus-check-server
8819          (setq gnus-current-select-method (gnus-find-method-for-group group)))
8820         (error "Couldn't open server"))
8821
8822     (or (and entry (not (eq (car entry) t))) ; Either it's active...
8823         (gnus-activate-group group)     ; Or we can activate it...
8824         (progn                          ; Or we bug out.
8825           (when (equal major-mode 'gnus-summary-mode)
8826             (kill-buffer (current-buffer)))
8827           (error "Couldn't request group %s: %s"
8828                  group (gnus-status-message group))))
8829
8830     (unless (gnus-request-group group t)
8831       (when (equal major-mode 'gnus-summary-mode)
8832         (kill-buffer (current-buffer)))
8833       (error "Couldn't request group %s: %s"
8834              group (gnus-status-message group)))      
8835
8836     (setq gnus-newsgroup-name group)
8837     (setq gnus-newsgroup-unselected nil)
8838     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
8839
8840     (and gnus-asynchronous
8841          (gnus-check-backend-function
8842           'request-asynchronous gnus-newsgroup-name)
8843          (setq gnus-newsgroup-async
8844                (gnus-request-asynchronous gnus-newsgroup-name)))
8845
8846     ;; Adjust and set lists of article marks.
8847     (when info
8848       (gnus-adjust-marked-articles info))
8849
8850     ;; Kludge to avoid having cached articles nixed out in virtual groups.
8851     (when (gnus-virtual-group-p group)
8852       (setq cached gnus-newsgroup-cached))
8853
8854     (setq gnus-newsgroup-unreads
8855           (gnus-set-difference
8856            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
8857            gnus-newsgroup-dormant))
8858
8859     (setq gnus-newsgroup-processable nil)
8860
8861     (setq articles (gnus-articles-to-read group read-all))
8862
8863     (cond
8864      ((null articles)
8865       ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
8866       'quit)
8867      ((eq articles 0) nil)
8868      (t
8869       ;; Init the dependencies hash table.
8870       (setq gnus-newsgroup-dependencies
8871             (gnus-make-hashtable (length articles)))
8872       ;; Retrieve the headers and read them in.
8873       (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
8874       (setq gnus-newsgroup-headers
8875             (if (eq 'nov
8876                     (setq gnus-headers-retrieved-by
8877                           (gnus-retrieve-headers
8878                            articles gnus-newsgroup-name
8879                            ;; We might want to fetch old headers, but
8880                            ;; not if there is only 1 article.
8881                            (and gnus-fetch-old-headers
8882                                 (or (and
8883                                      (not (eq gnus-fetch-old-headers 'some))
8884                                      (not (numberp gnus-fetch-old-headers)))
8885                                     (> (length articles) 1))))))
8886                 (gnus-get-newsgroup-headers-xover articles)
8887               (gnus-get-newsgroup-headers)))
8888       (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
8889
8890       ;; Kludge to avoid having cached articles nixed out in virtual groups.
8891       (when cached
8892         (setq gnus-newsgroup-cached cached))
8893
8894       ;; Set the initial limit.
8895       (setq gnus-newsgroup-limit (copy-sequence articles))
8896       ;; Remove canceled articles from the list of unread articles.
8897       (setq gnus-newsgroup-unreads
8898             (gnus-set-sorted-intersection
8899              gnus-newsgroup-unreads
8900              (setq fetched-articles
8901                    (mapcar (lambda (headers) (mail-header-number headers))
8902                            gnus-newsgroup-headers))))
8903       ;; Removed marked articles that do not exist.
8904       (gnus-update-missing-marks
8905        (gnus-sorted-complement fetched-articles articles))
8906       ;; We might want to build some more threads first.
8907       (and gnus-fetch-old-headers
8908            (eq gnus-headers-retrieved-by 'nov)
8909            (gnus-build-old-threads))
8910       ;; Check whether auto-expire is to be done in this group.
8911       (setq gnus-newsgroup-auto-expire
8912             (gnus-group-auto-expirable-p group))
8913       ;; Set up the article buffer now, if necessary.
8914       (unless gnus-single-article-buffer
8915         (gnus-article-setup-buffer))
8916       ;; First and last article in this newsgroup.
8917       (when gnus-newsgroup-headers
8918         (setq gnus-newsgroup-begin
8919               (mail-header-number (car gnus-newsgroup-headers))
8920               gnus-newsgroup-end
8921               (mail-header-number
8922                (gnus-last-element gnus-newsgroup-headers))))
8923       ;; GROUP is successfully selected.
8924       (or gnus-newsgroup-headers t)))))
8925
8926 (defun gnus-articles-to-read (group read-all)
8927   ;; Find out what articles the user wants to read.
8928   (let* ((articles
8929           ;; Select all articles if `read-all' is non-nil, or if there
8930           ;; are no unread articles.
8931           (if (or read-all
8932                   (and (zerop (length gnus-newsgroup-marked))
8933                        (zerop (length gnus-newsgroup-unreads))))
8934               (gnus-uncompress-range (gnus-active group))
8935             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
8936                           (copy-sequence gnus-newsgroup-unreads))
8937                   '<)))
8938          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
8939          (scored (length scored-list))
8940          (number (length articles))
8941          (marked (+ (length gnus-newsgroup-marked)
8942                     (length gnus-newsgroup-dormant)))
8943          (select
8944           (cond
8945            ((numberp read-all)
8946             read-all)
8947            (t
8948             (condition-case ()
8949                 (cond
8950                  ((and (or (<= scored marked) (= scored number))
8951                        (numberp gnus-large-newsgroup)
8952                        (> number gnus-large-newsgroup))
8953                   (let ((input
8954                          (read-string
8955                           (format
8956                            "How many articles from %s (default %d): "
8957                            gnus-newsgroup-name number))))
8958                     (if (string-match "^[ \t]*$" input) number input)))
8959                  ((and (> scored marked) (< scored number)
8960                        (> (- scored number) 20))
8961                   (let ((input
8962                          (read-string
8963                           (format "%s %s (%d scored, %d total): "
8964                                   "How many articles from"
8965                                   group scored number))))
8966                     (if (string-match "^[ \t]*$" input)
8967                         number input)))
8968                  (t number))
8969               (quit nil))))))
8970     (setq select (if (stringp select) (string-to-number select) select))
8971     (if (or (null select) (zerop select))
8972         select
8973       (if (and (not (zerop scored)) (<= (abs select) scored))
8974           (progn
8975             (setq articles (sort scored-list '<))
8976             (setq number (length articles)))
8977         (setq articles (copy-sequence articles)))
8978
8979       (if (< (abs select) number)
8980           (if (< select 0)
8981               ;; Select the N oldest articles.
8982               (setcdr (nthcdr (1- (abs select)) articles) nil)
8983             ;; Select the N most recent articles.
8984             (setq articles (nthcdr (- number select) articles))))
8985       (setq gnus-newsgroup-unselected
8986             (gnus-sorted-intersection
8987              gnus-newsgroup-unreads
8988              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
8989       articles)))
8990
8991 (defun gnus-killed-articles (killed articles)
8992   (let (out)
8993     (while articles
8994       (if (inline (gnus-member-of-range (car articles) killed))
8995           (setq out (cons (car articles) out)))
8996       (setq articles (cdr articles)))
8997     out))
8998
8999 (defun gnus-uncompress-marks (marks)
9000   "Uncompress the mark ranges in MARKS."
9001   (let ((uncompressed '(score bookmark))
9002         out)
9003     (while marks
9004       (if (memq (caar marks) uncompressed)
9005           (push (car marks) out)
9006         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
9007       (setq marks (cdr marks)))
9008     out))
9009
9010 (defun gnus-adjust-marked-articles (info)
9011   "Set all article lists and remove all marks that are no longer legal."
9012   (let* ((marked-lists (gnus-info-marks info))
9013          (active (gnus-active (gnus-info-group info)))
9014          (min (car active))
9015          (max (cdr active))
9016          (types gnus-article-mark-lists)
9017          (uncompressed '(score bookmark killed))
9018          marks var articles article mark)
9019
9020     (while marked-lists
9021       (setq marks (pop marked-lists))
9022       (set (setq var (intern (format "gnus-newsgroup-%s"
9023                                      (car (rassq (setq mark (car marks))
9024                                                  types)))))
9025            (if (memq (car marks) uncompressed) (cdr marks)
9026              (gnus-uncompress-range (cdr marks))))
9027
9028       (setq articles (symbol-value var))
9029
9030       ;; All articles have to be subsets of the active articles.
9031       (cond
9032        ;; Adjust "simple" lists.
9033        ((memq mark '(tick dormant expirable reply save))
9034         (while articles
9035           (when (or (< (setq article (pop articles)) min) (> article max))
9036             (set var (delq article (symbol-value var))))))
9037        ;; Adjust assocs.
9038        ((memq mark uncompressed)
9039         (while articles
9040           (when (or (not (consp (setq article (pop articles))))
9041                     (< (car article) min)
9042                     (> (car article) max))
9043             (set var (delq article (symbol-value var))))))))))
9044
9045 (defun gnus-update-missing-marks (missing)
9046   "Go through the list of MISSING articles and remove them mark lists."
9047   (when missing
9048     (let ((types gnus-article-mark-lists)
9049           var m)
9050       ;; Go through all types.
9051       (while types
9052         (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
9053         (when (symbol-value var)
9054           ;; This list has articles.  So we delete all missing articles
9055           ;; from it.
9056           (setq m missing)
9057           (while m
9058             (set var (delq (pop m) (symbol-value var)))))))))
9059
9060 (defun gnus-update-marks ()
9061   "Enter the various lists of marked articles into the newsgroup info list."
9062   (let ((types gnus-article-mark-lists)
9063         (info (gnus-get-info gnus-newsgroup-name))
9064         (uncompressed '(score bookmark killed))
9065         type list newmarked symbol)
9066     (when info
9067       ;; Add all marks lists that are non-nil to the list of marks lists.
9068       (while types
9069         (setq type (pop types))
9070         (when (setq list (symbol-value
9071                           (setq symbol
9072                                 (intern (format "gnus-newsgroup-%s"
9073                                                 (car type))))))
9074           (push (cons (cdr type)
9075                       (if (memq (cdr type) uncompressed) list
9076                         (gnus-compress-sequence 
9077                          (set symbol (sort list '<)) t)))
9078                 newmarked)))
9079
9080       ;; Enter these new marks into the info of the group.
9081       (if (nthcdr 3 info)
9082           (setcar (nthcdr 3 info) newmarked)
9083         ;; Add the marks lists to the end of the info.
9084         (when newmarked
9085           (setcdr (nthcdr 2 info) (list newmarked))))
9086
9087       ;; Cut off the end of the info if there's nothing else there.
9088       (let ((i 5))
9089         (while (and (> i 2)
9090                     (not (nth i info)))
9091           (when (nthcdr (decf i) info)
9092             (setcdr (nthcdr i info) nil)))))))
9093
9094 (defun gnus-add-marked-articles (group type articles &optional info force)
9095   ;; Add ARTICLES of TYPE to the info of GROUP.
9096   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
9097   ;; add, but replace marked articles of TYPE with ARTICLES.
9098   (let ((info (or info (gnus-get-info group)))
9099         (uncompressed '(score bookmark killed))
9100         marked m)
9101     (or (not info)
9102         (and (not (setq marked (nthcdr 3 info)))
9103              (or (null articles)
9104                  (setcdr (nthcdr 2 info)
9105                          (list (list (cons type (gnus-compress-sequence
9106                                                  articles t)))))))
9107         (and (not (setq m (assq type (car marked))))
9108              (or (null articles)
9109                  (setcar marked
9110                          (cons (cons type (gnus-compress-sequence articles t) )
9111                                (car marked)))))
9112         (if force
9113             (if (null articles)
9114                 (setcar (nthcdr 3 info)
9115                         (delq (assq type (car marked)) (car marked)))
9116               (setcdr m (gnus-compress-sequence articles t)))
9117           (setcdr m (gnus-compress-sequence
9118                      (sort (nconc (gnus-uncompress-range (cdr m))
9119                                   (copy-sequence articles)) '<) t))))))
9120
9121 (defun gnus-set-mode-line (where)
9122   "This function sets the mode line of the article or summary buffers.
9123 If WHERE is `summary', the summary mode line format will be used."
9124   ;; Is this mode line one we keep updated?
9125   (when (memq where gnus-updated-mode-lines)
9126     (let (mode-string)
9127       (save-excursion
9128         ;; We evaluate this in the summary buffer since these
9129         ;; variables are buffer-local to that buffer.
9130         (set-buffer gnus-summary-buffer)
9131         ;; We bind all these variables that are used in the `eval' form
9132         ;; below.
9133         (let* ((mformat (symbol-value
9134                          (intern
9135                           (format "gnus-%s-mode-line-format-spec" where))))
9136                (gnus-tmp-group-name gnus-newsgroup-name)
9137                (gnus-tmp-article-number (or gnus-current-article 0))
9138                (gnus-tmp-unread gnus-newsgroup-unreads)
9139                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
9140                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
9141                (gnus-tmp-unread-and-unselected
9142                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
9143                             (zerop gnus-tmp-unselected)) "")
9144                       ((zerop gnus-tmp-unselected)
9145                        (format "{%d more}" gnus-tmp-unread-and-unticked))
9146                       (t (format "{%d(+%d) more}"
9147                                  gnus-tmp-unread-and-unticked
9148                                  gnus-tmp-unselected))))
9149                (gnus-tmp-subject
9150                 (if (and gnus-current-headers
9151                          (vectorp gnus-current-headers))
9152                     (gnus-mode-string-quote
9153                      (mail-header-subject gnus-current-headers)) ""))
9154                max-len
9155                gnus-tmp-header);; passed as argument to any user-format-funcs
9156           (setq mode-string (eval mformat))
9157           (setq max-len (max 4 (if gnus-mode-non-string-length
9158                                    (- (window-width)
9159                                       gnus-mode-non-string-length)
9160                                  (length mode-string))))
9161           ;; We might have to chop a bit of the string off...
9162           (when (> (length mode-string) max-len)
9163             (setq mode-string
9164                   (concat (gnus-truncate-string mode-string (- max-len 3))
9165                           "...")))
9166           ;; Pad the mode string a bit.
9167           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
9168       ;; Update the mode line.
9169       (setq mode-line-buffer-identification 
9170             (gnus-mode-line-buffer-identification
9171              (list mode-string)))
9172       (set-buffer-modified-p t))))
9173
9174 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
9175   "Go through the HEADERS list and add all Xrefs to a hash table.
9176 The resulting hash table is returned, or nil if no Xrefs were found."
9177   (let* ((virtual (gnus-virtual-group-p from-newsgroup))
9178          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
9179          (xref-hashtb (make-vector 63 0))
9180          start group entry number xrefs header)
9181     (while headers
9182       (setq header (pop headers))
9183       (when (and (setq xrefs (mail-header-xref header))
9184                  (not (memq (setq number (mail-header-number header))
9185                             unreads)))
9186         (setq start 0)
9187         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
9188           (setq start (match-end 0))
9189           (setq group (if prefix
9190                           (concat prefix (substring xrefs (match-beginning 1)
9191                                                     (match-end 1)))
9192                         (substring xrefs (match-beginning 1) (match-end 1))))
9193           (setq number
9194                 (string-to-int (substring xrefs (match-beginning 2)
9195                                           (match-end 2))))
9196           (if (setq entry (gnus-gethash group xref-hashtb))
9197               (setcdr entry (cons number (cdr entry)))
9198             (gnus-sethash group (cons number nil) xref-hashtb)))))
9199     (and start xref-hashtb)))
9200
9201 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
9202   "Look through all the headers and mark the Xrefs as read."
9203   (let ((virtual (gnus-virtual-group-p from-newsgroup))
9204         name entry info xref-hashtb idlist method nth4)
9205     (save-excursion
9206       (set-buffer gnus-group-buffer)
9207       (when (setq xref-hashtb
9208                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
9209         (mapatoms
9210          (lambda (group)
9211            (unless (string= from-newsgroup (setq name (symbol-name group)))
9212              (setq idlist (symbol-value group))
9213              ;; Dead groups are not updated.
9214              (and (prog1
9215                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
9216                             info (nth 2 entry))
9217                     (if (stringp (setq nth4 (gnus-info-method info)))
9218                         (setq nth4 (gnus-server-to-method nth4))))
9219                   ;; Only do the xrefs if the group has the same
9220                   ;; select method as the group we have just read.
9221                   (or (gnus-methods-equal-p
9222                        nth4 (gnus-find-method-for-group from-newsgroup))
9223                       virtual
9224                       (equal nth4 (setq method (gnus-find-method-for-group
9225                                                 from-newsgroup)))
9226                       (and (equal (car nth4) (car method))
9227                            (equal (nth 1 nth4) (nth 1 method))))
9228                   gnus-use-cross-reference
9229                   (or (not (eq gnus-use-cross-reference t))
9230                       virtual
9231                       ;; Only do cross-references on subscribed
9232                       ;; groups, if that is what is wanted.
9233                       (<= (gnus-info-level info) gnus-level-subscribed))
9234                   (gnus-group-make-articles-read name idlist))))
9235          xref-hashtb)))))
9236
9237 (defun gnus-group-make-articles-read (group articles)
9238   (let* ((num 0)
9239          (entry (gnus-gethash group gnus-newsrc-hashtb))
9240          (info (nth 2 entry))
9241          (active (gnus-active group))
9242          range)
9243     ;; First peel off all illegal article numbers.
9244     (if active
9245         (let ((ids articles)
9246               id first)
9247           (while ids
9248             (setq id (car ids))
9249             (if (and first (> id (cdr active)))
9250                 (progn
9251                   ;; We'll end up in this situation in one particular
9252                   ;; obscure situation.  If you re-scan a group and get
9253                   ;; a new article that is cross-posted to a different
9254                   ;; group that has not been re-scanned, you might get
9255                   ;; crossposted article that has a higher number than
9256                   ;; Gnus believes possible.  So we re-activate this
9257                   ;; group as well.  This might mean doing the
9258                   ;; crossposting thingy will *increase* the number
9259                   ;; of articles in some groups.  Tsk, tsk.
9260                   (setq active (or (gnus-activate-group group) active))))
9261             (if (or (> id (cdr active))
9262                     (< id (car active)))
9263                 (setq articles (delq id articles)))
9264             (setq ids (cdr ids)))))
9265     ;; If the read list is nil, we init it.
9266     (and active
9267          (null (gnus-info-read info))
9268          (> (car active) 1)
9269          (gnus-info-set-read info (cons 1 (1- (car active)))))
9270     ;; Then we add the read articles to the range.
9271     (gnus-info-set-read
9272      info
9273      (setq range
9274            (gnus-add-to-range
9275             (gnus-info-read info) (setq articles (sort articles '<)))))
9276     ;; Then we have to re-compute how many unread
9277     ;; articles there are in this group.
9278     (if active
9279         (progn
9280           (cond
9281            ((not range)
9282             (setq num (- (1+ (cdr active)) (car active))))
9283            ((not (listp (cdr range)))
9284             (setq num (- (cdr active) (- (1+ (cdr range))
9285                                          (car range)))))
9286            (t
9287             (while range
9288               (if (numberp (car range))
9289                   (setq num (1+ num))
9290                 (setq num (+ num (- (1+ (cdar range)) (caar range)))))
9291               (setq range (cdr range)))
9292             (setq num (- (cdr active) num))))
9293           ;; Update the number of unread articles.
9294           (setcar entry num)
9295           ;; Update the group buffer.
9296           (gnus-group-update-group group t)))))
9297
9298 (defun gnus-methods-equal-p (m1 m2)
9299   (let ((m1 (or m1 gnus-select-method))
9300         (m2 (or m2 gnus-select-method)))
9301     (or (equal m1 m2)
9302         (and (eq (car m1) (car m2))
9303              (or (not (memq 'address (assoc (symbol-name (car m1))
9304                                             gnus-valid-select-methods)))
9305                  (equal (nth 1 m1) (nth 1 m2)))))))
9306
9307 (defsubst gnus-header-value ()
9308   (buffer-substring (match-end 0) (gnus-point-at-eol)))
9309
9310 (defvar gnus-newsgroup-none-id 0)
9311
9312 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
9313   (let ((cur nntp-server-buffer)
9314         (dependencies
9315          (or dependencies
9316              (save-excursion (set-buffer gnus-summary-buffer)
9317                              gnus-newsgroup-dependencies)))
9318         headers id id-dep ref-dep end ref)
9319     (save-excursion
9320       (set-buffer nntp-server-buffer)
9321       (run-hooks 'gnus-parse-headers-hook)
9322       (let ((case-fold-search t)
9323             in-reply-to header p lines)
9324         (goto-char (point-min))
9325         ;; Search to the beginning of the next header.  Error messages
9326         ;; do not begin with 2 or 3.
9327         (while (re-search-forward "^[23][0-9]+ " nil t)
9328           (setq id nil
9329                 ref nil)
9330           ;; This implementation of this function, with nine
9331           ;; search-forwards instead of the one re-search-forward and
9332           ;; a case (which basically was the old function) is actually
9333           ;; about twice as fast, even though it looks messier.  You
9334           ;; can't have everything, I guess.  Speed and elegance
9335           ;; doesn't always go hand in hand.
9336           (setq
9337            header
9338            (vector
9339             ;; Number.
9340             (prog1
9341                 (read cur)
9342               (end-of-line)
9343               (setq p (point))
9344               (narrow-to-region (point)
9345                                 (or (and (search-forward "\n.\n" nil t)
9346                                          (- (point) 2))
9347                                     (point))))
9348             ;; Subject.
9349             (progn
9350               (goto-char p)
9351               (if (search-forward "\nsubject: " nil t)
9352                   (gnus-header-value) "(none)"))
9353             ;; From.
9354             (progn
9355               (goto-char p)
9356               (if (search-forward "\nfrom: " nil t)
9357                   (gnus-header-value) "(nobody)"))
9358             ;; Date.
9359             (progn
9360               (goto-char p)
9361               (if (search-forward "\ndate: " nil t)
9362                   (gnus-header-value) ""))
9363             ;; Message-ID.
9364             (progn
9365               (goto-char p)
9366               (if (search-forward "\nmessage-id: " nil t)
9367                   (setq id (gnus-header-value))
9368                 ;; If there was no message-id, we just fake one to make
9369                 ;; subsequent routines simpler.
9370                 (setq id (concat "none+"
9371                                  (int-to-string
9372                                   (setq gnus-newsgroup-none-id
9373                                         (1+ gnus-newsgroup-none-id)))))))
9374             ;; References.
9375             (progn
9376               (goto-char p)
9377               (if (search-forward "\nreferences: " nil t)
9378                   (progn
9379                     (setq end (point))
9380                     (prog1
9381                         (gnus-header-value)
9382                       (setq ref
9383                             (buffer-substring
9384                              (progn
9385                                (end-of-line)
9386                                (search-backward ">" end t)
9387                                (1+ (point)))
9388                              (progn
9389                                (search-backward "<" end t)
9390                                (point))))))
9391                 ;; Get the references from the in-reply-to header if there
9392                 ;; were no references and the in-reply-to header looks
9393                 ;; promising.
9394                 (if (and (search-forward "\nin-reply-to: " nil t)
9395                          (setq in-reply-to (gnus-header-value))
9396                          (string-match "<[^>]+>" in-reply-to))
9397                     (setq ref (substring in-reply-to (match-beginning 0)
9398                                          (match-end 0)))
9399                   (setq ref ""))))
9400             ;; Chars.
9401             0
9402             ;; Lines.
9403             (progn
9404               (goto-char p)
9405               (if (search-forward "\nlines: " nil t)
9406                   (if (numberp (setq lines (read cur)))
9407                       lines 0)
9408                 0))
9409             ;; Xref.
9410             (progn
9411               (goto-char p)
9412               (and (search-forward "\nxref: " nil t)
9413                    (gnus-header-value)))))
9414           ;; We do the threading while we read the headers.  The
9415           ;; message-id and the last reference are both entered into
9416           ;; the same hash table.  Some tippy-toeing around has to be
9417           ;; done in case an article has arrived before the article
9418           ;; which it refers to.
9419           (if (boundp (setq id-dep (intern id dependencies)))
9420               (if (and (car (symbol-value id-dep))
9421                        (not force-new))
9422                   ;; An article with this Message-ID has already
9423                   ;; been seen, so we ignore this one, except we add
9424                   ;; any additional Xrefs (in case the two articles
9425                   ;; came from different servers).
9426                   (progn
9427                     (mail-header-set-xref
9428                      (car (symbol-value id-dep))
9429                      (concat (or (mail-header-xref
9430                                   (car (symbol-value id-dep))) "")
9431                              (or (mail-header-xref header) "")))
9432                     (setq header nil))
9433                 (setcar (symbol-value id-dep) header))
9434             (set id-dep (list header)))
9435           (when header
9436             (if (boundp (setq ref-dep (intern ref dependencies)))
9437                 (setcdr (symbol-value ref-dep)
9438                         (nconc (cdr (symbol-value ref-dep))
9439                                (list (symbol-value id-dep))))
9440               (set ref-dep (list nil (symbol-value id-dep))))
9441             (setq headers (cons header headers)))
9442           (goto-char (point-max))
9443           (widen))
9444         (nreverse headers)))))
9445
9446 ;; The following macros and functions were written by Felix Lee
9447 ;; <flee@cse.psu.edu>.
9448
9449 (defmacro gnus-nov-read-integer ()
9450   '(prog1
9451        (if (= (following-char) ?\t)
9452            0
9453          (let ((num (condition-case nil (read buffer) (error nil))))
9454            (if (numberp num) num 0)))
9455      (or (eobp) (forward-char 1))))
9456
9457 (defmacro gnus-nov-skip-field ()
9458   '(search-forward "\t" eol 'move))
9459
9460 (defmacro gnus-nov-field ()
9461   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
9462
9463 ;; Goes through the xover lines and returns a list of vectors
9464 (defun gnus-get-newsgroup-headers-xover (sequence &optional 
9465                                                   force-new dependencies)
9466   "Parse the news overview data in the server buffer, and return a
9467 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
9468   ;; Get the Xref when the users reads the articles since most/some
9469   ;; NNTP servers do not include Xrefs when using XOVER.
9470   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
9471   (let ((cur nntp-server-buffer)
9472         (dependencies (or dependencies gnus-newsgroup-dependencies))
9473         number headers header)
9474     (save-excursion
9475       (set-buffer nntp-server-buffer)
9476       ;; Allow the user to mangle the headers before parsing them.
9477       (run-hooks 'gnus-parse-headers-hook)
9478       (goto-char (point-min))
9479       (while (and sequence (not (eobp)))
9480         (setq number (read cur))
9481         (while (and sequence (< (car sequence) number))
9482           (setq sequence (cdr sequence)))
9483         (and sequence
9484              (eq number (car sequence))
9485              (progn
9486                (setq sequence (cdr sequence))
9487                (if (setq header
9488                          (inline (gnus-nov-parse-line
9489                                   number dependencies force-new)))
9490                    (setq headers (cons header headers)))))
9491         (forward-line 1))
9492       (setq headers (nreverse headers)))
9493     headers))
9494
9495 ;; This function has to be called with point after the article number
9496 ;; on the beginning of the line.
9497 (defun gnus-nov-parse-line (number dependencies &optional force-new)
9498   (let ((none 0)
9499         (eol (gnus-point-at-eol))
9500         (buffer (current-buffer))
9501         header ref id id-dep ref-dep)
9502
9503     ;; overview: [num subject from date id refs chars lines misc]
9504     (narrow-to-region (point) eol)
9505     (or (eobp) (forward-char))
9506
9507     (condition-case nil
9508         (setq header
9509               (vector
9510                number                   ; number
9511                (gnus-nov-field)         ; subject
9512                (gnus-nov-field)         ; from
9513                (gnus-nov-field)         ; date
9514                (setq id (or (gnus-nov-field)
9515                             (concat "none+"
9516                                     (int-to-string
9517                                      (setq none (1+ none)))))) ; id
9518                (progn
9519                  (save-excursion
9520                    (let ((beg (point)))
9521                      (search-forward "\t" eol)
9522                      (if (search-backward ">" beg t)
9523                          (setq ref
9524                                (buffer-substring
9525                                 (1+ (point))
9526                                 (search-backward "<" beg t)))
9527                        (setq ref nil))))
9528                  (gnus-nov-field))      ; refs
9529                (gnus-nov-read-integer)  ; chars
9530                (gnus-nov-read-integer)  ; lines
9531                (if (= (following-char) ?\n)
9532                    nil
9533                  (gnus-nov-field))      ; misc
9534                ))
9535       (error (progn
9536                (gnus-error 4 "Strange nov line")
9537                (setq header nil)
9538                (goto-char eol))))
9539
9540     (widen)
9541
9542     ;; We build the thread tree.
9543     (when header
9544       (if (boundp (setq id-dep (intern id dependencies)))
9545           (if (and (car (symbol-value id-dep))
9546                    (not force-new))
9547               ;; An article with this Message-ID has already been seen,
9548               ;; so we ignore this one, except we add any additional
9549               ;; Xrefs (in case the two articles came from different
9550               ;; servers.
9551               (progn
9552                 (mail-header-set-xref
9553                  (car (symbol-value id-dep))
9554                  (concat (or (mail-header-xref
9555                               (car (symbol-value id-dep))) "")
9556                          (or (mail-header-xref header) "")))
9557                 (setq header nil))
9558             (setcar (symbol-value id-dep) header))
9559         (set id-dep (list header))))
9560     (when header
9561       (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
9562           (setcdr (symbol-value ref-dep)
9563                   (nconc (cdr (symbol-value ref-dep))
9564                          (list (symbol-value id-dep))))
9565         (set ref-dep (list nil (symbol-value id-dep)))))
9566     header))
9567
9568 (defun gnus-article-get-xrefs ()
9569   "Fill in the Xref value in `gnus-current-headers', if necessary.
9570 This is meant to be called in `gnus-article-internal-prepare-hook'."
9571   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
9572                                  gnus-current-headers)))
9573     (or (not gnus-use-cross-reference)
9574         (not headers)
9575         (and (mail-header-xref headers)
9576              (not (string= (mail-header-xref headers) "")))
9577         (let ((case-fold-search t)
9578               xref)
9579           (save-restriction
9580             (nnheader-narrow-to-headers)
9581             (goto-char (point-min))
9582             (if (or (and (eq (downcase (following-char)) ?x)
9583                          (looking-at "Xref:"))
9584                     (search-forward "\nXref:" nil t))
9585                 (progn
9586                   (goto-char (1+ (match-end 0)))
9587                   (setq xref (buffer-substring (point)
9588                                                (progn (end-of-line) (point))))
9589                   (mail-header-set-xref headers xref))))))))
9590
9591 (defun gnus-summary-insert-subject (id &optional old-header use-old-header)
9592   "Find article ID and insert the summary line for that article."
9593   (let ((header (if (and old-header use-old-header)
9594                     old-header (gnus-read-header id)))
9595         (number (and (numberp id) id))
9596         pos)
9597     (when header
9598       ;; Rebuild the thread that this article is part of and go to the
9599       ;; article we have fetched.
9600       (when (and (not gnus-show-threads)
9601                  old-header)
9602         (when (setq pos (text-property-any
9603                          (point-min) (point-max) 'gnus-number 
9604                          (mail-header-number old-header)))
9605           (goto-char pos)
9606           (gnus-delete-line)
9607           (gnus-data-remove (mail-header-number old-header))))
9608       (when old-header
9609         (mail-header-set-number header (mail-header-number old-header)))
9610       (setq gnus-newsgroup-sparse
9611             (delq (setq number (mail-header-number header)) 
9612                   gnus-newsgroup-sparse))
9613       (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
9614       (gnus-rebuild-thread (mail-header-id header))
9615       (gnus-summary-goto-subject number nil t))
9616     (when (and (numberp number)
9617                (> number 0))
9618       ;; We have to update the boundaries even if we can't fetch the
9619       ;; article if ID is a number -- so that the next `P' or `N'
9620       ;; command will fetch the previous (or next) article even
9621       ;; if the one we tried to fetch this time has been canceled.
9622       (and (> number gnus-newsgroup-end)
9623            (setq gnus-newsgroup-end number))
9624       (and (< number gnus-newsgroup-begin)
9625            (setq gnus-newsgroup-begin number))
9626       (setq gnus-newsgroup-unselected
9627             (delq number gnus-newsgroup-unselected)))
9628     ;; Report back a success?
9629     (and header (mail-header-number header))))
9630
9631 (defun gnus-summary-work-articles (n)
9632   "Return a list of articles to be worked upon.  The prefix argument,
9633 the list of process marked articles, and the current article will be
9634 taken into consideration."
9635   (cond
9636    (n
9637     ;; A numerical prefix has been given.
9638     (let ((backward (< n 0))
9639           (n (abs (prefix-numeric-value n)))
9640           articles article)
9641       (save-excursion
9642         (while
9643             (and (> n 0)
9644                  (push (setq article (gnus-summary-article-number))
9645                        articles)
9646                  (if backward
9647                      (gnus-summary-find-prev nil article)
9648                    (gnus-summary-find-next nil article)))
9649           (decf n)))
9650       (nreverse articles)))
9651    ((and (boundp 'transient-mark-mode)
9652          transient-mark-mode
9653          mark-active)
9654     ;; Work on the region between point and mark.
9655     (let ((max (max (point) (mark)))
9656           articles article)
9657       (save-excursion
9658         (goto-char (min (point) (mark)))
9659         (while
9660             (and
9661              (push (setq article (gnus-summary-article-number)) articles)
9662              (gnus-summary-find-next nil article)
9663              (< (point) max)))
9664         (nreverse articles))))
9665    (gnus-newsgroup-processable
9666     ;; There are process-marked articles present.
9667     (reverse gnus-newsgroup-processable))
9668    (t
9669     ;; Just return the current article.
9670     (list (gnus-summary-article-number)))))
9671
9672 (defun gnus-summary-search-group (&optional backward use-level)
9673   "Search for next unread newsgroup.
9674 If optional argument BACKWARD is non-nil, search backward instead."
9675   (save-excursion
9676     (set-buffer gnus-group-buffer)
9677     (if (gnus-group-search-forward
9678          backward nil (if use-level (gnus-group-group-level) nil))
9679         (gnus-group-group-name))))
9680
9681 (defun gnus-summary-best-group (&optional exclude-group)
9682   "Find the name of the best unread group.
9683 If EXCLUDE-GROUP, do not go to this group."
9684   (save-excursion
9685     (set-buffer gnus-group-buffer)
9686     (save-excursion
9687       (gnus-group-best-unread-group exclude-group))))
9688
9689 (defun gnus-summary-find-next (&optional unread article backward)
9690   (if backward (gnus-summary-find-prev)
9691     (let* ((dummy (gnus-summary-article-intangible-p))
9692            (article (or article (gnus-summary-article-number)))
9693            (arts (gnus-data-find-list article))
9694            result)
9695       (when (and (not dummy)
9696                  (or (not gnus-summary-check-current)
9697                      (not unread)
9698                      (not (gnus-data-unread-p (car arts)))))
9699         (setq arts (cdr arts)))
9700       (when (setq result
9701                   (if unread
9702                       (progn
9703                         (while arts
9704                           (when (gnus-data-unread-p (car arts))
9705                             (setq result (car arts)
9706                                   arts nil))
9707                           (setq arts (cdr arts)))
9708                         result)
9709                     (car arts)))
9710         (goto-char (gnus-data-pos result))
9711         (gnus-data-number result)))))
9712
9713 (defun gnus-summary-find-prev (&optional unread article)
9714   (let* ((eobp (eobp))
9715          (article (or article (gnus-summary-article-number)))
9716          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
9717          result)
9718     (when (and (not eobp)
9719                (or (not gnus-summary-check-current)
9720                    (not unread)
9721                    (not (gnus-data-unread-p (car arts)))))
9722       (setq arts (cdr arts)))
9723     (if (setq result
9724               (if unread
9725                   (progn
9726                     (while arts
9727                       (and (gnus-data-unread-p (car arts))
9728                            (setq result (car arts)
9729                                  arts nil))
9730                       (setq arts (cdr arts)))
9731                     result)
9732                 (car arts)))
9733         (progn
9734           (goto-char (gnus-data-pos result))
9735           (gnus-data-number result)))))
9736
9737 (defun gnus-summary-find-subject (subject &optional unread backward article)
9738   (let* ((simp-subject (gnus-simplify-subject-fully subject))
9739          (article (or article (gnus-summary-article-number)))
9740          (articles (gnus-data-list backward))
9741          (arts (gnus-data-find-list article articles))
9742          result)
9743     (when (or (not gnus-summary-check-current)
9744               (not unread)
9745               (not (gnus-data-unread-p (car arts))))
9746       (setq arts (cdr arts)))
9747     (while arts
9748       (and (or (not unread)
9749                (gnus-data-unread-p (car arts)))
9750            (vectorp (gnus-data-header (car arts)))
9751            (gnus-subject-equal
9752             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
9753            (setq result (car arts)
9754                  arts nil))
9755       (setq arts (cdr arts)))
9756     (and result
9757          (goto-char (gnus-data-pos result))
9758          (gnus-data-number result))))
9759
9760 (defun gnus-summary-search-forward (&optional unread subject backward)
9761   "Search forward for an article.
9762 If UNREAD, look for unread articles.  If SUBJECT, look for
9763 articles with that subject.  If BACKWARD, search backward instead."
9764   (cond (subject (gnus-summary-find-subject subject unread backward))
9765         (backward (gnus-summary-find-prev unread))
9766         (t (gnus-summary-find-next unread))))
9767
9768 (defun gnus-recenter (&optional n)
9769   "Center point in window and redisplay frame.
9770 Also do horizontal recentering."
9771   (interactive "P")
9772   (when (and gnus-auto-center-summary
9773              (not (eq gnus-auto-center-summary 'vertical)))
9774     (gnus-horizontal-recenter))
9775   (recenter n))
9776
9777 (defun gnus-summary-recenter ()
9778   "Center point in the summary window.
9779 If `gnus-auto-center-summary' is nil, or the article buffer isn't
9780 displayed, no centering will be performed."
9781   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
9782   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
9783   (let* ((top (cond ((< (window-height) 4) 0)
9784                     ((< (window-height) 7) 1)
9785                     (t 2)))
9786          (height (1- (window-height)))
9787          (bottom (save-excursion (goto-char (point-max))
9788                                  (forward-line (- height))
9789                                  (point)))
9790          (window (get-buffer-window (current-buffer))))
9791     ;; The user has to want it.
9792     (when gnus-auto-center-summary
9793       (when (get-buffer-window gnus-article-buffer)
9794        ;; Only do recentering when the article buffer is displayed,
9795        ;; Set the window start to either `bottom', which is the biggest
9796        ;; possible valid number, or the second line from the top,
9797        ;; whichever is the least.
9798        (set-window-start
9799         window (min bottom (save-excursion 
9800                              (forward-line (- top)) (point)))))
9801       ;; Do horizontal recentering while we're at it.
9802       (when (and (get-buffer-window (current-buffer) t)
9803                  (not (eq gnus-auto-center-summary 'vertical)))
9804         (let ((selected (selected-window)))
9805           (select-window (get-buffer-window (current-buffer) t))
9806           (gnus-summary-position-point)
9807           (gnus-horizontal-recenter)
9808           (select-window selected))))))
9809
9810 (defun gnus-horizontal-recenter ()
9811   "Recenter the current buffer horizontally."
9812   (if (< (current-column) (/ (window-width) 2))
9813       (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
9814     (let* ((orig (point))
9815            (end (window-end (get-buffer-window (current-buffer) t)))
9816            (max 0))
9817       ;; Find the longest line currently displayed in the window.
9818       (goto-char (window-start))
9819       (while (and (not (eobp)) 
9820                   (< (point) end))
9821         (end-of-line)
9822         (setq max (max max (current-column)))
9823         (forward-line 1))
9824       (goto-char orig)
9825       ;; Scroll horizontally to center (sort of) the point.
9826       (if (> max (window-width))
9827           (set-window-hscroll 
9828            (get-buffer-window (current-buffer) t)
9829            (min (- (current-column) (/ (window-width) 3))
9830                 (+ 2 (- max (window-width)))))
9831         (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
9832       max)))
9833
9834 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
9835 (defun gnus-short-group-name (group &optional levels)
9836   "Collapse GROUP name LEVELS."
9837   (let* ((name "") 
9838          (foreign "")
9839          (depth 0) 
9840          (skip 1)
9841          (levels (or levels
9842                      (progn
9843                        (while (string-match "\\." group skip)
9844                          (setq skip (match-end 0)
9845                                depth (+ depth 1)))
9846                        depth))))
9847     (if (string-match ":" group)
9848         (setq foreign (substring group 0 (match-end 0))
9849               group (substring group (match-end 0))))
9850     (while group
9851       (if (and (string-match "\\." group)
9852                (> levels (- gnus-group-uncollapsed-levels 1)))
9853           (setq name (concat name (substring group 0 1))
9854                 group (substring group (match-end 0))
9855                 levels (- levels 1)
9856                 name (concat name "."))
9857         (setq name (concat foreign name group)
9858               group nil)))
9859     name))
9860
9861 (defun gnus-summary-jump-to-group (newsgroup)
9862   "Move point to NEWSGROUP in group mode buffer."
9863   ;; Keep update point of group mode buffer if visible.
9864   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
9865       (save-window-excursion
9866         ;; Take care of tree window mode.
9867         (if (get-buffer-window gnus-group-buffer)
9868             (pop-to-buffer gnus-group-buffer))
9869         (gnus-group-jump-to-group newsgroup))
9870     (save-excursion
9871       ;; Take care of tree window mode.
9872       (if (get-buffer-window gnus-group-buffer)
9873           (pop-to-buffer gnus-group-buffer)
9874         (set-buffer gnus-group-buffer))
9875       (gnus-group-jump-to-group newsgroup))))
9876
9877 ;; This function returns a list of article numbers based on the
9878 ;; difference between the ranges of read articles in this group and
9879 ;; the range of active articles.
9880 (defun gnus-list-of-unread-articles (group)
9881   (let* ((read (gnus-info-read (gnus-get-info group)))
9882          (active (gnus-active group))
9883          (last (cdr active))
9884          first nlast unread)
9885     ;; If none are read, then all are unread.
9886     (if (not read)
9887         (setq first (car active))
9888       ;; If the range of read articles is a single range, then the
9889       ;; first unread article is the article after the last read
9890       ;; article.  Sounds logical, doesn't it?
9891       (if (not (listp (cdr read)))
9892           (setq first (1+ (cdr read)))
9893         ;; `read' is a list of ranges.
9894         (if (/= (setq nlast (or (and (numberp (car read)) (car read))
9895                                 (caar read))) 1)
9896             (setq first 1))
9897         (while read
9898           (if first
9899               (while (< first nlast)
9900                 (setq unread (cons first unread))
9901                 (setq first (1+ first))))
9902           (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
9903           (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
9904           (setq read (cdr read)))))
9905     ;; And add the last unread articles.
9906     (while (<= first last)
9907       (setq unread (cons first unread))
9908       (setq first (1+ first)))
9909     ;; Return the list of unread articles.
9910     (nreverse unread)))
9911
9912 (defun gnus-list-of-read-articles (group)
9913   "Return a list of unread, unticked and non-dormant articles."
9914   (let* ((info (gnus-get-info group))
9915          (marked (gnus-info-marks info))
9916          (active (gnus-active group)))
9917     (and info active
9918          (gnus-set-difference
9919           (gnus-sorted-complement
9920            (gnus-uncompress-range active)
9921            (gnus-list-of-unread-articles group))
9922           (append
9923            (gnus-uncompress-range (cdr (assq 'dormant marked)))
9924            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
9925
9926 ;; Various summary commands
9927
9928 (defun gnus-summary-universal-argument (arg)
9929   "Perform any operation on all articles that are process/prefixed."
9930   (interactive "P")
9931   (gnus-set-global-variables)
9932   (let ((articles (gnus-summary-work-articles arg))
9933         func article)
9934     (if (eq
9935          (setq
9936           func
9937           (key-binding
9938            (read-key-sequence
9939             (substitute-command-keys
9940              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
9941              ))))
9942          'undefined)
9943         (gnus-error 1 "Undefined key")
9944       (save-excursion
9945         (while articles
9946           (gnus-summary-goto-subject (setq article (pop articles)))
9947           (command-execute func)
9948           (gnus-summary-remove-process-mark article)))))
9949   (gnus-summary-position-point))
9950
9951 (defun gnus-summary-toggle-truncation (&optional arg)
9952   "Toggle truncation of summary lines.
9953 With arg, turn line truncation on iff arg is positive."
9954   (interactive "P")
9955   (setq truncate-lines
9956         (if (null arg) (not truncate-lines)
9957           (> (prefix-numeric-value arg) 0)))
9958   (redraw-display))
9959
9960 (defun gnus-summary-reselect-current-group (&optional all rescan)
9961   "Exit and then reselect the current newsgroup.
9962 The prefix argument ALL means to select all articles."
9963   (interactive "P")
9964   (gnus-set-global-variables)
9965   (when (gnus-ephemeral-group-p gnus-newsgroup-name)
9966     (error "Ephemeral groups can't be reselected"))
9967   (let ((current-subject (gnus-summary-article-number))
9968         (group gnus-newsgroup-name))
9969     (setq gnus-newsgroup-begin nil)
9970     (gnus-summary-exit)
9971     ;; We have to adjust the point of group mode buffer because the
9972     ;; current point was moved to the next unread newsgroup by
9973     ;; exiting.
9974     (gnus-summary-jump-to-group group)
9975     (when rescan
9976       (save-excursion
9977         (gnus-group-get-new-news-this-group 1)))
9978     (gnus-group-read-group all t)
9979     (gnus-summary-goto-subject current-subject nil t)))
9980
9981 (defun gnus-summary-rescan-group (&optional all)
9982   "Exit the newsgroup, ask for new articles, and select the newsgroup."
9983   (interactive "P")
9984   (gnus-summary-reselect-current-group all t))
9985
9986 (defun gnus-summary-update-info ()
9987   (let* ((group gnus-newsgroup-name))
9988     (when gnus-newsgroup-kill-headers
9989       (setq gnus-newsgroup-killed
9990             (gnus-compress-sequence
9991              (nconc
9992               (gnus-set-sorted-intersection
9993                (gnus-uncompress-range gnus-newsgroup-killed)
9994                (setq gnus-newsgroup-unselected
9995                      (sort gnus-newsgroup-unselected '<)))
9996               (setq gnus-newsgroup-unreads
9997                     (sort gnus-newsgroup-unreads '<))) t)))
9998     (unless (listp (cdr gnus-newsgroup-killed))
9999       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
10000     (let ((headers gnus-newsgroup-headers))
10001       (run-hooks 'gnus-exit-group-hook)
10002       (unless gnus-save-score
10003         (setq gnus-newsgroup-scored nil))
10004       ;; Set the new ranges of read articles.
10005       (gnus-update-read-articles
10006        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
10007       ;; Set the current article marks.
10008       (gnus-update-marks)
10009       ;; Do the cross-ref thing.
10010       (when gnus-use-cross-reference
10011         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
10012       ;; Do adaptive scoring, and possibly save score files.
10013       (when gnus-newsgroup-adaptive
10014         (gnus-score-adaptive))
10015       (when gnus-use-scoring
10016         (gnus-score-save))
10017       ;; Do not switch windows but change the buffer to work.
10018       (set-buffer gnus-group-buffer)
10019       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
10020           (gnus-group-update-group group)))))
10021
10022 (defun gnus-summary-exit (&optional temporary)
10023   "Exit reading current newsgroup, and then return to group selection mode.
10024 gnus-exit-group-hook is called with no arguments if that value is non-nil."
10025   (interactive)
10026   (gnus-set-global-variables)
10027   (gnus-kill-save-kill-buffer)
10028   (let* ((group gnus-newsgroup-name)
10029          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
10030          (mode major-mode)
10031          (buf (current-buffer)))
10032     (run-hooks 'gnus-summary-prepare-exit-hook)
10033     ;; If we have several article buffers, we kill them at exit.
10034     (unless gnus-single-article-buffer
10035       (gnus-kill-buffer gnus-original-article-buffer)
10036       (setq gnus-article-current nil))
10037     (when gnus-use-cache
10038       (gnus-cache-possibly-remove-articles)
10039       (gnus-cache-save-buffers))
10040     (when gnus-use-trees
10041       (gnus-tree-close group))
10042     ;; Make all changes in this group permanent.
10043     (unless quit-config
10044       (gnus-summary-update-info))
10045     (gnus-close-group group)
10046     ;; Make sure where I was, and go to next newsgroup.
10047     (set-buffer gnus-group-buffer)
10048     (unless quit-config
10049       (gnus-group-jump-to-group group))
10050     (run-hooks 'gnus-summary-exit-hook)
10051     (unless quit-config
10052       (gnus-group-next-unread-group 1))
10053     (if temporary
10054         nil                             ;Nothing to do.
10055       ;; If we have several article buffers, we kill them at exit.
10056       (unless gnus-single-article-buffer
10057         (gnus-kill-buffer gnus-article-buffer)
10058         (gnus-kill-buffer gnus-original-article-buffer)
10059         (setq gnus-article-current nil))
10060       (set-buffer buf)
10061       (if (not gnus-kill-summary-on-exit)
10062           (gnus-deaden-summary)
10063         ;; We set all buffer-local variables to nil.  It is unclear why
10064         ;; this is needed, but if we don't, buffer-local variables are
10065         ;; not garbage-collected, it seems.  This would the lead to en
10066         ;; ever-growing Emacs.
10067         (gnus-summary-clear-local-variables)
10068         (when (get-buffer gnus-article-buffer)
10069           (bury-buffer gnus-article-buffer))
10070         ;; We clear the global counterparts of the buffer-local
10071         ;; variables as well, just to be on the safe side.
10072         (gnus-configure-windows 'group 'force)
10073         (gnus-summary-clear-local-variables)
10074         ;; Return to group mode buffer.
10075         (if (eq mode 'gnus-summary-mode)
10076             (gnus-kill-buffer buf)))
10077       (setq gnus-current-select-method gnus-select-method)
10078       (pop-to-buffer gnus-group-buffer)
10079       ;; Clear the current group name.
10080       (if (not quit-config)
10081           (progn
10082             (gnus-group-jump-to-group group)
10083             (gnus-group-next-unread-group 1)
10084             (gnus-configure-windows 'group 'force))
10085         (if (not (buffer-name (car quit-config)))
10086             (gnus-configure-windows 'group 'force)
10087           (set-buffer (car quit-config))
10088           (and (eq major-mode 'gnus-summary-mode)
10089                (gnus-set-global-variables))
10090           (gnus-configure-windows (cdr quit-config))))
10091       (unless quit-config
10092         (setq gnus-newsgroup-name nil)))))
10093
10094 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
10095 (defun gnus-summary-exit-no-update (&optional no-questions)
10096   "Quit reading current newsgroup without updating read article info."
10097   (interactive)
10098   (gnus-set-global-variables)
10099   (let* ((group gnus-newsgroup-name)
10100          (quit-config (gnus-group-quit-config group)))
10101     (when (or no-questions
10102               gnus-expert-user
10103               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
10104       ;; If we have several article buffers, we kill them at exit.
10105       (unless gnus-single-article-buffer
10106         (gnus-kill-buffer gnus-article-buffer)
10107         (gnus-kill-buffer gnus-original-article-buffer)
10108         (setq gnus-article-current nil))
10109       (if (not gnus-kill-summary-on-exit)
10110           (gnus-deaden-summary)
10111         (gnus-close-group group)
10112         (gnus-summary-clear-local-variables)
10113         (set-buffer gnus-group-buffer)
10114         (gnus-summary-clear-local-variables)
10115         (when (get-buffer gnus-summary-buffer)
10116           (kill-buffer gnus-summary-buffer)))
10117       (unless gnus-single-article-buffer
10118         (setq gnus-article-current nil))
10119       (when gnus-use-trees
10120         (gnus-tree-close group))
10121       (when (get-buffer gnus-article-buffer)
10122         (bury-buffer gnus-article-buffer))
10123       ;; Return to the group buffer.
10124       (gnus-configure-windows 'group 'force)
10125       ;; Clear the current group name.
10126       (setq gnus-newsgroup-name nil)
10127       (when (equal (gnus-group-group-name) group)
10128         (gnus-group-next-unread-group 1))
10129       (when quit-config
10130         (if (not (buffer-name (car quit-config)))
10131             (gnus-configure-windows 'group 'force)
10132           (set-buffer (car quit-config))
10133           (when (eq major-mode 'gnus-summary-mode)
10134             (gnus-set-global-variables))
10135           (gnus-configure-windows (cdr quit-config)))))))
10136
10137 ;;; Dead summaries.
10138
10139 (defvar gnus-dead-summary-mode-map nil)
10140
10141 (if gnus-dead-summary-mode-map
10142     nil
10143   (setq gnus-dead-summary-mode-map (make-keymap))
10144   (suppress-keymap gnus-dead-summary-mode-map)
10145   (substitute-key-definition
10146    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
10147   (let ((keys '("\C-d" "\r" "\177")))
10148     (while keys
10149       (define-key gnus-dead-summary-mode-map
10150         (pop keys) 'gnus-summary-wake-up-the-dead))))
10151
10152 (defvar gnus-dead-summary-mode nil
10153   "Minor mode for Gnus summary buffers.")
10154
10155 (defun gnus-dead-summary-mode (&optional arg)
10156   "Minor mode for Gnus summary buffers."
10157   (interactive "P")
10158   (when (eq major-mode 'gnus-summary-mode)
10159     (make-local-variable 'gnus-dead-summary-mode)
10160     (setq gnus-dead-summary-mode
10161           (if (null arg) (not gnus-dead-summary-mode)
10162             (> (prefix-numeric-value arg) 0)))
10163     (when gnus-dead-summary-mode
10164       (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
10165         (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
10166       (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
10167         (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
10168               minor-mode-map-alist)))))
10169
10170 (defun gnus-deaden-summary ()
10171   "Make the current summary buffer into a dead summary buffer."
10172   ;; Kill any previous dead summary buffer.
10173   (when (and gnus-dead-summary
10174              (buffer-name gnus-dead-summary))
10175     (save-excursion
10176       (set-buffer gnus-dead-summary)
10177       (when gnus-dead-summary-mode
10178         (kill-buffer (current-buffer)))))
10179   ;; Make this the current dead summary.
10180   (setq gnus-dead-summary (current-buffer))
10181   (gnus-dead-summary-mode 1)
10182   (let ((name (buffer-name)))
10183     (when (string-match "Summary" name)
10184       (rename-buffer
10185        (concat (substring name 0 (match-beginning 0)) "Dead "
10186                (substring name (match-beginning 0))) t))))
10187
10188 (defun gnus-kill-or-deaden-summary (buffer)
10189   "Kill or deaden the summary BUFFER."
10190   (when (and (buffer-name buffer)
10191              (not gnus-single-article-buffer))
10192     (save-excursion
10193       (set-buffer buffer)
10194       (gnus-kill-buffer gnus-article-buffer)
10195       (gnus-kill-buffer gnus-original-article-buffer)))
10196   (cond (gnus-kill-summary-on-exit
10197          (when (and gnus-use-trees
10198                     (and (get-buffer buffer)
10199                          (buffer-name (get-buffer buffer))))
10200            (save-excursion
10201              (set-buffer (get-buffer buffer))
10202              (gnus-tree-close gnus-newsgroup-name)))
10203          (gnus-kill-buffer buffer))
10204         ((and (get-buffer buffer)
10205               (buffer-name (get-buffer buffer)))
10206          (save-excursion
10207            (set-buffer buffer)
10208            (gnus-deaden-summary)))))
10209
10210 (defun gnus-summary-wake-up-the-dead (&rest args)
10211   "Wake up the dead summary buffer."
10212   (interactive)
10213   (gnus-dead-summary-mode -1)
10214   (let ((name (buffer-name)))
10215     (when (string-match "Dead " name)
10216       (rename-buffer
10217        (concat (substring name 0 (match-beginning 0))
10218                (substring name (match-end 0))) t)))
10219   (gnus-message 3 "This dead summary is now alive again"))
10220
10221 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
10222 (defun gnus-summary-fetch-faq (&optional faq-dir)
10223   "Fetch the FAQ for the current group.
10224 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
10225 in."
10226   (interactive
10227    (list
10228     (if current-prefix-arg
10229         (completing-read
10230          "Faq dir: " (and (listp gnus-group-faq-directory)
10231                           gnus-group-faq-directory)))))
10232   (let (gnus-faq-buffer)
10233     (and (setq gnus-faq-buffer
10234                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
10235          (gnus-configure-windows 'summary-faq))))
10236
10237 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
10238 (defun gnus-summary-describe-group (&optional force)
10239   "Describe the current newsgroup."
10240   (interactive "P")
10241   (gnus-group-describe-group force gnus-newsgroup-name))
10242
10243 (defun gnus-summary-describe-briefly ()
10244   "Describe summary mode commands briefly."
10245   (interactive)
10246   (gnus-message 6
10247                 (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")))
10248
10249 ;; Walking around group mode buffer from summary mode.
10250
10251 (defun gnus-summary-next-group (&optional no-article target-group backward)
10252   "Exit current newsgroup and then select next unread newsgroup.
10253 If prefix argument NO-ARTICLE is non-nil, no article is selected
10254 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
10255 previous group instead."
10256   (interactive "P")
10257   (gnus-set-global-variables)
10258   (let ((current-group gnus-newsgroup-name)
10259         (current-buffer (current-buffer))
10260         entered)
10261     ;; First we semi-exit this group to update Xrefs and all variables.
10262     ;; We can't do a real exit, because the window conf must remain
10263     ;; the same in case the user is prompted for info, and we don't
10264     ;; want the window conf to change before that...
10265     (gnus-summary-exit t)
10266     (while (not entered)
10267       ;; Then we find what group we are supposed to enter.
10268       (set-buffer gnus-group-buffer)
10269       (gnus-group-jump-to-group current-group)
10270       (setq target-group
10271             (or target-group
10272                 (if (eq gnus-keep-same-level 'best)
10273                     (gnus-summary-best-group gnus-newsgroup-name)
10274                   (gnus-summary-search-group backward gnus-keep-same-level))))
10275       (if (not target-group)
10276           ;; There are no further groups, so we return to the group
10277           ;; buffer.
10278           (progn
10279             (gnus-message 5 "Returning to the group buffer")
10280             (setq entered t)
10281             (set-buffer current-buffer)
10282             (gnus-summary-exit))
10283         ;; We try to enter the target group.
10284         (gnus-group-jump-to-group target-group)
10285         (let ((unreads (gnus-group-group-unread)))
10286           (if (and (or (eq t unreads)
10287                        (and unreads (not (zerop unreads))))
10288                    (gnus-summary-read-group
10289                     target-group nil no-article current-buffer))
10290               (setq entered t)
10291             (setq current-group target-group
10292                   target-group nil)))))))
10293
10294 (defun gnus-summary-prev-group (&optional no-article)
10295   "Exit current newsgroup and then select previous unread newsgroup.
10296 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
10297   (interactive "P")
10298   (gnus-summary-next-group no-article nil t))
10299
10300 ;; Walking around summary lines.
10301
10302 (defun gnus-summary-first-subject (&optional unread)
10303   "Go to the first unread subject.
10304 If UNREAD is non-nil, go to the first unread article.
10305 Returns the article selected or nil if there are no unread articles."
10306   (interactive "P")
10307   (prog1
10308       (cond
10309        ;; Empty summary.
10310        ((null gnus-newsgroup-data)
10311         (gnus-message 3 "No articles in the group")
10312         nil)
10313        ;; Pick the first article.
10314        ((not unread)
10315         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
10316         (gnus-data-number (car gnus-newsgroup-data)))
10317        ;; No unread articles.
10318        ((null gnus-newsgroup-unreads)
10319         (gnus-message 3 "No more unread articles")
10320         nil)
10321        ;; Find the first unread article.
10322        (t
10323         (let ((data gnus-newsgroup-data))
10324           (while (and data
10325                       (not (gnus-data-unread-p (car data))))
10326             (setq data (cdr data)))
10327           (if data
10328               (progn
10329                 (goto-char (gnus-data-pos (car data)))
10330                 (gnus-data-number (car data)))))))
10331     (gnus-summary-position-point)))
10332
10333 (defun gnus-summary-next-subject (n &optional unread dont-display)
10334   "Go to next N'th summary line.
10335 If N is negative, go to the previous N'th subject line.
10336 If UNREAD is non-nil, only unread articles are selected.
10337 The difference between N and the actual number of steps taken is
10338 returned."
10339   (interactive "p")
10340   (let ((backward (< n 0))
10341         (n (abs n)))
10342     (while (and (> n 0)
10343                 (if backward
10344                     (gnus-summary-find-prev unread)
10345                   (gnus-summary-find-next unread)))
10346       (setq n (1- n)))
10347     (if (/= 0 n) (gnus-message 7 "No more%s articles"
10348                                (if unread " unread" "")))
10349     (unless dont-display
10350       (gnus-summary-recenter)
10351       (gnus-summary-position-point))
10352     n))
10353
10354 (defun gnus-summary-next-unread-subject (n)
10355   "Go to next N'th unread summary line."
10356   (interactive "p")
10357   (gnus-summary-next-subject n t))
10358
10359 (defun gnus-summary-prev-subject (n &optional unread)
10360   "Go to previous N'th summary line.
10361 If optional argument UNREAD is non-nil, only unread article is selected."
10362   (interactive "p")
10363   (gnus-summary-next-subject (- n) unread))
10364
10365 (defun gnus-summary-prev-unread-subject (n)
10366   "Go to previous N'th unread summary line."
10367   (interactive "p")
10368   (gnus-summary-next-subject (- n) t))
10369
10370 (defun gnus-summary-goto-subject (article &optional force silent)
10371   "Go the subject line of ARTICLE.
10372 If FORCE, also allow jumping to articles not currently shown."
10373   (let ((b (point))
10374         (data (gnus-data-find article)))
10375     ;; We read in the article if we have to.
10376     (and (not data)
10377          force
10378          (gnus-summary-insert-subject article (and (vectorp force) force) t)
10379          (setq data (gnus-data-find article)))
10380     (goto-char b)
10381     (if (not data)
10382         (progn
10383           (unless silent
10384             (gnus-message 3 "Can't find article %d" article))
10385           nil)
10386       (goto-char (gnus-data-pos data))
10387       article)))
10388
10389 ;; Walking around summary lines with displaying articles.
10390
10391 (defun gnus-summary-expand-window (&optional arg)
10392   "Make the summary buffer take up the entire Emacs frame.
10393 Given a prefix, will force an `article' buffer configuration."
10394   (interactive "P")
10395   (gnus-set-global-variables)
10396   (if arg
10397       (gnus-configure-windows 'article 'force)
10398     (gnus-configure-windows 'summary 'force)))
10399
10400 (defun gnus-summary-display-article (article &optional all-header)
10401   "Display ARTICLE in article buffer."
10402   (gnus-set-global-variables)
10403   (if (null article)
10404       nil
10405     (prog1
10406         (if gnus-summary-display-article-function
10407             (funcall gnus-summary-display-article-function article all-header)
10408           (gnus-article-prepare article all-header))
10409       (run-hooks 'gnus-select-article-hook)
10410       (unless (zerop gnus-current-article)
10411         (gnus-summary-goto-subject gnus-current-article))
10412       (gnus-summary-recenter)
10413       (when gnus-use-trees
10414         (gnus-possibly-generate-tree article)
10415         (gnus-highlight-selected-tree article))
10416       ;; Successfully display article.
10417       (gnus-article-set-window-start
10418        (cdr (assq article gnus-newsgroup-bookmarks))))))
10419
10420 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
10421   "Select the current article.
10422 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
10423 non-nil, the article will be re-fetched even if it already present in
10424 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
10425 be displayed."
10426   ;; Make sure we are in the summary buffer to work around bbdb bug.
10427   (unless (eq major-mode 'gnus-summary-mode)
10428     (set-buffer gnus-summary-buffer))
10429   (let ((article (or article (gnus-summary-article-number)))
10430         (all-headers (not (not all-headers))) ;Must be T or NIL.
10431         gnus-summary-display-article-function
10432         did)
10433     (and (not pseudo)
10434          (gnus-summary-article-pseudo-p article)
10435          (error "This is a pseudo-article."))
10436     (prog1
10437         (save-excursion
10438           (set-buffer gnus-summary-buffer)
10439           (if (or (and gnus-single-article-buffer
10440                        (or (null gnus-current-article)
10441                            (null gnus-article-current)
10442                            (null (get-buffer gnus-article-buffer))
10443                            (not (eq article (cdr gnus-article-current)))
10444                            (not (equal (car gnus-article-current)
10445                                        gnus-newsgroup-name))))
10446                   (and (not gnus-single-article-buffer)
10447                        (or (null gnus-current-article)
10448                            (not (eq gnus-current-article article))))
10449                   force)
10450               ;; The requested article is different from the current article.
10451               (prog1
10452                   (gnus-summary-display-article article all-headers)
10453                 (setq did article))
10454             (if (or all-headers gnus-show-all-headers)
10455                 (gnus-article-show-all-headers))
10456             'old))
10457       (if did
10458           (gnus-article-set-window-start
10459            (cdr (assq article gnus-newsgroup-bookmarks)))))))
10460
10461 (defun gnus-summary-set-current-mark (&optional current-mark)
10462   "Obsolete function."
10463   nil)
10464
10465 (defun gnus-summary-next-article (&optional unread subject backward push)
10466   "Select the next article.
10467 If UNREAD, only unread articles are selected.
10468 If SUBJECT, only articles with SUBJECT are selected.
10469 If BACKWARD, the previous article is selected instead of the next."
10470   (interactive "P")
10471   (gnus-set-global-variables)
10472   (cond
10473    ;; Is there such an article?
10474    ((and (gnus-summary-search-forward unread subject backward)
10475          (or (gnus-summary-display-article (gnus-summary-article-number))
10476              (eq (gnus-summary-article-mark) gnus-canceled-mark)))
10477     (gnus-summary-position-point))
10478    ;; If not, we try the first unread, if that is wanted.
10479    ((and subject
10480          gnus-auto-select-same
10481          (gnus-summary-first-unread-article))
10482     (gnus-summary-position-point)
10483     (gnus-message 6 "Wrapped"))
10484    ;; Try to get next/previous article not displayed in this group.
10485    ((and gnus-auto-extend-newsgroup
10486          (not unread) (not subject))
10487     (gnus-summary-goto-article
10488      (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
10489      nil t))
10490    ;; Go to next/previous group.
10491    (t
10492     (or (gnus-ephemeral-group-p gnus-newsgroup-name)
10493         (gnus-summary-jump-to-group gnus-newsgroup-name))
10494     (let ((cmd last-command-char)
10495           (group
10496            (if (eq gnus-keep-same-level 'best)
10497                (gnus-summary-best-group gnus-newsgroup-name)
10498              (gnus-summary-search-group backward gnus-keep-same-level))))
10499       ;; For some reason, the group window gets selected.  We change
10500       ;; it back.
10501       (select-window (get-buffer-window (current-buffer)))
10502       ;; Select next unread newsgroup automagically.
10503       (cond
10504        ((or (not gnus-auto-select-next)
10505             (not cmd))
10506         (gnus-message 7 "No more%s articles" (if unread " unread" "")))
10507        ((or (eq gnus-auto-select-next 'quietly)
10508             (and (eq gnus-auto-select-next 'slightly-quietly)
10509                  push)
10510             (and (eq gnus-auto-select-next 'almost-quietly)
10511                  (gnus-summary-last-article-p)))
10512         ;; Select quietly.
10513         (if (gnus-ephemeral-group-p gnus-newsgroup-name)
10514             (gnus-summary-exit)
10515           (gnus-message 7 "No more%s articles (%s)..."
10516                         (if unread " unread" "")
10517                         (if group (concat "selecting " group)
10518                           "exiting"))
10519           (gnus-summary-next-group nil group backward)))
10520        (t
10521         (gnus-summary-walk-group-buffer
10522          gnus-newsgroup-name cmd unread backward)))))))
10523
10524 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
10525   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
10526                       (?\C-p (gnus-group-prev-unread-group 1))))
10527         keve key group ended)
10528     (save-excursion
10529       (set-buffer gnus-group-buffer)
10530       (gnus-summary-jump-to-group from-group)
10531       (setq group
10532             (if (eq gnus-keep-same-level 'best)
10533                 (gnus-summary-best-group gnus-newsgroup-name)
10534               (gnus-summary-search-group backward gnus-keep-same-level))))
10535     (while (not ended)
10536       (gnus-message
10537        5 "No more%s articles%s" (if unread " unread" "")
10538        (if (and group
10539                 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
10540            (format " (Type %s for %s [%s])"
10541                    (single-key-description cmd) group
10542                    (car (gnus-gethash group gnus-newsrc-hashtb)))
10543          (format " (Type %s to exit %s)"
10544                  (single-key-description cmd)
10545                  gnus-newsgroup-name)))
10546       ;; Confirm auto selection.
10547       (setq key (car (setq keve (gnus-read-event-char))))
10548       (setq ended t)
10549       (cond
10550        ((assq key keystrokes)
10551         (let ((obuf (current-buffer)))
10552           (switch-to-buffer gnus-group-buffer)
10553           (and group
10554                (gnus-group-jump-to-group group))
10555           (eval (cadr (assq key keystrokes)))
10556           (setq group (gnus-group-group-name))
10557           (switch-to-buffer obuf))
10558         (setq ended nil))
10559        ((equal key cmd)
10560         (if (or (not group)
10561                 (gnus-ephemeral-group-p gnus-newsgroup-name))
10562             (gnus-summary-exit)
10563           (gnus-summary-next-group nil group backward)))
10564        (t
10565         (push (cdr keve) unread-command-events))))))
10566
10567 (defun gnus-read-event-char ()
10568   "Get the next event."
10569   (let ((event (read-event)))
10570     (cons (and (numberp event) event) event)))
10571
10572 (defun gnus-summary-next-unread-article ()
10573   "Select unread article after current one."
10574   (interactive)
10575   (gnus-summary-next-article t (and gnus-auto-select-same
10576                                     (gnus-summary-article-subject))))
10577
10578 (defun gnus-summary-prev-article (&optional unread subject)
10579   "Select the article after the current one.
10580 If UNREAD is non-nil, only unread articles are selected."
10581   (interactive "P")
10582   (gnus-summary-next-article unread subject t))
10583
10584 (defun gnus-summary-prev-unread-article ()
10585   "Select unred article before current one."
10586   (interactive)
10587   (gnus-summary-prev-article t (and gnus-auto-select-same
10588                                     (gnus-summary-article-subject))))
10589
10590 (defun gnus-summary-next-page (&optional lines circular)
10591   "Show next page of the selected article.
10592 If at the end of the current article, select the next article.
10593 LINES says how many lines should be scrolled up.
10594
10595 If CIRCULAR is non-nil, go to the start of the article instead of
10596 selecting the next article when reaching the end of the current
10597 article."
10598   (interactive "P")
10599   (setq gnus-summary-buffer (current-buffer))
10600   (gnus-set-global-variables)
10601   (let ((article (gnus-summary-article-number))
10602         (endp nil))
10603     (gnus-configure-windows 'article)
10604     (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
10605         (if (and (eq gnus-summary-goto-unread 'never)
10606                  (not (gnus-summary-last-article-p article)))
10607             (gnus-summary-next-article)
10608           (gnus-summary-next-unread-article))
10609       (if (or (null gnus-current-article)
10610               (null gnus-article-current)
10611               (/= article (cdr gnus-article-current))
10612               (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10613           ;; Selected subject is different from current article's.
10614           (gnus-summary-display-article article)
10615         (gnus-eval-in-buffer-window gnus-article-buffer
10616           (setq endp (gnus-article-next-page lines)))
10617         (if endp
10618             (cond (circular
10619                    (gnus-summary-beginning-of-article))
10620                   (lines
10621                    (gnus-message 3 "End of message"))
10622                   ((null lines)
10623                    (if (and (eq gnus-summary-goto-unread 'never)
10624                             (not (gnus-summary-last-article-p article)))
10625                        (gnus-summary-next-article)
10626                      (gnus-summary-next-unread-article)))))))
10627     (gnus-summary-recenter)
10628     (gnus-summary-position-point)))
10629
10630 (defun gnus-summary-prev-page (&optional lines)
10631   "Show previous page of selected article.
10632 Argument LINES specifies lines to be scrolled down."
10633   (interactive "P")
10634   (gnus-set-global-variables)
10635   (let ((article (gnus-summary-article-number)))
10636     (gnus-configure-windows 'article)
10637     (if (or (null gnus-current-article)
10638             (null gnus-article-current)
10639             (/= article (cdr gnus-article-current))
10640             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10641         ;; Selected subject is different from current article's.
10642         (gnus-summary-display-article article)
10643       (gnus-summary-recenter)
10644       (gnus-eval-in-buffer-window gnus-article-buffer
10645         (gnus-article-prev-page lines))))
10646   (gnus-summary-position-point))
10647
10648 (defun gnus-summary-scroll-up (lines)
10649   "Scroll up (or down) one line current article.
10650 Argument LINES specifies lines to be scrolled up (or down if negative)."
10651   (interactive "p")
10652   (gnus-set-global-variables)
10653   (gnus-configure-windows 'article)
10654   (gnus-summary-show-thread)
10655   (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
10656     (gnus-eval-in-buffer-window gnus-article-buffer
10657       (cond ((> lines 0)
10658              (if (gnus-article-next-page lines)
10659                  (gnus-message 3 "End of message")))
10660             ((< lines 0)
10661              (gnus-article-prev-page (- lines))))))
10662   (gnus-summary-recenter)
10663   (gnus-summary-position-point))
10664
10665 (defun gnus-summary-next-same-subject ()
10666   "Select next article which has the same subject as current one."
10667   (interactive)
10668   (gnus-set-global-variables)
10669   (gnus-summary-next-article nil (gnus-summary-article-subject)))
10670
10671 (defun gnus-summary-prev-same-subject ()
10672   "Select previous article which has the same subject as current one."
10673   (interactive)
10674   (gnus-set-global-variables)
10675   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
10676
10677 (defun gnus-summary-next-unread-same-subject ()
10678   "Select next unread article which has the same subject as current one."
10679   (interactive)
10680   (gnus-set-global-variables)
10681   (gnus-summary-next-article t (gnus-summary-article-subject)))
10682
10683 (defun gnus-summary-prev-unread-same-subject ()
10684   "Select previous unread article which has the same subject as current one."
10685   (interactive)
10686   (gnus-set-global-variables)
10687   (gnus-summary-prev-article t (gnus-summary-article-subject)))
10688
10689 (defun gnus-summary-first-unread-article ()
10690   "Select the first unread article.
10691 Return nil if there are no unread articles."
10692   (interactive)
10693   (gnus-set-global-variables)
10694   (prog1
10695       (if (gnus-summary-first-subject t)
10696           (progn
10697             (gnus-summary-show-thread)
10698             (gnus-summary-first-subject t)
10699             (gnus-summary-display-article (gnus-summary-article-number))))
10700     (gnus-summary-position-point)))
10701
10702 (defun gnus-summary-best-unread-article ()
10703   "Select the unread article with the highest score."
10704   (interactive)
10705   (gnus-set-global-variables)
10706   (let ((best -1000000)
10707         (data gnus-newsgroup-data)
10708         article score)
10709     (while data
10710       (and (gnus-data-unread-p (car data))
10711            (> (setq score
10712                     (gnus-summary-article-score (gnus-data-number (car data))))
10713               best)
10714            (setq best score
10715                  article (gnus-data-number (car data))))
10716       (setq data (cdr data)))
10717     (prog1
10718         (if article
10719             (gnus-summary-goto-article article)
10720           (error "No unread articles"))
10721       (gnus-summary-position-point))))
10722
10723 (defun gnus-summary-last-subject ()
10724   "Go to the last displayed subject line in the group."
10725   (let ((article (gnus-data-number (car (gnus-data-list t)))))
10726     (when article
10727       (gnus-summary-goto-subject article))))
10728
10729 (defun gnus-summary-goto-article (article &optional all-headers force)
10730   "Fetch ARTICLE and display it if it exists.
10731 If ALL-HEADERS is non-nil, no header lines are hidden."
10732   (interactive
10733    (list
10734     (string-to-int
10735      (completing-read
10736       "Article number: "
10737       (mapcar (lambda (number) (list (int-to-string number)))
10738               gnus-newsgroup-limit)))
10739     current-prefix-arg
10740     t))
10741   (prog1
10742       (if (gnus-summary-goto-subject article force)
10743           (gnus-summary-display-article article all-headers)
10744         (gnus-message 4 "Couldn't go to article %s" article) nil)
10745     (gnus-summary-position-point)))
10746
10747 (defun gnus-summary-goto-last-article ()
10748   "Go to the previously read article."
10749   (interactive)
10750   (prog1
10751       (and gnus-last-article
10752            (gnus-summary-goto-article gnus-last-article))
10753     (gnus-summary-position-point)))
10754
10755 (defun gnus-summary-pop-article (number)
10756   "Pop one article off the history and go to the previous.
10757 NUMBER articles will be popped off."
10758   (interactive "p")
10759   (let (to)
10760     (setq gnus-newsgroup-history
10761           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
10762     (if to
10763         (gnus-summary-goto-article (car to))
10764       (error "Article history empty")))
10765   (gnus-summary-position-point))
10766
10767 ;; Summary commands and functions for limiting the summary buffer.
10768
10769 (defun gnus-summary-limit-to-articles (n)
10770   "Limit the summary buffer to the next N articles.
10771 If not given a prefix, use the process marked articles instead."
10772   (interactive "P")
10773   (gnus-set-global-variables)
10774   (prog1
10775       (let ((articles (gnus-summary-work-articles n)))
10776         (setq gnus-newsgroup-processable nil)
10777         (gnus-summary-limit articles))
10778     (gnus-summary-position-point)))
10779
10780 (defun gnus-summary-pop-limit (&optional total)
10781   "Restore the previous limit.
10782 If given a prefix, remove all limits."
10783   (interactive "P")
10784   (gnus-set-global-variables)
10785   (when total 
10786     (setq gnus-newsgroup-limits
10787           (list (mapcar (lambda (h) (mail-header-number h))
10788                         gnus-newsgroup-headers))))
10789   (unless gnus-newsgroup-limits
10790     (error "No limit to pop"))
10791   (prog1
10792       (gnus-summary-limit nil 'pop)
10793     (gnus-summary-position-point)))
10794
10795 (defun gnus-summary-limit-to-subject (subject &optional header)
10796   "Limit the summary buffer to articles that have subjects that match a regexp."
10797   (interactive "sRegexp: ")
10798   (unless header
10799     (setq header "subject"))
10800   (when (not (equal "" subject))
10801     (prog1
10802         (let ((articles (gnus-summary-find-matching
10803                          (or header "subject") subject 'all)))
10804           (or articles (error "Found no matches for \"%s\"" subject))
10805           (gnus-summary-limit articles))
10806       (gnus-summary-position-point))))
10807
10808 (defun gnus-summary-limit-to-author (from)
10809   "Limit the summary buffer to articles that have authors that match a regexp."
10810   (interactive "sRegexp: ")
10811   (gnus-summary-limit-to-subject from "from"))
10812
10813 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10814 (make-obsolete
10815  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10816
10817 (defun gnus-summary-limit-to-unread (&optional all)
10818   "Limit the summary buffer to articles that are not marked as read.
10819 If ALL is non-nil, limit strictly to unread articles."
10820   (interactive "P")
10821   (if all
10822       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
10823     (gnus-summary-limit-to-marks
10824      ;; Concat all the marks that say that an article is read and have
10825      ;; those removed.
10826      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
10827            gnus-killed-mark gnus-kill-file-mark
10828            gnus-low-score-mark gnus-expirable-mark
10829            gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark)
10830      'reverse)))
10831
10832 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10833 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10834
10835 (defun gnus-summary-limit-to-marks (marks &optional reverse)
10836   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
10837 If REVERSE, limit the summary buffer to articles that are not marked
10838 with MARKS.  MARKS can either be a string of marks or a list of marks.
10839 Returns how many articles were removed."
10840   (interactive "sMarks: ")
10841   (gnus-set-global-variables)
10842   (prog1
10843       (let ((data gnus-newsgroup-data)
10844             (marks (if (listp marks) marks
10845                      (append marks nil))) ; Transform to list.
10846             articles)
10847         (while data
10848           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
10849                  (memq (gnus-data-mark (car data)) marks))
10850                (setq articles (cons (gnus-data-number (car data)) articles)))
10851           (setq data (cdr data)))
10852         (gnus-summary-limit articles))
10853     (gnus-summary-position-point)))
10854
10855 (defun gnus-summary-limit-to-score (&optional score)
10856   "Limit to articles with score at or above SCORE."
10857   (interactive "P")
10858   (gnus-set-global-variables)
10859   (setq score (if score
10860                   (prefix-numeric-value score)
10861                 (or gnus-summary-default-score 0)))
10862   (let ((data gnus-newsgroup-data)
10863         articles)
10864     (while data
10865       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
10866                 score)
10867         (push (gnus-data-number (car data)) articles))
10868       (setq data (cdr data)))
10869     (prog1
10870         (gnus-summary-limit articles)
10871       (gnus-summary-position-point))))
10872
10873 (defun gnus-summary-limit-include-dormant ()
10874   "Display all the hidden articles that are marked as dormant."
10875   (interactive)
10876   (gnus-set-global-variables)
10877   (or gnus-newsgroup-dormant
10878       (error "There are no dormant articles in this group"))
10879   (prog1
10880       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
10881     (gnus-summary-position-point)))
10882
10883 (defun gnus-summary-limit-exclude-dormant ()
10884   "Hide all dormant articles."
10885   (interactive)
10886   (gnus-set-global-variables)
10887   (prog1
10888       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
10889     (gnus-summary-position-point)))
10890
10891 (defun gnus-summary-limit-exclude-childless-dormant ()
10892   "Hide all dormant articles that have no children."
10893   (interactive)
10894   (gnus-set-global-variables)
10895   (let ((data (gnus-data-list t))
10896         articles d children)
10897     ;; Find all articles that are either not dormant or have
10898     ;; children.
10899     (while (setq d (pop data))
10900       (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
10901                 (and (setq children 
10902                            (gnus-article-children (gnus-data-number d)))
10903                      (let (found)
10904                        (while children
10905                          (when (memq (car children) articles)
10906                            (setq children nil
10907                                  found t))
10908                          (pop children))
10909                        found)))
10910         (push (gnus-data-number d) articles)))
10911     ;; Do the limiting.
10912     (prog1
10913         (gnus-summary-limit articles)
10914       (gnus-summary-position-point))))
10915
10916 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
10917   "Mark all unread excluded articles as read.
10918 If ALL, mark even excluded ticked and dormants as read."
10919   (interactive "P")
10920   (let ((articles (gnus-sorted-complement
10921                    (sort
10922                     (mapcar (lambda (h) (mail-header-number h))
10923                             gnus-newsgroup-headers)
10924                     '<)
10925                    (sort gnus-newsgroup-limit '<)))
10926         article)
10927     (setq gnus-newsgroup-unreads nil)
10928     (if all
10929         (setq gnus-newsgroup-dormant nil
10930               gnus-newsgroup-marked nil
10931               gnus-newsgroup-reads
10932               (nconc
10933                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
10934                gnus-newsgroup-reads))
10935       (while (setq article (pop articles))
10936         (unless (or (memq article gnus-newsgroup-dormant)
10937                     (memq article gnus-newsgroup-marked))
10938           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
10939
10940 (defun gnus-summary-limit (articles &optional pop)
10941   (if pop
10942       ;; We pop the previous limit off the stack and use that.
10943       (setq articles (car gnus-newsgroup-limits)
10944             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
10945     ;; We use the new limit, so we push the old limit on the stack.
10946     (setq gnus-newsgroup-limits
10947           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
10948   ;; Set the limit.
10949   (setq gnus-newsgroup-limit articles)
10950   (let ((total (length gnus-newsgroup-data))
10951         (data (gnus-data-find-list (gnus-summary-article-number)))
10952         (gnus-summary-mark-below nil)   ; Inhibit this.
10953         found)
10954     ;; This will do all the work of generating the new summary buffer
10955     ;; according to the new limit.
10956     (gnus-summary-prepare)
10957     ;; Hide any threads, possibly.
10958     (and gnus-show-threads
10959          gnus-thread-hide-subtree
10960          (gnus-summary-hide-all-threads))
10961     ;; Try to return to the article you were at, or one in the
10962     ;; neighborhood.
10963     (if data
10964         ;; We try to find some article after the current one.
10965         (while data
10966           (and (gnus-summary-goto-subject
10967                 (gnus-data-number (car data)) nil t)
10968                (setq data nil
10969                      found t))
10970           (setq data (cdr data))))
10971     (or found
10972         ;; If there is no data, that means that we were after the last
10973         ;; article.  The same goes when we can't find any articles
10974         ;; after the current one.
10975         (progn
10976           (goto-char (point-max))
10977           (gnus-summary-find-prev)))
10978     ;; We return how many articles were removed from the summary
10979     ;; buffer as a result of the new limit.
10980     (- total (length gnus-newsgroup-data))))
10981
10982 (defsubst gnus-invisible-cut-children (threads)
10983   (let ((num 0))
10984     (while threads
10985       (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
10986         (incf num))
10987       (pop threads))
10988     (< num 2)))
10989
10990 (defsubst gnus-cut-thread (thread)
10991   "Go forwards in the thread until we find an article that we want to display."
10992   (when (or (eq gnus-fetch-old-headers 'some)
10993             (eq gnus-build-sparse-threads 'some)
10994             (eq gnus-build-sparse-threads 'more))
10995     ;; Deal with old-fetched headers and sparse threads.
10996     (while (and
10997             thread
10998             (or
10999              (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
11000              (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
11001             (or (<= (length (cdr thread)) 1)
11002                 (gnus-invisible-cut-children (cdr thread))))
11003       (setq thread (cadr thread))))
11004   thread)
11005
11006 (defun gnus-cut-threads (threads)
11007   "Cut off all uninteresting articles from the beginning of threads."
11008   (when (or (eq gnus-fetch-old-headers 'some)
11009             (eq gnus-build-sparse-threads 'some)
11010             (eq gnus-build-sparse-threads 'more))
11011     (let ((th threads))
11012       (while th
11013         (setcar th (gnus-cut-thread (car th)))
11014         (setq th (cdr th)))))
11015   ;; Remove nixed out threads.
11016   (delq nil threads))
11017
11018 (defun gnus-summary-initial-limit (&optional show-if-empty)
11019   "Figure out what the initial limit is supposed to be on group entry.
11020 This entails weeding out unwanted dormants, low-scored articles,
11021 fetch-old-headers verbiage, and so on."
11022   ;; Most groups have nothing to remove.
11023   (if (or gnus-inhibit-limiting
11024           (and (null gnus-newsgroup-dormant)
11025                (not (eq gnus-fetch-old-headers 'some))
11026                (null gnus-summary-expunge-below)
11027                (not (eq gnus-build-sparse-threads 'some))
11028                (not (eq gnus-build-sparse-threads 'more))
11029                (null gnus-thread-expunge-below)
11030                (not gnus-use-nocem)))
11031       () ; Do nothing.
11032     (push gnus-newsgroup-limit gnus-newsgroup-limits)
11033     (setq gnus-newsgroup-limit nil)
11034     (mapatoms
11035      (lambda (node)
11036        (unless (car (symbol-value node))
11037          ;; These threads have no parents -- they are roots.
11038          (let ((nodes (cdr (symbol-value node)))
11039                thread)
11040            (while nodes
11041              (if (and gnus-thread-expunge-below
11042                       (< (gnus-thread-total-score (car nodes))
11043                          gnus-thread-expunge-below))
11044                  (gnus-expunge-thread (pop nodes))
11045                (setq thread (pop nodes))
11046                (gnus-summary-limit-children thread))))))
11047      gnus-newsgroup-dependencies)
11048     ;; If this limitation resulted in an empty group, we might
11049     ;; pop the previous limit and use it instead.
11050     (when (and (not gnus-newsgroup-limit)
11051                show-if-empty)
11052       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
11053     gnus-newsgroup-limit))
11054
11055 (defun gnus-summary-limit-children (thread)
11056   "Return 1 if this subthread is visible and 0 if it is not."
11057   ;; First we get the number of visible children to this thread.  This
11058   ;; is done by recursing down the thread using this function, so this
11059   ;; will really go down to a leaf article first, before slowly
11060   ;; working its way up towards the root.
11061   (when thread
11062     (let ((children
11063            (if (cdr thread)
11064                (apply '+ (mapcar 'gnus-summary-limit-children
11065                                  (cdr thread)))
11066              0))
11067           (number (mail-header-number (car thread)))
11068           score)
11069       (if (or
11070            ;; If this article is dormant and has absolutely no visible
11071            ;; children, then this article isn't visible.
11072            (and (memq number gnus-newsgroup-dormant)
11073                 (= children 0))
11074            ;; If this is "fetch-old-headered" and there is only one
11075            ;; visible child (or less), then we don't want this article.
11076            (and (eq gnus-fetch-old-headers 'some)
11077                 (memq number gnus-newsgroup-ancient)
11078                 (zerop children))
11079            ;; If this is a sparsely inserted article with no children,
11080            ;; we don't want it.
11081            (and (eq gnus-build-sparse-threads 'some)
11082                 (memq number gnus-newsgroup-sparse)
11083                 (zerop children))
11084            ;; If we use expunging, and this article is really
11085            ;; low-scored, then we don't want this article.
11086            (when (and gnus-summary-expunge-below
11087                       (< (setq score
11088                                (or (cdr (assq number gnus-newsgroup-scored))
11089                                    gnus-summary-default-score))
11090                          gnus-summary-expunge-below))
11091              ;; We increase the expunge-tally here, but that has
11092              ;; nothing to do with the limits, really.
11093              (incf gnus-newsgroup-expunged-tally)
11094              ;; We also mark as read here, if that's wanted.
11095              (when (and gnus-summary-mark-below
11096                         (< score gnus-summary-mark-below))
11097                (setq gnus-newsgroup-unreads
11098                      (delq number gnus-newsgroup-unreads))
11099                (if gnus-newsgroup-auto-expire
11100                    (push number gnus-newsgroup-expirable)
11101                  (push (cons number gnus-low-score-mark)
11102                        gnus-newsgroup-reads)))
11103              t)
11104            (and gnus-use-nocem
11105                 (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))))
11106           ;; Nope, invisible article.
11107           0
11108         ;; Ok, this article is to be visible, so we add it to the limit
11109         ;; and return 1.
11110         (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
11111         1))))
11112
11113 (defun gnus-expunge-thread (thread)
11114   "Mark all articles in THREAD as read."
11115   (let* ((number (mail-header-number (car thread))))
11116     (incf gnus-newsgroup-expunged-tally)
11117     ;; We also mark as read here, if that's wanted.
11118     (setq gnus-newsgroup-unreads
11119           (delq number gnus-newsgroup-unreads))
11120     (if gnus-newsgroup-auto-expire
11121         (push number gnus-newsgroup-expirable)
11122       (push (cons number gnus-low-score-mark)
11123             gnus-newsgroup-reads)))
11124   ;; Go recursively through all subthreads.
11125   (mapcar 'gnus-expunge-thread (cdr thread)))
11126
11127 ;; Summary article oriented commands
11128
11129 (defun gnus-summary-refer-parent-article (n)
11130   "Refer parent article N times.
11131 The difference between N and the number of articles fetched is returned."
11132   (interactive "p")
11133   (gnus-set-global-variables)
11134   (while
11135       (and
11136        (> n 0)
11137        (let* ((header (gnus-summary-article-header))
11138               (ref
11139                ;; If we try to find the parent of the currently
11140                ;; displayed article, then we take a look at the actual
11141                ;; References header, since this is slightly more
11142                ;; reliable than the References field we got from the
11143                ;; server.
11144                (if (and (eq (mail-header-number header)
11145                             (cdr gnus-article-current))
11146                         (equal gnus-newsgroup-name
11147                                (car gnus-article-current)))
11148                    (save-excursion
11149                      (set-buffer gnus-original-article-buffer)
11150                      (nnheader-narrow-to-headers)
11151                      (prog1
11152                          (message-fetch-field "references")
11153                        (widen)))
11154                  ;; It's not the current article, so we take a bet on
11155                  ;; the value we got from the server.
11156                  (mail-header-references header))))
11157          (if (setq ref (or ref (mail-header-references header)))
11158              (or (gnus-summary-refer-article (gnus-parent-id ref))
11159                  (gnus-message 1 "Couldn't find parent"))
11160            (gnus-message 1 "No references in article %d"
11161                          (gnus-summary-article-number))
11162            nil)))
11163     (setq n (1- n)))
11164   (gnus-summary-position-point)
11165   n)
11166
11167 (defun gnus-summary-refer-references ()
11168   "Fetch all articles mentioned in the References header.
11169 Return how many articles were fetched."
11170   (interactive)
11171   (gnus-set-global-variables)
11172   (let ((ref (mail-header-references (gnus-summary-article-header)))
11173         (current (gnus-summary-article-number))
11174         (n 0))
11175     ;; For each Message-ID in the References header...
11176     (while (string-match "<[^>]*>" ref)
11177       (incf n)
11178       ;; ... fetch that article.
11179       (gnus-summary-refer-article
11180        (prog1 (match-string 0 ref)
11181          (setq ref (substring ref (match-end 0))))))
11182     (gnus-summary-goto-subject current)
11183     (gnus-summary-position-point)
11184     n))
11185
11186 (defun gnus-summary-refer-article (message-id)
11187   "Fetch an article specified by MESSAGE-ID."
11188   (interactive "sMessage-ID: ")
11189   (when (and (stringp message-id)
11190              (not (zerop (length message-id))))
11191     ;; Construct the correct Message-ID if necessary.
11192     ;; Suggested by tale@pawl.rpi.edu.
11193     (unless (string-match "^<" message-id)
11194       (setq message-id (concat "<" message-id)))
11195     (unless (string-match ">$" message-id)
11196       (setq message-id (concat message-id ">")))
11197     (let* ((header (gnus-id-to-header message-id))
11198            (sparse (and header
11199                         (memq (mail-header-number header)
11200                               gnus-newsgroup-sparse))))
11201       (if header
11202           (prog1
11203               ;; The article is present in the buffer, to we just go to it.
11204               (gnus-summary-goto-article 
11205                (mail-header-number header) nil header)
11206             (when sparse
11207               (gnus-summary-update-article (mail-header-number header))))
11208         ;; We fetch the article
11209         (let ((gnus-override-method 
11210                (and (gnus-news-group-p gnus-newsgroup-name)
11211                     gnus-refer-article-method))
11212               number)
11213           ;; Start the special refer-article method, if necessary.
11214           (when (and gnus-refer-article-method
11215                      (gnus-news-group-p gnus-newsgroup-name))
11216             (gnus-check-server gnus-refer-article-method))
11217           ;; Fetch the header, and display the article.
11218           (if (setq number (gnus-summary-insert-subject message-id))
11219               (gnus-summary-select-article nil nil nil number)
11220             (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
11221
11222 (defun gnus-summary-enter-digest-group (&optional force)
11223   "Enter a digest group based on the current article."
11224   (interactive "P")
11225   (gnus-set-global-variables)
11226   (gnus-summary-select-article)
11227   (let ((name (format "%s-%d"
11228                       (gnus-group-prefixed-name
11229                        gnus-newsgroup-name (list 'nndoc ""))
11230                       gnus-current-article))
11231         (ogroup gnus-newsgroup-name)
11232         (case-fold-search t)
11233         (buf (current-buffer))
11234         dig)
11235     (save-excursion
11236       (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
11237       (insert-buffer-substring gnus-original-article-buffer)
11238       (narrow-to-region
11239        (goto-char (point-min))
11240        (or (search-forward "\n\n" nil t) (point)))
11241       (goto-char (point-min))
11242       (delete-matching-lines "^\\(Path\\):\\|^From ")
11243       (widen))
11244     (unwind-protect
11245         (if (gnus-group-read-ephemeral-group
11246              name `(nndoc ,name (nndoc-address
11247                                  ,(get-buffer dig))
11248                           (nndoc-article-type ,(if force 'digest 'guess))) t)
11249             ;; Make all postings to this group go to the parent group.
11250             (nconc (gnus-info-params (gnus-get-info name))
11251                    (list (cons 'to-group ogroup)))
11252           ;; Couldn't select this doc group.
11253           (switch-to-buffer buf)
11254           (gnus-set-global-variables)
11255           (gnus-configure-windows 'summary)
11256           (gnus-message 3 "Article couldn't be entered?"))
11257       (kill-buffer dig))))
11258
11259 (defun gnus-summary-isearch-article (&optional regexp-p)
11260   "Do incremental search forward on the current article.
11261 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
11262   (interactive "P")
11263   (gnus-set-global-variables)
11264   (gnus-summary-select-article)
11265   (gnus-configure-windows 'article)
11266   (gnus-eval-in-buffer-window gnus-article-buffer
11267     ;;(goto-char (point-min))
11268     (isearch-forward regexp-p)))
11269
11270 (defun gnus-summary-search-article-forward (regexp &optional backward)
11271   "Search for an article containing REGEXP forward.
11272 If BACKWARD, search backward instead."
11273   (interactive
11274    (list (read-string
11275           (format "Search article %s (regexp%s): "
11276                   (if current-prefix-arg "backward" "forward")
11277                   (if gnus-last-search-regexp
11278                       (concat ", default " gnus-last-search-regexp)
11279                     "")))
11280          current-prefix-arg))
11281   (gnus-set-global-variables)
11282   (if (string-equal regexp "")
11283       (setq regexp (or gnus-last-search-regexp ""))
11284     (setq gnus-last-search-regexp regexp))
11285   (unless (gnus-summary-search-article regexp backward)
11286     (error "Search failed: \"%s\"" regexp)))
11287
11288 (defun gnus-summary-search-article-backward (regexp)
11289   "Search for an article containing REGEXP backward."
11290   (interactive
11291    (list (read-string
11292           (format "Search article backward (regexp%s): "
11293                   (if gnus-last-search-regexp
11294                       (concat ", default " gnus-last-search-regexp)
11295                     "")))))
11296   (gnus-summary-search-article-forward regexp 'backward))
11297
11298 (defun gnus-summary-search-article (regexp &optional backward)
11299   "Search for an article containing REGEXP.
11300 Optional argument BACKWARD means do search for backward.
11301 `gnus-select-article-hook' is not called during the search."
11302   (let ((gnus-select-article-hook nil)  ;Disable hook.
11303         (gnus-article-display-hook nil)
11304         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
11305         (re-search
11306          (if backward
11307              're-search-backward 're-search-forward))
11308         (sum (current-buffer))
11309         (found nil))
11310     (gnus-save-hidden-threads
11311       (gnus-summary-select-article)
11312       (set-buffer gnus-article-buffer)
11313       (when backward
11314         (forward-line -1))
11315       (while (not found)
11316         (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
11317         (if (if backward
11318                 (re-search-backward regexp nil t)
11319               (re-search-forward regexp nil t))
11320             ;; We found the regexp.
11321             (progn
11322               (setq found 'found)
11323               (beginning-of-line)
11324               (set-window-start
11325                (get-buffer-window (current-buffer))
11326                (point))
11327               (forward-line 1)
11328               (set-buffer sum))
11329           ;; We didn't find it, so we go to the next article.
11330           (set-buffer sum)
11331           (if (not (if backward (gnus-summary-find-prev)
11332                      (gnus-summary-find-next)))
11333               ;; No more articles.
11334               (setq found t)
11335             ;; Select the next article and adjust point.
11336             (gnus-summary-select-article)
11337             (set-buffer gnus-article-buffer)
11338             (widen)
11339             (goto-char (if backward (point-max) (point-min))))))
11340       (gnus-message 7 ""))
11341     ;; Return whether we found the regexp.
11342     (when (eq found 'found)
11343       (gnus-summary-show-thread)
11344       (gnus-summary-goto-subject gnus-current-article)
11345       (gnus-summary-position-point)
11346       t)))
11347
11348 (defun gnus-summary-find-matching (header regexp &optional backward unread
11349                                           not-case-fold)
11350   "Return a list of all articles that match REGEXP on HEADER.
11351 The search stars on the current article and goes forwards unless
11352 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
11353 If UNREAD is non-nil, only unread articles will
11354 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
11355 in the comparisons."
11356   (let ((data (if (eq backward 'all) gnus-newsgroup-data
11357                 (gnus-data-find-list
11358                  (gnus-summary-article-number) (gnus-data-list backward))))
11359         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
11360         (case-fold-search (not not-case-fold))
11361         articles d)
11362     (or (fboundp (intern (concat "mail-header-" header)))
11363         (error "%s is not a valid header" header))
11364     (while data
11365       (setq d (car data))
11366       (and (or (not unread)             ; We want all articles...
11367                (gnus-data-unread-p d))  ; Or just unreads.
11368            (vectorp (gnus-data-header d)) ; It's not a pseudo.
11369            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
11370            (setq articles (cons (gnus-data-number d) articles))) ; Success!
11371       (setq data (cdr data)))
11372     (nreverse articles)))
11373
11374 (defun gnus-summary-execute-command (header regexp command &optional backward)
11375   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
11376 If HEADER is an empty string (or nil), the match is done on the entire
11377 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
11378   (interactive
11379    (list (let ((completion-ignore-case t))
11380            (completing-read
11381             "Header name: "
11382             (mapcar (lambda (string) (list string))
11383                     '("Number" "Subject" "From" "Lines" "Date"
11384                       "Message-ID" "Xref" "References" "Body"))
11385             nil 'require-match))
11386          (read-string "Regexp: ")
11387          (read-key-sequence "Command: ")
11388          current-prefix-arg))
11389   (when (equal header "Body")
11390     (setq header ""))
11391   (gnus-set-global-variables)
11392   ;; Hidden thread subtrees must be searched as well.
11393   (gnus-summary-show-all-threads)
11394   ;; We don't want to change current point nor window configuration.
11395   (save-excursion
11396     (save-window-excursion
11397       (gnus-message 6 "Executing %s..." (key-description command))
11398       ;; We'd like to execute COMMAND interactively so as to give arguments.
11399       (gnus-execute header regexp
11400                     `(lambda () (call-interactively ',(key-binding command)))
11401                     backward)
11402       (gnus-message 6 "Executing %s...done" (key-description command)))))
11403
11404 (defun gnus-summary-beginning-of-article ()
11405   "Scroll the article back to the beginning."
11406   (interactive)
11407   (gnus-set-global-variables)
11408   (gnus-summary-select-article)
11409   (gnus-configure-windows 'article)
11410   (gnus-eval-in-buffer-window gnus-article-buffer
11411     (widen)
11412     (goto-char (point-min))
11413     (and gnus-break-pages (gnus-narrow-to-page))))
11414
11415 (defun gnus-summary-end-of-article ()
11416   "Scroll to the end of the article."
11417   (interactive)
11418   (gnus-set-global-variables)
11419   (gnus-summary-select-article)
11420   (gnus-configure-windows 'article)
11421   (gnus-eval-in-buffer-window gnus-article-buffer
11422     (widen)
11423     (goto-char (point-max))
11424     (recenter -3)
11425     (and gnus-break-pages (gnus-narrow-to-page))))
11426
11427 (defun gnus-summary-show-article (&optional arg)
11428   "Force re-fetching of the current article.
11429 If ARG (the prefix) is non-nil, show the raw article without any
11430 article massaging functions being run."
11431   (interactive "P")
11432   (gnus-set-global-variables)
11433   (if (not arg)
11434       ;; Select the article the normal way.
11435       (gnus-summary-select-article nil 'force)
11436     ;; Bind the article treatment functions to nil.
11437     (let ((gnus-have-all-headers t)
11438           gnus-article-display-hook
11439           gnus-article-prepare-hook
11440           gnus-break-pages
11441           gnus-visual)
11442       (gnus-summary-select-article nil 'force)))
11443   (gnus-summary-goto-subject gnus-current-article)
11444 ;  (gnus-configure-windows 'article)
11445   (gnus-summary-position-point))
11446
11447 (defun gnus-summary-verbose-headers (&optional arg)
11448   "Toggle permanent full header display.
11449 If ARG is a positive number, turn header display on.
11450 If ARG is a negative number, turn header display off."
11451   (interactive "P")
11452   (gnus-set-global-variables)
11453   (gnus-summary-toggle-header arg)
11454   (setq gnus-show-all-headers
11455         (cond ((or (not (numberp arg))
11456                    (zerop arg))
11457                (not gnus-show-all-headers))
11458               ((natnump arg)
11459                t))))
11460
11461 (defun gnus-summary-toggle-header (&optional arg)
11462   "Show the headers if they are hidden, or hide them if they are shown.
11463 If ARG is a positive number, show the entire header.
11464 If ARG is a negative number, hide the unwanted header lines."
11465   (interactive "P")
11466   (gnus-set-global-variables)
11467   (save-excursion
11468     (set-buffer gnus-article-buffer)
11469     (let* ((buffer-read-only nil)
11470            (inhibit-point-motion-hooks t)
11471            (hidden (text-property-any
11472                     (goto-char (point-min)) (search-forward "\n\n")
11473                     'invisible t))
11474            e)
11475       (goto-char (point-min))
11476       (when (search-forward "\n\n" nil t)
11477         (delete-region (point-min) (1- (point))))
11478       (goto-char (point-min))
11479       (save-excursion
11480         (set-buffer gnus-original-article-buffer)
11481         (goto-char (point-min))
11482         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
11483       (insert-buffer-substring gnus-original-article-buffer 1 e)
11484       (let ((gnus-inhibit-hiding t))
11485         (run-hooks 'gnus-article-display-hook))
11486       (if (or (not hidden) (and (numberp arg) (< arg 0)))
11487           (gnus-article-hide-headers)))))
11488
11489 (defun gnus-summary-show-all-headers ()
11490   "Make all header lines visible."
11491   (interactive)
11492   (gnus-set-global-variables)
11493   (gnus-article-show-all-headers))
11494
11495 (defun gnus-summary-toggle-mime (&optional arg)
11496   "Toggle MIME processing.
11497 If ARG is a positive number, turn MIME processing on."
11498   (interactive "P")
11499   (gnus-set-global-variables)
11500   (setq gnus-show-mime
11501         (if (null arg) (not gnus-show-mime)
11502           (> (prefix-numeric-value arg) 0)))
11503   (gnus-summary-select-article t 'force))
11504
11505 (defun gnus-summary-caesar-message (&optional arg)
11506   "Caesar rotate the current article by 13.
11507 The numerical prefix specifies how manu places to rotate each letter
11508 forward."
11509   (interactive "P")
11510   (gnus-set-global-variables)
11511   (gnus-summary-select-article)
11512   (let ((mail-header-separator ""))
11513     (gnus-eval-in-buffer-window gnus-article-buffer
11514       (save-restriction
11515         (widen)
11516         (let ((start (window-start))
11517               buffer-read-only)
11518           (message-caesar-buffer-body arg)
11519           (set-window-start (get-buffer-window (current-buffer)) start))))))
11520
11521 (defun gnus-summary-stop-page-breaking ()
11522   "Stop page breaking in the current article."
11523   (interactive)
11524   (gnus-set-global-variables)
11525   (gnus-summary-select-article)
11526   (gnus-eval-in-buffer-window gnus-article-buffer
11527     (widen)))
11528
11529 (defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
11530   "Move the current article to a different newsgroup.
11531 If N is a positive number, move the N next articles.
11532 If N is a negative number, move the N previous articles.
11533 If N is nil and any articles have been marked with the process mark,
11534 move those articles instead.
11535 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11536 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
11537 re-spool using this method.
11538
11539 For this function to work, both the current newsgroup and the
11540 newsgroup that you want to move to have to support the `request-move'
11541 and `request-accept' functions."
11542   (interactive "P")
11543   (unless action (setq action 'move))
11544   (gnus-set-global-variables)
11545   ;; Check whether the source group supports the required functions.
11546   (cond ((and (eq action 'move)
11547               (not (gnus-check-backend-function
11548                     'request-move-article gnus-newsgroup-name)))
11549          (error "The current group does not support article moving"))
11550         ((and (eq action 'crosspost)
11551               (not (gnus-check-backend-function
11552                     'request-replace-article gnus-newsgroup-name)))
11553          (error "The current group does not support article editing")))
11554   (let ((articles (gnus-summary-work-articles n))
11555         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
11556         (names '((move "Move" "Moving")
11557                  (copy "Copy" "Copying")
11558                  (crosspost "Crosspost" "Crossposting")))
11559         (copy-buf (save-excursion
11560                     (nnheader-set-temp-buffer " *copy article*")))
11561         art-group to-method new-xref article to-groups)
11562     (unless (assq action names)
11563       (error "Unknown action %s" action))
11564     ;; Read the newsgroup name.
11565     (when (and (not to-newsgroup)
11566                (not select-method))
11567       (setq to-newsgroup
11568             (gnus-read-move-group-name
11569              (cadr (assq action names))
11570              (symbol-value (intern (format "gnus-current-%s-group" action)))
11571              articles prefix))
11572       (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
11573     (setq to-method (or select-method 
11574                         (gnus-group-name-to-method to-newsgroup)))
11575     ;; Check the method we are to move this article to...
11576     (or (gnus-check-backend-function 'request-accept-article (car to-method))
11577         (error "%s does not support article copying" (car to-method)))
11578     (or (gnus-check-server to-method)
11579         (error "Can't open server %s" (car to-method)))
11580     (gnus-message 6 "%s to %s: %s..."
11581                   (caddr (assq action names))
11582                   (or (car select-method) to-newsgroup) articles)
11583     (while articles
11584       (setq article (pop articles))
11585       (setq
11586        art-group
11587        (cond
11588         ;; Move the article.
11589         ((eq action 'move)
11590          (gnus-request-move-article
11591           article                       ; Article to move
11592           gnus-newsgroup-name           ; From newsgrouo
11593           (nth 1 (gnus-find-method-for-group
11594                   gnus-newsgroup-name)) ; Server
11595           (list 'gnus-request-accept-article
11596                 to-newsgroup (list 'quote select-method)
11597                 (not articles))         ; Accept form
11598           (not articles)))              ; Only save nov last time
11599         ;; Copy the article.
11600         ((eq action 'copy)
11601          (save-excursion
11602            (set-buffer copy-buf)
11603            (gnus-request-article-this-buffer article gnus-newsgroup-name)
11604            (gnus-request-accept-article
11605             to-newsgroup select-method (not articles))))
11606         ;; Crosspost the article.
11607         ((eq action 'crosspost)
11608          (let ((xref (mail-header-xref (gnus-summary-article-header article))))
11609            (setq new-xref (concat gnus-newsgroup-name ":" article))
11610            (if (and xref (not (string= xref "")))
11611                (progn
11612                  (when (string-match "^Xref: " xref)
11613                    (setq xref (substring xref (match-end 0))))
11614                  (setq new-xref (concat xref " " new-xref)))
11615              (setq new-xref (concat (system-name) " " new-xref)))
11616            (save-excursion
11617              (set-buffer copy-buf)
11618              (gnus-request-article-this-buffer article gnus-newsgroup-name)
11619              (nnheader-replace-header "xref" new-xref)
11620              (gnus-request-accept-article
11621               to-newsgroup select-method (not articles)))))))
11622       (if (not art-group)
11623           (gnus-message 1 "Couldn't %s article %s"
11624                         (cadr (assq action names)) article)
11625         (let* ((entry
11626                 (or
11627                  (gnus-gethash (car art-group) gnus-newsrc-hashtb)
11628                  (gnus-gethash
11629                   (gnus-group-prefixed-name
11630                    (car art-group)
11631                    (or select-method 
11632                        (gnus-find-method-for-group to-newsgroup)))
11633                   gnus-newsrc-hashtb)))
11634                (info (nth 2 entry))
11635                (to-group (gnus-info-group info)))
11636           ;; Update the group that has been moved to.
11637           (when (and info
11638                      (memq action '(move copy)))
11639             (unless (member to-group to-groups)
11640               (push to-group to-groups))
11641
11642             (unless (memq article gnus-newsgroup-unreads)
11643               (gnus-info-set-read
11644                info (gnus-add-to-range (gnus-info-read info)
11645                                        (list (cdr art-group)))))
11646
11647             ;; Copy any marks over to the new group.
11648             (let ((marks gnus-article-mark-lists)
11649                   (to-article (cdr art-group)))
11650
11651               ;; See whether the article is to be put in the cache.
11652               (when gnus-use-cache
11653                 (gnus-cache-possibly-enter-article
11654                  to-group to-article
11655                  (let ((header (copy-sequence
11656                                 (gnus-summary-article-header article))))
11657                    (mail-header-set-number header to-article)
11658                    header)
11659                  (memq article gnus-newsgroup-marked)
11660                  (memq article gnus-newsgroup-dormant)
11661                  (memq article gnus-newsgroup-unreads)))
11662
11663               (while marks
11664                 (when (memq article (symbol-value
11665                                      (intern (format "gnus-newsgroup-%s"
11666                                                      (caar marks)))))
11667                   ;; If the other group is the same as this group,
11668                   ;; then we have to add the mark to the list.
11669                   (when (equal to-group gnus-newsgroup-name)
11670                     (set (intern (format "gnus-newsgroup-%s" (caar marks)))
11671                          (cons to-article
11672                                (symbol-value
11673                                 (intern (format "gnus-newsgroup-%s"
11674                                                 (caar marks)))))))
11675                   ;; Copy mark to other group.
11676                   (gnus-add-marked-articles
11677                    to-group (cdar marks) (list to-article) info))
11678                 (setq marks (cdr marks)))))
11679
11680           ;; Update the Xref header in this article to point to
11681           ;; the new crossposted article we have just created.
11682           (when (eq action 'crosspost)
11683             (save-excursion
11684               (set-buffer copy-buf)
11685               (gnus-request-article-this-buffer article gnus-newsgroup-name)
11686               (nnheader-replace-header
11687                "xref" (concat new-xref " " (gnus-group-prefixed-name
11688                                             (car art-group) to-method)
11689                               ":" (cdr art-group)))
11690               (gnus-request-replace-article
11691                article gnus-newsgroup-name (current-buffer)))))
11692
11693         (gnus-summary-goto-subject article)
11694         (when (eq action 'move)
11695           (gnus-summary-mark-article article gnus-canceled-mark)))
11696       (gnus-summary-remove-process-mark article))
11697     ;; Re-activate all groups that have been moved to.
11698     (while to-groups
11699       (gnus-activate-group (pop to-groups)))
11700     
11701     (gnus-kill-buffer copy-buf)
11702     (gnus-summary-position-point)
11703     (gnus-set-mode-line 'summary)))
11704
11705 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
11706   "Move the current article to a different newsgroup.
11707 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11708 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
11709 re-spool using this method."
11710   (interactive "P")
11711   (gnus-summary-move-article n nil select-method 'copy))
11712
11713 (defun gnus-summary-crosspost-article (&optional n)
11714   "Crosspost the current article to some other group."
11715   (interactive "P")
11716   (gnus-summary-move-article n nil nil 'crosspost))
11717
11718 (defvar gnus-summary-respool-default-method nil
11719   "Default method for respooling an article.  
11720 If nil, use to the current newsgroup method.")
11721
11722 (defun gnus-summary-respool-article (&optional n method)
11723   "Respool the current article.
11724 The article will be squeezed through the mail spooling process again,
11725 which means that it will be put in some mail newsgroup or other
11726 depending on `nnmail-split-methods'.
11727 If N is a positive number, respool the N next articles.
11728 If N is a negative number, respool the N previous articles.
11729 If N is nil and any articles have been marked with the process mark,
11730 respool those articles instead.
11731
11732 Respooling can be done both from mail groups and \"real\" newsgroups.
11733 In the former case, the articles in question will be moved from the
11734 current group into whatever groups they are destined to.  In the
11735 latter case, they will be copied into the relevant groups."
11736   (interactive 
11737    (list current-prefix-arg
11738          (let* ((methods (gnus-methods-using 'respool))
11739                 (methname
11740                  (symbol-name (or gnus-summary-respool-default-method
11741                                   (car (gnus-find-method-for-group
11742                                         gnus-newsgroup-name)))))
11743                 (method
11744                  (gnus-completing-read 
11745                   methname "What backend do you want to use when respooling?"
11746                   methods nil t nil 'gnus-method-history))
11747                 ms)
11748            (cond
11749             ((zerop (length (setq ms (gnus-servers-using-backend method))))
11750              (list (intern method) ""))
11751             ((= 1 (length ms))
11752              (car ms))
11753             (t
11754              (cdr (completing-read 
11755                    "Server name: "
11756                    (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t)))))))
11757   (gnus-set-global-variables)
11758   (unless method
11759     (error "No method given for respooling"))
11760   (if (assoc (symbol-name
11761               (car (gnus-find-method-for-group gnus-newsgroup-name)))
11762              (gnus-methods-using 'respool))
11763       (gnus-summary-move-article n nil method)
11764     (gnus-summary-copy-article n nil method)))
11765
11766 (defun gnus-summary-import-article (file)
11767   "Import a random file into a mail newsgroup."
11768   (interactive "fImport file: ")
11769   (gnus-set-global-variables)
11770   (let ((group gnus-newsgroup-name)
11771         (now (current-time))
11772         atts lines)
11773     (or (gnus-check-backend-function 'request-accept-article group)
11774         (error "%s does not support article importing" group))
11775     (or (file-readable-p file)
11776         (not (file-regular-p file))
11777         (error "Can't read %s" file))
11778     (save-excursion
11779       (set-buffer (get-buffer-create " *import file*"))
11780       (buffer-disable-undo (current-buffer))
11781       (erase-buffer)
11782       (insert-file-contents file)
11783       (goto-char (point-min))
11784       (unless (nnheader-article-p)
11785         ;; This doesn't look like an article, so we fudge some headers.
11786         (setq atts (file-attributes file)
11787               lines (count-lines (point-min) (point-max)))
11788         (insert "From: " (read-string "From: ") "\n"
11789                 "Subject: " (read-string "Subject: ") "\n"
11790                 "Date: " (timezone-make-date-arpa-standard
11791                           (current-time-string (nth 5 atts))
11792                           (current-time-zone now)
11793                           (current-time-zone now)) "\n"
11794                 "Message-ID: " (message-make-message-id) "\n"
11795                 "Lines: " (int-to-string lines) "\n"
11796                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
11797       (gnus-request-accept-article group nil t)
11798       (kill-buffer (current-buffer)))))
11799
11800 (defun gnus-summary-expire-articles (&optional now)
11801   "Expire all articles that are marked as expirable in the current group."
11802   (interactive)
11803   (gnus-set-global-variables)
11804   (when (gnus-check-backend-function
11805          'request-expire-articles gnus-newsgroup-name)
11806     ;; This backend supports expiry.
11807     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
11808            (expirable (if total
11809                           (gnus-list-of-read-articles gnus-newsgroup-name)
11810                         (setq gnus-newsgroup-expirable
11811                               (sort gnus-newsgroup-expirable '<))))
11812            (expiry-wait (if now 'immediate
11813                           (gnus-group-get-parameter
11814                            gnus-newsgroup-name 'expiry-wait)))
11815            es)
11816       (when expirable
11817         ;; There are expirable articles in this group, so we run them
11818         ;; through the expiry process.
11819         (gnus-message 6 "Expiring articles...")
11820         ;; The list of articles that weren't expired is returned.
11821         (if expiry-wait
11822             (let ((nnmail-expiry-wait-function nil)
11823                   (nnmail-expiry-wait expiry-wait))
11824               (setq es (gnus-request-expire-articles
11825                         expirable gnus-newsgroup-name)))
11826           (setq es (gnus-request-expire-articles
11827                     expirable gnus-newsgroup-name)))
11828         (or total (setq gnus-newsgroup-expirable es))
11829         ;; We go through the old list of expirable, and mark all
11830         ;; really expired articles as nonexistent.
11831         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
11832           (let ((gnus-use-cache nil))
11833             (while expirable
11834               (unless (memq (car expirable) es)
11835                 (when (gnus-data-find (car expirable))
11836                   (gnus-summary-mark-article
11837                    (car expirable) gnus-canceled-mark)))
11838               (setq expirable (cdr expirable)))))
11839         (gnus-message 6 "Expiring articles...done")))))
11840
11841 (defun gnus-summary-expire-articles-now ()
11842   "Expunge all expirable articles in the current group.
11843 This means that *all* articles that are marked as expirable will be
11844 deleted forever, right now."
11845   (interactive)
11846   (gnus-set-global-variables)
11847   (or gnus-expert-user
11848       (gnus-y-or-n-p
11849        "Are you really, really, really sure you want to delete all these messages? ")
11850       (error "Phew!"))
11851   (gnus-summary-expire-articles t))
11852
11853 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
11854 (defun gnus-summary-delete-article (&optional n)
11855   "Delete the N next (mail) articles.
11856 This command actually deletes articles.  This is not a marking
11857 command.  The article will disappear forever from your life, never to
11858 return.
11859 If N is negative, delete backwards.
11860 If N is nil and articles have been marked with the process mark,
11861 delete these instead."
11862   (interactive "P")
11863   (gnus-set-global-variables)
11864   (or (gnus-check-backend-function 'request-expire-articles
11865                                    gnus-newsgroup-name)
11866       (error "The current newsgroup does not support article deletion."))
11867   ;; Compute the list of articles to delete.
11868   (let ((articles (gnus-summary-work-articles n))
11869         not-deleted)
11870     (if (and gnus-novice-user
11871              (not (gnus-y-or-n-p
11872                    (format "Do you really want to delete %s forever? "
11873                            (if (> (length articles) 1) 
11874                                (format "these %s articles" (length articles))
11875                              "this article")))))
11876         ()
11877       ;; Delete the articles.
11878       (setq not-deleted (gnus-request-expire-articles
11879                          articles gnus-newsgroup-name 'force))
11880       (while articles
11881         (gnus-summary-remove-process-mark (car articles))
11882         ;; The backend might not have been able to delete the article
11883         ;; after all.
11884         (or (memq (car articles) not-deleted)
11885             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
11886         (setq articles (cdr articles))))
11887     (gnus-summary-position-point)
11888     (gnus-set-mode-line 'summary)
11889     not-deleted))
11890
11891 (defun gnus-summary-edit-article (&optional force)
11892   "Enter into a buffer and edit the current article.
11893 This will have permanent effect only in mail groups.
11894 If FORCE is non-nil, allow editing of articles even in read-only
11895 groups."
11896   (interactive "P")
11897   (save-excursion
11898     (set-buffer gnus-summary-buffer)
11899     (gnus-set-global-variables)
11900     (when (and (not force)
11901                (gnus-group-read-only-p))
11902       (error "The current newsgroup does not support article editing."))
11903     (gnus-summary-select-article t nil t)
11904     (gnus-configure-windows 'article)
11905     (select-window (get-buffer-window gnus-article-buffer))
11906     (gnus-message 6 "C-c C-c to end edits")
11907     (setq buffer-read-only nil)
11908     (text-mode)
11909     (use-local-map (copy-keymap (current-local-map)))
11910     (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
11911     (buffer-enable-undo)
11912     (widen)
11913     (goto-char (point-min))
11914     (search-forward "\n\n" nil t)))
11915
11916 (defun gnus-summary-edit-article-done ()
11917   "Make edits to the current article permanent."
11918   (interactive)
11919   (if (gnus-group-read-only-p)
11920       (progn
11921         (let ((beep (not (eq major-mode 'text-mode))))
11922           (gnus-summary-edit-article-postpone)
11923           (when beep
11924             (gnus-error
11925              3 "The current newsgroup does not support article editing."))))
11926     (let ((buf (format "%s" (buffer-string))))
11927       (erase-buffer)
11928       (insert buf)
11929       (if (not (gnus-request-replace-article
11930                 (cdr gnus-article-current) (car gnus-article-current)
11931                 (current-buffer)))
11932           (error "Couldn't replace article.")
11933         (gnus-article-mode)
11934         (use-local-map gnus-article-mode-map)
11935         (setq buffer-read-only t)
11936         (buffer-disable-undo (current-buffer))
11937         (gnus-configure-windows 'summary)
11938         (gnus-summary-update-article (cdr gnus-article-current))
11939         (when gnus-use-cache
11940           (gnus-cache-update-article    
11941            (car gnus-article-current) (cdr gnus-article-current)))
11942         (when gnus-keep-backlog
11943           (gnus-backlog-remove-article 
11944            (car gnus-article-current) (cdr gnus-article-current))))
11945       (save-excursion
11946         (when (get-buffer gnus-original-article-buffer)
11947           (set-buffer gnus-original-article-buffer)
11948           (setq gnus-original-article nil)))
11949       (setq gnus-article-current nil
11950             gnus-current-article nil)
11951       (run-hooks 'gnus-article-display-hook)
11952       (and (gnus-visual-p 'summary-highlight 'highlight)
11953            (run-hooks 'gnus-visual-mark-article-hook)))))
11954
11955 (defun gnus-summary-edit-article-postpone ()
11956   "Postpone changes to the current article."
11957   (interactive)
11958   (gnus-article-mode)
11959   (use-local-map gnus-article-mode-map)
11960   (setq buffer-read-only t)
11961   (buffer-disable-undo (current-buffer))
11962   (gnus-configure-windows 'summary)
11963   (and (gnus-visual-p 'summary-highlight 'highlight)
11964        (run-hooks 'gnus-visual-mark-article-hook)))
11965
11966 (defun gnus-summary-respool-query ()
11967   "Query where the respool algorithm would put this article."
11968   (interactive)
11969   (gnus-set-global-variables)
11970   (gnus-summary-select-article)
11971   (save-excursion
11972     (set-buffer gnus-article-buffer)
11973     (save-restriction
11974       (goto-char (point-min))
11975       (search-forward "\n\n")
11976       (narrow-to-region (point-min) (point))
11977       (pp-eval-expression
11978        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
11979
11980 ;; Summary marking commands.
11981
11982 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
11983   "Mark articles which has the same subject as read, and then select the next.
11984 If UNMARK is positive, remove any kind of mark.
11985 If UNMARK is negative, tick articles."
11986   (interactive "P")
11987   (gnus-set-global-variables)
11988   (if unmark
11989       (setq unmark (prefix-numeric-value unmark)))
11990   (let ((count
11991          (gnus-summary-mark-same-subject
11992           (gnus-summary-article-subject) unmark)))
11993     ;; Select next unread article.  If auto-select-same mode, should
11994     ;; select the first unread article.
11995     (gnus-summary-next-article t (and gnus-auto-select-same
11996                                       (gnus-summary-article-subject)))
11997     (gnus-message 7 "%d article%s marked as %s"
11998                   count (if (= count 1) " is" "s are")
11999                   (if unmark "unread" "read"))))
12000
12001 (defun gnus-summary-kill-same-subject (&optional unmark)
12002   "Mark articles which has the same subject as read.
12003 If UNMARK is positive, remove any kind of mark.
12004 If UNMARK is negative, tick articles."
12005   (interactive "P")
12006   (gnus-set-global-variables)
12007   (if unmark
12008       (setq unmark (prefix-numeric-value unmark)))
12009   (let ((count
12010          (gnus-summary-mark-same-subject
12011           (gnus-summary-article-subject) unmark)))
12012     ;; If marked as read, go to next unread subject.
12013     (if (null unmark)
12014         ;; Go to next unread subject.
12015         (gnus-summary-next-subject 1 t))
12016     (gnus-message 7 "%d articles are marked as %s"
12017                   count (if unmark "unread" "read"))))
12018
12019 (defun gnus-summary-mark-same-subject (subject &optional unmark)
12020   "Mark articles with same SUBJECT as read, and return marked number.
12021 If optional argument UNMARK is positive, remove any kinds of marks.
12022 If optional argument UNMARK is negative, mark articles as unread instead."
12023   (let ((count 1))
12024     (save-excursion
12025       (cond
12026        ((null unmark)                   ; Mark as read.
12027         (while (and
12028                 (progn
12029                   (gnus-summary-mark-article-as-read gnus-killed-mark)
12030                   (gnus-summary-show-thread) t)
12031                 (gnus-summary-find-subject subject))
12032           (setq count (1+ count))))
12033        ((> unmark 0)                    ; Tick.
12034         (while (and
12035                 (progn
12036                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
12037                   (gnus-summary-show-thread) t)
12038                 (gnus-summary-find-subject subject))
12039           (setq count (1+ count))))
12040        (t                               ; Mark as unread.
12041         (while (and
12042                 (progn
12043                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
12044                   (gnus-summary-show-thread) t)
12045                 (gnus-summary-find-subject subject))
12046           (setq count (1+ count)))))
12047       (gnus-set-mode-line 'summary)
12048       ;; Return the number of marked articles.
12049       count)))
12050
12051 (defun gnus-summary-mark-as-processable (n &optional unmark)
12052   "Set the process mark on the next N articles.
12053 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
12054 the process mark instead.  The difference between N and the actual
12055 number of articles marked is returned."
12056   (interactive "p")
12057   (gnus-set-global-variables)
12058   (let ((backward (< n 0))
12059         (n (abs n)))
12060     (while (and
12061             (> n 0)
12062             (if unmark
12063                 (gnus-summary-remove-process-mark
12064                  (gnus-summary-article-number))
12065               (gnus-summary-set-process-mark (gnus-summary-article-number)))
12066             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
12067       (setq n (1- n)))
12068     (if (/= 0 n) (gnus-message 7 "No more articles"))
12069     (gnus-summary-recenter)
12070     (gnus-summary-position-point)
12071     n))
12072
12073 (defun gnus-summary-unmark-as-processable (n)
12074   "Remove the process mark from the next N articles.
12075 If N is negative, mark backward instead.  The difference between N and
12076 the actual number of articles marked is returned."
12077   (interactive "p")
12078   (gnus-set-global-variables)
12079   (gnus-summary-mark-as-processable n t))
12080
12081 (defun gnus-summary-unmark-all-processable ()
12082   "Remove the process mark from all articles."
12083   (interactive)
12084   (gnus-set-global-variables)
12085   (save-excursion
12086     (while gnus-newsgroup-processable
12087       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
12088   (gnus-summary-position-point))
12089
12090 (defun gnus-summary-mark-as-expirable (n)
12091   "Mark N articles forward as expirable.
12092 If N is negative, mark backward instead.  The difference between N and
12093 the actual number of articles marked is returned."
12094   (interactive "p")
12095   (gnus-set-global-variables)
12096   (gnus-summary-mark-forward n gnus-expirable-mark))
12097
12098 (defun gnus-summary-mark-article-as-replied (article)
12099   "Mark ARTICLE replied and update the summary line."
12100   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
12101   (let ((buffer-read-only nil))
12102     (when (gnus-summary-goto-subject article)
12103       (gnus-summary-update-secondary-mark article))))
12104
12105 (defun gnus-summary-set-bookmark (article)
12106   "Set a bookmark in current article."
12107   (interactive (list (gnus-summary-article-number)))
12108   (gnus-set-global-variables)
12109   (if (or (not (get-buffer gnus-article-buffer))
12110           (not gnus-current-article)
12111           (not gnus-article-current)
12112           (not (equal gnus-newsgroup-name (car gnus-article-current))))
12113       (error "No current article selected"))
12114   ;; Remove old bookmark, if one exists.
12115   (let ((old (assq article gnus-newsgroup-bookmarks)))
12116     (if old (setq gnus-newsgroup-bookmarks
12117                   (delq old gnus-newsgroup-bookmarks))))
12118   ;; Set the new bookmark, which is on the form
12119   ;; (article-number . line-number-in-body).
12120   (setq gnus-newsgroup-bookmarks
12121         (cons
12122          (cons article
12123                (save-excursion
12124                  (set-buffer gnus-article-buffer)
12125                  (count-lines
12126                   (min (point)
12127                        (save-excursion
12128                          (goto-char (point-min))
12129                          (search-forward "\n\n" nil t)
12130                          (point)))
12131                   (point))))
12132          gnus-newsgroup-bookmarks))
12133   (gnus-message 6 "A bookmark has been added to the current article."))
12134
12135 (defun gnus-summary-remove-bookmark (article)
12136   "Remove the bookmark from the current article."
12137   (interactive (list (gnus-summary-article-number)))
12138   (gnus-set-global-variables)
12139   ;; Remove old bookmark, if one exists.
12140   (let ((old (assq article gnus-newsgroup-bookmarks)))
12141     (if old
12142         (progn
12143           (setq gnus-newsgroup-bookmarks
12144                 (delq old gnus-newsgroup-bookmarks))
12145           (gnus-message 6 "Removed bookmark."))
12146       (gnus-message 6 "No bookmark in current article."))))
12147
12148 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
12149 (defun gnus-summary-mark-as-dormant (n)
12150   "Mark N articles forward as dormant.
12151 If N is negative, mark backward instead.  The difference between N and
12152 the actual number of articles marked is returned."
12153   (interactive "p")
12154   (gnus-set-global-variables)
12155   (gnus-summary-mark-forward n gnus-dormant-mark))
12156
12157 (defun gnus-summary-set-process-mark (article)
12158   "Set the process mark on ARTICLE and update the summary line."
12159   (setq gnus-newsgroup-processable
12160         (cons article
12161               (delq article gnus-newsgroup-processable)))
12162   (when (gnus-summary-goto-subject article)
12163     (gnus-summary-show-thread)
12164     (gnus-summary-update-secondary-mark article)))
12165
12166 (defun gnus-summary-remove-process-mark (article)
12167   "Remove the process mark from ARTICLE and update the summary line."
12168   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
12169   (when (gnus-summary-goto-subject article)
12170     (gnus-summary-show-thread)
12171     (gnus-summary-update-secondary-mark article)))
12172
12173 (defun gnus-summary-set-saved-mark (article)
12174   "Set the process mark on ARTICLE and update the summary line."
12175   (push article gnus-newsgroup-saved)
12176   (when (gnus-summary-goto-subject article)
12177     (gnus-summary-update-secondary-mark article)))
12178
12179 (defun gnus-summary-mark-forward (n &optional mark no-expire)
12180   "Mark N articles as read forwards.
12181 If N is negative, mark backwards instead.  Mark with MARK, ?r by default.
12182 The difference between N and the actual number of articles marked is
12183 returned."
12184   (interactive "p")
12185   (gnus-set-global-variables)
12186   (let ((backward (< n 0))
12187         (gnus-summary-goto-unread
12188          (and gnus-summary-goto-unread
12189               (not (eq gnus-summary-goto-unread 'never))
12190               (not (memq mark (list gnus-unread-mark
12191                                     gnus-ticked-mark gnus-dormant-mark)))))
12192         (n (abs n))
12193         (mark (or mark gnus-del-mark)))
12194     (while (and (> n 0)
12195                 (gnus-summary-mark-article nil mark no-expire)
12196                 (zerop (gnus-summary-next-subject
12197                         (if backward -1 1)
12198                         (and gnus-summary-goto-unread
12199                              (not (eq gnus-summary-goto-unread 'never)))
12200                         t)))
12201       (setq n (1- n)))
12202     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
12203     (gnus-summary-recenter)
12204     (gnus-summary-position-point)
12205     (gnus-set-mode-line 'summary)
12206     n))
12207
12208 (defun gnus-summary-mark-article-as-read (mark)
12209   "Mark the current article quickly as read with MARK."
12210   (let ((article (gnus-summary-article-number)))
12211     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
12212     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
12213     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
12214     (setq gnus-newsgroup-reads
12215           (cons (cons article mark) gnus-newsgroup-reads))
12216     ;; Possibly remove from cache, if that is used.
12217     (and gnus-use-cache (gnus-cache-enter-remove-article article))
12218     ;; Allow the backend to change the mark.
12219     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
12220     ;; Check for auto-expiry.
12221     (when (and gnus-newsgroup-auto-expire
12222                (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
12223                    (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
12224                    (= mark gnus-ancient-mark)
12225                    (= mark gnus-read-mark) (= mark gnus-souped-mark)))
12226       (setq mark gnus-expirable-mark)
12227       (push article gnus-newsgroup-expirable))
12228     ;; Set the mark in the buffer.
12229     (gnus-summary-update-mark mark 'unread)
12230     t))
12231
12232 (defun gnus-summary-mark-article-as-unread (mark)
12233   "Mark the current article quickly as unread with MARK."
12234   (let ((article (gnus-summary-article-number)))
12235     (if (< article 0)
12236         (gnus-error 1 "Unmarkable article")
12237       (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
12238       (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
12239       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
12240       (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
12241       (cond ((= mark gnus-ticked-mark)
12242              (push article gnus-newsgroup-marked))
12243             ((= mark gnus-dormant-mark)
12244              (push article gnus-newsgroup-dormant))
12245             (t
12246              (push article gnus-newsgroup-unreads)))
12247       (setq gnus-newsgroup-reads
12248             (delq (assq article gnus-newsgroup-reads)
12249                   gnus-newsgroup-reads))
12250
12251       ;; See whether the article is to be put in the cache.
12252       (and gnus-use-cache
12253            (vectorp (gnus-summary-article-header article))
12254            (save-excursion
12255              (gnus-cache-possibly-enter-article
12256               gnus-newsgroup-name article
12257               (gnus-summary-article-header article)
12258               (= mark gnus-ticked-mark)
12259               (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
12260
12261       ;; Fix the mark.
12262       (gnus-summary-update-mark mark 'unread))
12263     t))
12264
12265 (defun gnus-summary-mark-article (&optional article mark no-expire)
12266   "Mark ARTICLE with MARK.  MARK can be any character.
12267 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
12268 `??' (dormant) and `?E' (expirable).
12269 If MARK is nil, then the default character `?D' is used.
12270 If ARTICLE is nil, then the article on the current line will be
12271 marked."
12272   ;; The mark might be a string.
12273   (and (stringp mark)
12274        (setq mark (aref mark 0)))
12275   ;; If no mark is given, then we check auto-expiring.
12276   (and (not no-expire)
12277        gnus-newsgroup-auto-expire
12278        (or (not mark)
12279            (and (numberp mark)
12280                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
12281                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
12282                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
12283        (setq mark gnus-expirable-mark))
12284   (let* ((mark (or mark gnus-del-mark))
12285          (article (or article (gnus-summary-article-number))))
12286     (or article (error "No article on current line"))
12287     (if (or (= mark gnus-unread-mark)
12288             (= mark gnus-ticked-mark)
12289             (= mark gnus-dormant-mark))
12290         (gnus-mark-article-as-unread article mark)
12291       (gnus-mark-article-as-read article mark))
12292
12293     ;; See whether the article is to be put in the cache.
12294     (and gnus-use-cache
12295          (not (= mark gnus-canceled-mark))
12296          (vectorp (gnus-summary-article-header article))
12297          (save-excursion
12298            (gnus-cache-possibly-enter-article
12299             gnus-newsgroup-name article
12300             (gnus-summary-article-header article)
12301             (= mark gnus-ticked-mark)
12302             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
12303
12304     (if (gnus-summary-goto-subject article nil t)
12305         (let ((buffer-read-only nil))
12306           (gnus-summary-show-thread)
12307           ;; Fix the mark.
12308           (gnus-summary-update-mark mark 'unread)
12309           t))))
12310
12311 (defun gnus-summary-update-secondary-mark (article)
12312   "Update the secondary (read, process, cache) mark."
12313   (gnus-summary-update-mark
12314    (cond ((memq article gnus-newsgroup-processable)
12315           gnus-process-mark)
12316          ((memq article gnus-newsgroup-cached)
12317           gnus-cached-mark)
12318          ((memq article gnus-newsgroup-replied)
12319           gnus-replied-mark)
12320          ((memq article gnus-newsgroup-saved)
12321           gnus-saved-mark)
12322          (t gnus-unread-mark))
12323    'replied)
12324   (when (gnus-visual-p 'summary-highlight 'highlight)
12325     (run-hooks 'gnus-summary-update-hook))
12326   t)
12327
12328 (defun gnus-summary-update-mark (mark type)
12329   (beginning-of-line)
12330   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
12331         (buffer-read-only nil))
12332     (when (and forward
12333                (<= (+ forward (point)) (point-max)))
12334       ;; Go to the right position on the line.
12335       (goto-char (+ forward (point)))
12336       ;; Replace the old mark with the new mark.
12337       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
12338       ;; Optionally update the marks by some user rule.
12339       (when (eq type 'unread)
12340         (gnus-data-set-mark
12341          (gnus-data-find (gnus-summary-article-number)) mark)
12342         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
12343
12344 (defun gnus-mark-article-as-read (article &optional mark)
12345   "Enter ARTICLE in the pertinent lists and remove it from others."
12346   ;; Make the article expirable.
12347   (let ((mark (or mark gnus-del-mark)))
12348     (if (= mark gnus-expirable-mark)
12349         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
12350       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
12351     ;; Remove from unread and marked lists.
12352     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
12353     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
12354     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
12355     (push (cons article mark) gnus-newsgroup-reads)
12356     ;; Possibly remove from cache, if that is used.
12357     (when gnus-use-cache
12358       (gnus-cache-enter-remove-article article))))
12359
12360 (defun gnus-mark-article-as-unread (article &optional mark)
12361   "Enter ARTICLE in the pertinent lists and remove it from others."
12362   (let ((mark (or mark gnus-ticked-mark)))
12363     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
12364     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
12365     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
12366     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
12367     (cond ((= mark gnus-ticked-mark)
12368            (push article gnus-newsgroup-marked))
12369           ((= mark gnus-dormant-mark)
12370            (push article gnus-newsgroup-dormant))
12371           (t
12372            (push article gnus-newsgroup-unreads)))
12373     (setq gnus-newsgroup-reads
12374           (delq (assq article gnus-newsgroup-reads)
12375                 gnus-newsgroup-reads))))
12376
12377 (defalias 'gnus-summary-mark-as-unread-forward
12378   'gnus-summary-tick-article-forward)
12379 (make-obsolete 'gnus-summary-mark-as-unread-forward
12380                'gnus-summary-tick-article-forward)
12381 (defun gnus-summary-tick-article-forward (n)
12382   "Tick N articles forwards.
12383 If N is negative, tick backwards instead.
12384 The difference between N and the number of articles ticked is returned."
12385   (interactive "p")
12386   (gnus-summary-mark-forward n gnus-ticked-mark))
12387
12388 (defalias 'gnus-summary-mark-as-unread-backward
12389   'gnus-summary-tick-article-backward)
12390 (make-obsolete 'gnus-summary-mark-as-unread-backward
12391                'gnus-summary-tick-article-backward)
12392 (defun gnus-summary-tick-article-backward (n)
12393   "Tick N articles backwards.
12394 The difference between N and the number of articles ticked is returned."
12395   (interactive "p")
12396   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
12397
12398 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
12399 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
12400 (defun gnus-summary-tick-article (&optional article clear-mark)
12401   "Mark current article as unread.
12402 Optional 1st argument ARTICLE specifies article number to be marked as unread.
12403 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
12404   (interactive)
12405   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
12406                                        gnus-ticked-mark)))
12407
12408 (defun gnus-summary-mark-as-read-forward (n)
12409   "Mark N articles as read forwards.
12410 If N is negative, mark backwards instead.
12411 The difference between N and the actual number of articles marked is
12412 returned."
12413   (interactive "p")
12414   (gnus-summary-mark-forward n gnus-del-mark t))
12415
12416 (defun gnus-summary-mark-as-read-backward (n)
12417   "Mark the N articles as read backwards.
12418 The difference between N and the actual number of articles marked is
12419 returned."
12420   (interactive "p")
12421   (gnus-summary-mark-forward (- n) gnus-del-mark t))
12422
12423 (defun gnus-summary-mark-as-read (&optional article mark)
12424   "Mark current article as read.
12425 ARTICLE specifies the article to be marked as read.
12426 MARK specifies a string to be inserted at the beginning of the line."
12427   (gnus-summary-mark-article article mark))
12428
12429 (defun gnus-summary-clear-mark-forward (n)
12430   "Clear marks from N articles forward.
12431 If N is negative, clear backward instead.
12432 The difference between N and the number of marks cleared is returned."
12433   (interactive "p")
12434   (gnus-summary-mark-forward n gnus-unread-mark))
12435
12436 (defun gnus-summary-clear-mark-backward (n)
12437   "Clear marks from N articles backward.
12438 The difference between N and the number of marks cleared is returned."
12439   (interactive "p")
12440   (gnus-summary-mark-forward (- n) gnus-unread-mark))
12441
12442 (defun gnus-summary-mark-unread-as-read ()
12443   "Intended to be used by `gnus-summary-mark-article-hook'."
12444   (when (memq gnus-current-article gnus-newsgroup-unreads)
12445     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
12446
12447 (defun gnus-summary-mark-read-and-unread-as-read ()
12448   "Intended to be used by `gnus-summary-mark-article-hook'."
12449   (let ((mark (gnus-summary-article-mark)))
12450     (when (or (gnus-unread-mark-p mark)
12451               (gnus-read-mark-p mark))
12452       (gnus-summary-mark-article gnus-current-article gnus-read-mark))))
12453
12454 (defun gnus-summary-mark-region-as-read (point mark all)
12455   "Mark all unread articles between point and mark as read.
12456 If given a prefix, mark all articles between point and mark as read,
12457 even ticked and dormant ones."
12458   (interactive "r\nP")
12459   (save-excursion
12460     (let (article)
12461       (goto-char point)
12462       (beginning-of-line)
12463       (while (and
12464               (< (point) mark)
12465               (progn
12466                 (when (or all
12467                           (memq (setq article (gnus-summary-article-number))
12468                                 gnus-newsgroup-unreads))
12469                   (gnus-summary-mark-article article gnus-del-mark))
12470                 t)
12471               (gnus-summary-find-next))))))
12472
12473 (defun gnus-summary-mark-below (score mark)
12474   "Mark articles with score less than SCORE with MARK."
12475   (interactive "P\ncMark: ")
12476   (gnus-set-global-variables)
12477   (setq score (if score
12478                   (prefix-numeric-value score)
12479                 (or gnus-summary-default-score 0)))
12480   (save-excursion
12481     (set-buffer gnus-summary-buffer)
12482     (goto-char (point-min))
12483     (while 
12484         (progn
12485           (and (< (gnus-summary-article-score) score)
12486                (gnus-summary-mark-article nil mark))
12487           (gnus-summary-find-next)))))
12488
12489 (defun gnus-summary-kill-below (&optional score)
12490   "Mark articles with score below SCORE as read."
12491   (interactive "P")
12492   (gnus-set-global-variables)
12493   (gnus-summary-mark-below score gnus-killed-mark))
12494
12495 (defun gnus-summary-clear-above (&optional score)
12496   "Clear all marks from articles with score above SCORE."
12497   (interactive "P")
12498   (gnus-set-global-variables)
12499   (gnus-summary-mark-above score gnus-unread-mark))
12500
12501 (defun gnus-summary-tick-above (&optional score)
12502   "Tick all articles with score above SCORE."
12503   (interactive "P")
12504   (gnus-set-global-variables)
12505   (gnus-summary-mark-above score gnus-ticked-mark))
12506
12507 (defun gnus-summary-mark-above (score mark)
12508   "Mark articles with score over SCORE with MARK."
12509   (interactive "P\ncMark: ")
12510   (gnus-set-global-variables)
12511   (setq score (if score
12512                   (prefix-numeric-value score)
12513                 (or gnus-summary-default-score 0)))
12514   (save-excursion
12515     (set-buffer gnus-summary-buffer)
12516     (goto-char (point-min))
12517     (while (and (progn
12518                   (if (> (gnus-summary-article-score) score)
12519                       (gnus-summary-mark-article nil mark))
12520                   t)
12521                 (gnus-summary-find-next)))))
12522
12523 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
12524 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
12525 (defun gnus-summary-limit-include-expunged (&optional no-error)
12526   "Display all the hidden articles that were expunged for low scores."
12527   (interactive)
12528   (gnus-set-global-variables)
12529   (let ((buffer-read-only nil))
12530     (let ((scored gnus-newsgroup-scored)
12531           headers h)
12532       (while scored
12533         (or (gnus-summary-goto-subject (caar scored))
12534             (and (setq h (gnus-summary-article-header (caar scored)))
12535                  (< (cdar scored) gnus-summary-expunge-below)
12536                  (setq headers (cons h headers))))
12537         (setq scored (cdr scored)))
12538       (if (not headers)
12539           (when (not no-error)
12540             (error "No expunged articles hidden."))
12541         (goto-char (point-min))
12542         (gnus-summary-prepare-unthreaded (nreverse headers))
12543         (goto-char (point-min))
12544         (gnus-summary-position-point)
12545         t))))
12546
12547 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
12548   "Mark all articles not marked as unread in this newsgroup as read.
12549 If prefix argument ALL is non-nil, all articles are marked as read.
12550 If QUIETLY is non-nil, no questions will be asked.
12551 If TO-HERE is non-nil, it should be a point in the buffer.  All
12552 articles before this point will be marked as read.
12553 The number of articles marked as read is returned."
12554   (interactive "P")
12555   (gnus-set-global-variables)
12556   (prog1
12557       (if (or quietly
12558               (not gnus-interactive-catchup) ;Without confirmation?
12559               gnus-expert-user
12560               (gnus-y-or-n-p
12561                (if all
12562                    "Mark absolutely all articles as read? "
12563                  "Mark all unread articles as read? ")))
12564           (if (and not-mark
12565                    (not gnus-newsgroup-adaptive)
12566                    (not gnus-newsgroup-auto-expire))
12567               (progn
12568                 (when all
12569                   (setq gnus-newsgroup-marked nil
12570                         gnus-newsgroup-dormant nil))
12571                 (setq gnus-newsgroup-unreads nil))
12572             ;; We actually mark all articles as canceled, which we
12573             ;; have to do when using auto-expiry or adaptive scoring.
12574             (gnus-summary-show-all-threads)
12575             (if (gnus-summary-first-subject (not all))
12576                 (while (and
12577                         (if to-here (< (point) to-here) t)
12578                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
12579                         (gnus-summary-find-next (not all)))))
12580             (unless to-here
12581               (setq gnus-newsgroup-unreads nil))
12582             (gnus-set-mode-line 'summary)))
12583     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
12584       (if (and (not to-here) (eq 'nnvirtual (car method)))
12585           (nnvirtual-catchup-group
12586            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
12587     (gnus-summary-position-point)))
12588
12589 (defun gnus-summary-catchup-to-here (&optional all)
12590   "Mark all unticked articles before the current one as read.
12591 If ALL is non-nil, also mark ticked and dormant articles as read."
12592   (interactive "P")
12593   (gnus-set-global-variables)
12594   (save-excursion
12595     (gnus-save-hidden-threads
12596       (let ((beg (point)))
12597         ;; We check that there are unread articles.
12598         (when (or all (gnus-summary-find-prev))
12599           (gnus-summary-catchup all t beg)))))
12600   (gnus-summary-position-point))
12601
12602 (defun gnus-summary-catchup-all (&optional quietly)
12603   "Mark all articles in this newsgroup as read."
12604   (interactive "P")
12605   (gnus-set-global-variables)
12606   (gnus-summary-catchup t quietly))
12607
12608 (defun gnus-summary-catchup-and-exit (&optional all quietly)
12609   "Mark all articles not marked as unread in this newsgroup as read, then exit.
12610 If prefix argument ALL is non-nil, all articles are marked as read."
12611   (interactive "P")
12612   (gnus-set-global-variables)
12613   (gnus-summary-catchup all quietly nil 'fast)
12614   ;; Select next newsgroup or exit.
12615   (if (eq gnus-auto-select-next 'quietly)
12616       (gnus-summary-next-group nil)
12617     (gnus-summary-exit)))
12618
12619 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
12620   "Mark all articles in this newsgroup as read, and then exit."
12621   (interactive "P")
12622   (gnus-set-global-variables)
12623   (gnus-summary-catchup-and-exit t quietly))
12624
12625 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
12626 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
12627   "Mark all articles in this group as read and select the next group.
12628 If given a prefix, mark all articles, unread as well as ticked, as
12629 read."
12630   (interactive "P")
12631   (gnus-set-global-variables)
12632   (save-excursion
12633     (gnus-summary-catchup all))
12634   (gnus-summary-next-article t nil nil t))
12635
12636 ;; Thread-based commands.
12637
12638 (defun gnus-summary-articles-in-thread (&optional article)
12639   "Return a list of all articles in the current thread.
12640 If ARTICLE is non-nil, return all articles in the thread that starts
12641 with that article."
12642   (let* ((article (or article (gnus-summary-article-number)))
12643          (data (gnus-data-find-list article))
12644          (top-level (gnus-data-level (car data)))
12645          (top-subject
12646           (cond ((null gnus-thread-operation-ignore-subject)
12647                  (gnus-simplify-subject-re
12648                   (mail-header-subject (gnus-data-header (car data)))))
12649                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
12650                  (gnus-simplify-subject-fuzzy
12651                   (mail-header-subject (gnus-data-header (car data)))))
12652                 (t nil)))
12653          (end-point (save-excursion
12654                       (if (gnus-summary-go-to-next-thread) 
12655                           (point) (point-max))))
12656          articles)
12657     (while (and data
12658                 (< (gnus-data-pos (car data)) end-point))
12659       (when (or (not top-subject)
12660                 (string= top-subject
12661                          (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
12662                              (gnus-simplify-subject-fuzzy
12663                               (mail-header-subject
12664                                (gnus-data-header (car data))))
12665                            (gnus-simplify-subject-re
12666                             (mail-header-subject
12667                              (gnus-data-header (car data)))))))
12668         (push (gnus-data-number (car data)) articles))
12669       (unless (and (setq data (cdr data))
12670                    (> (gnus-data-level (car data)) top-level))
12671         (setq data nil)))
12672     ;; Return the list of articles.
12673     (nreverse articles)))
12674
12675 (defun gnus-summary-rethread-current ()
12676   "Rethread the thread the current article is part of."
12677   (interactive)
12678   (gnus-set-global-variables)
12679   (let* ((gnus-show-threads t)
12680          (article (gnus-summary-article-number))
12681          (id (mail-header-id (gnus-summary-article-header)))
12682          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
12683     (unless id
12684       (error "No article on the current line"))
12685     (gnus-rebuild-thread id)
12686     (gnus-summary-goto-subject article)))
12687
12688 (defun gnus-summary-reparent-thread ()
12689   "Make current article child of the marked (or previous) article.
12690
12691 Note that the re-threading will only work if `gnus-thread-ignore-subject'
12692 is non-nil or the Subject: of both articles are the same."
12693   (interactive)
12694   (or (not (gnus-group-read-only-p))
12695       (error "The current newsgroup does not support article editing."))
12696   (or (<= (length gnus-newsgroup-processable) 1)
12697       (error "No more than one article may be marked."))
12698   (save-window-excursion
12699     (let ((gnus-article-buffer " *reparent*")
12700           (current-article (gnus-summary-article-number))
12701           ; first grab the marked article, otherwise one line up.
12702           (parent-article (if (not (null gnus-newsgroup-processable))
12703                               (car gnus-newsgroup-processable)
12704                             (save-excursion
12705                               (if (eq (forward-line -1) 0)
12706                                   (gnus-summary-article-number)
12707                                 (error "Beginning of summary buffer."))))))
12708       (or (not (eq current-article parent-article))
12709           (error "An article may not be self-referential."))
12710       (let ((message-id (mail-header-id 
12711                          (gnus-summary-article-header parent-article))))
12712         (or (and message-id (not (equal message-id "")))
12713             (error "No message-id in desired parent."))
12714         (gnus-summary-select-article t t nil current-article)
12715         (set-buffer gnus-article-buffer)
12716         (setq buffer-read-only nil)
12717         (let ((buf (format "%s" (buffer-string))))
12718           (erase-buffer)
12719           (insert buf))
12720         (goto-char (point-min))
12721         (if (search-forward-regexp "^References: " nil t)
12722             (insert message-id " " )
12723           (insert "References: " message-id "\n"))
12724         (or (gnus-request-replace-article current-article
12725                                           (car gnus-article-current)
12726                                           gnus-article-buffer)
12727             (error "Couldn't replace article."))
12728         (set-buffer gnus-summary-buffer)
12729         (gnus-summary-unmark-all-processable)
12730         (gnus-summary-rethread-current)
12731         (gnus-message 3 "Article %d is now the child of article %d."
12732                       current-article parent-article)))))
12733
12734 (defun gnus-summary-toggle-threads (&optional arg)
12735   "Toggle showing conversation threads.
12736 If ARG is positive number, turn showing conversation threads on."
12737   (interactive "P")
12738   (gnus-set-global-variables)
12739   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
12740     (setq gnus-show-threads
12741           (if (null arg) (not gnus-show-threads)
12742             (> (prefix-numeric-value arg) 0)))
12743     (gnus-summary-prepare)
12744     (gnus-summary-goto-subject current)
12745     (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
12746     (gnus-summary-position-point)))
12747
12748 (defun gnus-summary-show-all-threads ()
12749   "Show all threads."
12750   (interactive)
12751   (gnus-set-global-variables)
12752   (save-excursion
12753     (let ((buffer-read-only nil))
12754       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
12755   (gnus-summary-position-point))
12756
12757 (defun gnus-summary-show-thread ()
12758   "Show thread subtrees.
12759 Returns nil if no thread was there to be shown."
12760   (interactive)
12761   (gnus-set-global-variables)
12762   (let ((buffer-read-only nil)
12763         (orig (point))
12764         ;; first goto end then to beg, to have point at beg after let
12765         (end (progn (end-of-line) (point)))
12766         (beg (progn (beginning-of-line) (point))))
12767     (prog1
12768         ;; Any hidden lines here?
12769         (search-forward "\r" end t)
12770       (subst-char-in-region beg end ?\^M ?\n t)
12771       (goto-char orig)
12772       (gnus-summary-position-point))))
12773
12774 (defun gnus-summary-hide-all-threads ()
12775   "Hide all thread subtrees."
12776   (interactive)
12777   (gnus-set-global-variables)
12778   (save-excursion
12779     (goto-char (point-min))
12780     (gnus-summary-hide-thread)
12781     (while (zerop (gnus-summary-next-thread 1 t))
12782       (gnus-summary-hide-thread)))
12783   (gnus-summary-position-point))
12784
12785 (defun gnus-summary-hide-thread ()
12786   "Hide thread subtrees.
12787 Returns nil if no threads were there to be hidden."
12788   (interactive)
12789   (gnus-set-global-variables)
12790   (let ((buffer-read-only nil)
12791         (start (point))
12792         (article (gnus-summary-article-number)))
12793     (goto-char start)
12794     ;; Go forward until either the buffer ends or the subthread
12795     ;; ends.
12796     (when (and (not (eobp))
12797                (or (zerop (gnus-summary-next-thread 1 t))
12798                    (goto-char (point-max))))
12799       (prog1
12800           (if (and (> (point) start)
12801                    (search-backward "\n" start t))
12802               (progn
12803                 (subst-char-in-region start (point) ?\n ?\^M)
12804                 (gnus-summary-goto-subject article))
12805             (goto-char start)
12806             nil)
12807         ;;(gnus-summary-position-point)
12808         ))))
12809
12810 (defun gnus-summary-go-to-next-thread (&optional previous)
12811   "Go to the same level (or less) next thread.
12812 If PREVIOUS is non-nil, go to previous thread instead.
12813 Return the article number moved to, or nil if moving was impossible."
12814   (let ((level (gnus-summary-thread-level))
12815         (way (if previous -1 1))
12816         (beg (point)))
12817     (forward-line way)
12818     (while (and (not (eobp))
12819                 (< level (gnus-summary-thread-level)))
12820       (forward-line way))
12821     (if (eobp)
12822         (progn
12823           (goto-char beg)
12824           nil)
12825       (setq beg (point))
12826       (prog1
12827           (gnus-summary-article-number)
12828         (goto-char beg)))))
12829
12830 (defun gnus-summary-go-to-next-thread-old (&optional previous)
12831   "Go to the same level (or less) next thread.
12832 If PREVIOUS is non-nil, go to previous thread instead.
12833 Return the article number moved to, or nil if moving was impossible."
12834   (if (and (eq gnus-summary-make-false-root 'dummy)
12835            (gnus-summary-article-intangible-p))
12836       (let ((beg (point)))
12837         (while (and (zerop (forward-line 1))
12838                     (not (gnus-summary-article-intangible-p))
12839                     (not (zerop (save-excursion 
12840                                   (gnus-summary-thread-level))))))
12841         (if (eobp)
12842             (progn
12843               (goto-char beg)
12844               nil)
12845           (point)))
12846     (let* ((level (gnus-summary-thread-level))
12847            (article (gnus-summary-article-number))
12848            (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
12849            oart)
12850       (while data
12851         (if (<= (gnus-data-level (car data)) level)
12852             (setq oart (gnus-data-number (car data))
12853                   data nil)
12854           (setq data (cdr data))))
12855       (and oart
12856            (gnus-summary-goto-subject oart)))))
12857
12858 (defun gnus-summary-next-thread (n &optional silent)
12859   "Go to the same level next N'th thread.
12860 If N is negative, search backward instead.
12861 Returns the difference between N and the number of skips actually
12862 done.
12863
12864 If SILENT, don't output messages."
12865   (interactive "p")
12866   (gnus-set-global-variables)
12867   (let ((backward (< n 0))
12868         (n (abs n))
12869         old dum int)
12870     (while (and (> n 0)
12871                 (gnus-summary-go-to-next-thread backward))
12872       (decf n))
12873     (unless silent 
12874       (gnus-summary-position-point))
12875     (when (and (not silent) (/= 0 n))
12876       (gnus-message 7 "No more threads"))
12877     n))
12878
12879 (defun gnus-summary-prev-thread (n)
12880   "Go to the same level previous N'th thread.
12881 Returns the difference between N and the number of skips actually
12882 done."
12883   (interactive "p")
12884   (gnus-set-global-variables)
12885   (gnus-summary-next-thread (- n)))
12886
12887 (defun gnus-summary-go-down-thread ()
12888   "Go down one level in the current thread."
12889   (let ((children (gnus-summary-article-children)))
12890     (and children
12891          (gnus-summary-goto-subject (car children)))))
12892
12893 (defun gnus-summary-go-up-thread ()
12894   "Go up one level in the current thread."
12895   (let ((parent (gnus-summary-article-parent)))
12896     (and parent
12897          (gnus-summary-goto-subject parent))))
12898
12899 (defun gnus-summary-down-thread (n)
12900   "Go down thread N steps.
12901 If N is negative, go up instead.
12902 Returns the difference between N and how many steps down that were
12903 taken."
12904   (interactive "p")
12905   (gnus-set-global-variables)
12906   (let ((up (< n 0))
12907         (n (abs n)))
12908     (while (and (> n 0)
12909                 (if up (gnus-summary-go-up-thread)
12910                   (gnus-summary-go-down-thread)))
12911       (setq n (1- n)))
12912     (gnus-summary-position-point)
12913     (if (/= 0 n) (gnus-message 7 "Can't go further"))
12914     n))
12915
12916 (defun gnus-summary-up-thread (n)
12917   "Go up thread N steps.
12918 If N is negative, go up instead.
12919 Returns the difference between N and how many steps down that were
12920 taken."
12921   (interactive "p")
12922   (gnus-set-global-variables)
12923   (gnus-summary-down-thread (- n)))
12924
12925 (defun gnus-summary-top-thread ()
12926   "Go to the top of the thread."
12927   (interactive)
12928   (gnus-set-global-variables)
12929   (while (gnus-summary-go-up-thread))
12930   (gnus-summary-article-number))
12931
12932 (defun gnus-summary-kill-thread (&optional unmark)
12933   "Mark articles under current thread as read.
12934 If the prefix argument is positive, remove any kinds of marks.
12935 If the prefix argument is negative, tick articles instead."
12936   (interactive "P")
12937   (gnus-set-global-variables)
12938   (when unmark
12939     (setq unmark (prefix-numeric-value unmark)))
12940   (let ((articles (gnus-summary-articles-in-thread)))
12941     (save-excursion
12942       ;; Expand the thread.
12943       (gnus-summary-show-thread)
12944       ;; Mark all the articles.
12945       (while articles
12946         (gnus-summary-goto-subject (car articles))
12947         (cond ((null unmark)
12948                (gnus-summary-mark-article-as-read gnus-killed-mark))
12949               ((> unmark 0)
12950                (gnus-summary-mark-article-as-unread gnus-unread-mark))
12951               (t
12952                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
12953         (setq articles (cdr articles))))
12954     ;; Hide killed subtrees.
12955     (and (null unmark)
12956          gnus-thread-hide-killed
12957          (gnus-summary-hide-thread))
12958     ;; If marked as read, go to next unread subject.
12959     (if (null unmark)
12960         ;; Go to next unread subject.
12961         (gnus-summary-next-subject 1 t)))
12962   (gnus-set-mode-line 'summary))
12963
12964 ;; Summary sorting commands
12965
12966 (defun gnus-summary-sort-by-number (&optional reverse)
12967   "Sort summary buffer by article number.
12968 Argument REVERSE means reverse order."
12969   (interactive "P")
12970   (gnus-summary-sort 'number reverse))
12971
12972 (defun gnus-summary-sort-by-author (&optional reverse)
12973   "Sort summary buffer by author name alphabetically.
12974 If case-fold-search is non-nil, case of letters is ignored.
12975 Argument REVERSE means reverse order."
12976   (interactive "P")
12977   (gnus-summary-sort 'author reverse))
12978
12979 (defun gnus-summary-sort-by-subject (&optional reverse)
12980   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
12981 If case-fold-search is non-nil, case of letters is ignored.
12982 Argument REVERSE means reverse order."
12983   (interactive "P")
12984   (gnus-summary-sort 'subject reverse))
12985
12986 (defun gnus-summary-sort-by-date (&optional reverse)
12987   "Sort summary buffer by date.
12988 Argument REVERSE means reverse order."
12989   (interactive "P")
12990   (gnus-summary-sort 'date reverse))
12991
12992 (defun gnus-summary-sort-by-score (&optional reverse)
12993   "Sort summary buffer by score.
12994 Argument REVERSE means reverse order."
12995   (interactive "P")
12996   (gnus-summary-sort 'score reverse))
12997
12998 (defun gnus-summary-sort (predicate reverse)
12999   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
13000   (gnus-set-global-variables)
13001   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
13002          (article (intern (format "gnus-article-sort-by-%s" predicate)))
13003          (gnus-thread-sort-functions
13004           (list
13005            (if (not reverse)
13006                thread
13007              `(lambda (t1 t2)
13008                 (,thread t2 t1)))))
13009          (gnus-article-sort-functions
13010           (list
13011            (if (not reverse)
13012                article
13013              `(lambda (t1 t2)
13014                 (,article t2 t1)))))
13015          (buffer-read-only)
13016          (gnus-summary-prepare-hook nil))
13017     ;; We do the sorting by regenerating the threads.
13018     (gnus-summary-prepare)
13019     ;; Hide subthreads if needed.
13020     (when (and gnus-show-threads gnus-thread-hide-subtree)
13021       (gnus-summary-hide-all-threads)))
13022   ;; If in async mode, we send some info to the backend.
13023   (when gnus-newsgroup-async
13024     (gnus-request-asynchronous
13025      gnus-newsgroup-name gnus-newsgroup-data)))
13026
13027 (defun gnus-sortable-date (date)
13028   "Make sortable string by string-lessp from DATE.
13029 Timezone package is used."
13030   (condition-case ()
13031       (progn
13032         (setq date (inline (timezone-fix-time 
13033                             date nil 
13034                             (aref (inline (timezone-parse-date date)) 4))))
13035         (inline
13036           (timezone-make-sortable-date
13037            (aref date 0) (aref date 1) (aref date 2)
13038            (inline
13039              (timezone-make-time-string
13040               (aref date 3) (aref date 4) (aref date 5))))))
13041     (error "")))
13042   
13043 ;; Summary saving commands.
13044
13045 (defun gnus-summary-save-article (&optional n not-saved)
13046   "Save the current article using the default saver function.
13047 If N is a positive number, save the N next articles.
13048 If N is a negative number, save the N previous articles.
13049 If N is nil and any articles have been marked with the process mark,
13050 save those articles instead.
13051 The variable `gnus-default-article-saver' specifies the saver function."
13052   (interactive "P")
13053   (gnus-set-global-variables)
13054   (let ((articles (gnus-summary-work-articles n))
13055         (save-buffer (save-excursion 
13056                        (nnheader-set-temp-buffer " *Gnus Save*")))
13057         file header article)
13058     (while articles
13059       (setq header (gnus-summary-article-header
13060                     (setq article (pop articles))))
13061       (if (not (vectorp header))
13062           ;; This is a pseudo-article.
13063           (if (assq 'name header)
13064               (gnus-copy-file (cdr (assq 'name header)))
13065             (gnus-message 1 "Article %d is unsaveable" article))
13066         ;; This is a real article.
13067         (save-window-excursion
13068           (gnus-summary-select-article t nil nil article))
13069         (save-excursion
13070           (set-buffer save-buffer)
13071           (erase-buffer)
13072           (insert-buffer-substring gnus-original-article-buffer))
13073         (unless gnus-save-all-headers
13074           ;; Remove headers accoring to `gnus-saved-headers'.
13075           (let ((gnus-visible-headers
13076                  (or gnus-saved-headers gnus-visible-headers))
13077                 (gnus-article-buffer save-buffer))
13078             (gnus-article-hide-headers 1 t)))
13079         (save-window-excursion
13080           (if (not gnus-default-article-saver)
13081               (error "No default saver is defined.")
13082             ;; !!! Magic!  The saving functions all save
13083             ;; `gnus-original-article-buffer' (or so they think),
13084             ;; but we bind that variable to our save-buffer.
13085             (set-buffer gnus-article-buffer)
13086             (let ((gnus-original-article-buffer save-buffer))
13087               (set-buffer gnus-summary-buffer)
13088               (setq file (funcall
13089                           gnus-default-article-saver
13090                           (cond
13091                            ((not gnus-prompt-before-saving)
13092                             'default)
13093                            ((eq gnus-prompt-before-saving 'always)
13094                             nil)
13095                            (t file)))))))
13096         (gnus-summary-remove-process-mark article)
13097         (unless not-saved
13098           (gnus-summary-set-saved-mark article))))
13099     (gnus-kill-buffer save-buffer)
13100     (gnus-summary-position-point)
13101     n))
13102
13103 (defun gnus-summary-pipe-output (&optional arg)
13104   "Pipe the current article to a subprocess.
13105 If N is a positive number, pipe the N next articles.
13106 If N is a negative number, pipe the N previous articles.
13107 If N is nil and any articles have been marked with the process mark,
13108 pipe those articles instead."
13109   (interactive "P")
13110   (gnus-set-global-variables)
13111   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
13112     (gnus-summary-save-article arg t))
13113   (gnus-configure-windows 'pipe))
13114
13115 (defun gnus-summary-save-article-mail (&optional arg)
13116   "Append the current article to an mail file.
13117 If N is a positive number, save the N next articles.
13118 If N is a negative number, save the N previous articles.
13119 If N is nil and any articles have been marked with the process mark,
13120 save those articles instead."
13121   (interactive "P")
13122   (gnus-set-global-variables)
13123   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
13124     (gnus-summary-save-article arg)))
13125
13126 (defun gnus-summary-save-article-rmail (&optional arg)
13127   "Append the current article to an rmail file.
13128 If N is a positive number, save the N next articles.
13129 If N is a negative number, save the N previous articles.
13130 If N is nil and any articles have been marked with the process mark,
13131 save those articles instead."
13132   (interactive "P")
13133   (gnus-set-global-variables)
13134   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
13135     (gnus-summary-save-article arg)))
13136
13137 (defun gnus-summary-save-article-file (&optional arg)
13138   "Append the current article to a file.
13139 If N is a positive number, save the N next articles.
13140 If N is a negative number, save the N previous articles.
13141 If N is nil and any articles have been marked with the process mark,
13142 save those articles instead."
13143   (interactive "P")
13144   (gnus-set-global-variables)
13145   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
13146     (gnus-summary-save-article arg)))
13147
13148 (defun gnus-summary-save-article-body-file (&optional arg)
13149   "Append the current article body to a file.
13150 If N is a positive number, save the N next articles.
13151 If N is a negative number, save the N previous articles.
13152 If N is nil and any articles have been marked with the process mark,
13153 save those articles instead."
13154   (interactive "P")
13155   (gnus-set-global-variables)
13156   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
13157     (gnus-summary-save-article arg)))
13158
13159 (defun gnus-get-split-value (methods)
13160   "Return a value based on the split METHODS."
13161   (let (split-name method result match)
13162     (when methods
13163       (save-excursion
13164         (set-buffer gnus-original-article-buffer)
13165         (save-restriction
13166           (nnheader-narrow-to-headers)
13167           (while methods
13168             (goto-char (point-min))
13169             (setq method (pop methods))
13170             (setq match (car method))
13171             (when (cond
13172                    ((stringp match)
13173                     ;; Regular expression.
13174                     (condition-case ()
13175                         (re-search-forward match nil t)
13176                       (error nil)))
13177                    ((gnus-functionp match)
13178                     ;; Function.
13179                     (save-restriction
13180                       (widen)
13181                       (setq result (funcall match gnus-newsgroup-name))))
13182                    ((consp match)
13183                     ;; Form.
13184                     (save-restriction
13185                       (widen)
13186                       (setq result (eval match)))))
13187               (setq split-name (append (cdr method) split-name))
13188               (cond ((stringp result)
13189                      (push result split-name))
13190                     ((consp result)
13191                      (setq split-name (append result split-name)))))))))
13192     split-name))
13193
13194 (defun gnus-read-move-group-name (prompt default articles prefix)
13195   "Read a group name."
13196   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
13197          (minibuffer-confirm-incomplete nil) ; XEmacs
13198          group-map
13199          (dum (mapatoms
13200                (lambda (g) 
13201                  (and (boundp g)
13202                       (symbol-name g)
13203                       (memq 'respool
13204                             (assoc (symbol-name
13205                                     (car (gnus-find-method-for-group
13206                                           (symbol-name g))))
13207                                    gnus-valid-select-methods))
13208                       (push (list (symbol-name g)) group-map)))
13209                gnus-active-hashtb))
13210          (prom
13211           (format "%s %s to:"
13212                   prompt
13213                   (if (> (length articles) 1)
13214                       (format "these %d articles" (length articles))
13215                     "this article")))
13216          (to-newsgroup
13217           (cond
13218            ((null split-name)
13219             (gnus-completing-read default prom
13220                                   group-map nil nil prefix
13221                                   'gnus-group-history))
13222            ((= 1 (length split-name))
13223             (gnus-completing-read (car split-name) prom group-map
13224                                   nil nil nil
13225                                   'gnus-group-history))
13226            (t
13227             (gnus-completing-read nil prom 
13228                                   (mapcar (lambda (el) (list el))
13229                                           (nreverse split-name))
13230                                   nil nil nil
13231                                   'gnus-group-history)))))
13232     (when to-newsgroup
13233       (if (or (string= to-newsgroup "")
13234               (string= to-newsgroup prefix))
13235           (setq to-newsgroup (or default "")))
13236       (or (gnus-active to-newsgroup)
13237           (gnus-activate-group to-newsgroup)
13238           (if (gnus-y-or-n-p (format "No such group: %s.  Create it? "
13239                                      to-newsgroup))
13240               (or (and (gnus-request-create-group 
13241                         to-newsgroup (gnus-group-name-to-method to-newsgroup))
13242                        (gnus-activate-group to-newsgroup nil nil
13243                                             (gnus-group-name-to-method
13244                                              to-newsgroup)))
13245                   (error "Couldn't create group %s" to-newsgroup)))
13246           (error "No such group: %s" to-newsgroup)))
13247     to-newsgroup))
13248
13249 (defun gnus-read-save-file-name (prompt default-name)
13250   (let* ((split-name (gnus-get-split-value gnus-split-methods))
13251          (file
13252           ;; Let the split methods have their say.
13253           (cond
13254            ;; No split name was found.
13255            ((null split-name)
13256             (read-file-name
13257              (concat prompt " (default "
13258                      (file-name-nondirectory default-name) ") ")
13259              (file-name-directory default-name)
13260              default-name))
13261            ;; A single split name was found
13262            ((= 1 (length split-name))
13263             (let* ((name (car split-name))
13264                    (dir (cond ((file-directory-p name)
13265                                (file-name-as-directory name))
13266                               ((file-exists-p name) name)
13267                               (t gnus-article-save-directory))))
13268               (read-file-name
13269                (concat prompt " (default " name ") ")
13270                dir name)))
13271            ;; A list of splits was found.
13272            (t
13273             (setq split-name (nreverse split-name))
13274             (let (result)
13275               (let ((file-name-history (nconc split-name file-name-history)))
13276                 (setq result
13277                       (read-file-name
13278                        (concat prompt " (`M-p' for defaults) ")
13279                        gnus-article-save-directory
13280                        (car split-name))))
13281               (car (push result file-name-history)))))))
13282     ;; If we have read a directory, we append the default file name.
13283     (when (file-directory-p file)
13284       (setq file (concat (file-name-as-directory file)
13285                          (file-name-nondirectory default-name))))
13286     ;; Possibly translate some charaters.
13287     (nnheader-translate-file-chars file)))
13288
13289 (defun gnus-article-archive-name (group)
13290   "Return the first instance of an \"Archive-name\" in the current buffer."
13291   (let ((case-fold-search t))
13292     (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
13293       (match-string 1))))
13294
13295 (defun gnus-summary-save-in-rmail (&optional filename)
13296   "Append this article to Rmail file.
13297 Optional argument FILENAME specifies file name.
13298 Directory to save to is default to `gnus-article-save-directory'."
13299   (interactive)
13300   (gnus-set-global-variables)
13301   (let ((default-name
13302           (funcall gnus-rmail-save-name gnus-newsgroup-name
13303                    gnus-current-headers gnus-newsgroup-last-rmail)))
13304     (setq filename
13305           (cond ((eq filename 'default)
13306                  default-name)
13307                 (filename filename)
13308                 (t (gnus-read-save-file-name
13309                     "Save in rmail file:" default-name))))
13310     (gnus-make-directory (file-name-directory filename))
13311     (gnus-eval-in-buffer-window gnus-original-article-buffer
13312       (save-excursion
13313         (save-restriction
13314           (widen)
13315           (gnus-output-to-rmail filename))))
13316     ;; Remember the directory name to save articles
13317     (setq gnus-newsgroup-last-rmail filename)))
13318
13319 (defun gnus-summary-save-in-mail (&optional filename)
13320   "Append this article to Unix mail file.
13321 Optional argument FILENAME specifies file name.
13322 Directory to save to is default to `gnus-article-save-directory'."
13323   (interactive)
13324   (gnus-set-global-variables)
13325   (let ((default-name
13326           (funcall gnus-mail-save-name gnus-newsgroup-name
13327                    gnus-current-headers gnus-newsgroup-last-mail)))
13328     (setq filename
13329           (cond ((eq filename 'default)
13330                  default-name)
13331                 (filename filename)
13332                 (t (gnus-read-save-file-name
13333                     "Save in Unix mail file:" default-name))))
13334     (setq filename
13335           (expand-file-name filename
13336                             (and default-name
13337                                  (file-name-directory default-name))))
13338     (gnus-make-directory (file-name-directory filename))
13339     (gnus-eval-in-buffer-window gnus-original-article-buffer
13340       (save-excursion
13341         (save-restriction
13342           (widen)
13343           (if (and (file-readable-p filename) (mail-file-babyl-p filename))
13344               (gnus-output-to-rmail filename)
13345             (let ((mail-use-rfc822 t))
13346               (rmail-output filename 1 t t))))))
13347     ;; Remember the directory name to save articles.
13348     (setq gnus-newsgroup-last-mail filename)))
13349
13350 (defun gnus-summary-save-in-file (&optional filename)
13351   "Append this article to file.
13352 Optional argument FILENAME specifies file name.
13353 Directory to save to is default to `gnus-article-save-directory'."
13354   (interactive)
13355   (gnus-set-global-variables)
13356   (let ((default-name
13357           (funcall gnus-file-save-name gnus-newsgroup-name
13358                    gnus-current-headers gnus-newsgroup-last-file)))
13359     (setq filename
13360           (cond ((eq filename 'default)
13361                  default-name)
13362                 (filename filename)
13363                 (t (gnus-read-save-file-name
13364                     "Save in file:" default-name))))
13365     (gnus-make-directory (file-name-directory filename))
13366     (gnus-eval-in-buffer-window gnus-original-article-buffer
13367       (save-excursion
13368         (save-restriction
13369           (widen)
13370           (gnus-output-to-file filename))))
13371     ;; Remember the directory name to save articles.
13372     (setq gnus-newsgroup-last-file filename)))
13373
13374 (defun gnus-summary-save-body-in-file (&optional filename)
13375   "Append this article body to a file.
13376 Optional argument FILENAME specifies file name.
13377 The directory to save in defaults to `gnus-article-save-directory'."
13378   (interactive)
13379   (gnus-set-global-variables)
13380   (let ((default-name
13381           (funcall gnus-file-save-name gnus-newsgroup-name
13382                    gnus-current-headers gnus-newsgroup-last-file)))
13383     (setq filename
13384           (cond ((eq filename 'default)
13385                  default-name)
13386                 (filename filename)
13387                 (t (gnus-read-save-file-name
13388                     "Save body in file:" default-name))))
13389     (gnus-make-directory (file-name-directory filename))
13390     (gnus-eval-in-buffer-window gnus-original-article-buffer
13391       (save-excursion
13392         (save-restriction
13393           (widen)
13394           (goto-char (point-min))
13395           (and (search-forward "\n\n" nil t)
13396                (narrow-to-region (point) (point-max)))
13397           (gnus-output-to-file filename))))
13398     ;; Remember the directory name to save articles.
13399     (setq gnus-newsgroup-last-file filename)))
13400
13401 (defun gnus-summary-save-in-pipe (&optional command)
13402   "Pipe this article to subprocess."
13403   (interactive)
13404   (gnus-set-global-variables)
13405   (setq command
13406         (cond ((eq command 'default)
13407                gnus-last-shell-command)
13408               (command command)
13409               (t (read-string "Shell command on article: "
13410                               gnus-last-shell-command))))
13411   (if (string-equal command "")
13412       (setq command gnus-last-shell-command))
13413   (gnus-eval-in-buffer-window gnus-article-buffer
13414     (save-restriction
13415       (widen)
13416       (shell-command-on-region (point-min) (point-max) command nil)))
13417   (setq gnus-last-shell-command command))
13418
13419 ;; Summary extract commands
13420
13421 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
13422   (let ((buffer-read-only nil)
13423         (article (gnus-summary-article-number))
13424         after-article b e)
13425     (or (gnus-summary-goto-subject article)
13426         (error (format "No such article: %d" article)))
13427     (gnus-summary-position-point)
13428     ;; If all commands are to be bunched up on one line, we collect
13429     ;; them here.
13430     (if gnus-view-pseudos-separately
13431         ()
13432       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
13433             files action)
13434         (while ps
13435           (setq action (cdr (assq 'action (car ps))))
13436           (setq files (list (cdr (assq 'name (car ps)))))
13437           (while (and ps (cdr ps)
13438                       (string= (or action "1")
13439                                (or (cdr (assq 'action (cadr ps))) "2")))
13440             (setq files (cons (cdr (assq 'name (cadr ps))) files))
13441             (setcdr ps (cddr ps)))
13442           (if (not files)
13443               ()
13444             (if (not (string-match "%s" action))
13445                 (setq files (cons " " files)))
13446             (setq files (cons " " files))
13447             (and (assq 'execute (car ps))
13448                  (setcdr (assq 'execute (car ps))
13449                          (funcall (if (string-match "%s" action)
13450                                       'format 'concat)
13451                                   action
13452                                   (mapconcat (lambda (f) f) files " ")))))
13453           (setq ps (cdr ps)))))
13454     (if (and gnus-view-pseudos (not not-view))
13455         (while pslist
13456           (and (assq 'execute (car pslist))
13457                (gnus-execute-command (cdr (assq 'execute (car pslist)))
13458                                      (eq gnus-view-pseudos 'not-confirm)))
13459           (setq pslist (cdr pslist)))
13460       (save-excursion
13461         (while pslist
13462           (setq after-article (or (cdr (assq 'article (car pslist)))
13463                                   (gnus-summary-article-number)))
13464           (gnus-summary-goto-subject after-article)
13465           (forward-line 1)
13466           (setq b (point))
13467           (insert "    " (file-name-nondirectory
13468                                 (cdr (assq 'name (car pslist))))
13469                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
13470           (setq e (point))
13471           (forward-line -1)             ; back to `b'
13472           (gnus-add-text-properties
13473            b (1- e) (list 'gnus-number gnus-reffed-article-number
13474                           gnus-mouse-face-prop gnus-mouse-face))
13475           (gnus-data-enter
13476            after-article gnus-reffed-article-number
13477            gnus-unread-mark b (car pslist) 0 (- e b))
13478           (push gnus-reffed-article-number gnus-newsgroup-unreads)
13479           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
13480           (setq pslist (cdr pslist)))))))
13481
13482 (defun gnus-pseudos< (p1 p2)
13483   (let ((c1 (cdr (assq 'action p1)))
13484         (c2 (cdr (assq 'action p2))))
13485     (and c1 c2 (string< c1 c2))))
13486
13487 (defun gnus-request-pseudo-article (props)
13488   (cond ((assq 'execute props)
13489          (gnus-execute-command (cdr (assq 'execute props)))))
13490   (let ((gnus-current-article (gnus-summary-article-number)))
13491     (run-hooks 'gnus-mark-article-hook)))
13492
13493 (defun gnus-execute-command (command &optional automatic)
13494   (save-excursion
13495     (gnus-article-setup-buffer)
13496     (set-buffer gnus-article-buffer)
13497     (setq buffer-read-only nil)
13498     (let ((command (if automatic command (read-string "Command: " command)))
13499           ;; Just binding this here doesn't help, because there might
13500           ;; be output from the process after exiting the scope of 
13501           ;; this `let'.
13502           ;; (buffer-read-only nil)
13503           )
13504       (erase-buffer)
13505       (insert "$ " command "\n\n")
13506       (if gnus-view-pseudo-asynchronously
13507           (start-process "gnus-execute" nil shell-file-name
13508                          shell-command-switch command)
13509         (call-process shell-file-name nil t nil
13510                       shell-command-switch command)))))
13511
13512 (defun gnus-copy-file (file &optional to)
13513   "Copy FILE to TO."
13514   (interactive
13515    (list (read-file-name "Copy file: " default-directory)
13516          (read-file-name "Copy file to: " default-directory)))
13517   (gnus-set-global-variables)
13518   (or to (setq to (read-file-name "Copy file to: " default-directory)))
13519   (and (file-directory-p to)
13520        (setq to (concat (file-name-as-directory to)
13521                         (file-name-nondirectory file))))
13522   (copy-file file to))
13523
13524 ;; Summary kill commands.
13525
13526 (defun gnus-summary-edit-global-kill (article)
13527   "Edit the \"global\" kill file."
13528   (interactive (list (gnus-summary-article-number)))
13529   (gnus-set-global-variables)
13530   (gnus-group-edit-global-kill article))
13531
13532 (defun gnus-summary-edit-local-kill ()
13533   "Edit a local kill file applied to the current newsgroup."
13534   (interactive)
13535   (gnus-set-global-variables)
13536   (setq gnus-current-headers (gnus-summary-article-header))
13537   (gnus-set-global-variables)
13538   (gnus-group-edit-local-kill
13539    (gnus-summary-article-number) gnus-newsgroup-name))
13540
13541 \f
13542 ;;;
13543 ;;; Gnus article mode
13544 ;;;
13545
13546 (put 'gnus-article-mode 'mode-class 'special)
13547
13548 (if gnus-article-mode-map
13549     nil
13550   (setq gnus-article-mode-map (make-keymap))
13551   (suppress-keymap gnus-article-mode-map)
13552
13553   (gnus-define-keys gnus-article-mode-map
13554     " " gnus-article-goto-next-page
13555     "\177" gnus-article-goto-prev-page
13556     [delete] gnus-article-goto-prev-page
13557     "\C-c^" gnus-article-refer-article
13558     "h" gnus-article-show-summary
13559     "s" gnus-article-show-summary
13560     "\C-c\C-m" gnus-article-mail
13561     "?" gnus-article-describe-briefly
13562     gnus-mouse-2 gnus-article-push-button
13563     "\r" gnus-article-press-button
13564     "\t" gnus-article-next-button
13565     "\M-\t" gnus-article-prev-button
13566     "<" beginning-of-buffer
13567     ">" end-of-buffer
13568     "\C-c\C-i" gnus-info-find-node
13569     "\C-c\C-b" gnus-bug)
13570
13571   (substitute-key-definition
13572    'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
13573
13574 (defun gnus-article-mode ()
13575   "Major mode for displaying an article.
13576
13577 All normal editing commands are switched off.
13578
13579 The following commands are available:
13580
13581 \\<gnus-article-mode-map>
13582 \\[gnus-article-next-page]\t Scroll the article one page forwards
13583 \\[gnus-article-prev-page]\t Scroll the article one page backwards
13584 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
13585 \\[gnus-article-show-summary]\t Display the summary buffer
13586 \\[gnus-article-mail]\t Send a reply to the address near point
13587 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
13588 \\[gnus-info-find-node]\t Go to the Gnus info node"
13589   (interactive)
13590   (when (and menu-bar-mode
13591              (gnus-visual-p 'article-menu 'menu))
13592     (gnus-article-make-menu-bar))
13593   (kill-all-local-variables)
13594   (gnus-simplify-mode-line)
13595   (setq mode-name "Article")
13596   (setq major-mode 'gnus-article-mode)
13597   (make-local-variable 'minor-mode-alist)
13598   (or (assq 'gnus-show-mime minor-mode-alist)
13599       (setq minor-mode-alist
13600             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
13601   (use-local-map gnus-article-mode-map)
13602   (make-local-variable 'page-delimiter)
13603   (setq page-delimiter gnus-page-delimiter)
13604   (buffer-disable-undo (current-buffer))
13605   (setq buffer-read-only t)             ;Disable modification
13606   (run-hooks 'gnus-article-mode-hook))
13607
13608 (defun gnus-article-setup-buffer ()
13609   "Initialize the article buffer."
13610   (let* ((name (if gnus-single-article-buffer "*Article*"
13611                  (concat "*Article " gnus-newsgroup-name "*")))
13612          (original
13613           (progn (string-match "\\*Article" name)
13614                  (concat " *Original Article"
13615                          (substring name (match-end 0))))))
13616     (setq gnus-article-buffer name)
13617     (setq gnus-original-article-buffer original)
13618     ;; This might be a variable local to the summary buffer.
13619     (unless gnus-single-article-buffer
13620       (save-excursion
13621         (set-buffer gnus-summary-buffer)
13622         (setq gnus-article-buffer name)
13623         (setq gnus-original-article-buffer original)
13624         (gnus-set-global-variables))
13625       (make-local-variable 'gnus-summary-buffer))
13626     ;; Init original article buffer.
13627     (save-excursion
13628       (set-buffer (get-buffer-create gnus-original-article-buffer))
13629       (buffer-disable-undo (current-buffer))
13630       (setq major-mode 'gnus-original-article-mode)
13631       (gnus-add-current-to-buffer-list)
13632       (make-local-variable 'gnus-original-article))
13633     (if (get-buffer name)
13634         (save-excursion
13635           (set-buffer name)
13636           (buffer-disable-undo (current-buffer))
13637           (setq buffer-read-only t)
13638           (gnus-add-current-to-buffer-list)
13639           (or (eq major-mode 'gnus-article-mode)
13640               (gnus-article-mode))
13641           (current-buffer))
13642       (save-excursion
13643         (set-buffer (get-buffer-create name))
13644         (gnus-add-current-to-buffer-list)
13645         (gnus-article-mode)
13646         (current-buffer)))))
13647
13648 ;; Set article window start at LINE, where LINE is the number of lines
13649 ;; from the head of the article.
13650 (defun gnus-article-set-window-start (&optional line)
13651   (set-window-start
13652    (get-buffer-window gnus-article-buffer t)
13653    (save-excursion
13654      (set-buffer gnus-article-buffer)
13655      (goto-char (point-min))
13656      (if (not line)
13657          (point-min)
13658        (gnus-message 6 "Moved to bookmark")
13659        (search-forward "\n\n" nil t)
13660        (forward-line line)
13661        (point)))))
13662
13663 (defun gnus-kill-all-overlays ()
13664   "Delete all overlays in the current buffer."
13665   (when (fboundp 'overlay-lists)
13666     (let* ((overlayss (overlay-lists))
13667            (buffer-read-only nil)
13668            (overlays (nconc (car overlayss) (cdr overlayss))))
13669       (while overlays
13670         (delete-overlay (pop overlays))))))
13671
13672 (defun gnus-request-article-this-buffer (article group)
13673   "Get an article and insert it into this buffer."
13674   (let (do-update-line)
13675     (prog1
13676         (save-excursion
13677           (erase-buffer)
13678           (gnus-kill-all-overlays)
13679           (setq group (or group gnus-newsgroup-name))
13680
13681           ;; Open server if it has closed.
13682           (gnus-check-server (gnus-find-method-for-group group))
13683
13684           ;; Using `gnus-request-article' directly will insert the article into
13685           ;; `nntp-server-buffer' - so we'll save some time by not having to
13686           ;; copy it from the server buffer into the article buffer.
13687
13688           ;; We only request an article by message-id when we do not have the
13689           ;; headers for it, so we'll have to get those.
13690           (when (stringp article)
13691             (let ((gnus-override-method gnus-refer-article-method))
13692               (gnus-read-header article)))
13693
13694           ;; If the article number is negative, that means that this article
13695           ;; doesn't belong in this newsgroup (possibly), so we find its
13696           ;; message-id and request it by id instead of number.
13697           (when (and (numberp article)
13698                      gnus-summary-buffer
13699                      (get-buffer gnus-summary-buffer)
13700                      (buffer-name (get-buffer gnus-summary-buffer)))
13701             (save-excursion
13702               (set-buffer gnus-summary-buffer)
13703               (let ((header (gnus-summary-article-header article)))
13704                 (if (< article 0)
13705                     (cond 
13706                      ((memq article gnus-newsgroup-sparse)
13707                       ;; This is a sparse gap article.
13708                       (setq do-update-line article)
13709                       (setq article (mail-header-id header))
13710                       (let ((gnus-override-method gnus-refer-article-method))
13711                         (gnus-read-header article))
13712                       (setq gnus-newsgroup-sparse
13713                             (delq article gnus-newsgroup-sparse)))
13714                      ((vectorp header)
13715                       ;; It's a real article.
13716                       (setq article (mail-header-id header)))
13717                      (t
13718                       ;; It is an extracted pseudo-article.
13719                       (setq article 'pseudo)
13720                       (gnus-request-pseudo-article header))))
13721                 
13722                 (let ((method (gnus-find-method-for-group 
13723                                gnus-newsgroup-name)))
13724                   (if (not (eq (car method) 'nneething))
13725                       ()
13726                     (let ((dir (concat (file-name-as-directory (nth 1 method))
13727                                        (mail-header-subject header))))
13728                       (if (file-directory-p dir)
13729                           (progn
13730                             (setq article 'nneething)
13731                             (gnus-group-enter-directory dir)))))))))
13732
13733           (cond
13734            ;; Refuse to select canceled articles.
13735            ((and (numberp article)
13736                  gnus-summary-buffer
13737                  (get-buffer gnus-summary-buffer)
13738                  (buffer-name (get-buffer gnus-summary-buffer))
13739                  (eq (cdr (save-excursion
13740                             (set-buffer gnus-summary-buffer)
13741                             (assq article gnus-newsgroup-reads)))
13742                      gnus-canceled-mark))
13743             nil)
13744            ;; We first check `gnus-original-article-buffer'.
13745            ((and (get-buffer gnus-original-article-buffer)
13746                  (numberp article)
13747                  (save-excursion
13748                    (set-buffer gnus-original-article-buffer)
13749                    (and (equal (car gnus-original-article) group)
13750                         (eq (cdr gnus-original-article) article))))
13751             (insert-buffer-substring gnus-original-article-buffer)
13752             'article)
13753            ;; Check the backlog.
13754            ((and gnus-keep-backlog
13755                  (gnus-backlog-request-article group article (current-buffer)))
13756             'article)
13757            ;; Check the cache.
13758            ((and gnus-use-cache
13759                  (numberp article)
13760                  (gnus-cache-request-article article group))
13761             'article)
13762            ;; Get the article and put into the article buffer.
13763            ((or (stringp article) (numberp article))
13764             (let ((gnus-override-method
13765                    (and (stringp article) gnus-refer-article-method))
13766                   (buffer-read-only nil))
13767               (erase-buffer)
13768               (gnus-kill-all-overlays)
13769               (if (gnus-request-article article group (current-buffer))
13770                   (progn
13771                     (and gnus-keep-backlog
13772                          (numberp article)
13773                          (gnus-backlog-enter-article
13774                           group article (current-buffer)))
13775                     'article))))
13776            ;; It was a pseudo.
13777            (t article)))
13778
13779       ;; Take the article from the original article buffer
13780       ;; and place it in the buffer it's supposed to be in.
13781       (when (and (get-buffer gnus-article-buffer)
13782                  ;;(numberp article)
13783                  (equal (buffer-name (current-buffer))
13784                         (buffer-name (get-buffer gnus-article-buffer))))
13785         (save-excursion
13786           (if (get-buffer gnus-original-article-buffer)
13787               (set-buffer (get-buffer gnus-original-article-buffer))
13788             (set-buffer (get-buffer-create gnus-original-article-buffer))
13789             (buffer-disable-undo (current-buffer))
13790             (setq major-mode 'gnus-original-article-mode)
13791             (setq buffer-read-only t)
13792             (gnus-add-current-to-buffer-list))
13793           (let (buffer-read-only)
13794             (erase-buffer)
13795             (insert-buffer-substring gnus-article-buffer))
13796           (setq gnus-original-article (cons group article))))
13797     
13798       ;; Update sparse articles.
13799       (when (and do-update-line
13800                  (or (numberp article)
13801                      (stringp article)))
13802         (let ((buf (current-buffer)))
13803           (set-buffer gnus-summary-buffer)
13804           (gnus-summary-update-article do-update-line)
13805           (gnus-summary-goto-subject do-update-line nil t)
13806           (set-window-point (get-buffer-window (current-buffer) t)
13807                             (point))
13808           (set-buffer buf))))))
13809
13810 (defun gnus-read-header (id &optional header)
13811   "Read the headers of article ID and enter them into the Gnus system."
13812   (let ((group gnus-newsgroup-name)
13813         (gnus-override-method 
13814          (and (gnus-news-group-p gnus-newsgroup-name)
13815               gnus-refer-article-method))       
13816         where)
13817     ;; First we check to see whether the header in question is already
13818     ;; fetched.
13819     (if (stringp id)
13820         ;; This is a Message-ID.
13821         (setq header (or header (gnus-id-to-header id)))
13822       ;; This is an article number.
13823       (setq header (or header (gnus-summary-article-header id))))
13824     (if (and header
13825              (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
13826         ;; We have found the header.
13827         header
13828       ;; We have to really fetch the header to this article.
13829       (when (setq where (gnus-request-head id group))
13830         (save-excursion
13831           (set-buffer nntp-server-buffer)
13832           (goto-char (point-max))
13833           (insert ".\n")
13834           (goto-char (point-min))
13835           (insert "211 ")
13836           (princ (cond
13837                   ((numberp id) id)
13838                   ((cdr where) (cdr where))
13839                   (header (mail-header-number header))
13840                   (t gnus-reffed-article-number))
13841                  (current-buffer))
13842           (insert " Article retrieved.\n"))
13843         ;(when (and header
13844         ;          (memq (mail-header-number header) gnus-newsgroup-sparse))
13845         ;  (setcar (gnus-id-to-thread id) nil))
13846         (if (not (setq header (car (gnus-get-newsgroup-headers))))
13847             ()                          ; Malformed head.
13848           (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
13849             (if (and (stringp id)
13850                      (not (string= (gnus-group-real-name group)
13851                                    (car where))))
13852                 ;; If we fetched by Message-ID and the article came
13853                 ;; from a different group, we fudge some bogus article
13854                 ;; numbers for this article.
13855                 (mail-header-set-number header gnus-reffed-article-number))
13856             (decf gnus-reffed-article-number)
13857             (gnus-remove-header (mail-header-number header))
13858             (push header gnus-newsgroup-headers)
13859             (setq gnus-current-headers header)
13860             (push (mail-header-number header) gnus-newsgroup-limit))
13861           header)))))
13862
13863 (defun gnus-remove-header (number)
13864   "Remove header NUMBER from `gnus-newsgroup-headers'."
13865   (if (and gnus-newsgroup-headers
13866            (= number (mail-header-number (car gnus-newsgroup-headers))))
13867       (pop gnus-newsgroup-headers)
13868     (let ((headers gnus-newsgroup-headers))
13869       (while (and (cdr headers)
13870                   (not (= number (mail-header-number (cadr headers)))))
13871         (pop headers))
13872       (when (cdr headers)
13873         (setcdr headers (cddr headers))))))
13874
13875 (defun gnus-article-prepare (article &optional all-headers header)
13876   "Prepare ARTICLE in article mode buffer.
13877 ARTICLE should either be an article number or a Message-ID.
13878 If ARTICLE is an id, HEADER should be the article headers.
13879 If ALL-HEADERS is non-nil, no headers are hidden."
13880   (save-excursion
13881     ;; Make sure we start in a summary buffer.
13882     (unless (eq major-mode 'gnus-summary-mode)
13883       (set-buffer gnus-summary-buffer))
13884     (setq gnus-summary-buffer (current-buffer))
13885     ;; Make sure the connection to the server is alive.
13886     (unless (gnus-server-opened
13887              (gnus-find-method-for-group gnus-newsgroup-name))
13888       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
13889       (gnus-request-group gnus-newsgroup-name t))
13890     (let* ((article (if header (mail-header-number header) article))
13891            (summary-buffer (current-buffer))
13892            (internal-hook gnus-article-internal-prepare-hook)
13893            (group gnus-newsgroup-name)
13894            result)
13895       (save-excursion
13896         (gnus-article-setup-buffer)
13897         (set-buffer gnus-article-buffer)
13898         ;; Deactivate active regions.
13899         (when (and (boundp 'transient-mark-mode)
13900                    transient-mark-mode)
13901           (setq mark-active nil))
13902         (if (not (setq result (let ((buffer-read-only nil))
13903                                 (gnus-request-article-this-buffer
13904                                  article group))))
13905             ;; There is no such article.
13906             (save-excursion
13907               (when (and (numberp article)
13908                          (not (memq article gnus-newsgroup-sparse)))
13909                 (setq gnus-article-current
13910                       (cons gnus-newsgroup-name article))
13911                 (set-buffer gnus-summary-buffer)
13912                 (setq gnus-current-article article)
13913                 (gnus-summary-mark-article article gnus-canceled-mark))
13914               (unless (memq article gnus-newsgroup-sparse)
13915                 (gnus-error
13916                  1 "No such article (may have expired or been canceled)")))
13917           (if (or (eq result 'pseudo) (eq result 'nneething))
13918               (progn
13919                 (save-excursion
13920                   (set-buffer summary-buffer)
13921                   (setq gnus-last-article gnus-current-article
13922                         gnus-newsgroup-history (cons gnus-current-article
13923                                                      gnus-newsgroup-history)
13924                         gnus-current-article 0
13925                         gnus-current-headers nil
13926                         gnus-article-current nil)
13927                   (if (eq result 'nneething)
13928                       (gnus-configure-windows 'summary)
13929                     (gnus-configure-windows 'article))
13930                   (gnus-set-global-variables))
13931                 (gnus-set-mode-line 'article))
13932             ;; The result from the `request' was an actual article -
13933             ;; or at least some text that is now displayed in the
13934             ;; article buffer.
13935             (if (and (numberp article)
13936                      (not (eq article gnus-current-article)))
13937                 ;; Seems like a new article has been selected.
13938                 ;; `gnus-current-article' must be an article number.
13939                 (save-excursion
13940                   (set-buffer summary-buffer)
13941                   (setq gnus-last-article gnus-current-article
13942                         gnus-newsgroup-history (cons gnus-current-article
13943                                                      gnus-newsgroup-history)
13944                         gnus-current-article article
13945                         gnus-current-headers
13946                         (gnus-summary-article-header gnus-current-article)
13947                         gnus-article-current
13948                         (cons gnus-newsgroup-name gnus-current-article))
13949                   (unless (vectorp gnus-current-headers)
13950                     (setq gnus-current-headers nil))
13951                   (gnus-summary-show-thread)
13952                   (run-hooks 'gnus-mark-article-hook)
13953                   (gnus-set-mode-line 'summary)
13954                   (and (gnus-visual-p 'article-highlight 'highlight)
13955                        (run-hooks 'gnus-visual-mark-article-hook))
13956                   ;; Set the global newsgroup variables here.
13957                   ;; Suggested by Jim Sisolak
13958                   ;; <sisolak@trans4.neep.wisc.edu>.
13959                   (gnus-set-global-variables)
13960                   (setq gnus-have-all-headers
13961                         (or all-headers gnus-show-all-headers))
13962                   (and gnus-use-cache
13963                        (vectorp (gnus-summary-article-header article))
13964                        (gnus-cache-possibly-enter-article
13965                         group article
13966                         (gnus-summary-article-header article)
13967                         (memq article gnus-newsgroup-marked)
13968                         (memq article gnus-newsgroup-dormant)
13969                         (memq article gnus-newsgroup-unreads)))))
13970             (when (or (numberp article)
13971                       (stringp article))
13972               ;; Hooks for getting information from the article.
13973               ;; This hook must be called before being narrowed.
13974               (let (buffer-read-only)
13975                 (run-hooks 'internal-hook)
13976                 (run-hooks 'gnus-article-prepare-hook)
13977                 ;; Decode MIME message.
13978                 (if gnus-show-mime
13979                     (if (or (not gnus-strict-mime)
13980                             (gnus-fetch-field "Mime-Version"))
13981                         (funcall gnus-show-mime-method)
13982                       (funcall gnus-decode-encoded-word-method)))
13983                 ;; Perform the article display hooks.
13984                 (run-hooks 'gnus-article-display-hook))
13985               ;; Do page break.
13986               (goto-char (point-min))
13987               (and gnus-break-pages (gnus-narrow-to-page)))
13988             (gnus-set-mode-line 'article)
13989             (gnus-configure-windows 'article)
13990             (goto-char (point-min))
13991             t))))))
13992
13993 (defun gnus-article-show-all-headers ()
13994   "Show all article headers in article mode buffer."
13995   (save-excursion
13996     (gnus-article-setup-buffer)
13997     (set-buffer gnus-article-buffer)
13998     (let ((buffer-read-only nil))
13999       (gnus-unhide-text (point-min) (point-max)))))
14000
14001 (defun gnus-article-hide-headers-if-wanted ()
14002   "Hide unwanted headers if `gnus-have-all-headers' is nil.
14003 Provided for backwards compatibility."
14004   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
14005       gnus-inhibit-hiding
14006       (gnus-article-hide-headers)))
14007
14008 (defsubst gnus-article-header-rank ()
14009   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
14010   (let ((list gnus-sorted-header-list)
14011         (i 0))
14012     (while list
14013       (when (looking-at (car list))
14014         (setq list nil))
14015       (setq list (cdr list))
14016       (incf i))
14017     i))
14018
14019 (defun gnus-article-hide-headers (&optional arg delete)
14020   "Toggle whether to hide unwanted headers and possibly sort them as well.
14021 If given a negative prefix, always show; if given a positive prefix,
14022 always hide."
14023   (interactive (gnus-hidden-arg))
14024   (if (gnus-article-check-hidden-text 'headers arg)
14025       ;; Show boring headers as well.
14026       (gnus-article-show-hidden-text 'boring-headers)
14027     ;; This function might be inhibited.
14028     (unless gnus-inhibit-hiding
14029       (save-excursion
14030         (set-buffer gnus-article-buffer)
14031         (save-restriction
14032           (let ((buffer-read-only nil)
14033                 (props (nconc (list 'gnus-type 'headers)
14034                               gnus-hidden-properties))
14035                 (max (1+ (length gnus-sorted-header-list)))
14036                 (ignored (when (not (stringp gnus-visible-headers))
14037                            (cond ((stringp gnus-ignored-headers)
14038                                   gnus-ignored-headers)
14039                                  ((listp gnus-ignored-headers)
14040                                   (mapconcat 'identity gnus-ignored-headers
14041                                              "\\|")))))
14042                 (visible
14043                  (cond ((stringp gnus-visible-headers)
14044                         gnus-visible-headers)
14045                        ((and gnus-visible-headers
14046                              (listp gnus-visible-headers))
14047                         (mapconcat 'identity gnus-visible-headers "\\|"))))
14048                 (inhibit-point-motion-hooks t)
14049                 want-list beg)
14050             ;; First we narrow to just the headers.
14051             (widen)
14052             (goto-char (point-min))
14053             ;; Hide any "From " lines at the beginning of (mail) articles.
14054             (while (looking-at "From ")
14055               (forward-line 1))
14056             (unless (bobp)
14057               (if delete
14058                   (delete-region (point-min) (point))
14059                 (gnus-hide-text (point-min) (point) props)))
14060             ;; Then treat the rest of the header lines.
14061             (narrow-to-region
14062              (point)
14063              (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
14064             ;; Then we use the two regular expressions
14065             ;; `gnus-ignored-headers' and `gnus-visible-headers' to
14066             ;; select which header lines is to remain visible in the
14067             ;; article buffer.
14068             (goto-char (point-min))
14069             (while (re-search-forward "^[^ \t]*:" nil t)
14070               (beginning-of-line)
14071               ;; We add the headers we want to keep to a list and delete
14072               ;; them from the buffer.
14073               (gnus-put-text-property 
14074                (point) (1+ (point)) 'message-rank
14075                (if (or (and visible (looking-at visible))
14076                        (and ignored
14077                             (not (looking-at ignored))))
14078                    (gnus-article-header-rank) 
14079                  (+ 2 max)))
14080               (forward-line 1))
14081             (message-sort-headers-1)
14082             (when (setq beg (text-property-any 
14083                              (point-min) (point-max) 'message-rank (+ 2 max)))
14084               ;; We make the unwanted headers invisible.
14085               (if delete
14086                   (delete-region beg (point-max))
14087                 ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
14088                 (gnus-hide-text-type beg (point-max) 'headers))
14089               ;; Work around XEmacs lossage.
14090               (gnus-put-text-property (point-min) beg 'invisible nil))))))))
14091
14092 (defun gnus-article-hide-boring-headers (&optional arg)
14093   "Toggle hiding of headers that aren't very interesting.
14094 If given a negative prefix, always show; if given a positive prefix,
14095 always hide."
14096   (interactive (gnus-hidden-arg))
14097   (unless (gnus-article-check-hidden-text 'boring-headers arg)
14098     (save-excursion
14099       (set-buffer gnus-article-buffer)
14100       (save-restriction
14101         (let ((buffer-read-only nil)
14102               (list gnus-boring-article-headers)
14103               (inhibit-point-motion-hooks t)
14104               elem)
14105           (nnheader-narrow-to-headers)
14106           (while list
14107             (setq elem (pop list))
14108             (goto-char (point-min))
14109             (cond
14110              ;; Hide empty headers.
14111              ((eq elem 'empty)
14112               (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
14113                 (forward-line -1)
14114                 (gnus-hide-text-type
14115                  (progn (beginning-of-line) (point))
14116                  (progn 
14117                    (end-of-line)
14118                    (if (re-search-forward "^[^ \t]" nil t)
14119                        (match-beginning 0)
14120                      (point-max)))
14121                  'boring-headers)))
14122              ;; Hide boring Newsgroups header.
14123              ((eq elem 'newsgroups)
14124               (when (equal (message-fetch-field "newsgroups")
14125                            (gnus-group-real-name gnus-newsgroup-name))
14126                 (gnus-article-hide-header "newsgroups")))
14127              ((eq elem 'followup-to)
14128               (when (equal (message-fetch-field "followup-to")
14129                            (message-fetch-field "newsgroups"))
14130                 (gnus-article-hide-header "followup-to")))
14131              ((eq elem 'reply-to)
14132               (let ((from (message-fetch-field "from"))
14133                     (reply-to (message-fetch-field "reply-to")))
14134                 (when (and
14135                        from reply-to
14136                        (equal 
14137                         (nth 1 (funcall gnus-extract-address-components from))
14138                         (nth 1 (funcall gnus-extract-address-components
14139                                         reply-to))))
14140                   (gnus-article-hide-header "reply-to"))))
14141              ((eq elem 'date)
14142               (let ((date (message-fetch-field "date")))
14143                 (when (and date
14144                            (< (gnus-days-between date (current-time-string))
14145                               4))
14146                   (gnus-article-hide-header "date")))))))))))
14147
14148 (defun gnus-article-hide-header (header)
14149   (save-excursion
14150     (goto-char (point-min))
14151     (when (re-search-forward (concat "^" header ":") nil t)
14152       (gnus-hide-text-type
14153        (progn (beginning-of-line) (point))
14154        (progn 
14155          (end-of-line)
14156          (if (re-search-forward "^[^ \t]" nil t)
14157              (match-beginning 0)
14158            (point-max)))
14159        'boring-headers))))
14160
14161 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
14162 (defun gnus-article-treat-overstrike ()
14163   "Translate overstrikes into bold text."
14164   (interactive)
14165   (save-excursion
14166     (set-buffer gnus-article-buffer)
14167     (let ((buffer-read-only nil))
14168       (while (search-forward "\b" nil t)
14169         (let ((next (following-char))
14170               (previous (char-after (- (point) 2))))
14171           (cond 
14172            ((eq next previous)
14173             (gnus-put-text-property (- (point) 2) (point) 'invisible t)
14174             (gnus-put-text-property (point) (1+ (point)) 'face 'bold))
14175            ((eq next ?_)
14176             (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t)
14177             (gnus-put-text-property
14178              (- (point) 2) (1- (point)) 'face 'underline))
14179            ((eq previous ?_)
14180             (gnus-put-text-property (- (point) 2) (point) 'invisible t)
14181             (gnus-put-text-property
14182              (point) (1+ (point))       'face 'underline))))))))
14183
14184 (defun gnus-article-word-wrap ()
14185   "Format too long lines."
14186   (interactive)
14187   (save-excursion
14188     (set-buffer gnus-article-buffer)
14189     (let ((buffer-read-only nil))
14190       (widen)
14191       (goto-char (point-min))
14192       (search-forward "\n\n" nil t)
14193       (end-of-line 1)
14194       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
14195             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
14196             (adaptive-fill-mode t))
14197         (while (not (eobp))
14198           (and (>= (current-column) (min fill-column (window-width)))
14199                (/= (preceding-char) ?:)
14200                (fill-paragraph nil))
14201           (end-of-line 2))))))
14202
14203 (defun gnus-article-remove-cr ()
14204   "Remove carriage returns from an article."
14205   (interactive)
14206   (save-excursion
14207     (set-buffer gnus-article-buffer)
14208     (let ((buffer-read-only nil))
14209       (goto-char (point-min))
14210       (while (search-forward "\r" nil t)
14211         (replace-match "" t t)))))
14212
14213 (defun gnus-article-remove-trailing-blank-lines ()
14214   "Remove all trailing blank lines from the article."
14215   (interactive)
14216   (save-excursion
14217     (set-buffer gnus-article-buffer)
14218     (let ((buffer-read-only nil))
14219       (goto-char (point-max))
14220       (delete-region
14221        (point)
14222        (progn
14223          (while (looking-at "^[ \t]*$")
14224            (forward-line -1))
14225          (forward-line 1)
14226          (point))))))
14227
14228 (defun gnus-article-display-x-face (&optional force)
14229   "Look for an X-Face header and display it if present."
14230   (interactive (list 'force))
14231   (save-excursion
14232     (set-buffer gnus-article-buffer)
14233     ;; Delete the old process, if any.
14234     (when (process-status "gnus-x-face")
14235       (delete-process "gnus-x-face"))
14236     (let ((inhibit-point-motion-hooks t)
14237           (case-fold-search nil)
14238           from)
14239       (save-restriction
14240         (nnheader-narrow-to-headers)
14241         (setq from (message-fetch-field "from"))
14242         (goto-char (point-min))
14243         (when (and gnus-article-x-face-command
14244                    (or force
14245                        ;; Check whether this face is censored.
14246                        (not gnus-article-x-face-too-ugly)
14247                        (and gnus-article-x-face-too-ugly from
14248                             (not (string-match gnus-article-x-face-too-ugly
14249                                                from))))
14250                    ;; Has to be present.
14251                    (re-search-forward "^X-Face: " nil t))
14252           ;; We now have the area of the buffer where the X-Face is stored.
14253           (let ((beg (point))
14254                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
14255             ;; We display the face.
14256             (if (symbolp gnus-article-x-face-command)
14257                 ;; The command is a lisp function, so we call it.
14258                 (if (gnus-functionp gnus-article-x-face-command)
14259                     (funcall gnus-article-x-face-command beg end)
14260                   (error "%s is not a function" gnus-article-x-face-command))
14261               ;; The command is a string, so we interpret the command
14262               ;; as a, well, command, and fork it off.
14263               (let ((process-connection-type nil))
14264                 (process-kill-without-query
14265                  (start-process
14266                   "gnus-x-face" nil shell-file-name shell-command-switch
14267                   gnus-article-x-face-command))
14268                 (process-send-region "gnus-x-face" beg end)
14269                 (process-send-eof "gnus-x-face")))))))))
14270
14271 (defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522)
14272 (defun gnus-decode-rfc1522 ()
14273   "Hack to remove QP encoding from headers."
14274   (let ((case-fold-search t)
14275         (inhibit-point-motion-hooks t)
14276         (buffer-read-only nil)
14277         string)
14278     (save-restriction
14279       (narrow-to-region
14280        (goto-char (point-min))
14281        (or (search-forward "\n\n" nil t) (point-max)))
14282
14283       (goto-char (point-min))
14284       (while (re-search-forward 
14285               "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
14286         (setq string (match-string 1))
14287         (narrow-to-region (match-beginning 0) (match-end 0))
14288         (delete-region (point-min) (point-max))
14289         (insert string)
14290         (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
14291         (subst-char-in-region (point-min) (point-max) ?_ ? )
14292         (widen)
14293         (goto-char (point-min))))))
14294
14295 (defun gnus-article-de-quoted-unreadable (&optional force)
14296   "Do a naive translation of a quoted-printable-encoded article.
14297 This is in no way, shape or form meant as a replacement for real MIME
14298 processing, but is simply a stop-gap measure until MIME support is
14299 written.
14300 If FORCE, decode the article whether it is marked as quoted-printable
14301 or not."
14302   (interactive (list 'force))
14303   (save-excursion
14304     (set-buffer gnus-article-buffer)
14305     (let ((case-fold-search t)
14306           (buffer-read-only nil)
14307           (type (gnus-fetch-field "content-transfer-encoding")))
14308       (gnus-decode-rfc1522)
14309       (when (or force
14310                 (and type (string-match "quoted-printable" (downcase type))))
14311         (goto-char (point-min))
14312         (search-forward "\n\n" nil 'move)
14313         (gnus-mime-decode-quoted-printable (point) (point-max))))))
14314
14315 (defun gnus-mime-decode-quoted-printable (from to)
14316   "Decode Quoted-Printable in the region between FROM and TO."
14317   (interactive "r")
14318   (goto-char from)
14319   (while (search-forward "=" to t)
14320     (cond ((eq (following-char) ?\n)
14321            (delete-char -1)
14322            (delete-char 1))
14323           ((looking-at "[0-9A-F][0-9A-F]")
14324            (subst-char-in-region
14325             (1- (point)) (point) ?=
14326             (hexl-hex-string-to-integer
14327              (buffer-substring (point) (+ 2 (point)))))
14328            (delete-char 2))
14329           ((looking-at "=")
14330            (delete-char 1))
14331           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
14332
14333 (defun gnus-article-hide-pgp (&optional arg)
14334   "Toggle hiding of any PGP headers and signatures in the current article.
14335 If given a negative prefix, always show; if given a positive prefix,
14336 always hide."
14337   (interactive (gnus-hidden-arg))
14338   (unless (gnus-article-check-hidden-text 'pgp arg)
14339     (save-excursion
14340       (set-buffer gnus-article-buffer)
14341       (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties))
14342             buffer-read-only beg end)
14343         (widen)
14344         (goto-char (point-min))
14345         ;; Hide the "header".
14346         (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
14347              (gnus-hide-text (match-beginning 0) (match-end 0) props))
14348         (setq beg (point))
14349         ;; Hide the actual signature.
14350         (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
14351              (setq end (1+ (match-beginning 0)))
14352              (gnus-hide-text
14353               end
14354               (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
14355                   (match-end 0)
14356                 ;; Perhaps we shouldn't hide to the end of the buffer
14357                 ;; if there is no end to the signature?
14358                 (point-max))
14359               props))
14360         ;; Hide "- " PGP quotation markers.
14361         (when (and beg end)
14362           (narrow-to-region beg end)
14363           (goto-char (point-min))
14364           (while (re-search-forward "^- " nil t)
14365             (gnus-hide-text (match-beginning 0) (match-end 0) props))
14366           (widen))))))
14367
14368 (defun gnus-article-hide-pem (&optional arg)
14369   "Toggle hiding of any PEM headers and signatures in the current article.
14370 If given a negative prefix, always show; if given a positive prefix,
14371 always hide."
14372   (interactive (gnus-hidden-arg))
14373   (unless (gnus-article-check-hidden-text 'pem arg)
14374     (save-excursion
14375       (set-buffer gnus-article-buffer)
14376       (let ((props (nconc (list 'gnus-type 'pem) gnus-hidden-properties))
14377             buffer-read-only end)
14378         (widen)
14379         (goto-char (point-min))
14380         ;; hide the horrendously ugly "header".
14381         (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
14382                              nil
14383                              t)
14384              (setq end (1+ (match-beginning 0)))
14385              (gnus-hide-text
14386               end
14387               (if (search-forward "\n\n" nil t)
14388                   (match-end 0)
14389                 (point-max))
14390               props))
14391         ;; hide the trailer as well
14392         (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n"
14393                              nil
14394                              t)
14395              (gnus-hide-text (match-beginning 0) (match-end 0) props))))))
14396
14397 (defun gnus-article-hide-signature (&optional arg)
14398   "Hide the signature in the current article.
14399 If given a negative prefix, always show; if given a positive prefix,
14400 always hide."
14401   (interactive (gnus-hidden-arg))
14402   (unless (gnus-article-check-hidden-text 'signature arg)
14403     (save-excursion
14404       (set-buffer gnus-article-buffer)
14405       (save-restriction
14406         (let ((buffer-read-only nil))
14407           (when (gnus-narrow-to-signature)
14408             (gnus-hide-text-type (point-min) (point-max) 'signature)))))))
14409
14410 (defun gnus-article-strip-leading-blank-lines ()
14411   "Remove all blank lines from the beginning of the article."
14412   (interactive)
14413   (save-excursion
14414     (set-buffer gnus-article-buffer)
14415     (let (buffer-read-only)
14416       (goto-char (point-min))
14417       (when (search-forward "\n\n" nil t)
14418         (while (looking-at "[ \t]$")
14419           (gnus-delete-line))))))
14420
14421 (defvar mime::preview/content-list)
14422 (defvar mime::preview-content-info/point-min)
14423 (defun gnus-narrow-to-signature ()
14424   "Narrow to the signature."
14425   (widen)
14426   (if (and (boundp 'mime::preview/content-list)
14427            mime::preview/content-list)
14428       (let ((pcinfo (car (last mime::preview/content-list))))
14429         (condition-case ()
14430             (narrow-to-region
14431              (funcall (intern "mime::preview-content-info/point-min") pcinfo)
14432              (point-max))
14433           (error nil))))
14434   (goto-char (point-max))
14435   (when (re-search-backward gnus-signature-separator nil t)
14436     (forward-line 1)
14437     (when (or (null gnus-signature-limit)
14438               (and (numberp gnus-signature-limit)
14439                    (< (- (point-max) (point)) gnus-signature-limit))
14440               (and (gnus-functionp gnus-signature-limit)
14441                    (funcall gnus-signature-limit))
14442               (and (stringp gnus-signature-limit)
14443                    (not (re-search-forward gnus-signature-limit nil t))))
14444       (narrow-to-region (point) (point-max))
14445       t)))
14446
14447 (defun gnus-hidden-arg ()
14448   "Return the current prefix arg as a number, or 0 if no prefix."
14449   (list (if current-prefix-arg
14450             (prefix-numeric-value current-prefix-arg)
14451           0)))
14452
14453 (defun gnus-article-check-hidden-text (type arg)
14454   "Return nil if hiding is necessary.
14455 Arg can be nil or a number.  Nil and positive means hide, negative
14456 means show, 0 means toggle."
14457   (save-excursion
14458     (set-buffer gnus-article-buffer)
14459     (let ((hide (gnus-article-hidden-text-p type)))
14460       (cond
14461        ((or (null arg)
14462             (> arg 0))
14463         nil)
14464        ((< arg 0)
14465         (gnus-article-show-hidden-text type))
14466        (t
14467         (if (eq hide 'hidden)
14468             (gnus-article-show-hidden-text type)
14469           nil))))))
14470
14471 (defun gnus-article-hidden-text-p (type)
14472   "Say whether the current buffer contains hidden text of type TYPE."
14473   (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type)))
14474     (when pos
14475       (if (get-text-property pos 'invisible)
14476           'hidden
14477         'shown))))
14478
14479 (defun gnus-article-hide (&optional arg force)
14480   "Hide all the gruft in the current article.
14481 This means that PGP stuff, signatures, cited text and (some)
14482 headers will be hidden.
14483 If given a prefix, show the hidden text instead."
14484   (interactive (list current-prefix-arg 'force))
14485   (gnus-article-hide-headers arg)
14486   (gnus-article-hide-pgp arg)
14487   (gnus-article-hide-citation-maybe arg force)
14488   (gnus-article-hide-signature arg))
14489
14490 (defun gnus-article-show-hidden-text (type &optional hide)
14491   "Show all hidden text of type TYPE.
14492 If HIDE, hide the text instead."
14493   (save-excursion
14494     (set-buffer gnus-article-buffer)
14495     (let ((buffer-read-only nil)
14496           (inhibit-point-motion-hooks t)
14497           (beg (point-min)))
14498       (while (gnus-goto-char (text-property-any
14499                               beg (point-max) 'gnus-type type))
14500         (setq beg (point))
14501         (forward-char)
14502         (if hide
14503             (gnus-hide-text beg (point) gnus-hidden-properties)
14504           (gnus-unhide-text beg (point)))
14505         (setq beg (point)))
14506       t)))
14507
14508 (defvar gnus-article-time-units
14509   `((year . ,(* 365.25 24 60 60))
14510     (week . ,(* 7 24 60 60))
14511     (day . ,(* 24 60 60))
14512     (hour . ,(* 60 60))
14513     (minute . 60)
14514     (second . 1))
14515   "Mapping from time units to seconds.")
14516
14517 (defun gnus-article-date-ut (&optional type highlight)
14518   "Convert DATE date to universal time in the current article.
14519 If TYPE is `local', convert to local time; if it is `lapsed', output
14520 how much time has lapsed since DATE."
14521   (interactive (list 'ut t))
14522   (let* ((header (or gnus-current-headers
14523                      (gnus-summary-article-header) ""))
14524          (date (and (vectorp header) (mail-header-date header)))
14525          (date-regexp "^Date: \\|^X-Sent: ")
14526          (now (current-time))
14527          (inhibit-point-motion-hooks t)
14528          bface eface)
14529     (when (and date (not (string= date "")))
14530       (save-excursion
14531         (set-buffer gnus-article-buffer)
14532         (save-restriction
14533           (nnheader-narrow-to-headers)
14534           (let ((buffer-read-only nil))
14535             ;; Delete any old Date headers.
14536             (if (re-search-forward date-regexp nil t)
14537                 (progn
14538                   (setq bface (get-text-property (gnus-point-at-bol) 'face)
14539                         eface (get-text-property (1- (gnus-point-at-eol))
14540                                                  'face))
14541                   (message-remove-header date-regexp t)
14542                   (beginning-of-line))
14543               (goto-char (point-max)))
14544             (insert (gnus-make-date-line date type))
14545             ;; Do highlighting.
14546             (forward-line -1)
14547             (when (and (gnus-visual-p 'article-highlight 'highlight)
14548                        (looking-at "\\([^:]+\\): *\\(.*\\)$"))
14549               (gnus-put-text-property (match-beginning 1) (match-end 1)
14550                                  'face bface)
14551               (gnus-put-text-property (match-beginning 2) (match-end 2)
14552                                  'face eface))))))))
14553
14554 (defun gnus-make-date-line (date type)
14555   "Return a DATE line of TYPE."
14556   (cond
14557    ;; Convert to the local timezone.  We have to slap a
14558    ;; `condition-case' round the calls to the timezone
14559    ;; functions since they aren't particularly resistant to
14560    ;; buggy dates.
14561    ((eq type 'local)
14562     (concat "Date: " (condition-case ()
14563                          (timezone-make-date-arpa-standard date)
14564                        (error date))
14565             "\n"))
14566    ;; Convert to Universal Time.
14567    ((eq type 'ut)
14568     (concat "Date: "
14569             (condition-case ()
14570                 (timezone-make-date-arpa-standard date nil "UT")
14571               (error date))
14572             "\n"))
14573    ;; Get the original date from the article.
14574    ((eq type 'original)
14575     (concat "Date: " date "\n"))
14576    ;; Do an X-Sent lapsed format.
14577    ((eq type 'lapsed)
14578     ;; If the date is seriously mangled, the timezone
14579     ;; functions are liable to bug out, so we condition-case
14580     ;; the entire thing.
14581     (let* ((now (current-time))
14582            (real-time
14583             (condition-case ()
14584                 (gnus-time-minus
14585                  (gnus-encode-date
14586                   (timezone-make-date-arpa-standard
14587                    (current-time-string now)
14588                    (current-time-zone now) "UT"))
14589                  (gnus-encode-date
14590                   (timezone-make-date-arpa-standard
14591                    date nil "UT")))
14592               (error '(0 0))))
14593            (real-sec (+ (* (float (car real-time)) 65536)
14594                         (cadr real-time)))
14595            (sec (abs real-sec))
14596            num prev)
14597       (cond
14598        ((equal real-time '(0 0))
14599         "X-Sent: Unknown\n")
14600        ((zerop sec)
14601         "X-Sent: Now\n")
14602        (t
14603         (concat
14604          "X-Sent: "
14605          ;; This is a bit convoluted, but basically we go
14606          ;; through the time units for years, weeks, etc,
14607          ;; and divide things to see whether that results
14608          ;; in positive answers.
14609          (mapconcat
14610           (lambda (unit)
14611             (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
14612                 ;; The (remaining) seconds are too few to
14613                 ;; be divided into this time unit.
14614                 ""
14615               ;; It's big enough, so we output it.
14616               (setq sec (- sec (* num (cdr unit))))
14617               (prog1
14618                   (concat (if prev ", " "") (int-to-string
14619                                              (floor num))
14620                           " " (symbol-name (car unit)) 
14621                           (if (> num 1) "s" ""))
14622                 (setq prev t))))
14623           gnus-article-time-units "")
14624          ;; If dates are odd, then it might appear like the
14625          ;; article was sent in the future.
14626          (if (> real-sec 0)
14627              " ago\n"
14628            " in the future\n"))))))
14629    (t
14630     (error "Unknown conversion type: %s" type))))
14631
14632 (defun gnus-article-date-local (&optional highlight)
14633   "Convert the current article date to the local timezone."
14634   (interactive (list t))
14635   (gnus-article-date-ut 'local highlight))
14636
14637 (defun gnus-article-date-original (&optional highlight)
14638   "Convert the current article date to what it was originally.
14639 This is only useful if you have used some other date conversion
14640 function and want to see what the date was before converting."
14641   (interactive (list t))
14642   (gnus-article-date-ut 'original highlight))
14643
14644 (defun gnus-article-date-lapsed (&optional highlight)
14645   "Convert the current article date to time lapsed since it was sent."
14646   (interactive (list t))
14647   (gnus-article-date-ut 'lapsed highlight))
14648
14649 (defun gnus-article-maybe-highlight ()
14650   "Do some article highlighting if `gnus-visual' is non-nil."
14651   (if (gnus-visual-p 'article-highlight 'highlight)
14652       (gnus-article-highlight-some)))
14653
14654 ;;; Article savers.
14655
14656 (defun gnus-output-to-rmail (file-name)
14657   "Append the current article to an Rmail file named FILE-NAME."
14658   (require 'rmail)
14659   ;; Most of these codes are borrowed from rmailout.el.
14660   (setq file-name (expand-file-name file-name))
14661   (setq rmail-default-rmail-file file-name)
14662   (let ((artbuf (current-buffer))
14663         (tmpbuf (get-buffer-create " *Gnus-output*")))
14664     (save-excursion
14665       (or (get-file-buffer file-name)
14666           (file-exists-p file-name)
14667           (if (gnus-yes-or-no-p
14668                (concat "\"" file-name "\" does not exist, create it? "))
14669               (let ((file-buffer (create-file-buffer file-name)))
14670                 (save-excursion
14671                   (set-buffer file-buffer)
14672                   (rmail-insert-rmail-file-header)
14673                   (let ((require-final-newline nil))
14674                     (write-region (point-min) (point-max) file-name t 1)))
14675                 (kill-buffer file-buffer))
14676             (error "Output file does not exist")))
14677       (set-buffer tmpbuf)
14678       (buffer-disable-undo (current-buffer))
14679       (erase-buffer)
14680       (insert-buffer-substring artbuf)
14681       (gnus-convert-article-to-rmail)
14682       ;; Decide whether to append to a file or to an Emacs buffer.
14683       (let ((outbuf (get-file-buffer file-name)))
14684         (if (not outbuf)
14685             (append-to-file (point-min) (point-max) file-name)
14686           ;; File has been visited, in buffer OUTBUF.
14687           (set-buffer outbuf)
14688           (let ((buffer-read-only nil)
14689                 (msg (and (boundp 'rmail-current-message)
14690                           (symbol-value 'rmail-current-message))))
14691             ;; If MSG is non-nil, buffer is in RMAIL mode.
14692             (if msg
14693                 (progn (widen)
14694                        (narrow-to-region (point-max) (point-max))))
14695             (insert-buffer-substring tmpbuf)
14696             (if msg
14697                 (progn
14698                   (goto-char (point-min))
14699                   (widen)
14700                   (search-backward "\^_")
14701                   (narrow-to-region (point) (point-max))
14702                   (goto-char (1+ (point-min)))
14703                   (rmail-count-new-messages t)
14704                   (rmail-show-message msg)))))))
14705     (kill-buffer tmpbuf)))
14706
14707 (defun gnus-output-to-file (file-name)
14708   "Append the current article to a file named FILE-NAME."
14709   (let ((artbuf (current-buffer)))
14710     (nnheader-temp-write nil
14711       (insert-buffer-substring artbuf)
14712       ;; Append newline at end of the buffer as separator, and then
14713       ;; save it to file.
14714       (goto-char (point-max))
14715       (insert "\n")
14716       (append-to-file (point-min) (point-max) file-name))))
14717
14718 (defun gnus-convert-article-to-rmail ()
14719   "Convert article in current buffer to Rmail message format."
14720   (let ((buffer-read-only nil))
14721     ;; Convert article directly into Babyl format.
14722     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
14723     (goto-char (point-min))
14724     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
14725     (while (search-forward "\n\^_" nil t) ;single char
14726       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
14727     (goto-char (point-max))
14728     (insert "\^_")))
14729
14730 (defun gnus-narrow-to-page (&optional arg)
14731   "Narrow the article buffer to a page.
14732 If given a numerical ARG, move forward ARG pages."
14733   (interactive "P")
14734   (setq arg (if arg (prefix-numeric-value arg) 0))
14735   (save-excursion
14736     (set-buffer gnus-article-buffer)
14737     (goto-char (point-min))
14738     (widen)
14739     (when (gnus-visual-p 'page-marker)
14740       (let ((buffer-read-only nil))
14741         (gnus-remove-text-with-property 'gnus-prev)
14742         (gnus-remove-text-with-property 'gnus-next)))
14743     (when
14744         (cond ((< arg 0)
14745                (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
14746               ((> arg 0)
14747                (re-search-forward page-delimiter nil 'move arg)))
14748       (goto-char (match-end 0)))
14749     (narrow-to-region
14750      (point)
14751      (if (re-search-forward page-delimiter nil 'move)
14752          (match-beginning 0)
14753        (point)))
14754     (when (and (gnus-visual-p 'page-marker)
14755                (not (= (point-min) 1)))
14756       (save-excursion
14757         (goto-char (point-min))
14758         (gnus-insert-prev-page-button)))
14759     (when (and (gnus-visual-p 'page-marker)
14760                (not (= (1- (point-max)) (buffer-size))))
14761       (save-excursion
14762         (goto-char (point-max))
14763         (gnus-insert-next-page-button)))))
14764
14765 ;; Article mode commands
14766
14767 (defun gnus-article-goto-next-page ()
14768   "Show the next page of the article."
14769   (interactive)
14770   (when (gnus-article-next-page)
14771     (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
14772
14773 (defun gnus-article-goto-prev-page ()
14774   "Show the next page of the article."
14775   (interactive)
14776   (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))
14777     (gnus-article-prev-page nil)))
14778
14779 (defun gnus-article-next-page (&optional lines)
14780   "Show the next page of the current article.
14781 If end of article, return non-nil.  Otherwise return nil.
14782 Argument LINES specifies lines to be scrolled up."
14783   (interactive "p")
14784   (move-to-window-line -1)
14785   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
14786   (if (save-excursion
14787         (end-of-line)
14788         (and (pos-visible-in-window-p)  ;Not continuation line.
14789              (eobp)))
14790       ;; Nothing in this page.
14791       (if (or (not gnus-break-pages)
14792               (save-excursion
14793                 (save-restriction
14794                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
14795           t                             ;Nothing more.
14796         (gnus-narrow-to-page 1)         ;Go to next page.
14797         nil)
14798     ;; More in this page.
14799     (condition-case ()
14800         (scroll-up lines)
14801       (end-of-buffer
14802        ;; Long lines may cause an end-of-buffer error.
14803        (goto-char (point-max))))
14804     (move-to-window-line 0)
14805     nil))
14806
14807 (defun gnus-article-prev-page (&optional lines)
14808   "Show previous page of current article.
14809 Argument LINES specifies lines to be scrolled down."
14810   (interactive "p")
14811   (move-to-window-line 0)
14812   (if (and gnus-break-pages
14813            (bobp)
14814            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
14815       (progn
14816         (gnus-narrow-to-page -1)        ;Go to previous page.
14817         (goto-char (point-max))
14818         (recenter -1))
14819     (prog1
14820         (condition-case ()
14821             (scroll-down lines)
14822           (error nil))
14823       (move-to-window-line 0))))
14824
14825 (defun gnus-article-refer-article ()
14826   "Read article specified by message-id around point."
14827   (interactive)
14828   (let ((point (point)))
14829     (search-forward ">" nil t)          ;Move point to end of "<....>".
14830     (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
14831         (let ((message-id (match-string 1)))
14832           (goto-char point)
14833           (set-buffer gnus-summary-buffer)
14834           (gnus-summary-refer-article message-id))
14835       (goto-char (point))
14836       (error "No references around point"))))
14837
14838 (defun gnus-article-show-summary ()
14839   "Reconfigure windows to show summary buffer."
14840   (interactive)
14841   (gnus-configure-windows 'article)
14842   (gnus-summary-goto-subject gnus-current-article))
14843
14844 (defun gnus-article-describe-briefly ()
14845   "Describe article mode commands briefly."
14846   (interactive)
14847   (gnus-message 6
14848                 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page     \\[gnus-article-goto-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
14849
14850 (defun gnus-article-summary-command ()
14851   "Execute the last keystroke in the summary buffer."
14852   (interactive)
14853   (let ((obuf (current-buffer))
14854         (owin (current-window-configuration))
14855         func)
14856     (switch-to-buffer gnus-summary-buffer 'norecord)
14857     (setq func (lookup-key (current-local-map) (this-command-keys)))
14858     (call-interactively func)
14859     (set-buffer obuf)
14860     (set-window-configuration owin)
14861     (set-window-point (get-buffer-window (current-buffer)) (point))))
14862
14863 (defun gnus-article-summary-command-nosave ()
14864   "Execute the last keystroke in the summary buffer."
14865   (interactive)
14866   (let (func)
14867     (pop-to-buffer gnus-summary-buffer 'norecord)
14868     (setq func (lookup-key (current-local-map) (this-command-keys)))
14869     (call-interactively func)))
14870
14871 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
14872   "Read a summary buffer key sequence and execute it from the article buffer."
14873   (interactive "P")
14874   (let ((nosaves
14875          '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
14876            "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
14877            "=" "^" "\M-^" "|"))
14878         (nosave-but-article
14879          '("A\r"))
14880         keys)
14881     (save-excursion
14882       (set-buffer gnus-summary-buffer)
14883       (push (or key last-command-event) unread-command-events)
14884       (setq keys (read-key-sequence nil)))
14885     (message "")
14886
14887     (if (or (member keys nosaves)
14888             (member keys nosave-but-article))
14889         (let (func)
14890           (save-window-excursion
14891             (pop-to-buffer gnus-summary-buffer 'norecord)
14892             (setq func (lookup-key (current-local-map) keys)))
14893           (if (not func)
14894               (ding)
14895             (set-buffer gnus-summary-buffer)
14896             (call-interactively func))
14897           (when (member keys nosave-but-article)
14898             (pop-to-buffer gnus-article-buffer 'norecord)))
14899       (let ((obuf (current-buffer))
14900             (owin (current-window-configuration))
14901             (opoint (point))
14902             func in-buffer)
14903         (if not-restore-window
14904             (pop-to-buffer gnus-summary-buffer 'norecord)
14905           (switch-to-buffer gnus-summary-buffer 'norecord))
14906         (setq in-buffer (current-buffer))
14907         (if (setq func (lookup-key (current-local-map) keys))
14908             (call-interactively func)
14909           (ding))
14910         (when (eq in-buffer (current-buffer))
14911           (set-buffer obuf)
14912           (unless not-restore-window
14913             (set-window-configuration owin))
14914           (set-window-point (get-buffer-window (current-buffer)) opoint))))))
14915
14916 \f
14917 ;;;
14918 ;;; Kill file handling.
14919 ;;;
14920
14921 ;;;###autoload
14922 (defalias 'gnus-batch-kill 'gnus-batch-score)
14923 ;;;###autoload
14924 (defun gnus-batch-score ()
14925   "Run batched scoring.
14926 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
14927 Newsgroups is a list of strings in Bnews format.  If you want to score
14928 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
14929 score the alt hierarchy, you'd say \"!alt.all\"."
14930   (interactive)
14931   (let* ((yes-and-no
14932           (gnus-newsrc-parse-options
14933            (apply (function concat)
14934                   (mapcar (lambda (g) (concat g " "))
14935                           command-line-args-left))))
14936          (gnus-expert-user t)
14937          (nnmail-spool-file nil)
14938          (gnus-use-dribble-file nil)
14939          (yes (car yes-and-no))
14940          (no (cdr yes-and-no))
14941          group newsrc entry
14942          ;; Disable verbose message.
14943          gnus-novice-user gnus-large-newsgroup)
14944     ;; Eat all arguments.
14945     (setq command-line-args-left nil)
14946     ;; Start Gnus.
14947     (gnus)
14948     ;; Apply kills to specified newsgroups in command line arguments.
14949     (setq newsrc (cdr gnus-newsrc-alist))
14950     (while newsrc
14951       (setq group (caar newsrc))
14952       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
14953       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
14954                (and (car entry)
14955                     (or (eq (car entry) t)
14956                         (not (zerop (car entry)))))
14957                (if yes (string-match yes group) t)
14958                (or (null no) (not (string-match no group))))
14959           (progn
14960             (gnus-summary-read-group group nil t nil t)
14961             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
14962                  (gnus-summary-exit))))
14963       (setq newsrc (cdr newsrc)))
14964     ;; Exit Emacs.
14965     (switch-to-buffer gnus-group-buffer)
14966     (gnus-group-save-newsrc)))
14967
14968 (defun gnus-apply-kill-file ()
14969   "Apply a kill file to the current newsgroup.
14970 Returns the number of articles marked as read."
14971   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
14972           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14973       (gnus-apply-kill-file-internal)
14974     0))
14975
14976 (defun gnus-kill-save-kill-buffer ()
14977   (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14978     (when (get-file-buffer file)
14979       (save-excursion
14980         (set-buffer (get-file-buffer file))
14981         (and (buffer-modified-p) (save-buffer))
14982         (kill-buffer (current-buffer))))))
14983
14984 (defvar gnus-kill-file-name "KILL"
14985   "Suffix of the kill files.")
14986
14987 (defun gnus-newsgroup-kill-file (newsgroup)
14988   "Return the name of a kill file name for NEWSGROUP.
14989 If NEWSGROUP is nil, return the global kill file name instead."
14990   (cond 
14991    ;; The global KILL file is placed at top of the directory.
14992    ((or (null newsgroup)
14993         (string-equal newsgroup ""))
14994     (expand-file-name gnus-kill-file-name
14995                       gnus-kill-files-directory))
14996    ;; Append ".KILL" to newsgroup name.
14997    ((gnus-use-long-file-name 'not-kill)
14998     (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
14999                               "." gnus-kill-file-name)
15000                       gnus-kill-files-directory))
15001    ;; Place "KILL" under the hierarchical directory.
15002    (t
15003     (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
15004                               "/" gnus-kill-file-name)
15005                       gnus-kill-files-directory))))
15006
15007 \f
15008 ;;;
15009 ;;; Dribble file
15010 ;;;
15011
15012 (defvar gnus-dribble-ignore nil)
15013 (defvar gnus-dribble-eval-file nil)
15014
15015 (defun gnus-dribble-file-name ()
15016   "Return the dribble file for the current .newsrc."
15017   (concat
15018    (if gnus-dribble-directory
15019        (concat (file-name-as-directory gnus-dribble-directory)
15020                (file-name-nondirectory gnus-current-startup-file))
15021      gnus-current-startup-file)
15022    "-dribble"))
15023
15024 (defun gnus-dribble-enter (string)
15025   "Enter STRING into the dribble buffer."
15026   (if (and (not gnus-dribble-ignore)
15027            gnus-dribble-buffer
15028            (buffer-name gnus-dribble-buffer))
15029       (let ((obuf (current-buffer)))
15030         (set-buffer gnus-dribble-buffer)
15031         (insert string "\n")
15032         (set-window-point (get-buffer-window (current-buffer)) (point-max))
15033         (bury-buffer gnus-dribble-buffer)
15034         (set-buffer obuf))))
15035
15036 (defun gnus-dribble-read-file ()
15037   "Read the dribble file from disk."
15038   (let ((dribble-file (gnus-dribble-file-name)))
15039     (save-excursion
15040       (set-buffer (setq gnus-dribble-buffer
15041                         (get-buffer-create
15042                          (file-name-nondirectory dribble-file))))
15043       (gnus-add-current-to-buffer-list)
15044       (erase-buffer)
15045       (setq buffer-file-name dribble-file)
15046       (auto-save-mode t)
15047       (buffer-disable-undo (current-buffer))
15048       (bury-buffer (current-buffer))
15049       (set-buffer-modified-p nil)
15050       (let ((auto (make-auto-save-file-name))
15051             (gnus-dribble-ignore t)
15052             modes)
15053         (when (or (file-exists-p auto) (file-exists-p dribble-file))
15054           ;; Load whichever file is newest -- the auto save file
15055           ;; or the "real" file.
15056           (if (file-newer-than-file-p auto dribble-file)
15057               (insert-file-contents auto)
15058             (insert-file-contents dribble-file))
15059           (unless (zerop (buffer-size))
15060             (set-buffer-modified-p t))
15061           ;; Set the file modes to reflect the .newsrc file modes.
15062           (save-buffer)
15063           (when (and (file-exists-p gnus-current-startup-file)
15064                      (setq modes (file-modes gnus-current-startup-file)))
15065             (set-file-modes dribble-file modes))
15066           ;; Possibly eval the file later.
15067           (when (gnus-y-or-n-p
15068                  "Auto-save file exists.  Do you want to read it? ")
15069             (setq gnus-dribble-eval-file t)))))))
15070
15071 (defun gnus-dribble-eval-file ()
15072   (when gnus-dribble-eval-file
15073     (setq gnus-dribble-eval-file nil)
15074     (save-excursion
15075       (let ((gnus-dribble-ignore t))
15076         (set-buffer gnus-dribble-buffer)
15077         (eval-buffer (current-buffer))))))
15078
15079 (defun gnus-dribble-delete-file ()
15080   (when (file-exists-p (gnus-dribble-file-name))
15081     (delete-file (gnus-dribble-file-name)))
15082   (when gnus-dribble-buffer
15083     (save-excursion
15084       (set-buffer gnus-dribble-buffer)
15085       (let ((auto (make-auto-save-file-name)))
15086         (if (file-exists-p auto)
15087             (delete-file auto))
15088         (erase-buffer)
15089         (set-buffer-modified-p nil)))))
15090
15091 (defun gnus-dribble-save ()
15092   (when (and gnus-dribble-buffer
15093              (buffer-name gnus-dribble-buffer))
15094     (save-excursion
15095       (set-buffer gnus-dribble-buffer)
15096       (save-buffer))))
15097
15098 (defun gnus-dribble-clear ()
15099   (when (gnus-buffer-exists-p gnus-dribble-buffer)
15100     (save-excursion
15101       (set-buffer gnus-dribble-buffer)
15102       (erase-buffer)
15103       (set-buffer-modified-p nil)
15104       (setq buffer-saved-size (buffer-size)))))
15105
15106 \f
15107 ;;;
15108 ;;; Server Communication
15109 ;;;
15110
15111 (defun gnus-start-news-server (&optional confirm)
15112   "Open a method for getting news.
15113 If CONFIRM is non-nil, the user will be asked for an NNTP server."
15114   (let (how)
15115     (if gnus-current-select-method
15116         ;; Stream is already opened.
15117         nil
15118       ;; Open NNTP server.
15119       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
15120       (if confirm
15121           (progn
15122             ;; Read server name with completion.
15123             (setq gnus-nntp-server
15124                   (completing-read "NNTP server: "
15125                                    (mapcar (lambda (server) (list server))
15126                                            (cons (list gnus-nntp-server)
15127                                                  gnus-secondary-servers))
15128                                    nil nil gnus-nntp-server))))
15129
15130       (if (and gnus-nntp-server
15131                (stringp gnus-nntp-server)
15132                (not (string= gnus-nntp-server "")))
15133           (setq gnus-select-method
15134                 (cond ((or (string= gnus-nntp-server "")
15135                            (string= gnus-nntp-server "::"))
15136                        (list 'nnspool (system-name)))
15137                       ((string-match "^:" gnus-nntp-server)
15138                        (list 'nnmh gnus-nntp-server
15139                              (list 'nnmh-directory
15140                                    (file-name-as-directory
15141                                     (expand-file-name
15142                                      (concat "~/" (substring
15143                                                    gnus-nntp-server 1)))))
15144                              (list 'nnmh-get-new-mail nil)))
15145                       (t
15146                        (list 'nntp gnus-nntp-server)))))
15147
15148       (setq how (car gnus-select-method))
15149       (cond ((eq how 'nnspool)
15150              (require 'nnspool)
15151              (gnus-message 5 "Looking up local news spool..."))
15152             ((eq how 'nnmh)
15153              (require 'nnmh)
15154              (gnus-message 5 "Looking up mh spool..."))
15155             (t
15156              (require 'nntp)))
15157       (setq gnus-current-select-method gnus-select-method)
15158       (run-hooks 'gnus-open-server-hook)
15159       (or
15160        ;; gnus-open-server-hook might have opened it
15161        (gnus-server-opened gnus-select-method)
15162        (gnus-open-server gnus-select-method)
15163        (gnus-y-or-n-p
15164         (format
15165          "%s (%s) open error: '%s'.     Continue? "
15166          (car gnus-select-method) (cadr gnus-select-method)
15167          (gnus-status-message gnus-select-method)))
15168        (gnus-error 1 "Couldn't open server on %s"
15169                    (nth 1 gnus-select-method))))))
15170
15171 (defun gnus-check-group (group)
15172   "Try to make sure that the server where GROUP exists is alive."
15173   (let ((method (gnus-find-method-for-group group)))
15174     (or (gnus-server-opened method)
15175         (gnus-open-server method))))
15176
15177 (defun gnus-check-server (&optional method silent)
15178   "Check whether the connection to METHOD is down.
15179 If METHOD is nil, use `gnus-select-method'.
15180 If it is down, start it up (again)."
15181   (let ((method (or method gnus-select-method)))
15182     ;; Transform virtual server names into select methods.
15183     (when (stringp method)
15184       (setq method (gnus-server-to-method method)))
15185     (if (gnus-server-opened method)
15186         ;; The stream is already opened.
15187         t
15188       ;; Open the server.
15189       (unless silent
15190         (gnus-message 5 "Opening %s server%s..." (car method)
15191                       (if (equal (nth 1 method) "") ""
15192                         (format " on %s" (nth 1 method)))))
15193       (run-hooks 'gnus-open-server-hook)
15194       (prog1
15195           (gnus-open-server method)
15196         (unless silent
15197           (message ""))))))
15198
15199 (defun gnus-get-function (method function &optional noerror)
15200   "Return a function symbol based on METHOD and FUNCTION."
15201   ;; Translate server names into methods.
15202   (unless method
15203     (error "Attempted use of a nil select method"))
15204   (when (stringp method)
15205     (setq method (gnus-server-to-method method)))
15206   (let ((func (intern (format "%s-%s" (car method) function))))
15207     ;; If the functions isn't bound, we require the backend in
15208     ;; question.
15209     (unless (fboundp func)
15210       (require (car method))
15211       (when (and (not (fboundp func))
15212                  (not noerror))
15213         ;; This backend doesn't implement this function.
15214         (error "No such function: %s" func)))
15215     func))
15216
15217 \f
15218 ;;;
15219 ;;; Interface functions to the backends.
15220 ;;;
15221
15222 (defun gnus-open-server (method)
15223   "Open a connection to METHOD."
15224   (when (stringp method)
15225     (setq method (gnus-server-to-method method)))
15226   (let ((elem (assoc method gnus-opened-servers)))
15227     ;; If this method was previously denied, we just return nil.
15228     (if (eq (nth 1 elem) 'denied)
15229         (progn
15230           (gnus-message 1 "Denied server")
15231           nil)
15232       ;; Open the server.
15233       (let ((result
15234              (funcall (gnus-get-function method 'open-server)
15235                       (nth 1 method) (nthcdr 2 method))))
15236         ;; If this hasn't been opened before, we add it to the list.
15237         (unless elem
15238           (setq elem (list method nil)
15239                 gnus-opened-servers (cons elem gnus-opened-servers)))
15240         ;; Set the status of this server.
15241         (setcar (cdr elem) (if result 'ok 'denied))
15242         ;; Return the result from the "open" call.
15243         result))))
15244
15245 (defun gnus-close-server (method)
15246   "Close the connection to METHOD."
15247   (when (stringp method)
15248     (setq method (gnus-server-to-method method)))
15249   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
15250
15251 (defun gnus-request-list (method)
15252   "Request the active file from METHOD."
15253   (when (stringp method)
15254     (setq method (gnus-server-to-method method)))
15255   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
15256
15257 (defun gnus-request-list-newsgroups (method)
15258   "Request the newsgroups file from METHOD."
15259   (when (stringp method)
15260     (setq method (gnus-server-to-method method)))
15261   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
15262
15263 (defun gnus-request-newgroups (date method)
15264   "Request all new groups since DATE from METHOD."
15265   (when (stringp method)
15266     (setq method (gnus-server-to-method method)))
15267   (funcall (gnus-get-function method 'request-newgroups)
15268            date (nth 1 method)))
15269
15270 (defun gnus-server-opened (method)
15271   "Check whether a connection to METHOD has been opened."
15272   (when (stringp method)
15273     (setq method (gnus-server-to-method method)))
15274   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
15275
15276 (defun gnus-status-message (method)
15277   "Return the status message from METHOD.
15278 If METHOD is a string, it is interpreted as a group name.   The method
15279 this group uses will be queried."
15280   (let ((method (if (stringp method) (gnus-find-method-for-group method)
15281                   method)))
15282     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
15283
15284 (defun gnus-request-group (group &optional dont-check method)
15285   "Request GROUP.  If DONT-CHECK, no information is required."
15286   (let ((method (or method (gnus-find-method-for-group group))))
15287     (when (stringp method)
15288       (setq method (gnus-server-to-method method)))
15289     (funcall (gnus-get-function method 'request-group)
15290              (gnus-group-real-name group) (nth 1 method) dont-check)))
15291
15292 (defun gnus-request-asynchronous (group &optional articles)
15293   "Request that GROUP behave asynchronously.
15294 ARTICLES is the `data' of the group."
15295   (let ((method (gnus-find-method-for-group group)))
15296     (funcall (gnus-get-function method 'request-asynchronous)
15297              (gnus-group-real-name group) (nth 1 method) articles)))
15298
15299 (defun gnus-list-active-group (group)
15300   "Request active information on GROUP."
15301   (let ((method (gnus-find-method-for-group group))
15302         (func 'list-active-group))
15303     (when (gnus-check-backend-function func group)
15304       (funcall (gnus-get-function method func)
15305                (gnus-group-real-name group) (nth 1 method)))))
15306
15307 (defun gnus-request-group-description (group)
15308   "Request a description of GROUP."
15309   (let ((method (gnus-find-method-for-group group))
15310         (func 'request-group-description))
15311     (when (gnus-check-backend-function func group)
15312       (funcall (gnus-get-function method func)
15313                (gnus-group-real-name group) (nth 1 method)))))
15314
15315 (defun gnus-close-group (group)
15316   "Request the GROUP be closed."
15317   (let ((method (gnus-find-method-for-group group)))
15318     (funcall (gnus-get-function method 'close-group)
15319              (gnus-group-real-name group) (nth 1 method))))
15320
15321 (defun gnus-retrieve-headers (articles group &optional fetch-old)
15322   "Request headers for ARTICLES in GROUP.
15323 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
15324   (let ((method (gnus-find-method-for-group group)))
15325     (if (and gnus-use-cache (numberp (car articles)))
15326         (gnus-cache-retrieve-headers articles group fetch-old)
15327       (funcall (gnus-get-function method 'retrieve-headers)
15328                articles (gnus-group-real-name group) (nth 1 method)
15329                fetch-old))))
15330
15331 (defun gnus-retrieve-groups (groups method)
15332   "Request active information on GROUPS from METHOD."
15333   (when (stringp method)
15334     (setq method (gnus-server-to-method method)))
15335   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
15336
15337 (defun gnus-request-type (group &optional article)
15338   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
15339   (let ((method (gnus-find-method-for-group group)))
15340     (if (not (gnus-check-backend-function 'request-type (car method)))
15341         'unknown
15342       (funcall (gnus-get-function method 'request-type)
15343                (gnus-group-real-name group) article))))
15344
15345 (defun gnus-request-update-mark (group article mark)
15346   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
15347   (let ((method (gnus-find-method-for-group group)))
15348     (if (not (gnus-check-backend-function 'request-update-mark (car method)))
15349         mark
15350       (funcall (gnus-get-function method 'request-update-mark)
15351                (gnus-group-real-name group) article mark))))
15352
15353 (defun gnus-request-article (article group &optional buffer)
15354   "Request the ARTICLE in GROUP.
15355 ARTICLE can either be an article number or an article Message-ID.
15356 If BUFFER, insert the article in that group."
15357   (let ((method (gnus-find-method-for-group group)))
15358     (funcall (gnus-get-function method 'request-article)
15359              article (gnus-group-real-name group) (nth 1 method) buffer)))
15360
15361 (defun gnus-request-head (article group)
15362   "Request the head of ARTICLE in GROUP."
15363   (let* ((method (gnus-find-method-for-group group))
15364          (head (gnus-get-function method 'request-head t)))
15365     (if (fboundp head)
15366         (funcall head article (gnus-group-real-name group) (nth 1 method))
15367       (let ((res (gnus-request-article article group)))
15368         (when res
15369           (save-excursion
15370             (set-buffer nntp-server-buffer)
15371             (goto-char (point-min))
15372             (when (search-forward "\n\n" nil t)
15373               (delete-region (1- (point)) (point-max)))
15374             (nnheader-fold-continuation-lines)))
15375         res))))
15376
15377 (defun gnus-request-body (article group)
15378   "Request the body of ARTICLE in GROUP."
15379   (let ((method (gnus-find-method-for-group group)))
15380     (funcall (gnus-get-function method 'request-body)
15381              article (gnus-group-real-name group) (nth 1 method))))
15382
15383 (defun gnus-request-post (method)
15384   "Post the current buffer using METHOD."
15385   (when (stringp method)
15386     (setq method (gnus-server-to-method method)))
15387   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
15388
15389 (defun gnus-request-scan (group method)
15390   "Request a SCAN being performed in GROUP from METHOD.
15391 If GROUP is nil, all groups on METHOD are scanned."
15392   (let ((method (if group (gnus-find-method-for-group group) method)))
15393     (funcall (gnus-get-function method 'request-scan)
15394              (and group (gnus-group-real-name group)) (nth 1 method))))
15395
15396 (defsubst gnus-request-update-info (info method)
15397   "Request that METHOD update INFO."
15398   (when (stringp method)
15399     (setq method (gnus-server-to-method method)))
15400   (when (gnus-check-backend-function 'request-update-info (car method))
15401     (funcall (gnus-get-function method 'request-update-info)
15402              (gnus-group-real-name (gnus-info-group info))
15403              info (nth 1 method))))
15404
15405 (defun gnus-request-expire-articles (articles group &optional force)
15406   (let ((method (gnus-find-method-for-group group)))
15407     (funcall (gnus-get-function method 'request-expire-articles)
15408              articles (gnus-group-real-name group) (nth 1 method)
15409              force)))
15410
15411 (defun gnus-request-move-article
15412   (article group server accept-function &optional last)
15413   (let ((method (gnus-find-method-for-group group)))
15414     (funcall (gnus-get-function method 'request-move-article)
15415              article (gnus-group-real-name group)
15416              (nth 1 method) accept-function last)))
15417
15418 (defun gnus-request-accept-article (group method &optional last)
15419   ;; Make sure there's a newline at the end of the article.
15420   (when (stringp method)
15421     (setq method (gnus-server-to-method method)))
15422   (when (and (not method)
15423              (stringp group))
15424     (setq method (gnus-group-name-to-method group)))
15425   (goto-char (point-max))
15426   (unless (bolp)
15427     (insert "\n"))
15428   (let ((func (car (or method (gnus-find-method-for-group group)))))
15429     (funcall (intern (format "%s-request-accept-article" func))
15430              (if (stringp group) (gnus-group-real-name group) group)
15431              (cadr method)
15432              last)))
15433
15434 (defun gnus-request-replace-article (article group buffer)
15435   (let ((func (car (gnus-find-method-for-group group))))
15436     (funcall (intern (format "%s-request-replace-article" func))
15437              article (gnus-group-real-name group) buffer)))
15438
15439 (defun gnus-request-associate-buffer (group)
15440   (let ((method (gnus-find-method-for-group group)))
15441     (funcall (gnus-get-function method 'request-associate-buffer)
15442              (gnus-group-real-name group))))
15443
15444 (defun gnus-request-restore-buffer (article group)
15445   "Request a new buffer restored to the state of ARTICLE."
15446   (let ((method (gnus-find-method-for-group group)))
15447     (funcall (gnus-get-function method 'request-restore-buffer)
15448              article (gnus-group-real-name group) (nth 1 method))))
15449
15450 (defun gnus-request-create-group (group &optional method)
15451   (when (stringp method)
15452     (setq method (gnus-server-to-method method)))
15453   (let ((method (or method (gnus-find-method-for-group group))))
15454     (funcall (gnus-get-function method 'request-create-group)
15455              (gnus-group-real-name group) (nth 1 method))))
15456
15457 (defun gnus-request-delete-group (group &optional force)
15458   (let ((method (gnus-find-method-for-group group)))
15459     (funcall (gnus-get-function method 'request-delete-group)
15460              (gnus-group-real-name group) force (nth 1 method))))
15461
15462 (defun gnus-request-rename-group (group new-name)
15463   (let ((method (gnus-find-method-for-group group)))
15464     (funcall (gnus-get-function method 'request-rename-group)
15465              (gnus-group-real-name group)
15466              (gnus-group-real-name new-name) (nth 1 method))))
15467
15468 (defun gnus-member-of-valid (symbol group)
15469   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
15470   (memq symbol (assoc
15471                 (symbol-name (car (gnus-find-method-for-group group)))
15472                 gnus-valid-select-methods)))
15473
15474 (defun gnus-method-option-p (method option)
15475   "Return non-nil if select METHOD has OPTION as a parameter."
15476   (when (stringp method)
15477     (setq method (gnus-server-to-method method)))
15478   (memq option (assoc (format "%s" (car method))
15479                       gnus-valid-select-methods)))
15480
15481 (defun gnus-server-extend-method (group method)
15482   ;; This function "extends" a virtual server.  If the server is
15483   ;; "hello", and the select method is ("hello" (my-var "something"))
15484   ;; in the group "alt.alt", this will result in a new virtual server
15485   ;; called "hello+alt.alt".
15486   (let ((entry
15487          (gnus-copy-sequence
15488           (if (equal (car method) "native") gnus-select-method
15489             (cdr (assoc (car method) gnus-server-alist))))))
15490     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
15491     (nconc entry (cdr method))))
15492
15493 (defun gnus-server-status (method)
15494   "Return the status of METHOD."
15495   (nth 1 (assoc method gnus-opened-servers)))
15496
15497 (defun gnus-group-name-to-method (group)
15498   "Return a select method suitable for GROUP."
15499   (if (string-match ":" group)
15500       (let ((server (substring group 0 (match-beginning 0))))
15501         (if (string-match "\\+" server)
15502             (list (intern (substring server 0 (match-beginning 0)))
15503                   (substring server (match-end 0)))
15504           (list (intern server) "")))
15505     gnus-select-method))
15506
15507 (defun gnus-find-method-for-group (group &optional info)
15508   "Find the select method that GROUP uses."
15509   (or gnus-override-method
15510       (and (not group)
15511            gnus-select-method)
15512       (let ((info (or info (gnus-get-info group)))
15513             method)
15514         (if (or (not info)
15515                 (not (setq method (gnus-info-method info)))
15516                 (equal method "native"))
15517             gnus-select-method
15518           (setq method
15519                 (cond ((stringp method)
15520                        (gnus-server-to-method method))
15521                       ((stringp (car method))
15522                        (gnus-server-extend-method group method))
15523                       (t
15524                        method)))
15525           (cond ((equal (cadr method) "")
15526                  method)
15527                 ((null (cadr method))
15528                  (list (car method) ""))
15529                 (t
15530                  (gnus-server-add-address method)))))))
15531
15532 (defun gnus-check-backend-function (func group)
15533   "Check whether GROUP supports function FUNC."
15534   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
15535                   group)))
15536     (fboundp (intern (format "%s-%s" method func)))))
15537
15538 (defun gnus-methods-using (feature)
15539   "Find all methods that have FEATURE."
15540   (let ((valids gnus-valid-select-methods)
15541         outs)
15542     (while valids
15543       (if (memq feature (car valids))
15544           (setq outs (cons (car valids) outs)))
15545       (setq valids (cdr valids)))
15546     outs))
15547
15548 \f
15549 ;;;
15550 ;;; Active & Newsrc File Handling
15551 ;;;
15552
15553 (defun gnus-setup-news (&optional rawfile level dont-connect)
15554   "Setup news information.
15555 If RAWFILE is non-nil, the .newsrc file will also be read.
15556 If LEVEL is non-nil, the news will be set up at level LEVEL."
15557   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
15558
15559     (when init 
15560       ;; Clear some variables to re-initialize news information.
15561       (setq gnus-newsrc-alist nil
15562             gnus-active-hashtb nil)
15563       ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
15564       (gnus-read-newsrc-file rawfile))
15565
15566     (when (and (not (assoc "archive" gnus-server-alist))
15567                (gnus-archive-server-wanted-p))
15568       (push (cons "archive" gnus-message-archive-method)
15569             gnus-server-alist))
15570
15571     ;; If we don't read the complete active file, we fill in the
15572     ;; hashtb here.
15573     (if (or (null gnus-read-active-file)
15574             (eq gnus-read-active-file 'some))
15575         (gnus-update-active-hashtb-from-killed))
15576
15577     ;; Read the active file and create `gnus-active-hashtb'.
15578     ;; If `gnus-read-active-file' is nil, then we just create an empty
15579     ;; hash table.  The partial filling out of the hash table will be
15580     ;; done in `gnus-get-unread-articles'.
15581     (and gnus-read-active-file
15582          (not level)
15583          (gnus-read-active-file))
15584
15585     (or gnus-active-hashtb
15586         (setq gnus-active-hashtb (make-vector 4095 0)))
15587
15588     ;; Initialize the cache.
15589     (when gnus-use-cache
15590       (gnus-cache-open))
15591
15592     ;; Possibly eval the dribble file.
15593     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
15594
15595     ;; Slave Gnusii should then clear the dribble buffer.
15596     (when (and init gnus-slave)
15597       (gnus-dribble-clear))
15598
15599     (gnus-update-format-specifications)
15600
15601     ;; See whether we need to read the description file.
15602     (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
15603              (not gnus-description-hashtb)
15604              (not dont-connect)
15605              gnus-read-active-file)
15606         (gnus-read-all-descriptions-files))
15607
15608     ;; Find new newsgroups and treat them.
15609     (if (and init gnus-check-new-newsgroups (not level)
15610              (gnus-check-server gnus-select-method))
15611         (gnus-find-new-newsgroups))
15612
15613     ;; We might read in new NoCeM messages here.
15614     (when (and gnus-use-nocem 
15615                (not level)
15616                (not dont-connect))
15617       (gnus-nocem-scan-groups))
15618
15619     ;; Find the number of unread articles in each non-dead group.
15620     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
15621       (gnus-get-unread-articles level))
15622
15623     (if (and init gnus-check-bogus-newsgroups
15624              gnus-read-active-file (not level)
15625              (gnus-server-opened gnus-select-method))
15626         (gnus-check-bogus-newsgroups))))
15627
15628 (defun gnus-find-new-newsgroups (&optional arg)
15629   "Search for new newsgroups and add them.
15630 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
15631 The `-n' option line from .newsrc is respected.
15632 If ARG (the prefix), use the `ask-server' method to query
15633 the server for new groups."
15634   (interactive "P")
15635   (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
15636                        (null gnus-read-active-file)
15637                        (eq gnus-read-active-file 'some))
15638                    'ask-server gnus-check-new-newsgroups)))
15639     (unless (gnus-check-first-time-used)
15640       (if (or (consp check)
15641               (eq check 'ask-server))
15642           ;; Ask the server for new groups.
15643           (gnus-ask-server-for-new-groups)
15644         ;; Go through the active hashtb and look for new groups.
15645         (let ((groups 0)
15646               group new-newsgroups)
15647           (gnus-message 5 "Looking for new newsgroups...")
15648           (unless gnus-have-read-active-file
15649             (gnus-read-active-file))
15650           (setq gnus-newsrc-last-checked-date (current-time-string))
15651           (unless gnus-killed-hashtb
15652             (gnus-make-hashtable-from-killed))
15653           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
15654           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
15655           (mapatoms
15656            (lambda (sym)
15657              (if (or (null (setq group (symbol-name sym)))
15658                      (not (boundp sym))
15659                      (null (symbol-value sym))
15660                      (gnus-gethash group gnus-killed-hashtb)
15661                      (gnus-gethash group gnus-newsrc-hashtb))
15662                  ()
15663                (let ((do-sub (gnus-matches-options-n group)))
15664                  (cond
15665                   ((eq do-sub 'subscribe)
15666                    (setq groups (1+ groups))
15667                    (gnus-sethash group group gnus-killed-hashtb)
15668                    (funcall gnus-subscribe-options-newsgroup-method group))
15669                   ((eq do-sub 'ignore)
15670                    nil)
15671                   (t
15672                    (setq groups (1+ groups))
15673                    (gnus-sethash group group gnus-killed-hashtb)
15674                    (if gnus-subscribe-hierarchical-interactive
15675                        (setq new-newsgroups (cons group new-newsgroups))
15676                      (funcall gnus-subscribe-newsgroup-method group)))))))
15677            gnus-active-hashtb)
15678           (when new-newsgroups
15679             (gnus-subscribe-hierarchical-interactive new-newsgroups))
15680           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
15681           (if (> groups 0)
15682               (gnus-message 6 "%d new newsgroup%s arrived."
15683                             groups (if (> groups 1) "s have" " has"))
15684             (gnus-message 6 "No new newsgroups.")))))))
15685
15686 (defun gnus-matches-options-n (group)
15687   ;; Returns `subscribe' if the group is to be unconditionally
15688   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
15689   ;; no match for the group.
15690
15691   ;; First we check the two user variables.
15692   (cond
15693    ((and gnus-options-subscribe
15694          (string-match gnus-options-subscribe group))
15695     'subscribe)
15696    ((and gnus-auto-subscribed-groups
15697          (string-match gnus-auto-subscribed-groups group))
15698     'subscribe)
15699    ((and gnus-options-not-subscribe
15700          (string-match gnus-options-not-subscribe group))
15701     'ignore)
15702    ;; Then we go through the list that was retrieved from the .newsrc
15703    ;; file.  This list has elements on the form
15704    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
15705    ;; is in the reverse order of the options line) is returned.
15706    (t
15707     (let ((regs gnus-newsrc-options-n))
15708       (while (and regs
15709                   (not (string-match (caar regs) group)))
15710         (setq regs (cdr regs)))
15711       (and regs (cdar regs))))))
15712
15713 (defun gnus-ask-server-for-new-groups ()
15714   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
15715          (methods (cons gnus-select-method
15716                         (nconc
15717                          (when (gnus-archive-server-wanted-p)
15718                            (list "archive"))
15719                          (append
15720                           (and (consp gnus-check-new-newsgroups)
15721                                gnus-check-new-newsgroups)
15722                           gnus-secondary-select-methods))))
15723          (groups 0)
15724          (new-date (current-time-string))
15725          group new-newsgroups got-new method hashtb
15726          gnus-override-subscribe-method)
15727     ;; Go through both primary and secondary select methods and
15728     ;; request new newsgroups.
15729     (while (setq method (gnus-server-get-method nil (pop methods)))
15730       (setq new-newsgroups nil)
15731       (setq gnus-override-subscribe-method method)
15732       (when (and (gnus-check-server method)
15733                  (gnus-request-newgroups date method))
15734         (save-excursion
15735           (setq got-new t)
15736           (setq hashtb (gnus-make-hashtable 100))
15737           (set-buffer nntp-server-buffer)
15738           ;; Enter all the new groups into a hashtable.
15739           (gnus-active-to-gnus-format method hashtb 'ignore))
15740         ;; Now all new groups from `method' are in `hashtb'.
15741         (mapatoms
15742          (lambda (group-sym)
15743            (if (or (null (setq group (symbol-name group-sym)))
15744                    (not (boundp group-sym))
15745                    (null (symbol-value group-sym))
15746                    (gnus-gethash group gnus-newsrc-hashtb)
15747                    (member group gnus-zombie-list)
15748                    (member group gnus-killed-list))
15749                ;; The group is already known.
15750                ()
15751              ;; Make this group active.
15752              (when (symbol-value group-sym)
15753                (gnus-set-active group (symbol-value group-sym)))
15754              ;; Check whether we want it or not.
15755              (let ((do-sub (gnus-matches-options-n group)))
15756                (cond
15757                 ((eq do-sub 'subscribe)
15758                  (incf groups)
15759                  (gnus-sethash group group gnus-killed-hashtb)
15760                  (funcall gnus-subscribe-options-newsgroup-method group))
15761                 ((eq do-sub 'ignore)
15762                  nil)
15763                 (t
15764                  (incf groups)
15765                  (gnus-sethash group group gnus-killed-hashtb)
15766                  (if gnus-subscribe-hierarchical-interactive
15767                      (push group new-newsgroups)
15768                    (funcall gnus-subscribe-newsgroup-method group)))))))
15769          hashtb))
15770       (when new-newsgroups
15771         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
15772     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
15773     (when (> groups 0)
15774       (gnus-message 6 "%d new newsgroup%s arrived."
15775                     groups (if (> groups 1) "s have" " has")))
15776     (and got-new (setq gnus-newsrc-last-checked-date new-date))
15777     got-new))
15778
15779 (defun gnus-check-first-time-used ()
15780   (if (or (> (length gnus-newsrc-alist) 1)
15781           (file-exists-p gnus-startup-file)
15782           (file-exists-p (concat gnus-startup-file ".el"))
15783           (file-exists-p (concat gnus-startup-file ".eld")))
15784       nil
15785     (gnus-message 6 "First time user; subscribing you to default groups")
15786     (unless (gnus-read-active-file-p)
15787       (gnus-read-active-file))
15788     (setq gnus-newsrc-last-checked-date (current-time-string))
15789     (let ((groups gnus-default-subscribed-newsgroups)
15790           group)
15791       (if (eq groups t)
15792           nil
15793         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
15794         (mapatoms
15795          (lambda (sym)
15796            (if (null (setq group (symbol-name sym)))
15797                ()
15798              (let ((do-sub (gnus-matches-options-n group)))
15799                (cond
15800                 ((eq do-sub 'subscribe)
15801                  (gnus-sethash group group gnus-killed-hashtb)
15802                  (funcall gnus-subscribe-options-newsgroup-method group))
15803                 ((eq do-sub 'ignore)
15804                  nil)
15805                 (t
15806                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
15807          gnus-active-hashtb)
15808         (while groups
15809           (if (gnus-active (car groups))
15810               (gnus-group-change-level
15811                (car groups) gnus-level-default-subscribed gnus-level-killed))
15812           (setq groups (cdr groups)))
15813         (gnus-group-make-help-group)
15814         (and gnus-novice-user
15815              (gnus-message 7 "`A k' to list killed groups"))))))
15816
15817 (defun gnus-subscribe-group (group previous &optional method)
15818   (gnus-group-change-level
15819    (if method
15820        (list t group gnus-level-default-subscribed nil nil method)
15821      group)
15822    gnus-level-default-subscribed gnus-level-killed previous t))
15823
15824 ;; `gnus-group-change-level' is the fundamental function for changing
15825 ;; subscription levels of newsgroups.  This might mean just changing
15826 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
15827 ;; again, which subscribes/unsubscribes a group, which is equally
15828 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
15829 ;; from 8-9 to 1-7 means that you remove the group from the list of
15830 ;; killed (or zombie) groups and add them to the (kinda) subscribed
15831 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
15832 ;; which is trivial.
15833 ;; ENTRY can either be a string (newsgroup name) or a list (if
15834 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
15835 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
15836 ;; entries.
15837 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
15838 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
15839 ;; after.
15840 (defun gnus-group-change-level (entry level &optional oldlevel
15841                                       previous fromkilled)
15842   (let (group info active num)
15843     ;; Glean what info we can from the arguments
15844     (if (consp entry)
15845         (if fromkilled (setq group (nth 1 entry))
15846           (setq group (car (nth 2 entry))))
15847       (setq group entry))
15848     (if (and (stringp entry)
15849              oldlevel
15850              (< oldlevel gnus-level-zombie))
15851         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
15852     (if (and (not oldlevel)
15853              (consp entry))
15854         (setq oldlevel (gnus-info-level (nth 2 entry)))
15855       (setq oldlevel (or oldlevel 9)))
15856     (if (stringp previous)
15857         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
15858
15859     (if (and (>= oldlevel gnus-level-zombie)
15860              (gnus-gethash group gnus-newsrc-hashtb))
15861         ;; We are trying to subscribe a group that is already
15862         ;; subscribed.
15863         ()                              ; Do nothing.
15864
15865       (or (gnus-ephemeral-group-p group)
15866           (gnus-dribble-enter
15867            (format "(gnus-group-change-level %S %S %S %S %S)"
15868                    group level oldlevel (car (nth 2 previous)) fromkilled)))
15869
15870       ;; Then we remove the newgroup from any old structures, if needed.
15871       ;; If the group was killed, we remove it from the killed or zombie
15872       ;; list.  If not, and it is in fact going to be killed, we remove
15873       ;; it from the newsrc hash table and assoc.
15874       (cond
15875        ((>= oldlevel gnus-level-zombie)
15876         (if (= oldlevel gnus-level-zombie)
15877             (setq gnus-zombie-list (delete group gnus-zombie-list))
15878           (setq gnus-killed-list (delete group gnus-killed-list))))
15879        (t
15880         (if (and (>= level gnus-level-zombie)
15881                  entry)
15882             (progn
15883               (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
15884               (if (nth 3 entry)
15885                   (setcdr (gnus-gethash (car (nth 3 entry))
15886                                         gnus-newsrc-hashtb)
15887                           (cdr entry)))
15888               (setcdr (cdr entry) (cdddr entry))))))
15889
15890       ;; Finally we enter (if needed) the list where it is supposed to
15891       ;; go, and change the subscription level.  If it is to be killed,
15892       ;; we enter it into the killed or zombie list.
15893       (cond 
15894        ((>= level gnus-level-zombie)
15895         ;; Remove from the hash table.
15896         (gnus-sethash group nil gnus-newsrc-hashtb)
15897         ;; We do not enter foreign groups into the list of dead
15898         ;; groups.
15899         (unless (gnus-group-foreign-p group)
15900           (if (= level gnus-level-zombie)
15901               (setq gnus-zombie-list (cons group gnus-zombie-list))
15902             (setq gnus-killed-list (cons group gnus-killed-list)))))
15903        (t
15904         ;; If the list is to be entered into the newsrc assoc, and
15905         ;; it was killed, we have to create an entry in the newsrc
15906         ;; hashtb format and fix the pointers in the newsrc assoc.
15907         (if (< oldlevel gnus-level-zombie)
15908             ;; It was alive, and it is going to stay alive, so we
15909             ;; just change the level and don't change any pointers or
15910             ;; hash table entries.
15911             (setcar (cdaddr entry) level)
15912           (if (listp entry)
15913               (setq info (cdr entry)
15914                     num (car entry))
15915             (setq active (gnus-active group))
15916             (setq num
15917                   (if active (- (1+ (cdr active)) (car active)) t))
15918             ;; Check whether the group is foreign.  If so, the
15919             ;; foreign select method has to be entered into the
15920             ;; info.
15921             (let ((method (or gnus-override-subscribe-method
15922                               (gnus-group-method group))))
15923               (if (eq method gnus-select-method)
15924                   (setq info (list group level nil))
15925                 (setq info (list group level nil nil method)))))
15926           (unless previous
15927             (setq previous
15928                   (let ((p gnus-newsrc-alist))
15929                     (while (cddr p)
15930                       (setq p (cdr p)))
15931                     p)))
15932           (setq entry (cons info (cddr previous)))
15933           (if (cdr previous)
15934               (progn
15935                 (setcdr (cdr previous) entry)
15936                 (gnus-sethash group (cons num (cdr previous))
15937                               gnus-newsrc-hashtb))
15938             (setcdr previous entry)
15939             (gnus-sethash group (cons num previous)
15940                           gnus-newsrc-hashtb))
15941           (when (cdr entry)
15942             (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)))))
15943       (when gnus-group-change-level-function
15944         (funcall gnus-group-change-level-function group level oldlevel)))))
15945
15946 (defun gnus-kill-newsgroup (newsgroup)
15947   "Obsolete function.  Kills a newsgroup."
15948   (gnus-group-change-level
15949    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
15950
15951 (defun gnus-check-bogus-newsgroups (&optional confirm)
15952   "Remove bogus newsgroups.
15953 If CONFIRM is non-nil, the user has to confirm the deletion of every
15954 newsgroup."
15955   (let ((newsrc (cdr gnus-newsrc-alist))
15956         bogus group entry info)
15957     (gnus-message 5 "Checking bogus newsgroups...")
15958     (unless (gnus-read-active-file-p)
15959       (gnus-read-active-file))
15960     (when (gnus-read-active-file-p)
15961       ;; Find all bogus newsgroup that are subscribed.
15962       (while newsrc
15963         (setq info (pop newsrc)
15964               group (gnus-info-group info))
15965         (unless (or (gnus-active group) ; Active
15966                     (gnus-info-method info) ; Foreign
15967                     (and confirm
15968                          (not (gnus-y-or-n-p
15969                                (format "Remove bogus newsgroup: %s " group)))))
15970           ;; Found a bogus newsgroup.
15971           (push group bogus)))
15972       ;; Remove all bogus subscribed groups by first killing them, and
15973       ;; then removing them from the list of killed groups.
15974       (while bogus
15975         (when (setq entry (gnus-gethash (setq group (pop bogus))
15976                                         gnus-newsrc-hashtb))
15977           (gnus-group-change-level entry gnus-level-killed)
15978           (setq gnus-killed-list (delete group gnus-killed-list))))
15979       ;; Then we remove all bogus groups from the list of killed and
15980       ;; zombie groups.  They are removed without confirmation.
15981       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
15982             killed)
15983         (while dead-lists
15984           (setq killed (symbol-value (car dead-lists)))
15985           (while killed
15986             (unless (gnus-active (setq group (pop killed)))
15987               ;; The group is bogus.
15988               ;; !!!Slow as hell.
15989               (set (car dead-lists)
15990                    (delete group (symbol-value (car dead-lists))))))
15991           (setq dead-lists (cdr dead-lists))))
15992       (run-hooks 'gnus-check-bogus-groups-hook)
15993       (gnus-message 5 "Checking bogus newsgroups...done"))))
15994
15995 (defun gnus-check-duplicate-killed-groups ()
15996   "Remove duplicates from the list of killed groups."
15997   (interactive)
15998   (let ((killed gnus-killed-list))
15999     (while killed
16000       (gnus-message 9 "%d" (length killed))
16001       (setcdr killed (delete (car killed) (cdr killed)))
16002       (setq killed (cdr killed)))))
16003
16004 ;; We want to inline a function from gnus-cache, so we cheat here:
16005 (eval-when-compile
16006   (provide 'gnus)
16007   (setq gnus-directory (or (getenv "SAVEDIR") "~/News/"))
16008   (require 'gnus-cache))
16009
16010 (defun gnus-get-unread-articles-in-group (info active &optional update)
16011   (when active
16012     ;; Allow the backend to update the info in the group.
16013     (when (and update 
16014                (gnus-request-update-info
16015                 info (gnus-find-method-for-group (gnus-info-group info))))
16016       (gnus-activate-group (gnus-info-group info) nil t))
16017     (let* ((range (gnus-info-read info))
16018            (num 0))
16019       ;; If a cache is present, we may have to alter the active info.
16020       (when (and gnus-use-cache info)
16021         (inline (gnus-cache-possibly-alter-active 
16022                  (gnus-info-group info) active)))
16023       ;; Modify the list of read articles according to what articles
16024       ;; are available; then tally the unread articles and add the
16025       ;; number to the group hash table entry.
16026       (cond
16027        ((zerop (cdr active))
16028         (setq num 0))
16029        ((not range)
16030         (setq num (- (1+ (cdr active)) (car active))))
16031        ((not (listp (cdr range)))
16032         ;; Fix a single (num . num) range according to the
16033         ;; active hash table.
16034         ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
16035         (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
16036         (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
16037         ;; Compute number of unread articles.
16038         (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
16039        (t
16040         ;; The read list is a list of ranges.  Fix them according to
16041         ;; the active hash table.
16042         ;; First peel off any elements that are below the lower
16043         ;; active limit.
16044         (while (and (cdr range)
16045                     (>= (car active)
16046                         (or (and (atom (cadr range)) (cadr range))
16047                             (caadr range))))
16048           (if (numberp (car range))
16049               (setcar range
16050                       (cons (car range)
16051                             (or (and (numberp (cadr range))
16052                                      (cadr range))
16053                                 (cdadr range))))
16054             (setcdr (car range)
16055                     (or (and (numberp (nth 1 range)) (nth 1 range))
16056                         (cdadr range))))
16057           (setcdr range (cddr range)))
16058         ;; Adjust the first element to be the same as the lower limit.
16059         (if (and (not (atom (car range)))
16060                  (< (cdar range) (car active)))
16061             (setcdr (car range) (1- (car active))))
16062         ;; Then we want to peel off any elements that are higher
16063         ;; than the upper active limit.
16064         (let ((srange range))
16065           ;; Go past all legal elements.
16066           (while (and (cdr srange)
16067                       (<= (or (and (atom (cadr srange))
16068                                    (cadr srange))
16069                               (caadr srange)) (cdr active)))
16070             (setq srange (cdr srange)))
16071           (if (cdr srange)
16072               ;; Nuke all remaining illegal elements.
16073               (setcdr srange nil))
16074
16075           ;; Adjust the final element.
16076           (if (and (not (atom (car srange)))
16077                    (> (cdar srange) (cdr active)))
16078               (setcdr (car srange) (cdr active))))
16079         ;; Compute the number of unread articles.
16080         (while range
16081           (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
16082                                       (cdar range)))
16083                               (or (and (atom (car range)) (car range))
16084                                   (caar range)))))
16085           (setq range (cdr range)))
16086         (setq num (max 0 (- (cdr active) num)))))
16087       ;; Set the number of unread articles.
16088       (when info
16089         (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
16090       num)))
16091
16092 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
16093 ;; and compute how many unread articles there are in each group.
16094 (defun gnus-get-unread-articles (&optional level)
16095   (let* ((newsrc (cdr gnus-newsrc-alist))
16096          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
16097          (foreign-level
16098           (min
16099            (cond ((and gnus-activate-foreign-newsgroups
16100                        (not (numberp gnus-activate-foreign-newsgroups)))
16101                   (1+ gnus-level-subscribed))
16102                  ((numberp gnus-activate-foreign-newsgroups)
16103                   gnus-activate-foreign-newsgroups)
16104                  (t 0))
16105            level))
16106          info group active method)
16107     (gnus-message 5 "Checking new news...")
16108
16109     (while newsrc
16110       (setq active (gnus-active (setq group (gnus-info-group
16111                                              (setq info (pop newsrc))))))
16112
16113       ;; Check newsgroups.  If the user doesn't want to check them, or
16114       ;; they can't be checked (for instance, if the news server can't
16115       ;; be reached) we just set the number of unread articles in this
16116       ;; newsgroup to t.  This means that Gnus thinks that there are
16117       ;; unread articles, but it has no idea how many.
16118       (if (and (setq method (gnus-info-method info))
16119                (not (gnus-server-equal
16120                      gnus-select-method
16121                      (setq method (gnus-server-get-method nil method))))
16122                (not (gnus-secondary-method-p method)))
16123           ;; These groups are foreign.  Check the level.
16124           (when (<= (gnus-info-level info) foreign-level)
16125             (setq active (gnus-activate-group group 'scan))
16126             (unless (inline (gnus-virtual-group-p group))
16127               (inline (gnus-close-group group)))
16128             (when (fboundp (intern (concat (symbol-name (car method))
16129                                            "-request-update-info")))
16130               (inline (gnus-request-update-info info method))))
16131         ;; These groups are native or secondary.
16132         (when (and (<= (gnus-info-level info) level)
16133                    (not gnus-read-active-file))
16134           (setq active (gnus-activate-group group 'scan))
16135           (inline (gnus-close-group group))))
16136
16137       ;; Get the number of unread articles in the group.
16138       (if active
16139           (inline (gnus-get-unread-articles-in-group info active))
16140         ;; The group couldn't be reached, so we nix out the number of
16141         ;; unread articles and stuff.
16142         (gnus-set-active group nil)
16143         (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
16144
16145     (gnus-message 5 "Checking new news...done")))
16146
16147 ;; Create a hash table out of the newsrc alist.  The `car's of the
16148 ;; alist elements are used as keys.
16149 (defun gnus-make-hashtable-from-newsrc-alist ()
16150   (let ((alist gnus-newsrc-alist)
16151         (ohashtb gnus-newsrc-hashtb)
16152         prev)
16153     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
16154     (setq alist
16155           (setq prev (setq gnus-newsrc-alist
16156                            (if (equal (caar gnus-newsrc-alist)
16157                                       "dummy.group")
16158                                gnus-newsrc-alist
16159                              (cons (list "dummy.group" 0 nil) alist)))))
16160     (while alist
16161       (gnus-sethash
16162        (caar alist)
16163        (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
16164              prev)
16165        gnus-newsrc-hashtb)
16166       (setq prev alist
16167             alist (cdr alist)))))
16168
16169 (defun gnus-make-hashtable-from-killed ()
16170   "Create a hash table from the killed and zombie lists."
16171   (let ((lists '(gnus-killed-list gnus-zombie-list))
16172         list)
16173     (setq gnus-killed-hashtb
16174           (gnus-make-hashtable
16175            (+ (length gnus-killed-list) (length gnus-zombie-list))))
16176     (while (setq list (pop lists))
16177       (setq list (symbol-value list))
16178       (while list
16179         (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
16180
16181 (defun gnus-activate-group (group &optional scan dont-check method)
16182   ;; Check whether a group has been activated or not.
16183   ;; If SCAN, request a scan of that group as well.
16184   (let ((method (or method (gnus-find-method-for-group group)))
16185         active)
16186     (and (gnus-check-server method)
16187          ;; We escape all bugs and quit here to make it possible to
16188          ;; continue if a group is so out-there that it reports bugs
16189          ;; and stuff.
16190          (progn
16191            (and scan
16192                 (gnus-check-backend-function 'request-scan (car method))
16193                 (gnus-request-scan group method))
16194            t)
16195          (condition-case ()
16196              (gnus-request-group group dont-check method)
16197         ;   (error nil)
16198            (quit nil))
16199          (save-excursion
16200            (set-buffer nntp-server-buffer)
16201            (goto-char (point-min))
16202            ;; Parse the result we got from `gnus-request-group'.
16203            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
16204                 (progn
16205                   (goto-char (match-beginning 1))
16206                   (gnus-set-active
16207                    group (setq active (cons (read (current-buffer))
16208                                             (read (current-buffer)))))
16209                   ;; Return the new active info.
16210                   active))))))
16211
16212 (defun gnus-update-read-articles (group unread)
16213   "Update the list of read and ticked articles in GROUP using the
16214 UNREAD and TICKED lists.
16215 Note: UNSELECTED has to be sorted over `<'.
16216 Returns whether the updating was successful."
16217   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
16218          (entry (gnus-gethash group gnus-newsrc-hashtb))
16219          (info (nth 2 entry))
16220          (prev 1)
16221          (unread (sort (copy-sequence unread) '<))
16222          read)
16223     (if (or (not info) (not active))
16224         ;; There is no info on this group if it was, in fact,
16225         ;; killed.  Gnus stores no information on killed groups, so
16226         ;; there's nothing to be done.
16227         ;; One could store the information somewhere temporarily,
16228         ;; perhaps...  Hmmm...
16229         ()
16230       ;; Remove any negative articles numbers.
16231       (while (and unread (< (car unread) 0))
16232         (setq unread (cdr unread)))
16233       ;; Remove any expired article numbers
16234       (while (and unread (< (car unread) (car active)))
16235         (setq unread (cdr unread)))
16236       ;; Compute the ranges of read articles by looking at the list of
16237       ;; unread articles.
16238       (while unread
16239         (if (/= (car unread) prev)
16240             (setq read (cons (if (= prev (1- (car unread))) prev
16241                                (cons prev (1- (car unread)))) read)))
16242         (setq prev (1+ (car unread)))
16243         (setq unread (cdr unread)))
16244       (when (<= prev (cdr active))
16245         (setq read (cons (cons prev (cdr active)) read)))
16246       ;; Enter this list into the group info.
16247       (gnus-info-set-read
16248        info (if (> (length read) 1) (nreverse read) read))
16249       ;; Set the number of unread articles in gnus-newsrc-hashtb.
16250       (gnus-get-unread-articles-in-group info (gnus-active group))
16251       t)))
16252
16253 (defun gnus-make-articles-unread (group articles)
16254   "Mark ARTICLES in GROUP as unread."
16255   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
16256                           (gnus-gethash (gnus-group-real-name group)
16257                                         gnus-newsrc-hashtb))))
16258          (ranges (gnus-info-read info))
16259          news article)
16260     (while articles
16261       (when (gnus-member-of-range
16262              (setq article (pop articles)) ranges)
16263         (setq news (cons article news))))
16264     (when news
16265       (gnus-info-set-read
16266        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
16267       (gnus-group-update-group group t))))
16268
16269 ;; Enter all dead groups into the hashtb.
16270 (defun gnus-update-active-hashtb-from-killed ()
16271   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
16272         (lists (list gnus-killed-list gnus-zombie-list))
16273         killed)
16274     (while lists
16275       (setq killed (car lists))
16276       (while killed
16277         (gnus-sethash (car killed) nil hashtb)
16278         (setq killed (cdr killed)))
16279       (setq lists (cdr lists)))))
16280
16281 (defun gnus-get-killed-groups ()
16282   "Go through the active hashtb and mark all unknown groups as killed."
16283   ;; First make sure active file has been read.
16284   (unless (gnus-read-active-file-p)
16285     (let ((gnus-read-active-file t))
16286       (gnus-read-active-file)))
16287   (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
16288   ;; Go through all newsgroups that are known to Gnus - enlarge kill list.
16289   (mapatoms
16290    (lambda (sym)
16291      (let ((groups 0)
16292            (group (symbol-name sym)))
16293        (if (or (null group)
16294                (gnus-gethash group gnus-killed-hashtb)
16295                (gnus-gethash group gnus-newsrc-hashtb))
16296            ()
16297          (let ((do-sub (gnus-matches-options-n group)))
16298            (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
16299                ()
16300              (setq groups (1+ groups))
16301              (setq gnus-killed-list
16302                    (cons group gnus-killed-list))
16303              (gnus-sethash group group gnus-killed-hashtb))))))
16304    gnus-active-hashtb))
16305
16306 ;; Get the active file(s) from the backend(s).
16307 (defun gnus-read-active-file ()
16308   (gnus-group-set-mode-line)
16309   (let ((methods 
16310          (append
16311           (if (gnus-check-server gnus-select-method)
16312               ;; The native server is available.
16313               (cons gnus-select-method gnus-secondary-select-methods)
16314             ;; The native server is down, so we just do the
16315             ;; secondary ones.
16316             gnus-secondary-select-methods)
16317           ;; Also read from the archive server.
16318           (when (gnus-archive-server-wanted-p)
16319             (list "archive"))))
16320         list-type)
16321     (setq gnus-have-read-active-file nil)
16322     (save-excursion
16323       (set-buffer nntp-server-buffer)
16324       (while methods
16325         (let* ((method (if (stringp (car methods))
16326                            (gnus-server-get-method nil (car methods))
16327                          (car methods)))
16328                (where (nth 1 method))
16329                (mesg (format "Reading active file%s via %s..."
16330                              (if (and where (not (zerop (length where))))
16331                                  (concat " from " where) "")
16332                              (car method))))
16333           (gnus-message 5 mesg)
16334           (when (gnus-check-server method)
16335             ;; Request that the backend scan its incoming messages.
16336             (and (gnus-check-backend-function 'request-scan (car method))
16337                  (gnus-request-scan nil method))
16338             (cond
16339              ((and (eq gnus-read-active-file 'some)
16340                    (gnus-check-backend-function 'retrieve-groups (car method)))
16341               (let ((newsrc (cdr gnus-newsrc-alist))
16342                     (gmethod (gnus-server-get-method nil method))
16343                     groups info)
16344                 (while (setq info (pop newsrc))
16345                   (when (gnus-server-equal
16346                          (gnus-find-method-for-group 
16347                           (gnus-info-group info) info)
16348                          gmethod)
16349                     (push (gnus-group-real-name (gnus-info-group info)) 
16350                           groups)))
16351                 (when groups
16352                   (gnus-check-server method)
16353                   (setq list-type (gnus-retrieve-groups groups method))
16354                   (cond
16355                    ((not list-type)
16356                     (gnus-error
16357                      1.2 "Cannot read partial active file from %s server."
16358                      (car method)))
16359                    ((eq list-type 'active)
16360                     (gnus-active-to-gnus-format method gnus-active-hashtb))
16361                    (t
16362                     (gnus-groups-to-gnus-format method gnus-active-hashtb))))))
16363              (t
16364               (if (not (gnus-request-list method))
16365                   (unless (equal method gnus-message-archive-method)
16366                     (gnus-error 1 "Cannot read active file from %s server."
16367                                 (car method)))
16368                 (gnus-message 5 mesg)
16369                 (gnus-active-to-gnus-format method gnus-active-hashtb)
16370                 ;; We mark this active file as read.
16371                 (push method gnus-have-read-active-file)
16372                 (gnus-message 5 "%sdone" mesg))))))
16373         (setq methods (cdr methods))))))
16374
16375 ;; Read an active file and place the results in `gnus-active-hashtb'.
16376 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
16377   (unless method
16378     (setq method gnus-select-method))
16379   (let ((cur (current-buffer))
16380         (hashtb (or hashtb
16381                     (if (and gnus-active-hashtb
16382                              (not (equal method gnus-select-method)))
16383                         gnus-active-hashtb
16384                       (setq gnus-active-hashtb
16385                             (if (equal method gnus-select-method)
16386                                 (gnus-make-hashtable
16387                                  (count-lines (point-min) (point-max)))
16388                               (gnus-make-hashtable 4096)))))))
16389     ;; Delete unnecessary lines.
16390     (goto-char (point-min))
16391     (while (search-forward "\nto." nil t)
16392       (delete-region (1+ (match-beginning 0))
16393                      (progn (forward-line 1) (point))))
16394     (or (string= gnus-ignored-newsgroups "")
16395         (progn
16396           (goto-char (point-min))
16397           (delete-matching-lines gnus-ignored-newsgroups)))
16398     ;; Make the group names readable as a lisp expression even if they
16399     ;; contain special characters.
16400     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
16401     (goto-char (point-max))
16402     (while (re-search-backward "[][';?()#]" nil t)
16403       (insert ?\\))
16404     ;; If these are groups from a foreign select method, we insert the
16405     ;; group prefix in front of the group names.
16406     (and method (not (gnus-server-equal
16407                       (gnus-server-get-method nil method)
16408                       (gnus-server-get-method nil gnus-select-method)))
16409          (let ((prefix (gnus-group-prefixed-name "" method)))
16410            (goto-char (point-min))
16411            (while (and (not (eobp))
16412                        (progn (insert prefix)
16413                               (zerop (forward-line 1)))))))
16414     ;; Store the active file in a hash table.
16415     (goto-char (point-min))
16416     (if (string-match "%[oO]" gnus-group-line-format)
16417         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
16418         ;; If we want information on moderated groups, we use this
16419         ;; loop...
16420         (let* ((mod-hashtb (make-vector 7 0))
16421                (m (intern "m" mod-hashtb))
16422                group max min)
16423           (while (not (eobp))
16424             (condition-case nil
16425                 (progn
16426                   (narrow-to-region (point) (gnus-point-at-eol))
16427                   (setq group (let ((obarray hashtb)) (read cur)))
16428                   (if (and (numberp (setq max (read cur)))
16429                            (numberp (setq min (read cur)))
16430                            (progn
16431                              (skip-chars-forward " \t")
16432                              (not
16433                               (or (= (following-char) ?=)
16434                                   (= (following-char) ?x)
16435                                   (= (following-char) ?j)))))
16436                       (set group (cons min max))
16437                     (set group nil))
16438                   ;; Enter moderated groups into a list.
16439                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
16440                       (setq gnus-moderated-list
16441                             (cons (symbol-name group) gnus-moderated-list))))
16442               (error
16443                (and group
16444                     (symbolp group)
16445                     (set group nil))))
16446             (widen)
16447             (forward-line 1)))
16448       ;; And if we do not care about moderation, we use this loop,
16449       ;; which is faster.
16450       (let (group max min)
16451         (while (not (eobp))
16452           (condition-case ()
16453               (progn
16454                 (narrow-to-region (point) (gnus-point-at-eol))
16455                 ;; group gets set to a symbol interned in the hash table
16456                 ;; (what a hack!!) - jwz
16457                 (setq group (let ((obarray hashtb)) (read cur)))
16458                 (if (and (numberp (setq max (read cur)))
16459                          (numberp (setq min (read cur)))
16460                          (progn
16461                            (skip-chars-forward " \t")
16462                            (not
16463                             (or (= (following-char) ?=)
16464                                 (= (following-char) ?x)
16465                                 (= (following-char) ?j)))))
16466                     (set group (cons min max))
16467                   (set group nil)))
16468             (error
16469              (progn
16470                (and group
16471                     (symbolp group)
16472                     (set group nil))
16473                (or ignore-errors
16474                    (gnus-message 3 "Warning - illegal active: %s"
16475                                  (buffer-substring
16476                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
16477           (widen)
16478           (forward-line 1))))))
16479
16480 (defun gnus-groups-to-gnus-format (method &optional hashtb)
16481   ;; Parse a "groups" active file.
16482   (let ((cur (current-buffer))
16483         (hashtb (or hashtb
16484                     (if (and method gnus-active-hashtb)
16485                         gnus-active-hashtb
16486                       (setq gnus-active-hashtb
16487                             (gnus-make-hashtable
16488                              (count-lines (point-min) (point-max)))))))
16489         (prefix (and method
16490                      (not (gnus-server-equal
16491                            (gnus-server-get-method nil method)
16492                            (gnus-server-get-method nil gnus-select-method)))
16493                      (gnus-group-prefixed-name "" method))))
16494
16495     (goto-char (point-min))
16496     ;; We split this into to separate loops, one with the prefix
16497     ;; and one without to speed the reading up somewhat.
16498     (if prefix
16499         (let (min max opoint group)
16500           (while (not (eobp))
16501             (condition-case ()
16502                 (progn
16503                   (read cur) (read cur)
16504                   (setq min (read cur)
16505                         max (read cur)
16506                         opoint (point))
16507                   (skip-chars-forward " \t")
16508                   (insert prefix)
16509                   (goto-char opoint)
16510                   (set (let ((obarray hashtb)) (read cur))
16511                        (cons min max)))
16512               (error (and group (symbolp group) (set group nil))))
16513             (forward-line 1)))
16514       (let (min max group)
16515         (while (not (eobp))
16516           (condition-case ()
16517               (if (= (following-char) ?2)
16518                   (progn
16519                     (read cur) (read cur)
16520                     (setq min (read cur)
16521                           max (read cur))
16522                     (set (setq group (let ((obarray hashtb)) (read cur)))
16523                          (cons min max))))
16524             (error (and group (symbolp group) (set group nil))))
16525           (forward-line 1))))))
16526
16527 (defun gnus-read-newsrc-file (&optional force)
16528   "Read startup file.
16529 If FORCE is non-nil, the .newsrc file is read."
16530   ;; Reset variables that might be defined in the .newsrc.eld file.
16531   (let ((variables gnus-variable-list))
16532     (while variables
16533       (set (car variables) nil)
16534       (setq variables (cdr variables))))
16535   (let* ((newsrc-file gnus-current-startup-file)
16536          (quick-file (concat newsrc-file ".el")))
16537     (save-excursion
16538       ;; We always load the .newsrc.eld file.  If always contains
16539       ;; much information that can not be gotten from the .newsrc
16540       ;; file (ticked articles, killed groups, foreign methods, etc.)
16541       (gnus-read-newsrc-el-file quick-file)
16542
16543       (if (and (file-exists-p gnus-current-startup-file)
16544                (or force
16545                    (and (file-newer-than-file-p newsrc-file quick-file)
16546                         (file-newer-than-file-p newsrc-file
16547                                                 (concat quick-file "d")))
16548                    (not gnus-newsrc-alist)))
16549           ;; We read the .newsrc file.  Note that if there if a
16550           ;; .newsrc.eld file exists, it has already been read, and
16551           ;; the `gnus-newsrc-hashtb' has been created.  While reading
16552           ;; the .newsrc file, Gnus will only use the information it
16553           ;; can find there for changing the data already read -
16554           ;; ie. reading the .newsrc file will not trash the data
16555           ;; already read (except for read articles).
16556           (save-excursion
16557             (gnus-message 5 "Reading %s..." newsrc-file)
16558             (set-buffer (find-file-noselect newsrc-file))
16559             (buffer-disable-undo (current-buffer))
16560             (gnus-newsrc-to-gnus-format)
16561             (kill-buffer (current-buffer))
16562             (gnus-message 5 "Reading %s...done" newsrc-file)))
16563
16564       ;; Read any slave files.
16565       (unless gnus-slave
16566         (gnus-master-read-slave-newsrc))
16567       
16568       ;; Convert old to new.
16569       (gnus-convert-old-newsrc))))
16570
16571 (defun gnus-continuum-version (version)
16572   "Return VERSION as a floating point number."
16573   (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
16574             (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
16575     (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
16576            (number (match-string 2 version))
16577            major minor least)
16578       (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
16579       (setq major (string-to-number (match-string 1 number)))
16580       (setq minor (string-to-number (match-string 2 number)))
16581       (setq least (if (match-beginning 3)
16582                       (string-to-number (match-string 3 number))
16583                     0))
16584       (string-to-number
16585        (if (zerop major)
16586            (format "%s00%02d%02d"
16587                    (cond 
16588                     ((member alpha '("(ding)" "d")) "4.99")
16589                     ((member alpha '("September" "s")) "5.01")
16590                     ((member alpha '("Red" "r")) "5.03"))
16591                    minor least)
16592          (format "%d.%02d%02d" major minor least))))))
16593
16594 (defun gnus-convert-old-newsrc ()
16595   "Convert old newsrc into the new format, if needed."
16596   (let ((fcv (and gnus-newsrc-file-version
16597                   (gnus-continuum-version gnus-newsrc-file-version))))
16598     (cond
16599      ;; No .newsrc.eld file was loaded.
16600      ((null fcv) nil)
16601      ;; Gnus 5 .newsrc.eld was loaded.
16602      ((< fcv (gnus-continuum-version "September Gnus v0.1"))
16603       (gnus-convert-old-ticks)))))
16604
16605 (defun gnus-convert-old-ticks ()
16606   (let ((newsrc (cdr gnus-newsrc-alist))
16607         marks info dormant ticked)
16608     (while (setq info (pop newsrc))
16609       (when (setq marks (gnus-info-marks info))
16610         (setq dormant (cdr (assq 'dormant marks))
16611               ticked (cdr (assq 'tick marks)))
16612         (when (or dormant ticked)
16613           (gnus-info-set-read
16614            info
16615            (gnus-add-to-range
16616             (gnus-info-read info)
16617             (nconc (gnus-uncompress-range dormant)
16618                    (gnus-uncompress-range ticked)))))))))
16619
16620 (defun gnus-read-newsrc-el-file (file)
16621   (let ((ding-file (concat file "d")))
16622     ;; We always, always read the .eld file.
16623     (gnus-message 5 "Reading %s..." ding-file)
16624     (let (gnus-newsrc-assoc)
16625       (condition-case nil
16626           (load ding-file t t t)
16627         (error
16628          (gnus-error 1 "Error in %s" ding-file)))
16629       (when gnus-newsrc-assoc
16630         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
16631     (gnus-make-hashtable-from-newsrc-alist)
16632     (when (file-newer-than-file-p file ding-file)
16633       ;; Old format quick file
16634       (gnus-message 5 "Reading %s..." file)
16635       ;; The .el file is newer than the .eld file, so we read that one
16636       ;; as well.
16637       (gnus-read-old-newsrc-el-file file))))
16638
16639 ;; Parse the old-style quick startup file
16640 (defun gnus-read-old-newsrc-el-file (file)
16641   (let (newsrc killed marked group m info)
16642     (prog1
16643         (let ((gnus-killed-assoc nil)
16644               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
16645           (prog1
16646               (condition-case nil
16647                   (load file t t t)
16648                 (error nil))
16649             (setq newsrc gnus-newsrc-assoc
16650                   killed gnus-killed-assoc
16651                   marked gnus-marked-assoc)))
16652       (setq gnus-newsrc-alist nil)
16653       (while (setq group (pop newsrc))
16654         (if (setq info (gnus-get-info (car group)))
16655             (progn
16656               (gnus-info-set-read info (cddr group))
16657               (gnus-info-set-level
16658                info (if (nth 1 group) gnus-level-default-subscribed
16659                       gnus-level-default-unsubscribed))
16660               (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
16661           (push (setq info
16662                       (list (car group)
16663                             (if (nth 1 group) gnus-level-default-subscribed
16664                               gnus-level-default-unsubscribed)
16665                             (cddr group)))
16666                 gnus-newsrc-alist))
16667         ;; Copy marks into info.
16668         (when (setq m (assoc (car group) marked))
16669           (unless (nthcdr 3 info)
16670             (nconc info (list nil)))
16671           (gnus-info-set-marks
16672            info (list (cons 'tick (gnus-compress-sequence 
16673                                    (sort (cdr m) '<) t))))))
16674       (setq newsrc killed)
16675       (while newsrc
16676         (setcar newsrc (caar newsrc))
16677         (setq newsrc (cdr newsrc)))
16678       (setq gnus-killed-list killed))
16679     ;; The .el file version of this variable does not begin with
16680     ;; "options", while the .eld version does, so we just add it if it
16681     ;; isn't there.
16682     (and
16683      gnus-newsrc-options
16684      (progn
16685        (and (not (string-match "^ *options" gnus-newsrc-options))
16686             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
16687        (and (not (string-match "\n$" gnus-newsrc-options))
16688             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
16689        ;; Finally, if we read some options lines, we parse them.
16690        (or (string= gnus-newsrc-options "")
16691            (gnus-newsrc-parse-options gnus-newsrc-options))))
16692
16693     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
16694     (gnus-make-hashtable-from-newsrc-alist)))
16695
16696 (defun gnus-make-newsrc-file (file)
16697   "Make server dependent file name by catenating FILE and server host name."
16698   (let* ((file (expand-file-name file nil))
16699          (real-file (concat file "-" (nth 1 gnus-select-method))))
16700     (if (or (file-exists-p real-file)
16701             (file-exists-p (concat real-file ".el"))
16702             (file-exists-p (concat real-file ".eld")))
16703         real-file file)))
16704
16705 (defun gnus-newsrc-to-gnus-format ()
16706   (setq gnus-newsrc-options "")
16707   (setq gnus-newsrc-options-n nil)
16708
16709   (or gnus-active-hashtb
16710       (setq gnus-active-hashtb (make-vector 4095 0)))
16711   (let ((buf (current-buffer))
16712         (already-read (> (length gnus-newsrc-alist) 1))
16713         group subscribed options-symbol newsrc Options-symbol
16714         symbol reads num1)
16715     (goto-char (point-min))
16716     ;; We intern the symbol `options' in the active hashtb so that we
16717     ;; can `eq' against it later.
16718     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
16719     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
16720
16721     (while (not (eobp))
16722       ;; We first read the first word on the line by narrowing and
16723       ;; then reading into `gnus-active-hashtb'.  Most groups will
16724       ;; already exist in that hashtb, so this will save some string
16725       ;; space.
16726       (narrow-to-region
16727        (point)
16728        (progn (skip-chars-forward "^ \t!:\n") (point)))
16729       (goto-char (point-min))
16730       (setq symbol
16731             (and (/= (point-min) (point-max))
16732                  (let ((obarray gnus-active-hashtb)) (read buf))))
16733       (widen)
16734       ;; Now, the symbol we have read is either `options' or a group
16735       ;; name.  If it is an options line, we just add it to a string.
16736       (cond
16737        ((or (eq symbol options-symbol)
16738             (eq symbol Options-symbol))
16739         (setq gnus-newsrc-options
16740               ;; This concating is quite inefficient, but since our
16741               ;; thorough studies show that approx 99.37% of all
16742               ;; .newsrc files only contain a single options line, we
16743               ;; don't give a damn, frankly, my dear.
16744               (concat gnus-newsrc-options
16745                       (buffer-substring
16746                        (gnus-point-at-bol)
16747                        ;; Options may continue on the next line.
16748                        (or (and (re-search-forward "^[^ \t]" nil 'move)
16749                                 (progn (beginning-of-line) (point)))
16750                            (point)))))
16751         (forward-line -1))
16752        (symbol
16753         ;; Group names can be just numbers.  
16754         (when (numberp symbol) 
16755           (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
16756         (or (boundp symbol) (set symbol nil))
16757         ;; It was a group name.
16758         (setq subscribed (= (following-char) ?:)
16759               group (symbol-name symbol)
16760               reads nil)
16761         (if (eolp)
16762             ;; If the line ends here, this is clearly a buggy line, so
16763             ;; we put point a the beginning of line and let the cond
16764             ;; below do the error handling.
16765             (beginning-of-line)
16766           ;; We skip to the beginning of the ranges.
16767           (skip-chars-forward "!: \t"))
16768         ;; We are now at the beginning of the list of read articles.
16769         ;; We read them range by range.
16770         (while
16771             (cond
16772              ((looking-at "[0-9]+")
16773               ;; We narrow and read a number instead of buffer-substring/
16774               ;; string-to-int because it's faster.  narrow/widen is
16775               ;; faster than save-restriction/narrow, and save-restriction
16776               ;; produces a garbage object.
16777               (setq num1 (progn
16778                            (narrow-to-region (match-beginning 0) (match-end 0))
16779                            (read buf)))
16780               (widen)
16781               ;; If the next character is a dash, then this is a range.
16782               (if (= (following-char) ?-)
16783                   (progn
16784                     ;; We read the upper bound of the range.
16785                     (forward-char 1)
16786                     (if (not (looking-at "[0-9]+"))
16787                         ;; This is a buggy line, by we pretend that
16788                         ;; it's kinda OK.  Perhaps the user should be
16789                         ;; dinged?
16790                         (setq reads (cons num1 reads))
16791                       (setq reads
16792                             (cons
16793                              (cons num1
16794                                    (progn
16795                                      (narrow-to-region (match-beginning 0)
16796                                                        (match-end 0))
16797                                      (read buf)))
16798                              reads))
16799                       (widen)))
16800                 ;; It was just a simple number, so we add it to the
16801                 ;; list of ranges.
16802                 (setq reads (cons num1 reads)))
16803               ;; If the next char in ?\n, then we have reached the end
16804               ;; of the line and return nil.
16805               (/= (following-char) ?\n))
16806              ((= (following-char) ?\n)
16807               ;; End of line, so we end.
16808               nil)
16809              (t
16810               ;; Not numbers and not eol, so this might be a buggy
16811               ;; line...
16812               (or (eobp)
16813                   ;; If it was eob instead of ?\n, we allow it.
16814                   (progn
16815                     ;; The line was buggy.
16816                     (setq group nil)
16817                     (gnus-error 3.1 "Mangled line: %s"
16818                                 (buffer-substring (gnus-point-at-bol)
16819                                                   (gnus-point-at-eol)))))
16820               nil))
16821           ;; Skip past ", ".  Spaces are illegal in these ranges, but
16822           ;; we allow them, because it's a common mistake to put a
16823           ;; space after the comma.
16824           (skip-chars-forward ", "))
16825
16826         ;; We have already read .newsrc.eld, so we gently update the
16827         ;; data in the hash table with the information we have just
16828         ;; read.
16829         (when group
16830           (let ((info (gnus-get-info group))
16831                 level)
16832             (if info
16833                 ;; There is an entry for this file in the alist.
16834                 (progn
16835                   (gnus-info-set-read info (nreverse reads))
16836                   ;; We update the level very gently.  In fact, we
16837                   ;; only change it if there's been a status change
16838                   ;; from subscribed to unsubscribed, or vice versa.
16839                   (setq level (gnus-info-level info))
16840                   (cond ((and (<= level gnus-level-subscribed)
16841                               (not subscribed))
16842                          (setq level (if reads
16843                                          gnus-level-default-unsubscribed
16844                                        (1+ gnus-level-default-unsubscribed))))
16845                         ((and (> level gnus-level-subscribed) subscribed)
16846                          (setq level gnus-level-default-subscribed)))
16847                   (gnus-info-set-level info level))
16848               ;; This is a new group.
16849               (setq info (list group
16850                                (if subscribed
16851                                    gnus-level-default-subscribed
16852                                  (if reads
16853                                      (1+ gnus-level-subscribed)
16854                                    gnus-level-default-unsubscribed))
16855                                (nreverse reads))))
16856             (setq newsrc (cons info newsrc))))))
16857       (forward-line 1))
16858
16859     (setq newsrc (nreverse newsrc))
16860
16861     (if (not already-read)
16862         ()
16863       ;; We now have two newsrc lists - `newsrc', which is what we
16864       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
16865       ;; what we've read from .newsrc.eld.  We have to merge these
16866       ;; lists.  We do this by "attaching" any (foreign) groups in the
16867       ;; gnus-newsrc-alist to the (native) group that precedes them.
16868       (let ((rc (cdr gnus-newsrc-alist))
16869             (prev gnus-newsrc-alist)
16870             entry mentry)
16871         (while rc
16872           (or (null (nth 4 (car rc)))   ; It's a native group.
16873               (assoc (caar rc) newsrc) ; It's already in the alist.
16874               (if (setq entry (assoc (caar prev) newsrc))
16875                   (setcdr (setq mentry (memq entry newsrc))
16876                           (cons (car rc) (cdr mentry)))
16877                 (setq newsrc (cons (car rc) newsrc))))
16878           (setq prev rc
16879                 rc (cdr rc)))))
16880
16881     (setq gnus-newsrc-alist newsrc)
16882     ;; We make the newsrc hashtb.
16883     (gnus-make-hashtable-from-newsrc-alist)
16884
16885     ;; Finally, if we read some options lines, we parse them.
16886     (or (string= gnus-newsrc-options "")
16887         (gnus-newsrc-parse-options gnus-newsrc-options))))
16888
16889 ;; Parse options lines to find "options -n !all rec.all" and stuff.
16890 ;; The return value will be a list on the form
16891 ;; ((regexp1 . ignore)
16892 ;;  (regexp2 . subscribe)...)
16893 ;; When handling new newsgroups, groups that match a `ignore' regexp
16894 ;; will be ignored, and groups that match a `subscribe' regexp will be
16895 ;; subscribed.  A line like
16896 ;; options -n !all rec.all
16897 ;; will lead to a list that looks like
16898 ;; (("^rec\\..+" . subscribe)
16899 ;;  ("^.+" . ignore))
16900 ;; So all "rec.*" groups will be subscribed, while all the other
16901 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
16902 ;; different from "options -n rec.all !all".
16903 (defun gnus-newsrc-parse-options (options)
16904   (let (out eol)
16905     (save-excursion
16906       (gnus-set-work-buffer)
16907       (insert (regexp-quote options))
16908       ;; First we treat all continuation lines.
16909       (goto-char (point-min))
16910       (while (re-search-forward "\n[ \t]+" nil t)
16911         (replace-match " " t t))
16912       ;; Then we transform all "all"s into ".+"s.
16913       (goto-char (point-min))
16914       (while (re-search-forward "\\ball\\b" nil t)
16915         (replace-match ".+" t t))
16916       (goto-char (point-min))
16917       ;; We remove all other options than the "-n" ones.
16918       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
16919         (replace-match " ")
16920         (forward-char -1))
16921       (goto-char (point-min))
16922
16923       ;; We are only interested in "options -n" lines - we
16924       ;; ignore the other option lines.
16925       (while (re-search-forward "[ \t]-n" nil t)
16926         (setq eol
16927               (or (save-excursion
16928                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
16929                          (- (point) 2)))
16930                   (gnus-point-at-eol)))
16931         ;; Search for all "words"...
16932         (while (re-search-forward "[^ \t,\n]+" eol t)
16933           (if (= (char-after (match-beginning 0)) ?!)
16934               ;; If the word begins with a bang (!), this is a "not"
16935               ;; spec.  We put this spec (minus the bang) and the
16936               ;; symbol `ignore' into the list.
16937               (setq out (cons (cons (concat
16938                                      "^" (buffer-substring
16939                                           (1+ (match-beginning 0))
16940                                           (match-end 0)))
16941                                     'ignore) out))
16942             ;; There was no bang, so this is a "yes" spec.
16943             (setq out (cons (cons (concat "^" (match-string 0))
16944                                   'subscribe) out)))))
16945
16946       (setq gnus-newsrc-options-n out))))
16947
16948 (defun gnus-save-newsrc-file (&optional force)
16949   "Save .newsrc file."
16950   ;; Note: We cannot save .newsrc file if all newsgroups are removed
16951   ;; from the variable gnus-newsrc-alist.
16952   (when (and (or gnus-newsrc-alist gnus-killed-list)
16953              gnus-current-startup-file)
16954     (save-excursion
16955       (if (and (or gnus-use-dribble-file gnus-slave)
16956                (not force)
16957                (or (not gnus-dribble-buffer)
16958                    (not (buffer-name gnus-dribble-buffer))
16959                    (zerop (save-excursion
16960                             (set-buffer gnus-dribble-buffer)
16961                             (buffer-size)))))
16962           (gnus-message 4 "(No changes need to be saved)")
16963         (run-hooks 'gnus-save-newsrc-hook)
16964         (if gnus-slave
16965             (gnus-slave-save-newsrc)
16966           ;; Save .newsrc.
16967           (when gnus-save-newsrc-file
16968             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
16969             (gnus-gnus-to-newsrc-format)
16970             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
16971           ;; Save .newsrc.eld.
16972           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
16973           (make-local-variable 'version-control)
16974           (setq version-control 'never)
16975           (setq buffer-file-name
16976                 (concat gnus-current-startup-file ".eld"))
16977           (setq default-directory (file-name-directory buffer-file-name))
16978           (gnus-add-current-to-buffer-list)
16979           (buffer-disable-undo (current-buffer))
16980           (erase-buffer)
16981           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
16982           (gnus-gnus-to-quick-newsrc-format)
16983           (run-hooks 'gnus-save-quick-newsrc-hook)
16984           (save-buffer)
16985           (kill-buffer (current-buffer))
16986           (gnus-message
16987            5 "Saving %s.eld...done" gnus-current-startup-file))
16988         (gnus-dribble-delete-file)
16989         (gnus-group-set-mode-line)))))
16990
16991 (defun gnus-gnus-to-quick-newsrc-format ()
16992   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
16993   (insert ";; Gnus startup file.\n")
16994   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
16995   (insert ";; to read .newsrc.\n")
16996   (insert "(setq gnus-newsrc-file-version "
16997           (prin1-to-string gnus-version) ")\n")
16998   (let ((variables
16999          (if gnus-save-killed-list gnus-variable-list
17000            ;; Remove the `gnus-killed-list' from the list of variables
17001            ;; to be saved, if required.
17002            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
17003         ;; Peel off the "dummy" group.
17004         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
17005         variable)
17006     ;; Insert the variables into the file.
17007     (while variables
17008       (when (and (boundp (setq variable (pop variables)))
17009                  (symbol-value variable))
17010         (insert "(setq " (symbol-name variable) " '")
17011         (prin1 (symbol-value variable) (current-buffer))
17012         (insert ")\n")))))
17013
17014 (defun gnus-gnus-to-newsrc-format ()
17015   ;; Generate and save the .newsrc file.
17016   (save-excursion
17017     (set-buffer (create-file-buffer gnus-current-startup-file))
17018     (let ((newsrc (cdr gnus-newsrc-alist))
17019           (standard-output (current-buffer))
17020           info ranges range method)
17021       (setq buffer-file-name gnus-current-startup-file)
17022       (setq default-directory (file-name-directory buffer-file-name))
17023       (buffer-disable-undo (current-buffer))
17024       (erase-buffer)
17025       ;; Write options.
17026       (if gnus-newsrc-options (insert gnus-newsrc-options))
17027       ;; Write subscribed and unsubscribed.
17028       (while (setq info (pop newsrc))
17029         ;; Don't write foreign groups to .newsrc.
17030         (when (or (null (setq method (gnus-info-method info)))
17031                   (equal method "native")
17032                   (gnus-server-equal method gnus-select-method))
17033           (insert (gnus-info-group info)
17034                   (if (> (gnus-info-level info) gnus-level-subscribed)
17035                       "!" ":"))
17036           (when (setq ranges (gnus-info-read info))
17037             (insert " ")
17038             (if (not (listp (cdr ranges)))
17039                 (if (= (car ranges) (cdr ranges))
17040                     (princ (car ranges))
17041                   (princ (car ranges))
17042                   (insert "-")
17043                   (princ (cdr ranges)))
17044               (while (setq range (pop ranges))
17045                 (if (or (atom range) (= (car range) (cdr range)))
17046                     (princ (or (and (atom range) range) (car range)))
17047                   (princ (car range))
17048                   (insert "-")
17049                   (princ (cdr range)))
17050                 (if ranges (insert ",")))))
17051           (insert "\n")))
17052       (make-local-variable 'version-control)
17053       (setq version-control 'never)
17054       ;; It has been reported that sometime the modtime on the .newsrc
17055       ;; file seems to be off.  We really do want to overwrite it, so
17056       ;; we clear the modtime here before saving.  It's a bit odd,
17057       ;; though...
17058       ;; sometimes the modtime clear isn't sufficient.  most brute force:
17059       ;; delete the silly thing entirely first.  but this fails to provide
17060       ;; such niceties as .newsrc~ creation.
17061       (if gnus-modtime-botch
17062           (delete-file gnus-startup-file)
17063         (clear-visited-file-modtime))
17064       (run-hooks 'gnus-save-standard-newsrc-hook)
17065       (save-buffer)
17066       (kill-buffer (current-buffer)))))
17067
17068 \f
17069 ;;;
17070 ;;; Slave functions.
17071 ;;;
17072
17073 (defun gnus-slave-save-newsrc ()
17074   (save-excursion
17075     (set-buffer gnus-dribble-buffer)
17076     (let ((slave-name
17077            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
17078       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
17079
17080 (defun gnus-master-read-slave-newsrc ()
17081   (let ((slave-files
17082          (directory-files
17083           (file-name-directory gnus-current-startup-file)
17084           t (concat
17085              "^" (regexp-quote
17086                   (concat
17087                    (file-name-nondirectory gnus-current-startup-file)
17088                    "-slave-")))
17089           t))
17090         file)
17091     (if (not slave-files)
17092         ()                              ; There are no slave files to read.
17093       (gnus-message 7 "Reading slave newsrcs...")
17094       (save-excursion
17095         (set-buffer (get-buffer-create " *gnus slave*"))
17096         (buffer-disable-undo (current-buffer))
17097         (setq slave-files
17098               (sort (mapcar (lambda (file)
17099                               (list (nth 5 (file-attributes file)) file))
17100                             slave-files)
17101                     (lambda (f1 f2)
17102                       (or (< (caar f1) (caar f2))
17103                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
17104         (while slave-files
17105           (erase-buffer)
17106           (setq file (nth 1 (car slave-files)))
17107           (insert-file-contents file)
17108           (if (condition-case ()
17109                   (progn
17110                     (eval-buffer (current-buffer))
17111                     t)
17112                 (error
17113                  (gnus-error 3.2 "Possible error in %s" file)
17114                  nil))
17115               (or gnus-slave ; Slaves shouldn't delete these files.
17116                   (condition-case ()
17117                       (delete-file file)
17118                     (error nil))))
17119           (setq slave-files (cdr slave-files))))
17120       (gnus-message 7 "Reading slave newsrcs...done"))))
17121
17122 \f
17123 ;;;
17124 ;;; Group description.
17125 ;;;
17126
17127 (defun gnus-read-all-descriptions-files ()
17128   (let ((methods (cons gnus-select-method 
17129                        (nconc
17130                         (when (gnus-archive-server-wanted-p)
17131                           (list "archive"))
17132                         gnus-secondary-select-methods))))
17133     (while methods
17134       (gnus-read-descriptions-file (car methods))
17135       (setq methods (cdr methods)))
17136     t))
17137
17138 (defun gnus-read-descriptions-file (&optional method)
17139   (let ((method (or method gnus-select-method))
17140         group)
17141     (when (stringp method)
17142       (setq method (gnus-server-to-method method)))
17143     ;; We create the hashtable whether we manage to read the desc file
17144     ;; to avoid trying to re-read after a failed read.
17145     (or gnus-description-hashtb
17146         (setq gnus-description-hashtb
17147               (gnus-make-hashtable (length gnus-active-hashtb))))
17148     ;; Mark this method's desc file as read.
17149     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
17150                   gnus-description-hashtb)
17151
17152     (gnus-message 5 "Reading descriptions file via %s..." (car method))
17153     (cond
17154      ((not (gnus-check-server method))
17155       (gnus-message 1 "Couldn't open server")
17156       nil)
17157      ((not (gnus-request-list-newsgroups method))
17158       (gnus-message 1 "Couldn't read newsgroups descriptions")
17159       nil)
17160      (t
17161       (save-excursion
17162         (save-restriction
17163           (set-buffer nntp-server-buffer)
17164           (goto-char (point-min))
17165           (when (or (search-forward "\n.\n" nil t)
17166                     (goto-char (point-max)))
17167             (beginning-of-line)
17168             (narrow-to-region (point-min) (point)))
17169           ;; If these are groups from a foreign select method, we insert the
17170           ;; group prefix in front of the group names.
17171           (and method (not (gnus-server-equal
17172                             (gnus-server-get-method nil method)
17173                             (gnus-server-get-method nil gnus-select-method)))
17174                (let ((prefix (gnus-group-prefixed-name "" method)))
17175                  (goto-char (point-min))
17176                  (while (and (not (eobp))
17177                              (progn (insert prefix)
17178                                     (zerop (forward-line 1)))))))
17179           (goto-char (point-min))
17180           (while (not (eobp))
17181             ;; If we get an error, we set group to 0, which is not a
17182             ;; symbol...
17183             (setq group
17184                   (condition-case ()
17185                       (let ((obarray gnus-description-hashtb))
17186                         ;; Group is set to a symbol interned in this
17187                         ;; hash table.
17188                         (read nntp-server-buffer))
17189                     (error 0)))
17190             (skip-chars-forward " \t")
17191             ;; ...  which leads to this line being effectively ignored.
17192             (and (symbolp group)
17193                  (set group (buffer-substring
17194                              (point) (progn (end-of-line) (point)))))
17195             (forward-line 1))))
17196       (gnus-message 5 "Reading descriptions file...done")
17197       t))))
17198
17199 (defun gnus-group-get-description (group)
17200   "Get the description of a group by sending XGTITLE to the server."
17201   (when (gnus-request-group-description group)
17202     (save-excursion
17203       (set-buffer nntp-server-buffer)
17204       (goto-char (point-min))
17205       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
17206         (match-string 1)))))
17207
17208 \f
17209 ;;;
17210 ;;; Buffering of read articles.
17211 ;;;
17212
17213 (defvar gnus-backlog-buffer " *Gnus Backlog*")
17214 (defvar gnus-backlog-articles nil)
17215 (defvar gnus-backlog-hashtb nil)
17216
17217 (defun gnus-backlog-buffer ()
17218   "Return the backlog buffer."
17219   (or (get-buffer gnus-backlog-buffer)
17220       (save-excursion
17221         (set-buffer (get-buffer-create gnus-backlog-buffer))
17222         (buffer-disable-undo (current-buffer))
17223         (setq buffer-read-only t)
17224         (gnus-add-current-to-buffer-list)
17225         (get-buffer gnus-backlog-buffer))))
17226
17227 (defun gnus-backlog-setup ()
17228   "Initialize backlog variables."
17229   (unless gnus-backlog-hashtb
17230     (setq gnus-backlog-hashtb (make-vector 1023 0))))
17231
17232 (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus)
17233
17234 (defun gnus-backlog-shutdown ()
17235   "Clear all backlog variables and buffers."
17236   (when (get-buffer gnus-backlog-buffer)
17237     (kill-buffer gnus-backlog-buffer))
17238   (setq gnus-backlog-hashtb nil
17239         gnus-backlog-articles nil))
17240
17241 (defun gnus-backlog-enter-article (group number buffer)
17242   (gnus-backlog-setup)
17243   (let ((ident (intern (concat group ":" (int-to-string number))
17244                        gnus-backlog-hashtb))
17245         b)
17246     (if (memq ident gnus-backlog-articles)
17247         () ; It's already kept.
17248       ;; Remove the oldest article, if necessary.
17249       (and (numberp gnus-keep-backlog)
17250            (>= (length gnus-backlog-articles) gnus-keep-backlog)
17251            (gnus-backlog-remove-oldest-article))
17252       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
17253       ;; Insert the new article.
17254       (save-excursion
17255         (set-buffer (gnus-backlog-buffer))
17256         (let (buffer-read-only)
17257           (goto-char (point-max))
17258           (or (bolp) (insert "\n"))
17259           (setq b (point))
17260           (insert-buffer-substring buffer)
17261           ;; Tag the beginning of the article with the ident.
17262           (gnus-put-text-property b (1+ b) 'gnus-backlog ident))))))
17263
17264 (defun gnus-backlog-remove-oldest-article ()
17265   (save-excursion
17266     (set-buffer (gnus-backlog-buffer))
17267     (goto-char (point-min))
17268     (if (zerop (buffer-size))
17269         () ; The buffer is empty.
17270       (let ((ident (get-text-property (point) 'gnus-backlog))
17271             buffer-read-only)
17272         ;; Remove the ident from the list of articles.
17273         (when ident
17274           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
17275         ;; Delete the article itself.
17276         (delete-region
17277          (point) (next-single-property-change
17278                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
17279
17280 (defun gnus-backlog-remove-article (group number)
17281   "Remove article NUMBER in GROUP from the backlog."
17282   (when (numberp number)
17283     (gnus-backlog-setup)
17284     (let ((ident (intern (concat group ":" (int-to-string number))
17285                          gnus-backlog-hashtb))
17286           beg end)
17287       (when (memq ident gnus-backlog-articles)
17288         ;; It was in the backlog.
17289         (save-excursion
17290           (set-buffer (gnus-backlog-buffer))
17291           (let (buffer-read-only)
17292             (when (setq beg (text-property-any
17293                              (point-min) (point-max) 'gnus-backlog
17294                              ident))
17295               ;; Find the end (i. e., the beginning of the next article).
17296               (setq end
17297                     (next-single-property-change
17298                      (1+ beg) 'gnus-backlog (current-buffer) (point-max)))
17299               (delete-region beg end)
17300               ;; Return success.
17301               t)))))))
17302
17303 (defun gnus-backlog-request-article (group number buffer)
17304   (when (numberp number)
17305     (gnus-backlog-setup)
17306     (let ((ident (intern (concat group ":" (int-to-string number))
17307                          gnus-backlog-hashtb))
17308           beg end)
17309       (when (memq ident gnus-backlog-articles)
17310         ;; It was in the backlog.
17311         (save-excursion
17312           (set-buffer (gnus-backlog-buffer))
17313           (if (not (setq beg (text-property-any
17314                               (point-min) (point-max) 'gnus-backlog
17315                               ident)))
17316               ;; It wasn't in the backlog after all.
17317               (ignore
17318                (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
17319             ;; Find the end (i. e., the beginning of the next article).
17320             (setq end
17321                   (next-single-property-change
17322                    (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
17323         (let ((buffer-read-only nil))
17324           (erase-buffer)
17325           (insert-buffer-substring gnus-backlog-buffer beg end)
17326           t)))))
17327
17328 ;; Allow redefinition of Gnus functions.
17329
17330 (gnus-ems-redefine)
17331
17332 (provide 'gnus)
17333
17334 ;;; gnus.el ends here